aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ChangeLog11
-rw-r--r--src/boot/ast.boot.pamphlet659
-rw-r--r--src/boot/includer.boot.pamphlet46
-rw-r--r--src/boot/parser.boot.pamphlet181
-rw-r--r--src/boot/scanner.boot.pamphlet122
-rw-r--r--src/boot/tokens.boot.pamphlet477
-rw-r--r--src/boot/translator.boot.pamphlet376
7 files changed, 969 insertions, 903 deletions
diff --git a/src/boot/ChangeLog b/src/boot/ChangeLog
index 5354e39f..cf785f41 100644
--- a/src/boot/ChangeLog
+++ b/src/boot/ChangeLog
@@ -1,3 +1,14 @@
+2007-10-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * ast.boot.pamphlet (bfLp1): Simplify loop code generation.
+ Update cached Lisp translation.
+ * includer.boot.pamphlet: Update cached Lisp translation.
+ * parser.boot.pamphlet: Likewise.
+ * pile.boot.pamphlet: Likewise.
+ * scanner.boot.pamphlet: Likewise.
+ * tokens.boot.pamphlet: Likewise.
+ * translator.boot.pamphlet: Likewise.
+
2007-10-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
* ast.boot.pamphlet (bfSUBLIS1): Return fix point.
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet
index 02c99679..20371331 100644
--- a/src/boot/ast.boot.pamphlet
+++ b/src/boot/ast.boot.pamphlet
@@ -374,9 +374,9 @@ bfLp1(iters,body)==
value:=if null value then "NIL" else car value
exits:= ["COND",[bfOR exits,["RETURN",value]],
['(QUOTE T),nbody]]
- loop:=
- [["LAMBDA",vars,
- ["LOOP",exits,:sucs]],:inits]
+ loop := ["LOOP",exits,:sucs]
+ if vars then loop :=
+ ["LET",[[v, i] for v in vars for i in inits], loop]
loop
bfLp2(extrait,itl,body)==
@@ -1212,7 +1212,7 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(DEFUN |Structure| #0=(|bfVar#64| |bfVar#65|)
(CONS '|Structure| (LIST . #0#)))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (DEFPARAMETER |$inDefIS| NIL))
+(DEFPARAMETER |$inDefIS| NIL)
(DEFUN |bfGenSymbol| ()
(PROG ()
@@ -1323,23 +1323,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#69| |bfVar#68| |x|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#68|)
- (PROGN (SETQ |x| (CAR |bfVar#68|)) NIL))
- (RETURN |bfVar#69|))
- ('T
- (PROGN
- (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#69| (RETURN |bfVar#69|))))))
- (SETQ |bfVar#68| (CDR |bfVar#68|))))
- NIL |a| NIL)
+ ((LET ((|bfVar#69| NIL) (|bfVar#68| |a|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#68|)
+ (PROGN (SETQ |x| (CAR |bfVar#68|)) NIL))
+ (RETURN |bfVar#69|))
+ ('T
+ (PROGN
+ (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#69| (RETURN |bfVar#69|))))))
+ (SETQ |bfVar#68| (CDR |bfVar#68|))))
(|bfMakeCons| |a|))
('T (CONS 'LIST |a|)))))))
@@ -1509,19 +1508,19 @@ 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#72| |bfVar#70| |i| |bfVar#71| |j|)
- (LOOP
- (COND
- ((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#72| (CONS (APPEND |i| |j|) |bfVar#72|))))
- (SETQ |bfVar#70| (CDR |bfVar#70|))
- (SETQ |bfVar#71| (CDR |bfVar#71|))))
- NIL |f| NIL |r| NIL))))))
+ (LET ((|bfVar#72| NIL) (|bfVar#70| |f|) (|i| NIL)
+ (|bfVar#71| |r|) (|j| NIL))
+ (LOOP
+ (COND
+ ((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#72| (CONS (APPEND |i| |j|) |bfVar#72|))))
+ (SETQ |bfVar#70| (CDR |bfVar#70|))
+ (SETQ |bfVar#71| (CDR |bfVar#71|)))))))))
(DEFUN |bfReduce| (|op| |y|)
(PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
@@ -1634,10 +1633,30 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(LIST 'COND
(LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
(LIST ''T |nbody|)))
- (SETQ |loop|
- (CONS (LIST 'LAMBDA |vars|
- (CONS 'LOOP (CONS |exits| |sucs|)))
- |inits|))
+ (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|)))
+ (COND
+ (|vars| (SETQ |loop|
+ (LIST 'LET
+ (LET ((|bfVar#75| NIL)
+ (|bfVar#73| |vars|) (|v| NIL)
+ (|bfVar#74| |inits|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#73|)
+ (PROGN
+ (SETQ |v| (CAR |bfVar#73|))
+ NIL)
+ (ATOM |bfVar#74|)
+ (PROGN
+ (SETQ |i| (CAR |bfVar#74|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#75|)))
+ ('T
+ (SETQ |bfVar#75|
+ (CONS (LIST |v| |i|) |bfVar#75|))))
+ (SETQ |bfVar#73| (CDR |bfVar#73|))
+ (SETQ |bfVar#74| (CDR |bfVar#74|))))
+ |loop|))))
|loop|))))
(DEFUN |bfLp2| (|extrait| |itl| |body|)
@@ -1747,7 +1766,7 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(PROGN
(SETQ |f| (CAR |p|))
(COND
- ((EQ (CAR |f|) |e|) (CDR |f|))
+ ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|)))
(#0# (|bfSUBLIS1| (CDR |p|) |e|)))))))))
(DEFUN |defSheepAndGoats| (|x|)
@@ -2206,12 +2225,33 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
('T (CONS |bfop| (LIST |bfarg|)))))))
-(DEFUN |bfReName| (|x|)
+(DEFUN |bfGetOldBootName| (|x|)
(PROG (|a|)
(RETURN
+ (COND ((SETQ |a| (GET |x| 'OLD-BOOT)) (CAR |a|)) ('T |x|)))))
+
+(DEFUN |bfSameMeaning| (|x|) (PROG () (RETURN (GET |x| 'RENAME-OK))))
+
+(DEFUN |bfReName| (|x|)
+ (PROG (|oldName| |newName| |a|)
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (RETURN
(PROGN
- (SETQ |a| (GET |x| 'SHOERENAME))
- (COND (|a| (CAR |a|)) ('T |x|))))))
+ (SETQ |newName|
+ (COND
+ ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|))
+ (#0='T |x|)))
+ (COND
+ ((AND |$translatingOldBoot| (NULL (|bfSameMeaning| |x|)))
+ (PROGN
+ (SETQ |oldName| (|bfGetOldBootName| |x|))
+ (COND
+ ((NOT (EQUAL |newName| |oldName|))
+ (|warn| (LIST (PNAME |x|) " as `" (PNAME |newName|)
+ "' differs from Old Boot `"
+ (PNAME |oldName|) "'"))))
+ |oldName|))
+ (#0# |newName|))))))
(DEFUN |bfInfApplication| (|op| |left| |right|)
(PROG ()
@@ -2257,18 +2297,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'OR
- ((LAMBDA (|bfVar#74| |bfVar#73| |c|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#73|)
- (PROGN (SETQ |c| (CAR |bfVar#73|)) NIL))
- (RETURN (NREVERSE |bfVar#74|)))
- ('T
- (SETQ |bfVar#74|
- (APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#74|))))
- (SETQ |bfVar#73| (CDR |bfVar#73|))))
- NIL |l| NIL)))))))
+ (LET ((|bfVar#77| NIL) (|bfVar#76| |l|) (|c| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#76|)
+ (PROGN (SETQ |c| (CAR |bfVar#76|)) NIL))
+ (RETURN (NREVERSE |bfVar#77|)))
+ ('T
+ (SETQ |bfVar#77|
+ (APPEND (REVERSE (|bfFlatten| 'OR |c|))
+ |bfVar#77|))))
+ (SETQ |bfVar#76| (CDR |bfVar#76|))))))))))
(DEFUN |bfAND| (|l|)
(PROG ()
@@ -2278,18 +2317,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'AND
- ((LAMBDA (|bfVar#76| |bfVar#75| |c|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#75|)
- (PROGN (SETQ |c| (CAR |bfVar#75|)) NIL))
- (RETURN (NREVERSE |bfVar#76|)))
- ('T
- (SETQ |bfVar#76|
- (APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#76|))))
- (SETQ |bfVar#75| (CDR |bfVar#75|))))
- NIL |l| NIL)))))))
+ (LET ((|bfVar#79| NIL) (|bfVar#78| |l|) (|c| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#78|)
+ (PROGN (SETQ |c| (CAR |bfVar#78|)) NIL))
+ (RETURN (NREVERSE |bfVar#79|)))
+ ('T
+ (SETQ |bfVar#79|
+ (APPEND (REVERSE (|bfFlatten| 'AND |c|))
+ |bfVar#79|))))
+ (SETQ |bfVar#78| (CDR |bfVar#78|))))))))))
(DEFUN |defQuoteId| (|x|)
(PROG () (RETURN (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))))
@@ -2332,56 +2370,55 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- ((LAMBDA (|bfVar#79| |bfVar#77| |i| |bfVar#78| |j|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#77|)
- (PROGN (SETQ |i| (CAR |bfVar#77|)) NIL)
- (ATOM |bfVar#78|)
- (PROGN (SETQ |j| (CAR |bfVar#78|)) NIL))
- (RETURN (NREVERSE |bfVar#79|)))
- (#1='T
- (SETQ |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))
+ (LET ((|bfVar#82| NIL) (|bfVar#80| |nargl|) (|i| NIL)
+ (|bfVar#81| |sgargl|) (|j| NIL))
+ (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='T
+ (SETQ |bfVar#82| (CONS (CONS |i| |j|) |bfVar#82|))))
+ (SETQ |bfVar#80| (CDR |bfVar#80|))
+ (SETQ |bfVar#81| (CDR |bfVar#81|)))))
(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))
+ (LET ((|bfVar#85| NIL) (|bfVar#83| |sgargl|) (|i| NIL)
+ (|bfVar#84| |largl|) (|j| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#83|)
+ (PROGN (SETQ |i| (CAR |bfVar#83|)) NIL)
+ (ATOM |bfVar#84|)
+ (PROGN (SETQ |j| (CAR |bfVar#84|)) NIL))
+ (RETURN (NREVERSE |bfVar#85|)))
+ (#1#
+ (SETQ |bfVar#85|
+ (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
+ |bfVar#85|))))
+ (SETQ |bfVar#83| (CDR |bfVar#83|))
+ (SETQ |bfVar#84| (CDR |bfVar#84|)))))
(SETQ |body|
(LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
(SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
(SETQ |def| (LIST |op| |lamex|))
(|bfTuple|
(CONS (|shoeComp| |def|)
- ((LAMBDA (|bfVar#84| |bfVar#83| |d|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#83|)
- (PROGN (SETQ |d| (CAR |bfVar#83|)) NIL))
- (RETURN (NREVERSE |bfVar#84|)))
- (#1#
- (SETQ |bfVar#84|
- (APPEND (REVERSE
- (|shoeComps| (|bfDef1| |d|)))
- |bfVar#84|))))
- (SETQ |bfVar#83| (CDR |bfVar#83|))))
- NIL |$wheredefs| NIL)))))))
+ (LET ((|bfVar#87| NIL) (|bfVar#86| |$wheredefs|)
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#86|)
+ (PROGN (SETQ |d| (CAR |bfVar#86|)) NIL))
+ (RETURN (NREVERSE |bfVar#87|)))
+ (#1#
+ (SETQ |bfVar#87|
+ (APPEND (REVERSE
+ (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#87|))))
+ (SETQ |bfVar#86| (CDR |bfVar#86|))))))))))
(DEFUN |bfGargl| (|argl|)
(PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -2401,13 +2438,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#85|)
+(DEFUN |bfDef1| (|bfVar#88|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op| |defOp|)
(RETURN
(PROGN
- (SETQ |defOp| (CAR |bfVar#85|))
- (SETQ |op| (CADR . #0=(|bfVar#85|)))
+ (SETQ |defOp| (CAR |bfVar#88|))
+ (SETQ |op| (CADR . #0=(|bfVar#88|)))
(SETQ |args| (CADDR . #0#))
(SETQ |body| (CADDDR . #0#))
(SETQ |argl|
@@ -2453,34 +2490,33 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(|bfCompHash| |op1| |arg1| |body1|)))
('T
(|bfTuple|
- ((LAMBDA (|bfVar#87| |bfVar#86| |d|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#86|)
- (PROGN (SETQ |d| (CAR |bfVar#86|)) NIL))
- (RETURN (NREVERSE |bfVar#87|)))
- ('T
- (SETQ |bfVar#87|
- (APPEND (REVERSE
- (|shoeComps| (|bfDef1| |d|)))
- |bfVar#87|))))
- (SETQ |bfVar#86| (CDR |bfVar#86|))))
- NIL (CONS (LIST |defOp| |op| |args| |body|) |$wheredefs|)
- NIL)))))))
+ (LET ((|bfVar#90| NIL)
+ (|bfVar#89|
+ (CONS (LIST |defOp| |op| |args| |body|)
+ |$wheredefs|))
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#89|)
+ (PROGN (SETQ |d| (CAR |bfVar#89|)) NIL))
+ (RETURN (NREVERSE |bfVar#90|)))
+ ('T
+ (SETQ |bfVar#90|
+ (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#90|))))
+ (SETQ |bfVar#89| (CDR |bfVar#89|))))))))))
(DEFUN |shoeComps| (|x|)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#89| |bfVar#88| |def|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#88|)
- (PROGN (SETQ |def| (CAR |bfVar#88|)) NIL))
- (RETURN (NREVERSE |bfVar#89|)))
- ('T
- (SETQ |bfVar#89| (CONS (|shoeComp| |def|) |bfVar#89|))))
- (SETQ |bfVar#88| (CDR |bfVar#88|))))
- NIL |x| NIL))))
+ (LET ((|bfVar#92| NIL) (|bfVar#91| |x|) (|def| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#91|)
+ (PROGN (SETQ |def| (CAR |bfVar#91|)) NIL))
+ (RETURN (NREVERSE |bfVar#92|)))
+ ('T (SETQ |bfVar#92| (CONS (|shoeComp| |def|) |bfVar#92|))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|)))))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -2690,38 +2726,37 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((MEMQ U '(PROG LAMBDA))
(PROGN
(SETQ |newbindings| NIL)
- ((LAMBDA (|bfVar#90| |y|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#90|)
- (PROGN (SETQ |y| (CAR |bfVar#90|)) NIL))
- (RETURN NIL))
- (#1='T
- (COND
- ((NULL (MEMQ |y| |$locVars|))
- (IDENTITY (PROGN
- (SETQ |$locVars|
- (CONS |y| |$locVars|))
- (SETQ |newbindings|
- (CONS |y| |newbindings|))))))))
- (SETQ |bfVar#90| (CDR |bfVar#90|))))
- (CADR |x|) NIL)
+ (LET ((|bfVar#93| (CADR |x|)) (|y| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#93|)
+ (PROGN (SETQ |y| (CAR |bfVar#93|)) NIL))
+ (RETURN NIL))
+ (#1='T
+ (COND
+ ((NULL (MEMQ |y| |$locVars|))
+ (IDENTITY
+ (PROGN
+ (SETQ |$locVars| (CONS |y| |$locVars|))
+ (SETQ |newbindings|
+ (CONS |y| |newbindings|))))))))
+ (SETQ |bfVar#93| (CDR |bfVar#93|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- ((LAMBDA (|bfVar#92| |bfVar#91| |y|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#91|)
- (PROGN
- (SETQ |y| (CAR |bfVar#91|))
- NIL))
- (RETURN (NREVERSE |bfVar#92|)))
- (#1#
- (AND (NULL (MEMQ |y| |newbindings|))
- (SETQ |bfVar#92|
- (CONS |y| |bfVar#92|)))))
- (SETQ |bfVar#91| (CDR |bfVar#91|))))
- NIL |$locVars| NIL))))
+ (LET ((|bfVar#95| NIL) (|bfVar#94| |$locVars|)
+ (|y| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#94|)
+ (PROGN
+ (SETQ |y| (CAR |bfVar#94|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#95|)))
+ (#1#
+ (AND (NULL (MEMQ |y| |newbindings|))
+ (SETQ |bfVar#95|
+ (CONS |y| |bfVar#95|)))))
+ (SETQ |bfVar#94| (CDR |bfVar#94|)))))))
(#0#
(PROGN
(|shoeCompTran1| (CAR |x|))
@@ -2813,16 +2848,15 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(RETURN
(PROGN
(SETQ |a|
- ((LAMBDA (|bfVar#93| |c|)
- (LOOP
- (COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#93|)))
- ('T
- (SETQ |bfVar#93|
- (APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#93|))))
- (SETQ |c| (CDR |c|))))
- NIL |l|))
+ (LET ((|bfVar#96| NIL) (|c| |l|))
+ (LOOP
+ (COND
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#96|)))
+ ('T
+ (SETQ |bfVar#96|
+ (APPEND (REVERSE (|bfFlattenSeq| |c|))
+ |bfVar#96|))))
+ (SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
((NULL (CDR |a|)) (CAR |a|))
@@ -2841,17 +2875,17 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((EQCAR |f| 'PROGN)
(COND
((CDR |x|)
- ((LAMBDA (|bfVar#95| |bfVar#94| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#94|)
- (PROGN (SETQ |i| (CAR |bfVar#94|)) NIL))
- (RETURN (NREVERSE |bfVar#95|)))
- ('T
- (AND (NULL (ATOM |i|))
- (SETQ |bfVar#95| (CONS |i| |bfVar#95|)))))
- (SETQ |bfVar#94| (CDR |bfVar#94|))))
- NIL (CDR |f|) NIL))
+ (LET ((|bfVar#98| NIL) (|bfVar#97| (CDR |f|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#97|)
+ (PROGN (SETQ |i| (CAR |bfVar#97|)) NIL))
+ (RETURN (NREVERSE |bfVar#98|)))
+ ('T
+ (AND (NULL (ATOM |i|))
+ (SETQ |bfVar#98| (CONS |i| |bfVar#98|)))))
+ (SETQ |bfVar#97| (CDR |bfVar#97|)))))
(#0# (CDR |f|))))
(#0# (LIST |f|)))))))))
@@ -2864,54 +2898,50 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(#0='T
(PROGN
(SETQ |transform|
- ((LAMBDA (|bfVar#97| |bfVar#96| |x|)
- (LOOP
- (COND
- ((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|))
- (AND (CONSP |ISTMP#1|)
- (EQ (CDR |ISTMP#1|) NIL)
- (PROGN
- (SETQ |ISTMP#2|
- (CAR |ISTMP#1|))
- (AND (CONSP |ISTMP#2|)
- (PROGN
- (SETQ |a|
- (CAR |ISTMP#2|))
- (SETQ |ISTMP#3|
- (CDR |ISTMP#2|))
- (AND (CONSP |ISTMP#3|)
- (EQ (CDR |ISTMP#3|)
- NIL)
- (PROGN
- (SETQ |ISTMP#4|
- (CAR |ISTMP#3|))
- (AND
- (CONSP |ISTMP#4|)
- (EQ (CAR |ISTMP#4|)
- 'IDENTITY)
- (PROGN
- (SETQ |ISTMP#5|
- (CDR |ISTMP#4|))
- (AND
- (CONSP |ISTMP#5|)
- (EQ
- (CDR |ISTMP#5|)
- NIL)
- (PROGN
- (SETQ |b|
- (CAR
- |ISTMP#5|))
- 'T))))))))))))))
- (RETURN (NREVERSE |bfVar#97|)))
- ('T
- (SETQ |bfVar#97|
- (CONS (LIST |a| |b|) |bfVar#97|))))
- (SETQ |bfVar#96| (CDR |bfVar#96|))))
- NIL |l| NIL))
+ (LET ((|bfVar#100| NIL) (|bfVar#99| |l|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#99|)
+ (PROGN (SETQ |x| (CAR |bfVar#99|)) NIL)
+ (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN
+ (SETQ |ISTMP#2|
+ (CAR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |a|
+ (CAR |ISTMP#2|))
+ (SETQ |ISTMP#3|
+ (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |ISTMP#4|
+ (CAR |ISTMP#3|))
+ (AND (CONSP |ISTMP#4|)
+ (EQ (CAR |ISTMP#4|)
+ 'IDENTITY)
+ (PROGN
+ (SETQ |ISTMP#5|
+ (CDR |ISTMP#4|))
+ (AND
+ (CONSP |ISTMP#5|)
+ (EQ
+ (CDR |ISTMP#5|)
+ NIL)
+ (PROGN
+ (SETQ |b|
+ (CAR |ISTMP#5|))
+ 'T))))))))))))))
+ (RETURN (NREVERSE |bfVar#100|)))
+ ('T
+ (SETQ |bfVar#100|
+ (CONS (LIST |a| |b|) |bfVar#100|))))
+ (SETQ |bfVar#99| (CDR |bfVar#99|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -2944,36 +2974,35 @@ 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#99| |bfVar#98| |d|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#98|)
- (PROGN (SETQ |d| (CAR |bfVar#98|)) NIL))
- (RETURN (NREVERSE |bfVar#99|)))
- ('T
- (AND (CONSP |d|)
- (PROGN
- (SETQ |def| (CAR |d|))
- (SETQ |ISTMP#1| (CDR |d|))
- (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)))))))
- (SETQ |bfVar#99|
- (CONS (LIST |def| |op| |args|
- (|bfSUBLIS| |opassoc| |body|))
- |bfVar#99|)))))
- (SETQ |bfVar#98| (CDR |bfVar#98|))))
- NIL |defs| NIL))
+ (LET ((|bfVar#102| NIL) (|bfVar#101| |defs|) (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#101|)
+ (PROGN (SETQ |d| (CAR |bfVar#101|)) NIL))
+ (RETURN (NREVERSE |bfVar#102|)))
+ ('T
+ (AND (CONSP |d|)
+ (PROGN
+ (SETQ |def| (CAR |d|))
+ (SETQ |ISTMP#1| (CDR |d|))
+ (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)))))))
+ (SETQ |bfVar#102|
+ (CONS (LIST |def| |op| |args|
+ (|bfSUBLIS| |opassoc| |body|))
+ |bfVar#102|)))))
+ (SETQ |bfVar#101| (CDR |bfVar#101|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -3050,17 +3079,16 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
(PROG ()
(RETURN
(|bfTuple|
- ((LAMBDA (|bfVar#101| |bfVar#100| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#100|)
- (PROGN (SETQ |i| (CAR |bfVar#100|)) NIL))
- (RETURN (NREVERSE |bfVar#101|)))
- ('T
- (SETQ |bfVar#101|
- (CONS (|bfCreateDef| |i|) |bfVar#101|))))
- (SETQ |bfVar#100| (CDR |bfVar#100|))))
- NIL |arglist| NIL)))))
+ (LET ((|bfVar#104| NIL) (|bfVar#103| |arglist|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#103|)
+ (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL))
+ (RETURN (NREVERSE |bfVar#104|)))
+ ('T
+ (SETQ |bfVar#104|
+ (CONS (|bfCreateDef| |i|) |bfVar#104|))))
+ (SETQ |bfVar#103| (CDR |bfVar#103|))))))))
(DEFUN |bfCreateDef| (|x|)
(PROG (|a| |f|)
@@ -3070,17 +3098,17 @@ 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#103| |bfVar#102| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#102|)
- (PROGN (SETQ |i| (CAR |bfVar#102|)) NIL))
- (RETURN (NREVERSE |bfVar#103|)))
- ('T
- (SETQ |bfVar#103|
- (CONS (|bfGenSymbol|) |bfVar#103|))))
- (SETQ |bfVar#102| (CDR |bfVar#102|))))
- NIL (CDR |x|) NIL))
+ (LET ((|bfVar#106| NIL) (|bfVar#105| (CDR |x|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#105|)
+ (PROGN (SETQ |i| (CAR |bfVar#105|)) NIL))
+ (RETURN (NREVERSE |bfVar#106|)))
+ ('T
+ (SETQ |bfVar#106|
+ (CONS (|bfGenSymbol|) |bfVar#106|))))
+ (SETQ |bfVar#105| (CDR |bfVar#105|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -3101,23 +3129,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#106| |bfVar#105| |bfVar#104|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#105|)
- (PROGN (SETQ |bfVar#104| (CAR |bfVar#105|)) NIL))
- (RETURN (NREVERSE |bfVar#106|)))
- ('T
- (AND (CONSP |bfVar#104|)
- (PROGN
- (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#106|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#106|)))))
- (SETQ |bfVar#105| (CDR |bfVar#105|))))
- NIL |x| NIL))))
+ (LET ((|bfVar#109| NIL) (|bfVar#108| |x|) (|bfVar#107| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#108|)
+ (PROGN (SETQ |bfVar#107| (CAR |bfVar#108|)) NIL))
+ (RETURN (NREVERSE |bfVar#109|)))
+ ('T
+ (AND (CONSP |bfVar#107|)
+ (PROGN
+ (SETQ |i| (CAR |bfVar#107|))
+ (SETQ |ISTMP#1| (CDR |bfVar#107|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
+ (SETQ |bfVar#109|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#109|)))))
+ (SETQ |bfVar#108| (CDR |bfVar#108|)))))))
(DEFUN |bfCI| (|g| |x| |y|)
(PROG (|b| |a|)
@@ -3128,19 +3155,19 @@ bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
((NULL |a|) (LIST (CAR |x|) |y|))
('T
(SETQ |b|
- ((LAMBDA (|bfVar#108| |bfVar#107| |i| |j|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#107|)
- (PROGN (SETQ |i| (CAR |bfVar#107|)) NIL))
- (RETURN (NREVERSE |bfVar#108|)))
- ('T
- (SETQ |bfVar#108|
- (CONS (LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#108|))))
- (SETQ |bfVar#107| (CDR |bfVar#107|))
- (SETQ |j| (+ |j| 1))))
- NIL |a| NIL 0))
+ (LET ((|bfVar#111| NIL) (|bfVar#110| |a|) (|i| NIL)
+ (|j| 0))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#110|)
+ (PROGN (SETQ |i| (CAR |bfVar#110|)) NIL))
+ (RETURN (NREVERSE |bfVar#111|)))
+ ('T
+ (SETQ |bfVar#111|
+ (CONS (LIST |i| (|bfCARCDR| |j| |g|))
+ |bfVar#111|))))
+ (SETQ |bfVar#110| (CDR |bfVar#110|))
+ (SETQ |j| (+ |j| 1)))))
(LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
(DEFUN |bfCARCDR| (|n| |g|)
diff --git a/src/boot/includer.boot.pamphlet b/src/boot/includer.boot.pamphlet
index e613d5c4..9775aeb1 100644
--- a/src/boot/includer.boot.pamphlet
+++ b/src/boot/includer.boot.pamphlet
@@ -691,7 +691,8 @@ bPremStreamNull(s)==
(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
(DEFUN |shoeNotFound| (|fn|)
- (PROG () (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
+ (PROG ()
+ (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
(DEFUN |shoeReadLispString| (|s| |n|)
(PROG (|l|)
@@ -804,8 +805,7 @@ bPremStreamNull(s)==
((NULL |lines|) (|shoeConsole| ")package not found")))
(APPEND (REVERSE |lines|) (CAR |b|)))))))))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |$bStreamNil| (LIST '|nullstream|)))
+(DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))
(DEFUN |bStreamNull| (|x|)
(PROG (|st|)
@@ -814,15 +814,14 @@ bPremStreamNull(s)==
((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
('T
(PROGN
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
- ('T
- (PROGN
- (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
- (RPLACA |x| (CAR |st|))
- (RPLACD |x| (CDR |st|))))))))
+ (LOOP
+ (COND
+ ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
+ (RPLACA |x| (CAR |st|))
+ (RPLACD |x| (CDR |st|))))))
(EQCAR |x| '|nullstream|)))))))
(DEFUN |bMap| (|f| |x|)
@@ -830,6 +829,7 @@ bPremStreamNull(s)==
(DEFUN |bMap1| (&REST |z|)
(PROG (|x| |f|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(SETQ |f| (CAR |z|))
@@ -840,6 +840,7 @@ bPremStreamNull(s)==
(DEFUN |shoeFileMap| (|f| |fn|)
(PROG (|a|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(SETQ |a| (|shoeInputFile| |fn|))
@@ -941,16 +942,15 @@ bPremStreamNull(s)==
('T
(PROGN
(SETQ |good| T)
- ((LAMBDA (|bfVar#1| |i| |j|)
- (LOOP
- (COND
- ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
- ('T
- (SETQ |good|
- (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
- (SETQ |i| (+ |i| 1))
- (SETQ |j| (+ |j| 1))))
- (- (LENGTH |prefix|) 1) 0 0)
+ (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
+ (LOOP
+ (COND
+ ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
+ ('T
+ (SETQ |good|
+ (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ |j| (+ |j| 1))))
(COND
(|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
('T |good|))))))))
@@ -1061,6 +1061,7 @@ bPremStreamNull(s)==
(DEFUN |shoeInclude1| (|s|)
(PROG (|command| |string| |t| |h|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(COND
((|bStreamNull| |s|) |s|)
@@ -1202,6 +1203,7 @@ bPremStreamNull(s)==
(DEFUN |bPremStreamNil| (|h|)
(PROG ()
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(|shoeConsole|
diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet
index 47627d4a..863ef202 100644
--- a/src/boot/parser.boot.pamphlet
+++ b/src/boot/parser.boot.pamphlet
@@ -1126,11 +1126,9 @@ bpCaseItem()==
(IN-PACKAGE "BOOTTRAN")
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |$sawParenthesizedHead| NIL))
+(DEFPARAMETER |$sawParenthesizedHead| NIL)
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |$bodyHasReturn| NIL))
+(DEFPARAMETER |$bodyHasReturn| NIL)
(DEFUN |bpFirstToken| ()
(PROG ()
@@ -1329,13 +1327,12 @@ bpCaseItem()==
(COND
((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))
(SETQ |a| |$stack|) (SETQ |$stack| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpEqKey| |str1|)
- (OR (APPLY |f| NIL) (|bpTrap|))))
- (RETURN NIL))
- ('T 0)))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
(SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
(|bpPush|
(FUNCALL |g|
@@ -1352,13 +1349,12 @@ bpCaseItem()==
(COND
((AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|bpTrap|)))
(SETQ |a| |$stack|) (SETQ |$stack| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (APPLY |h| NIL)
- (OR (APPLY |f| NIL) (|bpTrap|))))
- (RETURN NIL))
- ('T 0)))))
+ (LOOP
+ (COND
+ ((NOT (AND (APPLY |h| NIL)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
(SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
(|bpPush|
(FUNCALL |g|
@@ -1377,13 +1373,12 @@ bpCaseItem()==
(COND
((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))
(SETQ |a| |$stack|) (SETQ |$stack| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpEqKey| |str1|)
- (OR (APPLY |f| NIL) (|bpTrap|))))
- (RETURN NIL))
- ('T 0)))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
(SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
(|bpPush|
(FUNCALL |g|
@@ -1400,9 +1395,7 @@ bpCaseItem()==
(PROGN
(SETQ |a| |$stack|)
(SETQ |$stack| NIL)
- ((LAMBDA ()
- (LOOP
- (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) ('T 0)))))
+ (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) ('T 0)))
(SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
(|bpPush| (CONS (|bpPop2|) (|bpPop1|)))))
('T NIL)))))
@@ -1411,8 +1404,7 @@ bpCaseItem()==
(PROG ()
(RETURN
(PROGN
- ((LAMBDA ()
- (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) ('T 0)))))
+ (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) ('T 0)))
T))))
(DEFUN |bpAndOr| (|keyword| |p| |f|)
@@ -1527,30 +1519,28 @@ bpCaseItem()==
(SETQ |$stack| NIL)
(SETQ |done| NIL)
(SETQ |c| |$inputStream|)
- ((LAMBDA ()
- (LOOP
- (COND
- (|done| (RETURN NIL))
- ('T
- (PROGN
- (SETQ |found| (CATCH 'TRAPPOINT (APPLY |f| NIL)))
+ (LOOP
+ (COND
+ (|done| (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |found| (CATCH 'TRAPPOINT (APPLY |f| NIL)))
+ (COND
+ ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
+ (|bpRecoverTrap|))
+ ((NULL |found|) (SETQ |$inputStream| |c|)
+ (|bpGeneralErrorHere|) (|bpRecoverTrap|)))
+ (COND
+ ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
+ ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
+ (SETQ |done| T))
+ (#0='T (SETQ |$inputStream| |c|)
+ (|bpGeneralErrorHere|) (|bpRecoverTrap|)
(COND
- ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
- (|bpRecoverTrap|))
- ((NULL |found|) (SETQ |$inputStream| |c|)
- (|bpGeneralErrorHere|) (|bpRecoverTrap|)))
- (COND
- ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
(SETQ |done| T))
- (#0='T (SETQ |$inputStream| |c|)
- (|bpGeneralErrorHere|) (|bpRecoverTrap|)
- (COND
- ((OR (|bpEqPeek| 'BACKTAB)
- (NULL |$inputStream|))
- (SETQ |done| T))
- (#0# (|bpNext|) (SETQ |c| |$inputStream|)))))
- (SETQ |b| (CONS (|bpPop1|) |b|))))))))
+ (#0# (|bpNext|) (SETQ |c| |$inputStream|)))))
+ (SETQ |b| (CONS (|bpPop1|) |b|))))))
(SETQ |$stack| |a|)
(|bpPush| (NREVERSE |b|))))))
@@ -1810,16 +1800,15 @@ bpCaseItem()==
(SETQ |a| (|bpState|))
(COND
((APPLY |p| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpInfGeneric| |o|)
- (OR (|bpRightAssoc| |o| |p|) (|bpTrap|))))
- (RETURN NIL))
- ('T
- (|bpPush|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|)
- (|bpPop1|))))))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpInfGeneric| |o|)
+ (OR (|bpRightAssoc| |o| |p|) (|bpTrap|))))
+ (RETURN NIL))
+ ('T
+ (|bpPush|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|)
+ (|bpPop1|))))))
T)
('T (|bpRestore| |a|) NIL))))))
@@ -1828,16 +1817,14 @@ bpCaseItem()==
(RETURN
(COND
((APPLY |parser| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpInfGeneric| |operations|)
- (OR (APPLY |parser| NIL) (|bpTrap|))))
- (RETURN NIL))
- ('T
- (|bpPush|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|)
- (|bpPop1|))))))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpInfGeneric| |operations|)
+ (OR (APPLY |parser| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T
+ (|bpPush|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
T)
('T NIL)))))
@@ -2271,19 +2258,18 @@ bpCaseItem()==
(RETURN
(COND
((|bpRegularPatternItemL|)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpEqKey| 'COMMA)
- (OR (|bpRegularPatternItemL|)
- (PROGN
- (OR (AND (|bpPatternTail|)
- (|bpPush|
- (APPEND (|bpPop2|) (|bpPop1|))))
- (|bpTrap|))
- NIL))))
- (RETURN NIL))
- ('T (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| 'COMMA)
+ (OR (|bpRegularPatternItemL|)
+ (PROGN
+ (OR (AND (|bpPatternTail|)
+ (|bpPush|
+ (APPEND (|bpPop2|) (|bpPop1|))))
+ (|bpTrap|))
+ NIL))))
+ (RETURN NIL))
+ ('T (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))))
T)
('T (|bpPatternTail|))))))
@@ -2333,20 +2319,19 @@ bpCaseItem()==
(RETURN
(COND
((|bpRegularBVItemL|)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (|bpEqKey| 'COMMA)
- (OR (|bpRegularBVItemL|)
- (PROGN
- (OR (AND (|bpColonName|)
- (|bpPush|
- (|bfColonAppend| (|bpPop2|)
- (|bpPop1|))))
- (|bpTrap|))
- NIL))))
- (RETURN NIL))
- ('T (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))))))
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| 'COMMA)
+ (OR (|bpRegularBVItemL|)
+ (PROGN
+ (OR (AND (|bpColonName|)
+ (|bpPush|
+ (|bfColonAppend| (|bpPop2|)
+ (|bpPop1|))))
+ (|bpTrap|))
+ NIL))))
+ (RETURN NIL))
+ ('T (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))))
T)
('T
(AND (|bpColonName|)
diff --git a/src/boot/scanner.boot.pamphlet b/src/boot/scanner.boot.pamphlet
index b98ed289..b6bc1175 100644
--- a/src/boot/scanner.boot.pamphlet
+++ b/src/boot/scanner.boot.pamphlet
@@ -641,13 +641,11 @@ shoePunctuation c== shoePun.c =1
(#0#
(PROGN
(SETQ |toks| NIL)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (< |$n| |$sz|)) (RETURN NIL))
- ('T
- (SETQ |toks|
- (|dqAppend| |toks| (|shoeToken|))))))))
+ (LOOP
+ (COND
+ ((NOT (< |$n| |$sz|)) (RETURN NIL))
+ ('T
+ (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
(COND
((NULL |toks|) (|shoeLineToks| |$r|))
(#0# (CONS (LIST |toks|) |$r|)))))))))))))
@@ -754,7 +752,8 @@ shoePunctuation c== shoePun.c =1
(PROGN
(SETQ |b| (|shoeIntValue| (CONCAT |a| |w|)))
(SETQ |c|
- (* (|double| |b|) (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
+ (* (|double| |b|)
+ (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
(LIST 'FLOAT |c|)))))
(DEFUN |shoeLeafString| (|x|) (PROG () (RETURN (LIST 'STRING |x|))))
@@ -818,21 +817,15 @@ shoePunctuation c== shoePun.c =1
((NOT (< |$n| |$sz|))
(COND
((|shoeNextLine| |$r|)
- ((LAMBDA ()
- (LOOP
- (COND
- (|$n| (RETURN NIL))
- (#0='T (|shoeNextLine| |$r|))))))
+ (LOOP
+ (COND (|$n| (RETURN NIL)) (#0='T (|shoeNextLine| |$r|))))
(|shoeEsc|) NIL)
(#1='T NIL)))
(#1# (SETQ |n1| (STRPOSL " " |$ln| |$n| T))
(COND
((NULL |n1|) (|shoeNextLine| |$r|)
- ((LAMBDA ()
- (LOOP
- (COND
- (|$n| (RETURN NIL))
- (#0# (|shoeNextLine| |$r|))))))
+ (LOOP
+ (COND (|$n| (RETURN NIL)) (#0# (|shoeNextLine| |$r|))))
(|shoeEsc|) NIL)
(#1# T)))))))
@@ -966,13 +959,12 @@ shoePunctuation c== shoePun.c =1
(PROG ()
(RETURN
(PROGN
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (< |n| (LENGTH |line|))
- (|shoeIdChar| (ELT |line| |n|))))
- (RETURN NIL))
- ('T (SETQ |n| (+ |n| 1)))))))
+ (LOOP
+ (COND
+ ((NOT (AND (< |n| (LENGTH |line|))
+ (|shoeIdChar| (ELT |line| |n|))))
+ (RETURN NIL))
+ ('T (SETQ |n| (+ |n| 1)))))
|n|))))
(DEFUN |shoeDigit| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|))))
@@ -1019,12 +1011,11 @@ shoePunctuation c== shoePun.c =1
(PROGN
(SETQ |n| |$n|)
(SETQ |l| |$sz|)
- ((LAMBDA ()
- (LOOP
- (COND
- ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|))))
- (RETURN NIL))
- ('T (SETQ |$n| (+ |$n| 1)))))))
+ (LOOP
+ (COND
+ ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|))))
+ (RETURN NIL))
+ ('T (SETQ |$n| (+ |$n| 1)))))
(COND
((OR (EQUAL |$n| |l|)
(NOT (EQUAL (QENUM |$ln| |$n|) |shoeESCAPE|)))
@@ -1041,16 +1032,15 @@ shoePunctuation c== shoePun.c =1
(PROGN
(SETQ |ns| (LENGTH |s|))
(SETQ |ival| 0)
- ((LAMBDA (|bfVar#1| |i|)
- (LOOP
- (COND
- ((> |i| |bfVar#1|) (RETURN NIL))
- ('T
- (PROGN
- (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|)))
- (SETQ |ival| (+ (* 10 |ival|) |d|)))))
- (SETQ |i| (+ |i| 1))))
- (- |ns| 1) 0)
+ (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#1|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|)))
+ (SETQ |ival| (+ (* 10 |ival|) |d|)))))
+ (SETQ |i| (+ |i| 1))))
|ival|))))
(DEFUN |shoeNumber| ()
@@ -1139,32 +1129,30 @@ shoePunctuation c== shoePun.c =1
(SETQ |ll| (SIZE |l|))
(SETQ |done| NIL)
(SETQ |s1| "")
- ((LAMBDA (|bfVar#2| |j|)
- (LOOP
- (COND
- ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL))
- (#0='T
- (PROGN
- (SETQ |s| (ELT |u| |j|))
- (SETQ |ls| (SIZE |s|))
- (SETQ |done|
- (COND
- ((< |ll| (+ |ls| |i|)) NIL)
- (#1='T (SETQ |eql| T)
- ((LAMBDA (|bfVar#3| |k|)
- (LOOP
- (COND
- ((OR (> |k| |bfVar#3|) (NOT |eql|))
- (RETURN NIL))
- (#0#
- (SETQ |eql|
- (EQL (QENUM |s| |k|)
- (QENUM |l| (+ |k| |i|))))))
- (SETQ |k| (+ |k| 1))))
- (- |ls| 1) 1)
- (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL))))))))
- (SETQ |j| (+ |j| 1))))
- (- (SIZE |u|) 1) 0)
+ (LET ((|bfVar#2| (- (SIZE |u|) 1)) (|j| 0))
+ (LOOP
+ (COND
+ ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL))
+ (#0='T
+ (PROGN
+ (SETQ |s| (ELT |u| |j|))
+ (SETQ |ls| (SIZE |s|))
+ (SETQ |done|
+ (COND
+ ((< |ll| (+ |ls| |i|)) NIL)
+ (#1='T (SETQ |eql| T)
+ (LET ((|bfVar#3| (- |ls| 1)) (|k| 1))
+ (LOOP
+ (COND
+ ((OR (> |k| |bfVar#3|) (NOT |eql|))
+ (RETURN NIL))
+ (#0#
+ (SETQ |eql|
+ (EQL (QENUM |s| |k|)
+ (QENUM |l| (+ |k| |i|))))))
+ (SETQ |k| (+ |k| 1))))
+ (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL))))))))
+ (SETQ |j| (+ |j| 1))))
|s1|))))
(DEFUN |shoePunctuation| (|c|)
diff --git a/src/boot/tokens.boot.pamphlet b/src/boot/tokens.boot.pamphlet
index 4f2405c1..106e96e8 100644
--- a/src/boot/tokens.boot.pamphlet
+++ b/src/boot/tokens.boot.pamphlet
@@ -541,78 +541,65 @@ for i in [ _
(IN-PACKAGE "BOOTTRAN")
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeKeyWords|
- (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
- (LIST "cross" 'CROSS) (LIST "else" 'ELSE) (LIST "for" 'FOR)
- (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
- (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
- (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
- (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
- (LIST "then" 'THEN) (LIST "until" 'UNTIL)
- (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
- (LIST ":" 'COLON) (LIST "::" 'COLON-COLON)
- (LIST "," 'COMMA) (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES)
- (LIST "**" 'POWER) (LIST "/" 'SLASH) (LIST "+" 'PLUS)
- (LIST "-" 'MINUS) (LIST "<" 'LT) (LIST ">" 'GT)
- (LIST "<=" 'LE) (LIST ">=" 'GE) (LIST "=" 'SHOEEQ)
- (LIST "^" 'NOT) (LIST "^=" 'SHOENE) (LIST ".." 'SEG)
- (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST ":=" 'BEC)
- (LIST "==" 'DEF) (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF)
- (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK)
- (LIST "|)" 'CBRACK) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK)
- (LIST "suchthat" 'BAR) (LIST "'" 'QUOTE) (LIST "|" 'BAR))))
+(DEFPARAMETER |shoeKeyWords|
+ (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
+ (LIST "cross" 'CROSS) (LIST "else" 'ELSE) (LIST "for" 'FOR)
+ (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
+ (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
+ (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
+ (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
+ (LIST "then" 'THEN) (LIST "until" 'UNTIL)
+ (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
+ (LIST ":" 'COLON) (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
+ (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
+ (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
+ (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
+ (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENE)
+ (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
+ (LIST ":=" 'BEC) (LIST "==" 'DEF) (LIST "==>" 'MDEF)
+ (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN)
+ (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK) (LIST "[" 'OBRACK)
+ (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR) (LIST "'" 'QUOTE)
+ (LIST "|" 'BAR)))
(DEFUN |shoeKeyTableCons| ()
(PROG (|KeyTable|)
(RETURN
(PROGN
(SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
- ((LAMBDA (|bfVar#1| |st|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#1|)
- (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
- (RETURN NIL))
- ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
- (SETQ |bfVar#1| (CDR |bfVar#1|))))
- |shoeKeyWords| NIL)
+ (LET ((|bfVar#1| |shoeKeyWords|) (|st| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
|KeyTable|))))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|)))
+(DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeSPACE| (QENUM " " 0)))
+(DEFPARAMETER |shoeSPACE| (QENUM " " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeESCAPE| (QENUM "_ " 0)))
+(DEFPARAMETER |shoeESCAPE| (QENUM "_ " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeLispESCAPE| (QENUM "! " 0)))
+(DEFPARAMETER |shoeLispESCAPE| (QENUM "! " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeSTRINGCHAR| (QENUM "\" " 0)))
+(DEFPARAMETER |shoeSTRINGCHAR| (QENUM "\" " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoePLUSCOMMENT| (QENUM "+ " 0)))
+(DEFPARAMETER |shoePLUSCOMMENT| (QENUM "+ " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeMINUSCOMMENT| (QENUM "- " 0)))
+(DEFPARAMETER |shoeMINUSCOMMENT| (QENUM "- " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeDOT| (QENUM ". " 0)))
+(DEFPARAMETER |shoeDOT| (QENUM ". " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeEXPONENT1| (QENUM "E " 0)))
+(DEFPARAMETER |shoeEXPONENT1| (QENUM "E " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeEXPONENT2| (QENUM "e " 0)))
+(DEFPARAMETER |shoeEXPONENT2| (QENUM "e " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeCLOSEPAREN| (QENUM ") " 0)))
+(DEFPARAMETER |shoeCLOSEPAREN| (QENUM ") " 0))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (DEFPARAMETER |shoeTAB| 9))
+(DEFPARAMETER |shoeTAB| 9)
(DEFUN |shoeInsert| (|s| |d|)
(PROG (|v| |k| |n| |u| |h| |l|)
@@ -623,27 +610,24 @@ for i in [ _
(SETQ |u| (ELT |d| |h|))
(SETQ |n| (LENGTH |u|))
(SETQ |k| 0)
- ((LAMBDA ()
- (LOOP
- (COND
- ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
- (#0='T (SETQ |k| (+ |k| 1)))))))
+ (LOOP
+ (COND
+ ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
+ (#0='T (SETQ |k| (+ |k| 1)))))
(SETQ |v| (MAKE-VEC (+ |n| 1)))
- ((LAMBDA (|bfVar#2| |i|)
- (LOOP
- (COND
- ((> |i| |bfVar#2|) (RETURN NIL))
- (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
- (SETQ |i| (+ |i| 1))))
- (- |k| 1) 0)
+ (LET ((|bfVar#2| (- |k| 1)) (|i| 0))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#2|) (RETURN NIL))
+ (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
+ (SETQ |i| (+ |i| 1))))
(VEC-SETELT |v| |k| |s|)
- ((LAMBDA (|bfVar#3| |i|)
- (LOOP
- (COND
- ((> |i| |bfVar#3|) (RETURN NIL))
- (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
- (SETQ |i| (+ |i| 1))))
- (- |n| 1) |k|)
+ (LET ((|bfVar#3| (- |n| 1)) (|i| |k|))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#3|) (RETURN NIL))
+ (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
+ (SETQ |i| (+ |i| 1))))
(VEC-SETELT |d| |h| |v|)
|s|))))
@@ -657,27 +641,24 @@ for i in [ _
(SETQ |a| (MAKE-VEC 256))
(SETQ |b| (MAKE-VEC 1))
(VEC-SETELT |b| 0 (MAKE-CVEC 0))
- ((LAMBDA (|i|)
- (LOOP
- (COND
- ((> |i| 255) (RETURN NIL))
- (#0='T (VEC-SETELT |a| |i| |b|)))
- (SETQ |i| (+ |i| 1))))
- 0)
+ (LET ((|i| 0))
+ (LOOP
+ (COND
+ ((> |i| 255) (RETURN NIL))
+ (#0='T (VEC-SETELT |a| |i| |b|)))
+ (SETQ |i| (+ |i| 1))))
|a|))
- ((LAMBDA (|bfVar#4| |s|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#4|)
- (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
- (RETURN NIL))
- (#0# (|shoeInsert| |s| |d|)))
- (SETQ |bfVar#4| (CDR |bfVar#4|))))
- |l| NIL)
+ (LET ((|bfVar#4| |l|) (|s| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#4|)
+ (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
+ (RETURN NIL))
+ (#0# (|shoeInsert| |s| |d|)))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))
|d|))))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoeDict| (|shoeDictCons|)))
+(DEFPARAMETER |shoeDict| (|shoeDictCons|))
(DEFUN |shoePunCons| ()
(PROG (|a| |listing|)
@@ -685,148 +666,226 @@ for i in [ _
(PROGN
(SETQ |listing| (HKEYS |shoeKeyTable|))
(SETQ |a| (MAKE-BVEC 256))
- ((LAMBDA (|i|)
- (LOOP
- (COND
- ((> |i| 255) (RETURN NIL))
- (#0='T (BVEC-SETELT |a| |i| 0)))
- (SETQ |i| (+ |i| 1))))
- 0)
- ((LAMBDA (|bfVar#5| |k|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#5|)
- (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
- (RETURN NIL))
- (#0#
- (COND
- ((NULL (|shoeStartsId| (ELT |k| 0)))
- (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
- (SETQ |bfVar#5| (CDR |bfVar#5|))))
- |listing| NIL)
+ (LET ((|i| 0))
+ (LOOP
+ (COND
+ ((> |i| 255) (RETURN NIL))
+ (#0='T (BVEC-SETELT |a| |i| 0)))
+ (SETQ |i| (+ |i| 1))))
+ (LET ((|bfVar#5| |listing|) (|k| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#5|)
+ (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (COND
+ ((NULL (|shoeStartsId| (ELT |k| 0)))
+ (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
+ (SETQ |bfVar#5| (CDR |bfVar#5|))))
|a|))))
+(DEFPARAMETER |shoePun| (|shoePunCons|))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (LET ((|bfVar#6| (LIST 'NOT 'LENGTH)) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#6|)
+ (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET |i| 'SHOEPRE) 'T)))
+ (SETQ |bfVar#6| (CDR |bfVar#6|)))))))
+
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |shoePun| (|shoePunCons|)))
+ (PROG ()
+ (RETURN
+ (LET ((|bfVar#7|
+ (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*)
+ (LIST 'PLUS '+) (LIST 'IS '|is|)
+ (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
+ (LIST 'OR '|or|) (LIST 'SLASH '/)
+ (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<)
+ (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
+ (LIST 'SHOENE '^=)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#6| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#6|)
- (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
- (RETURN NIL))
- ('T (SETF (GET |i| 'SHOEPRE) 'T)))
- (SETQ |bfVar#6| (CDR |bfVar#6|))))
- (LIST 'NOT 'LENGTH) NIL))))
+ (LET ((|bfVar#8|
+ (LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
+ (LIST 'STRCONC "") (LIST '|strconc| "")
+ (LIST 'MAX (- 999999)) (LIST 'MIN 999999)
+ (LIST '* 1) (LIST '|times| 1) (LIST 'CONS NIL)
+ (LIST 'APPEND NIL) (LIST '|append| NIL)
+ (LIST 'UNION NIL) (LIST 'UNIONQ NIL)
+ (LIST '|union| NIL) (LIST 'NCONC NIL)
+ (LIST '|and| 'T) (LIST '|or| NIL) (LIST 'AND 'T)
+ (LIST 'OR NIL)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#8|)
+ (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'SHOETHETA) (CDR |i|))))
+ (SETQ |bfVar#8| (CDR |bfVar#8|)))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#7| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#7|)
- (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
- (RETURN NIL))
- ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
- (SETQ |bfVar#7| (CDR |bfVar#7|))))
- (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*) (LIST 'PLUS '+)
- (LIST 'IS '|is|) (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
- (LIST 'OR '|or|) (LIST 'SLASH '/) (LIST 'POWER '**)
- (LIST 'MINUS '-) (LIST 'LT '<) (LIST 'GT '>)
- (LIST 'LE '<=) (LIST 'GE '>=) (LIST 'SHOENE '^=))
- NIL))))
+ (LET ((|bfVar#9|
+ (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND)
+ (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
+ (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
+ (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
+ (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
+ (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
+ (LIST '|first| 'CAR) (LIST '|function| 'FUNCTION)
+ (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER)
+ (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
+ (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
+ (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
+ (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
+ (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
+ (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL)
+ (LIST '|or| 'OR) (LIST '|otherwise| 'T)
+ (LIST 'PAIRP 'CONSP)
+ (LIST '|removeDuplicates| 'REMDUP)
+ (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
+ (LIST '|setDifference| 'SETDIFFERENCE)
+ (LIST '|setIntersection| 'INTERSECTION)
+ (LIST '|setPart| 'SETELT)
+ (LIST '|setUnion| 'UNION) (LIST '|size| 'SIZE)
+ (LIST '|strconc| 'CONCAT)
+ (LIST '|substitute| 'SUBST) (LIST '|take| 'TAKE)
+ (LIST '|true| 'T) (LIST 'PLUS '+)
+ (LIST 'MINUS '-) (LIST 'TIMES '*)
+ (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
+ (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
+ (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
+ (LIST 'SHOENE '/=) (LIST 'T 'T$)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#9|)
+ (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'SHOERENAME) (CDR |i|))))
+ (SETQ |bfVar#9| (CDR |bfVar#9|)))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#8| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#8|)
- (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
- (RETURN NIL))
- ('T (SETF (GET (CAR |i|) 'SHOETHETA) (CDR |i|))))
- (SETQ |bfVar#8| (CDR |bfVar#8|))))
- (LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
- (LIST 'STRCONC "") (LIST '|strconc| "")
- (LIST 'MAX (- 999999)) (LIST 'MIN 999999) (LIST '* 1)
- (LIST '|times| 1) (LIST 'CONS NIL) (LIST 'APPEND NIL)
- (LIST '|append| NIL) (LIST 'UNION NIL) (LIST 'UNIONQ NIL)
- (LIST '|union| NIL) (LIST 'NCONC NIL) (LIST '|and| 'T)
- (LIST '|or| NIL) (LIST 'AND 'T) (LIST 'OR NIL))
- NIL))))
+ (LET ((|bfVar#10|
+ (LIST (LIST 'PLUS 'PLUS) (LIST '|and| 'AND)
+ (LIST '|append| 'APPEND) (LIST '|apply| 'APPLY)
+ (LIST '|atom| 'ATOM) (LIST '|brace| 'REMDUP)
+ (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
+ (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
+ (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
+ (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
+ (LIST '|first| 'CAR) (LIST '|genvar| 'GENVAR)
+ (LIST '|in| '|member|) (LIST '|is| 'IS)
+ (LIST '|lastNode| 'LASTNODE) (LIST '|list| 'LIST)
+ (LIST '|mkpf| 'MKPF) (LIST '|nconc| 'NCONC)
+ (LIST '|nil| 'NIL) (LIST '|not| 'NULL)
+ (LIST 'NOT 'NULL) (LIST '|nreverse| 'NREVERSE)
+ (LIST '|null| 'NULL) (LIST '|or| 'OR)
+ (LIST '|otherwise| 'T)
+ (LIST '|removeDuplicates| 'REMDUP)
+ (LIST '|rest| 'CDR) (LIST '|return| 'RETURN)
+ (LIST '|reverse| 'REVERSE)
+ (LIST '|setDifference| 'SETDIFFERENCE)
+ (LIST '|setIntersection| '|intersection|)
+ (LIST '|setPart| 'SETELT)
+ (LIST '|setUnion| '|union|) (LIST '|size| 'SIZE)
+ (LIST '|strconc| 'STRCONC)
+ (LIST '|substitute| 'MSUBST)
+ (LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE)
+ (LIST '|true| 'T) (LIST '|where| 'WHERE)
+ (LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT)
+ (LIST 'NOT 'NULL) (LIST 'SHOENE 'NEQUAL)
+ (LIST 'MINUS 'SPADDIFFERENCE)
+ (LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL)
+ (LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|)
+ (LIST 'DELETE '|delete|) (LIST 'GET 'GETL)
+ (LIST 'INTERSECTION '|intersection|)
+ (LIST 'LAST '|last|) (LIST 'MEMBER '|member|)
+ (LIST 'RASSOC '|rassoc|) (LIST 'READ 'VMREAD)
+ (LIST 'READ-LINE '|read-line|)
+ (LIST 'REDUCE 'SPADREDUCE)
+ (LIST 'REMOVE '|remove|) (LIST 'BAR 'SUCHTHAT)
+ (LIST 'T 'T$) (LIST 'IN '|member|)
+ (LIST 'UNION '|union|)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#10|)
+ (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'OLD-BOOT) (CDR |i|))))
+ (SETQ |bfVar#10| (CDR |bfVar#10|)))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#9| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#9|)
- (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
- (RETURN NIL))
- ('T (SETF (GET (CAR |i|) 'SHOERENAME) (CDR |i|))))
- (SETQ |bfVar#9| (CDR |bfVar#9|))))
- (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND)
- (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
- (LIST '|car| 'CAR) (LIST '|cdr| 'CDR) (LIST '|cons| 'CONS)
- (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK)
- (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT)
- (LIST '|false| 'NIL) (LIST '|first| 'CAR)
- (LIST '|function| 'FUNCTION) (LIST '|genvar| 'GENVAR)
- (LIST 'IN 'MEMBER) (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
- (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
- (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
- (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
- (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
- (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL)
- (LIST '|or| 'OR) (LIST '|otherwise| 'T)
- (LIST 'PAIRP 'CONSP) (LIST '|removeDuplicates| 'REMDUP)
- (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
- (LIST '|setDifference| 'SETDIFFERENCE)
- (LIST '|setIntersection| 'INTERSECTION)
- (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION)
- (LIST '|size| 'SIZE) (LIST '|strconc| 'CONCAT)
- (LIST '|substitute| 'SUBST) (LIST '|take| 'TAKE)
- (LIST '|true| 'T) (LIST 'PLUS '+) (LIST 'MINUS '-)
- (LIST 'TIMES '*) (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
- (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
- (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=) (LIST 'T 'T$))
- NIL))))
+ (LET ((|bfVar#11|
+ (LIST 'LT 'LE 'GT 'GE 'SHOENE 'TIMES 'PLUS 'MINUS
+ '|function| 'PAIRP))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET |i| 'RENAME-OK) T)))
+ (SETQ |bfVar#11| (CDR |bfVar#11|)))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#10| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#10|)
- (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
- (RETURN NIL))
- ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|))))
- (SETQ |bfVar#10| (CDR |bfVar#10|))))
- (LIST (LIST '|setName| 0) (LIST '|setLabel| 1)
- (LIST '|setLevel| 2) (LIST '|setType| 3)
- (LIST '|setVar| 4) (LIST '|setLeaf| 5) (LIST '|setDef| 6)
- (LIST '|aGeneral| 4) (LIST '|aMode| 1)
- (LIST '|aModeSet| 3) (LIST '|aTree| 0) (LIST '|aValue| 2)
- (LIST '|attributes| 'CADDR) (LIST '|cacheCount| 'CADDDDR)
- (LIST '|cacheName| 'CADR) (LIST '|cacheReset| 'CADDDR)
- (LIST '|cacheType| 'CADDR) (LIST '|env| 'CADDR)
- (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
- (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
- (LIST '|mmImplementation| 'CADADR)
- (LIST '|mmSignature| 'CDAR) (LIST '|mmTarget| 'CADAR)
- (LIST '|mode| 'CADR) (LIST '|op| 'CAR)
- (LIST '|opcode| 'CADR) (LIST '|opSig| 'CADR)
- (LIST 'CDR 'CDR) (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
- (LIST '|streamCode| 'CADDDR) (LIST '|streamDef| 'CADDR)
- (LIST '|streamName| 'CADR) (LIST '|target| 'CAR))
- NIL))))
+ (LET ((|bfVar#12|
+ (LIST (LIST '|setName| 0) (LIST '|setLabel| 1)
+ (LIST '|setLevel| 2) (LIST '|setType| 3)
+ (LIST '|setVar| 4) (LIST '|setLeaf| 5)
+ (LIST '|setDef| 6) (LIST '|aGeneral| 4)
+ (LIST '|aMode| 1) (LIST '|aModeSet| 3)
+ (LIST '|aTree| 0) (LIST '|aValue| 2)
+ (LIST '|attributes| 'CADDR)
+ (LIST '|cacheCount| 'CADDDDR)
+ (LIST '|cacheName| 'CADR)
+ (LIST '|cacheReset| 'CADDDR)
+ (LIST '|cacheType| 'CADDR) (LIST '|env| 'CADDR)
+ (LIST '|expr| 'CAR) (LIST 'CAR 'CAR)
+ (LIST '|mmCondition| 'CAADR) (LIST '|mmDC| 'CAAR)
+ (LIST '|mmImplementation| 'CADADR)
+ (LIST '|mmSignature| 'CDAR)
+ (LIST '|mmTarget| 'CADAR) (LIST '|mode| 'CADR)
+ (LIST '|op| 'CAR) (LIST '|opcode| 'CADR)
+ (LIST '|opSig| 'CADR) (LIST 'CDR 'CDR)
+ (LIST '|sig| 'CDDR) (LIST '|source| 'CDR)
+ (LIST '|streamCode| 'CADDDR)
+ (LIST '|streamDef| 'CADDR)
+ (LIST '|streamName| 'CADR) (LIST '|target| 'CAR)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|)))))))
@
\eject
diff --git a/src/boot/translator.boot.pamphlet b/src/boot/translator.boot.pamphlet
index 23249648..406820b1 100644
--- a/src/boot/translator.boot.pamphlet
+++ b/src/boot/translator.boot.pamphlet
@@ -822,6 +822,17 @@ associateRequestWithFileType(Option '"compile", '"boot",
(IN-PACKAGE "BOOTTRAN")
+(DEFPARAMETER |$translatingOldBoot| NIL)
+
+(DEFUN |AxiomCore|::|%sysInit| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (RETURN
+ (COND
+ ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|)))
+ "old")
+ (SETQ |$translatingOldBoot| T))))))
+
(DEFUN |setCurrentPackage| (|x|)
(PROG () (RETURN (SETQ *PACKAGE* |x|))))
@@ -868,15 +879,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
('T (SETQ |$GenVarCounter| 0)
(|shoeOpenOutputFile| |stream| |outfn|
(PROGN
- ((LAMBDA (|bfVar#1| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#1|)
- (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#1| (CDR |bfVar#1|))))
- |lines| NIL)
+ (LET ((|bfVar#1| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
(|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
|outfn|)))))
@@ -907,15 +917,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
('T (SETQ |$GenVarCounter| 0)
(|shoeOpenOutputFile| |stream| |outfn|
(PROGN
- ((LAMBDA (|bfVar#2| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#2|)
- (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#2| (CDR |bfVar#2|))))
- |lines| NIL)
+ (LET ((|bfVar#2| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#2|)
+ (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#2| (CDR |bfVar#2|))))
(|shoeFileTrees|
(|shoeTransformToFile| |stream|
(|shoeInclude|
@@ -1050,12 +1059,10 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |shoeCompileTrees| (|s|)
(PROG ()
(RETURN
- ((LAMBDA ()
- (LOOP
- (COND
- ((|bStreamNull| |s|) (RETURN NIL))
- ('T
- (PROGN (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|)))))))))))
+ (LOOP
+ (COND
+ ((|bStreamNull| |s|) (RETURN NIL))
+ ('T (PROGN (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|)))))))))
(DEFUN |shoeCompile| (|fn|)
(PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
@@ -1160,15 +1167,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
(RETURN
(PROGN
(|shoeFileLine| " " |fn|)
- ((LAMBDA (|bfVar#3| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#3|)
- (PROGN (SETQ |line| (CAR |bfVar#3|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| (|shoeAddComment| |line|) |fn|)))
- (SETQ |bfVar#3| (CDR |bfVar#3|))))
- |lines| NIL)
+ (LET ((|bfVar#3| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#3|)
+ (PROGN (SETQ |line| (CAR |bfVar#3|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| (|shoeAddComment| |line|) |fn|)))
+ (SETQ |bfVar#3| (CDR |bfVar#3|))))
(|shoeFileLine| " " |fn|)))))
(DEFUN |shoeConsoleLines| (|lines|)
@@ -1176,15 +1182,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
(RETURN
(PROGN
(|shoeConsole| " ")
- ((LAMBDA (|bfVar#4| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#4|)
- (PROGN (SETQ |line| (CAR |bfVar#4|)) NIL))
- (RETURN NIL))
- ('T (|shoeConsole| (|shoeAddComment| |line|))))
- (SETQ |bfVar#4| (CDR |bfVar#4|))))
- |lines| NIL)
+ (LET ((|bfVar#4| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#4|)
+ (PROGN (SETQ |line| (CAR |bfVar#4|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeConsole| (|shoeAddComment| |line|))))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))
(|shoeConsole| " ")))))
(DEFUN |shoeFileLine| (|x| |stream|)
@@ -1193,17 +1198,16 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |shoeFileTrees| (|s| |st|)
(PROG (|a|)
(RETURN
- ((LAMBDA ()
- (LOOP
- (COND
- ((|bStreamNull| |s|) (RETURN NIL))
- ('T
- (PROGN
- (SETQ |a| (CAR |s|))
- (COND
- ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|))
- ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
- (SETQ |s| (CDR |s|)))))))))))
+ (LOOP
+ (COND
+ ((|bStreamNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CAR |s|))
+ (COND
+ ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|))
+ ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
+ (SETQ |s| (CDR |s|)))))))))
(DEFUN |shoePPtoFile| (|x| |stream|)
(PROG () (RETURN (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))))
@@ -1211,17 +1215,16 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |shoeConsoleTrees| (|s|)
(PROG (|fn|)
(RETURN
- ((LAMBDA ()
- (LOOP
- (COND
- ((|bStreamPackageNull| |s|) (RETURN NIL))
- ('T
- (PROGN
- (SETQ |fn|
- (|stripm| (CAR |s|) *PACKAGE*
- (FIND-PACKAGE "BOOTTRAN")))
- (REALLYPRETTYPRINT |fn|)
- (SETQ |s| (CDR |s|)))))))))))
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |fn|
+ (|stripm| (CAR |s|) *PACKAGE*
+ (FIND-PACKAGE "BOOTTRAN")))
+ (REALLYPRETTYPRINT |fn|)
+ (SETQ |s| (CDR |s|)))))))))
(DEFUN |shoeAddComment| (|l|)
(PROG () (RETURN (CONCAT "; " (CAR |l|)))))
@@ -1273,8 +1276,7 @@ associateRequestWithFileType(Option '"compile", '"boot",
(EQ (CDR |ISTMP#2|) NIL)
(PROGN (SETQ |r| (CAR |ISTMP#2|)) 'T)))))
(IDENTP |l|))
- (|bpPush|
- (LIST (LIST 'DEFPARAMETER |l| |r|))))
+ (|bpPush| (LIST (LIST 'DEFPARAMETER |l| |r|))))
('T
(PROGN
(SETQ |bfVar#5| |b|)
@@ -1355,22 +1357,22 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |shoeReport| (|stream|)
(PROG (|b| |a|)
- (DECLARE (SPECIAL |$bootDefinedTwice| |$bootDefined| |$bootUsed|))
+ (DECLARE (SPECIAL |$bootDefinedTwice| |$bootUsed| |$bootDefined|))
(RETURN
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
(SETQ |a|
- ((LAMBDA (|bfVar#8| |bfVar#7| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#7|)
- (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
- (RETURN (NREVERSE |bfVar#8|)))
- (#0='T
- (AND (NULL (GETHASH |i| |$bootUsed|))
- (SETQ |bfVar#8| (CONS |i| |bfVar#8|)))))
- (SETQ |bfVar#7| (CDR |bfVar#7|))))
- NIL (HKEYS |$bootDefined|) NIL))
+ (LET ((|bfVar#8| NIL) (|bfVar#7| (HKEYS |$bootDefined|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+ (RETURN (NREVERSE |bfVar#8|)))
+ (#0='T
+ (AND (NULL (GETHASH |i| |$bootUsed|))
+ (SETQ |bfVar#8| (CONS |i| |bfVar#8|)))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))
(|bootOut| (SSORT |a|) |stream|)
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "DEFINED TWICE" |stream|)
@@ -1378,45 +1380,43 @@ associateRequestWithFileType(Option '"compile", '"boot",
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "USED and not DEFINED" |stream|)
(SETQ |a|
- ((LAMBDA (|bfVar#10| |bfVar#9| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#9|)
- (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
- (RETURN (NREVERSE |bfVar#10|)))
- (#0#
- (AND (NULL (GETHASH |i| |$bootDefined|))
- (SETQ |bfVar#10| (CONS |i| |bfVar#10|)))))
- (SETQ |bfVar#9| (CDR |bfVar#9|))))
- NIL (HKEYS |$bootUsed|) NIL))
- ((LAMBDA (|bfVar#11| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#11|)
- (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
- (RETURN NIL))
- (#0#
- (PROGN
- (SETQ |b| (CONCAT (PNAME |i|) " is used in "))
- (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
- |stream| |b|))))
- (SETQ |bfVar#11| (CDR |bfVar#11|))))
- (SSORT |a|) NIL)))))
+ (LET ((|bfVar#10| NIL) (|bfVar#9| (HKEYS |$bootUsed|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#9|)
+ (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
+ (RETURN (NREVERSE |bfVar#10|)))
+ (#0#
+ (AND (NULL (GETHASH |i| |$bootDefined|))
+ (SETQ |bfVar#10| (CONS |i| |bfVar#10|)))))
+ (SETQ |bfVar#9| (CDR |bfVar#9|)))))
+ (LET ((|bfVar#11| (SSORT |a|)) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (PROGN
+ (SETQ |b| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |b|))))
+ (SETQ |bfVar#11| (CDR |bfVar#11|))))))))
(DEFUN |shoeDefUse| (|s|)
(PROG ()
(RETURN
- ((LAMBDA ()
- (LOOP
- (COND
- ((|bStreamPackageNull| |s|) (RETURN NIL))
- ('T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))))))))
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))))))
(DEFUN |defuse| (|e| |x|)
(PROG (|$used| |niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id|
|ISTMP#4| |ISTMP#3| |body| |bv| |ISTMP#2| |name|
|ISTMP#1|)
- (DECLARE (SPECIAL |$used| |$bootUsed| |$bootDefinedTwice|
+ (DECLARE (SPECIAL |$bootUsed| |$used| |$bootDefinedTwice|
|$bootDefined|))
(RETURN
(PROGN
@@ -1501,17 +1501,16 @@ associateRequestWithFileType(Option '"compile", '"boot",
(#1# (CONS |nee| |$bootDefinedTwice|)))))
('T (HPUT |$bootDefined| |nee| T)))
(|defuse1| |e| |niens|)
- ((LAMBDA (|bfVar#12| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#12|)
- (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
- (RETURN NIL))
- ('T
- (HPUT |$bootUsed| |i|
- (CONS |nee| (GETHASH |i| |$bootUsed|)))))
- (SETQ |bfVar#12| (CDR |bfVar#12|))))
- |$used| NIL)))))
+ (LET ((|bfVar#12| |$used|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ (RETURN NIL))
+ ('T
+ (HPUT |$bootUsed| |i|
+ (CONS |nee| (GETHASH |i| |$bootUsed|)))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
@@ -1549,15 +1548,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
(SETQ |LETTMP#1| (|defSeparate| |a|))
(SETQ |dol| (CAR |LETTMP#1|))
(SETQ |ndol| (CADR |LETTMP#1|))
- ((LAMBDA (|bfVar#13| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#13|)
- (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
- (RETURN NIL))
- (#2='T (HPUT |$bootDefined| |i| T)))
- (SETQ |bfVar#13| (CDR |bfVar#13|))))
- |dol| NIL)
+ (LET ((|bfVar#13| |dol|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#13|)
+ (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
+ (RETURN NIL))
+ (#2='T (HPUT |$bootDefined| |i| T)))
+ (SETQ |bfVar#13| (CDR |bfVar#13|))))
(|defuse1| (APPEND |ndol| |e|) |b|)))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
(PROGN (SETQ |a| (CDR |y|)) #1#))
@@ -1566,15 +1564,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
(PROGN (SETQ |a| (CDR |y|)) #1#))
NIL)
(#0#
- ((LAMBDA (|bfVar#14| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#14|)
- (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
- (RETURN NIL))
- (#2# (|defuse1| |e| |i|)))
- (SETQ |bfVar#14| (CDR |bfVar#14|))))
- |y| NIL))))))
+ (LET ((|bfVar#14| |y|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#14|)
+ (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
+ (RETURN NIL))
+ (#2# (|defuse1| |e| |i|)))
+ (SETQ |bfVar#14| (CDR |bfVar#14|)))))))))
(DEFUN |defSeparate| (|x|)
(PROG (|x2| |x1| |LETTMP#1| |f|)
@@ -1610,15 +1607,14 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |bootOut| (|l| |outfn|)
(PROG ()
(RETURN
- ((LAMBDA (|bfVar#15| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#15|)
- (PROGN (SETQ |i| (CAR |bfVar#15|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
- (SETQ |bfVar#15| (CDR |bfVar#15|))))
- |l| NIL))))
+ (LET ((|bfVar#15| |l|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#15|)
+ (PROGN (SETQ |i| (CAR |bfVar#15|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
+ (SETQ |bfVar#15| (CDR |bfVar#15|)))))))
(DEFUN CLESSP (|s1| |s2|)
(PROG () (RETURN (NULL (SHOEGREATERP |s1| |s2|)))))
@@ -1671,19 +1667,18 @@ associateRequestWithFileType(Option '"compile", '"boot",
(PROGN
(|shoeFileLine| "USED and where DEFINED" |stream|)
(SETQ |c| (SSORT (HKEYS |$bootUsed|)))
- ((LAMBDA (|bfVar#16| |i|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#16|)
- (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
- (RETURN NIL))
- ('T
- (PROGN
- (SETQ |a| (CONCAT (PNAME |i|) " is used in "))
- (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
- |stream| |a|))))
- (SETQ |bfVar#16| (CDR |bfVar#16|))))
- |c| NIL)))))
+ (LET ((|bfVar#16| |c|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#16|)
+ (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |a|))))
+ (SETQ |bfVar#16| (CDR |bfVar#16|))))))))
(DEFUN FBO (|name| |fn|)
(PROG () (RETURN (|shoeGeneralFC| #'BO |name| |fn|))))
@@ -1725,17 +1720,16 @@ associateRequestWithFileType(Option '"compile", '"boot",
(SETQ |filename|
(CONCAT "/tmp/" |filename| ".boot"))
(|shoeOpenOutputFile| |stream| |filename|
- ((LAMBDA (|bfVar#17| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#17|)
- (PROGN
- (SETQ |line| (CAR |bfVar#17|))
- NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#17| (CDR |bfVar#17|))))
- |lines| NIL))
+ (LET ((|bfVar#17| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#17|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#17|))
+ NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#17| (CDR |bfVar#17|)))))
T))
('T NIL))))))
@@ -1752,19 +1746,20 @@ associateRequestWithFileType(Option '"compile", '"boot",
(RETURN
(PROGN
(SETQ |dq| (CAR |str|))
- (CONS (LIST ((LAMBDA (|bfVar#19| |bfVar#18| |line|)
- (LOOP
- (COND
- ((OR (ATOM |bfVar#18|)
- (PROGN
- (SETQ |line| (CAR |bfVar#18|))
- NIL))
- (RETURN (NREVERSE |bfVar#19|)))
- ('T
- (SETQ |bfVar#19|
- (CONS (CAR |line|) |bfVar#19|))))
- (SETQ |bfVar#18| (CDR |bfVar#18|))))
- NIL (|shoeDQlines| |dq|) NIL))
+ (CONS (LIST (LET ((|bfVar#19| NIL)
+ (|bfVar#18| (|shoeDQlines| |dq|))
+ (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#18|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#18|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#19|)))
+ ('T
+ (SETQ |bfVar#19|
+ (CONS (CAR |line|) |bfVar#19|))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
(CDR |str|))))))
(DEFUN |stripm| (|x| |pk| |bt|)
@@ -1825,14 +1820,13 @@ associateRequestWithFileType(Option '"compile", '"boot",
(DEFUN |shoePCompileTrees| (|s|)
(PROG ()
(RETURN
- ((LAMBDA ()
- (LOOP
- (COND
- ((|bStreamPackageNull| |s|) (RETURN NIL))
- ('T
- (PROGN
- (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|)))
- (SETQ |s| (CDR |s|)))))))))))
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|)))
+ (SETQ |s| (CDR |s|)))))))))
(DEFUN |bStreamPackageNull| (|s|)
(PROG (|b| |a|)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 13:30:49 +0000