From 5b6d8d0eff3355fe2ab4b04938df72d2b24ea1e9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Sun, 23 Jul 2023 04:37:42 -0300 Subject: Change api and add some features --- cmamut.lisp | 65 ++++++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 41 insertions(+), 24 deletions(-) (limited to 'cmamut.lisp') diff --git a/cmamut.lisp b/cmamut.lisp index 8e43557..719f84e 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -2,7 +2,7 @@ (defparameter +target-package+ (gensym)) -; TODO: Handle cases where the header file cannot be found +; TODO: Handle cases where the header file cannot be found VERY IMPORTANT (defun get-raw-spec (filename) (sb-ext:run-program "/usr/bin/c2ffi" (list filename "--macro-file" "defines.h" @@ -74,7 +74,7 @@ (cook-type new-type type-associations) (error "Unknown type: ~a" tag))))))) -(defun cook-function (raw-function type-associations) +(defun cook-function (raw-function type-associations name-transformer) (let ((raw-params (gethash "parameters" raw-function)) (cooked-params (queue:new))) (dotimes (j (length raw-params)) @@ -85,7 +85,7 @@ (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 (funcall name-transformer function-name :function) +target-package+))) ,(cook-type (gethash "return-type" raw-function) type-associations) ,@(queue:to-list cooked-params)))) @@ -94,19 +94,19 @@ (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 (string-upcase (gethash "name" (aref raw-fields j))) 'keyword) (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+)) ,@(queue:to-list cooked-fields)))) -(defun cook-const (raw-const) - `(defparameter - ,(intern (gethash "name" raw-const) +target-package+) +(defun cook-const (raw-const name-transformer) + `(defconstant + ,(intern (funcall name-transformer (gethash "name" raw-const) :const) +target-package+) ,(gethash "value" raw-const))) -(defun cook-enum (raw-enum enum-references) +(defun cook-enum (raw-enum enum-references name-transformer) (let ((name (if (> (gethash "id" raw-enum) 0) (gethash (gethash "id" raw-enum) enum-references) (gethash "name" raw-enum))) @@ -114,8 +114,8 @@ (cooked-fields (queue:new))) (dotimes (j (length raw-fields)) (queue:add cooked-fields - `(defparameter - ,(intern (gethash "name" (aref raw-fields j)) +target-package+) + `(defconstant + ,(intern (funcall name-transformer (gethash "name" (aref raw-fields j)) :const) +target-package+) ,(gethash "value" (aref raw-fields j))))) `(progn ,name @@ -235,21 +235,26 @@ (filter-deps comps-and-deps)) (reverse result))) -(defun codegen (spec function-filter) +; TODO: add missing name filtering of enum and composite types +(defun codegen (spec name-filter name-transformer) (let ((enum-references (generate-enum-references (spec-typedefs spec))) (type-associations (generate-type-associations (spec-typedefs spec)))) - (let ((consts (mapcar #'cook-const (spec-consts spec))) - (enums (mapcar (lambda (x) (cook-enum x enum-references)) + (let ((consts (mapcar (lambda (x) (cook-const x name-transformer)) + (remove-if (lambda (x) (funcall name-filter (gethash "name" x))) + (spec-consts spec)))) + (enums (mapcar (lambda (x) (cook-enum x enum-references name-transformer)) (spec-enums spec))) - (composite (mapcar (lambda (x) `(sb-alien:define-alien-type ,(cadr x) ,x)) + (composite (mapcar (lambda (x) + `(sb-alien:define-alien-type + ,(intern (funcall name-transformer (symbol-name (cadr x)) :composite) + +target-package+) + ,x)) (sort-composites-by-deps (mapcar (lambda (x) (cook-composite x type-associations)) (spec-composite spec))))) - (functions (mapcar (lambda (x) (cook-function x type-associations)) - (if function-filter - (remove-if-not (lambda (x) (funcall function-filter (gethash "name" x))) - (spec-functions spec)) - (spec-functions spec))))) + (functions (mapcar (lambda (x) (cook-function x type-associations name-transformer)) + (remove-if (lambda (x) (funcall name-filter (gethash "name" x))) + (spec-functions spec))))) (remove-duplicates (concatenate 'list consts enums composite functions) :test #'equal)))) (defun to-file (code filename) @@ -268,11 +273,23 @@ (1+ (or (position #\/ path :from-end t) -1)) (position #\. path))) -(defun run (input &optional function-filter) +(defun filter-directories (search-directories raw-spec) + (remove-if (lambda (x) + (and (notany (lambda (dir) + (let ((location (gethash "location" x))) + (or (string= dir location :end2 (min (length location) (length dir))) + (string= "defines.h" location :end2 (min (length location) (length "defines.h")))))) + search-directories) + (string/= (gethash "tag" x) "typedef"))) + raw-spec)) + +(defun run (path-to-header-file &key search-directories name-filter name-transformer) (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 (concatenate 'string (file-name input) ".lisp"))) + (let* ((raw-spec (get-raw-spec path-to-header-file)) + (spec (classify-definitions (filter-directories search-directories raw-spec))) + (code (codegen spec + (or name-filter (lambda (name) nil)) + (or name-transformer (lambda (name kind) name))))) + (to-file code (concatenate 'string (file-name path-to-header-file) ".lisp"))) (delete-package (find-package +target-package+))) -- cgit v1.2.3