diff options
Diffstat (limited to 'cmamut.lisp')
| -rw-r--r-- | cmamut.lisp | 128 |
1 files changed, 90 insertions, 38 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index a132744..bacca56 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -2,15 +2,19 @@ ; Ideas: ; Generate code that creates a package and puts all definitions there. -; If symbol names are unaltered we can skip connecting everything together. ; To avoid collisions the created package shouldn't import any symbols. -; Maybe use straight defuns and ffi functions to get as close as possible to the C names without much work. ; 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 -(defvar reference-table (make-hash-table :test #'equal :size 256)) +(defvar enum-references (make-hash-table :test #'equal :size 256)) +(defvar type-associations (make-hash-table :test #'equal :size 256)) (defun get-spec () (json:from-file "~/common-lisp/cmamut/spec.json")) @@ -23,9 +27,11 @@ 'sb-alien:function) ((string= tag ":pointer") (let ((pointed-type (gethash "type" raw-type))) - (if (string= (gethash "tag" pointed-type) ":char") - 'sb-alien:c-string - (list 'sb-alien:* (cook-type pointed-type))))) + (cond ((string= (gethash "tag" pointed-type) ":char") + 'sb-alien:c-string) + ((string= (gethash "tag" pointed-type) ":void") + (list 'sb-alien:* t)) + (t (list 'sb-alien:* (cook-type pointed-type)))))) ((string= tag ":float") 'sb-alien:float) ((string= tag ":double") @@ -47,7 +53,9 @@ ((or (string= tag ":long") (string= tag ":signed-long")) 'sb-alien:long) ((string= tag ":array") - (cook-array raw-type)) + (list 'sb-alien:array + (cook-type (gethash "type" raw-type)) + (gethash "size" raw-type))) ((string= tag ":struct") (list 'sb-alien:struct (intern (gethash "name" raw-type)))) ((string= tag ":union") @@ -56,12 +64,13 @@ (cook-struct raw-type)) ((string= tag "union") (cook-union raw-type)) - (t tag)))) - -(defun cook-array (raw-array) - `(sb-alien:array - ,(cook-type (gethash "type" raw-array)) - ,(gethash "size" raw-array))) + (t + (let ((new-tag (gethash tag type-associations))) + (if new-tag + (progn + (setf (gethash "tag" raw-type) new-tag) + (cook-type raw-type)) + (error (format nil "Unknown type tag ~a" tag)))))))) (defun cook-function (raw-function &optional name-transformer) (let ((raw-params (gethash "parameters" raw-function)) @@ -82,8 +91,7 @@ (let* ((base-type (gethash "type" raw-typedef)) (new-name (gethash "name" raw-typedef))) (if (string= (gethash "tag" base-type) ":enum") - (setf (gethash (gethash "id" base-type) reference-table) - new-name) + (progn (setf (gethash (gethash "id" base-type) enum-references) new-name) nil) `(sb-alien:define-alien-type ,new-name ,(cook-type base-type))))) @@ -96,7 +104,8 @@ (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) (cook-type (gethash "type" (aref raw-fields j)))))) `(sb-alien:struct - ,(intern (gethash "name" raw-struct)) + ,(when (> (length (gethash "name" raw-struct)) 0) + (intern (gethash "name" raw-struct))) ,@(queue:to-list cooked-fields)))) (defun cook-union (raw-union) @@ -107,11 +116,12 @@ (list (intern (string-upcase (gethash "name" (aref raw-fields j)))) (cook-type (gethash "type" (aref raw-fields j)))))) `(sb-alien:union - ,(intern (gethash "name" raw-union)) + ,(when (> (length (gethash "name" raw-union)) 0) + (intern (gethash "name" raw-union))) ,@(queue:to-list cooked-fields)))) (defun cook-enum (raw-enum) - (let ((name (gethash (gethash "id" raw-enum) reference-table)) + (let ((name (gethash (gethash "id" raw-enum) enum-references)) (raw-fields (gethash "fields" raw-enum)) (cooked-fields (queue:new))) (dotimes (j (length raw-fields)) @@ -124,6 +134,47 @@ nil ,@(queue:to-list cooked-fields))))) +(defun filter-base-types (raw-typedefs) + (clrhash type-associations) + (setf (gethash ":char" type-associations) t) + (setf (gethash ":short" type-associations) t) + (setf (gethash ":int" type-associations) t) + (setf (gethash ":long" type-associations) t) + (setf (gethash ":signed-char" type-associations) t) + (setf (gethash ":signed-short" type-associations) t) + (setf (gethash ":signed-int" type-associations) t) + (setf (gethash ":signed-long" type-associations) t) + (setf (gethash ":unsigned-char" type-associations) t) + (setf (gethash ":unsigned-short" type-associations) t) + (setf (gethash ":unsigned-int" type-associations) t) + (setf (gethash ":unsigned-long" type-associations) t) + (setf (gethash ":float" type-associations) t) + (setf (gethash ":double" type-associations) t) + (setf (gethash ":function-pointer" type-associations) t) + (labels ((take-deps + (deps) + (let (remaining) + (dolist (i deps) + (let ((tag (gethash "tag" (gethash "type" i)))) + (if (gethash tag type-associations) + (setf (gethash (gethash "name" i) type-associations) tag) + (push i remaining)))) + (if (= (length deps) (length remaining)) + remaining + (take-deps remaining))))) + (let ((result (take-deps raw-typedefs))) + (labels ((associate-base-type + (k v) + (let ((new-v (gethash v type-associations))) + (if (eq new-v t) + (setf (gethash k type-associations) v) + (associate-base-type k new-v))))) + (maphash (lambda (k v) + (unless (eq v t) + (associate-base-type k v))) + type-associations)) + result))) + (defstruct spec functions typedefs @@ -131,8 +182,7 @@ unions enums) -(defun prepare-spec (spec) - (clrhash reference-table) +(defun classify-definitions (spec) (let ((s (make-spec))) (dotimes (i (length spec)) (cond ((string= (gethash "tag" (aref spec i)) "function") @@ -146,20 +196,25 @@ ((string= (gethash "tag" (aref spec i)) "union") (push (aref spec i) (spec-unions s))) (t))) -; typedefs must be generated first to build the reference table - (setf (spec-typedefs s) (mapcar #'cook-typedef (spec-typedefs s))) - (setf (spec-functions s) (mapcar #'cook-function (spec-functions s))) - (setf (spec-enums s) (mapcar #'cook-enum (spec-enums s))) - (setf (spec-structs s) - (mapcar (lambda (x) - `(sb-alien:define-alien-type nil ,(cook-struct x))) - (spec-structs s))) - (setf (spec-unions s) - (mapcar (lambda (x) - `(sb-alien:define-alien-type nil ,(cook-union x))) - (spec-unions s))) s)) +(defun codegen (spec) + (clrhash enum-references) + ; typedefs must be generated first to build the reference table + (setf (spec-typedefs spec) + (remove nil (mapcar #'cook-typedef (filter-base-types (spec-typedefs spec))))) + (setf (spec-functions spec) (mapcar #'cook-function (spec-functions spec))) + (setf (spec-enums spec) (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))) + spec) + (defun to-file (spec filename) (with-open-file (f filename :direction :output @@ -171,9 +226,6 @@ (*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)) +;(format f "~{~s~&~}" (spec-structs spec)) +;(format f "~{~s~&~}" (spec-unions spec)) +;(format f "~{~s~&~}" (spec-functions spec))))) |