aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/boot/ChangeLog11
-rw-r--r--src/boot/ast.boot.pamphlet360
-rw-r--r--src/boot/parser.boot.pamphlet5
-rw-r--r--src/boot/translator.boot.pamphlet21
4 files changed, 225 insertions, 172 deletions
diff --git a/src/boot/ChangeLog b/src/boot/ChangeLog
index 9b2571be..0015cc43 100644
--- a/src/boot/ChangeLog
+++ b/src/boot/ChangeLog
@@ -1,5 +1,16 @@
2007-08-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * translator.boot.pamphlet (bpOutItem): Translate ConstantDefinition
+ nodes. Update cached Lisp translation.
+ * parser.boot.pamphlet (bpSimpleDefinitionTail): Build a
+ ConstantDefinition Ast. Update cached Lisp translation.
+ * ast.boot.pamphlet (ConstantDefinition): A separate Ast node
+ for constant definitions.
+ (bfCompDef): Don't compile ConstantDefinition here.
+ Update cached Lisp translation.
+
+2007-08-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* Makefile.pamphlet (BOOTSYS_FOR_TARGET): Remove.
(stamp): Update prerequisite.
($(axiom_build_bindir)/bootsys$(EXEEXT)): Rename from
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet
index bd38fa39..09d68b35 100644
--- a/src/boot/ast.boot.pamphlet
+++ b/src/boot/ast.boot.pamphlet
@@ -94,7 +94,8 @@ structure Ast ==
PrefixExpr(Name, Ast) -- #v
Call(Ast, Sequence) -- f(x, y , z)
InfixExpr(Name, Ast, Ast) -- x + y
- Definition(Name, List, Ast, Ast) -- x == y or f x == y
+ ConstantDefinition(Name, Ast) -- x == y
+ Definition(Name, List, Ast, Ast) -- f x == y
Macro(Name, List, Ast) -- m x ==> y
SuchThat(Ast) -- | p
Assignment(Ast, Ast) -- x := y
@@ -169,7 +170,13 @@ bfDefinition(bflhsitems, bfrhs,body) ==
bfMDefinition(bflhsitems, bfrhs,body) ==
bfMDef('MDEF,bflhsitems,bfrhs,body)
-bfCompDef [def,op,args,body]== bfDef(def,op,args,body)
+bfCompDef x ==
+ case x of
+ ConstantDefinition(n, e) => x
+ otherwise =>
+ x is [def, op, args, body] =>
+ bfDef(def,op,args,body)
+ error '"invalid AST"
bfBeginsDollar x== EQL('"$".0,(PNAME x).0)
@@ -1126,45 +1133,48 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(DEFUN |InfixExpr| #0=(|bfVar#31| |bfVar#32| |bfVar#33|)
(CONS '|InfixExpr| (LIST . #0#)))
-(DEFUN |Definition| #0=(|bfVar#34| |bfVar#35| |bfVar#36| |bfVar#37|)
+(DEFUN |ConstantDefinition| #0=(|bfVar#34| |bfVar#35|)
+ (CONS '|ConstantDefinition| (LIST . #0#)))
+
+(DEFUN |Definition| #0=(|bfVar#36| |bfVar#37| |bfVar#38| |bfVar#39|)
(CONS '|Definition| (LIST . #0#)))
-(DEFUN |Macro| #0=(|bfVar#38| |bfVar#39| |bfVar#40|)
+(DEFUN |Macro| #0=(|bfVar#40| |bfVar#41| |bfVar#42|)
(CONS '|Macro| (LIST . #0#)))
-(DEFUN |SuchThat| #0=(|bfVar#41|) (CONS '|SuchThat| (LIST . #0#)))
+(DEFUN |SuchThat| #0=(|bfVar#43|) (CONS '|SuchThat| (LIST . #0#)))
-(DEFUN |Assignment| #0=(|bfVar#42| |bfVar#43|)
+(DEFUN |Assignment| #0=(|bfVar#44| |bfVar#45|)
(CONS '|Assignment| (LIST . #0#)))
-(DEFUN |While| #0=(|bfVar#44|) (CONS '|While| (LIST . #0#)))
+(DEFUN |While| #0=(|bfVar#46|) (CONS '|While| (LIST . #0#)))
-(DEFUN |Until| #0=(|bfVar#45|) (CONS '|Until| (LIST . #0#)))
+(DEFUN |Until| #0=(|bfVar#47|) (CONS '|Until| (LIST . #0#)))
-(DEFUN |For| #0=(|bfVar#46| |bfVar#47| |bfVar#48|)
+(DEFUN |For| #0=(|bfVar#48| |bfVar#49| |bfVar#50|)
(CONS '|For| (LIST . #0#)))
-(DEFUN |Exit| #0=(|bfVar#49| |bfVar#50|) (CONS '|Exit| (LIST . #0#)))
+(DEFUN |Exit| #0=(|bfVar#51| |bfVar#52|) (CONS '|Exit| (LIST . #0#)))
-(DEFUN |Iterators| #0=(|bfVar#51|) (CONS '|Iterators| (LIST . #0#)))
+(DEFUN |Iterators| #0=(|bfVar#53|) (CONS '|Iterators| (LIST . #0#)))
-(DEFUN |Cross| #0=(|bfVar#52|) (CONS '|Cross| (LIST . #0#)))
+(DEFUN |Cross| #0=(|bfVar#54|) (CONS '|Cross| (LIST . #0#)))
-(DEFUN |Repeat| #0=(|bfVar#53| |bfVar#54|)
+(DEFUN |Repeat| #0=(|bfVar#55| |bfVar#56|)
(CONS '|Repeat| (LIST . #0#)))
-(DEFUN |Pile| #0=(|bfVar#55|) (CONS '|Pile| (LIST . #0#)))
+(DEFUN |Pile| #0=(|bfVar#57|) (CONS '|Pile| (LIST . #0#)))
-(DEFUN |Append| #0=(|bfVar#56|) (CONS '|Append| (LIST . #0#)))
+(DEFUN |Append| #0=(|bfVar#58|) (CONS '|Append| (LIST . #0#)))
-(DEFUN |Case| #0=(|bfVar#57| |bfVar#58|) (CONS '|Case| (LIST . #0#)))
+(DEFUN |Case| #0=(|bfVar#59| |bfVar#60|) (CONS '|Case| (LIST . #0#)))
-(DEFUN |Return| #0=(|bfVar#59|) (CONS '|Return| (LIST . #0#)))
+(DEFUN |Return| #0=(|bfVar#61|) (CONS '|Return| (LIST . #0#)))
-(DEFUN |Where| #0=(|bfVar#60| |bfVar#61|)
+(DEFUN |Where| #0=(|bfVar#62| |bfVar#63|)
(CONS '|Where| (LIST . #0#)))
-(DEFUN |Structure| #0=(|bfVar#62| |bfVar#63|)
+(DEFUN |Structure| #0=(|bfVar#64| |bfVar#65|)
(CONS '|Structure| (LIST . #0#)))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (DEFPARAMETER |$inDefIS| NIL))
@@ -1217,15 +1227,37 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(DEFUN |bfMDefinition| (|bflhsitems| |bfrhs| |body|)
(PROG () (RETURN (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|))))
-(DEFUN |bfCompDef| (|bfVar#64|)
- (PROG (|body| |args| |op| |def|)
+(DEFUN |bfCompDef| (|x|)
+ (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
+ |bfVar#67| |bfVar#66|)
(RETURN
(PROGN
- (SETQ |def| (CAR |bfVar#64|))
- (SETQ |op| (CADR . #0=(|bfVar#64|)))
- (SETQ |args| (CADDR . #0#))
- (SETQ |body| (CADDDR . #0#))
- (|bfDef| |def| |op| |args| |body|)))))
+ (SETQ |bfVar#66| |x|)
+ (SETQ |bfVar#67| (CDR |bfVar#66|))
+ (CASE (CAR |bfVar#66|)
+ (|ConstantDefinition|
+ (LET ((|n| (CAR |bfVar#67|)) (|e| (CADR |bfVar#67|)))
+ |x|))
+ (T (COND
+ ((AND (CONSP |x|)
+ (PROGN
+ (SETQ |def| (CAR |x|))
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |args| (CAR |ISTMP#2|))
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |body| (CAR |ISTMP#3|))
+ 'T))))))))
+ (|bfDef| |def| |op| |args| |body|))
+ ('T (|error| "invalid AST")))))))))
(DEFUN |bfBeginsDollar| (|x|)
(PROG () (RETURN (EQL (ELT "$" 0) (ELT (PNAME |x|) 0)))))
@@ -1256,22 +1288,22 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(PROGN
(SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
(COND
- (((LAMBDA (|bfVar#66| |bfVar#65| |x|)
+ (((LAMBDA (|bfVar#69| |bfVar#68| |x|)
(LOOP
(COND
- ((OR (ATOM |bfVar#65|)
- (PROGN (SETQ |x| (CAR |bfVar#65|)) NIL))
- (RETURN |bfVar#66|))
+ ((OR (ATOM |bfVar#68|)
+ (PROGN (SETQ |x| (CAR |bfVar#68|)) NIL))
+ (RETURN |bfVar#69|))
('T
(PROGN
- (SETQ |bfVar#66|
+ (SETQ |bfVar#69|
(AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(EQ (CDR |ISTMP#1|) NIL)))))
- (COND (|bfVar#66| (RETURN |bfVar#66|))))))
- (SETQ |bfVar#65| (CDR |bfVar#65|))))
+ (COND (|bfVar#69| (RETURN |bfVar#69|))))))
+ (SETQ |bfVar#68| (CDR |bfVar#68|))))
NIL |a| NIL)
(|bfMakeCons| |a|))
('T (CONS 'LIST |a|)))))))
@@ -1442,18 +1474,18 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(COND
((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
- ((LAMBDA (|bfVar#69| |bfVar#67| |i| |bfVar#68| |j|)
+ ((LAMBDA (|bfVar#72| |bfVar#70| |i| |bfVar#71| |j|)
(LOOP
(COND
- ((OR (ATOM |bfVar#67|)
- (PROGN (SETQ |i| (CAR |bfVar#67|)) NIL)
- (ATOM |bfVar#68|)
- (PROGN (SETQ |j| (CAR |bfVar#68|)) NIL))
- (RETURN (NREVERSE |bfVar#69|)))
+ ((OR (ATOM |bfVar#70|)
+ (PROGN (SETQ |i| (CAR |bfVar#70|)) NIL)
+ (ATOM |bfVar#71|)
+ (PROGN (SETQ |j| (CAR |bfVar#71|)) NIL))
+ (RETURN (NREVERSE |bfVar#72|)))
('T
- (SETQ |bfVar#69| (CONS (APPEND |i| |j|) |bfVar#69|))))
- (SETQ |bfVar#67| (CDR |bfVar#67|))
- (SETQ |bfVar#68| (CDR |bfVar#68|))))
+ (SETQ |bfVar#72| (CONS (APPEND |i| |j|) |bfVar#72|))))
+ (SETQ |bfVar#70| (CDR |bfVar#70|))
+ (SETQ |bfVar#71| (CDR |bfVar#71|))))
NIL |f| NIL |r| NIL))))))
(DEFUN |bfReduce| (|op| |y|)
@@ -2190,17 +2222,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'OR
- ((LAMBDA (|bfVar#71| |bfVar#70| |c|)
+ ((LAMBDA (|bfVar#74| |bfVar#73| |c|)
(LOOP
(COND
- ((OR (ATOM |bfVar#70|)
- (PROGN (SETQ |c| (CAR |bfVar#70|)) NIL))
- (RETURN (NREVERSE |bfVar#71|)))
+ ((OR (ATOM |bfVar#73|)
+ (PROGN (SETQ |c| (CAR |bfVar#73|)) NIL))
+ (RETURN (NREVERSE |bfVar#74|)))
('T
- (SETQ |bfVar#71|
+ (SETQ |bfVar#74|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#71|))))
- (SETQ |bfVar#70| (CDR |bfVar#70|))))
+ |bfVar#74|))))
+ (SETQ |bfVar#73| (CDR |bfVar#73|))))
NIL |l| NIL)))))))
(DEFUN |bfAND| (|l|)
@@ -2211,17 +2243,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'AND
- ((LAMBDA (|bfVar#73| |bfVar#72| |c|)
+ ((LAMBDA (|bfVar#76| |bfVar#75| |c|)
(LOOP
(COND
- ((OR (ATOM |bfVar#72|)
- (PROGN (SETQ |c| (CAR |bfVar#72|)) NIL))
- (RETURN (NREVERSE |bfVar#73|)))
+ ((OR (ATOM |bfVar#75|)
+ (PROGN (SETQ |c| (CAR |bfVar#75|)) NIL))
+ (RETURN (NREVERSE |bfVar#76|)))
('T
- (SETQ |bfVar#73|
+ (SETQ |bfVar#76|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#73|))))
- (SETQ |bfVar#72| (CDR |bfVar#72|))))
+ |bfVar#76|))))
+ (SETQ |bfVar#75| (CDR |bfVar#75|))))
NIL |l| NIL)))))))
(DEFUN |defQuoteId| (|x|)
@@ -2265,22 +2297,6 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- ((LAMBDA (|bfVar#76| |bfVar#74| |i| |bfVar#75| |j|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#74|)
- (PROGN (SETQ |i| (CAR |bfVar#74|)) NIL)
- (ATOM |bfVar#75|)
- (PROGN (SETQ |j| (CAR |bfVar#75|)) NIL))
- (RETURN (NREVERSE |bfVar#76|)))
- (#1='T
- (SETQ |bfVar#76|
- (CONS (CONS |i| |j|) |bfVar#76|))))
- (SETQ |bfVar#74| (CDR |bfVar#74|))
- (SETQ |bfVar#75| (CDR |bfVar#75|))))
- NIL |nargl| NIL |sgargl| NIL))
- (SETQ |body| (SUBLIS |sb| |body|))
- (SETQ |sb2|
((LAMBDA (|bfVar#79| |bfVar#77| |i| |bfVar#78| |j|)
(LOOP
(COND
@@ -2289,12 +2305,28 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(ATOM |bfVar#78|)
(PROGN (SETQ |j| (CAR |bfVar#78|)) NIL))
(RETURN (NREVERSE |bfVar#79|)))
- (#1#
+ (#1='T
(SETQ |bfVar#79|
- (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
- |bfVar#79|))))
+ (CONS (CONS |i| |j|) |bfVar#79|))))
(SETQ |bfVar#77| (CDR |bfVar#77|))
(SETQ |bfVar#78| (CDR |bfVar#78|))))
+ NIL |nargl| NIL |sgargl| NIL))
+ (SETQ |body| (SUBLIS |sb| |body|))
+ (SETQ |sb2|
+ ((LAMBDA (|bfVar#82| |bfVar#80| |i| |bfVar#81| |j|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#80|)
+ (PROGN (SETQ |i| (CAR |bfVar#80|)) NIL)
+ (ATOM |bfVar#81|)
+ (PROGN (SETQ |j| (CAR |bfVar#81|)) NIL))
+ (RETURN (NREVERSE |bfVar#82|)))
+ (#1#
+ (SETQ |bfVar#82|
+ (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
+ |bfVar#82|))))
+ (SETQ |bfVar#80| (CDR |bfVar#80|))
+ (SETQ |bfVar#81| (CDR |bfVar#81|))))
NIL |sgargl| NIL |largl| NIL))
(SETQ |body|
(LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
@@ -2302,18 +2334,18 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(SETQ |def| (LIST |op| |lamex|))
(|bfTuple|
(CONS (|shoeComp| |def|)
- ((LAMBDA (|bfVar#81| |bfVar#80| |d|)
+ ((LAMBDA (|bfVar#84| |bfVar#83| |d|)
(LOOP
(COND
- ((OR (ATOM |bfVar#80|)
- (PROGN (SETQ |d| (CAR |bfVar#80|)) NIL))
- (RETURN (NREVERSE |bfVar#81|)))
+ ((OR (ATOM |bfVar#83|)
+ (PROGN (SETQ |d| (CAR |bfVar#83|)) NIL))
+ (RETURN (NREVERSE |bfVar#84|)))
(#1#
- (SETQ |bfVar#81|
+ (SETQ |bfVar#84|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#81|))))
- (SETQ |bfVar#80| (CDR |bfVar#80|))))
+ |bfVar#84|))))
+ (SETQ |bfVar#83| (CDR |bfVar#83|))))
NIL |$wheredefs| NIL)))))))
(DEFUN |bfGargl| (|argl|)
@@ -2334,13 +2366,13 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
(CONS |f| |d|)))))))))
-(DEFUN |bfDef1| (|bfVar#82|)
+(DEFUN |bfDef1| (|bfVar#85|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op| |defOp|)
(RETURN
(PROGN
- (SETQ |defOp| (CAR |bfVar#82|))
- (SETQ |op| (CADR . #0=(|bfVar#82|)))
+ (SETQ |defOp| (CAR |bfVar#85|))
+ (SETQ |op| (CADR . #0=(|bfVar#85|)))
(SETQ |args| (CADDR . #0#))
(SETQ |body| (CADDDR . #0#))
(SETQ |argl|
@@ -2386,33 +2418,33 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(|bfCompHash| |op1| |arg1| |body1|)))
('T
(|bfTuple|
- ((LAMBDA (|bfVar#84| |bfVar#83| |d|)
+ ((LAMBDA (|bfVar#87| |bfVar#86| |d|)
(LOOP
(COND
- ((OR (ATOM |bfVar#83|)
- (PROGN (SETQ |d| (CAR |bfVar#83|)) NIL))
- (RETURN (NREVERSE |bfVar#84|)))
+ ((OR (ATOM |bfVar#86|)
+ (PROGN (SETQ |d| (CAR |bfVar#86|)) NIL))
+ (RETURN (NREVERSE |bfVar#87|)))
('T
- (SETQ |bfVar#84|
+ (SETQ |bfVar#87|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#84|))))
- (SETQ |bfVar#83| (CDR |bfVar#83|))))
+ |bfVar#87|))))
+ (SETQ |bfVar#86| (CDR |bfVar#86|))))
NIL (CONS (LIST |defOp| |op| |args| |body|) |$wheredefs|)
NIL)))))))
(DEFUN |shoeComps| (|x|)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#86| |bfVar#85| |def|)
+ ((LAMBDA (|bfVar#89| |bfVar#88| |def|)
(LOOP
(COND
- ((OR (ATOM |bfVar#85|)
- (PROGN (SETQ |def| (CAR |bfVar#85|)) NIL))
- (RETURN (NREVERSE |bfVar#86|)))
+ ((OR (ATOM |bfVar#88|)
+ (PROGN (SETQ |def| (CAR |bfVar#88|)) NIL))
+ (RETURN (NREVERSE |bfVar#89|)))
('T
- (SETQ |bfVar#86| (CONS (|shoeComp| |def|) |bfVar#86|))))
- (SETQ |bfVar#85| (CDR |bfVar#85|))))
+ (SETQ |bfVar#89| (CONS (|shoeComp| |def|) |bfVar#89|))))
+ (SETQ |bfVar#88| (CDR |bfVar#88|))))
NIL |x| NIL))))
(DEFUN |shoeComp| (|x|)
@@ -2623,11 +2655,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((MEMQ U '(PROG LAMBDA))
(PROGN
(SETQ |newbindings| NIL)
- ((LAMBDA (|bfVar#87| |y|)
+ ((LAMBDA (|bfVar#90| |y|)
(LOOP
(COND
- ((OR (ATOM |bfVar#87|)
- (PROGN (SETQ |y| (CAR |bfVar#87|)) NIL))
+ ((OR (ATOM |bfVar#90|)
+ (PROGN (SETQ |y| (CAR |bfVar#90|)) NIL))
(RETURN NIL))
(#1='T
(COND
@@ -2637,23 +2669,23 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#87| (CDR |bfVar#87|))))
+ (SETQ |bfVar#90| (CDR |bfVar#90|))))
(CADR |x|) NIL)
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- ((LAMBDA (|bfVar#89| |bfVar#88| |y|)
+ ((LAMBDA (|bfVar#92| |bfVar#91| |y|)
(LOOP
(COND
- ((OR (ATOM |bfVar#88|)
+ ((OR (ATOM |bfVar#91|)
(PROGN
- (SETQ |y| (CAR |bfVar#88|))
+ (SETQ |y| (CAR |bfVar#91|))
NIL))
- (RETURN (NREVERSE |bfVar#89|)))
+ (RETURN (NREVERSE |bfVar#92|)))
(#1#
(AND (NULL (MEMQ |y| |newbindings|))
- (SETQ |bfVar#89|
- (CONS |y| |bfVar#89|)))))
- (SETQ |bfVar#88| (CDR |bfVar#88|))))
+ (SETQ |bfVar#92|
+ (CONS |y| |bfVar#92|)))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|))))
NIL |$locVars| NIL))))
(#0#
(PROGN
@@ -2746,14 +2778,14 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(RETURN
(PROGN
(SETQ |a|
- ((LAMBDA (|bfVar#90| |c|)
+ ((LAMBDA (|bfVar#93| |c|)
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#90|)))
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#93|)))
('T
- (SETQ |bfVar#90|
+ (SETQ |bfVar#93|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#90|))))
+ |bfVar#93|))))
(SETQ |c| (CDR |c|))))
NIL |l|))
(COND
@@ -2774,16 +2806,16 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((EQCAR |f| 'PROGN)
(COND
((CDR |x|)
- ((LAMBDA (|bfVar#92| |bfVar#91| |i|)
+ ((LAMBDA (|bfVar#95| |bfVar#94| |i|)
(LOOP
(COND
- ((OR (ATOM |bfVar#91|)
- (PROGN (SETQ |i| (CAR |bfVar#91|)) NIL))
- (RETURN (NREVERSE |bfVar#92|)))
+ ((OR (ATOM |bfVar#94|)
+ (PROGN (SETQ |i| (CAR |bfVar#94|)) NIL))
+ (RETURN (NREVERSE |bfVar#95|)))
('T
(AND (NULL (ATOM |i|))
- (SETQ |bfVar#92| (CONS |i| |bfVar#92|)))))
- (SETQ |bfVar#91| (CDR |bfVar#91|))))
+ (SETQ |bfVar#95| (CONS |i| |bfVar#95|)))))
+ (SETQ |bfVar#94| (CDR |bfVar#94|))))
NIL (CDR |f|) NIL))
(#0# (CDR |f|))))
(#0# (LIST |f|)))))))))
@@ -2797,11 +2829,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(#0='T
(PROGN
(SETQ |transform|
- ((LAMBDA (|bfVar#94| |bfVar#93| |x|)
+ ((LAMBDA (|bfVar#97| |bfVar#96| |x|)
(LOOP
(COND
- ((OR (ATOM |bfVar#93|)
- (PROGN (SETQ |x| (CAR |bfVar#93|)) NIL)
+ ((OR (ATOM |bfVar#96|)
+ (PROGN (SETQ |x| (CAR |bfVar#96|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -2839,11 +2871,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(CAR
|ISTMP#5|))
'T))))))))))))))
- (RETURN (NREVERSE |bfVar#94|)))
+ (RETURN (NREVERSE |bfVar#97|)))
('T
- (SETQ |bfVar#94|
- (CONS (LIST |a| |b|) |bfVar#94|))))
- (SETQ |bfVar#93| (CDR |bfVar#93|))))
+ (SETQ |bfVar#97|
+ (CONS (LIST |a| |b|) |bfVar#97|))))
+ (SETQ |bfVar#96| (CDR |bfVar#96|))))
NIL |l| NIL))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
@@ -2877,12 +2909,12 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- ((LAMBDA (|bfVar#96| |bfVar#95| |d|)
+ ((LAMBDA (|bfVar#99| |bfVar#98| |d|)
(LOOP
(COND
- ((OR (ATOM |bfVar#95|)
- (PROGN (SETQ |d| (CAR |bfVar#95|)) NIL))
- (RETURN (NREVERSE |bfVar#96|)))
+ ((OR (ATOM |bfVar#98|)
+ (PROGN (SETQ |d| (CAR |bfVar#98|)) NIL))
+ (RETURN (NREVERSE |bfVar#99|)))
('T
(AND (CONSP |d|)
(PROGN
@@ -2901,11 +2933,11 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(PROGN
(SETQ |body| (CAR |ISTMP#3|))
'T)))))))
- (SETQ |bfVar#96|
+ (SETQ |bfVar#99|
(CONS (LIST |def| |op| |args|
(|bfSUBLIS| |opassoc| |body|))
- |bfVar#96|)))))
- (SETQ |bfVar#95| (CDR |bfVar#95|))))
+ |bfVar#99|)))))
+ (SETQ |bfVar#98| (CDR |bfVar#98|))))
NIL |defs| NIL))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
@@ -2983,16 +3015,16 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(PROG ()
(RETURN
(|bfTuple|
- ((LAMBDA (|bfVar#98| |bfVar#97| |i|)
+ ((LAMBDA (|bfVar#101| |bfVar#100| |i|)
(LOOP
(COND
- ((OR (ATOM |bfVar#97|)
- (PROGN (SETQ |i| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
+ ((OR (ATOM |bfVar#100|)
+ (PROGN (SETQ |i| (CAR |bfVar#100|)) NIL))
+ (RETURN (NREVERSE |bfVar#101|)))
('T
- (SETQ |bfVar#98|
- (CONS (|bfCreateDef| |i|) |bfVar#98|))))
- (SETQ |bfVar#97| (CDR |bfVar#97|))))
+ (SETQ |bfVar#101|
+ (CONS (|bfCreateDef| |i|) |bfVar#101|))))
+ (SETQ |bfVar#100| (CDR |bfVar#100|))))
NIL |arglist| NIL)))))
(DEFUN |bfCreateDef| (|x|)
@@ -3003,16 +3035,16 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
('T
(SETQ |a|
- ((LAMBDA (|bfVar#100| |bfVar#99| |i|)
+ ((LAMBDA (|bfVar#103| |bfVar#102| |i|)
(LOOP
(COND
- ((OR (ATOM |bfVar#99|)
- (PROGN (SETQ |i| (CAR |bfVar#99|)) NIL))
- (RETURN (NREVERSE |bfVar#100|)))
+ ((OR (ATOM |bfVar#102|)
+ (PROGN (SETQ |i| (CAR |bfVar#102|)) NIL))
+ (RETURN (NREVERSE |bfVar#103|)))
('T
- (SETQ |bfVar#100|
- (CONS (|bfGenSymbol|) |bfVar#100|))))
- (SETQ |bfVar#99| (CDR |bfVar#99|))))
+ (SETQ |bfVar#103|
+ (CONS (|bfGenSymbol|) |bfVar#103|))))
+ (SETQ |bfVar#102| (CDR |bfVar#102|))))
NIL (CDR |x|) NIL))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -3034,22 +3066,22 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- ((LAMBDA (|bfVar#103| |bfVar#102| |bfVar#101|)
+ ((LAMBDA (|bfVar#106| |bfVar#105| |bfVar#104|)
(LOOP
(COND
- ((OR (ATOM |bfVar#102|)
- (PROGN (SETQ |bfVar#101| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
+ ((OR (ATOM |bfVar#105|)
+ (PROGN (SETQ |bfVar#104| (CAR |bfVar#105|)) NIL))
+ (RETURN (NREVERSE |bfVar#106|)))
('T
- (AND (CONSP |bfVar#101|)
+ (AND (CONSP |bfVar#104|)
(PROGN
- (SETQ |i| (CAR |bfVar#101|))
- (SETQ |ISTMP#1| (CDR |bfVar#101|))
+ (SETQ |i| (CAR |bfVar#104|))
+ (SETQ |ISTMP#1| (CDR |bfVar#104|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
- (SETQ |bfVar#103|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#103|)))))
- (SETQ |bfVar#102| (CDR |bfVar#102|))))
+ (SETQ |bfVar#106|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#106|)))))
+ (SETQ |bfVar#105| (CDR |bfVar#105|))))
NIL |x| NIL))))
(DEFUN |bfCI| (|g| |x| |y|)
@@ -3061,17 +3093,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL |a|) (LIST (CAR |x|) |y|))
('T
(SETQ |b|
- ((LAMBDA (|bfVar#105| |bfVar#104| |i| |j|)
+ ((LAMBDA (|bfVar#108| |bfVar#107| |i| |j|)
(LOOP
(COND
- ((OR (ATOM |bfVar#104|)
- (PROGN (SETQ |i| (CAR |bfVar#104|)) NIL))
- (RETURN (NREVERSE |bfVar#105|)))
+ ((OR (ATOM |bfVar#107|)
+ (PROGN (SETQ |i| (CAR |bfVar#107|)) NIL))
+ (RETURN (NREVERSE |bfVar#108|)))
('T
- (SETQ |bfVar#105|
+ (SETQ |bfVar#108|
(CONS (LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#105|))))
- (SETQ |bfVar#104| (CDR |bfVar#104|))
+ |bfVar#108|))))
+ (SETQ |bfVar#107| (CDR |bfVar#107|))
(SETQ |j| (+ |j| 1))))
NIL |a| NIL 0))
(LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet
index 043dde0f..eb68fa1e 100644
--- a/src/boot/parser.boot.pamphlet
+++ b/src/boot/parser.boot.pamphlet
@@ -848,7 +848,7 @@ bpDDef() == bpName() and bpDefTail()
bpSimpleDefinitionTail() ==
bpEqKey "DEF" and
(bpWhere() or bpTrap())
- and bpPush bfDefinition(bpPop2(),bfTuple nil, bpPop1())
+ and bpPush ConstantDefinition(bpPop2(), bpPop1())
++ Parse the remaining of a compound definition.
bpCompoundDefinitionTail() ==
@@ -2099,8 +2099,7 @@ bpCaseItem()==
(PROG ()
(RETURN
(AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
- (|bpPush|
- (|bfDefinition| (|bpPop2|) (|bfTuple| NIL) (|bpPop1|)))))))
+ (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|)))))))
(DEFUN |bpCompoundDefinitionTail| ()
(PROG ()
diff --git a/src/boot/translator.boot.pamphlet b/src/boot/translator.boot.pamphlet
index 384fdbde..c805b20b 100644
--- a/src/boot/translator.boot.pamphlet
+++ b/src/boot/translator.boot.pamphlet
@@ -408,9 +408,18 @@ bpOutItem()==
b is ["L%T",l,r] and IDENTP l =>
bpPush [shoeEVALANDFILEACTQ ["DEFPARAMETER",l,r]]
case b of
- Module(m) => bpPush [shoeCompileTimeEvaluation ["PROVIDE", m]]
- Import(m) => bpPush [["IMPORT-MODULE", m]]
- TypeAlias(t, args, rhs) => bpPush [["DEFTYPE", t, args, ["QUOTE", rhs]]]
+ Module(m) =>
+ bpPush [shoeCompileTimeEvaluation ["PROVIDE", m]]
+
+ Import(m) =>
+ bpPush [["IMPORT-MODULE", m]]
+
+ TypeAlias(t, args, rhs) =>
+ bpPush [["DEFTYPE", t, args, ["QUOTE", rhs]]]
+
+ ConstantDefinition(n, e) =>
+ bpPush [["DEFCONSTANT", n, e]]
+
otherwise =>
b:=shoeCompTran ["LAMBDA",["x"],b]
bpPush [shoeEVALANDFILEACTQ CADDR b]
@@ -1272,8 +1281,7 @@ associateRequestWithFileType(Option '"compile", '"boot",
(LIST 'PROVIDE |m|))))))
(|Import|
(LET ((|m| (CAR |bfVar#6|)))
- (|bpPush|
- (LIST (LIST 'IMPORT-MODULE |m|)))))
+ (|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
(|TypeAlias|
(LET ((|t| (CAR |bfVar#6|))
(|args| (CADR |bfVar#6|))
@@ -1281,6 +1289,9 @@ associateRequestWithFileType(Option '"compile", '"boot",
(|bpPush|
(LIST (LIST 'DEFTYPE |t| |args|
(LIST 'QUOTE |rhs|))))))
+ (|ConstantDefinition|
+ (LET ((|n| (CAR |bfVar#6|)) (|e| (CADR |bfVar#6|)))
+ (|bpPush| (LIST (LIST 'DEFCONSTANT |n| |e|)))))
(T (PROGN
(SETQ |b|
(|shoeCompTran|
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 00:01:01 +0000