From f37fc65a449f6e3166d987152e90599776fd32a6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= <jtomas1815@gmail.com>
Date: Mon, 30 Jan 2023 03:45:43 -0300
Subject: Implement enum generation

---
 cmamut.lisp | 39 +++++++++++++++++++--------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

(limited to 'cmamut.lisp')

diff --git a/cmamut.lisp b/cmamut.lisp
index 97db0f5..d572342 100644
--- a/cmamut.lisp
+++ b/cmamut.lisp
@@ -8,7 +8,7 @@
 ; Only define functions from the target library, but get all other definitions.
 
 ; TODO: Get constants from macro file generated by c2ffi -M
-; TODO: Generate enum definitions
+; TODO: Use c2ffi to extract the spec.json using the header file as parameter
 
 (defvar reference-table (make-hash-table :test #'equal :size 256))
 
@@ -61,7 +61,7 @@
         (cooked-params (queue:new)))
     (dotimes (j (length raw-params))
       (queue:add cooked-params
-                 (list (intern (gethash "name" (aref raw-params j)))
+                 (list (intern (string-upcase (gethash "name" (aref raw-params j))))
                        (cook-type (gethash "type" (aref raw-params j))))))
     `(sb-alien:define-alien-routine
        ,(let ((function-name (gethash "name" raw-function)))
@@ -81,7 +81,7 @@
     `(sb-alien:define-alien-type
        ,new-name
        ,(if enum?
-          `(enum ,new-name)
+          `(sb-alien:enum ,new-name)
           (cook-type base-type)))))
 
 (defun cook-struct (raw-struct)
@@ -89,7 +89,7 @@
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
-                 (list (intern (gethash "name" (aref raw-fields j)))
+                 (list (intern (string-upcase (gethash "name" (aref raw-fields j))))
                        (cook-type (gethash "type" (aref raw-fields j))))))
     `(sb-alien:struct
        ,(gethash "name" raw-struct)
@@ -100,16 +100,25 @@
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
-                 (list (intern (gethash "name" (aref raw-fields j)))
+                 (list (intern (string-upcase (gethash "name" (aref raw-fields j))))
                        (cook-type (gethash "type" (aref raw-fields j))))))
     `(sb-alien:union
        ,(gethash "name" raw-union)
        ,@(queue:to-list cooked-fields))))
 
-;(defun cook-enum (raw-enum)
-;  (let ((name (gethash (gethash "id" raw-enum) reference-table))
-;        (raw-fields (gethash "fields" raw-enum))
-;        (cooked-fields (queue:new)))
+(defun cook-enum (raw-enum)
+  (let ((name (gethash (gethash "id" raw-enum) reference-table))
+        (raw-fields (gethash "fields" raw-enum))
+        (cooked-fields (queue:new)))
+    (dotimes (j (length raw-fields))
+      (queue:add cooked-fields
+                 (list (intern (string-upcase (gethash "name" (aref raw-fields j))))
+                       (gethash "value" (aref raw-fields j)))))
+    `(sb-alien:define-alien-type
+       nil
+       (sb-alien:enum
+         ,name
+         ,@(queue:to-list cooked-fields)))))
 
 (defstruct spec
   functions
@@ -136,7 +145,7 @@
 ; typedefs must be generated first to build the reference table
     (setf (spec-typedefs s) (mapcar #'cook-typedef (spec-typedefs s)))
     (setf (spec-functions s) (mapcar #'cook-function (spec-functions s)))
-    ;(setf (spec-enums s) (mapcar #'cook-enum (spec-enums s)))
+    (setf (spec-enums s) (mapcar #'cook-enum (spec-enums s)))
     (setf (spec-structs s)
           (mapcar (lambda (x)
                     `(sb-alien:define-alien-type nil ,(cook-struct x)))
@@ -155,18 +164,8 @@
 ; definitions must be written in the following order to avoid "unknown type" errors
     (princ ";;; GENERATED BY CMAMUT" f)
     (terpri f)
-    (princ ";typedefs" f)
-    (terpri f)
     (format f "~{~s~&~}" (spec-typedefs spec))
-    (princ ";enums" f)
-    (terpri f)
     (format f "~{~s~&~}" (spec-enums spec))
-    (princ ";structs" f)
-    (terpri f)
     (format f "~{~s~&~}" (spec-structs spec))
-    (princ ";unions" f)
-    (terpri f)
     (format f "~{~s~&~}" (spec-unions spec))
-    (princ ";functions" f)
-    (terpri f)
     (format f "~{~s~&~}" (spec-functions spec))))
-- 
cgit v1.2.3