Remove globals and close the enum ref loop

1 files changed, 43 insertions, 45 deletions

diff --git a/cmamut.lisp b/cmamut.lisp
index 9918c5d..a5133a0 100644
--- a/cmamut.lisp
+++ b/cmamut.lisp
@@ -12,13 +12,11 @@
 
 ; TODO: Get constants from macro file generated by c2ffi -M
 
-(defvar enum-references (make-hash-table :test #'equal :size 256))
-
 ; TODO: Use c2ffi to extract the spec.json using the header file as parameter
 (defun get-raw-spec ()
   (json:from-file "~/common-lisp/cmamut/spec.json"))
 
-(defun cook-type (raw-type)
+(defun cook-type (raw-type type-associations)
   (let ((tag (gethash "tag" raw-type)))
     (cond ((string= tag ":void")
            'sb-alien:void)
@@ -30,7 +28,7 @@
                     'sb-alien:c-string)
                    ((string= (gethash "tag" pointed-type) ":void")
                     (list 'sb-alien:* t))
-                   (t (list 'sb-alien:* (cook-type pointed-type))))))
+                   (t (list 'sb-alien:* (cook-type pointed-type type-associations))))))
           ((string= tag ":float")
            'sb-alien:float)
           ((string= tag ":double")
@@ -53,7 +51,7 @@
            'sb-alien:long)
           ((string= tag ":array")
            (list 'sb-alien:array
-                 (cook-type (gethash "type" raw-type))
+                 (cook-type (gethash "type" raw-type) type-associations)
                  (gethash "size" raw-type)))
           ((string= tag ":struct")
            (list 'sb-alien:struct (intern (gethash "name" raw-type))))
@@ -63,48 +61,51 @@
            (cook-struct raw-type))
           ((string= tag "union")
            (cook-union raw-type))
-          (t tag)))) ;TODO: Add type resolution
+          (t (let ((new-type (gethash tag type-associations)))
+               (if new-type
+                 (cook-type new-type type-associations)
+                 (error "Unknown type: ~a" tag)))))))
 
-(defun cook-function (raw-function &optional name-transformer)
+(defun cook-function (raw-function type-associations &optional name-transformer)
   (let ((raw-params (gethash "parameters" raw-function))
         (cooked-params (queue:new)))
     (dotimes (j (length raw-params))
       (queue:add cooked-params
                  (list (intern (string-upcase (gethash "name" (aref raw-params j))))
-                       (cook-type (gethash "type" (aref raw-params j))))))
+                       (cook-type (gethash "type" (aref raw-params j)) type-associations))))
     `(sb-alien:define-alien-routine
        ,(let ((function-name (gethash "name" raw-function)))
           (if name-transformer
             (list function-name (funcall name-transformer function-name))
             function-name))
-       ,(cook-type (gethash "return-type" raw-function))
+       ,(cook-type (gethash "return-type" raw-function) type-associations)
        ,@(queue:to-list cooked-params))))
 
-(defun cook-struct (raw-struct)
+(defun cook-struct (raw-struct type-associations)
   (let ((raw-fields (gethash "fields" raw-struct))
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
                  (list (intern (string-upcase (gethash "name" (aref raw-fields j))))
-                       (cook-type (gethash "type" (aref raw-fields j))))))
+                       (cook-type (gethash "type" (aref raw-fields j)) type-associations))))
     `(sb-alien:struct
        ,(when (> (length (gethash "name" raw-struct)) 0)
           (intern (gethash "name" raw-struct)))
        ,@(queue:to-list cooked-fields))))
 
-(defun cook-union (raw-union)
+(defun cook-union (raw-union type-associations)
   (let ((raw-fields (gethash "fields" raw-union))
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
                  (list (intern (string-upcase (gethash "name" (aref raw-fields j))))
-                       (cook-type (gethash "type" (aref raw-fields j))))))
+                       (cook-type (gethash "type" (aref raw-fields j)) type-associations))))
     `(sb-alien:union
        ,(when (> (length (gethash "name" raw-union)) 0)
           (intern (gethash "name" raw-union)))
        ,@(queue:to-list cooked-fields))))
 
-(defun cook-enum (raw-enum)
+(defun cook-enum (raw-enum enum-references)
   (let ((name (gethash (gethash "id" raw-enum) enum-references))
         (raw-fields (gethash "fields" raw-enum))
         (cooked-fields (queue:new)))
@@ -118,21 +119,22 @@
          nil
          ,@(queue:to-list cooked-fields)))))
 
-; If the enum table population gets done at an earlier stage and all typedefs get flattened, there would be no need of having codegen for typedefs.
-(defun cook-typedef (raw-typedef)
-  (let* ((base-type (gethash "type" raw-typedef))
-         (new-name (gethash "name" raw-typedef)))
-    (if (string= (gethash "tag" base-type) ":enum")
-      (progn (setf (gethash (gethash "id" base-type) enum-references) new-name) nil)
-      `(sb-alien:define-alien-type
-         ,new-name
-         ,(cook-type base-type)))))
+(defun generate-enum-references (raw-typedefs)
+  (let ((enum-references (make-hash-table :test #'equal :size 256)))
+    (dolist (i raw-typedefs)
+      (let ((base-type (gethash "type" i)))
+        (when (string= (gethash "tag" base-type) ":enum")
+          (setf (gethash (gethash "id" base-type) enum-references)
+                (gethash "name" i)))))
+    enum-references))
 
 ; Generates a table for type resolution.
 ; Typedefs get "flattened" so that resolving is just a lookup.
-(defun flatten-typedefs (raw-typedefs)
+(defun generate-type-associations (raw-typedefs)
   (let ((type-associations (make-hash-table :test #'equal :size 256)))
     (dolist (i raw-typedefs)
+      (when (string= (gethash "tag" (gethash "type" i)) ":enum")
+        (setf (gethash "name" (gethash "type" i)) (gethash "name" i)))
       (setf (gethash (gethash "name" i) type-associations) (gethash "type" i)))
     (labels ((flatten-typedef
                (k v)
@@ -177,11 +179,8 @@
                       (setf (gethash "name" internal-type) (gethash "name" def)))
                     (classify-definition internal-type spec)
                     (setf (gethash "type" def)
-                          (json:from-string
-                            (format nil
-                                    "{ \"tag\": \":~a\", \"name\": ~s }"
-                                    (gethash "tag" internal-type)
-                                    (gethash "name" internal-type)))))
+                          (json:obj ("tag" (gethash "tag" internal-type))
+                                    ("name" (gethash "name" internal-type)))))
                    ((or (string= internal-tag ":array")
                         (string= internal-tag ":pointer"))
                     (classify-definition internal-type spec)))
@@ -196,22 +195,21 @@
            (push def (spec-unions spec)))))
   spec)
 
-(defun codegen (spec)
-  (clrhash enum-references)
-  ; typedefs must be generated first to build the reference table
-  (setf (spec-typedefs spec)
-        (remove nil (mapcar #'cook-typedef (filter-base-types (spec-typedefs spec)))))
-  (setf (spec-enums spec) (mapcar #'cook-enum (spec-enums spec)))
-  (setf (spec-structs spec)
-        (mapcar (lambda (x)
-                  `(sb-alien:define-alien-type nil ,(cook-struct x)))
-                (spec-structs spec)))
-  (setf (spec-unions spec)
-        (mapcar (lambda (x)
-                  `(sb-alien:define-alien-type nil ,(cook-union x)))
-                (spec-unions spec)))
-  (setf (spec-functions spec) (mapcar #'cook-function (spec-functions spec)))
-  spec)
+;(defun codegen (spec)
+;  (let ((enum-references (generate-enum-references (spec-typedefs spec)))
+;        (type-associations (generate-type-associations (spec-typedefs spec)))
+;        (code nil))
+;  ((mapcar #'cook-enum (spec-enums spec)))
+;  (setf (spec-structs spec)
+;        (mapcar (lambda (x)
+;                  `(sb-alien:define-alien-type nil ,(cook-struct x)))
+;                (spec-structs spec)))
+;  (setf (spec-unions spec)
+;        (mapcar (lambda (x)
+;                  `(sb-alien:define-alien-type nil ,(cook-union x)))
+;                (spec-unions spec)))
+;  (setf (spec-functions spec) (mapcar #'cook-function (spec-functions spec)))
+;  spec)
 
 (defun to-json-file (code filename)
   (with-open-file (f filename