; main declaration generator for UFFI binding

(in-package "VERRAZANO")

(defparameter +fundamental-type-map+
  '(("long double" . "double")
    ("long int" . "long")))

(defun translate-fundamental-type (str)
  (let ((tgt (cdr (assoc str +fundamental-type-map+ :test #'equal))))
    (if tgt tgt str)))

(defun generate-package (ir cfg)
  (write-declarations (generate-declarations ir) cfg))

(defun generate-declarations (ir)
  (let ((edg (car (node-edges ir))))
    (output ir edg (edge-target edg))))

(defun matches-kind (e kind)
  (or (not kind) (eq (type-of e) kind)))

(defun edge-output (node &optional kind)
  (let ((edg (find-if #'(lambda (e) (matches-kind e kind)) 
		      (node-edges node))))
    (output node edg (edge-target edg))))

(defun edges-output (node &optional kind)
  (remove nil
	  (mapcar #'(lambda (e) 
		      (when (matches-kind e kind)
			(output node e (edge-target e))))
		  (node-edges node))))

(defgeneric output (par edg tgt))

(defmethod output ((par node) (edg edge) (tgt node)) nil)

(defmethod output ((par library) (edg allocates) (tgt namespace-type))
  `(,@(edges-output tgt)))
  
(defmethod output ((par node) (edg defines) (tgt pointer-type))
  `("uffi:def-foreign-type" ,(cpp-type-name tgt) ("*" ,(edge-output tgt 'extends))))

(defmethod output ((par node) (edg defines) (tgt qualified-type))
  `("uffi:def-foreign-type" ,(cpp-type-name tgt) ,(edge-output tgt 'extends)))

(defmethod output ((par node) (edg defines) (tgt class-type))
  `("uffi:def-foreign-type" ,(cpp-type-name tgt) ":int"))

(defmethod output ((par node) (edg extends) (tgt cpp-type))
  (name-for-type tgt))

(defmethod output ((par node) (edg receives) (tgt cpp-type))
  `(,(receives-edge-name edg) ,(name-for-type tgt)))

(defmethod output ((par node) (edge returns) (tgt cpp-type))
  `(":returning" ,(name-for-type tgt)))

(defmethod output ((par node) (edg extends) (tgt fundamental-type))
  (name-for-type tgt))

(defmethod output ((par node) (edg allocates) (tgt function-type))
  (let ((fun-name (allocates-edge-name edg)))
    `("uffi:def-function" ,(quote-string fun-name)
		   ,(edges-output tgt 'receives)
		   ,@(edge-output tgt 'returns))))

(defgeneric name-for-type (node))

(defmethod name-for-type ((node cpp-type))
  (substitute #\- #\_ (cpp-type-name node)))

(defmethod name-for-type ((node fundamental-type))
  (concatenate 'string ":" 
	       (substitute #\- #\Space (translate-fundamental-type 
					 (cpp-type-name node)))))