* interp/comp.lisp (|compAndDefine|): Move to interp/compiler.boot

	(COMP): Likewise.
	(|compQuietly|): Likewise.
	(|compileQuietly|): Likewise.
	(COMP-1): Likewise.

4 files changed, 49 insertions, 71 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 28f6797a..ab58b8be 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,11 @@
 2008-06-02  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/comp.lisp (|compAndDefine|): Move to interp/compiler.boot
+	(COMP): Likewise.
+	(|compQuietly|): Likewise.
+	(|compileQuietly|): Likewise.
+	(COMP-1): Likewise.
+
 	* interp/define.boot (compDefineCategory): Check that a category
 	was indeed abbreviated a category.
 
diff --git a/src/algebra/catdef.spad.pamphlet b/src/algebra/catdef.spad.pamphlet
index 1bb9eabc..75c43cae 100644
--- a/src/algebra/catdef.spad.pamphlet
+++ b/src/algebra/catdef.spad.pamphlet
@@ -2931,7 +2931,6 @@ OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianSemiGroup)
 OrderedSemiGroup(): Category == Join(OrderedSet, SemiGroup)
 @
 
-@
 \section{category OCAMON OrderedCancellationAbelianMonoid}
 <<category OCAMON OrderedCancellationAbelianMonoid>>=
 )abbrev category OCAMON OrderedCancellationAbelianMonoid
diff --git a/src/interp/comp.lisp b/src/interp/comp.lisp
index 8945cc49..b60cd837 100644
--- a/src/interp/comp.lisp
+++ b/src/interp/comp.lisp
@@ -65,36 +65,6 @@
 
 (defvar $closedfns nil)
 
-(defun |compAndDefine| (L)
-  (let ((*comp370-apply* (function print-and-eval-defun)))
-    (declare (special *comp370-apply*))
-    (COMP L)))
-
-(defun COMP (L) (MAPCAR #'COMP-2 (MAPCAN #'COMP-1 L)))
-
-;;(defun |compQuietly| (L)
-;;  (let (U CUROUTSTREAM)
-;;    (declare (special CUROUTSTREAM))
-;;    (ADDOPTIONS 'LISTING NULLOUTSTREAM)                     
-;;    (SETQ CUROUTSTREAM NULLOUTSTREAM)                       
-;;    (setq U (COMP L))
-;;    (setq OPTIONLIST (CDDR OPTIONLIST))
-;;    U))
-
-(defun |compQuietly| (fn)
-  (let ((*comp370-apply*
-         (if |$InteractiveMode|
-             (if |$compileDontDefineFunctions|
-		 #'compile-defun
-	       #'eval-defun)
-           #'print-defun))
-     ;; following creates a null outputstream if $InteractiveMode
-        (|$OutputStream|
-         (if |$InteractiveMode|
-	     (make-broadcast-stream)
-           (make-synonym-stream '*standard-output*))))
-    (COMP fn)))
-
 ;; The following are used mainly in setvars.boot
 (defun notEqualLibs (u v)
   (if (string= u (library-name v)) (seq (close-library v) t) nil))
@@ -113,46 +83,6 @@
   (|dropInputLibrary| lib)
    (setq input-libraries (cons (open-library lib) input-libraries)) )
 
-
-
-;;(defun |compileQuietly| (L) (PROG (U CUROUTSTREAM)
-;;  ;; calls lisp system COMPILE or DEFINE                  
-;;  (ADDOPTIONS 'QUIET 'T)                                  
-;;  (ADDOPTIONS 'LISTING NULLOUTSTREAM)                     
-;;  (SETQ CUROUTSTREAM NULLOUTSTREAM)                       
-;;  (SETQ U (COND                                           
-;;    (|$compileDontDefineFunctions| (COMPILE L))           
-;;    ('T (DEFINE L))))                                     
-;;  (SETQ OPTIONLIST (CDDR OPTIONLIST))                     
-;;  (RETURN U)   ))                                       
-
-(defun |compileQuietly| (fn)
-  (let ((*comp370-apply*
-         (if |$InteractiveMode|
-             (if |$compileDontDefineFunctions| 
-		 #'compile-defun
-	       #'eval-defun)
-           #'print-defun))
-	;; following creates a null outputstream if $InteractiveMode
-        (|$OutputStream|
-         (if |$InteractiveMode| 
-	     (make-broadcast-stream)
-           (make-synonym-stream '*standard-output*))))
-    (COMP370 fn)))
-
-(defun COMP-1 (X)
-  (let* ((FNAME (car X))
-         ($FUNNAME FNAME)
-         ($FUNNAME_TAIL (LIST FNAME))
-         (LAMEX (second X))
-         ($closedfns nil))
-    (declare (special $FUNNAME $FUNNAME_TAIL $CLOSEDFNS))
-    (setq LAMEX (COMP-TRAN LAMEX))
-    (COMP-NEWNAM LAMEX)
-    (if (fboundp FNAME)
-        (format t "~&~%;;;     ***       ~S REDEFINED~%" FNAME))
-    (CONS (LIST FNAME LAMEX) $CLOSEDFNS)))
-
 (defun Comp-2 (args &aux name type argl bodyl junk)
     (dsetq (NAME (TYPE ARGL . BODYL) . JUNK) args)
     (cond (JUNK (MOAN (format nil "******pren error in (~S (~S ...) ...)" NAME TYPE)))
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 3fc3b462..550776b2 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1614,6 +1614,49 @@ compileFileQuietly path ==
     MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
   COMPILE_-FILE path
 
+compAndDefine l ==
+  _*COMP370_-APPLY_* := function PRINT_-AND_-EVAL_-DEFUN
+  COMP l
+
+compQuietly fn ==
+  _*COMP370_-APPLY_* :=
+    $InteractiveMode =>
+      $compileDontDefineFunctions => function COMPILE_-DEFUN
+      function EVAL_-DEFUN
+    function PRINT_-DEFUN
+  -- create a null outputstream if $InteractiveMode
+  $OutputStream := 
+    $InteractiveMode => MAKE_-BROADCAST_-STREAM()
+    MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+  COMP fn
+
+compileQuietly fn ==
+  _*COMP370_-APPLY_* :=
+     $InteractiveMode =>
+       $compileDontDefineFunctions => function COMPILE_-DEFUN
+       function EVAL_-DEFUN
+     function PRINT_-DEFUN
+  $OutputStream := 
+    $InteractiveMode => MAKE_-BROADCAST_-STREAM()
+    MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+  COMP370 fn
+
+
+COMP l ==
+  MAPCAR(function COMP_-2, MAPCAN(function COMP_-1,l))
+
+COMP_-1 x ==
+  fname := first x
+  $FUNNAME := fname
+  $FUNNAME__TAIL := [fname]
+  lamex := second x
+  $CLOSEDFNS := []
+  lamex := COMP_-TRAN lamex
+  COMP_-NEWNAM lamex
+  if FBOUNDP fname then
+    FORMAT(true,'"~&~%;;;     ***       ~S REDEFINED~%",fname)
+  [[fname,lamex],:$CLOSEDFNS]
+
 
 --% Register compilers for special forms.
 -- Those compilers are on the `SPECIAL' property of the corresponding