diff options
Diffstat (limited to 'cmamut.lisp')
| -rw-r--r-- | cmamut.lisp | 171 |
1 files changed, 171 insertions, 0 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index 7b64756..97db0f5 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -1 +1,172 @@ (in-package #:cmamut) + +; 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. + +; TODO: Get constants from macro file generated by c2ffi -M +; TODO: Generate enum definitions + +(defvar reference-table (make-hash-table :test #'equal :size 256)) + +(defun get-spec () + (json:from-file "~/common-lisp/cmamut/spec.json")) + +(defun cook-type (raw-type) + (let ((tag (gethash "tag" raw-type))) + (cond ((string= tag ":void") + 'sb-alien:void) + ((string= tag ":function-pointer") + '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))))) + ((string= tag ":float") + 'sb-alien:float) + ((string= tag ":double") + 'sb-alien:double) + ((string= tag ":unsigned-char") + 'sb-alien:unsigned-char) + ((string= tag ":unsigned-short") + 'sb-alien:unsigned-short) + ((string= tag ":unsigned-int") + 'sb-alien:unsigned-int) + ((string= tag ":unsigned-long") + 'sb-alien:unsigned-long) + ((string= tag ":char") + 'sb-alien:char) + ((string= tag ":short") + 'sb-alien:short) + ((string= tag ":int") + 'sb-alien:int) + ((string= tag ":long") + 'sb-alien:long) + ((string= tag ":struct") + (list 'sb-alien:struct (gethash "name" raw-type))) + ((string= tag ":union") + (list 'sb-alien:union (gethash "name" raw-type))) + ((string= tag "struct") + (cook-struct raw-type)) + ((string= tag "union") + (cook-union raw-type)) + (t tag)))) + +(defun cook-function (raw-function &optional name-transformer) + (let ((raw-params (gethash "parameters" raw-function)) + (cooked-params (queue:new))) + (dotimes (j (length raw-params)) + (queue:add cooked-params + (list (intern (gethash "name" (aref raw-params j))) + (cook-type (gethash "type" (aref raw-params j)))))) + `(sb-alien:define-alien-routine + ,(let ((function-name (gethash "name" raw-function))) + (if name-transformer + (list function-name (funcall name-transformer function-name)) + function-name)) + ,(cook-type (gethash "return-type" raw-function)) + ,@(queue:to-list cooked-params)))) + +(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? + (setf (gethash (gethash "id" base-type) reference-table) + new-name)) + `(sb-alien:define-alien-type + ,new-name + ,(if enum? + `(enum ,new-name) + (cook-type base-type))))) + +(defun cook-struct (raw-struct) + (let ((raw-fields (gethash "fields" raw-struct)) + (cooked-fields (queue:new))) + (dotimes (j (length raw-fields)) + (queue:add cooked-fields + (list (intern (gethash "name" (aref raw-fields j))) + (cook-type (gethash "type" (aref raw-fields j)))))) + `(sb-alien:struct + ,(gethash "name" raw-struct) + ,@(queue:to-list cooked-fields)))) + +(defun cook-union (raw-union) + (let ((raw-fields (gethash "fields" raw-union)) + (cooked-fields (queue:new))) + (dotimes (j (length raw-fields)) + (queue:add cooked-fields + (list (intern (gethash "name" (aref raw-fields j))) + (cook-type (gethash "type" (aref raw-fields j)))))) + `(sb-alien:union + ,(gethash "name" raw-union) + ,@(queue:to-list cooked-fields)))) + +;(defun cook-enum (raw-enum) +; (let ((name (gethash (gethash "id" raw-enum) reference-table)) +; (raw-fields (gethash "fields" raw-enum)) +; (cooked-fields (queue:new))) + +(defstruct spec + functions + typedefs + structs + unions + enums) + +(defun prepare-spec (spec) + (clrhash reference-table) + (let ((s (make-spec))) + (dotimes (i (length spec)) + (cond ((string= (gethash "tag" (aref spec i)) "function") + (push (aref spec i) (spec-functions s))) + ((string= (gethash "tag" (aref spec i)) "typedef") + (push (aref spec i) (spec-typedefs s))) + ((string= (gethash "tag" (aref spec i)) "struct") + (push (aref spec i) (spec-structs s))) + ((string= (gethash "tag" (aref spec i)) "enum") + (push (aref spec i) (spec-enums s))) + ((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 to-file (spec filename) + (with-open-file (f filename + :direction :output + :if-exists :overwrite + :if-does-not-exist :create) +; definitions must be written in the following order to avoid "unknown type" errors + (princ ";;; GENERATED BY CMAMUT" f) + (terpri f) + (princ ";typedefs" f) + (terpri f) + (format f "~{~s~&~}" (spec-typedefs spec)) + (princ ";enums" f) + (terpri f) + (format f "~{~s~&~}" (spec-enums spec)) + (princ ";structs" f) + (terpri f) + (format f "~{~s~&~}" (spec-structs spec)) + (princ ";unions" f) + (terpri f) + (format f "~{~s~&~}" (spec-unions spec)) + (princ ";functions" f) + (terpri f) + (format f "~{~s~&~}" (spec-functions spec)))) |