diff options
| -rw-r--r-- | cmamut.lisp | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/cmamut.lisp b/cmamut.lisp index 4ecfda6..17b01c2 100644 --- a/cmamut.lisp +++ b/cmamut.lisp @@ -261,16 +261,24 @@ (spec-functions spec)))) (remove-duplicates (concatenate 'list consts enums composite functions) :test #'equal)))) -(defun to-file (code filename) +(defun to-file (code filename pkg-name shared-object) (with-open-file (f filename :direction :output :if-exists :supersede :if-does-not-exist :create) (let ((*print-length* nil) (*print-level* nil) - (*print-pretty* nil) + (*print-pretty* t) (*package* (find-package +target-package+))) - (format f "~{~s~&~}" code)))) + (when shared-object + (format f + "(COMMON-LISP:LET ((LOADED? COMMON-LISP:NIL))~& (SB-ALIEN:LOAD-SHARED-OBJECT ~s)~& (COMMON-LISP:SETF LOADED? COMMON-LISP:T))~&" + shared-object)) + (when pkg-name + (format f "(COMMON-LISP:DEFPACKAGE #:~a)~&" (string-upcase pkg-name)) + (format f "(COMMON-LISP:IN-PACKAGE #:~a)~&" (string-upcase pkg-name))) + (format f "~{~s~&~}" code) + (do-symbols (s *package*) (format f "(COMMON-LISP:EXPORT '~s)~&" s))))) (defun filter-directories (search-directories raw-spec) (remove-if (lambda (x) @@ -282,7 +290,7 @@ (string/= (gethash "tag" x) "const"))) raw-spec)) -(defun run (path-to-header-file &key additional-directories name-transformer) +(defun run (path-to-header-file &key package-name shared-object additional-directories name-transformer) (unless (probe-file path-to-header-file) (error (format t "The header file ~a doesn't exist!" path-to-header-file))) (when (not (find-package +target-package+)) @@ -292,5 +300,5 @@ (let* ((raw-spec (get-raw-spec (namestring path-to-header-file) additional-directories)) (spec (classify-definitions (filter-directories additional-directories raw-spec))) (code (codegen spec (or name-transformer (lambda (name kind) name))))) - (to-file code (concatenate 'string (pathname-name path-to-header-file) ".lisp"))) + (to-file code (concatenate 'string (pathname-name path-to-header-file) ".lisp") package-name shared-object)) (delete-package (find-package +target-package+))) |