; generate declarations for functions

(in-package "VERRAZANO")

; for functions, output defcfun declaration
(generate-for ((par namespace-type) (edg allocates) (tgt function-type) bst)
  (when (not (get-note edg 'artificial))
    (cond
      ((virtual-method? edg) (virtual-function-declaration par edg tgt bst))
      ((constructor-function? edg) (constructor-declaration par edg tgt bst))
      (t (regular-function-declaration par edg tgt bst)))))

; utility routine for generating the defcfun declaration
(defun defcfun-declaration (fun-name c-name tgt bst)
  `("cffi:defcfun" (,(quote-string c-name) ,fun-name)
    ,@(collect-output tgt bst 'returns)
    ,@(collect-output tgt bst 'receives)))

; generate a declaration for a regular function
(defun regular-function-declaration (par edg tgt bst)
  (let ((fun-name (named-name edg))
	(c-name (named-c-name edg)))
    (define-symbol fun-name "function" (list par edg tgt) bst)
    (defcfun-declaration fun-name c-name tgt bst)))

; generate a declaration for a constructor
(defun constructor-declaration (par edg tgt bst)
  (let ((fun-name (concatenate 'string (named-name edg) "-"))
	(c-name (named-c-name edg))
	(wrap-name (named-name edg)))
    (define-symbol fun-name "function" (list par edg tgt) bst)
    (define-symbol wrap-name "function" (list par edg tgt) bst)
    `("cl:progn"
      ,(defcfun-declaration fun-name c-name tgt bst)
      ,(constructor-wrapper-declaration fun-name wrap-name edg))))

; generate a declaration for the constructo wrapper
(defun constructor-wrapper-declaration (fun-name wrap-name edg)
  (let* ((this (function-this-argument edg))
	 (clname (named-name (edge-target this)))
	 (ntargs (mapcar #'named-name (function-non-this-arguments edg))))
    `("cl:defun" ,wrap-name ,(if ntargs ntargs "()")
      ("cl:let" (("-pobj-" ("cffi:foreign-alloc" ',clname)))
	(,fun-name "-pobj-" ,@(mapcar #'named-name
				     (function-non-this-arguments edg)))
	"-pobj-"))))

; generate a declaration for a virtual function
(defun virtual-function-declaration (par edg tgt bst)
  (let ((fun-name (named-name edg))
	(this (function-this-argument edg)))
    (define-symbol fun-name "function" (list par edg tgt) bst)
    `("cl:defun" ,fun-name ,(mapcar #'named-name (function-arguments edg))
      ("vzn:virtual-funcall" 
       ,(named-name this)
       ,(receives-edge-index this)
       "0"
       ,@(flatten-arglist tgt bst)))))

; flatten the arglist of a function for foreign-funcall
(defun flatten-arglist (tgt bst)
  (let ((args (collect-output tgt bst 'receives))
	(newargs nil))
    (append
      (dolist (arg args newargs)
	(push-extend (reverse arg) newargs))
      (list (cadr (collect-output tgt bst 'returns))))))

; for typenames that appear as arguments, output tuple
(generate-for ((par node) (edg receives) (tgt cpp-type) bst)
  `(,(named-name edg) ,(call-next-method)))

; structures and unions passed by value are actually passed as pointers
(generate-for ((par node) (edg receives) (tgt (class-type 
					       struct-type 
					       union-type)) bst)
  `(,(named-name edg) ":pointer"))

; don't output anything for ellipsis, since C-FFI doesn't support them
(generate-for ((par node) (edg receives) (tgt ellipsis-type) bst) nil)