Change api and add some features

1 files changed, 41 insertions, 24 deletions

diff --git a/cmamut.lisp b/cmamut.lisp
index 8e43557..719f84e 100644
--- a/cmamut.lisp
+++ b/cmamut.lisp
@@ -2,7 +2,7 @@
 
 (defparameter +target-package+ (gensym))
 
-; TODO: Handle cases where the header file cannot be found
+; TODO: Handle cases where the header file cannot be found VERY IMPORTANT
 (defun get-raw-spec (filename)
   (sb-ext:run-program "/usr/bin/c2ffi" (list filename
                                              "--macro-file" "defines.h"
@@ -74,7 +74,7 @@
                  (cook-type new-type type-associations)
                  (error "Unknown type: ~a" tag)))))))
 
-(defun cook-function (raw-function type-associations)
+(defun cook-function (raw-function type-associations name-transformer)
   (let ((raw-params (gethash "parameters" raw-function))
         (cooked-params (queue:new)))
     (dotimes (j (length raw-params))
@@ -85,7 +85,7 @@
                        (cook-type (gethash "type" (aref raw-params j)) type-associations))))
     `(sb-alien:define-alien-routine
        ,(let ((function-name (gethash "name" raw-function)))
-          (list function-name (intern function-name +target-package+)))
+          (list function-name (intern (funcall name-transformer function-name :function) +target-package+)))
        ,(cook-type (gethash "return-type" raw-function) type-associations)
        ,@(queue:to-list cooked-params))))
 
@@ -94,19 +94,19 @@
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
-                 (list (intern (gethash "name" (aref raw-fields j)) +target-package+)
+                 (list (intern (string-upcase (gethash "name" (aref raw-fields j))) 'keyword)
                        (cook-type (gethash "type" (aref raw-fields j)) type-associations))))
     `(,(intern (string-upcase (gethash "tag" raw-composite)) 'sb-alien)
        ,(when (> (length (gethash "name" raw-composite)) 0)
           (intern (gethash "name" raw-composite) +target-package+))
        ,@(queue:to-list cooked-fields))))
 
-(defun cook-const (raw-const)
-  `(defparameter
-     ,(intern (gethash "name" raw-const) +target-package+)
+(defun cook-const (raw-const name-transformer)
+  `(defconstant
+     ,(intern (funcall name-transformer (gethash "name" raw-const) :const) +target-package+)
      ,(gethash "value" raw-const)))
 
-(defun cook-enum (raw-enum enum-references)
+(defun cook-enum (raw-enum enum-references name-transformer)
   (let ((name (if (> (gethash "id" raw-enum) 0)
                 (gethash (gethash "id" raw-enum) enum-references)
                 (gethash "name" raw-enum)))
@@ -114,8 +114,8 @@
         (cooked-fields (queue:new)))
     (dotimes (j (length raw-fields))
       (queue:add cooked-fields
-                 `(defparameter
-                    ,(intern (gethash "name" (aref raw-fields j)) +target-package+)
+                 `(defconstant
+                    ,(intern (funcall name-transformer (gethash "name" (aref raw-fields j)) :const) +target-package+)
                     ,(gethash "value" (aref raw-fields j)))))
     `(progn
        ,name
@@ -235,21 +235,26 @@
       (filter-deps comps-and-deps))
     (reverse result)))
 
-(defun codegen (spec function-filter)
+; TODO: add missing name filtering of enum and composite types
+(defun codegen (spec name-filter name-transformer)
   (let ((enum-references (generate-enum-references (spec-typedefs spec)))
         (type-associations (generate-type-associations (spec-typedefs spec))))
-    (let ((consts (mapcar #'cook-const (spec-consts spec)))
-          (enums (mapcar (lambda (x) (cook-enum x enum-references))
+    (let ((consts (mapcar (lambda (x) (cook-const x name-transformer))
+                          (remove-if (lambda (x) (funcall name-filter (gethash "name" x)))
+                                     (spec-consts spec))))
+          (enums (mapcar (lambda (x) (cook-enum x enum-references name-transformer))
                          (spec-enums spec)))
-          (composite (mapcar (lambda (x) `(sb-alien:define-alien-type ,(cadr x) ,x))
+          (composite (mapcar (lambda (x)
+                               `(sb-alien:define-alien-type
+                                  ,(intern (funcall name-transformer (symbol-name (cadr x)) :composite)
+                                           +target-package+)
+                                  ,x))
                              (sort-composites-by-deps
                                (mapcar (lambda (x) (cook-composite x type-associations))
                                        (spec-composite spec)))))
-          (functions (mapcar (lambda (x) (cook-function x type-associations))
-                             (if function-filter
-                               (remove-if-not (lambda (x) (funcall function-filter (gethash "name" x)))
-                                              (spec-functions spec))
-                               (spec-functions spec)))))
+          (functions (mapcar (lambda (x) (cook-function x type-associations name-transformer))
+                               (remove-if (lambda (x) (funcall name-filter (gethash "name" x)))
+                                              (spec-functions spec)))))
       (remove-duplicates (concatenate 'list consts enums composite functions) :test #'equal))))
 
 (defun to-file (code filename)
@@ -268,11 +273,23 @@
           (1+ (or (position #\/ path :from-end t) -1))
           (position #\. path)))
 
-(defun run (input &optional function-filter)
+(defun filter-directories (search-directories raw-spec)
+  (remove-if (lambda (x)
+               (and (notany (lambda (dir)
+                              (let ((location (gethash "location" x)))
+                                (or (string= dir location :end2 (min (length location) (length dir)))
+                                    (string= "defines.h" location :end2 (min (length location) (length "defines.h"))))))
+                            search-directories)
+                    (string/= (gethash "tag" x) "typedef")))
+             raw-spec))
+
+(defun run (path-to-header-file &key search-directories name-filter name-transformer)
   (when (not (find-package +target-package+))
     (make-package +target-package+))
-  (let* ((raw-spec (get-raw-spec input))
-         (spec (classify-definitions raw-spec))
-         (code (codegen spec function-filter)))
-    (to-file code (concatenate 'string (file-name input) ".lisp")))
+  (let* ((raw-spec (get-raw-spec path-to-header-file))
+         (spec (classify-definitions (filter-directories search-directories raw-spec)))
+         (code (codegen spec
+                        (or name-filter (lambda (name) nil))
+                        (or name-transformer (lambda (name kind) name)))))
+    (to-file code (concatenate 'string (file-name path-to-header-file) ".lisp")))
   (delete-package (find-package +target-package+)))