X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/c91b90c3bfd3d3e68cc3d3ff3f431d1e73920061..048d0b2d143b6a491ac73eed6ab972e97774391c:/pre-reorg/module-output.lisp

diff --git a/pre-reorg/module-output.lisp b/pre-reorg/module-output.lisp
index 891ff54..fd690ad 100644
--- 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 --------------------------------------------------