Groveler: code cleanup
authorStelian Ionescu <sionescu@cddr.org>
Wed, 20 Mar 2013 23:48:25 +0000 (00:48 +0100)
committerStelian Ionescu <sionescu@cddr.org>
Wed, 20 Mar 2013 23:48:25 +0000 (00:48 +0100)
grovel/asdf.lisp
grovel/grovel.lisp

index 2930d44..c12e1b1 100644 (file)
           (list (list 'process-op (asdf:component-name c)))))
 
 (defmethod asdf:perform ((op asdf:compile-op) (c process-op-input))
-  (let ((generated-lisp-file (asdf:output-file (make-instance 'process-op) c)))
+  (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
     (asdf:perform op (make-instance 'asdf:cl-source-file
                                     :name (asdf:component-name c)
                                     :parent (asdf:component-parent c)
                                     :pathname generated-lisp-file))))
 
 (defmethod asdf:perform ((op asdf:load-source-op) (c process-op-input))
-  (let ((generated-lisp-file (asdf:output-file (make-instance 'process-op) c)))
+  (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
     (asdf:perform op (make-instance 'asdf:cl-source-file
                                     :name (asdf:component-name c)
                                     :parent (asdf:component-parent c)
      by PROCESS-GROVEL-FILE.")))
 
 (defmethod asdf:perform ((op process-op) (c grovel-file))
-  (let ((output-file (asdf:output-file op c))
+  (let ((output-file (first (asdf:output-files op c)))
         (input-file (asdf:component-pathname c)))
     (ensure-directories-exist (directory-namestring output-file))
-    (let ((tmp-file (process-grovel-file input-file (ensure-pathname output-file))))
+    (let ((tmp-file (process-grovel-file input-file output-file)))
       (unwind-protect
            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
         (delete-file tmp-file)))))
       matching CFFI bindings that are subsequently compiled and
       loaded.")))
 
+(defun wrapper-soname (c)
+  (or (soname-of c)
+      (asdf:component-name c)))
+
 (defmethod asdf:perform ((op process-op) (c wrapper-file))
-  (let ((output-file (asdf:output-file op c))
+  (let ((output-file (first (asdf:output-files op c)))
         (input-file  (asdf:component-pathname c)))
     (ensure-directories-exist (directory-namestring output-file))
-    (let ((tmp-file (process-wrapper-file input-file output-file (or (soname-of c)
-                                                                     (asdf:component-name c)))))
+    (let ((tmp-file (process-wrapper-file input-file output-file (wrapper-soname c))))
       (unwind-protect
            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
         (delete-file tmp-file)))))
index 2310bb7..a0c150c 100644 (file)
@@ -177,8 +177,11 @@ int main(int argc, char**argv) {
 (defun header-form-p (form)
   (member (form-kind form) *header-forms*))
 
+(defun make-c-file-name (output-defaults)
+  (make-pathname :type "c" :defaults output-defaults))
+
 (defun generate-c-file (input-file output-defaults)
-  (let ((c-file (make-pathname :type "c" :defaults output-defaults)))
+  (let ((c-file (make-c-file-name output-defaults)))
     (with-open-file (out c-file :direction :output :if-exists :supersede)
       (with-open-file (in input-file :direction :input)
         (flet ((read-forms (s)
@@ -744,7 +747,7 @@ int main(int argc, char**argv) {
 
 (defun generate-c-lib-file (input-file output-defaults)
   (let ((*lisp-forms* nil)
-        (c-file (make-pathname :type "c" :defaults output-defaults)))
+        (c-file (make-c-file-name output-defaults)))
     (with-open-file (out c-file :direction :output :if-exists :supersede)
       (with-open-file (in input-file :direction :input)
         (write-string *header* out)
@@ -780,13 +783,16 @@ int main(int argc, char**argv) {
       (terpri out))
     lisp-file))
 
+(defun make-soname (lib-soname output-defaults)
+  (make-pathname :name lib-soname
+                 :defaults output-defaults))
+
 ;;; *PACKAGE* is rebound so that the IN-PACKAGE form can set it during
 ;;; *the extent of a given wrapper file.
 (defun process-wrapper-file (input-file output-defaults lib-soname)
   (with-standard-io-syntax
     (let ((lib-file
-           (lib-filename (make-pathname :name lib-soname
-                                        :defaults output-defaults))))
+            (lib-filename (make-soname lib-soname output-defaults))))
       (multiple-value-bind (c-file lisp-forms)
           (generate-c-lib-file input-file output-defaults)
         (cc-compile-and-link c-file lib-file :library t)