9 files changed, 65 insertions, 58 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 8ffebce6..e3cbf6c4 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2008-10-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/compiler.boot (backendCompile1): Move to c-util.boot.
+	(COMP): Likewise.  Rename to backendCompile.
+	(compileFileQuietly): Move to c-util.boot.
+	(compAndDefine): Likewise.
+	(compQuietly): Likewise.
+	(compileQuitely): Likewise.
+
+2008-10-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/mkfunc.spad.pamphlet (unparse$InputForm): Use
 	inputForm2String$Lisp. 
 
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 3af79992..170f16f8 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1276,3 +1276,45 @@ transformToBackendCode x ==
       RPLACD(lastdecl, body)
     RPLACD(lastdecl, [declareGlobalVariables fluids,:body])
   x
+
+backendCompile1 x ==
+  fname := first x
+  $FUNNAME: local := fname
+  $FUNNAME__TAIL: local := [fname]
+  lamex := second x
+  $CLOSEDFNS: local := []
+  lamex := transformToBackendCode lamex
+  backendCompileNEWNAM lamex
+  -- Note that category constructors are evaluated before they
+  -- their compiled, so this noise is not very helpful.
+  if $verbose and FBOUNDP fname then
+    FORMAT(true,'"~&~%;;;     ***       ~S REDEFINED~%",fname)
+  [[fname,lamex],:$CLOSEDFNS]
+
+backendCompile l ==
+  MAPCAR(function backendCompile2, MAPCAN(function backendCompile1,l))
+
+compileFileQuietly path ==
+  quietlyIfInteractive COMPILE_-FILE path
+
+compAndDefine l ==
+  _*COMP370_-APPLY_* := "PRINT-AND-EVAL-DEFUN"
+  backendCompile l
+
+compQuietly fn ==
+  _*COMP370_-APPLY_* :=
+    $InteractiveMode =>
+      $compileDontDefineFunctions => "COMPILE-DEFUN"
+      "EVAL-DEFUN"
+    "PRINT-DEFUN"
+  quietlyIfInteractive backendCompile fn
+
+compileQuietly fn ==
+  _*COMP370_-APPLY_* :=
+     $InteractiveMode =>
+       $compileDontDefineFunctions => "COMPILE-DEFUN"
+       "EVAL-DEFUN"
+     "PRINT-DEFUN"
+  quietlyIfInteractive COMP370 fn
+
+
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 7ba68452..b9b4e254 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -65,7 +65,7 @@ namespace BOOT
 --     entries have their use count set
 --     to 0 on garbage collection; those with 0 use count at garbage collection
 --     are cleared
--- see definition of COMP,2 in COMP LISP which calls clamComp below
+-- see definition of backendCompile2 in c-util which calls clamComp below
 
 ++
 $hashNode := [[]]
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 99d44744..7fd58b82 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1893,50 +1893,6 @@ compMapCond''(cexpr,dc) ==
 compMapCondFun(fnexpr,op,dc,bindings) == 
   [fnexpr,bindings]
 
---% Interface to the backend
-
-compileFileQuietly path ==
-  quietlyIfInteractive COMPILE_-FILE path
-
-compAndDefine l ==
-  _*COMP370_-APPLY_* := "PRINT-AND-EVAL-DEFUN"
-  COMP l
-
-compQuietly fn ==
-  _*COMP370_-APPLY_* :=
-    $InteractiveMode =>
-      $compileDontDefineFunctions => "COMPILE-DEFUN"
-      "EVAL-DEFUN"
-    "PRINT-DEFUN"
-  quietlyIfInteractive COMP fn
-
-compileQuietly fn ==
-  _*COMP370_-APPLY_* :=
-     $InteractiveMode =>
-       $compileDontDefineFunctions => "COMPILE-DEFUN"
-       "EVAL-DEFUN"
-     "PRINT-DEFUN"
-  quietlyIfInteractive COMP370 fn
-
-
-COMP l ==
-  MAPCAR(function backendCompile2, MAPCAN(function COMP_-1,l))
-
-COMP_-1 x ==
-  fname := first x
-  $FUNNAME := fname
-  $FUNNAME__TAIL := [fname]
-  lamex := second x
-  $CLOSEDFNS := []
-  lamex := transformToBackendCode lamex
-  backendCompileNEWNAM lamex
-  -- Note that category constructors are evaluated before they
-  -- their compiled, so this noise is not very helpful.
-  if $verbose and 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
 -- special form operator symbol.
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 1e851a90..4b281043 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -98,7 +98,7 @@
  
 (defun heapelapsed () 0)
  
-(defun /COMP () (if (fboundp 'COMP) 'COMP 'COMP370))
+(defun /COMP () (if (fboundp '|backendCompile|) '|backendCompile| 'COMP370))
  
 (defvar /fn nil)
 
@@ -869,7 +869,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
        (APPEND /TRACELETNAMES (LIST 'tracelet))))
  
 (DEFUN /TRACELET-2 (FN OPTIONL &AUX ($TRACELETFLAG T))
-  (/D-1 (CONS FN OPTIONL) 'COMP NIL NIL)
+  (/D-1 (CONS FN OPTIONL) '|backendCompile| NIL NIL)
   (SETQ /TRACELETNAMES
         (if (ATOM /TRACELETNAMES) (LIST FN) (CONS FN /TRACELETNAMES)))
   FN)
@@ -896,7 +896,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
      (PROGN (PRINT (STRCONC (PNAME X) " not tracelet")) (TERPRI)))
     ((PROGN
        (/UNTRACELET-2 X)
-       (/D-1 (LIST X) 'COMP NIL NIL)))))
+       (/D-1 (LIST X) '|backendCompile| NIL NIL)))))
  
 (DEFUN /UNTRACELET-2 (X)
   (SETQ /TRACELETNAMES (REMOVE X /TRACELETNAMES))
diff --git a/src/interp/def.lisp b/src/interp/def.lisp
index d6c7ed82..d7d629b8 100644
--- a/src/interp/def.lisp
+++ b/src/interp/def.lisp
@@ -83,7 +83,7 @@ foo defined inside of fum gets renamed as fum,foo.")
          (argl (DEF-INSERT_LET argl))
          (arglp (DEF-STRINGTOQUOTE argl))
          ($body (|bootTransform| $body)))
-      (COMP (SUBLIS $OPASSOC (list (list $OP (list 'LAM arglp $body)))))))
+      (|backendCompile| (SUBLIS $OPASSOC (list (list $OP (list 'LAM arglp $body)))))))
 
 ; We are making shallow binding cells for these functions as well
 
@@ -139,7 +139,7 @@ foo defined inside of fum gets renamed as fum,foo.")
         ($BODY (SUBLISLIS GARGL ARGL (|bootTransform| (DEFTRAN $BODY))))
         ($BODY (LIST 'SUBLISLIS (CONS 'LIST GARGL) (LIST 'QUOTE GARGL)
                      (LIST 'QUOTE $BODY))))
-   (COMP (SUBLIS $OPASSOC
+   (|backendCompile| (SUBLIS $OPASSOC
                  (LIST (LIST $OP (LIST 'MLAMBDA (CONS () GARGL) $BODY)))))))
 
 (defun DEF-INNER (FORM SIGNATURE $BODY)
@@ -147,7 +147,7 @@ foo defined inside of fum gets renamed as fum,foo.")
  (let ($OpAssoc ($op (first form)) (argl (rest form)))
    (let* ((ARGL (DEF-INSERT_LET ARGL))
           (ARGLP (DEF-STRINGTOQUOTE ARGL)))
-    (COMP (SUBLIS $OPASSOC `((,$OP (LAM ,ARGLP ,$BODY))))))))
+    (|backendCompile| (SUBLIS $OPASSOC `((,$OP (LAM ,ARGLP ,$BODY))))))))
 
 (defun DEF-INSERT_LET (X)
   (if (ATOM X) X
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 3104d044..642906d7 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -541,7 +541,7 @@ compDefineFunctor1(df is ['DEF,form,signature,$functorSpecialCases,body],
        --this is used below to set $lisplibSlot1 global
     $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
     $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
-    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
+    $NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList
     $NRTaddList: local := nil --list of fncts not defined in capsule (added)
     $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
     $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
@@ -668,9 +668,9 @@ compFunctorBody(body,m,e,parForm) ==
   $capsuleFunctionStack := nreverse $capsuleFunctionStack
   -- ??? Don't resolve default definitions, yet.
   if $insideCategoryPackageIfTrue then
-    COMP $capsuleFunctionStack
+    backendCompile $capsuleFunctionStack
   else 
-    COMP foldExportedFunctionReferences $capsuleFunctionStack
+    backendCompile foldExportedFunctionReferences $capsuleFunctionStack
   clearCapsuleDirectory()        -- release storage.
   body is [op,:.] and MEMQ(op,'(add CAPSULE)) => T
   $NRTaddForm :=
@@ -1265,7 +1265,7 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) ==
     $optExportedFunctionReference =>
       $capsuleFunctionStack := [form,:$capsuleFunctionStack]
       first form
-    first COMP LIST form
+    first backendCompile LIST form
   compileConstructor form
  
 compileConstructor form ==
@@ -1287,7 +1287,7 @@ compileConstructor1 (form:=[fn,[key,vl,:bodyl]]) ==
   compForm:= LIST [fn,[lambdaOrSlam,vl,:bodyl]]
   if getConstructorKindFromDB fn = "category"
       then u:= compAndDefine compForm
-      else u:=COMP compForm
+      else u:= backendCompile compForm
   clearConstructorCache fn      --clear cache for constructor
   first u
  
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index a936733b..abc58773 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -861,7 +861,7 @@ spadCompileOrSetq form ==
            macform := ['XLAM,vl',body]
            LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
            sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
-  $insideCapsuleFunctionIfTrue => first COMP LIST form
+  $insideCapsuleFunctionIfTrue => first backendCompile LIST form
   compileConstructor form
 
 coerceHard(T,m) ==
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 33768c2d..77daa492 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -124,7 +124,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
        --this is used below to set $lisplibSlot1 global
     $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
     $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
-    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
+    $NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList
     $NRTaddList: local := nil --list of fncts not defined in capsule (added)
     $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
     $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)