; generate declarations for types

(in-package "VERRAZANO-CFFI")

; a mapping from GCC-XML type names to C-FFI typenames
(defparameter +fundamental-type-map+
  '(("void" . ":void")
    ("bool" . ":char")
    ("char" . ":char")
    ("unsigned char" . ":unsigned-char")
    ("signed char" . ":char")
    ("int" . ":int")
    ("short int" . ":short")
    ("short unsigned int" . ":short")
    ("long int" . ":long")
    ("long long int" . ":long")
    ("unsigned long long int" . ":long")
    ("unsigned int" . ":unsigned-int")
    ("long unsigned int" . ":unsigned-long")
    ("float" . ":float")
    ("double" . ":double")
    ("long double" . ":double")
    ("complex long double" . "not_supported")))

; translate a GCC-XML type to a C-FFI type
(defun translate-fundamental-type (str)
  (let ((tgt (cdr (assoc str +fundamental-type-map+ :test #'equal))))
    (if tgt tgt str)))

; since C-FFI is marginally typed, defining most types does nothing
(generate-for ((par node) (edg defines) (tgt pointer-type
											 function-type
											 fundamental-type
											 constant-type))
  nil)

; generate defctype declaration for typedefs
(generate-for ((par node) (edg defines) (tgt alias-type))
  (let ((type-name (named-name tgt)))
    (define-symbol type-name "typedef")
	(define-foreign-type-declaration (named-name tgt) "()" tgt)))

; in general, output types as their type name
(generate-for ((par node) (edg edge) (tgt cpp-type))
  (named-name tgt))

; with fundamental types, translate the name
(generate-for ((par node) (edg edge) (tgt fundamental-type))
  (translate-fundamental-type (named-name tgt)))
  
; for pointers, just output :pointer
(generate-for ((par node) (edg edge) (tgt pointer-type))
  ":pointer")

; for qualified types, array types, print the target type instead
(generate-for ((par node) (edg edge) (tgt constant-type
										  array-type))
			  (car (collect-output tgt 'extends)))

; defining a namespace outputs everything it allocates
(generate-for ((par node) (edg defines) (tgt namespace-type))
  `("cl:progn" ,@(collect-output tgt 'allocates)))