diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-24 16:14:17 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-24 16:14:17 +0000 |
commit | 8fc8aaeaf79472ff9cfd9b9fb3eeb17379c7d9bd (patch) | |
tree | 7ccb9ec4341eadef78f5f7c8ef0ac3c7b47d25d9 | |
parent | e9dacdbd3f3cd32d38fc1dbc4545dc66ece156ea (diff) | |
download | open-axiom-8fc8aaeaf79472ff9cfd9b9fb3eeb17379c7d9bd.tar.gz |
* boot/ast.boot (bfMakeCollectInsn): New.
(bfDoCollect): Tidy.
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/boot/ast.boot | 17 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 627 | ||||
-rw-r--r-- | src/boot/strap/includer.clisp | 6 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 66 | ||||
-rw-r--r-- | src/boot/strap/scanner.clisp | 34 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 5 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 166 |
8 files changed, 421 insertions, 505 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 5b326825..0fe2a833 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-04-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (bfMakeCollectInsn): New. + (bfDoCollect): Tidy. + +2011-04-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (bfDoCollect): New. Implement one-pass list comprehension. (bfListReduce): Use it. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 0e485759..afff0cf2 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -371,7 +371,7 @@ bfCollect(y,itl) == y is ["COLON",a] => bfListReduce('APPEND,['reverse,a],itl) y is ["TUPLE",:.] => bfListReduce('APPEND,['reverse,bfConstruct y],itl) - bfDoCollect(['CONS,y,'NIL],itl,'CDR) + bfDoCollect(['CONS,y,'NIL],itl,'CDR,nil) bfListReduce(op,y,itl)== g := bfGenSymbol() @@ -379,12 +379,19 @@ bfListReduce(op,y,itl)== extrait := [[[g],[nil],[],[],[],[['reverse!,g]]]] bfLp2(extrait,itl,body) -bfDoCollect(expr,itl,adv) == +bfMakeCollectInsn(expr,prev,head,adv) == + bfIf(['NULL,head],['SETQ,head,['SETQ,prev,expr]], + bfMKPROGN [['RPLACD,prev,expr],['SETQ,prev,[adv,prev]]]) + +bfDoCollect(expr,itl,adv,k) == head := bfGenSymbol() -- pointer to the result prev := bfGenSymbol() -- pointer to the previous cell body := - ['COND,[['NULL,head],['SETQ,head,['SETQ,prev,expr]]], - ["T",bfMKPROGN [['RPLACD,prev,expr],['SETQ,prev,[adv,prev]]]]] + k is 'skipNil => + x := bfGenSymbol() + ['LET,[[x,expr]], + bfIf(['NULL,x],'NIL,bfMakeCollectInsn(x,prev,head,adv))] + bfMakeCollectInsn(expr,prev,head,adv) extrait := [[[head,prev],['NIL,'NIL],nil,nil,nil,[head]]] bfLp2(extrait,itl,body) @@ -398,7 +405,7 @@ bfLp1(iters,body)== first value exits := exits = nil => nbody - ["COND",[bfOR exits,["RETURN",value]],['T,nbody]] + bfIf(bfOR exits,["RETURN",value],nbody) loop := ["LOOP",exits,:sucs] if vars then loop := ["LET",[[v, i] for v in vars for i in inits], loop] diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 1084a8ca..08491478 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -251,14 +251,13 @@ ((OR (ATOM |bfVar#86|) (PROGN (SETQ |x| (CAR |bfVar#86|)) NIL)) (RETURN |bfVar#87|)) - (T (PROGN - (SETQ |bfVar#87| - (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (NULL (CDR |ISTMP#1|)))))) - (COND (|bfVar#87| (RETURN |bfVar#87|)))))) + (T (SETQ |bfVar#87| + (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) + (NULL (CDR |ISTMP#1|)))))) + (COND (|bfVar#87| (RETURN |bfVar#87|))))) (SETQ |bfVar#86| (CDR |bfVar#86|)))) (|bfMakeCons| |a|)) (T (CONS 'LIST |a|))))))) @@ -435,14 +434,12 @@ (ATOM |bfVar#89|) (PROGN (SETQ |j| (CAR |bfVar#89|)) NIL)) (RETURN |bfVar#90|)) - (T (COND - ((NULL |bfVar#90|) - (SETQ |bfVar#90| - (SETQ |bfVar#91| - #0=(LIST (APPEND |i| |j|))))) - (T (PROGN - (RPLACD |bfVar#91| #0#) - (SETQ |bfVar#91| (CDR |bfVar#91|))))))) + ((NULL |bfVar#90|) + (SETQ |bfVar#90| + (SETQ |bfVar#91| + #0=(CONS (APPEND |i| |j|) NIL)))) + (T (RPLACD |bfVar#91| #0#) + (SETQ |bfVar#91| (CDR |bfVar#91|)))) (SETQ |bfVar#88| (CDR |bfVar#88|)) (SETQ |bfVar#89| (CDR |bfVar#89|))))))))) @@ -512,7 +509,7 @@ ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (|bfListReduce| 'APPEND (LIST '|reverse| (|bfConstruct| |y|)) |itl|)) - (T (|bfDoCollect| (LIST 'LIST |y|) |itl| 'CDR)))))) + (T (|bfDoCollect| (LIST 'CONS |y| 'NIL) |itl| 'CDR NIL)))))) (DEFUN |bfListReduce| (|op| |y| |itl|) (PROG (|extrait| |body| |g|) @@ -525,22 +522,27 @@ (LIST (LIST '|reverse!| |g|))))) (|bfLp2| |extrait| |itl| |body|))))) -(DEFUN |bfDoCollect| (|expr| |itl| |adv|) - (PROG (|extrait| |body| |prev| |head|) +(DEFUN |bfMakeCollectInsn| (|expr| |prev| |head| |adv|) + (|bfIf| (LIST 'NULL |head|) + (LIST 'SETQ |head| (LIST 'SETQ |prev| |expr|)) + (|bfMKPROGN| + (LIST (LIST 'RPLACD |prev| |expr|) + (LIST 'SETQ |prev| (LIST |adv| |prev|)))))) + +(DEFUN |bfDoCollect| (|expr| |itl| |adv| |k|) + (PROG (|extrait| |body| |x| |prev| |head|) (RETURN (PROGN (SETQ |head| (|bfGenSymbol|)) (SETQ |prev| (|bfGenSymbol|)) (SETQ |body| - (LIST 'COND - (LIST (LIST 'NULL |head|) - (LIST 'SETQ |head| - (LIST 'SETQ |prev| |expr|))) - (LIST 'T - (|bfMKPROGN| - (LIST (LIST 'RPLACD |prev| |expr|) - (LIST 'SETQ |prev| - (LIST |adv| |prev|))))))) + (COND + ((EQ |k| '|skipNil|) (SETQ |x| (|bfGenSymbol|)) + (LIST 'LET (LIST (LIST |x| |expr|)) + (|bfIf| (LIST 'NULL |x|) 'NIL + (|bfMakeCollectInsn| |x| |prev| |head| + |adv|)))) + (T (|bfMakeCollectInsn| |expr| |prev| |head| |adv|)))) (SETQ |extrait| (LIST (LIST (LIST |head| |prev|) (LIST 'NIL 'NIL) NIL NIL NIL (LIST |head|)))) @@ -566,9 +568,8 @@ (SETQ |exits| (COND ((NULL |exits|) |nbody|) - (T (LIST 'COND - (LIST (|bfOR| |exits|) (LIST 'RETURN |value|)) - (LIST 'T |nbody|))))) + (T (|bfIf| (|bfOR| |exits|) (LIST 'RETURN |value|) + |nbody|)))) (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|))) (COND (|vars| (SETQ |loop| @@ -587,17 +588,12 @@ (SETQ |i| (CAR |bfVar#93|)) NIL)) (RETURN |bfVar#94|)) - (T - (COND - ((NULL |bfVar#94|) - (SETQ |bfVar#94| - (SETQ |bfVar#95| - #2=(LIST (LIST |v| |i|))))) - (T - (PROGN - (RPLACD |bfVar#95| #2#) - (SETQ |bfVar#95| - (CDR |bfVar#95|))))))) + ((NULL |bfVar#94|) + (SETQ |bfVar#94| + (SETQ |bfVar#95| + #2=(CONS (LIST |v| |i|) NIL)))) + (T (RPLACD |bfVar#95| #2#) + (SETQ |bfVar#95| (CDR |bfVar#95|)))) (SETQ |bfVar#92| (CDR |bfVar#92|)) (SETQ |bfVar#93| (CDR |bfVar#93|)))) |loop|)))) @@ -1136,9 +1132,8 @@ ((OR (ATOM |bfVar#96|) (PROGN (SETQ |y| (CAR |bfVar#96|)) NIL)) (RETURN |bfVar#97|)) - (T (PROGN - (SETQ |bfVar#97| (APPLY |pred| |y| NIL)) - (COND ((NOT |bfVar#97|) (RETURN NIL)))))) + (T (SETQ |bfVar#97| (APPLY |pred| |y| NIL)) + (COND ((NOT |bfVar#97|) (RETURN NIL))))) (SETQ |bfVar#96| (CDR |bfVar#96|)))))))) (DEFUN |bfMember| (|var| |seq|) @@ -1334,14 +1329,12 @@ (ATOM |bfVar#103|) (PROGN (SETQ |j| (CAR |bfVar#103|)) NIL)) (RETURN |bfVar#104|)) - (T (COND - ((NULL |bfVar#104|) - (SETQ |bfVar#104| - (SETQ |bfVar#105| - #1=(LIST (CONS |i| |j|))))) - (T (PROGN - (RPLACD |bfVar#105| #1#) - (SETQ |bfVar#105| (CDR |bfVar#105|))))))) + ((NULL |bfVar#104|) + (SETQ |bfVar#104| + (SETQ |bfVar#105| + #1=(CONS (CONS |i| |j|) NIL)))) + (T (RPLACD |bfVar#105| #1#) + (SETQ |bfVar#105| (CDR |bfVar#105|)))) (SETQ |bfVar#102| (CDR |bfVar#102|)) (SETQ |bfVar#103| (CDR |bfVar#103|))))) (SETQ |body| (SUBLIS |sb| |body|)) @@ -1356,16 +1349,14 @@ (ATOM |bfVar#107|) (PROGN (SETQ |j| (CAR |bfVar#107|)) NIL)) (RETURN |bfVar#108|)) - (T (COND - ((NULL |bfVar#108|) - (SETQ |bfVar#108| - (SETQ |bfVar#109| - #2=(LIST - (LIST 'CONS (LIST 'QUOTE |i|) - |j|))))) - (T (PROGN - (RPLACD |bfVar#109| #2#) - (SETQ |bfVar#109| (CDR |bfVar#109|))))))) + ((NULL |bfVar#108|) + (SETQ |bfVar#108| + (SETQ |bfVar#109| + #2=(CONS + (LIST 'CONS (LIST 'QUOTE |i|) |j|) + NIL)))) + (T (RPLACD |bfVar#109| #2#) + (SETQ |bfVar#109| (CDR |bfVar#109|)))) (SETQ |bfVar#106| (CDR |bfVar#106|)) (SETQ |bfVar#107| (CDR |bfVar#107|))))) (SETQ |body| @@ -1474,13 +1465,11 @@ ((OR (ATOM |bfVar#115|) (PROGN (SETQ |def| (CAR |bfVar#115|)) NIL)) (RETURN |bfVar#116|)) - (T (COND - ((NULL |bfVar#116|) - (SETQ |bfVar#116| - (SETQ |bfVar#117| #0=(LIST (|shoeComp| |def|))))) - (T (PROGN - (RPLACD |bfVar#117| #0#) - (SETQ |bfVar#117| (CDR |bfVar#117|))))))) + ((NULL |bfVar#116|) + (SETQ |bfVar#116| + (SETQ |bfVar#117| #0=(CONS (|shoeComp| |def|) NIL)))) + (T (RPLACD |bfVar#117| #0#) + (SETQ |bfVar#117| (CDR |bfVar#117|)))) (SETQ |bfVar#115| (CDR |bfVar#115|))))) (DEFUN |shoeComp| (|x|) @@ -1632,9 +1621,8 @@ ((OR (ATOM |bfVar#118|) (PROGN (SETQ |t| (CAR |bfVar#118|)) NIL)) (RETURN |bfVar#119|)) - (T (PROGN - (SETQ |bfVar#119| (|needsPROG| |t|)) - (COND (|bfVar#119| (RETURN |bfVar#119|)))))) + (T (SETQ |bfVar#119| (|needsPROG| |t|)) + (COND (|bfVar#119| (RETURN |bfVar#119|))))) (SETQ |bfVar#118| (CDR |bfVar#118|)))) T) (T NIL))))))) @@ -1736,13 +1724,12 @@ ((OR (ATOM |bfVar#120|) (PROGN (SETQ |y| (CAR |bfVar#120|)) NIL)) (RETURN NIL)) - (T (COND - ((NOT (MEMQ |y| |$locVars|)) - (IDENTITY - (PROGN - (SETQ |$locVars| (CONS |y| |$locVars|)) - (SETQ |newbindings| - (CONS |y| |newbindings|)))))))) + ((NOT (MEMQ |y| |$locVars|)) + (IDENTITY + (PROGN + (SETQ |$locVars| (CONS |y| |$locVars|)) + (SETQ |newbindings| + (CONS |y| |newbindings|)))))) (SETQ |bfVar#120| (CDR |bfVar#120|)))) (SETQ |res| (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| @@ -1759,12 +1746,11 @@ (COND ((NULL |bfVar#122|) (SETQ |bfVar#122| - (SETQ |bfVar#123| #0=(LIST |y|)))) - (T - (PROGN - (RPLACD |bfVar#123| #0#) - (SETQ |bfVar#123| - (CDR |bfVar#123|)))))))) + (SETQ |bfVar#123| + #0=(CONS |y| NIL)))) + (T (RPLACD |bfVar#123| #0#) + (SETQ |bfVar#123| + (CDR |bfVar#123|))))))) (SETQ |bfVar#121| (CDR |bfVar#121|)))))) (T (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))) @@ -1892,11 +1878,10 @@ ((NULL |bfVar#126|) (SETQ |bfVar#126| (SETQ |bfVar#127| - #0=(LIST |i|)))) - (T (PROGN - (RPLACD |bfVar#127| #0#) - (SETQ |bfVar#127| - (CDR |bfVar#127|)))))))) + #0=(CONS |i| NIL)))) + (T (RPLACD |bfVar#127| #0#) + (SETQ |bfVar#127| + (CDR |bfVar#127|))))))) (SETQ |bfVar#125| (CDR |bfVar#125|))))) (T (CDR |f|)))) (T (LIST |f|)))))))) @@ -1986,14 +1971,13 @@ (CAR |ISTMP#5|)) T)))))))))))))) (RETURN |bfVar#129|)) - (T (COND - ((NULL |bfVar#129|) - (SETQ |bfVar#129| - (SETQ |bfVar#130| - #0=(LIST (|bfAlternative| |a| |b|))))) - (T (PROGN - (RPLACD |bfVar#130| #0#) - (SETQ |bfVar#130| (CDR |bfVar#130|))))))) + ((NULL |bfVar#129|) + (SETQ |bfVar#129| + (SETQ |bfVar#130| + #0=(CONS (|bfAlternative| |a| |b|) + NIL)))) + (T (RPLACD |bfVar#130| #0#) + (SETQ |bfVar#130| (CDR |bfVar#130|)))) (SETQ |bfVar#128| (CDR |bfVar#128|))))) (SETQ |no| (LENGTH |transform|)) (SETQ |before| (|bfTake| |no| |l|)) @@ -2033,17 +2017,16 @@ ((OR (ATOM |bfVar#131|) (PROGN (SETQ |d| (CAR |bfVar#131|)) NIL)) (RETURN |bfVar#132|)) - (T (COND - ((NULL |bfVar#132|) - (SETQ |bfVar#132| - (SETQ |bfVar#133| - #1=(LIST - (LIST (CAR |d|) (CADR |d|) - (|bfSUBLIS| |opassoc| - (CADDR |d|))))))) - (T (PROGN - (RPLACD |bfVar#133| #1#) - (SETQ |bfVar#133| (CDR |bfVar#133|))))))) + ((NULL |bfVar#132|) + (SETQ |bfVar#132| + (SETQ |bfVar#133| + #1=(CONS + (LIST (CAR |d|) (CADR |d|) + (|bfSUBLIS| |opassoc| + (CADDR |d|))) + NIL)))) + (T (RPLACD |bfVar#133| #1#) + (SETQ |bfVar#133| (CDR |bfVar#133|)))) (SETQ |bfVar#131| (CDR |bfVar#131|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| @@ -2136,14 +2119,12 @@ ((OR (ATOM |bfVar#134|) (PROGN (SETQ |i| (CAR |bfVar#134|)) NIL)) (RETURN |bfVar#135|)) - (T (COND - ((NULL |bfVar#135|) - (SETQ |bfVar#135| - (SETQ |bfVar#136| - #0=(LIST (|bfGenSymbol|))))) - (T (PROGN - (RPLACD |bfVar#136| #0#) - (SETQ |bfVar#136| (CDR |bfVar#136|))))))) + ((NULL |bfVar#135|) + (SETQ |bfVar#135| + (SETQ |bfVar#136| + #0=(CONS (|bfGenSymbol|) NIL)))) + (T (RPLACD |bfVar#136| #0#) + (SETQ |bfVar#136| (CDR |bfVar#136|)))) (SETQ |bfVar#134| (CDR |bfVar#134|))))) (LIST 'DEFUN (CAR |x|) |a| (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) @@ -2190,10 +2171,9 @@ ((NULL |bfVar#139|) (SETQ |bfVar#139| (SETQ |bfVar#140| - #0=(LIST (|bfCI| |g| |i| |j|))))) - (T (PROGN - (RPLACD |bfVar#140| #0#) - (SETQ |bfVar#140| (CDR |bfVar#140|)))))))) + #0=(CONS (|bfCI| |g| |i| |j|) NIL)))) + (T (RPLACD |bfVar#140| #0#) + (SETQ |bfVar#140| (CDR |bfVar#140|))))))) (SETQ |bfVar#138| (CDR |bfVar#138|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Form|) |bfCI|)) @@ -2218,14 +2198,13 @@ ((NULL |bfVar#142|) (SETQ |bfVar#142| (SETQ |bfVar#143| - #0=(LIST + #0=(CONS (LIST |i| - (|bfCARCDR| |j| |g|)))))) - (T - (PROGN - (RPLACD |bfVar#143| #0#) - (SETQ |bfVar#143| - (CDR |bfVar#143|)))))))) + (|bfCARCDR| |j| |g|)) + NIL)))) + (T (RPLACD |bfVar#143| #0#) + (SETQ |bfVar#143| + (CDR |bfVar#143|))))))) (SETQ |bfVar#141| (CDR |bfVar#141|)) (SETQ |j| (+ |j| 1))))) (COND @@ -2371,15 +2350,13 @@ ((OR (ATOM |bfVar#144|) (PROGN (SETQ |t| (CAR |bfVar#144|)) NIL)) (RETURN |bfVar#145|)) - (T (COND - ((NULL |bfVar#145|) - (SETQ |bfVar#145| - (SETQ |bfVar#146| - #0=(LIST - (|backquote| |t| |params|))))) - (T (PROGN - (RPLACD |bfVar#146| #0#) - (SETQ |bfVar#146| (CDR |bfVar#146|))))))) + ((NULL |bfVar#145|) + (SETQ |bfVar#145| + (SETQ |bfVar#146| + #0=(CONS (|backquote| |t| |params|) + NIL)))) + (T (RPLACD |bfVar#146| #0#) + (SETQ |bfVar#146| (CDR |bfVar#146|)))) (SETQ |bfVar#144| (CDR |bfVar#144|)))))))) (DEFUN |genTypeAlias| (|head| |body|) @@ -2588,15 +2565,13 @@ ((OR (ATOM |bfVar#147|) (PROGN (SETQ |x| (CAR |bfVar#147|)) NIL)) (RETURN |bfVar#148|)) - (T (COND - ((NULL |bfVar#148|) - (SETQ |bfVar#148| - (SETQ |bfVar#149| - #0=(LIST - (|nativeArgumentType| |x|))))) - (T (PROGN - (RPLACD |bfVar#149| #0#) - (SETQ |bfVar#149| (CDR |bfVar#149|))))))) + ((NULL |bfVar#148|) + (SETQ |bfVar#148| + (SETQ |bfVar#149| + #0=(CONS (|nativeArgumentType| |x|) + NIL)))) + (T (RPLACD |bfVar#149| #0#) + (SETQ |bfVar#149| (CDR |bfVar#149|)))) (SETQ |bfVar#147| (CDR |bfVar#147|))))) (SETQ |rettype| (|nativeReturnType| |t|)) (COND @@ -2607,9 +2582,8 @@ ((OR (ATOM |bfVar#150|) (PROGN (SETQ |x| (CAR |bfVar#150|)) NIL)) (RETURN |bfVar#151|)) - (T (PROGN - (SETQ |bfVar#151| (|isSimpleNativeType| |x|)) - (COND ((NOT |bfVar#151|) (RETURN NIL)))))) + (T (SETQ |bfVar#151| (|isSimpleNativeType| |x|)) + (COND ((NOT |bfVar#151|) (RETURN NIL))))) (SETQ |bfVar#150| (CDR |bfVar#150|)))) (LIST (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| (PNAME |op'|))))) @@ -2620,19 +2594,19 @@ (LOOP (COND ((> |i| |bfVar#159|) (RETURN |bfVar#160|)) - (T (COND - ((NULL |bfVar#160|) - (SETQ |bfVar#160| - (SETQ |bfVar#161| - (LIST + ((NULL |bfVar#160|) + (SETQ |bfVar#160| + (SETQ |bfVar#161| + (CONS (|genGCLnativeTranslation,mkCArgName| - |i|))))) - (T (PROGN - (RPLACD |bfVar#161| - (LIST + |i|) + NIL)))) + (T (RPLACD |bfVar#161| + (CONS (|genGCLnativeTranslation,mkCArgName| - |i|))) - (SETQ |bfVar#161| (CDR |bfVar#161|))))))) + |i|) + NIL)) + (SETQ |bfVar#161| (CDR |bfVar#161|)))) (SETQ |i| (+ |i| 1))))) (SETQ |ccode| (LET ((|bfVar#156| "") @@ -2652,22 +2626,21 @@ ((OR (ATOM |x|) (ATOM |a|)) (RETURN |bfVar#152|)) + ((NULL |bfVar#152|) + (SETQ |bfVar#152| + (SETQ |bfVar#153| + (CONS + (|genGCLnativeTranslation,cparm| + |x| |a|) + NIL)))) (T - (COND - ((NULL |bfVar#152|) - (SETQ |bfVar#152| - (SETQ |bfVar#153| - (LIST - (|genGCLnativeTranslation,cparm| - |x| |a|))))) - (T - (PROGN - (RPLACD |bfVar#153| - (LIST - (|genGCLnativeTranslation,cparm| - |x| |a|))) - (SETQ |bfVar#153| - (CDR |bfVar#153|))))))) + (RPLACD |bfVar#153| + (CONS + (|genGCLnativeTranslation,cparm| + |x| |a|) + NIL)) + (SETQ |bfVar#153| + (CDR |bfVar#153|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS ") { " @@ -2689,27 +2662,21 @@ (ATOM |a|)) (RETURN |bfVar#154|)) + ((NULL |bfVar#154|) + (SETQ |bfVar#154| + (SETQ |bfVar#155| + (CONS + (|genGCLnativeTranslation,gclArgsInC| + |x| |a|) + NIL)))) (T - (COND - ((NULL - |bfVar#154|) - (SETQ |bfVar#154| - (SETQ - |bfVar#155| - (LIST - (|genGCLnativeTranslation,gclArgsInC| - |x| |a|))))) - (T - (PROGN - (RPLACD - |bfVar#155| - (LIST - (|genGCLnativeTranslation,gclArgsInC| - |x| |a|))) - (SETQ - |bfVar#155| - (CDR - |bfVar#155|))))))) + (RPLACD |bfVar#155| + (CONS + (|genGCLnativeTranslation,gclArgsInC| + |x| |a|) + NIL)) + (SETQ |bfVar#155| + (CDR |bfVar#155|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS "); }" NIL)))))))))))) @@ -2789,10 +2756,9 @@ ((OR (ATOM |bfVar#162|) (PROGN (SETQ |x| (CAR |bfVar#162|)) NIL)) (RETURN NIL)) - (T (PROGN - (SETQ |argtypes| - (CONS (|nativeArgumentType| |x|) |argtypes|)) - (SETQ |args| (CONS (GENSYM) |args|))))) + (T (SETQ |argtypes| + (CONS (|nativeArgumentType| |x|) |argtypes|)) + (SETQ |args| (CONS (GENSYM) |args|)))) (SETQ |bfVar#162| (CDR |bfVar#162|)))) (SETQ |args| (|reverse| |args|)) (SETQ |rettype| (|nativeReturnType| |t|)) @@ -2820,22 +2786,21 @@ (SETQ |x| (CAR |bfVar#164|)) NIL)) (RETURN |bfVar#165|)) + ((NULL |bfVar#165|) + (SETQ |bfVar#165| + (SETQ |bfVar#166| + (CONS + (|genECLnativeTranslation,sharpArg| + |i| |x|) + NIL)))) (T - (COND - ((NULL |bfVar#165|) - (SETQ |bfVar#165| - (SETQ |bfVar#166| - (LIST - (|genECLnativeTranslation,sharpArg| - |i| |x|))))) - (T - (PROGN - (RPLACD |bfVar#166| - (LIST - (|genECLnativeTranslation,sharpArg| - |i| |x|))) - (SETQ |bfVar#166| - (CDR |bfVar#166|))))))) + (RPLACD |bfVar#166| + (CONS + (|genECLnativeTranslation,sharpArg| + |i| |x|) + NIL)) + (SETQ |bfVar#166| + (CDR |bfVar#166|)))) (SETQ |i| (+ |i| 1)) (SETQ |bfVar#164| (CDR |bfVar#164|)))) @@ -2894,15 +2859,13 @@ ((OR (ATOM |bfVar#170|) (PROGN (SETQ |x| (CAR |bfVar#170|)) NIL)) (RETURN |bfVar#171|)) - (T (COND - ((NULL |bfVar#171|) - (SETQ |bfVar#171| - (SETQ |bfVar#172| - #0=(LIST - (|nativeArgumentType| |x|))))) - (T (PROGN - (RPLACD |bfVar#172| #0#) - (SETQ |bfVar#172| (CDR |bfVar#172|))))))) + ((NULL |bfVar#171|) + (SETQ |bfVar#171| + (SETQ |bfVar#172| + #0=(CONS (|nativeArgumentType| |x|) + NIL)))) + (T (RPLACD |bfVar#172| #0#) + (SETQ |bfVar#172| (CDR |bfVar#172|)))) (SETQ |bfVar#170| (CDR |bfVar#170|))))) (SETQ |n| (INTERN (CONCAT (PNAME |op|) "%clisp-hack"))) (SETQ |parms| @@ -2913,14 +2876,12 @@ ((OR (ATOM |bfVar#173|) (PROGN (SETQ |x| (CAR |bfVar#173|)) NIL)) (RETURN |bfVar#174|)) - (T (COND - ((NULL |bfVar#174|) - (SETQ |bfVar#174| - (SETQ |bfVar#175| - #1=(LIST (GENSYM "parm"))))) - (T (PROGN - (RPLACD |bfVar#175| #1#) - (SETQ |bfVar#175| (CDR |bfVar#175|))))))) + ((NULL |bfVar#174|) + (SETQ |bfVar#174| + (SETQ |bfVar#175| + #1=(CONS (GENSYM "parm") NIL)))) + (T (RPLACD |bfVar#175| #1#) + (SETQ |bfVar#175| (CDR |bfVar#175|)))) (SETQ |bfVar#173| (CDR |bfVar#173|))))) (SETQ |unstableArgs| NIL) (LET ((|bfVar#176| |parms|) (|p| NIL) (|bfVar#177| |s|) @@ -2934,12 +2895,11 @@ (ATOM |bfVar#178|) (PROGN (SETQ |y| (CAR |bfVar#178|)) NIL)) (RETURN NIL)) - (T (COND - ((|needsStableReference?| |x|) - (IDENTITY - (SETQ |unstableArgs| - (CONS (CONS |p| (CONS |x| |y|)) - |unstableArgs|))))))) + ((|needsStableReference?| |x|) + (IDENTITY + (SETQ |unstableArgs| + (CONS (CONS |p| (CONS |x| |y|)) + |unstableArgs|))))) (SETQ |bfVar#176| (CDR |bfVar#176|)) (SETQ |bfVar#177| (CDR |bfVar#177|)) (SETQ |bfVar#178| (CDR |bfVar#178|)))) @@ -2961,16 +2921,12 @@ (SETQ |a| (CAR |bfVar#180|)) NIL)) (RETURN |bfVar#181|)) - (T (COND - ((NULL |bfVar#181|) - (SETQ |bfVar#181| + ((NULL |bfVar#181|) + (SETQ |bfVar#181| (SETQ |bfVar#182| - #2=(LIST (LIST |a| |x|))))) - (T - (PROGN - (RPLACD |bfVar#182| #2#) - (SETQ |bfVar#182| - (CDR |bfVar#182|))))))) + #2=(CONS (LIST |a| |x|) NIL)))) + (T (RPLACD |bfVar#182| #2#) + (SETQ |bfVar#182| (CDR |bfVar#182|)))) (SETQ |bfVar#179| (CDR |bfVar#179|)) (SETQ |bfVar#180| (CDR |bfVar#180|))))) (LIST :RETURN-TYPE |rettype|) @@ -3005,16 +2961,15 @@ ((NULL |bfVar#185|) (SETQ |bfVar#185| (SETQ |bfVar#186| - #3=(LIST + #3=(CONS (CONS |a| (CONS |x| (CONS |y| - (GENSYM "loc")))))))) - (T - (PROGN - (RPLACD |bfVar#186| #3#) - (SETQ |bfVar#186| - (CDR |bfVar#186|)))))))) + (GENSYM "loc")))) + NIL)))) + (T (RPLACD |bfVar#186| #3#) + (SETQ |bfVar#186| + (CDR |bfVar#186|))))))) (SETQ |bfVar#184| (CDR |bfVar#184|))))) (SETQ |call| (CONS |n| @@ -3028,22 +2983,21 @@ (SETQ |p| (CAR |bfVar#187|)) NIL)) (RETURN |bfVar#188|)) + ((NULL |bfVar#188|) + (SETQ |bfVar#188| + (SETQ |bfVar#189| + (CONS + (|genCLISPnativeTranslation,actualArg| + |p| |localPairs|) + NIL)))) (T - (COND - ((NULL |bfVar#188|) - (SETQ |bfVar#188| - (SETQ |bfVar#189| - (LIST - (|genCLISPnativeTranslation,actualArg| - |p| |localPairs|))))) - (T - (PROGN - (RPLACD |bfVar#189| - (LIST - (|genCLISPnativeTranslation,actualArg| - |p| |localPairs|))) - (SETQ |bfVar#189| - (CDR |bfVar#189|))))))) + (RPLACD |bfVar#189| + (CONS + (|genCLISPnativeTranslation,actualArg| + |p| |localPairs|) + NIL)) + (SETQ |bfVar#189| + (CDR |bfVar#189|)))) (SETQ |bfVar#187| (CDR |bfVar#187|)))))) (SETQ |call| (PROGN @@ -3070,13 +3024,12 @@ ((NULL |bfVar#191|) (SETQ |bfVar#191| (SETQ |bfVar#192| - (LIST |q|)))) + (CONS |q| NIL)))) (T - (PROGN - (RPLACD |bfVar#192| - (LIST |q|)) - (SETQ |bfVar#192| - (CDR |bfVar#192|)))))))) + (RPLACD |bfVar#192| + (CONS |q| NIL)) + (SETQ |bfVar#192| + (CDR |bfVar#192|))))))) (SETQ |bfVar#190| (CDR |bfVar#190|))))) (COND @@ -3159,15 +3112,13 @@ ((OR (ATOM |bfVar#196|) (PROGN (SETQ |x| (CAR |bfVar#196|)) NIL)) (RETURN |bfVar#197|)) - (T (COND - ((NULL |bfVar#197|) - (SETQ |bfVar#197| - (SETQ |bfVar#198| - #0=(LIST - (|nativeArgumentType| |x|))))) - (T (PROGN - (RPLACD |bfVar#198| #0#) - (SETQ |bfVar#198| (CDR |bfVar#198|))))))) + ((NULL |bfVar#197|) + (SETQ |bfVar#197| + (SETQ |bfVar#198| + #0=(CONS (|nativeArgumentType| |x|) + NIL)))) + (T (RPLACD |bfVar#198| #0#) + (SETQ |bfVar#198| (CDR |bfVar#198|)))) (SETQ |bfVar#196| (CDR |bfVar#196|))))) (SETQ |args| (LET ((|bfVar#200| NIL) (|bfVar#201| NIL) @@ -3177,13 +3128,11 @@ ((OR (ATOM |bfVar#199|) (PROGN (SETQ |x| (CAR |bfVar#199|)) NIL)) (RETURN |bfVar#200|)) - (T (COND - ((NULL |bfVar#200|) - (SETQ |bfVar#200| - (SETQ |bfVar#201| #1=(LIST (GENSYM))))) - (T (PROGN - (RPLACD |bfVar#201| #1#) - (SETQ |bfVar#201| (CDR |bfVar#201|))))))) + ((NULL |bfVar#200|) + (SETQ |bfVar#200| + (SETQ |bfVar#201| #1=(CONS (GENSYM) NIL)))) + (T (RPLACD |bfVar#201| #1#) + (SETQ |bfVar#201| (CDR |bfVar#201|)))) (SETQ |bfVar#199| (CDR |bfVar#199|))))) (SETQ |unstableArgs| NIL) (SETQ |newArgs| NIL) @@ -3196,13 +3145,11 @@ (ATOM |bfVar#203|) (PROGN (SETQ |x| (CAR |bfVar#203|)) NIL)) (RETURN NIL)) - (T (PROGN - (SETQ |newArgs| - (CONS (|coerceToNativeType| |a| |x|) - |newArgs|)) - (COND - ((|needsStableReference?| |x|) - (SETQ |unstableArgs| (CONS |a| |unstableArgs|))))))) + (T (SETQ |newArgs| + (CONS (|coerceToNativeType| |a| |x|) |newArgs|)) + (COND + ((|needsStableReference?| |x|) + (SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))) (SETQ |bfVar#202| (CDR |bfVar#202|)) (SETQ |bfVar#203| (CDR |bfVar#203|)))) (SETQ |op'| @@ -3248,15 +3195,13 @@ ((OR (ATOM |bfVar#204|) (PROGN (SETQ |x| (CAR |bfVar#204|)) NIL)) (RETURN |bfVar#205|)) - (T (COND - ((NULL |bfVar#205|) - (SETQ |bfVar#205| - (SETQ |bfVar#206| - #0=(LIST - (|nativeArgumentType| |x|))))) - (T (PROGN - (RPLACD |bfVar#206| #0#) - (SETQ |bfVar#206| (CDR |bfVar#206|))))))) + ((NULL |bfVar#205|) + (SETQ |bfVar#205| + (SETQ |bfVar#206| + #0=(CONS (|nativeArgumentType| |x|) + NIL)))) + (T (RPLACD |bfVar#206| #0#) + (SETQ |bfVar#206| (CDR |bfVar#206|)))) (SETQ |bfVar#204| (CDR |bfVar#204|))))) (SETQ |parms| (LET ((|bfVar#208| NIL) (|bfVar#209| NIL) @@ -3266,14 +3211,12 @@ ((OR (ATOM |bfVar#207|) (PROGN (SETQ |x| (CAR |bfVar#207|)) NIL)) (RETURN |bfVar#208|)) - (T (COND - ((NULL |bfVar#208|) - (SETQ |bfVar#208| - (SETQ |bfVar#209| - #1=(LIST (GENSYM "parm"))))) - (T (PROGN - (RPLACD |bfVar#209| #1#) - (SETQ |bfVar#209| (CDR |bfVar#209|))))))) + ((NULL |bfVar#208|) + (SETQ |bfVar#208| + (SETQ |bfVar#209| + #1=(CONS (GENSYM "parm") NIL)))) + (T (RPLACD |bfVar#209| #1#) + (SETQ |bfVar#209| (CDR |bfVar#209|)))) (SETQ |bfVar#207| (CDR |bfVar#207|))))) (SETQ |strPairs| NIL) (SETQ |aryPairs| NIL) @@ -3286,26 +3229,23 @@ (ATOM |bfVar#211|) (PROGN (SETQ |x| (CAR |bfVar#211|)) NIL)) (RETURN NIL)) - (T (COND - ((EQ |x| '|string|) - (SETQ |strPairs| - (CONS (CONS |p| (GENSYM "loc")) |strPairs|))) - ((AND (CONSP |x|) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CAR |ISTMP#2|) '|buffer|) - (PROGN - (SETQ |ISTMP#3| - (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (NULL (CDR |ISTMP#3|))))))))) - (SETQ |aryPairs| - (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))))) + ((EQ |x| '|string|) + (SETQ |strPairs| + (CONS (CONS |p| (GENSYM "loc")) |strPairs|))) + ((AND (CONSP |x|) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (EQ (CAR |ISTMP#2|) '|buffer|) + (PROGN + (SETQ |ISTMP#3| (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (NULL (CDR |ISTMP#3|))))))))) + (SETQ |aryPairs| + (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))) (SETQ |bfVar#210| (CDR |bfVar#210|)) (SETQ |bfVar#211| (CDR |bfVar#211|)))) (COND @@ -3378,18 +3318,15 @@ (SETQ |arg| (CAR |bfVar#216|)) NIL)) (RETURN |bfVar#217|)) - (T (COND - ((NULL |bfVar#217|) - (SETQ |bfVar#217| + ((NULL |bfVar#217|) + (SETQ |bfVar#217| (SETQ |bfVar#218| - #2=(LIST + #2=(CONS (LIST (CDR |arg|) - (CAR |arg|)))))) - (T - (PROGN - (RPLACD |bfVar#218| #2#) - (SETQ |bfVar#218| - (CDR |bfVar#218|))))))) + (CAR |arg|)) + NIL)))) + (T (RPLACD |bfVar#218| #2#) + (SETQ |bfVar#218| (CDR |bfVar#218|)))) (SETQ |bfVar#216| (CDR |bfVar#216|)))) |call|)))) (LIST (LIST 'DEFUN |op| |parms| |call|)))))) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index fc1065fb..7509ac95 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -101,10 +101,8 @@ (SETQ |args| (CDR |ISTMP#1|)) T))))) (RETURN NIL)) - (T (PROGN - (SETQ |st| (APPLY |op| |args|)) - (RPLACA |x| (CAR |st|)) - (RPLACD |x| (CDR |st|)))))) + (T (SETQ |st| (APPLY |op| |args|)) + (RPLACA |x| (CAR |st|)) (RPLACD |x| (CDR |st|))))) (AND (CONSP |x|) (EQ (CAR |x|) '|nullstream|))))))) (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 80aa2a76..7cf584dd 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -355,38 +355,36 @@ (LOOP (COND (|done| (RETURN NIL)) - (T (PROGN - (SETQ |found| - (LET ((#0=#:G1354 - (CATCH :OPEN-AXIOM-CATCH-POINT - (APPLY |f| NIL)))) - (COND - ((AND (CONSP #0#) - (EQUAL (CAR #0#) - :OPEN-AXIOM-CATCH-POINT)) - (COND - ((EQUAL (CAR #1=(CDR #0#)) - '(|BootParserException|)) - (LET ((|e| (CDR #1#))) |e|)) - (T (THROW :OPEN-AXIOM-CATCH-POINT #0#)))) - (T #0#)))) - (COND - ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|) - (|bpRecoverTrap|)) - ((NOT |found|) (SETQ |$inputStream| |c|) - (|bpGeneralErrorHere|) (|bpRecoverTrap|))) - (COND - ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|)) - ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) - (SETQ |done| T)) - (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) - (|bpRecoverTrap|) - (COND - ((OR (|bpEqPeek| 'BACKTAB) - (NULL |$inputStream|)) - (SETQ |done| T)) - (T (|bpNext|) (SETQ |c| |$inputStream|))))) - (SETQ |b| (CONS (|bpPop1|) |b|)))))) + (T (SETQ |found| + (LET ((#0=#:G1354 + (CATCH :OPEN-AXIOM-CATCH-POINT + (APPLY |f| NIL)))) + (COND + ((AND (CONSP #0#) + (EQUAL (CAR #0#) + :OPEN-AXIOM-CATCH-POINT)) + (COND + ((EQUAL (CAR #1=(CDR #0#)) + '(|BootParserException|)) + (LET ((|e| (CDR #1#))) |e|)) + (T (THROW :OPEN-AXIOM-CATCH-POINT #0#)))) + (T #0#)))) + (COND + ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|) + (|bpRecoverTrap|)) + ((NOT |found|) (SETQ |$inputStream| |c|) + (|bpGeneralErrorHere|) (|bpRecoverTrap|))) + (COND + ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|)) + ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) + (SETQ |done| T)) + (T (SETQ |$inputStream| |c|) (|bpGeneralErrorHere|) + (|bpRecoverTrap|) + (COND + ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|)) + (SETQ |done| T)) + (T (|bpNext|) (SETQ |c| |$inputStream|))))) + (SETQ |b| (CONS (|bpPop1|) |b|))))) (SETQ |$stack| |a|) (|bpPush| (|reverse!| |b|)))))) @@ -766,9 +764,7 @@ (LOOP (COND ((NOT (|bpHandler| 'CATCH)) (RETURN NIL)) - (T (PROGN - (|bpCatchItem|) - (SETQ |cs| (CONS (|bpPop1|) |cs|)))))) + (T (|bpCatchItem|) (SETQ |cs| (CONS (|bpPop1|) |cs|))))) (COND ((|bpHandler| 'FINALLY) (AND (|bpFinally|) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index a76f3a3f..1e5d418b 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -443,9 +443,8 @@ (LOOP (COND ((> |i| |bfVar#1|) (RETURN NIL)) - (T (PROGN - (SETQ |d| (|shoeOrdToNum| (SCHAR |s| |i|))) - (SETQ |ival| (+ (* 10 |ival|) |d|))))) + (T (SETQ |d| (|shoeOrdToNum| (SCHAR |s| |i|))) + (SETQ |ival| (+ (* 10 |ival|) |d|)))) (SETQ |i| (+ |i| 1)))) |ival|)))) @@ -536,24 +535,21 @@ (LOOP (COND ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL)) - (T (PROGN - (SETQ |s| (ELT |u| |j|)) - (SETQ |ls| (LENGTH |s|)) - (SETQ |done| - (COND - ((< |ll| (+ |ls| |i|)) NIL) - (T (SETQ |eql| T) - (LET ((|bfVar#3| (- |ls| 1)) (|k| 1)) - (LOOP - (COND - ((OR (> |k| |bfVar#3|) (NOT |eql|)) - (RETURN NIL)) - (T - (SETQ |eql| + (T (SETQ |s| (ELT |u| |j|)) (SETQ |ls| (LENGTH |s|)) + (SETQ |done| + (COND + ((< |ll| (+ |ls| |i|)) NIL) + (T (SETQ |eql| T) + (LET ((|bfVar#3| (- |ls| 1)) (|k| 1)) + (LOOP + (COND + ((OR (> |k| |bfVar#3|) (NOT |eql|)) + (RETURN NIL)) + (T (SETQ |eql| (CHAR= (SCHAR |s| |k|) (SCHAR |l| (+ |k| |i|)))))) - (SETQ |k| (+ |k| 1)))) - (COND (|eql| (SETQ |s1| |s|) T) (T NIL)))))))) + (SETQ |k| (+ |k| 1)))) + (COND (|eql| (SETQ |s1| |s|) T) (T NIL))))))) (SETQ |j| (+ |j| 1)))) |s1|)))) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 6843b904..074db86d 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -142,9 +142,8 @@ ((OR (ATOM |bfVar#6|) (PROGN (SETQ |k| (CAR |bfVar#6|)) NIL)) (RETURN NIL)) - (T (COND - ((|shoeStartsId| (ELT |k| 0)) NIL) - (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))))) + ((|shoeStartsId| (ELT |k| 0)) NIL) + (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))) (SETQ |bfVar#6| (CDR |bfVar#6|)))) |a|)))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 3b791460..e330c5bd 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -52,19 +52,15 @@ (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| + (SETQ |bfVar#3| + #0=(CONS (CADR |d|) + NIL)))) (T - (COND - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - (SETQ |bfVar#3| - #0=(LIST - (CADR |d|))))) - (T - (PROGN - (RPLACD |bfVar#3| - #0#) - (SETQ |bfVar#3| - (CDR |bfVar#3|))))))) + (RPLACD |bfVar#3| #0#) + (SETQ |bfVar#3| + (CDR |bfVar#3|)))) (SETQ |bfVar#1| (CDR |bfVar#1|)))))) (LET @@ -81,21 +77,16 @@ (CAR |bfVar#4|)) NIL)) (RETURN |bfVar#5|)) - (T - (COND - ((NULL |bfVar#5|) - (SETQ |bfVar#5| - (SETQ |bfVar#6| - #1=(LIST - (LIST 'EVAL - (LIST 'QUOTE - |d|)))))) - (T - (PROGN - (RPLACD |bfVar#6| - #1#) - (SETQ |bfVar#6| - (CDR |bfVar#6|))))))) + ((NULL |bfVar#5|) + (SETQ |bfVar#5| + (SETQ |bfVar#6| + #1=(CONS + (LIST 'EVAL + (LIST 'QUOTE |d|)) + NIL)))) + (T (RPLACD |bfVar#6| #1#) + (SETQ |bfVar#6| + (CDR |bfVar#6|)))) (SETQ |bfVar#4| (CDR |bfVar#4|))))))))) (REALLYPRETTYPRINT |init| |stream|)))) @@ -358,7 +349,7 @@ (LOOP (COND ((|bStreamNull| |s|) (RETURN NIL)) - (T (PROGN (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|))))))) + (T (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|)))))) (DECLAIM (FTYPE (FUNCTION (|%Ast|) |%Thing|) |shoeCompile|)) @@ -482,13 +473,12 @@ (LOOP (COND ((|bStreamNull| |s|) (RETURN NIL)) - (T (PROGN - (SETQ |a| (CAR |s|)) - (COND - ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE)) - (|shoeFileLine| (CADR |a|) |st|)) - (T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|))) - (SETQ |s| (CDR |s|))))))))) + (T (SETQ |a| (CAR |s|)) + (COND + ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE)) + (|shoeFileLine| (CADR |a|) |st|)) + (T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|))) + (SETQ |s| (CDR |s|)))))))) (DEFUN |shoePPtoFile| (|x| |stream|) (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|)) @@ -499,12 +489,10 @@ (LOOP (COND ((|bStreamPackageNull| |s|) (RETURN NIL)) - (T (PROGN - (SETQ |fn| - (|stripm| (CAR |s|) *PACKAGE* - (FIND-PACKAGE "BOOTTRAN"))) - (REALLYPRETTYPRINT |fn|) - (SETQ |s| (CDR |s|))))))))) + (T (SETQ |fn| + (|stripm| (CAR |s|) *PACKAGE* + (FIND-PACKAGE "BOOTTRAN"))) + (REALLYPRETTYPRINT |fn|) (SETQ |s| (CDR |s|)))))))) (DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|))) @@ -589,9 +577,8 @@ ((OR (ATOM |bfVar#11|) (PROGN (SETQ |t| (CAR |bfVar#11|)) NIL)) (RETURN NIL)) - (T (COND - ((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE)) - (IDENTITY (RPLACA |t| 'DECLAIM)))))) + ((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE)) + (IDENTITY (RPLACA |t| 'DECLAIM)))) (SETQ |bfVar#11| (CDR |bfVar#11|)))) (SETQ |expr'| (COND @@ -643,20 +630,17 @@ (CAR |bfVar#12|)) NIL)) (RETURN |bfVar#13|)) - (T - (COND - ((NULL |bfVar#13|) - (SETQ |bfVar#13| - (SETQ |bfVar#14| - #0=(LIST - (CAR - (|translateToplevel| - |d| T)))))) - (T - (PROGN - (RPLACD |bfVar#14| #0#) - (SETQ |bfVar#14| - (CDR |bfVar#14|))))))) + ((NULL |bfVar#13|) + (SETQ |bfVar#13| + (SETQ |bfVar#14| + #0=(CONS + (CAR + (|translateToplevel| + |d| T)) + NIL)))) + (T (RPLACD |bfVar#14| #0#) + (SETQ |bfVar#14| + (CDR |bfVar#14|)))) (SETQ |bfVar#12| (CDR |bfVar#12|))))))))) (|%Import| @@ -735,14 +719,13 @@ (SETQ |alt| (CAR |bfVar#15|)) NIL)) (RETURN |bfVar#16|)) - (T (COND - ((NULL |bfVar#16|) - (SETQ |bfVar#16| - (SETQ |bfVar#17| - #1=(LIST (|bfCreateDef| |alt|))))) - (T (PROGN - (RPLACD |bfVar#17| #1#) - (SETQ |bfVar#17| (CDR |bfVar#17|))))))) + ((NULL |bfVar#16|) + (SETQ |bfVar#16| + (SETQ |bfVar#17| + #1=(CONS (|bfCreateDef| |alt|) + NIL)))) + (T (RPLACD |bfVar#17| #1#) + (SETQ |bfVar#17| (CDR |bfVar#17|)))) (SETQ |bfVar#15| (CDR |bfVar#15|)))))) (|%Namespace| (LET ((|n| (CADR |b|))) @@ -826,10 +809,10 @@ (COND ((NULL |bfVar#19|) (SETQ |bfVar#19| - (SETQ |bfVar#20| #0=(LIST |i|)))) - (T (PROGN - (RPLACD |bfVar#20| #0#) - (SETQ |bfVar#20| (CDR |bfVar#20|)))))))) + (SETQ |bfVar#20| + #0=(CONS |i| NIL)))) + (T (RPLACD |bfVar#20| #0#) + (SETQ |bfVar#20| (CDR |bfVar#20|))))))) (SETQ |bfVar#18| (CDR |bfVar#18|))))) (|bootOut| (SSORT |a|) |stream|) (|shoeFileLine| " " |stream|) @@ -849,10 +832,10 @@ (COND ((NULL |bfVar#22|) (SETQ |bfVar#22| - (SETQ |bfVar#23| #1=(LIST |i|)))) - (T (PROGN - (RPLACD |bfVar#23| #1#) - (SETQ |bfVar#23| (CDR |bfVar#23|)))))))) + (SETQ |bfVar#23| + #1=(CONS |i| NIL)))) + (T (RPLACD |bfVar#23| #1#) + (SETQ |bfVar#23| (CDR |bfVar#23|))))))) (SETQ |bfVar#21| (CDR |bfVar#21|))))) (LET ((|bfVar#24| (SSORT |a|)) (|i| NIL)) (LOOP @@ -860,17 +843,16 @@ ((OR (ATOM |bfVar#24|) (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL)) (RETURN NIL)) - (T (PROGN - (SETQ |b| (CONCAT (PNAME |i|) " is used in ")) - (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) - |stream| |b|)))) + (T (SETQ |b| (CONCAT (PNAME |i|) " is used in ")) + (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) + |stream| |b|))) (SETQ |bfVar#24| (CDR |bfVar#24|)))))))) (DEFUN |shoeDefUse| (|s|) (LOOP (COND ((|bStreamPackageNull| |s|) (RETURN NIL)) - (T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|))))))) + (T (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))) (DEFUN |defuse| (|e| |x|) (PROG (|niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id| |ISTMP#4| @@ -1120,10 +1102,9 @@ ((OR (ATOM |bfVar#29|) (PROGN (SETQ |i| (CAR |bfVar#29|)) NIL)) (RETURN NIL)) - (T (PROGN - (SETQ |a| (CONCAT (PNAME |i|) " is used in ")) - (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) - |stream| |a|)))) + (T (SETQ |a| (CONCAT (PNAME |i|) " is used in ")) + (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) + |stream| |a|))) (SETQ |bfVar#29| (CDR |bfVar#29|)))))))) (DEFUN |shoeItem| (|str|) @@ -1141,14 +1122,12 @@ (SETQ |line| (CAR |bfVar#30|)) NIL)) (RETURN |bfVar#31|)) - (T (COND - ((NULL |bfVar#31|) - (SETQ |bfVar#31| - (SETQ |bfVar#32| - #0=(LIST (CAR |line|))))) - (T (PROGN - (RPLACD |bfVar#32| #0#) - (SETQ |bfVar#32| (CDR |bfVar#32|))))))) + ((NULL |bfVar#31|) + (SETQ |bfVar#31| + (SETQ |bfVar#32| + #0=(CONS (CAR |line|) NIL)))) + (T (RPLACD |bfVar#32| #0#) + (SETQ |bfVar#32| (CDR |bfVar#32|)))) (SETQ |bfVar#30| (CDR |bfVar#30|))))) (CDR |str|)))))) @@ -1189,9 +1168,8 @@ (LOOP (COND ((|bStreamNull| |s|) (RETURN NIL)) - (T (PROGN - (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|))) - (SETQ |s| (CDR |s|))))))) + (T (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|))) + (SETQ |s| (CDR |s|)))))) (DEFUN |bStreamPackageNull| (|s|) (PROG (|b| |a|) |