Refactoring more or less complete. Maybe I should test it.

[sod] / pre-reorg / module-output.lisp

diff --git a/pre-reorg/module-output.lisp b/pre-reorg/module-output.lisp
index 891ff54..fd690ad 100644 (file)
--- a/pre-reorg/module-output.lisp
+++ b/pre-reorg/module-output.lisp
@@ -28,144 +28,13 @@
 ;;;--------------------------------------------------------------------------
 ;;; Utilities.
 
-(defun banner (title output &key (blank-line-p t))
-  (format output "~&/*----- ~A ~A*/~%"
-         title
-         (make-string (- 77 2 5 1 (length title) 1 2)
-                      :initial-element #\-))
-  (when blank-line-p
-    (terpri output)))
-
-(defun guard-name (filename)
-  "Return a sensible inclusion guard name for FILENAME."
-  (with-output-to-string (guard)
-    (let* ((pathname (make-pathname :name (pathname-name filename)
-                                   :type (pathname-type filename)))
-          (name (namestring pathname))
-          (uscore t))
-      (dotimes (i (length name))
-       (let ((ch (char name i)))
-         (cond ((alphanumericp ch)
-                (write-char (char-upcase ch) guard)
-                (setf uscore nil))
-               ((not uscore)
-                (write-char #\_ guard)
-                (setf uscore t))))))))
-
-;;;--------------------------------------------------------------------------
-;;; Driving output.
-
-(defun guess-output-file (module type)
-  (merge-pathnames (make-pathname :type type :case :common)
-                  (module-name module)))
-
-(defun output-module (module reason stream)
-  (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)))
-
 ;;;--------------------------------------------------------------------------
 ;;; Main output protocol implementation.
 
-(defmethod add-output-hooks progn ((module module) 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.
 
-(defmethod add-output-hooks progn
-    ((module module) (reason (eql :h)) sequencer)
-  (sequence-output (stream sequencer)
-    :constraint (:prologue
-                (:guard :start)
-                (:typedefs :start) :typedefs (:typedefs :end)
-                (:includes :start) :includes (:includes :end)
-                (:classes :start) :classes (:classes :end)
-                (:guard :end)
-                :epilogue)
-
-    (:prologue
-     (format stream "~
-/* -*-c-*-
- *
- * Header file generated by SOD for ~A
- */~2%"
-            (namestring (module-name module))))
-
-    ((:guard :start)
-     (format stream "~
-#ifndef ~A
-#define ~:*~A
-
-#ifdef __cplusplus
-  extern \"C\" {
-#endif~2%"
-            (or (get-property (module-pset module) :guard :id)
-                (guard-name (or (stream-pathname stream)
-                                (guess-output-file module "H"))))))
-    ((:guard :end)
-     (banner "That's all, folks" stream)
-     (format stream "~
-#ifdef __cplusplus
-  }
-#endif
-
-#endif~%"))
-
-    ((:typedefs :start)
-     (banner "Forward type declarations" stream))
-    ((:typedefs :end)
-     (terpri stream))
-
-    ((:includes :start)
-     (banner "External header files" 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 --------------------------------------------------