(in-package :c2ffi)

(export '(cffi-generator))

(defclass cffi-generator (ffi-generator)
  ()
  (:default-initargs :name "CFFI")
  (:documentation "This class generates bindings for CFFI."))

(defmethod sort-bindings ((ffi cffi-generator))
  (setf (slot-value ffi 'bindings)
	(sort (ffi-bindings ffi)
	      #'<
	      :key #'(lambda (form)
		       (ecase (car form)
			 (export 0)
			 (cffi:defctype 1)
			 (cffi:defcenum 2)
			 (cffi:defcunion 3)
			 (cffi:defcstruct 4)
			 (cffi:defcfun 5))))))

(defmethod bindings-for-node ((ffi cffi-generator)
			      (type (eql :Function))
			      node)
  (let* ((c-name (name-with-id ffi (node-attribute "id" node) nil))
	 (lisp-name (str->sym c-name)))
    (list*
     `(cffi:defcfun (,c-name ,lisp-name)
	  ,(type-with-id ffi (node-attribute "returns" node))
	,@(mapcar #'(lambda (arg-node)
		      (list
		       (str->sym (node-attribute "name" arg-node))
		       (type-with-id ffi (node-attribute "type" arg-node))))
		  (find-in-tree node "Argument" () :all t)))
     (when (aand (node-attribute "extern" node)
		 (string= it "1"))
       `((export ',lisp-name))))))

(defmethod bindings-for-node ((ffi cffi-generator)
			      (type (eql :Typedef))
			      node)
  (let ((lisp-name (name-with-id ffi (node-attribute "id" node))))
    (list
     `(cffi:defctype ,lisp-name
	  ,(type-with-id ffi (node-attribute "type" node)))
     `(export ',lisp-name))))

(defmethod bindings-for-node ((ffi cffi-generator)
			      (type (eql :Enumeration))
			      node)
  (let ((lisp-name (name-with-id ffi (node-attribute "id" node))))
    (list
     `(cffi:defcenum ,lisp-name
	,@(mapcar #'(lambda (val-node)
		      (list
		       (str->sym (node-attribute "name" val-node) :keyword)
		       (parse-integer (node-attribute "init" val-node))))
		  (find-in-tree node "EnumValue" () :all t)))
     `(export ',lisp-name))))

(defmethod bindings-for-node ((ffi cffi-generator)
			      (type (eql :Struct))
			      node)
  (cffi-struct-union-bindings ffi type node 'cffi:defcstruct))

(defmethod bindings-for-node ((ffi cffi-generator)
			      (type (eql :Union))
			      node)
  (cffi-struct-union-bindings ffi type node 'cffi:defcunion))

(defun cffi-struct-union-bindings (ffi type node func)
  (let* ((lisp-name (name-with-id ffi (node-attribute "id" node)))
	 (root-node (ffi-parse-tree ffi))
	 (field-ids (split-sequence #\space (node-attribute "members" node)
				    :remove-empty-subseqs t))
	 (field-nodes (mapcan #'(lambda (id)
				  (awhen (find-in-tree root-node "Field" `(("id" ,id)))
				    (list it)))
			      field-ids))
	 (slot-names nil))
    (list
     `(,func ,lisp-name
	     ,@(mapcar #'(lambda (field-node)
			   (when (node-attribute "bits" field-node)
			     (warn "Array fields in structs/unions not currently supported~%  In struct: ~S~%     field: ~S" node field-node))
			   (let ((slot-name (str->sym (node-attribute "name" field-node))))
			     (push slot-name slot-names)
			     (list*
			      slot-name
			      (type-with-id ffi (node-attribute "type" field-node))
			      (awhen (and (eql type :Struct)
					  (node-attribute "offset" field-node))
				     (list :offset (parse-integer it))))))
		       field-nodes))
     `(export ',(cons lisp-name slot-names)))))