summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan Manuel Tomás <jtomas1815@gmail.com>2023-07-23 04:37:42 -0300
committerJuan Manuel Tomás <jtomas1815@gmail.com>2023-07-23 04:37:42 -0300
commit5b6d8d0eff3355fe2ab4b04938df72d2b24ea1e9 (patch)
tree32263b727dc8d3140aa43f88be86792ad0ba2a80
parent7c99df20cf7419e311204dedaf6b559918e704f3 (diff)
downloadcmamut-5b6d8d0eff3355fe2ab4b04938df72d2b24ea1e9.tar.gz
cmamut-5b6d8d0eff3355fe2ab4b04938df72d2b24ea1e9.zip
Change api and add some features
-rw-r--r--cmamut.lisp65
-rw-r--r--package.lisp3
2 files changed, 43 insertions, 25 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+)))
diff --git a/package.lisp b/package.lisp
index 3431e2b..477d049 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,2 +1,3 @@
(defpackage #:cmamut
- (:use #:cl))
+ (:use #:cl)
+ (:export #:run))