From 471d0186fa938e05f69b26dd209544de721de94d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 27 Oct 2007 23:21:35 +0000 Subject: * 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. --- src/boot/ChangeLog | 11 + src/boot/ast.boot.pamphlet | 659 ++++++++++++++++++++------------------ src/boot/includer.boot.pamphlet | 46 +-- src/boot/parser.boot.pamphlet | 181 +++++------ src/boot/scanner.boot.pamphlet | 122 ++++--- src/boot/tokens.boot.pamphlet | 477 +++++++++++++++------------ src/boot/translator.boot.pamphlet | 376 +++++++++++----------- 7 files changed, 969 insertions(+), 903 deletions(-) (limited to 'src/boot') 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 + + * 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 * 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|) -- cgit v1.2.3