It lives!

[sod] / module-output.lisp

diff --git a/module-output.lisp b/module-output.lisp
index 3ec6aee017e94df8a271b74705ce1955e4938668..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)
 


@@ -123,4 +141,31 @@ (defmethod add-output-hooks progn
     ((:includes :end)
      (terpri stream))))
 
     ((:includes :end)
      (terpri stream))))
 

+;;;--------------------------------------------------------------------------
+;;; Source output.
+
+(defmethod add-output-hooks progn
+    ((module module) (reason (eql :c)) sequencer)
+  (sequence-output (stream sequencer)
+    :constraint (:prologue
+                (:includes :start) :includes (:includes :end)
+                (:classes :start) (:classes :end)
+                :epilogue)
+
+    (:prologue
+     (format stream "~
+/* -*-c-*-
+ *
+ * Implementation file generated by SOD for ~A
+ */~2%"
+            (namestring (module-name module))))
+
+    (:epilogue
+     (banner "That's all, folks" stream :blank-line-p nil))
+
+    ((:includes :start)
+     (banner "External header files" stream))
+    ((:includes :end)
+     (terpri stream))))
+

 ;;;----- That's all, folks --------------------------------------------------
 ;;;----- That's all, folks --------------------------------------------------