It lives!

[sod] / module-output.lisp

diff --git a/module-output.lisp b/module-output.lisp
index dedbe97c02599e4274f4f207385beb23327771d0..891ff54fc379d9fbab7d1f422963bce3637e077b 100644 (file)
--- a/module-output.lisp
+++ b/module-output.lisp
@@ -60,7 +60,13 @@ (defun guess-output-file (module type)
                   (module-name module)))
 
 (defun output-module (module reason stream)
                   (module-name module)))
 
 (defun output-module (module reason stream)

-  (let ((sequencer (make-instance 'sequencer)))
+  (let ((sequencer (make-instance 'sequencer))
+       (stream (if (typep stream 'position-aware-output-stream)
+                   stream
+                   (make-instance 'position-aware-output-stream
+                                  :stream stream
+                                  :file (or (stream-pathname stream)
+                                            #p"<unnamed>")))))

     (add-output-hooks module reason sequencer)
     (invoke-sequencer-items sequencer stream)))
 
     (add-output-hooks module reason sequencer)
     (invoke-sequencer-items sequencer stream)))
 


@@ -71,6 +77,18 @@ (defmethod add-output-hooks progn ((module module) reason sequencer)
   (dolist (item (module-items module))
     (add-output-hooks item reason sequencer)))
 
   (dolist (item (module-items module))
     (add-output-hooks item reason sequencer)))
 

+(defmethod add-output-hooks progn
+    ((frag code-fragment-item) reason sequencer)
+  (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)))))
+

 ;;;--------------------------------------------------------------------------
 ;;; Header output.
 
 ;;;--------------------------------------------------------------------------
 ;;; Header output.
 


@@ -81,7 +99,7 @@ (defmethod add-output-hooks progn
                 (:guard :start)
                 (:typedefs :start) :typedefs (:typedefs :end)
                 (:includes :start) :includes (:includes :end)
                 (:guard :start)
                 (:typedefs :start) :typedefs (:typedefs :end)
                 (:includes :start) :includes (:includes :end)

-                (:classes :start) (:classes :end)
+                (:classes :start) :classes (:classes :end)

                 (:guard :end)
                 :epilogue)
 
                 (:guard :end)
                 :epilogue)