Started refactoring
Sun Sep 3 06:48:04 PDT 2006 Daniel Dickison (danieldickison@gmail.com)
* Started refactoring
In an effort to eventually get a CFFI backend in place, I've started moving the code around into separate files.
diff -rN -u old-c2ffi/C-to-FFI.lisp new-c2ffi/C-to-FFI.lisp
--- old-c2ffi/C-to-FFI.lisp 2014-07-31 04:29:45.000000000 -0700
+++ new-c2ffi/C-to-FFI.lisp 2014-07-31 04:29:45.000000000 -0700
@@ -8,9 +8,8 @@
eval-defs
write-defs))
-#+:openmcl
-(defun make-uffi-for-files (dir &optional gcc-opts-file)
- (format *terminal-io* "~&~%Running: ~S~%Options: ~S~%" *gccxml-command-path* (truename gcc-opts-file))
+(defun make-uffi-for-files (dir &key gcc-options-file (in-package *package*))
+ (format *terminal-io* "~&~%Running: ~S~%Options: ~S~%" *gccxml-command-path* (truename gcc-options-file))
(dolist (infile (directory dir))
(let ((xmlfile (make-pathname :type "xml"
:directory (append (pathname-directory infile) '("XML"))
@@ -23,108 +22,35 @@
(format *terminal-io* "~&~%Input: ~S~%XML: ~S~%UFFI: ~S~%" infile xmlfile lispfile)
;; Run GCC-XML.
- (ccl:run-program (namestring *gccxml-command-path*)
- (list* (namestring infile)
- (namestring xmlfile)
- (when gcc-opts-file
- (list (namestring (truename gcc-opts-file)))))
- :output *terminal-io*
- :error *terminal-io*)
+ (generate-xml infile xmlfile gcc-options-file)
;; Run the XML parser and UFFI generator.
(let ((xml (parse-header-xml xmlfile)))
(write-defs (make-uffi-defs xml)
- lispfile)))))
+ lispfile
+ :in-package in-package)))))
-(defun write-defs (defs filepath &key in-package)
+(defun write-defs (defs filepath &key (in-package *package*))
(with-open-file (f filepath
:direction :output
:if-exists :supersede)
(when in-package
- (prin1 `(in-package ,(package-name (find-package in-package))) f)
+ (write `(in-package ,(if (packagep in-package)
+ (package-name in-package)
+ in-package))
+ :stream f :readably t :escape t :level nil :lines nil :pretty t)
(terpri f))
(dolist (def defs)
- (prin1 def f)
+ (write def
+ :stream f :readably t :escape t :level nil :lines nil :pretty t)
(terpri f))))
(defun eval-defs (defs)
(eval (cons 'progn defs)))
-(defun make-uffi-defs (root)
- "Returns a list of UFFI definitions, in the order of:
- 1. typedefs and enums
- 2. structs
- 3. functions"
- (id-mappings root)
- (iter
- (with ignore-files = (ignore-files root))
- (for node in (node-children root))
- (unless (member (node-attribute "file" node)
- ignore-files :test #'equal)
- (case (intern (node-name node) :keyword)
- (:|Function| (collect (function-generator node)
- into functions))
- (:|Typedef| (collect (typedef-generator node)
- into typedefs))
- (:|Enumeration| (collect (enum-generator node)
- into typedefs))
- (:|Struct| (collect (struct-generator node root)
- into structs)))
- (finally
- (format *terminal-io* "~&Generated:~@
- ~5@A typedefs and enums~@
- ~5@A structs~@
- ~5@A functions~%"
- (length typedefs) (length structs) (length functions))
- (return (nconc typedefs structs functions))))))
-
-(defun ignore-files (root)
- (let ((files (find-in-tree root "File" () :all t)))
- (iter
- (for file in files)
- (when (string-find (node-attribute "name" file)
- "gccxml")
- (collect (node-attribute "id" file))))))
-
-(defun function-generator (node)
- `(uffi:def-function
- ,(get-name-with-id (node-attribute "id" node))
- ,(iter
- (for arg in (find-in-tree node "Argument" () :all t))
- (collect (list (intern (string-upcase (node-attribute "name" arg)))
- (get-type-with-id (node-attribute "type" arg)))))
- :returning ,(get-type-with-id (node-attribute "returns" node))))
-
-(defun typedef-generator (node)
- `(uffi:def-foreign-type
- ,(get-name-symbol (node-attribute "id" node))
- ,(get-type-with-id (node-attribute "type" node))))
-
-(defun enum-generator (node)
- `(uffi:def-enum
- ,(get-name-symbol (node-attribute "id" node))
- ,(iter
- (for val in (find-in-tree node "EnumValue" () :all t))
- (collect (list
- (intern (string-upcase (node-attribute "name" val)))
- (parse-integer (node-attribute "init" val)))))))
-
-(defun struct-generator (node root)
- `(uffi:def-struct
- ,(get-name-symbol (node-attribute "id" node))
- ,@(iter
- (for field-id in (split-sequence #\space (node-attribute "members" node)
- :remove-empty-subseqs t))
- (for field = (find-in-tree root "Field" `(("id" ,field-id))))
- (when field
- (collect (list
- (intern (string-upcase (node-attribute "name" field)))
- (get-type-with-id (node-attribute "type" field))))))))
-
-
;;;;;;;;;;;; Types and Names ;;;;;;;;;;;;
diff -rN -u old-c2ffi/GCC-XML.lisp new-c2ffi/GCC-XML.lisp
--- old-c2ffi/GCC-XML.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-c2ffi/GCC-XML.lisp 2014-07-31 04:29:45.000000000 -0700
@@ -0,0 +1,12 @@
+(in-package :c2ffi)
+
+(export '(generate-xml))
+
+(defun generate-xml (h-file xml-file &optional gcc-opts-file)
+ (ccl:run-program (namestring *gccxml-command-path*)
+ (list* (namestring (truename h-file))
+ (namestring xml-file)
+ (when gcc-opts-file
+ (list (namestring (truename gcc-opts-file)))))
+ :output *terminal-io*
+ :error *error-output*))
\ No newline at end of file
diff -rN -u old-c2ffi/UFFI-Generator.lisp new-c2ffi/UFFI-Generator.lisp
--- old-c2ffi/UFFI-Generator.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-c2ffi/UFFI-Generator.lisp 2014-07-31 04:29:45.000000000 -0700
@@ -0,0 +1,75 @@
+(in-package :c2ffi)
+
+(export '(make-uffi-defs))
+
+
+(defun make-uffi-defs (root)
+ "Returns a list of UFFI definitions, in the order of:
+ 1. typedefs and enums
+ 2. structs
+ 3. functions"
+ (id-mappings root)
+ (iter
+ (with ignore-files = (ignore-files root))
+ (for node in (node-children root))
+ (unless (member (node-attribute "file" node)
+ ignore-files :test #'equal)
+ (case (intern (node-name node) :keyword)
+ (:|Function| (collect (function-generator node)
+ into functions))
+ (:|Typedef| (collect (typedef-generator node)
+ into typedefs))
+ (:|Enumeration| (collect (enum-generator node)
+ into typedefs))
+ (:|Struct| (collect (struct-generator node root)
+ into structs)))
+ (finally
+ (format *terminal-io* "~&Generated:~@
+ ~5@A typedefs and enums~@
+ ~5@A structs~@
+ ~5@A functions~%"
+ (length typedefs) (length structs) (length functions))
+ (return (nconc typedefs structs functions))))))
+
+(defun ignore-files (root)
+ (let ((files (find-in-tree root "File" () :all t)))
+ (iter
+ (for file in files)
+ (when (string-find (node-attribute "name" file)
+ "gccxml")
+ (collect (node-attribute "id" file))))))
+
+(defun function-generator (node)
+ `(uffi:def-function
+ ,(get-name-with-id (node-attribute "id" node))
+ ,(iter
+ (for arg in (find-in-tree node "Argument" () :all t))
+ (collect (list (intern (string-upcase (node-attribute "name" arg)))
+ (get-type-with-id (node-attribute "type" arg)))))
+ :returning ,(get-type-with-id (node-attribute "returns" node))))
+
+(defun typedef-generator (node)
+ `(uffi:def-foreign-type
+ ,(get-name-symbol (node-attribute "id" node))
+ ,(get-type-with-id (node-attribute "type" node))))
+
+(defun enum-generator (node)
+ `(uffi:def-enum
+ ,(get-name-symbol (node-attribute "id" node))
+ ,(iter
+ (for val in (find-in-tree node "EnumValue" () :all t))
+ (collect (list
+ (intern (string-upcase (node-attribute "name" val)))
+ (parse-integer (node-attribute "init" val)))))))
+
+(defun struct-generator (node root)
+ `(uffi:def-struct
+ ,(get-name-symbol (node-attribute "id" node))
+ ,@(iter
+ (for field-id in (split-sequence #\space (node-attribute "members" node)
+ :remove-empty-subseqs t))
+ (for field = (find-in-tree root "Field" `(("id" ,field-id))))
+ (when field
+ (collect (list
+ (intern (string-upcase (node-attribute "name" field)))
+ (get-type-with-id (node-attribute "type" field))))))))
diff -rN -u old-c2ffi/c2ffi.asd new-c2ffi/c2ffi.asd
--- old-c2ffi/c2ffi.asd 2014-07-31 04:29:45.000000000 -0700
+++ new-c2ffi/c2ffi.asd 2014-07-31 04:29:45.000000000 -0700
@@ -4,7 +4,16 @@
:depends-on ("xmls" "cl-utilities" "iterate" "anaphora" "string-utilities"
#-:ecl "uffi")
:components ((:file "Package")
- (:file "Pathnames" :depends-on ("Package"))
- (:file "String-Utilities" :depends-on ("Package"))
- (:file "XML-Utilities" :depends-on ("Package" "String-Utilities"))
- (:file "C-to-FFI" :depends-on ("Pathnames" "Package" "XML-Utilities" "String-Utilities"))))
+ (:file "Pathnames"
+ :depends-on ("Package"))
+ (:file "String-Utilities"
+ :depends-on ("Package"))
+ (:file "XML-Utilities"
+ :depends-on ("Package" "String-Utilities"))
+ (:file "GCC-XML"
+ :depends-on ("Package" "Pathnames"))
+ (:file "C-to-FFI"
+ :depends-on ("Pathnames" "Package" "GCC-XML"
+ "XML-Utilities" "String-Utilities"))
+ (:file "UFFI-Generator"
+ :depends-on ("Package" "C-to-FFI"))))