diff options
Diffstat (limited to 'cmamut.lisp')
| -rw-r--r-- | cmamut.lisp | 84 |
1 files changed, 41 insertions, 43 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index a5133a0..7e6c23c 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -4,24 +4,19 @@ ; Generate code that creates a package and puts all definitions there. ; To avoid collisions the created package shouldn't import any symbols. ; Only define functions from the target library, but get all other definitions. -; To reduce amount of names being generated, resolve all types to their base counterparts -; Separate generation, preprocessing and type resolution phases -; Preprocessing phase should handle enums, structs and unions -; Basic types are handled by type resolution phase -; Can put an error to default case in cook type to enforce type resolution ; TODO: Get constants from macro file generated by c2ffi -M ; 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 get-raw-spec (filename) + (json:from-file filename)) (defun cook-type (raw-type type-associations) (let ((tag (gethash "tag" raw-type))) (cond ((string= tag ":void") 'sb-alien:void) ((string= tag ":function-pointer") - 'sb-alien:function) + (list 'sb-alien:* t)) ((string= tag ":pointer") (let ((pointed-type (gethash "type" raw-type))) (cond ((string= (gethash "tag" pointed-type) ":char") @@ -31,7 +26,7 @@ (t (list 'sb-alien:* (cook-type pointed-type type-associations)))))) ((string= tag ":float") 'sb-alien:float) - ((string= tag ":double") + ((or (string= tag ":double") (string= tag ":long-double")) 'sb-alien:double) ((string= tag ":unsigned-char") 'sb-alien:unsigned-char) @@ -41,14 +36,18 @@ 'sb-alien:unsigned-int) ((string= tag ":unsigned-long") 'sb-alien:unsigned-long) + ((string= tag ":unsigned-long-long") + 'sb-alien:unsigned-long-long) ((or (string= tag ":char") (string= tag ":signed-char")) 'sb-alien:char) ((or (string= tag ":short") (string= tag ":signed-short")) 'sb-alien:short) - ((or (string= tag ":int") (string= tag ":signed-int")) + ((or (string= tag ":int") (string= tag ":signed-int") (char= (char tag 0) #\<)) 'sb-alien:int) ((or (string= tag ":long") (string= tag ":signed-long")) 'sb-alien:long) + ((or (string= tag ":long-long") (string= tag ":signed-long-long")) + 'sb-alien:long-long) ((string= tag ":array") (list 'sb-alien:array (cook-type (gethash "type" raw-type) type-associations) @@ -57,10 +56,14 @@ (list 'sb-alien:struct (intern (gethash "name" raw-type)))) ((string= tag ":union") (list 'sb-alien:union (intern (gethash "name" raw-type)))) + ((string= tag ":enum") + (list 'sb-alien:enum (gethash "name" raw-type))) ((string= tag "struct") - (cook-struct raw-type)) + (cook-struct raw-type type-associations)) ((string= tag "union") - (cook-union raw-type)) + (cook-union raw-type type-associations)) + ((string= tag "__builtin_va_list") + (list 'sb-alien:* t)) (t (let ((new-type (gethash tag type-associations))) (if new-type (cook-type new-type type-associations) @@ -71,7 +74,7 @@ (cooked-params (queue:new))) (dotimes (j (length raw-params)) (queue:add cooked-params - (list (intern (string-upcase (gethash "name" (aref raw-params j)))) + (list (intern (gethash "name" (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))) @@ -86,7 +89,7 @@ (cooked-fields (queue:new))) (dotimes (j (length raw-fields)) (queue:add cooked-fields - (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) + (list (intern (gethash "name" (aref raw-fields j))) (cook-type (gethash "type" (aref raw-fields j)) type-associations)))) `(sb-alien:struct ,(when (> (length (gethash "name" raw-struct)) 0) @@ -98,7 +101,7 @@ (cooked-fields (queue:new))) (dotimes (j (length raw-fields)) (queue:add cooked-fields - (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) + (list (intern (gethash "name" (aref raw-fields j))) (cook-type (gethash "type" (aref raw-fields j)) type-associations)))) `(sb-alien:union ,(when (> (length (gethash "name" raw-union)) 0) @@ -111,12 +114,12 @@ (cooked-fields (queue:new))) (dotimes (j (length raw-fields)) (queue:add cooked-fields - (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) + (list (intern (gethash "name" (aref raw-fields j))) (gethash "value" (aref raw-fields j))))) `(sb-alien:define-alien-type - ,name + nil (sb-alien:enum - nil + ,name ,@(queue:to-list cooked-fields))))) (defun generate-enum-references (raw-typedefs) @@ -128,7 +131,6 @@ (gethash "name" i))))) enum-references)) -; Generates a table for type resolution. ; Typedefs get "flattened" so that resolving is just a lookup. (defun generate-type-associations (raw-typedefs) (let ((type-associations (make-hash-table :test #'equal :size 256))) @@ -195,30 +197,20 @@ (push def (spec-unions 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 - :direction :output - :if-exists :supersede - :if-does-not-exist :create) - (let ((*print-length* nil) - (*print-level* nil)) - (format f "~{~a~&~}" (mapcar #'json:to-string code))))) +(defun codegen (spec) + (let ((enum-references (generate-enum-references (spec-typedefs spec))) + (type-associations (generate-type-associations (spec-typedefs spec)))) + (let ((enums (mapcar (lambda (x) (cook-enum x enum-references)) + (spec-enums spec))) + (structs (mapcar (lambda (x) + `(sb-alien:define-alien-type nil ,(cook-struct x type-associations))) + (spec-structs spec))) + (unions (mapcar (lambda (x) + `(sb-alien:define-alien-type nil ,(cook-union x type-associations))) + (spec-unions spec))) + (functions (mapcar (lambda (x) (cook-function x type-associations)) + (spec-functions spec)))) + (remove-duplicates (concatenate 'list enums structs unions functions) :test #'equal)))) (defun to-file (code filename) (with-open-file (f filename @@ -228,3 +220,9 @@ (let ((*print-length* nil) (*print-level* nil)) (format f "~{~s~&~}" code)))) + +(defun run (input output) + (let* ((raw-spec (get-raw-spec input)) + (spec (classify-definitions raw-spec)) + (code (codegen spec))) + (to-file code output))) |