lib/sod-hosted.c (sod_makev): Use two statements rather than tricky expression.

[sod] / src / module-output.lisp

diff --git a/src/module-output.lisp b/src/module-output.lisp
index fe04f2b7460a15fc2696672de8cf983503a2576f..d09dfd8b7f238b17ea88c53acbc69250bce5b608 100644 (file)
--- a/src/module-output.lisp
+++ b/src/module-output.lisp
@@ -102,26 +102,27 @@ (defun output-module (module reason stream)
 ;;;--------------------------------------------------------------------------
 ;;; Output implementation.
 
 ;;;--------------------------------------------------------------------------
 ;;; Output implementation.
 

-(defmethod hook-output progn ((module module) reason sequencer)
+(defmethod hook-output :after ((module module) reason sequencer)

 
   ;; Ask the module's items to sequence themselves.
   (dolist (item (module-items module))
     (hook-output item reason sequencer)))
 
 
   ;; Ask the module's items to sequence themselves.
   (dolist (item (module-items module))
     (hook-output item reason sequencer)))
 

-(defmethod hook-output progn ((frag code-fragment-item) reason sequencer)
+(defmethod hook-output ((frag code-fragment-item) reason sequencer)

 
   ;; Output fragments when their reasons are called up.
   (when (eq reason (code-fragment-reason frag))
     (dolist (constraint (code-fragment-constraints frag))
       (add-sequencer-constraint sequencer constraint))
 
   ;; Output fragments when their reasons are called up.
   (when (eq reason (code-fragment-reason frag))
     (dolist (constraint (code-fragment-constraints frag))
       (add-sequencer-constraint sequencer constraint))

-    (add-sequencer-item-function sequencer (code-fragment-name frag)
-                                (lambda (stream)
-                                  (write (code-fragment frag)
-                                         :stream stream
-                                         :pretty nil
-                                         :escape nil)))))
-
-(defmethod hook-output progn ((module module) (reason (eql :h)) sequencer)
+    (awhen (code-fragment-name frag)
+      (add-sequencer-item-function sequencer it
+                                  (lambda (stream)
+                                    (write (code-fragment frag)
+                                           :stream stream
+                                           :pretty nil
+                                           :escape nil))))))
+
+(defmethod hook-output ((module module) (reason (eql :h)) sequencer)

   (sequence-output (stream sequencer)
 
     :constraint
   (sequence-output (stream sequencer)
 
     :constraint


@@ -131,6 +132,7 @@ (defmethod hook-output progn ((module module) (reason (eql :h)) sequencer)
      (:includes :start) :includes :early-decls (:includes :end)
      (:early-user :start) :early-user (:early-user :end)
      (:classes :start) (:classes :end)
      (:includes :start) :includes :early-decls (:includes :end)
      (:early-user :start) :early-user (:early-user :end)
      (:classes :start) (:classes :end)

+     (:static-instances :start) :static-instances (:static-instances :end)

      (:user :start) :user (:user :end)
      (:guard :end)
      :epilogue)
      (:user :start) :user (:user :end)
      (:guard :end)
      :epilogue)


@@ -173,13 +175,16 @@ (defmethod hook-output progn ((module module) (reason (eql :h)) sequencer)
     ((:includes :end)
      (terpri stream))))
 
     ((:includes :end)
      (terpri stream))))
 

-(defmethod hook-output progn ((module module) (reason (eql :c)) sequencer)
+(defmethod hook-output ((module module) (reason (eql :c)) sequencer)

   (sequence-output (stream sequencer)
 
     :constraint
     (:prologue
      (:includes :start) :includes (:includes :end)
      (:early-user :start) :early-user (:early-user :end)
   (sequence-output (stream sequencer)
 
     :constraint
     (:prologue
      (:includes :start) :includes (:includes :end)
      (:early-user :start) :early-user (:early-user :end)

+     (:static-instances :start)
+     (:static-instances :decls) (:static-instances :gap)
+     (:static-instances :end)

      (:classes :start) (:classes :end)
      (:user :start) :user (:user :end)
      :epilogue)
      (:classes :start) (:classes :end)
      (:user :start) :user (:user :end)
      :epilogue)


@@ -212,6 +217,7 @@ (defun declare-output-type (reason pathname)
 
    The output file name will be constructed by merging the module's pathname
    with PATHNAME."
 
    The output file name will be constructed by merging the module's pathname
    with PATHNAME."

+  (pushnew reason *output-types*)

   (setf (get reason 'output-type) pathname))
 
 (export 'output-type-pathname)
   (setf (get reason 'output-type) pathname))
 
 (export 'output-type-pathname)


@@ -246,6 +252,51 @@ (defmethod module-output-file
                (make-pathname :directory nil
                               :defaults (module-name module)))))
 
                (make-pathname :directory nil
                               :defaults (module-name module)))))
 

+(export 'write-dependency-file)
+(defgeneric write-dependency-file (module reason output-dir)
+  (:documentation
+   "Write a dependency-tracking make(1) fragment.
+
+   Specifically, we've processed a MODULE for a particular REASON (a
+   symbol), and the user has requested that output be written to OUTPUT-DIR
+   (a pathname): determine a suitable output pathname and write a make(1)
+   fragment explaining that the output file we've made depends on all of the
+   files we had to read to load the module."))
+
+(defmethod write-dependency-file ((module module) reason output-dir)
+  (let* ((common-case
+         ;; Bletch.  We want to derive the filetype from the one we're
+         ;; given, but we need to determine the environment's preferred
+         ;; filetype case to do that.  Make a pathname and inspect it to
+         ;; find out how to do this.
+
+         (if (upper-case-p
+                          (char (pathname-type (make-pathname
+                                                :type "TEST"
+                                                :case :common))
+                                0))
+                         #'string-upcase
+                         #'string-downcase))
+
+        (outpath (output-type-pathname reason))
+        (deppath (make-pathname :type (concatenate 'string
+                                                   (pathname-type outpath)
+                                                   (funcall common-case
+                                                            "-DEP"))
+                                :defaults outpath))
+        (outfile (module-output-file module reason output-dir))
+        (depfile (module-output-file module deppath output-dir)))
+
+    (with-open-file (dep depfile
+                    :direction :output
+                    :if-exists :supersede
+                    :if-does-not-exist :create)
+      (format dep "### -*-makefile-*-~%~
+                  ~A:~{ \\~%   ~A~}~%"
+             outfile
+             (cons (module-name module)
+                   (module-files module))))))
+

 (define-clear-the-decks reset-output-types
   "Clear out the registered output types."
   (dolist (reason *output-types*) (remprop reason 'output-type))
 (define-clear-the-decks reset-output-types
   "Clear out the registered output types."
   (dolist (reason *output-types*) (remprop reason 'output-type))