diff options
Diffstat (limited to 'cmamut.lisp')
| -rw-r--r-- | cmamut.lisp | 37 |
1 files changed, 20 insertions, 17 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index 4f39b05..f1bd327 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -2,7 +2,7 @@ ; TODO: Use c2ffi to extract the spec.json using the header file as parameter -(defvar *target-package* *package*) +(defparameter +target-package+ (gensym)) (defun get-raw-spec (filename) (json:from-file filename)) @@ -49,9 +49,9 @@ (cook-type (gethash "type" raw-type) type-associations) (gethash "size" raw-type))) ((string= tag ":struct") - (list 'sb-alien:struct (intern (gethash "name" raw-type) *target-package*))) + (list 'sb-alien:struct (intern (gethash "name" raw-type) +target-package+))) ((string= tag ":union") - (list 'sb-alien:union (intern (gethash "name" raw-type) *target-package*))) + (list 'sb-alien:union (intern (gethash "name" raw-type) +target-package+))) ((string= tag ":enum") (list 'sb-alien:enum (gethash "name" raw-type))) ((or (string= tag "struct") (string= tag "union")) @@ -70,11 +70,11 @@ (queue:add cooked-params (list (if (string= (gethash "name" (aref raw-params j)) "") (gensym) - (intern (gethash "name" (aref raw-params j)) *target-package*)) + (intern (gethash "name" (aref raw-params j)) +target-package+)) (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 function-name +target-package+))) ,(cook-type (gethash "return-type" raw-function) type-associations) ,@(queue:to-list cooked-params)))) @@ -83,16 +83,16 @@ (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 (gethash "name" (aref raw-fields j)) +target-package+) (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*)) + (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*) + ,(intern (gethash "name" raw-const) +target-package+) ,(gethash "value" raw-const))) (defun cook-enum (raw-enum enum-references) @@ -101,7 +101,7 @@ (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 (gethash "name" (aref raw-fields j)) +target-package+) (gethash "value" (aref raw-fields j))))) `(sb-alien:define-alien-type nil @@ -235,7 +235,9 @@ (mapcar (lambda (x) (cook-composite x type-associations)) (spec-composite spec))))) (functions (mapcar (lambda (x) (cook-function x type-associations)) - (remove-if-not function-filter (spec-functions spec))))) + (if function-filter + (remove-if-not function-filter (spec-functions spec)) + (spec-functions spec))))) (remove-duplicates (concatenate 'list consts enums composite functions) :test #'equal)))) (defun to-file (code filename) @@ -244,15 +246,16 @@ :if-exists :supersede :if-does-not-exist :create) (let ((*print-length* nil) - (*print-level* nil)) - (format f "(defpackage #~s)~&" *target-package*) + (*print-level* nil) + (*print-pretty* nil) + (*package* (find-package +target-package+))) (format f "~{~s~&~}" code)))) -(defun run (input output pkg &optional function-filter) - (setf *target-package* pkg) - (when (not (find-package *target-package*)) - (make-package *target-package*)) +(defun run (input output &optional function-filter) + (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 output))) + (to-file code output)) + (delete-package (find-package +target-package+))) |