]> asedeno.scripts.mit.edu Git - cl-protobufs.git/blobdiff - asdf-support.lisp
asdf-support: simplify do-process-import internals
[cl-protobufs.git] / asdf-support.lisp
index 1e3311fa1be90a29619e00ed0cc6ed5a85321d55..9f90ee158f70eb678ca226facf53cdea170b66b4 100644 (file)
@@ -67,7 +67,7 @@
     ;; Path was specified with ':proto-pathname'
     (subpathname (component-pathname (component-parent component))
                  (proto-relative-pathname component)
-                 :type "proto")
+                 :type (source-explicit-file-type component))
     ;; No ':proto-pathname', the path of the protobuf file
     ;; defaults to the component-pathname, with its automatic type "proto"
     (component-pathname component)))
   (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))
    stored where .fasl files are stored"
   (declare (ignorable op))
   (let* ((base-pathname (component-pathname component))
-         (lisp-file (make-pathname
-                     :name (format nil "~A.proto" (pathname-name base-pathname))
-                     :type "lisp"
-                     :defaults base-pathname)))
+         (lisp-file (protobuf-lispize-pathname base-pathname)))
     (values (list lisp-file
                   (make-pathname :type "proto-imports"
                                  :defaults lisp-file))
          (proto-impl:*protobuf-output-path* output))
     (dolist (path paths (error 'compile-failed
                           :component component :operation op))
-      (let ((proto (make-pathname :type "proto" :defaults (merge-pathnames* path (pathname input)))))
+      (let ((proto (merge-pathnames* path input)))
         (destructuring-bind (lisp imports)
             (output-files op component)
           (when (probe-file proto)
    If the file is a .proto file, it first parses it and writes a .lisp file.
    The .lisp file is the compiled and loaded."
   (dolist (import imports)
-    (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
-        (when imported
-          (appendf (proto-imported-schemas schema) (list imported))
-          (return-from import-one))
-        (do-process-import import import-name)
-        (let* ((imported (find-schema (class-name->proto import-name))))
-          (when imported
-            (appendf (proto-imported-schemas schema) (list imported)))
-          (return-from import-one))))))
+    (let* ((proto-file (do-process-import (pathname import)))
+           (imported   (find-schema proto-file)))
+      (when imported
+        (appendf (proto-imported-schemas schema) (list imported))))))
 
 (defun process-imports-from-file (imports-file)
   (when (probe-file imports-file)
                                     :element-type 'character)
                      (with-standard-io-syntax (read stream)))))
       (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))
-            (do-process-import import import-name)))))))
+        (do-process-import (pathname import))))))
 
-(defun do-process-import (import import-name
+(defun do-process-import (import
                           &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)))
+    (let* ((proto-file (asdf::merge-pathnames* import path))
+           (lisp-file (if output-path
+                        (asdf::lispize-pathname
+                         (make-pathname :name (asdf::protobuf-mangle-name proto-file)
+                                        :directory (pathname-directory output-path)))
+                        (asdf::protobuf-lispize-pathname proto-file)))
            (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
-            ;; If there's no .lisp file or an older .lisp file, or no
-            ;; .proto-imports file or an older .proto-imports file parse
-            ;; the .proto file now
-            ;; If we did not parse the .proto file, process the generated
-            ;; .proto-imports file now.
-            (cond ((not proto-date)
-                   (warn "Could not find the .proto file to be imported: ~A" proto-file))
-                  ((or (not (and lisp-date imports-date))
-                       (< lisp-date proto-date)
-                       (< imports-date proto-date))
-                   (parse-protobuf-file proto-file lisp-file imports-file)
-                   (setq lisp-date (file-write-date lisp-file))
-                   (setq imports-date (file-write-date imports-file)))
-                  (t
-                   (process-imports-from-file imports-file))))
+          ;; The user asked to import a .proto file
+          ;; If there's no .lisp file or an older .lisp file, or no
+          ;; .proto-imports file or an older .proto-imports file parse
+          ;; the .proto file now.
+          ;; If we did not parse the .proto file, process the generated
+          ;; .proto-imports file now.
+          (cond ((not proto-date)
+                 (warn "Could not find the .proto file to be imported: ~A" proto-file))
+                ((or (not (and lisp-date imports-date))
+                     (< lisp-date proto-date)
+                     (< imports-date proto-date))
+                 (parse-protobuf-file proto-file lisp-file imports-file)
+                 (setq lisp-date (file-write-date lisp-file))
+                 (setq imports-date (file-write-date imports-file)))
+                (t
+                 (process-imports-from-file imports-file)))
           ;; Compile the .lisp file, if necessary
           (cond ((not lisp-date)
-                 (unless (string= (pathname-type base-path) "proto")
-                   (warn "Could not find the .lisp file to be compiled: ~A" lisp-file)))
+                 (warn "Could not find the .lisp file to be compiled: ~A" lisp-file))
                 (t
                  (when (or (not fasl-date)
                            (< fasl-date lisp-date))
                    (setq fasl-date (file-write-date fasl-file)))))
           ;; Load the .fasl file
           (cond ((not fasl-date)
-                 (unless (string= (pathname-type base-path) "proto")
-                   (warn "Could not find the .fasl file to be loaded: ~A" fasl-file)))
+                 (warn "Could not find the .fasl file to be loaded: ~A" fasl-file))
                 (t
                  (let ((*compile-file-pathname* nil)
                        (*load-pathname* fasl-file))
                    (load fasl-file)))))
-        (return (values))))))
+        (return proto-file)))))