aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-10-16 04:06:43 +0000
committerdos-reis <gdr@axiomatics.org>2008-10-16 04:06:43 +0000
commit50eb3f193c9430ce498b89680442a703544f75f9 (patch)
tree1278adf08afe35d2a79ff21215371169a5f4286c /src
parenta865b3c1924286ed6308753b31b4eddaf0794687 (diff)
downloadopen-axiom-50eb3f193c9430ce498b89680442a703544f75f9.tar.gz
* 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.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/c-util.boot42
-rw-r--r--src/interp/clam.boot2
-rw-r--r--src/interp/compiler.boot44
-rw-r--r--src/interp/debug.lisp6
-rw-r--r--src/interp/def.lisp6
-rw-r--r--src/interp/define.boot10
-rw-r--r--src/interp/wi1.boot2
-rw-r--r--src/interp/wi2.boot2
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)