; main declaration generator for UFFI binding

(in-package "VERRAZANO")

(defparameter +run-config+ nil)

(defun generate-declarations (ir cfg)
  (setf +run-config+ cfg)
  (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))
  `(def-foreign-type ,(cpp-type-name tgt) ("*" ,(edge-output tgt 'extends))))

(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 receives) (tgt fundamental-type))
  (name-for-type tgt))

(defmethod output ((par node) (edg allocates) (tgt function-type))
  (let ((fun-name (allocates-edge-name edg)))
    `(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 (cpp-type-name node))))