]> asedeno.scripts.mit.edu Git - cl-protobufs.git/blobdiff - asdf-support.lisp
asdf-support: note which proto file we're loading a fasl for
[cl-protobufs.git] / asdf-support.lisp
index cee05d9247093349a697a503bdb8b7a242de6183..8f7bf8db94cd62caa971ddf038f59d655f3aa6e1 100644 (file)
   (pathname-directory-pathname
    (merge-pathnames* path parent-path)))
 
+(defun protobuf-mangle-name (input-file)
+  (let ((directory (pathname-directory input-file)))
+    (format nil "~{~A-~}~A-~A"
+            (if (eq (first directory) :absolute)
+              (rest directory)
+              directory)
+            (pathname-name input-file)
+            (pathname-type input-file))))
+
+(defun protobuf-lispize-pathname (input-file)
+  (make-pathname
+   :name (protobuf-mangle-name input-file)
+   :type "lisp"
+   :defaults input-file))
+
 (defmethod input-files ((op proto-to-lisp) (component protobuf-file))
   "The input file is just the .proto file."
   (declare (ignorable op))
   "The output file is a .lisp file and a .proto-imports file with dependency data,
    stored where .fasl files are stored"
   (declare (ignorable op))
-  (let ((lisp-file (lispize-pathname (component-pathname component))))
+  (let* ((base-pathname (component-pathname component))
+         (lisp-file (protobuf-lispize-pathname base-pathname)))
     (values (list lisp-file
                   (make-pathname :type "proto-imports"
                                  :defaults lisp-file))
             nil)))
 
-(defmethod input-files ((op compile-op) (component protobuf-file))
-  "The input files are the .lisp and .proto-imports files."
-  (declare (ignorable op))
-  (output-files (make-instance 'proto-to-lisp) component))
-
 (defmethod perform ((op proto-to-lisp) (component protobuf-file))
   (let* ((input  (protobuf-input-file component))
          (output (first (output-files op component)))
   (format nil (compatfmt "~@<proto-compiling ~3i~_~A~@:>")
           (first (input-files op component))))
 
-(defmethod input-files ((op load-op) (component protobuf-file))
-  "The input files are the .fasl and .proto-imports files."
+(defmethod input-files ((op compile-op) (component protobuf-file))
+  "The input files are the .lisp and .proto-imports files."
   (declare (ignorable op))
-  (append (output-files (make-instance 'compile-op) component) ; fasl
-          (cdr (output-files (make-instance 'proto-to-lisp) component)))) ; proto-imports
+  (output-files (make-instance 'proto-to-lisp) component))
 
 (defmethod perform ((op compile-op) (component protobuf-file))
-  (let* ((input  (protobuf-input-file component))
-         (output (output-file op component))
-         (lisp   (first (input-files op component)))
-         (fasl   output)
-         (paths  (cons (directory-namestring input) (resolve-search-path component)))
-         (proto-impl:*protobuf-search-path* paths)
-         (proto-impl:*protobuf-output-path* output)
-         (*compile-file-warnings-behaviour* (operation-on-warnings op))
-         (*compile-file-failure-behaviour* (operation-on-failure op)))
-    (proto-impl:process-imports-from-file
-     (make-pathname :type "proto-imports"
-                    :defaults output))
-    (multiple-value-bind (output warnings-p failure-p)
-        (apply #'compile-file* lisp
-               :output-file fasl
-               (compile-op-flags op))
-      (when warnings-p
-        (case (operation-on-warnings op)
-          (:warn  (warn "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" op component))
-          (:error (error 'compile-warned
-                         :component component :operation op))
-          (:ignore nil)))
-      (when failure-p
-        (case (operation-on-failure op)
-          (:warn  (warn "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" op component))
-          (:error (error 'compile-failed
-                         :component component :operation op))
-          (:ignore nil)))
-      (unless output
-        (error 'compile-error
-               :component component :operation op)))))
+  (destructuring-bind (lisp-file imports-file) (input-files op component)
+    (destructuring-bind (fasl-file
+                         &optional
+                           #+clisp lib-file
+                           #+(or ecl mkcl) object-file
+                           #+asdf3 warnings-file)
+        (output-files op component)
+      (let* ((proto-file (protobuf-input-file component))
+             (paths  (cons (directory-namestring proto-file)
+                           (resolve-search-path component)))
+             (proto-impl:*protobuf-search-path* paths)
+             (proto-impl:*protobuf-output-path* fasl-file)
+             (*compile-file-warnings-behaviour* (operation-on-warnings op))
+             (*compile-file-failure-behaviour* (operation-on-failure op)))
+        (proto-impl:process-imports-from-file imports-file)
+        (multiple-value-bind (output warnings-p failure-p)
+            (apply #'compile-file* lisp-file
+                   :output-file fasl-file
+                   #+asdf3 #+asdf3
+                   :warnings-file warnings-file
+                   (append
+                    #+clisp (list :lib-file lib-file)
+                    #+(or ecl mkcl) (list :object-file object-file)
+                    (compile-op-flags op)))
+          #+asdf3
+          (check-lisp-compile-results output warnings-p failure-p
+                                      "~/asdf-action::format-action/" (list (cons op component)))
+          #-asdf3
+          (progn
+            (when warnings-p
+              (case (operation-on-warnings op)
+                (:warn  (warn "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" op component))
+                (:error (error 'compile-warned
+                               :component component :operation op))
+                (:ignore nil)))
+            (when failure-p
+              (case (operation-on-failure op)
+                (:warn  (warn "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" op component))
+                (:error (error 'compile-failed
+                               :component component :operation op))
+                (:ignore nil)))
+            (unless output
+              (error 'compile-error
+                     :component component :operation op))))))))
+
+(defmethod input-files ((op load-op) (component protobuf-file))
+  "The input files are the .fasl and .proto-imports files."
+  (declare (ignorable op))
+  (list (first (output-files (make-instance 'compile-op) component))       ;fasl
+        (second (output-files (make-instance 'proto-to-lisp) component)))) ;proto-imports
 
 (defmethod perform ((op load-op) (component protobuf-file))
   (let* ((input  (protobuf-input-file component))
          (paths  (cons (directory-namestring input) (resolve-search-path component)))
          (proto-impl:*protobuf-search-path* paths)
          (proto-impl:*protobuf-output-path* (first (input-files op component))))
-    (proto-impl:process-imports-from-file
-     (make-pathname :type "proto-imports"
-                    :defaults (first (input-files op component)))))
-  (call-next-method))
+    (destructuring-bind (fasl proto-imports)
+        (input-files op component)
+      (proto-impl:process-imports-from-file proto-imports)
+      (let ((proto-impl:*protobuf-pathname* (protobuf-input-file component)))
+        (load fasl)))))
 
 (defmethod operation-description ((op compile-op) (component protobuf-file))
   (format nil (compatfmt "~@<compiling ~3i~_~A~@:>")
     (block import-one
       (let* ((import      (pathname import))
              (import-name (pathname-name import))
-             (imported    (find-schema (class-name->proto import-name))))
-        ;; If this schema has already been imported somewhere else,
-        ;; mark it as imported here and carry on
+             (proto-file  (do-process-import import import-name))
+             (imported    (find-schema proto-file)))
         (when imported
-          (setf (proto-imported-schemas schema)
-                (nconc (proto-imported-schemas schema) (list imported)))
-          (return-from import-one))
-        (%process-import import import-name)
-        (let* ((imported (find-schema (class-name->proto import-name))))
-          (when imported
-            (setf (proto-imported-schemas schema)
-                  (nconc (proto-imported-schemas schema) (list imported))))
-          (return-from import-one))))))
+          (appendf (proto-imported-schemas schema) (list imported)))
+        (return-from import-one)))))
 
 (defun process-imports-from-file (imports-file)
   (when (probe-file imports-file)
       (dolist (import imports)
         (let* ((import      (pathname import))
                (import-name (pathname-name import)))
-          ;; If this schema has already been loaded, we're done.
-          (unless (find-schema (class-name->proto import-name))
-            (%process-import import import-name)))))))
+          (do-process-import import import-name))))))
 
-(defun %process-import (import import-name
-                        &key (search-path *protobuf-search-path*)
-                             (output-path *protobuf-output-path*))
+(defun do-process-import (import import-name
+                          &key (search-path *protobuf-search-path*)
+                               (output-path *protobuf-output-path*))
   (dolist (path search-path (error "Could not import ~S" import))
     (let* ((base-path  (asdf::merge-pathnames* import path))
            (proto-file (make-pathname :name import-name :type "proto"
                                       :defaults base-path))
-           (lisp-file  (asdf::lispize-pathname
-                        (if output-path
-                            (make-pathname :name import-name
-                                           :directory (pathname-directory output-path))
-                            base-path)))
+           (lisp-file (if output-path
+                        (asdf::lispize-pathname
+                         (make-pathname :name (asdf::protobuf-mangle-name base-path)
+                                        :directory (pathname-directory output-path)))
+                        (asdf::protobuf-lispize-pathname base-path)))
            (imports-file (make-pathname :type "proto-imports"
                                         :defaults lisp-file))
            (fasl-file  (compile-file-pathname lisp-file))
            (fasl-date  (asdf::safe-file-write-date fasl-file))
            (imports-date  (asdf::safe-file-write-date imports-file)))
       (when (probe-file proto-file)
+        (when (find-schema proto-file)
+          (return proto-file))
         (let ((*protobuf-pathname* proto-file))
           (when (string= (pathname-type base-path) "proto")
             ;; The user asked to import a .proto file
                  (let ((*compile-file-pathname* nil)
                        (*load-pathname* fasl-file))
                    (load fasl-file)))))
-        (return (values))))))
+        (return proto-file)))))