diff options
Diffstat (limited to 'cmamut.lisp')
| -rw-r--r-- | cmamut.lisp | 52 |
1 files changed, 27 insertions, 25 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index 2a3e47a..a132744 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -38,20 +38,20 @@ 'sb-alien:unsigned-int) ((string= tag ":unsigned-long") 'sb-alien:unsigned-long) - ((string= tag ":char") + ((or (string= tag ":char") (string= tag ":signed-char")) 'sb-alien:char) - ((string= tag ":short") + ((or (string= tag ":short") (string= tag ":signed-short")) 'sb-alien:short) - ((string= tag ":int") + ((or (string= tag ":int") (string= tag ":signed-int")) 'sb-alien:int) - ((string= tag ":long") + ((or (string= tag ":long") (string= tag ":signed-long")) 'sb-alien:long) ((string= tag ":array") (cook-array raw-type)) ((string= tag ":struct") - (list 'sb-alien:struct (gethash "name" raw-type))) + (list 'sb-alien:struct (intern (gethash "name" raw-type)))) ((string= tag ":union") - (list 'sb-alien:union (gethash "name" raw-type))) + (list 'sb-alien:union (intern (gethash "name" raw-type)))) ((string= tag "struct") (cook-struct raw-type)) ((string= tag "union") @@ -80,16 +80,13 @@ (defun cook-typedef (raw-typedef) (let* ((base-type (gethash "type" raw-typedef)) - (new-name (gethash "name" raw-typedef)) - (enum? (string= (gethash "tag" base-type) ":enum"))) - (when enum? + (new-name (gethash "name" raw-typedef))) + (if (string= (gethash "tag" base-type) ":enum") (setf (gethash (gethash "id" base-type) reference-table) - new-name)) - `(sb-alien:define-alien-type - ,new-name - ,(if enum? - `(sb-alien:enum ,new-name) - (cook-type base-type))))) + new-name) + `(sb-alien:define-alien-type + ,new-name + ,(cook-type base-type))))) (defun cook-struct (raw-struct) (let ((raw-fields (gethash "fields" raw-struct)) @@ -99,7 +96,7 @@ (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) + ,(intern (gethash "name" raw-struct)) ,@(queue:to-list cooked-fields)))) (defun cook-union (raw-union) @@ -110,7 +107,7 @@ (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) + ,(intern (gethash "name" raw-union)) ,@(queue:to-list cooked-fields)))) (defun cook-enum (raw-enum) @@ -122,9 +119,9 @@ (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) (gethash "value" (aref raw-fields j))))) `(sb-alien:define-alien-type - nil + ,name (sb-alien:enum - ,name + nil ,@(queue:to-list cooked-fields))))) (defstruct spec @@ -166,12 +163,17 @@ (defun to-file (spec filename) (with-open-file (f filename :direction :output - :if-exists :overwrite + :if-exists :supersede :if-does-not-exist :create) (princ ";;; GENERATED BY CMAMUT" f) (terpri f) - (format f "~{~s~&~}" (spec-enums spec)) - (format f "~{~s~&~}" (spec-typedefs spec)) - (format f "~{~s~&~}" (spec-structs spec)) - (format f "~{~s~&~}" (spec-unions spec)) - (format f "~{~s~&~}" (spec-functions spec)))) + (let ((*print-length* nil) + (*print-level* nil)) + (format f "~{~s~&~}" (spec-enums spec)) + (format f "~{~s~&~}" (spec-typedefs spec))))) + ;(format f "~{~s~&~}" (spec-structs spec)) + ;(format f "~{~s~&~}" (spec-unions spec)) + ;(format f "~{~s~&~}" (spec-functions spec))))) + +(defun generate (filename) + (to-file (prepare-spec (get-spec)) filename)) |