aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-02-04 01:16:51 +0000
committerdos-reis <gdr@axiomatics.org>2008-02-04 01:16:51 +0000
commitd5088a15f1073ad01d8be9de9d4b6242dd5ed426 (patch)
treedafb8c5e145b623eb60ed1a3b2f424bb7861dfbf /src/boot/strap
parentcc79332bf2ba63c453df4a9f71870a7adf4fa4a3 (diff)
downloadopen-axiom-d5088a15f1073ad01d8be9de9d4b6242dd5ed426.tar.gz
* boot/translator.boot (translateToplevelExpression): New.
(bpOutItem): Use it. * boot/ast.boot (needsPROG): New. (shoeCompTran): Use it. Tidy. (bfMain): Define cache variables before functions manipulating them. * boot/strap/: Update cached Lisp translations. * interp/g-timer.boot: Use assignment instead of SETANDFILEQ at toplevel. * interp/i-syscmd.boot: Likewise. * interp/pf2atree.boot: Likewise. * interp/trace.boot: Likewise.
Diffstat (limited to 'src/boot/strap')
-rw-r--r--src/boot/strap/ast.clisp681
-rw-r--r--src/boot/strap/includer.clisp227
-rw-r--r--src/boot/strap/parser.clisp1220
-rw-r--r--src/boot/strap/pile.clisp28
-rw-r--r--src/boot/strap/scanner.clisp142
-rw-r--r--src/boot/strap/tokens.clisp354
-rw-r--r--src/boot/strap/translator.clisp426
7 files changed, 1330 insertions, 1748 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 3fc9fc07..04661e11 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -132,55 +132,53 @@
(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfGenSymbol|))
(DEFUN |bfGenSymbol| ()
- (PROG ()
- (DECLARE (SPECIAL |$GenVarCounter|))
- (RETURN
- (PROGN
- (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1))
- (INTERN (CONCAT "bfVar#" (STRINGIMAGE |$GenVarCounter|)))))))
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (PROGN
+ (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1))
+ (INTERN (CONCAT "bfVar#" (STRINGIMAGE |$GenVarCounter|)))))
(DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfListOf|))
-(DEFUN |bfListOf| (|x|) (PROG () (RETURN |x|)))
+(DEFUN |bfListOf| (|x|) |x|)
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfColon|))
-(DEFUN |bfColon| (|x|) (PROG () (RETURN (LIST 'COLON |x|))))
+(DEFUN |bfColon| (|x|) (LIST 'COLON |x|))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Symbol|) |%Symbol|)
|bfColonColon|))
(DEFUN |bfColonColon| (|package| |name|)
- (PROG () (RETURN (INTERN (SYMBOL-NAME |name|) |package|))))
+ (INTERN (SYMBOL-NAME |name|) |package|))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|))
(DEFUN |bfSymbol| (|x|)
- (PROG () (RETURN (COND ((STRINGP |x|) |x|) ('T (LIST 'QUOTE |x|))))))
+ (COND ((STRINGP |x|) |x|) ('T (LIST 'QUOTE |x|))))
(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfDot|))
-(DEFUN |bfDot| () (PROG () (RETURN 'DOT)))
+(DEFUN |bfDot| () 'DOT)
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfSuffixDot|))
-(DEFUN |bfSuffixDot| (|x|) (PROG () (RETURN (LIST |x| 'DOT))))
+(DEFUN |bfSuffixDot| (|x|) (LIST |x| 'DOT))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfEqual|))
-(DEFUN |bfEqual| (|name|) (PROG () (RETURN (LIST 'EQUAL |name|))))
+(DEFUN |bfEqual| (|name|) (LIST 'EQUAL |name|))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfBracket|))
-(DEFUN |bfBracket| (|part|) (PROG () (RETURN |part|)))
+(DEFUN |bfBracket| (|part|) |part|)
(DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfPile|))
-(DEFUN |bfPile| (|part|) (PROG () (RETURN |part|)))
+(DEFUN |bfPile| (|part|) |part|)
(DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfAppend|))
-(DEFUN |bfAppend| (|x|) (PROG () (RETURN (APPLY #'APPEND |x|))))
+(DEFUN |bfAppend| (|x|) (APPLY #'APPEND |x|))
(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing|) |%List|) |bfColonAppend|))
@@ -200,13 +198,13 @@
|bfDefinition|))
(DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|)
- (PROG () (RETURN (LIST 'DEF |bflhsitems| |bfrhs| |body|))))
+ (LIST 'DEF |bflhsitems| |bfrhs| |body|))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|)
|bfMDefinition|))
(DEFUN |bfMDefinition| (|bflhsitems| |bfrhs| |body|)
- (PROG () (RETURN (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|))))
+ (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCompDef|))
@@ -244,31 +242,26 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|))
-(DEFUN |bfBeginsDollar| (|x|)
- (PROG () (RETURN (EQL (ELT "$" 0) (ELT (PNAME |x|) 0)))))
+(DEFUN |bfBeginsDollar| (|x|) (EQL (ELT "$" 0) (ELT (PNAME |x|) 0)))
-(DEFUN |compFluid| (|id|) (PROG () (RETURN (LIST 'FLUID |id|))))
+(DEFUN |compFluid| (|id|) (LIST 'FLUID |id|))
(DEFUN |compFluidize| (|x|)
- (PROG ()
- (RETURN
- (COND
- ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
- ((ATOM |x|) |x|)
- ((EQCAR |x| 'QUOTE) |x|)
- ('T
- (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))))
+ (COND
+ ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
+ ((ATOM |x|) |x|)
+ ((EQCAR |x| 'QUOTE) |x|)
+ ('T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
-(DEFUN |bfTuple| (|x|) (PROG () (RETURN (CONS 'TUPLE |x|))))
+(DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|))
-(DEFUN |bfTupleP| (|x|) (PROG () (RETURN (EQCAR |x| 'TUPLE))))
+(DEFUN |bfTupleP| (|x|) (EQCAR |x| 'TUPLE))
(DEFUN |bfUntuple| (|bf|)
- (PROG () (RETURN (COND ((|bfTupleP| |bf|) (CDR |bf|)) ('T |bf|)))))
+ (COND ((|bfTupleP| |bf|) (CDR |bf|)) ('T |bf|)))
(DEFUN |bfTupleIf| (|x|)
- (PROG ()
- (RETURN (COND ((|bfTupleP| |x|) |x|) ('T (|bfTuple| |x|))))))
+ (COND ((|bfTupleP| |x|) |x|) ('T (|bfTuple| |x|))))
(DEFUN |bfTupleConstruct| (|b|)
(PROG (|ISTMP#1| |a|)
@@ -322,13 +315,10 @@
(#1# (LIST 'CONS (CAR |l|) (|bfMakeCons| (CDR |l|))))))))
(DEFUN |bfFor| (|bflhs| U |step|)
- (PROG ()
- (RETURN
- (COND
- ((EQCAR U '|tails|) (|bfForTree| 'ON |bflhs| (CADR U)))
- ((EQCAR U 'SEGMENT)
- (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U)))
- ('T (|bfForTree| 'IN |bflhs| U))))))
+ (COND
+ ((EQCAR U '|tails|) (|bfForTree| 'ON |bflhs| (CADR U)))
+ ((EQCAR U 'SEGMENT) (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U)))
+ ('T (|bfForTree| 'IN |bflhs| U))))
(DEFUN |bfForTree| (OP |lhs| |whole|)
(PROG (G)
@@ -416,18 +406,15 @@
NIL))))))
(DEFUN |bfON| (|x| E)
- (PROG ()
- (RETURN
- (LIST (LIST (LIST |x|) (LIST E)
- (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL
- (LIST (LIST 'ATOM |x|)) NIL)))))
+ (LIST (LIST (LIST |x|) (LIST E)
+ (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL
+ (LIST (LIST 'ATOM |x|)) NIL)))
(DEFUN |bfSuchthat| (|p|)
- (PROG () (RETURN (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL)))))
+ (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL)))
(DEFUN |bfWhile| (|p|)
- (PROG ()
- (RETURN (LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL)))))
+ (LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL)))
(DEFUN |bfUntil| (|p|)
(PROG (|g|)
@@ -437,23 +424,19 @@
(LIST (LIST (LIST |g|) (LIST NIL) (LIST (LIST 'SETQ |g| |p|))
NIL (LIST |g|) NIL))))))
-(DEFUN |bfIterators| (|x|) (PROG () (RETURN (CONS 'ITERATORS |x|))))
+(DEFUN |bfIterators| (|x|) (CONS 'ITERATORS |x|))
-(DEFUN |bfCross| (|x|) (PROG () (RETURN (CONS 'CROSS |x|))))
+(DEFUN |bfCross| (|x|) (CONS 'CROSS |x|))
(DEFUN |bfLp| (|iters| |body|)
- (PROG ()
- (RETURN
- (COND
- ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|))
- ('T (|bfLpCross| (CDR |iters|) |body|))))))
+ (COND
+ ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|))
+ ('T (|bfLpCross| (CDR |iters|) |body|))))
(DEFUN |bfLpCross| (|iters| |body|)
- (PROG ()
- (RETURN
- (COND
- ((NULL (CDR |iters|)) (|bfLp| (CAR |iters|) |body|))
- ('T (|bfLp| (CAR |iters|) (|bfLpCross| (CDR |iters|) |body|)))))))
+ (COND
+ ((NULL (CDR |iters|)) (|bfLp| (CAR |iters|) |body|))
+ ('T (|bfLp| (CAR |iters|) (|bfLpCross| (CDR |iters|) |body|)))))
(DEFUN |bfSep| (|iters|)
(PROG (|r| |f|)
@@ -518,10 +501,9 @@
(#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1)))
(|bfReduce| |op| |a|))))))
-(DEFUN |bfDCollect| (|y| |itl|)
- (PROG () (RETURN (LIST 'COLLECT |y| |itl|))))
+(DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|))
-(DEFUN |bfDTuple| (|x|) (PROG () (RETURN (LIST 'DTUPLE |x|))))
+(DEFUN |bfDTuple| (|x|) (LIST 'DTUPLE |x|))
(DEFUN |bfCollect| (|y| |itl|)
(PROG (|newBody| |a| |ISTMP#1|)
@@ -539,8 +521,7 @@
(|bf0APPEND| |newBody| |itl|)))
('T (|bf0COLLECT| |y| |itl|))))))
-(DEFUN |bf0COLLECT| (|y| |itl|)
- (PROG () (RETURN (|bfListReduce| 'CONS |y| |itl|))))
+(DEFUN |bf0COLLECT| (|y| |itl|) (|bfListReduce| 'CONS |y| |itl|))
(DEFUN |bf0APPEND| (|y| |itl|)
(PROG (|extrait| |body| |g|)
@@ -659,56 +640,44 @@
(LIST |g|))))
(|bfLp2| |extrait| |itl| |body|)))))))
-(DEFUN |bfLoop1| (|body|)
- (PROG () (RETURN (|bfLp| (|bfIterators| NIL) |body|))))
+(DEFUN |bfLoop1| (|body|) (|bfLp| (|bfIterators| NIL) |body|))
-(DEFUN |bfSegment1| (|lo|)
- (PROG () (RETURN (LIST 'SEGMENT |lo| NIL))))
+(DEFUN |bfSegment1| (|lo|) (LIST 'SEGMENT |lo| NIL))
-(DEFUN |bfSegment2| (|lo| |hi|)
- (PROG () (RETURN (LIST 'SEGMENT |lo| |hi|))))
+(DEFUN |bfSegment2| (|lo| |hi|) (LIST 'SEGMENT |lo| |hi|))
(DEFUN |bfForInBy| (|variable| |collection| |step|)
- (PROG () (RETURN (|bfFor| |variable| |collection| |step|))))
+ (|bfFor| |variable| |collection| |step|))
-(DEFUN |bfForin| (|lhs| U) (PROG () (RETURN (|bfFor| |lhs| U 1))))
+(DEFUN |bfForin| (|lhs| U) (|bfFor| |lhs| U 1))
(DEFUN |bfLocal| (|a| |b|)
- (PROG ()
- (RETURN
- (COND
- ((EQ |b| 'FLUID) (|compFluid| |a|))
- ((EQ |b| '|fluid|) (|compFluid| |a|))
- ((EQ |b| '|local|) (|compFluid| |a|))
- ('T |a|)))))
+ (COND
+ ((EQ |b| 'FLUID) (|compFluid| |a|))
+ ((EQ |b| '|fluid|) (|compFluid| |a|))
+ ((EQ |b| '|local|) (|compFluid| |a|))
+ ('T |a|)))
(DEFUN |bfTake| (|n| |x|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |x|) |x|)
- ((EQL |n| 0) NIL)
- ('T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|))))))))
+ (COND
+ ((NULL |x|) |x|)
+ ((EQL |n| 0) NIL)
+ ('T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|))))))
(DEFUN |bfDrop| (|n| |x|)
- (PROG ()
- (RETURN
- (COND
- ((OR (NULL |x|) (EQL |n| 0)) |x|)
- ('T (|bfDrop| (- |n| 1) (CDR |x|)))))))
+ (COND
+ ((OR (NULL |x|) (EQL |n| 0)) |x|)
+ ('T (|bfDrop| (- |n| 1) (CDR |x|)))))
-(DEFUN |bfDefSequence| (|l|) (PROG () (RETURN (CONS 'SEQ |l|))))
+(DEFUN |bfDefSequence| (|l|) (CONS 'SEQ |l|))
-(DEFUN |bfReturnNoName| (|a|) (PROG () (RETURN (LIST 'RETURN |a|))))
+(DEFUN |bfReturnNoName| (|a|) (LIST 'RETURN |a|))
(DEFUN |bfSUBLIS| (|p| |e|)
- (PROG ()
- (RETURN
- (COND
- ((ATOM |e|) (|bfSUBLIS1| |p| |e|))
- ((EQCAR |e| 'QUOTE) |e|)
- ('T
- (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|))))))))
+ (COND
+ ((ATOM |e|) (|bfSUBLIS1| |p| |e|))
+ ((EQCAR |e| 'QUOTE) |e|)
+ ('T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|))))))
(DEFUN |bfSUBLIS1| (|p| |e|)
(PROG (|f|)
@@ -766,8 +735,7 @@
(LIST (APPEND |opassoc| |opassoc1|) (APPEND |defs| |defs1|)
(APPEND |nondefs| |nondefs1|)))))))
-(DEFUN |bfLetForm| (|lhs| |rhs|)
- (PROG () (RETURN (LIST 'L%T |lhs| |rhs|))))
+(DEFUN |bfLetForm| (|lhs| |rhs|) (LIST 'L%T |lhs| |rhs|))
(DEFUN |bfLET1| (|lhs| |rhs|)
(PROG (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|)
@@ -825,14 +793,11 @@
(CONS |rhs1| (APPEND |let1| (CONS |g| NIL)))))))))))))
(DEFUN |bfCONTAINED| (|x| |y|)
- (PROG ()
- (RETURN
- (COND
- ((EQ |x| |y|) T)
- ((ATOM |y|) NIL)
- ('T
- (OR (|bfCONTAINED| |x| (CAR |y|))
- (|bfCONTAINED| |x| (CDR |y|))))))))
+ (COND
+ ((EQ |x| |y|) T)
+ ((ATOM |y|) NIL)
+ ('T
+ (OR (|bfCONTAINED| |x| (CAR |y|)) (|bfCONTAINED| |x| (CDR |y|))))))
(DEFUN |bfLET2| (|lhs| |rhs|)
(PROG (|isPred| |val1| |ISTMP#3| |g| |rev| |patrev| |l2| |l1| |var2|
@@ -996,23 +961,19 @@
(CONS (ELT |funsA| |p|) (CDR |expr|)))
('T (CONS (ELT |funsR| |p|) (CDR |expr|)))))))))))))
-(DEFUN |bfPosition| (|x| |l|) (PROG () (RETURN (|bfPosn| |x| |l| 0))))
+(DEFUN |bfPosition| (|x| |l|) (|bfPosn| |x| |l| 0))
(DEFUN |bfPosn| (|x| |l| |n|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |l|) (- 1))
- ((EQUAL |x| (CAR |l|)) |n|)
- ('T (|bfPosn| |x| (CDR |l|) (+ |n| 1)))))))
+ (COND
+ ((NULL |l|) (- 1))
+ ((EQUAL |x| (CAR |l|)) |n|)
+ ('T (|bfPosn| |x| (CDR |l|) (+ |n| 1)))))
(DEFUN |bfISApplication| (|op| |left| |right|)
- (PROG ()
- (RETURN
- (COND
- ((EQ |op| 'IS) (|bfIS| |left| |right|))
- ((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |left| |right|)))
- ('T (LIST |op| |left| |right|))))))
+ (COND
+ ((EQ |op| 'IS) (|bfIS| |left| |right|))
+ ((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |left| |right|)))
+ ('T (LIST |op| |left| |right|))))
(DEFUN |bfIS| (|left| |right|)
(PROG (|$inDefIS| |$isGenVarCounter|)
@@ -1172,18 +1133,16 @@
(|bpTrap|)))))))
(DEFUN |bfApplication| (|bfop| |bfarg|)
- (PROG ()
- (RETURN
- (COND
- ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
- ('T (CONS |bfop| (LIST |bfarg|)))))))
+ (COND
+ ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
+ ('T (CONS |bfop| (LIST |bfarg|)))))
(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 |bfSameMeaning| (|x|) (GET |x| 'RENAME-OK))
(DEFUN |bfReName| (|x|)
(PROG (|oldName| |newName| |a|)
@@ -1207,18 +1166,16 @@
(#0# |newName|))))))
(DEFUN |bfInfApplication| (|op| |left| |right|)
- (PROG ()
- (RETURN
- (COND
- ((EQ |op| 'EQUAL) (|bfQ| |left| |right|))
- ((EQ |op| '/=) (|bfNOT| (|bfQ| |left| |right|)))
- ((EQ |op| '>) (|bfLessp| |right| |left|))
- ((EQ |op| '<) (|bfLessp| |left| |right|))
- ((EQ |op| '<=) (|bfNOT| (|bfLessp| |right| |left|)))
- ((EQ |op| '>=) (|bfNOT| (|bfLessp| |left| |right|)))
- ((EQ |op| 'OR) (|bfOR| (LIST |left| |right|)))
- ((EQ |op| 'AND) (|bfAND| (LIST |left| |right|)))
- ('T (LIST |op| |left| |right|))))))
+ (COND
+ ((EQ |op| 'EQUAL) (|bfQ| |left| |right|))
+ ((EQ |op| '/=) (|bfNOT| (|bfQ| |left| |right|)))
+ ((EQ |op| '>) (|bfLessp| |right| |left|))
+ ((EQ |op| '<) (|bfLessp| |left| |right|))
+ ((EQ |op| '<=) (|bfNOT| (|bfLessp| |right| |left|)))
+ ((EQ |op| '>=) (|bfNOT| (|bfLessp| |left| |right|)))
+ ((EQ |op| 'OR) (|bfOR| (LIST |left| |right|)))
+ ((EQ |op| 'AND) (|bfAND| (LIST |left| |right|)))
+ ('T (LIST |op| |left| |right|))))
(DEFUN |bfNOT| (|x|)
(PROG (|a| |ISTMP#1|)
@@ -1239,73 +1196,60 @@
('T (LIST 'NOT |x|))))))
(DEFUN |bfFlatten| (|op| |x|)
- (PROG ()
- (RETURN (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|))))))
+ (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|))))
(DEFUN |bfOR| (|l|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |l|) NIL)
- ((NULL (CDR |l|)) (CAR |l|))
- ('T
- (CONS 'OR
- (LET ((|bfVar#83| NIL) (|bfVar#82| |l|) (|c| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#82|)
- (PROGN (SETQ |c| (CAR |bfVar#82|)) NIL))
- (RETURN (NREVERSE |bfVar#83|)))
- ('T
- (SETQ |bfVar#83|
- (APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#83|))))
- (SETQ |bfVar#82| (CDR |bfVar#82|))))))))))
+ (COND
+ ((NULL |l|) NIL)
+ ((NULL (CDR |l|)) (CAR |l|))
+ ('T
+ (CONS 'OR
+ (LET ((|bfVar#83| NIL) (|bfVar#82| |l|) (|c| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#82|)
+ (PROGN (SETQ |c| (CAR |bfVar#82|)) NIL))
+ (RETURN (NREVERSE |bfVar#83|)))
+ ('T
+ (SETQ |bfVar#83|
+ (APPEND (REVERSE (|bfFlatten| 'OR |c|))
+ |bfVar#83|))))
+ (SETQ |bfVar#82| (CDR |bfVar#82|))))))))
(DEFUN |bfAND| (|l|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |l|) 'T)
- ((NULL (CDR |l|)) (CAR |l|))
- ('T
- (CONS 'AND
- (LET ((|bfVar#85| NIL) (|bfVar#84| |l|) (|c| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#84|)
- (PROGN (SETQ |c| (CAR |bfVar#84|)) NIL))
- (RETURN (NREVERSE |bfVar#85|)))
- ('T
- (SETQ |bfVar#85|
- (APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#85|))))
- (SETQ |bfVar#84| (CDR |bfVar#84|))))))))))
+ (COND
+ ((NULL |l|) 'T)
+ ((NULL (CDR |l|)) (CAR |l|))
+ ('T
+ (CONS 'AND
+ (LET ((|bfVar#85| NIL) (|bfVar#84| |l|) (|c| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#84|)
+ (PROGN (SETQ |c| (CAR |bfVar#84|)) NIL))
+ (RETURN (NREVERSE |bfVar#85|)))
+ ('T
+ (SETQ |bfVar#85|
+ (APPEND (REVERSE (|bfFlatten| 'AND |c|))
+ |bfVar#85|))))
+ (SETQ |bfVar#84| (CDR |bfVar#84|))))))))
(DEFUN |defQuoteId| (|x|)
- (PROG () (RETURN (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))))
+ (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))
(DEFUN |bfSmintable| (|x|)
- (PROG ()
- (RETURN
- (OR (INTEGERP |x|)
- (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH)))))))
+ (OR (INTEGERP |x|) (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH)))))
(DEFUN |bfQ| (|l| |r|)
- (PROG ()
- (RETURN
- (COND
- ((OR (|bfSmintable| |l|) (|bfSmintable| |r|))
- (LIST 'EQL |l| |r|))
- ((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|))
- ((NULL |l|) (LIST 'NULL |r|))
- ((NULL |r|) (LIST 'NULL |l|))
- ('T (LIST 'EQUAL |l| |r|))))))
+ (COND
+ ((OR (|bfSmintable| |l|) (|bfSmintable| |r|)) (LIST 'EQL |l| |r|))
+ ((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|))
+ ((NULL |l|) (LIST 'NULL |r|))
+ ((NULL |r|) (LIST 'NULL |l|))
+ ('T (LIST 'EQUAL |l| |r|))))
(DEFUN |bfLessp| (|l| |r|)
- (PROG ()
- (RETURN
- (COND ((EQL |r| 0) (LIST 'MINUSP |l|)) ('T (LIST '< |l| |r|))))))
+ (COND ((EQL |r| 0) (LIST 'MINUSP |l|)) ('T (LIST '< |l| |r|))))
(DEFUN |bfMDef| (|defOp| |op| |args| |body|)
(PROG (|def| |lamex| |sb2| |sb| |largl| |nargl| |sgargl| |gargl|
@@ -1460,16 +1404,14 @@
(SETQ |bfVar#95| (CDR |bfVar#95|))))))))))
(DEFUN |shoeComps| (|x|)
- (PROG ()
- (RETURN
- (LET ((|bfVar#98| NIL) (|bfVar#97| |x|) (|def| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#97|)
- (PROGN (SETQ |def| (CAR |bfVar#97|)) NIL))
- (RETURN (NREVERSE |bfVar#98|)))
- ('T (SETQ |bfVar#98| (CONS (|shoeComp| |def|) |bfVar#98|))))
- (SETQ |bfVar#97| (CDR |bfVar#97|)))))))
+ (LET ((|bfVar#98| NIL) (|bfVar#97| |x|) (|def| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#97|)
+ (PROGN (SETQ |def| (CAR |bfVar#97|)) NIL))
+ (RETURN (NREVERSE |bfVar#98|)))
+ ('T (SETQ |bfVar#98| (CONS (|shoeComp| |def|) |bfVar#98|))))
+ (SETQ |bfVar#97| (CDR |bfVar#97|)))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -1545,7 +1487,7 @@
(DEFUN |shoeCompTran| (|x|)
(PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars|
- |lvars| |body| |args| |lamtype|)
+ |body'| |lvars| |body| |args| |lamtype|)
(DECLARE (SPECIAL |$typings| |$dollarVars| |$fluidVars| |$locVars|))
(RETURN
(PROGN
@@ -1560,37 +1502,58 @@
(SETDIFFERENCE (SETDIFFERENCE |$locVars| |$fluidVars|)
(|shoeATOMs| |args|)))
(SETQ |body|
- (COND
- ((OR |$fluidVars| |$locVars| |$dollarVars| |$typings|)
- (SETQ |lvars| (APPEND |$fluidVars| |$locVars|))
- (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|))
- (COND
- ((NULL |$fluidVars|)
- (COND
- ((NULL |$typings|) (|shoePROG| |lvars| |body|))
- (#0='T
- (|shoePROG| |lvars|
- (CONS (CONS 'DECLARE |$typings|) |body|)))))
- (#1='T
- (SETQ |fvars|
- (LIST 'DECLARE (CONS 'SPECIAL |$fluidVars|)))
- (COND
- ((NULL |$typings|)
- (|shoePROG| |lvars| (CONS |fvars| |body|)))
- (#0#
- (|shoePROG| |lvars|
- (CONS |fvars|
- (CONS (CONS 'DECLARE |$typings|)
- |body|))))))))
- (#1# (|shoePROG| NIL |body|))))
+ (PROGN
+ (SETQ |lvars| (APPEND |$fluidVars| |$locVars|))
+ (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|))
+ (SETQ |body'| |body|)
+ (COND
+ (|$typings|
+ (SETQ |body'|
+ (CONS (CONS 'DECLARE |$typings|) |body'|))))
+ (COND
+ (|$fluidVars|
+ (SETQ |fvars|
+ (LIST 'DECLARE
+ (CONS 'SPECIAL |$fluidVars|)))
+ (SETQ |body'| (CONS |fvars| |body'|))))
+ (COND
+ ((OR |lvars| (|needsPROG| |body|))
+ (|shoePROG| |lvars| |body'|))
+ (#0='T |body'|))))
(SETQ |fl| (|shoeFluids| |args|))
(SETQ |body|
(COND
(|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|)))
(CONS |fvs| |body|))
- (#1# |body|)))
+ (#0# |body|)))
(CONS |lamtype| (CONS |args| |body|))))))
+(DEFUN |needsPROG| (|body|)
+ (PROG (|args| |op|)
+ (RETURN
+ (COND
+ ((ATOM |body|) NIL)
+ (#0='T
+ (PROGN
+ (SETQ |op| (CAR |body|))
+ (SETQ |args| (CDR |body|))
+ (COND
+ ((MEMBER |op| '(RETURN RETURN-FROM)) T)
+ ((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
+ ((LET ((|bfVar#100| NIL) (|bfVar#99| |body|) (|t| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#99|)
+ (PROGN (SETQ |t| (CAR |bfVar#99|)) NIL))
+ (RETURN |bfVar#100|))
+ ('T
+ (PROGN
+ (SETQ |bfVar#100| (|needsPROG| |t|))
+ (COND (|bfVar#100| (RETURN |bfVar#100|))))))
+ (SETQ |bfVar#99| (CDR |bfVar#99|))))
+ T)
+ (#0# NIL))))))))
+
(DEFUN |shoePROG| (|v| |b|)
(PROG (|blist| |blast| |LETTMP#1|)
(RETURN
@@ -1607,22 +1570,18 @@
(CONS (LIST 'RETURN |blast|) NIL)))))))))))
(DEFUN |shoeFluids| (|x|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |x|) NIL)
- ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
- ((EQCAR |x| 'QUOTE) NIL)
- ((ATOM |x|) NIL)
- ('T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|))))))))
+ (COND
+ ((NULL |x|) NIL)
+ ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
+ ((EQCAR |x| 'QUOTE) NIL)
+ ((ATOM |x|) NIL)
+ ('T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|))))))
(DEFUN |shoeATOMs| (|x|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |x|) NIL)
- ((ATOM |x|) (LIST |x|))
- ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|))))))))
+ (COND
+ ((NULL |x|) NIL)
+ ((ATOM |x|) (LIST |x|))
+ ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|))))))
(DEFUN |shoeCompTran1| (|x|)
(PROG (|res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U)
@@ -1679,11 +1638,11 @@
((MEMQ U '(PROG LAMBDA))
(PROGN
(SETQ |newbindings| NIL)
- (LET ((|bfVar#99| (CADR |x|)) (|y| NIL))
+ (LET ((|bfVar#101| (CADR |x|)) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#99|)
- (PROGN (SETQ |y| (CAR |bfVar#99|)) NIL))
+ ((OR (ATOM |bfVar#101|)
+ (PROGN (SETQ |y| (CAR |bfVar#101|)) NIL))
(RETURN NIL))
(#1='T
(COND
@@ -1693,58 +1652,52 @@
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#99| (CDR |bfVar#99|))))
+ (SETQ |bfVar#101| (CDR |bfVar#101|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- (LET ((|bfVar#101| NIL) (|bfVar#100| |$locVars|)
+ (LET ((|bfVar#103| NIL) (|bfVar#102| |$locVars|)
(|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#100|)
+ ((OR (ATOM |bfVar#102|)
(PROGN
- (SETQ |y| (CAR |bfVar#100|))
+ (SETQ |y| (CAR |bfVar#102|))
NIL))
- (RETURN (NREVERSE |bfVar#101|)))
+ (RETURN (NREVERSE |bfVar#103|)))
(#1#
(AND (NULL (MEMQ |y| |newbindings|))
- (SETQ |bfVar#101|
- (CONS |y| |bfVar#101|)))))
- (SETQ |bfVar#100| (CDR |bfVar#100|)))))))
+ (SETQ |bfVar#103|
+ (CONS |y| |bfVar#103|)))))
+ (SETQ |bfVar#102| (CDR |bfVar#102|)))))))
(#0#
(PROGN
(|shoeCompTran1| (CAR |x|))
(|shoeCompTran1| (CDR |x|)))))))))))
(DEFUN |bfTagged| (|a| |b|)
- (PROG ()
- (DECLARE (SPECIAL |$typings| |$op|))
- (RETURN
- (COND
- ((NULL |$op|) (|Signature| |a| |b|))
- ((IDENTP |a|)
- (COND
- ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL))
- ((EQ |b| '|fluid|) (|bfLET| (|compFluid| |a|) NIL))
- ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL))
- (#0='T
- (PROGN
- (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|))
- |a|))))
- (#0# (LIST 'THE |b| |a|))))))
+ (DECLARE (SPECIAL |$typings| |$op|))
+ (COND
+ ((NULL |$op|) (|Signature| |a| |b|))
+ ((IDENTP |a|)
+ (COND
+ ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL))
+ ((EQ |b| '|fluid|) (|bfLET| (|compFluid| |a|) NIL))
+ ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL))
+ (#0='T
+ (PROGN
+ (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|))
+ |a|))))
+ (#0# (LIST 'THE |b| |a|))))
(DEFUN |bfAssign| (|l| |r|)
- (PROG ()
- (RETURN
- (COND
- ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
- ('T (|bfLET| |l| |r|))))))
+ (COND
+ ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
+ ('T (|bfLET| |l| |r|))))
(DEFUN |bfSetelt| (|e| |l| |r|)
- (PROG ()
- (RETURN
- (COND
- ((NULL (CDR |l|)) (|defSETELT| |e| (CAR |l|) |r|))
- ('T (|bfSetelt| (|bfElt| |e| (CAR |l|)) (CDR |l|) |r|))))))
+ (COND
+ ((NULL (CDR |l|)) (|defSETELT| |e| (CAR |l|) |r|))
+ ('T (|bfSetelt| (|bfElt| |e| (CAR |l|)) (CDR |l|) |r|))))
(DEFUN |bfElt| (|expr| |sel|)
(PROG (|y|)
@@ -1795,21 +1748,21 @@
(LIST 'COND (CONS |a| |b1|) (CONS ''T |c1|)))))))))
(DEFUN |bfExit| (|a| |b|)
- (PROG () (RETURN (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|))))))
+ (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|))))
(DEFUN |bfMKPROGN| (|l|)
(PROG (|a|)
(RETURN
(PROGN
(SETQ |a|
- (LET ((|bfVar#102| NIL) (|c| |l|))
+ (LET ((|bfVar#104| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#102|)))
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#104|)))
('T
- (SETQ |bfVar#102|
+ (SETQ |bfVar#104|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#102|))))
+ |bfVar#104|))))
(SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
@@ -1829,17 +1782,17 @@
((EQCAR |f| 'PROGN)
(COND
((CDR |x|)
- (LET ((|bfVar#104| NIL) (|bfVar#103| (CDR |f|))
+ (LET ((|bfVar#106| NIL) (|bfVar#105| (CDR |f|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#103|)
- (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL))
- (RETURN (NREVERSE |bfVar#104|)))
+ ((OR (ATOM |bfVar#105|)
+ (PROGN (SETQ |i| (CAR |bfVar#105|)) NIL))
+ (RETURN (NREVERSE |bfVar#106|)))
('T
(AND (NULL (ATOM |i|))
- (SETQ |bfVar#104| (CONS |i| |bfVar#104|)))))
- (SETQ |bfVar#103| (CDR |bfVar#103|)))))
+ (SETQ |bfVar#106| (CONS |i| |bfVar#106|)))))
+ (SETQ |bfVar#105| (CDR |bfVar#105|)))))
(#0# (CDR |f|))))
(#0# (LIST |f|)))))))))
@@ -1852,11 +1805,11 @@
(#0='T
(PROGN
(SETQ |transform|
- (LET ((|bfVar#106| NIL) (|bfVar#105| |l|) (|x| NIL))
+ (LET ((|bfVar#108| NIL) (|bfVar#107| |l|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#105|)
- (PROGN (SETQ |x| (CAR |bfVar#105|)) NIL)
+ ((OR (ATOM |bfVar#107|)
+ (PROGN (SETQ |x| (CAR |bfVar#107|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -1891,11 +1844,11 @@
(SETQ |b|
(CAR |ISTMP#5|))
'T))))))))))))))
- (RETURN (NREVERSE |bfVar#106|)))
+ (RETURN (NREVERSE |bfVar#108|)))
('T
- (SETQ |bfVar#106|
- (CONS (LIST |a| |b|) |bfVar#106|))))
- (SETQ |bfVar#105| (CDR |bfVar#105|)))))
+ (SETQ |bfVar#108|
+ (CONS (LIST |a| |b|) |bfVar#108|))))
+ (SETQ |bfVar#107| (CDR |bfVar#107|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -1928,12 +1881,12 @@
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- (LET ((|bfVar#108| NIL) (|bfVar#107| |defs|) (|d| NIL))
+ (LET ((|bfVar#110| NIL) (|bfVar#109| |defs|) (|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#107|)
- (PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
- (RETURN (NREVERSE |bfVar#108|)))
+ ((OR (ATOM |bfVar#109|)
+ (PROGN (SETQ |d| (CAR |bfVar#109|)) NIL))
+ (RETURN (NREVERSE |bfVar#110|)))
('T
(AND (CONSP |d|)
(PROGN
@@ -1952,17 +1905,17 @@
(PROGN
(SETQ |body| (CAR |ISTMP#3|))
'T)))))))
- (SETQ |bfVar#108|
+ (SETQ |bfVar#110|
(CONS (LIST |def| |op| |args|
(|bfSUBLIS| |opassoc| |body|))
- |bfVar#108|)))))
- (SETQ |bfVar#107| (CDR |bfVar#107|)))))
+ |bfVar#110|)))))
+ (SETQ |bfVar#109| (CDR |bfVar#109|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
(DEFUN |bfReadLisp| (|string|)
- (PROG () (RETURN (|bfTuple| (|shoeReadLispString| |string| 0)))))
+ (|bfTuple| (|shoeReadLispString| |string| 0)))
(DEFUN |bfCompHash| (|op| |argl| |body|)
(PROG (|computeFunction| |auxfn|)
@@ -1974,17 +1927,16 @@
(|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|)))))))
(DEFUN |shoeCompileTimeEvaluation| (|x|)
- (PROG () (RETURN (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|))))
+ (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|))
(DEFUN |shoeEVALANDFILEACTQ| (|x|)
- (PROG ()
- (RETURN (LIST 'EVAL-WHEN (LIST :EXECUTE :LOAD-TOPLEVEL) |x|))))
+ (LIST 'EVAL-WHEN (LIST :EXECUTE :LOAD-TOPLEVEL) |x|))
(DEFUN |bfMain| (|auxfn| |op|)
- (PROG (|cacheVector| |cacheCountCode| |cacheResetCode| |cacheType|
- |mainFunction| |codeBody| |thirdPredPair| |putCode|
- |secondPredPair| |getCode| |g2| |cacheName| |computeValue|
- |arg| |g1|)
+ (PROG (|defCode| |cacheVector| |cacheCountCode| |cacheResetCode|
+ |cacheType| |mainFunction| |codeBody| |thirdPredPair|
+ |putCode| |secondPredPair| |getCode| |g2| |cacheName|
+ |computeValue| |arg| |g1|)
(RETURN
(PROGN
(SETQ |g1| (|bfGenSymbol|))
@@ -2010,45 +1962,41 @@
(SETQ |cacheVector|
(LIST |op| |cacheName| |cacheType| |cacheResetCode|
|cacheCountCode|))
- (LIST |mainFunction|
+ (SETQ |defCode|
+ (LIST 'DEFPARAMETER |cacheName|
+ (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL))))
+ (LIST |defCode| |mainFunction|
(|shoeEVALANDFILEACTQ|
(LIST 'SETF
(LIST 'GET (LIST 'QUOTE |op|)
(LIST 'QUOTE '|cacheInfo|))
- (LIST 'QUOTE |cacheVector|)))
- (|shoeEVALANDFILEACTQ| |cacheResetCode|))))))
+ (LIST 'QUOTE |cacheVector|))))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfNameOnly|))
(DEFUN |bfNameOnly| (|x|)
- (PROG () (RETURN (COND ((EQ |x| '|t|) (LIST 'T)) ('T (LIST |x|))))))
+ (COND ((EQ |x| '|t|) (LIST 'T)) ('T (LIST |x|))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfNameArgs|))
(DEFUN |bfNameArgs| (|x| |y|)
- (PROG ()
- (RETURN
- (PROGN
- (SETQ |y|
- (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|))))
- (CONS |x| |y|)))))
+ (PROGN
+ (SETQ |y| (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|))))
+ (CONS |x| |y|)))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfStruct|))
(DEFUN |bfStruct| (|name| |arglist|)
- (PROG ()
- (RETURN
- (|bfTuple|
- (LET ((|bfVar#110| NIL) (|bfVar#109| |arglist|) (|i| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#109|)
- (PROGN (SETQ |i| (CAR |bfVar#109|)) NIL))
- (RETURN (NREVERSE |bfVar#110|)))
- ('T
- (SETQ |bfVar#110|
- (CONS (|bfCreateDef| |i|) |bfVar#110|))))
- (SETQ |bfVar#109| (CDR |bfVar#109|))))))))
+ (|bfTuple| (LET ((|bfVar#112| NIL) (|bfVar#111| |arglist|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#111|)
+ (PROGN (SETQ |i| (CAR |bfVar#111|)) NIL))
+ (RETURN (NREVERSE |bfVar#112|)))
+ ('T
+ (SETQ |bfVar#112|
+ (CONS (|bfCreateDef| |i|) |bfVar#112|))))
+ (SETQ |bfVar#111| (CDR |bfVar#111|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|))
@@ -2060,23 +2008,23 @@
(LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
('T
(SETQ |a|
- (LET ((|bfVar#112| NIL) (|bfVar#111| (CDR |x|))
+ (LET ((|bfVar#114| NIL) (|bfVar#113| (CDR |x|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#111|)
- (PROGN (SETQ |i| (CAR |bfVar#111|)) NIL))
- (RETURN (NREVERSE |bfVar#112|)))
+ ((OR (ATOM |bfVar#113|)
+ (PROGN (SETQ |i| (CAR |bfVar#113|)) NIL))
+ (RETURN (NREVERSE |bfVar#114|)))
('T
- (SETQ |bfVar#112|
- (CONS (|bfGenSymbol|) |bfVar#112|))))
- (SETQ |bfVar#111| (CDR |bfVar#111|)))))
+ (SETQ |bfVar#114|
+ (CONS (|bfGenSymbol|) |bfVar#114|))))
+ (SETQ |bfVar#113| (CDR |bfVar#113|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfCaseItem|))
-(DEFUN |bfCaseItem| (|x| |y|) (PROG () (RETURN (LIST |x| |y|))))
+(DEFUN |bfCaseItem| (|x| |y|) (LIST |x| |y|))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfCase|))
@@ -2097,22 +2045,22 @@
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- (LET ((|bfVar#115| NIL) (|bfVar#114| |x|) (|bfVar#113| NIL))
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |x|) (|bfVar#115| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#114|)
- (PROGN (SETQ |bfVar#113| (CAR |bfVar#114|)) NIL))
- (RETURN (NREVERSE |bfVar#115|)))
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |bfVar#115| (CAR |bfVar#116|)) NIL))
+ (RETURN (NREVERSE |bfVar#117|)))
('T
- (AND (CONSP |bfVar#113|)
+ (AND (CONSP |bfVar#115|)
(PROGN
- (SETQ |i| (CAR |bfVar#113|))
- (SETQ |ISTMP#1| (CDR |bfVar#113|))
+ (SETQ |i| (CAR |bfVar#115|))
+ (SETQ |ISTMP#1| (CDR |bfVar#115|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
- (SETQ |bfVar#115|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#115|)))))
- (SETQ |bfVar#114| (CDR |bfVar#114|)))))))
+ (SETQ |bfVar#117|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#117|)))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|))
@@ -2125,31 +2073,28 @@
((NULL |a|) (LIST (CAR |x|) |y|))
('T
(SETQ |b|
- (LET ((|bfVar#117| NIL) (|bfVar#116| |a|) (|i| NIL)
+ (LET ((|bfVar#119| NIL) (|bfVar#118| |a|) (|i| NIL)
(|j| 0))
(LOOP
(COND
- ((OR (ATOM |bfVar#116|)
- (PROGN (SETQ |i| (CAR |bfVar#116|)) NIL))
- (RETURN (NREVERSE |bfVar#117|)))
+ ((OR (ATOM |bfVar#118|)
+ (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL))
+ (RETURN (NREVERSE |bfVar#119|)))
('T
- (SETQ |bfVar#117|
+ (SETQ |bfVar#119|
(CONS (LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#117|))))
- (SETQ |bfVar#116| (CDR |bfVar#116|))
+ |bfVar#119|))))
+ (SETQ |bfVar#118| (CDR |bfVar#118|))
(SETQ |j| (+ |j| 1)))))
(LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Thing|) |%List|) |bfCARCDR|))
(DEFUN |bfCARCDR| (|n| |g|)
- (PROG ()
- (RETURN (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|))))
+ (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|))
(DECLAIM (FTYPE (FUNCTION (|%Short|) |%String|) |bfDs|))
(DEFUN |bfDs| (|n|)
- (PROG ()
- (RETURN
- (COND ((EQL |n| 0) "") ('T (CONCAT "D" (|bfDs| (- |n| 1))))))))
+ (COND ((EQL |n| 0) "") ('T (CONCAT "D" (|bfDs| (- |n| 1))))))
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index a2324315..61726ec9 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -5,25 +5,21 @@
(IN-PACKAGE "BOOTTRAN")
(DEFUN PNAME (|x|)
- (PROG ()
- (RETURN
- (COND
- ((SYMBOLP |x|) (SYMBOL-NAME |x|))
- ((CHARACTERP |x|) (STRING |x|))
- ('T NIL)))))
+ (COND
+ ((SYMBOLP |x|) (SYMBOL-NAME |x|))
+ ((CHARACTERP |x|) (STRING |x|))
+ ('T NIL)))
-(DEFUN |char| (|x|) (PROG () (RETURN (CHAR (PNAME |x|) 0))))
+(DEFUN |char| (|x|) (CHAR (PNAME |x|) 0))
-(DEFUN EQCAR (|x| |y|)
- (PROG () (RETURN (AND (CONSP |x|) (EQ (CAR |x|) |y|)))))
+(DEFUN EQCAR (|x| |y|) (AND (CONSP |x|) (EQ (CAR |x|) |y|)))
-(DEFUN STRINGIMAGE (|x|) (PROG () (RETURN (WRITE-TO-STRING |x|))))
+(DEFUN STRINGIMAGE (|x|) (WRITE-TO-STRING |x|))
-(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
+(DEFUN |shoeCLOSE| (|stream|) (CLOSE |stream|))
(DEFUN |shoeNotFound| (|fn|)
- (PROG ()
- (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
+ (PROGN (|coreError| (LIST |fn| " not found")) NIL))
(DEFUN |shoeReadLispString| (|s| |n|)
(PROG (|l|)
@@ -36,23 +32,19 @@
(READ-FROM-STRING
(CONCAT '|(| (SUBSTRING |s| |n| (- |l| |n|)) '|)|))))))))
-(DEFUN |shoeReadLine| (|stream|)
- (PROG () (RETURN (READ-LINE |stream| NIL NIL))))
+(DEFUN |shoeReadLine| (|stream|) (READ-LINE |stream| NIL NIL))
-(DEFUN |shoeConsole| (|line|)
- (PROG () (RETURN (WRITE-LINE |line| *TERMINAL-IO*))))
+(DEFUN |shoeConsole| (|line|) (WRITE-LINE |line| *TERMINAL-IO*))
-(DEFUN |shoeSpaces| (|n|) (PROG () (RETURN (MAKE-FULL-CVEC |n| "."))))
+(DEFUN |shoeSpaces| (|n|) (MAKE-FULL-CVEC |n| "."))
(DEFUN |SoftShoeError| (|posn| |key|)
- (PROG ()
- (RETURN
- (PROGN
- (|coreError| (LIST "in line " (STRINGIMAGE (|lineNo| |posn|))))
- (|shoeConsole| (|lineString| |posn|))
- (|shoeConsole|
- (CONCAT (|shoeSpaces| (|lineCharacter| |posn|)) "|"))
- (|shoeConsole| |key|)))))
+ (PROGN
+ (|coreError| (LIST "in line " (STRINGIMAGE (|lineNo| |posn|))))
+ (|shoeConsole| (|lineString| |posn|))
+ (|shoeConsole|
+ (CONCAT (|shoeSpaces| (|lineCharacter| |posn|)) "|"))
+ (|shoeConsole| |key|)))
(DEFUN |bpSpecificErrorAtToken| (|tok| |key|)
(PROG (|a|)
@@ -62,35 +54,30 @@
(|SoftShoeError| |a| |key|)))))
(DEFUN |bpSpecificErrorHere| (|key|)
- (PROG ()
- (DECLARE (SPECIAL |$stok|))
- (RETURN (|bpSpecificErrorAtToken| |$stok| |key|))))
+ (DECLARE (SPECIAL |$stok|))
+ (|bpSpecificErrorAtToken| |$stok| |key|))
-(DEFUN |bpGeneralErrorHere| ()
- (PROG () (RETURN (|bpSpecificErrorHere| "syntax error"))))
+(DEFUN |bpGeneralErrorHere| () (|bpSpecificErrorHere| "syntax error"))
(DEFUN |bpIgnoredFromTo| (|pos1| |pos2|)
- (PROG ()
- (RETURN
- (PROGN
- (|shoeConsole|
- (CONCAT "ignored from line "
- (STRINGIMAGE (|lineNo| |pos1|))))
- (|shoeConsole| (|lineString| |pos1|))
- (|shoeConsole|
- (CONCAT (|shoeSpaces| (|lineCharacter| |pos1|)) "|"))
- (|shoeConsole|
- (CONCAT "ignored through line "
- (STRINGIMAGE (|lineNo| |pos2|))))
- (|shoeConsole| (|lineString| |pos2|))
- (|shoeConsole|
- (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))))
+ (PROGN
+ (|shoeConsole|
+ (CONCAT "ignored from line " (STRINGIMAGE (|lineNo| |pos1|))))
+ (|shoeConsole| (|lineString| |pos1|))
+ (|shoeConsole|
+ (CONCAT (|shoeSpaces| (|lineCharacter| |pos1|)) "|"))
+ (|shoeConsole|
+ (CONCAT "ignored through line "
+ (STRINGIMAGE (|lineNo| |pos2|))))
+ (|shoeConsole| (|lineString| |pos2|))
+ (|shoeConsole|
+ (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))
-(DEFUN |lineNo| (|p|) (PROG () (RETURN (CDAAR |p|))))
+(DEFUN |lineNo| (|p|) (CDAAR |p|))
-(DEFUN |lineString| (|p|) (PROG () (RETURN (CAAAR |p|))))
+(DEFUN |lineString| (|p|) (CAAAR |p|))
-(DEFUN |lineCharacter| (|p|) (PROG () (RETURN (CDR |p|))))
+(DEFUN |lineCharacter| (|p|) (CDR |p|))
(DEFUN |shoePackageStartsAt| (|lines| |sz| |name| |stream|)
(PROG (|a|)
@@ -155,8 +142,7 @@
(RPLACD |x| (CDR |st|))))))
(EQCAR |x| '|nullstream|)))))))
-(DEFUN |bMap| (|f| |x|)
- (PROG () (RETURN (|bDelay| #'|bMap1| (LIST |f| |x|)))))
+(DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|)))
(DEFUN |bMap1| (&REST |z|)
(PROG (|x| |f|)
@@ -187,24 +173,19 @@
(|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
(|bIgen| 0))))))))))
-(DEFUN |bDelay| (|f| |x|)
- (PROG () (RETURN (CONS '|nonnullstream| (CONS |f| |x|)))))
+(DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|)))
-(DEFUN |bAppend| (|x| |y|)
- (PROG () (RETURN (|bDelay| #'|bAppend1| (LIST |x| |y|)))))
+(DEFUN |bAppend| (|x| |y|) (|bDelay| #'|bAppend1| (LIST |x| |y|)))
(DEFUN |bAppend1| (&REST |z|)
- (PROG ()
- (RETURN
- (COND
- ((|bStreamNull| (CAR |z|))
- (COND
- ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|))
- (#0='T (CADR |z|))))
- (#0# (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|))))))))
+ (COND
+ ((|bStreamNull| (CAR |z|))
+ (COND
+ ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|))
+ (#0='T (CADR |z|))))
+ (#0# (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|))))))
-(DEFUN |bNext| (|f| |s|)
- (PROG () (RETURN (|bDelay| #'|bNext1| (LIST |f| |s|)))))
+(DEFUN |bNext| (|f| |s|) (|bDelay| #'|bNext1| (LIST |f| |s|)))
(DEFUN |bNext1| (|f| |s|)
(PROG (|h|)
@@ -216,8 +197,7 @@
(SETQ |h| (APPLY |f| (LIST |s|)))
(|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
-(DEFUN |bRgen| (|s|)
- (PROG () (RETURN (|bDelay| #'|bRgen1| (LIST |s|)))))
+(DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|)))
(DEFUN |bRgen1| (&REST |s|)
(PROG (|a|)
@@ -228,16 +208,13 @@
((|shoePLACEP| |a|) (LIST '|nullstream|))
('T (CONS |a| (|bRgen| (CAR |s|)))))))))
-(DEFUN |bIgen| (|n|)
- (PROG () (RETURN (|bDelay| #'|bIgen1| (LIST |n|)))))
+(DEFUN |bIgen| (|n|) (|bDelay| #'|bIgen1| (LIST |n|)))
(DEFUN |bIgen1| (&REST |n|)
- (PROG ()
- (RETURN
- (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))))
+ (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))
(DEFUN |bAddLineNumber| (|f1| |f2|)
- (PROG () (RETURN (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))))
+ (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))
(DEFUN |bAddLineNumber1| (&REST |f|)
(PROG (|f2| |f1|)
@@ -252,18 +229,17 @@
(CONS (CONS (CAR |f1|) (CAR |f2|))
(|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))))))
-(DEFUN |shoeFileInput| (|fn|)
- (PROG () (RETURN (|shoeFileMap| #'IDENTITY |fn|))))
+(DEFUN |shoeFileInput| (|fn|) (|shoeFileMap| #'IDENTITY |fn|))
-(DEFUN |shoePrefixLisp| (|x|) (PROG () (RETURN (CONCAT ")lisp" |x|))))
+(DEFUN |shoePrefixLisp| (|x|) (CONCAT ")lisp" |x|))
(DEFUN |shoeLispFileInput| (|fn|)
- (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLisp| |fn|))))
+ (|shoeFileMap| #'|shoePrefixLisp| |fn|))
-(DEFUN |shoePrefixLine| (|x|) (PROG () (RETURN (CONCAT ")line" |x|))))
+(DEFUN |shoePrefixLine| (|x|) (CONCAT ")line" |x|))
(DEFUN |shoeLineFileInput| (|fn|)
- (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLine| |fn|))))
+ (|shoeFileMap| #'|shoePrefixLine| |fn|))
(DEFUN |shoePrefix?| (|prefix| |whole|)
(PROG (|good|)
@@ -287,50 +263,38 @@
('T |good|))))))))
(DEFUN |shoePlainLine?| (|s|)
- (PROG ()
- (RETURN
- (COND
- ((EQL (LENGTH |s|) 0) T)
- ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|))))))))
+ (COND
+ ((EQL (LENGTH |s|) 0) T)
+ ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|))))))
-(DEFUN |shoeSay?| (|s|) (PROG () (RETURN (|shoePrefix?| ")say" |s|))))
+(DEFUN |shoeSay?| (|s|) (|shoePrefix?| ")say" |s|))
-(DEFUN |shoeEval?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")eval" |s|))))
+(DEFUN |shoeEval?| (|s|) (|shoePrefix?| ")eval" |s|))
-(DEFUN |shoeInclude?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")include" |s|))))
+(DEFUN |shoeInclude?| (|s|) (|shoePrefix?| ")include" |s|))
-(DEFUN |shoeFin?| (|s|) (PROG () (RETURN (|shoePrefix?| ")fin" |s|))))
+(DEFUN |shoeFin?| (|s|) (|shoePrefix?| ")fin" |s|))
-(DEFUN |shoeIf?| (|s|) (PROG () (RETURN (|shoePrefix?| ")if" |s|))))
+(DEFUN |shoeIf?| (|s|) (|shoePrefix?| ")if" |s|))
-(DEFUN |shoeEndIf?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")endif" |s|))))
+(DEFUN |shoeEndIf?| (|s|) (|shoePrefix?| ")endif" |s|))
-(DEFUN |shoeElse?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")else" |s|))))
+(DEFUN |shoeElse?| (|s|) (|shoePrefix?| ")else" |s|))
-(DEFUN |shoeElseIf?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")elseif" |s|))))
+(DEFUN |shoeElseIf?| (|s|) (|shoePrefix?| ")elseif" |s|))
-(DEFUN |shoePackage?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")package" |s|))))
+(DEFUN |shoePackage?| (|s|) (|shoePrefix?| ")package" |s|))
-(DEFUN |shoeLisp?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")lisp" |s|))))
+(DEFUN |shoeLisp?| (|s|) (|shoePrefix?| ")lisp" |s|))
-(DEFUN |shoeIncludeLisp?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")includelisp" |s|))))
+(DEFUN |shoeIncludeLisp?| (|s|) (|shoePrefix?| ")includelisp" |s|))
-(DEFUN |shoeLine?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")line" |s|))))
+(DEFUN |shoeLine?| (|s|) (|shoePrefix?| ")line" |s|))
-(DEFUN |shoeIncludeLines?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")includelines" |s|))))
+(DEFUN |shoeIncludeLines?| (|s|) (|shoePrefix?| ")includelines" |s|))
(DEFUN |shoeIncludeFunction?| (|s|)
- (PROG () (RETURN (|shoePrefix?| ")includefunction" |s|))))
+ (|shoePrefix?| ")includefunction" |s|))
(DEFUN |shoeBiteOff| (|x|)
(PROG (|n1| |n|)
@@ -387,8 +351,7 @@
(|bAddLineNumber| (|shoeFindLines| |fn| |fun| |a|)
(|bIgen| 0))))))))
-(DEFUN |shoeInclude| (|s|)
- (PROG () (RETURN (|bDelay| #'|shoeInclude1| (LIST |s|)))))
+(DEFUN |shoeInclude| (|s|) (|bDelay| #'|shoeInclude1| (LIST |s|)))
(DEFUN |shoeInclude1| (|s|)
(PROG (|command| |string| |t| |h|)
@@ -433,7 +396,7 @@
('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
(DEFUN |shoeThen| (|keep| |b| |s|)
- (PROG () (RETURN (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))))
+ (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))
(DEFUN |shoeThen1| (|keep| |b| |s|)
(PROG (|b1| |keep1| |command| |string| |t| |h|)
@@ -486,7 +449,7 @@
(#0# (|shoeThen| |keep| |b| |t|))))))))))))
(DEFUN |shoeElse| (|keep| |b| |s|)
- (PROG () (RETURN (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))))
+ (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))
(DEFUN |shoeElse1| (|keep| |b| |s|)
(PROG (|keep1| |b1| |command| |string| |t| |h|)
@@ -523,31 +486,25 @@
(#0# (|shoeElse| |keep| |b| |t|))))))))))))
(DEFUN |shoeLineSyntaxError| (|h|)
- (PROG ()
- (RETURN
- (PROGN
- (|shoeConsole|
- (CONCAT "INCLUSION SYNTAX ERROR IN LINE "
- (STRINGIMAGE (CDR |h|))))
- (|shoeConsole| (CAR |h|))
- (|shoeConsole| "LINE IGNORED")))))
+ (PROGN
+ (|shoeConsole|
+ (CONCAT "INCLUSION SYNTAX ERROR IN LINE "
+ (STRINGIMAGE (CDR |h|))))
+ (|shoeConsole| (CAR |h|))
+ (|shoeConsole| "LINE IGNORED")))
(DEFUN |bPremStreamNil| (|h|)
- (PROG ()
- (DECLARE (SPECIAL |$bStreamNil|))
- (RETURN
- (PROGN
- (|shoeConsole|
- (CONCAT "UNEXPECTED )fin IN LINE " (STRINGIMAGE (CDR |h|))))
- (|shoeConsole| (CAR |h|))
- (|shoeConsole| "REST OF FILE IGNORED")
- |$bStreamNil|))))
+ (DECLARE (SPECIAL |$bStreamNil|))
+ (PROGN
+ (|shoeConsole|
+ (CONCAT "UNEXPECTED )fin IN LINE " (STRINGIMAGE (CDR |h|))))
+ (|shoeConsole| (CAR |h|))
+ (|shoeConsole| "REST OF FILE IGNORED")
+ |$bStreamNil|))
(DEFUN |bPremStreamNull| (|s|)
- (PROG ()
- (RETURN
- (COND
- ((|bStreamNull| |s|)
- (|shoeConsole| "FILE TERMINATED BEFORE )endif") T)
- ('T NIL)))))
+ (COND
+ ((|bStreamNull| |s|)
+ (|shoeConsole| "FILE TERMINATED BEFORE )endif") T)
+ ('T NIL)))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 279926e5..5f9c01ef 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -13,87 +13,68 @@
(DEFPARAMETER |$bodyHasReturn| NIL)
(DEFUN |bpFirstToken| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
- (RETURN
- (PROGN
- (SETQ |$stok|
- (COND
- ((NULL |$inputStream|)
- (|shoeTokConstruct| 'ERROR 'NOMORE
- (|shoeTokPosn| |$stok|)))
- ('T (CAR |$inputStream|))))
- (SETQ |$ttok| (|shoeTokPart| |$stok|))
- T))))
+ (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
+ (PROGN
+ (SETQ |$stok|
+ (COND
+ ((NULL |$inputStream|)
+ (|shoeTokConstruct| 'ERROR 'NOMORE
+ (|shoeTokPosn| |$stok|)))
+ ('T (CAR |$inputStream|))))
+ (SETQ |$ttok| (|shoeTokPart| |$stok|))
+ T))
(DEFUN |bpFirstTok| ()
- (PROG ()
- (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok|
- |$inputStream|))
- (RETURN
- (PROGN
- (SETQ |$stok|
- (COND
- ((NULL |$inputStream|)
- (|shoeTokConstruct| 'ERROR 'NOMORE
- (|shoeTokPosn| |$stok|)))
- ('T (CAR |$inputStream|))))
- (SETQ |$ttok| (|shoeTokPart| |$stok|))
- (COND
- ((AND (< 0 |$bpParenCount|) (EQCAR |$stok| 'KEY))
- (COND
- ((EQ |$ttok| 'SETTAB)
- (PROGN (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)))
- ((EQ |$ttok| 'BACKTAB)
- (PROGN (SETQ |$bpCount| (- |$bpCount| 1)) (|bpNext|)))
- ((EQ |$ttok| 'BACKSET) (|bpNext|))
- (#0='T T)))
- (#0# T))))))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok|
+ |$inputStream|))
+ (PROGN
+ (SETQ |$stok|
+ (COND
+ ((NULL |$inputStream|)
+ (|shoeTokConstruct| 'ERROR 'NOMORE
+ (|shoeTokPosn| |$stok|)))
+ ('T (CAR |$inputStream|))))
+ (SETQ |$ttok| (|shoeTokPart| |$stok|))
+ (COND
+ ((AND (< 0 |$bpParenCount|) (EQCAR |$stok| 'KEY))
+ (COND
+ ((EQ |$ttok| 'SETTAB)
+ (PROGN (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)))
+ ((EQ |$ttok| 'BACKTAB)
+ (PROGN (SETQ |$bpCount| (- |$bpCount| 1)) (|bpNext|)))
+ ((EQ |$ttok| 'BACKSET) (|bpNext|))
+ (#0='T T)))
+ (#0# T))))
(DEFUN |bpNext| ()
- (PROG ()
- (DECLARE (SPECIAL |$inputStream|))
- (RETURN
- (PROGN
- (SETQ |$inputStream| (CDR |$inputStream|))
- (|bpFirstTok|)))))
+ (DECLARE (SPECIAL |$inputStream|))
+ (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstTok|)))
(DEFUN |bpNextToken| ()
- (PROG ()
- (DECLARE (SPECIAL |$inputStream|))
- (RETURN
- (PROGN
- (SETQ |$inputStream| (CDR |$inputStream|))
- (|bpFirstToken|)))))
+ (DECLARE (SPECIAL |$inputStream|))
+ (PROGN (SETQ |$inputStream| (CDR |$inputStream|)) (|bpFirstToken|)))
(DEFUN |bpState| ()
- (PROG ()
- (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack|
- |$inputStream|))
- (RETURN (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
+ (LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))
(DEFUN |bpRestore| (|x|)
- (PROG ()
- (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack|
- |$inputStream|))
- (RETURN
- (PROGN
- (SETQ |$inputStream| (CAR |x|))
- (|bpFirstToken|)
- (SETQ |$stack| (CADR |x|))
- (SETQ |$bpParenCount| (CADDR |x|))
- (SETQ |$bpCount| (CADDDR |x|))
- T))))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
+ (PROGN
+ (SETQ |$inputStream| (CAR |x|))
+ (|bpFirstToken|)
+ (SETQ |$stack| (CADR |x|))
+ (SETQ |$bpParenCount| (CADDR |x|))
+ (SETQ |$bpCount| (CADDDR |x|))
+ T))
(DEFUN |bpPush| (|x|)
- (PROG ()
- (DECLARE (SPECIAL |$stack|))
- (RETURN (SETQ |$stack| (CONS |x| |$stack|)))))
+ (DECLARE (SPECIAL |$stack|))
+ (SETQ |$stack| (CONS |x| |$stack|)))
(DEFUN |bpPushId| ()
- (PROG ()
- (DECLARE (SPECIAL |$stack| |$ttok|))
- (RETURN (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))))
+ (DECLARE (SPECIAL |$stack| |$ttok|))
+ (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))
(DEFUN |bpPop1| ()
(PROG (|a|)
@@ -188,17 +169,14 @@
(#0# NIL))))))
(DEFUN |bpPileBracketed| (|f|)
- (PROG ()
- (RETURN
- (COND
- ((|bpEqKey| 'SETTAB)
- (COND
- ((|bpEqKey| 'BACKTAB) T)
- ((AND (APPLY |f| NIL)
- (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
- (|bpPush| (|bfPile| (|bpPop1|))))
- (#0='T NIL)))
- (#0# NIL)))))
+ (COND
+ ((|bpEqKey| 'SETTAB)
+ (COND
+ ((|bpEqKey| 'BACKTAB) T)
+ ((AND (APPLY |f| NIL) (OR (|bpEqKey| 'BACKTAB) (|bpPileTrap|)))
+ (|bpPush| (|bfPile| (|bpPop1|))))
+ (#0='T NIL)))
+ (#0# NIL)))
(DEFUN |bpListof| (|f| |str1| |g|)
(PROG (|a|)
@@ -283,35 +261,27 @@
('T NIL)))))
(DEFUN |bpAnyNo| (|s|)
- (PROG ()
- (RETURN
- (PROGN
- (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) ('T 0)))
- T))))
+ (PROGN (LOOP (COND ((NOT (APPLY |s| NIL)) (RETURN NIL)) ('T 0))) T))
(DEFUN |bpAndOr| (|keyword| |p| |f|)
- (PROG ()
- (RETURN
- (AND (|bpEqKey| |keyword|) (OR (APPLY |p| NIL) (|bpTrap|))
- (|bpPush| (FUNCALL |f| (|bpPop1|)))))))
+ (AND (|bpEqKey| |keyword|) (OR (APPLY |p| NIL) (|bpTrap|))
+ (|bpPush| (FUNCALL |f| (|bpPop1|)))))
(DEFUN |bpConditional| (|f|)
- (PROG ()
- (RETURN
- (COND
- ((AND (|bpEqKey| 'IF) (OR (|bpWhere|) (|bpTrap|))
- (OR (|bpEqKey| 'BACKSET) T))
- (COND
- ((|bpEqKey| 'SETTAB)
- (COND
- ((|bpEqKey| 'THEN)
- (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|)
- (|bpEqKey| 'BACKTAB)))
- (#0='T (|bpMissing| 'THEN))))
- ((|bpEqKey| 'THEN)
- (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|)))
- (#0# (|bpMissing| '|then|))))
- (#0# NIL)))))
+ (COND
+ ((AND (|bpEqKey| 'IF) (OR (|bpWhere|) (|bpTrap|))
+ (OR (|bpEqKey| 'BACKSET) T))
+ (COND
+ ((|bpEqKey| 'SETTAB)
+ (COND
+ ((|bpEqKey| 'THEN)
+ (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|)
+ (|bpEqKey| 'BACKTAB)))
+ (#0='T (|bpMissing| 'THEN))))
+ ((|bpEqKey| 'THEN)
+ (AND (OR (APPLY |f| NIL) (|bpTrap|)) (|bpElse| |f|)))
+ (#0# (|bpMissing| '|then|))))
+ (#0# NIL)))
(DEFUN |bpElse| (|f|)
(PROG (|a|)
@@ -326,58 +296,42 @@
(|bpPush| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|)))))))))
(DEFUN |bpBacksetElse| ()
- (PROG ()
- (RETURN
- (COND
- ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE))
- ('T (|bpEqKey| 'ELSE))))))
+ (COND
+ ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE))
+ ('T (|bpEqKey| 'ELSE))))
(DEFUN |bpEqPeek| (|s|)
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|)))
(DEFUN |bpEqKey| (|s|)
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNext|)))
(DEFUN |bpEqKeyNextTok| (|s|)
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))
-(DEFUN |bpPileTrap| () (PROG () (RETURN (|bpMissing| 'BACKTAB))))
+(DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB))
-(DEFUN |bpBrackTrap| (|x|)
- (PROG () (RETURN (|bpMissingMate| '] |x|))))
+(DEFUN |bpBrackTrap| (|x|) (|bpMissingMate| '] |x|))
-(DEFUN |bpParenTrap| (|x|)
- (PROG () (RETURN (|bpMissingMate| '|)| |x|))))
+(DEFUN |bpParenTrap| (|x|) (|bpMissingMate| '|)| |x|))
(DEFUN |bpMissingMate| (|close| |open|)
- (PROG ()
- (RETURN
- (PROGN
- (|bpSpecificErrorAtToken| |open| "possibly missing mate")
- (|bpMissing| |close|)))))
+ (PROGN
+ (|bpSpecificErrorAtToken| |open| "possibly missing mate")
+ (|bpMissing| |close|)))
(DEFUN |bpMissing| (|s|)
- (PROG ()
- (RETURN
- (PROGN
- (|bpSpecificErrorHere|
- (CONCAT (PNAME |s|) " possibly missing"))
- (THROW 'TRAPPOINT 'TRAPPED)))))
+ (PROGN
+ (|bpSpecificErrorHere| (CONCAT (PNAME |s|) " possibly missing"))
+ (THROW 'TRAPPOINT 'TRAPPED)))
-(DEFUN |bpCompMissing| (|s|)
- (PROG () (RETURN (OR (|bpEqKey| |s|) (|bpMissing| |s|)))))
+(DEFUN |bpCompMissing| (|s|) (OR (|bpEqKey| |s|) (|bpMissing| |s|)))
(DEFUN |bpTrap| ()
- (PROG ()
- (RETURN
- (PROGN (|bpGeneralErrorHere|) (THROW 'TRAPPOINT 'TRAPPED)))))
+ (PROGN (|bpGeneralErrorHere|) (THROW 'TRAPPOINT 'TRAPPED)))
(DEFUN |bpRecoverTrap| ()
(PROG (|pos2| |pos1|)
@@ -427,116 +381,95 @@
(|bpPush| (NREVERSE |b|))))))
(DEFUN |bpMoveTo| (|n|)
- (PROG ()
- (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
- (RETURN
- (COND
- ((NULL |$inputStream|) T)
- ((|bpEqPeek| 'BACKTAB)
- (COND
- ((EQL |n| 0) T)
- (#0='T
- (PROGN
- (|bpNextToken|)
- (SETQ |$bpCount| (- |$bpCount| 1))
- (|bpMoveTo| (- |n| 1))))))
- ((|bpEqPeek| 'BACKSET)
- (COND
- ((EQL |n| 0) T)
- (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))
- ((|bpEqPeek| 'SETTAB)
- (PROGN (|bpNextToken|) (|bpMoveTo| (+ |n| 1))))
- ((|bpEqPeek| 'OPAREN)
- (PROGN
- (|bpNextToken|)
- (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
- (|bpMoveTo| |n|)))
- ((|bpEqPeek| 'CPAREN)
- (PROGN
- (|bpNextToken|)
- (SETQ |$bpParenCount| (- |$bpParenCount| 1))
- (|bpMoveTo| |n|)))
- (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))))
+ (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
+ (COND
+ ((NULL |$inputStream|) T)
+ ((|bpEqPeek| 'BACKTAB)
+ (COND
+ ((EQL |n| 0) T)
+ (#0='T
+ (PROGN
+ (|bpNextToken|)
+ (SETQ |$bpCount| (- |$bpCount| 1))
+ (|bpMoveTo| (- |n| 1))))))
+ ((|bpEqPeek| 'BACKSET)
+ (COND
+ ((EQL |n| 0) T)
+ (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))
+ ((|bpEqPeek| 'SETTAB)
+ (PROGN (|bpNextToken|) (|bpMoveTo| (+ |n| 1))))
+ ((|bpEqPeek| 'OPAREN)
+ (PROGN
+ (|bpNextToken|)
+ (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
+ (|bpMoveTo| |n|)))
+ ((|bpEqPeek| 'CPAREN)
+ (PROGN
+ (|bpNextToken|)
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1))
+ (|bpMoveTo| |n|)))
+ (#0# (PROGN (|bpNextToken|) (|bpMoveTo| |n|)))))
(DEFUN |bpQualifiedName| ()
- (PROG ()
- (DECLARE (SPECIAL |$stok|))
- (RETURN
- (COND
- ((|bpEqPeek| 'COLON-COLON)
- (PROGN
- (|bpNext|)
- (AND (EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|)
- (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))))
- ('T NIL)))))
+ (DECLARE (SPECIAL |$stok|))
+ (COND
+ ((|bpEqPeek| 'COLON-COLON)
+ (PROGN
+ (|bpNext|)
+ (AND (EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|)
+ (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))))
+ ('T NIL)))
(DEFUN |bpName| ()
- (PROG ()
- (DECLARE (SPECIAL |$stok|))
- (RETURN
- (COND
- ((EQCAR |$stok| 'ID)
- (PROGN
- (|bpPushId|)
- (|bpNext|)
- (|bpAnyNo| #'|bpQualifiedName|)))
- ('T NIL)))))
+ (DECLARE (SPECIAL |$stok|))
+ (COND
+ ((EQCAR |$stok| 'ID)
+ (PROGN (|bpPushId|) (|bpNext|) (|bpAnyNo| #'|bpQualifiedName|)))
+ ('T NIL)))
(DEFUN |bpConstTok| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (COND
- ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT))
- (PROGN (|bpPush| |$ttok|) (|bpNext|)))
- ((EQCAR |$stok| 'LISP)
- (AND (|bpPush| (|bfReadLisp| |$ttok|)) (|bpNext|)))
- ((EQCAR |$stok| 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|)))
- ((EQCAR |$stok| 'LINE)
- (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|)))
- ((|bpEqPeek| 'QUOTE)
- (PROGN
- (|bpNext|)
- (AND (OR (|bpSexp|) (|bpTrap|))
- (|bpPush| (|bfSymbol| (|bpPop1|))))))
- ('T (|bpString|))))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (COND
+ ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT))
+ (PROGN (|bpPush| |$ttok|) (|bpNext|)))
+ ((EQCAR |$stok| 'LISP)
+ (AND (|bpPush| (|bfReadLisp| |$ttok|)) (|bpNext|)))
+ ((EQCAR |$stok| 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|)))
+ ((EQCAR |$stok| 'LINE)
+ (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|)))
+ ((|bpEqPeek| 'QUOTE)
+ (PROGN
+ (|bpNext|)
+ (AND (OR (|bpSexp|) (|bpTrap|))
+ (|bpPush| (|bfSymbol| (|bpPop1|))))))
+ ('T (|bpString|))))
(DEFUN |bpModule| ()
- (PROG ()
- (RETURN
- (COND
- ((|bpEqKey| 'MODULE)
- (AND (|bpConstTok|) (|bpPush| (|Module| (|bpPop1|)))))
- ('T NIL)))))
+ (COND
+ ((|bpEqKey| 'MODULE)
+ (AND (|bpConstTok|) (|bpPush| (|Module| (|bpPop1|)))))
+ ('T NIL)))
(DEFUN |bpImport| ()
- (PROG ()
- (RETURN
- (COND
- ((|bpEqKey| 'IMPORT)
- (OR (AND (|bpName|) (OR (|bpEqKey| 'FOR) (|bpTrap|))
- (|bpSignature|)
- (|bpPush| (|ImportSignature| (|bpPop2|) (|bpPop1|))))
- (AND (|bpConstTok|) (|bpPush| (|Import| (|bpPop1|))))))
- ('T NIL)))))
+ (COND
+ ((|bpEqKey| 'IMPORT)
+ (OR (AND (|bpName|) (OR (|bpEqKey| 'FOR) (|bpTrap|))
+ (|bpSignature|)
+ (|bpPush| (|ImportSignature| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpConstTok|) (|bpPush| (|Import| (|bpPop1|))))))
+ ('T NIL)))
(DEFUN |bpTypeAliasDefition| ()
- (PROG ()
- (RETURN
- (AND (OR (|bpName|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
- (|bpPush| (|TypeAlias| (|bpPop2|) NIL (|bpPop1|)))))))
+ (AND (OR (|bpName|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
+ (|bpPush| (|TypeAlias| (|bpPop2|) NIL (|bpPop1|)))))
(DEFUN |bpSignature| ()
- (PROG ()
- (RETURN
- (AND (|bpName|) (|bpEqKey| 'COLON) (|bpMapping|)
- (|bpPush| (|Signature| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpName|) (|bpEqKey| 'COLON) (|bpMapping|)
+ (|bpPush| (|Signature| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpMapping| ()
- (PROG ()
- (RETURN
- (AND (OR (|bpName|) (|bpIdList|)) (|bpEqKey| 'ARROW) (|bpName|)
- (|bpPush| (|Mapping| (|bpPop1|) (|bpPop1|)))))))
+ (AND (OR (|bpName|) (|bpIdList|)) (|bpEqKey| 'ARROW) (|bpName|)
+ (|bpPush| (|Mapping| (|bpPop1|) (|bpPop1|)))))
(DEFUN |bpCancel| ()
(PROG (|a|)
@@ -555,26 +488,20 @@
(#0# NIL))))))
(DEFUN |bpAddTokens| (|n|)
- (PROG ()
- (DECLARE (SPECIAL |$stok|))
- (RETURN
- (COND
- ((EQL |n| 0) NIL)
- ((< 0 |n|)
- (CONS (|shoeTokConstruct| 'KEY 'SETTAB
- (|shoeTokPosn| |$stok|))
- (|bpAddTokens| (- |n| 1))))
- ('T
- (CONS (|shoeTokConstruct| 'KEY 'BACKTAB
- (|shoeTokPosn| |$stok|))
- (|bpAddTokens| (+ |n| 1))))))))
+ (DECLARE (SPECIAL |$stok|))
+ (COND
+ ((EQL |n| 0) NIL)
+ ((< 0 |n|)
+ (CONS (|shoeTokConstruct| 'KEY 'SETTAB (|shoeTokPosn| |$stok|))
+ (|bpAddTokens| (- |n| 1))))
+ ('T
+ (CONS (|shoeTokConstruct| 'KEY 'BACKTAB (|shoeTokPosn| |$stok|))
+ (|bpAddTokens| (+ |n| 1))))))
(DEFUN |bpExceptions| ()
- (PROG ()
- (RETURN
- (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
- (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB)
- (|bpEqPeek| 'BACKTAB) (|bpEqPeek| 'BACKSET)))))
+ (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
+ (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB) (|bpEqPeek| 'BACKTAB)
+ (|bpEqPeek| 'BACKSET)))
(DEFUN |bpSexpKey| ()
(PROG (|a|)
@@ -590,116 +517,84 @@
(#0# NIL)))))
(DEFUN |bpAnyId| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (OR (AND (|bpEqKey| 'MINUS)
- (OR (EQCAR |$stok| 'INTEGER) (|bpTrap|))
- (|bpPush| (- |$ttok|)) (|bpNext|))
- (|bpSexpKey|)
- (AND (MEMQ (|shoeTokType| |$stok|)
- '(ID INTEGER STRING FLOAT))
- (|bpPush| |$ttok|) (|bpNext|))))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (OR (AND (|bpEqKey| 'MINUS) (OR (EQCAR |$stok| 'INTEGER) (|bpTrap|))
+ (|bpPush| (- |$ttok|)) (|bpNext|))
+ (|bpSexpKey|)
+ (AND (MEMQ (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT))
+ (|bpPush| |$ttok|) (|bpNext|))))
(DEFUN |bpSexp| ()
- (PROG ()
- (RETURN
- (OR (|bpAnyId|)
- (AND (|bpEqKey| 'QUOTE) (OR (|bpSexp|) (|bpTrap|))
- (|bpPush| (|bfSymbol| (|bpPop1|))))
- (|bpIndentParenthesized| #'|bpSexp1|)))))
+ (OR (|bpAnyId|)
+ (AND (|bpEqKey| 'QUOTE) (OR (|bpSexp|) (|bpTrap|))
+ (|bpPush| (|bfSymbol| (|bpPop1|))))
+ (|bpIndentParenthesized| #'|bpSexp1|)))
(DEFUN |bpSexp1| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpFirstTok|) (|bpSexp|)
- (OR (AND (|bpEqKey| 'DOT) (|bpSexp|)
- (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))
- (AND (|bpSexp1|)
- (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))))
- (|bpPush| NIL)))))
+ (OR (AND (|bpFirstTok|) (|bpSexp|)
+ (OR (AND (|bpEqKey| 'DOT) (|bpSexp|)
+ (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))
+ (AND (|bpSexp1|)
+ (|bpPush| (CONS (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| NIL)))
(DEFUN |bpPrimary1| ()
- (PROG ()
- (RETURN
- (OR (|bpName|) (|bpDot|) (|bpConstTok|) (|bpConstruct|)
- (|bpCase|) (|bpStruct|) (|bpPDefinition|)
- (|bpBPileDefinition|)))))
+ (OR (|bpName|) (|bpDot|) (|bpConstTok|) (|bpConstruct|) (|bpCase|)
+ (|bpStruct|) (|bpPDefinition|) (|bpBPileDefinition|)))
(DEFUN |bpPrimary| ()
- (PROG ()
- (RETURN
- (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|))))))
+ (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|))))
-(DEFUN |bpDot| ()
- (PROG () (RETURN (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))))
+(DEFUN |bpDot| () (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))
(DEFUN |bpPrefixOperator| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|)
- (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|)
+ (|bpNext|)))
(DEFUN |bpInfixOperator| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|)
- (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|)
+ (|bpNext|)))
(DEFUN |bpSelector| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'DOT)
- (OR (AND (|bpPrimary|)
- (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfSuffixDot| (|bpPop1|))))))))
+ (AND (|bpEqKey| 'DOT)
+ (OR (AND (|bpPrimary|)
+ (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfSuffixDot| (|bpPop1|))))))
-(DEFUN |bpOperator| ()
- (PROG () (RETURN (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)))))
+(DEFUN |bpOperator| () (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)))
(DEFUN |bpApplication| ()
- (PROG ()
- (RETURN
- (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)
- (OR (AND (|bpApplication|)
- (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
- T)))))
+ (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)
+ (OR (AND (|bpApplication|)
+ (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ T)))
(DEFUN |bpTyping| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpApplication|)
- (OR (AND (|bpEqKey| 'ARROW)
- (OR (|bpApplication|) (|bpTrap|))
- (|bpPush|
- (|Mapping| (|bpPop1|)
- (|bfUntuple| (|bpPop1|)))))
- T))
- (|bpMapping|)))))
+ (OR (AND (|bpApplication|)
+ (OR (AND (|bpEqKey| 'ARROW)
+ (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush|
+ (|Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|)))))
+ T))
+ (|bpMapping|)))
(DEFUN |bpTagged| ()
- (PROG ()
- (RETURN
- (AND (|bpApplication|)
- (OR (AND (|bpEqKey| 'COLON) (OR (|bpTyping|) (|bpTrap|))
- (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
- T)))))
+ (AND (|bpApplication|)
+ (OR (AND (|bpEqKey| 'COLON) (OR (|bpTyping|) (|bpTrap|))
+ (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
+ T)))
-(DEFUN |bpExpt| ()
- (PROG () (RETURN (|bpRightAssoc| '(POWER) #'|bpTagged|))))
+(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTagged|))
(DEFUN |bpInfKey| (|s|)
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|)
- (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|)
+ (|bpNext|)))
(DEFUN |bpInfGeneric| (|s|)
- (PROG ()
- (RETURN (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T)))))
+ (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T)))
(DEFUN |bpRightAssoc| (|o| |p|)
(PROG (|a|)
@@ -721,40 +616,33 @@
('T (|bpRestore| |a|) NIL))))))
(DEFUN |bpLeftAssoc| (|operations| |parser|)
- (PROG ()
- (RETURN
- (COND
- ((APPLY |parser| NIL)
- (LOOP
- (COND
- ((NOT (AND (|bpInfGeneric| |operations|)
- (OR (APPLY |parser| NIL) (|bpTrap|))))
- (RETURN NIL))
- ('T
- (|bpPush|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
- T)
- ('T NIL)))))
+ (COND
+ ((APPLY |parser| NIL)
+ (LOOP
+ (COND
+ ((NOT (AND (|bpInfGeneric| |operations|)
+ (OR (APPLY |parser| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T
+ (|bpPush|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))))
+ T)
+ ('T NIL)))
(DEFUN |bpString| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQ (|shoeTokType| |$stok|) 'STRING)
- (|bpPush| (LIST 'QUOTE (INTERN |$ttok|))) (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQ (|shoeTokType| |$stok|) 'STRING)
+ (|bpPush| (LIST 'QUOTE (INTERN |$ttok|))) (|bpNext|)))
(DEFUN |bpThetaName| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (COND
- ((AND (EQCAR |$stok| 'ID) (GET |$ttok| 'SHOETHETA))
- (|bpPushId|) (|bpNext|))
- ('T NIL)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (COND
+ ((AND (EQCAR |$stok| 'ID) (GET |$ttok| 'SHOETHETA)) (|bpPushId|)
+ (|bpNext|))
+ ('T NIL)))
(DEFUN |bpReduceOperator| ()
- (PROG ()
- (RETURN (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|)))))
+ (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|)))
(DEFUN |bpReduce| ()
(PROG (|a|)
@@ -773,138 +661,102 @@
('T (|bpRestore| |a|) NIL))))))
(DEFUN |bpTimes| ()
- (PROG ()
- (RETURN
- (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|)))))
+ (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|)))
(DEFUN |bpMinus| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpInfGeneric| '(MINUS)) (OR (|bpTimes|) (|bpTrap|))
- (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
- (|bpTimes|)))))
+ (OR (AND (|bpInfGeneric| '(MINUS)) (OR (|bpTimes|) (|bpTrap|))
+ (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (|bpTimes|)))
-(DEFUN |bpArith| ()
- (PROG () (RETURN (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|))))
+(DEFUN |bpArith| () (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|))
(DEFUN |bpIs| ()
- (PROG ()
- (RETURN
- (AND (|bpArith|)
- (OR (AND (|bpInfKey| '(IS ISNT))
- (OR (|bpPattern|) (|bpTrap|))
- (|bpPush|
- (|bfISApplication| (|bpPop2|) (|bpPop2|)
- (|bpPop1|))))
- T)))))
+ (AND (|bpArith|)
+ (OR (AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush|
+ (|bfISApplication| (|bpPop2|) (|bpPop2|)
+ (|bpPop1|))))
+ T)))
(DEFUN |bpBracketConstruct| (|f|)
- (PROG ()
- (RETURN
- (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))))
+ (AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))
(DEFUN |bpCompare| ()
- (PROG ()
- (RETURN
- (AND (|bpIs|)
- (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
- (OR (|bpIs|) (|bpTrap|))
- (|bpPush|
- (|bfInfApplication| (|bpPop2|) (|bpPop2|)
- (|bpPop1|))))
- T)))))
+ (AND (|bpIs|)
+ (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN))
+ (OR (|bpIs|) (|bpTrap|))
+ (|bpPush|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|)
+ (|bpPop1|))))
+ T)))
-(DEFUN |bpAnd| ()
- (PROG () (RETURN (|bpLeftAssoc| '(AND) #'|bpCompare|))))
+(DEFUN |bpAnd| () (|bpLeftAssoc| '(AND) #'|bpCompare|))
(DEFUN |bpNoteReturnStmt| ()
- (PROG ()
- (DECLARE (SPECIAL |$bodyHasReturn|))
- (RETURN (PROGN (SETQ |$bodyHasReturn| T) T))))
+ (DECLARE (SPECIAL |$bodyHasReturn|))
+ (PROGN (SETQ |$bodyHasReturn| T) T))
(DEFUN |bpReturn| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpEqKey| 'RETURN) (|bpNoteReturnStmt|)
- (OR (|bpAnd|) (|bpTrap|))
- (|bpPush| (|bfReturnNoName| (|bpPop1|))))
- (|bpAnd|)))))
+ (OR (AND (|bpEqKey| 'RETURN) (|bpNoteReturnStmt|)
+ (OR (|bpAnd|) (|bpTrap|))
+ (|bpPush| (|bfReturnNoName| (|bpPop1|))))
+ (|bpAnd|)))
-(DEFUN |bpLogical| ()
- (PROG () (RETURN (|bpLeftAssoc| '(OR) #'|bpReturn|))))
+(DEFUN |bpLogical| () (|bpLeftAssoc| '(OR) #'|bpReturn|))
(DEFUN |bpExpression| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpEqKey| 'COLON)
- (OR (AND (|bpLogical|)
- (|bpPush| (|bfApplication| 'COLON (|bpPop1|))))
- (|bpTrap|)))
- (|bpLogical|)))))
+ (OR (AND (|bpEqKey| 'COLON)
+ (OR (AND (|bpLogical|)
+ (|bpPush| (|bfApplication| 'COLON (|bpPop1|))))
+ (|bpTrap|)))
+ (|bpLogical|)))
(DEFUN |bpStatement| ()
- (PROG ()
- (RETURN
- (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|)))))
+ (OR (|bpConditional| #'|bpWhere|) (|bpLoop|) (|bpExpression|)))
(DEFUN |bpLoop| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpIterators|) (|bpCompMissing| 'REPEAT)
- (OR (|bpWhere|) (|bpTrap|))
- (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'REPEAT) (OR (|bpLogical|) (|bpTrap|))
- (|bpPush| (|bfLoop1| (|bpPop1|))))))))
+ (OR (AND (|bpIterators|) (|bpCompMissing| 'REPEAT)
+ (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|bfLp| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'REPEAT) (OR (|bpLogical|) (|bpTrap|))
+ (|bpPush| (|bfLoop1| (|bpPop1|))))))
-(DEFUN |bpSuchThat| ()
- (PROG () (RETURN (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|))))
+(DEFUN |bpSuchThat| () (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|))
-(DEFUN |bpWhile| ()
- (PROG () (RETURN (|bpAndOr| 'WHILE #'|bpLogical| #'|bfWhile|))))
+(DEFUN |bpWhile| () (|bpAndOr| 'WHILE #'|bpLogical| #'|bfWhile|))
-(DEFUN |bpUntil| ()
- (PROG () (RETURN (|bpAndOr| 'UNTIL #'|bpLogical| #'|bfUntil|))))
+(DEFUN |bpUntil| () (|bpAndOr| 'UNTIL #'|bpLogical| #'|bfUntil|))
(DEFUN |bpForIn| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'FOR) (OR (|bpVariable|) (|bpTrap|))
- (|bpCompMissing| 'IN)
- (OR (AND (OR (|bpSeg|) (|bpTrap|)) (|bpEqKey| 'BY)
- (OR (|bpArith|) (|bpTrap|))
- (|bpPush|
- (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|))))))))
+ (AND (|bpEqKey| 'FOR) (OR (|bpVariable|) (|bpTrap|))
+ (|bpCompMissing| 'IN)
+ (OR (AND (OR (|bpSeg|) (|bpTrap|)) (|bpEqKey| 'BY)
+ (OR (|bpArith|) (|bpTrap|))
+ (|bpPush|
+ (|bfForInBy| (|bpPop3|) (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfForin| (|bpPop2|) (|bpPop1|))))))
(DEFUN |bpSeg| ()
- (PROG ()
- (RETURN
- (AND (|bpArith|)
- (OR (AND (|bpEqKey| 'SEG)
- (OR (AND (|bpArith|)
- (|bpPush|
- (|bfSegment2| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfSegment1| (|bpPop1|)))))
- T)))))
+ (AND (|bpArith|)
+ (OR (AND (|bpEqKey| 'SEG)
+ (OR (AND (|bpArith|)
+ (|bpPush|
+ (|bfSegment2| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfSegment1| (|bpPop1|)))))
+ T)))
(DEFUN |bpIterator| ()
- (PROG ()
- (RETURN (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|)))))
+ (OR (|bpForIn|) (|bpSuchThat|) (|bpWhile|) (|bpUntil|)))
(DEFUN |bpIteratorList| ()
- (PROG ()
- (RETURN
- (AND (|bpOneOrMore| #'|bpIterator|)
- (|bpPush| (|bfIterators| (|bpPop1|)))))))
+ (AND (|bpOneOrMore| #'|bpIterator|)
+ (|bpPush| (|bfIterators| (|bpPop1|)))))
(DEFUN |bpCrossBackSet| ()
- (PROG ()
- (RETURN (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))))
+ (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))
(DEFUN |bpIterators| ()
- (PROG ()
- (RETURN
- (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))))
+ (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))
(DEFUN |bpAssign| ()
(PROG (|a|)
@@ -920,26 +772,20 @@
(#0# (|bpRestore| |a|) NIL))))))
(DEFUN |bpAssignment| ()
- (PROG ()
- (RETURN
- (AND (|bpAssignVariable|) (|bpEqKey| 'BEC)
- (OR (|bpAssign|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpAssignVariable|) (|bpEqKey| 'BEC)
+ (OR (|bpAssign|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpExit| ()
- (PROG ()
- (RETURN
- (AND (|bpAssign|)
- (OR (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|))
- (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|))))
- T)))))
+ (AND (|bpAssign|)
+ (OR (AND (|bpEqKey| 'EXIT) (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|bfExit| (|bpPop2|) (|bpPop1|))))
+ T)))
(DEFUN |bpBeginDefinition| ()
- (PROG ()
- (DECLARE (SPECIAL |$sawParenthesizedHead|))
- (RETURN
- (OR (|bpEqPeek| 'DEF)
- (AND |$sawParenthesizedHead| (|bpEqPeek| 'COLON))))))
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (OR (|bpEqPeek| 'DEF)
+ (AND |$sawParenthesizedHead| (|bpEqPeek| 'COLON))))
(DEFUN |bpDefinition| ()
(PROG (|a|)
@@ -958,75 +804,56 @@
(#0# (PROGN (|bpRestore| |a|) NIL)))))))
(DEFUN |bpStoreName| ()
- (PROG ()
- (DECLARE (SPECIAL |$bodyHasReturn| |$returnType| |$typings|
- |$wheredefs| |$op| |$stack|))
- (RETURN
- (PROGN
- (SETQ |$op| (CAR |$stack|))
- (SETQ |$wheredefs| NIL)
- (SETQ |$typings| NIL)
- (SETQ |$returnType| T)
- (SETQ |$bodyHasReturn| NIL)
- T))))
+ (DECLARE (SPECIAL |$bodyHasReturn| |$returnType| |$typings|
+ |$wheredefs| |$op| |$stack|))
+ (PROGN
+ (SETQ |$op| (CAR |$stack|))
+ (SETQ |$wheredefs| NIL)
+ (SETQ |$typings| NIL)
+ (SETQ |$returnType| T)
+ (SETQ |$bodyHasReturn| NIL)
+ T))
(DEFUN |bpReturnType| ()
- (PROG ()
- (DECLARE (SPECIAL |$returnType| |$sawParenthesizedHead|))
- (RETURN
- (COND
- ((AND |$sawParenthesizedHead| (|bpEqKey| 'COLON))
- (PROGN
- (OR (|bpApplication|) (|bpTrap|))
- (SETQ |$returnType| (|bpPop1|))
- T))
- ('T T)))))
+ (DECLARE (SPECIAL |$returnType| |$sawParenthesizedHead|))
+ (COND
+ ((AND |$sawParenthesizedHead| (|bpEqKey| 'COLON))
+ (PROGN
+ (OR (|bpApplication|) (|bpTrap|))
+ (SETQ |$returnType| (|bpPop1|))
+ T))
+ ('T T)))
(DEFUN |bpDef| ()
- (PROG ()
- (RETURN
- (AND (|bpName|) (|bpStoreName|) (|bpDefTail|)
- (|bpPush| (|bfCompDef| (|bpPop1|)))))))
+ (AND (|bpName|) (|bpStoreName|) (|bpDefTail|)
+ (|bpPush| (|bfCompDef| (|bpPop1|)))))
-(DEFUN |bpDDef| () (PROG () (RETURN (AND (|bpName|) (|bpDefTail|)))))
+(DEFUN |bpDDef| () (AND (|bpName|) (|bpDefTail|)))
(DEFUN |bpSimpleDefinitionTail| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
- (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpCompoundDefinitionTail| ()
- (PROG ()
- (RETURN
- (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF)
- (OR (|bpWhere|) (|bpTrap|))
- (|bpPush| (|bfDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF)
+ (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|bfDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpDefTail| ()
- (PROG ()
- (RETURN
- (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|)))))
+ (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|)))
(DEFUN |bpMDefTail| ()
- (PROG ()
- (RETURN
- (AND (OR (|bpVariable|) (|bpTrap|)) (|bpEqKey| 'MDEF)
- (OR (|bpWhere|) (|bpTrap|))
- (|bpPush|
- (|bfMDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))))
+ (AND (OR (|bpVariable|) (|bpTrap|)) (|bpEqKey| 'MDEF)
+ (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|bfMDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpMdef| ()
- (PROG () (RETURN (AND (|bpName|) (|bpStoreName|) (|bpMDefTail|)))))
+(DEFUN |bpMdef| () (AND (|bpName|) (|bpStoreName|) (|bpMDefTail|)))
(DEFUN |bpWhere| ()
- (PROG ()
- (RETURN
- (AND (|bpDefinition|)
- (OR (AND (|bpEqKey| 'WHERE)
- (OR (|bpDefinitionItem|) (|bpTrap|))
- (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|))))
- T)))))
+ (AND (|bpDefinition|)
+ (OR (AND (|bpEqKey| 'WHERE) (OR (|bpDefinitionItem|) (|bpTrap|))
+ (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|))))
+ T)))
(DEFUN |bpDefinitionItem| ()
(PROG (|a|)
@@ -1044,244 +871,185 @@
(#0# (|bpRestore| |a|) (|bpWhere|)))))))))))
(DEFUN |bpDefinitionPileItems| ()
- (PROG ()
- (RETURN
- (AND (|bpListAndRecover| #'|bpDefinitionItem|)
- (|bpPush| (|bfDefSequence| (|bpPop1|)))))))
+ (AND (|bpListAndRecover| #'|bpDefinitionItem|)
+ (|bpPush| (|bfDefSequence| (|bpPop1|)))))
(DEFUN |bpBDefinitionPileItems| ()
- (PROG () (RETURN (|bpPileBracketed| #'|bpDefinitionPileItems|))))
+ (|bpPileBracketed| #'|bpDefinitionPileItems|))
(DEFUN |bpSemiColonDefinition| ()
- (PROG ()
- (RETURN (|bpSemiListing| #'|bpDefinitionItem| #'|bfDefSequence|))))
+ (|bpSemiListing| #'|bpDefinitionItem| #'|bfDefSequence|))
(DEFUN |bpPDefinitionItems| ()
- (PROG () (RETURN (|bpParenthesized| #'|bpSemiColonDefinition|))))
+ (|bpParenthesized| #'|bpSemiColonDefinition|))
(DEFUN |bpComma| ()
- (PROG ()
- (RETURN (OR (|bpModule|) (|bpImport|) (|bpTuple| #'|bpWhere|)))))
+ (OR (|bpModule|) (|bpImport|) (|bpTuple| #'|bpWhere|)))
(DEFUN |bpTuple| (|p|)
- (PROG ()
- (RETURN (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|))))
+ (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|))
(DEFUN |bpCommaBackSet| ()
- (PROG ()
- (RETURN (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))))
+ (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpSemiColon| ()
- (PROG () (RETURN (|bpSemiListing| #'|bpComma| #'|bfSequence|))))
+(DEFUN |bpSemiColon| () (|bpSemiListing| #'|bpComma| #'|bfSequence|))
(DEFUN |bpSemiListing| (|p| |f|)
- (PROG () (RETURN (|bpListofFun| |p| #'|bpSemiBackSet| |f|))))
+ (|bpListofFun| |p| #'|bpSemiBackSet| |f|))
(DEFUN |bpSemiBackSet| ()
- (PROG ()
- (RETURN (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))))
+ (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))
-(DEFUN |bpPDefinition| ()
- (PROG () (RETURN (|bpIndentParenthesized| #'|bpSemiColon|))))
+(DEFUN |bpPDefinition| () (|bpIndentParenthesized| #'|bpSemiColon|))
(DEFUN |bpPileItems| ()
- (PROG ()
- (RETURN
- (AND (|bpListAndRecover| #'|bpSemiColon|)
- (|bpPush| (|bfSequence| (|bpPop1|)))))))
+ (AND (|bpListAndRecover| #'|bpSemiColon|)
+ (|bpPush| (|bfSequence| (|bpPop1|)))))
-(DEFUN |bpBPileDefinition| ()
- (PROG () (RETURN (|bpPileBracketed| #'|bpPileItems|))))
+(DEFUN |bpBPileDefinition| () (|bpPileBracketed| #'|bpPileItems|))
(DEFUN |bpIteratorTail| ()
- (PROG () (RETURN (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|)))))
+ (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|)))
-(DEFUN |bpConstruct| ()
- (PROG () (RETURN (|bpBracket| #'|bpConstruction|))))
+(DEFUN |bpConstruct| () (|bpBracket| #'|bpConstruction|))
(DEFUN |bpConstruction| ()
- (PROG ()
- (RETURN
- (AND (|bpComma|)
- (OR (AND (|bpIteratorTail|)
- (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfTupleConstruct| (|bpPop1|))))))))
+ (AND (|bpComma|)
+ (OR (AND (|bpIteratorTail|)
+ (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfTupleConstruct| (|bpPop1|))))))
-(DEFUN |bpDConstruct| ()
- (PROG () (RETURN (|bpBracket| #'|bpDConstruction|))))
+(DEFUN |bpDConstruct| () (|bpBracket| #'|bpDConstruction|))
(DEFUN |bpDConstruction| ()
- (PROG ()
- (RETURN
- (AND (|bpComma|)
- (OR (AND (|bpIteratorTail|)
- (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
- (|bpPush| (|bfDTuple| (|bpPop1|))))))))
+ (AND (|bpComma|)
+ (OR (AND (|bpIteratorTail|)
+ (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfDTuple| (|bpPop1|))))))
(DEFUN |bpPattern| ()
- (PROG ()
- (RETURN
- (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
- (|bpConstTok|)))))
+ (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|)))
(DEFUN |bpEqual| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'SHOEEQ)
- (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|))
- (|bpPush| (|bfEqual| (|bpPop1|)))))))
+ (AND (|bpEqKey| 'SHOEEQ)
+ (OR (|bpApplication|) (|bpConstTok|) (|bpTrap|))
+ (|bpPush| (|bfEqual| (|bpPop1|)))))
(DEFUN |bpRegularPatternItem| ()
- (PROG ()
- (RETURN
- (OR (|bpEqual|) (|bpConstTok|) (|bpDot|)
- (AND (|bpName|)
- (OR (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- T))
- (|bpBracketConstruct| #'|bpPatternL|)))))
+ (OR (|bpEqual|) (|bpConstTok|) (|bpDot|)
+ (AND (|bpName|)
+ (OR (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ T))
+ (|bpBracketConstruct| #'|bpPatternL|)))
(DEFUN |bpRegularPatternItemL| ()
- (PROG ()
- (RETURN
- (AND (|bpRegularPatternItem|) (|bpPush| (LIST (|bpPop1|)))))))
+ (AND (|bpRegularPatternItem|) (|bpPush| (LIST (|bpPop1|)))))
(DEFUN |bpRegularList| ()
- (PROG ()
- (RETURN
- (|bpListof| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))))
+ (|bpListof| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))
(DEFUN |bpPatternColon| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'COLON) (OR (|bpRegularPatternItem|) (|bpTrap|))
- (|bpPush| (LIST (|bfColon| (|bpPop1|))))))))
+ (AND (|bpEqKey| 'COLON) (OR (|bpRegularPatternItem|) (|bpTrap|))
+ (|bpPush| (LIST (|bfColon| (|bpPop1|))))))
(DEFUN |bpPatternL| ()
- (PROG ()
- (RETURN (AND (|bpPatternList|) (|bpPush| (|bfTuple| (|bpPop1|)))))))
+ (AND (|bpPatternList|) (|bpPush| (|bfTuple| (|bpPop1|)))))
(DEFUN |bpPatternList| ()
- (PROG ()
- (RETURN
- (COND
- ((|bpRegularPatternItemL|)
- (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|))))))
+ (COND
+ ((|bpRegularPatternItemL|)
+ (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|))))
(DEFUN |bpPatternTail| ()
- (PROG ()
- (RETURN
- (AND (|bpPatternColon|)
- (OR (AND (|bpEqKey| 'COMMA)
- (OR (|bpRegularList|) (|bpTrap|))
- (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))
- T)))))
+ (AND (|bpPatternColon|)
+ (OR (AND (|bpEqKey| 'COMMA) (OR (|bpRegularList|) (|bpTrap|))
+ (|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))
+ T)))
(DEFUN |bpRegularBVItem| ()
- (PROG ()
- (RETURN
- (OR (|bpBVString|) (|bpConstTok|)
- (AND (|bpName|)
- (OR (AND (|bpEqKey| 'COLON)
- (OR (|bpApplication|) (|bpTrap|))
- (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- T))
- (|bpBracketConstruct| #'|bpPatternL|)))))
+ (OR (|bpBVString|) (|bpConstTok|)
+ (AND (|bpName|)
+ (OR (AND (|bpEqKey| 'COLON)
+ (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ T))
+ (|bpBracketConstruct| #'|bpPatternL|)))
(DEFUN |bpBVString| ()
- (PROG ()
- (DECLARE (SPECIAL |$ttok| |$stok|))
- (RETURN
- (AND (EQ (|shoeTokType| |$stok|) 'STRING)
- (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (AND (EQ (|shoeTokType| |$stok|) 'STRING)
+ (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))
(DEFUN |bpRegularBVItemL| ()
- (PROG ()
- (RETURN (AND (|bpRegularBVItem|) (|bpPush| (LIST (|bpPop1|)))))))
+ (AND (|bpRegularBVItem|) (|bpPush| (LIST (|bpPop1|)))))
(DEFUN |bpColonName| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'COLON)
- (OR (|bpName|) (|bpBVString|) (|bpTrap|))))))
+ (AND (|bpEqKey| 'COLON) (OR (|bpName|) (|bpBVString|) (|bpTrap|))))
(DEFUN |bpBoundVariablelist| ()
- (PROG ()
- (RETURN
- (COND
- ((|bpRegularBVItemL|)
- (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|)
- (|bpPush| (|bfColonAppend| NIL (|bpPop1|)))))))))
+ (COND
+ ((|bpRegularBVItemL|)
+ (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|) (|bpPush| (|bfColonAppend| NIL (|bpPop1|)))))))
(DEFUN |bpBeginParameterList| ()
- (PROG ()
- (DECLARE (SPECIAL |$sawParenthesizedHead|))
- (RETURN (PROGN (SETQ |$sawParenthesizedHead| NIL) T))))
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (PROGN (SETQ |$sawParenthesizedHead| NIL) T))
(DEFUN |bpEndParameterList| ()
- (PROG ()
- (DECLARE (SPECIAL |$sawParenthesizedHead|))
- (RETURN (SETQ |$sawParenthesizedHead| T))))
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (SETQ |$sawParenthesizedHead| T))
(DEFUN |bpVariable| ()
- (PROG ()
- (RETURN
- (OR (AND (|bpBeginParameterList|)
- (|bpParenthesized| #'|bpBoundVariablelist|)
- (|bpPush| (|bfTupleIf| (|bpPop1|)))
- (|bpEndParameterList|))
- (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
- (|bpConstTok|)))))
+ (OR (AND (|bpBeginParameterList|)
+ (|bpParenthesized| #'|bpBoundVariablelist|)
+ (|bpPush| (|bfTupleIf| (|bpPop1|))) (|bpEndParameterList|))
+ (|bpBracketConstruct| #'|bpPatternL|) (|bpName|) (|bpConstTok|)))
(DEFUN |bpAssignVariable| ()
- (PROG ()
- (RETURN
- (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpAssignLHS|)))))
+ (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpAssignLHS|)))
(DEFUN |bpAssignLHS| ()
- (PROG ()
- (RETURN
- (AND (|bpName|)
- (OR (AND (|bpEqKey| 'COLON)
- (OR (|bpApplication|) (|bpTrap|))
- (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'DOT)
- (|bpList| #'|bpPrimary| 'DOT #'|bfListOf|)
- (|bpChecknull|)
- (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|)))))
- T)))))
+ (AND (|bpName|)
+ (OR (AND (|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'DOT)
+ (|bpList| #'|bpPrimary| 'DOT #'|bfListOf|)
+ (|bpChecknull|)
+ (|bpPush| (|bfTuple| (CONS (|bpPop2|) (|bpPop1|)))))
+ T)))
(DEFUN |bpChecknull| ()
(PROG (|a|)
@@ -1291,52 +1059,38 @@
(COND ((NULL |a|) (|bpTrap|)) ('T (|bpPush| |a|)))))))
(DEFUN |bpStruct| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'STRUCTURE) (OR (|bpName|) (|bpTrap|))
- (OR (|bpEqKey| 'DEF) (|bpTrap|)) (|bpTypeList|)
- (|bpPush| (|bfStruct| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpEqKey| 'STRUCTURE) (OR (|bpName|) (|bpTrap|))
+ (OR (|bpEqKey| 'DEF) (|bpTrap|)) (|bpTypeList|)
+ (|bpPush| (|bfStruct| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpTypeList| ()
- (PROG ()
- (RETURN
- (OR (|bpPileBracketed| #'|bpTypeItemList|)
- (AND (|bpTerm|) (|bpPush| (LIST (|bpPop1|))))))))
+ (OR (|bpPileBracketed| #'|bpTypeItemList|)
+ (AND (|bpTerm|) (|bpPush| (LIST (|bpPop1|))))))
-(DEFUN |bpTypeItemList| ()
- (PROG () (RETURN (|bpListAndRecover| #'|bpTerm|))))
+(DEFUN |bpTypeItemList| () (|bpListAndRecover| #'|bpTerm|))
(DEFUN |bpTerm| ()
- (PROG ()
- (RETURN
- (OR (AND (OR (|bpName|) (|bpTrap|))
- (OR (AND (|bpParenthesized| #'|bpIdList|)
- (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
- (AND (|bpName|)
- (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
- (|bpPush| (|bfNameOnly| (|bpPop1|)))))))
+ (OR (AND (OR (|bpName|) (|bpTrap|))
+ (OR (AND (|bpParenthesized| #'|bpIdList|)
+ (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpName|)
+ (|bpPush| (|bfNameArgs| (|bpPop2|) (|bpPop1|))))))
+ (|bpPush| (|bfNameOnly| (|bpPop1|)))))
-(DEFUN |bpIdList| () (PROG () (RETURN (|bpTuple| #'|bpName|))))
+(DEFUN |bpIdList| () (|bpTuple| #'|bpName|))
(DEFUN |bpCase| ()
- (PROG ()
- (RETURN
- (AND (|bpEqKey| 'CASE) (OR (|bpWhere|) (|bpTrap|))
- (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems|)))))
+ (AND (|bpEqKey| 'CASE) (OR (|bpWhere|) (|bpTrap|))
+ (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems|)))
(DEFUN |bpPiledCaseItems| ()
- (PROG ()
- (RETURN
- (AND (|bpPileBracketed| #'|bpCaseItemList|)
- (|bpPush| (|bfCase| (|bpPop2|) (|bpPop1|)))))))
+ (AND (|bpPileBracketed| #'|bpCaseItemList|)
+ (|bpPush| (|bfCase| (|bpPop2|) (|bpPop1|)))))
-(DEFUN |bpCaseItemList| ()
- (PROG () (RETURN (|bpListAndRecover| #'|bpCaseItem|))))
+(DEFUN |bpCaseItemList| () (|bpListAndRecover| #'|bpCaseItem|))
(DEFUN |bpCaseItem| ()
- (PROG ()
- (RETURN
- (AND (OR (|bpTerm|) (|bpTrap|)) (OR (|bpEqKey| 'EXIT) (|bpTrap|))
- (OR (|bpWhere|) (|bpTrap|))
- (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))))
+ (AND (OR (|bpTerm|) (|bpTrap|)) (OR (|bpEqKey| 'EXIT) (|bpTrap|))
+ (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp
index caa56d3e..a0f6d6db 100644
--- a/src/boot/strap/pile.clisp
+++ b/src/boot/strap/pile.clisp
@@ -6,14 +6,11 @@
(IN-PACKAGE "BOOTTRAN")
-(DEFUN |shoeFirstTokPosn| (|t|)
- (PROG () (RETURN (|shoeTokPosn| (CAAR |t|)))))
+(DEFUN |shoeFirstTokPosn| (|t|) (|shoeTokPosn| (CAAR |t|)))
-(DEFUN |shoeLastTokPosn| (|t|)
- (PROG () (RETURN (|shoeTokPosn| (CADR |t|)))))
+(DEFUN |shoeLastTokPosn| (|t|) (|shoeTokPosn| (CADR |t|)))
-(DEFUN |shoePileColumn| (|t|)
- (PROG () (RETURN (CDR (|shoeTokPosn| (CAAR |t|))))))
+(DEFUN |shoePileColumn| (|t|) (CDR (|shoeTokPosn| (CAAR |t|))))
(DEFUN |shoePileInsert| (|s|)
(PROG (|a| |toktype|)
@@ -95,7 +92,7 @@
('T (|shoePileForests| (|shoePileCtree| |h| |h1|) |n| |t1|)))))))
(DEFUN |shoePileCtree| (|x| |y|)
- (PROG () (RETURN (|dqAppend| |x| (|shoePileCforest| |y|)))))
+ (|dqAppend| |x| (|shoePileCforest| |y|)))
(DEFUN |shoePileCforest| (|x|)
(PROG (|b| |a|)
@@ -142,13 +139,12 @@
(LIST |a| |semicolon| (|shoeSeparatePiles| (CDR |x|)))))))))
(DEFUN |shoeEnPile| (|x|)
- (PROG ()
- (RETURN
- (|dqConcat| (LIST (|dqUnit|
- (|shoeTokConstruct| 'KEY 'SETTAB
- (|shoeFirstTokPosn| |x|)))
- |x|
- (|dqUnit|
- (|shoeTokConstruct| 'KEY 'BACKTAB
- (|shoeLastTokPosn| |x|))))))))
+ (|dqConcat|
+ (LIST (|dqUnit|
+ (|shoeTokConstruct| 'KEY 'SETTAB
+ (|shoeFirstTokPosn| |x|)))
+ |x|
+ (|dqUnit|
+ (|shoeTokConstruct| 'KEY 'BACKTAB
+ (|shoeLastTokPosn| |x|))))))
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 50078c3d..2689a8bf 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -6,42 +6,35 @@
(IN-PACKAGE "BOOTTRAN")
-(DEFUN |double| (|x|) (PROG () (RETURN (FLOAT |x| 1.0))))
+(DEFUN |double| (|x|) (FLOAT |x| 1.0))
(DEFUN |dqUnit| (|s|)
(PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|)))))
(DEFUN |dqAppend| (|x| |y|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |x|) |y|)
- ((NULL |y|) |x|)
- ('T (RPLACD (CDR |x|) (CAR |y|)) (RPLACD |x| (CDR |y|)) |x|)))))
+ (COND
+ ((NULL |x|) |y|)
+ ((NULL |y|) |x|)
+ ('T (RPLACD (CDR |x|) (CAR |y|)) (RPLACD |x| (CDR |y|)) |x|)))
(DEFUN |dqConcat| (|ld|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |ld|) NIL)
- ((NULL (CDR |ld|)) (CAR |ld|))
- ('T (|dqAppend| (CAR |ld|) (|dqConcat| (CDR |ld|))))))))
+ (COND
+ ((NULL |ld|) NIL)
+ ((NULL (CDR |ld|)) (CAR |ld|))
+ ('T (|dqAppend| (CAR |ld|) (|dqConcat| (CDR |ld|))))))
-(DEFUN |dqToList| (|s|)
- (PROG () (RETURN (COND ((NULL |s|) NIL) ('T (CAR |s|))))))
+(DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) ('T (CAR |s|))))
(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|)
- (PROG ()
- (RETURN (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))))
+ (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))
-(DEFUN |shoeTokType| (|x|) (PROG () (RETURN (CAR |x|))))
+(DEFUN |shoeTokType| (|x|) (CAR |x|))
-(DEFUN |shoeTokPart| (|x|) (PROG () (RETURN (CADR |x|))))
+(DEFUN |shoeTokPart| (|x|) (CADR |x|))
-(DEFUN |shoeTokPosn| (|x|) (PROG () (RETURN (CDDR |x|))))
+(DEFUN |shoeTokPosn| (|x|) (CDDR |x|))
-(DEFUN |shoeTokConstruct| (|x| |y| |z|)
- (PROG () (RETURN (CONS |x| (CONS |y| |z|)))))
+(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|)))
(DEFUN |shoeNextLine| (|s|)
(PROG (|s1| |a|)
@@ -171,8 +164,7 @@
(#0# (|shoeAccumulateLines| |$r| |string|)))))
(#0# (CONS |s| |string|)))))))))
-(DEFUN |shoeCloser| (|t|)
- (PROG () (RETURN (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))))
+(DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
(DEFUN |shoeToken| ()
(PROG (|b| |ch| |n| |linepos| |c| |ln|)
@@ -204,13 +196,11 @@
(#0#
(|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|))))))))
-(DEFUN |shoeLeafId| (|x|) (PROG () (RETURN (LIST 'ID (INTERN |x|)))))
+(DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|)))
-(DEFUN |shoeLeafKey| (|x|)
- (PROG () (RETURN (LIST 'KEY (|shoeKeyWord| |x|)))))
+(DEFUN |shoeLeafKey| (|x|) (LIST 'KEY (|shoeKeyWord| |x|)))
-(DEFUN |shoeLeafInteger| (|x|)
- (PROG () (RETURN (LIST 'INTEGER (|shoeIntValue| |x|)))))
+(DEFUN |shoeLeafInteger| (|x|) (LIST 'INTEGER (|shoeIntValue| |x|)))
(DEFUN |shoeLeafFloat| (|a| |w| |e|)
(PROG (|c| |b|)
@@ -222,22 +212,21 @@
(EXPT (|double| 10) (- |e| (LENGTH |w|)))))
(LIST 'FLOAT |c|)))))
-(DEFUN |shoeLeafString| (|x|) (PROG () (RETURN (LIST 'STRING |x|))))
+(DEFUN |shoeLeafString| (|x|) (LIST 'STRING |x|))
-(DEFUN |shoeLeafLisp| (|x|) (PROG () (RETURN (LIST 'LISP |x|))))
+(DEFUN |shoeLeafLisp| (|x|) (LIST 'LISP |x|))
-(DEFUN |shoeLeafLispExp| (|x|) (PROG () (RETURN (LIST 'LISPEXP |x|))))
+(DEFUN |shoeLeafLispExp| (|x|) (LIST 'LISPEXP |x|))
-(DEFUN |shoeLeafLine| (|x|) (PROG () (RETURN (LIST 'LINE |x|))))
+(DEFUN |shoeLeafLine| (|x|) (LIST 'LINE |x|))
-(DEFUN |shoeLeafComment| (|x|) (PROG () (RETURN (LIST 'COMMENT |x|))))
+(DEFUN |shoeLeafComment| (|x|) (LIST 'COMMENT |x|))
-(DEFUN |shoeLeafNegComment| (|x|)
- (PROG () (RETURN (LIST 'NEGCOMMENT |x|))))
+(DEFUN |shoeLeafNegComment| (|x|) (LIST 'NEGCOMMENT |x|))
-(DEFUN |shoeLeafError| (|x|) (PROG () (RETURN (LIST 'ERROR |x|))))
+(DEFUN |shoeLeafError| (|x|) (LIST 'ERROR |x|))
-(DEFUN |shoeLeafSpaces| (|x|) (PROG () (RETURN (LIST 'SPACES |x|))))
+(DEFUN |shoeLeafSpaces| (|x|) (LIST 'SPACES |x|))
(DEFUN |shoeLispEscape| ()
(PROG (|n| |exp| |a|)
@@ -353,26 +342,21 @@
(|shoeKeyTr| |sss|)))))
(DEFUN |shoeKeyTr| (|w|)
- (PROG ()
- (DECLARE (SPECIAL |$floatok|))
- (RETURN
- (COND
- ((EQ (|shoeKeyWord| |w|) 'DOT)
- (COND
- (|$floatok| (|shoePossFloat| |w|))
- (#0='T (|shoeLeafKey| |w|))))
- (#0# (SETQ |$floatok| (NULL (|shoeCloser| |w|)))
- (|shoeLeafKey| |w|))))))
+ (DECLARE (SPECIAL |$floatok|))
+ (COND
+ ((EQ (|shoeKeyWord| |w|) 'DOT)
+ (COND
+ (|$floatok| (|shoePossFloat| |w|))
+ (#0='T (|shoeLeafKey| |w|))))
+ (#0# (SETQ |$floatok| (NULL (|shoeCloser| |w|)))
+ (|shoeLeafKey| |w|))))
(DEFUN |shoePossFloat| (|w|)
- (PROG ()
- (DECLARE (SPECIAL |$ln| |$sz| |$n|))
- (RETURN
- (COND
- ((OR (NOT (< |$n| |$sz|))
- (NULL (|shoeDigit| (ELT |$ln| |$n|))))
- (|shoeLeafKey| |w|))
- ('T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (COND
+ ((OR (NOT (< |$n| |$sz|)) (NULL (|shoeDigit| (ELT |$ln| |$n|))))
+ (|shoeLeafKey| |w|))
+ ('T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))
(DEFUN |shoeSpace| ()
(PROG (|n|)
@@ -387,13 +371,11 @@
('T (|shoeLeafSpaces| (- |$n| |n|))))))))
(DEFUN |shoeString| ()
- (PROG ()
- (DECLARE (SPECIAL |$floatok| |$n|))
- (RETURN
- (PROGN
- (SETQ |$n| (+ |$n| 1))
- (SETQ |$floatok| NIL)
- (|shoeLeafString| (|shoeS|))))))
+ (DECLARE (SPECIAL |$floatok| |$n|))
+ (PROGN
+ (SETQ |$n| (+ |$n| 1))
+ (SETQ |$floatok| NIL)
+ (|shoeLeafString| (|shoeS|))))
(DEFUN |shoeS| ()
(PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
@@ -422,18 +404,16 @@
(CONCAT |str| |b|))))))))
(DEFUN |shoeIdEnd| (|line| |n|)
- (PROG ()
- (RETURN
- (PROGN
- (LOOP
- (COND
- ((NOT (AND (< |n| (LENGTH |line|))
- (|shoeIdChar| (ELT |line| |n|))))
- (RETURN NIL))
- ('T (SETQ |n| (+ |n| 1)))))
- |n|))))
+ (PROGN
+ (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|))))
+(DEFUN |shoeDigit| (|x|) (DIGIT-CHAR-P |x|))
(DEFUN |shoeW| (|b|)
(PROG (|bb| |a| |str| |endid| |l| |n1|)
@@ -468,7 +448,7 @@
(|shoeLeafKey| |w|))
('T (|shoeLeafId| |w|)))))))
-(DEFUN |shoeInteger| () (PROG () (RETURN (|shoeInteger1| NIL))))
+(DEFUN |shoeInteger| () (|shoeInteger1| NIL))
(DEFUN |shoeInteger1| (|zro|)
(PROG (|bb| |a| |str| |l| |n|)
@@ -575,16 +555,15 @@
" is not a Boot character"))
(|shoeLeafError| (ELT |$ln| |n|))))))
-(DEFUN |shoeOrdToNum| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|))))
+(DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|))
-(DEFUN |shoeKeyWord| (|st|)
- (PROG () (RETURN (GETHASH |st| |shoeKeyTable|))))
+(DEFUN |shoeKeyWord| (|st|) (GETHASH |st| |shoeKeyTable|))
(DEFUN |shoeKeyWordP| (|st|)
- (PROG () (RETURN (NULL (NULL (GETHASH |st| |shoeKeyTable|))))))
+ (NULL (NULL (GETHASH |st| |shoeKeyTable|))))
(DEFUN |shoeMatch| (|l| |i|)
- (PROG () (RETURN (|shoeSubStringMatch| |l| |shoeDict| |i|))))
+ (|shoeSubStringMatch| |l| |shoeDict| |i|))
(DEFUN |shoeSubStringMatch| (|l| |d| |i|)
(PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
@@ -621,6 +600,5 @@
(SETQ |j| (+ |j| 1))))
|s1|))))
-(DEFUN |shoePunctuation| (|c|)
- (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1))))
+(DEFUN |shoePunctuation| (|c|) (EQL (ELT |shoePun| |c|) 1))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 3ce6a7c8..a837e88b 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -151,202 +151,184 @@
(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|)))))))
+ (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)
- (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|)))))))
+ (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
- (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|)))))))
+ (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
- (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|)))))))
+ (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
- (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|)))))))
+ (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
- (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|)))))))
+ (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
- (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|)))))))
+ (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|)))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 2d480526..e05baa29 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -15,31 +15,24 @@
(DEFPARAMETER |$translatingOldBoot| NIL)
(DEFUN |AxiomCore|::|%sysInit| ()
- (PROG ()
- (DECLARE (SPECIAL |$translatingOldBoot|))
- (RETURN
- (COND
- ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|)))
- "old")
- (SETQ |$translatingOldBoot| T))))))
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (COND
+ ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|))) "old")
+ (SETQ |$translatingOldBoot| T))))
-(DEFUN |setCurrentPackage| (|x|)
- (PROG () (RETURN (SETQ *PACKAGE* |x|))))
+(DEFUN |setCurrentPackage| (|x|) (SETQ *PACKAGE* |x|))
(DEFUN |shoeCOMPILE-FILE| (|lspFileName|)
- (PROG () (RETURN (COMPILE-FILE |lspFileName|))))
+ (COMPILE-FILE |lspFileName|))
-(DEFUN BOOTTOCL (|fn| |out|)
- (PROG () (RETURN (BOOTTOCLLINES NIL |fn| |out|))))
+(DEFUN BOOTTOCL (|fn| |out|) (BOOTTOCLLINES NIL |fn| |out|))
(DEFUN BOOTCLAM (|fn| |out|)
- (PROG ()
- (DECLARE (SPECIAL |$bfClamming|))
- (RETURN
- (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
+ (DECLARE (SPECIAL |$bfClamming|))
+ (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))
(DEFUN BOOTCLAMLINES (|lines| |fn| |out|)
- (PROG () (RETURN (BOOTTOCLLINES |lines| |fn| |out|))))
+ (BOOTTOCLLINES |lines| |fn| |out|))
(DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|)
(PROG (|result| |infn| |callingPackage|)
@@ -75,8 +68,7 @@
(|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
|outfn|)))))
-(DEFUN BOOTTOCLC (|fn| |out|)
- (PROG () (RETURN (BOOTTOCLCLINES NIL |fn| |out|))))
+(DEFUN BOOTTOCLC (|fn| |out|) (BOOTTOCLCLINES NIL |fn| |out|))
(DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
(PROG (|result| |infn| |callingPackage|)
@@ -130,12 +122,10 @@
|result|))))
(DEFUN |shoeMc| (|a| |fn|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- ('T (|shoePCompileTrees| (|shoeTransformStream| |a|))
- (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))))
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (|shoePCompileTrees| (|shoeTransformStream| |a|))
+ (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))
(DEFUN EVAL-BOOT-FILE (|fn|)
(PROG (|outfn| |infn| |b|)
@@ -182,17 +172,15 @@
|result|))))
(DEFUN |shoeToConsole| (|a| |fn|)
- (PROG ()
- (RETURN
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- ('T
- (|shoeConsoleTrees|
- (|shoeTransformToConsole|
- (|shoeInclude|
- (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))))))))
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T
+ (|shoeConsoleTrees|
+ (|shoeTransformToConsole|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))))))
-(DEFUN STOUT (|string|) (PROG () (RETURN (PSTOUT (LIST |string|)))))
+(DEFUN STOUT (|string|) (PSTOUT (LIST |string|)))
(DEFUN STEVAL (|string|)
(PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|)
@@ -232,12 +220,10 @@
|result|))))
(DEFUN |shoeCompileTrees| (|s|)
- (PROG ()
- (RETURN
- (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|)
@@ -259,33 +245,24 @@
('T (EVAL |fn|))))))
(DEFUN |shoeTransform| (|str|)
- (PROG ()
- (RETURN
- (|bNext| #'|shoeTreeConstruct|
- (|bNext| #'|shoePileInsert|
- (|bNext| #'|shoeLineToks| |str|))))))
+ (|bNext| #'|shoeTreeConstruct|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))
(DEFUN |shoeTransformString| (|s|)
- (PROG ()
- (RETURN
- (|shoeTransform|
- (|shoeInclude| (|bAddLineNumber| |s| (|bIgen| 0)))))))
+ (|shoeTransform| (|shoeInclude| (|bAddLineNumber| |s| (|bIgen| 0)))))
(DEFUN |shoeTransformStream| (|s|)
- (PROG () (RETURN (|shoeTransformString| (|bRgen| |s|)))))
+ (|shoeTransformString| (|bRgen| |s|)))
(DEFUN |shoeTransformToConsole| (|str|)
- (PROG ()
- (RETURN
- (|bNext| #'|shoeConsoleItem|
- (|bNext| #'|shoePileInsert|
- (|bNext| #'|shoeLineToks| |str|))))))
+ (|bNext| #'|shoeConsoleItem|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))
(DEFUN |shoeTransformToFile| (|fn| |str|)
- (PROG ()
- (RETURN
- (|bFileNext| |fn|
- (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))))
+ (|bFileNext| |fn|
+ (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))
(DEFUN |shoeConsoleItem| (|str|)
(PROG (|dq|)
@@ -296,7 +273,7 @@
(CONS (|shoeParseTrees| |dq|) (CDR |str|))))))
(DEFUN |bFileNext| (|fn| |s|)
- (PROG () (RETURN (|bDelay| #'|bFileNext1| (LIST |fn| |s|)))))
+ (|bDelay| #'|bFileNext1| (LIST |fn| |s|)))
(DEFUN |bFileNext1| (|fn| |s|)
(PROG (|dq|)
@@ -318,7 +295,7 @@
(COND ((NULL |toklist|) NIL) ('T (|shoeOutParse| |toklist|)))))))
(DEFUN |shoeTreeConstruct| (|str|)
- (PROG () (RETURN (CONS (|shoeParseTrees| (CAR |str|)) (CDR |str|)))))
+ (CONS (|shoeParseTrees| (CAR |str|)) (CDR |str|)))
(DEFUN |shoeDQlines| (|dq|)
(PROG (|b| |a|)
@@ -330,45 +307,39 @@
(CAR (|shoeFirstTokPosn| |dq|)))))))
(DEFUN |streamTake| (|n| |s|)
- (PROG ()
- (RETURN
- (COND
- ((|bStreamNull| |s|) NIL)
- ((EQL |n| 0) NIL)
- ('T (CONS (CAR |s|) (|streamTake| (- |n| 1) (CDR |s|))))))))
+ (COND
+ ((|bStreamNull| |s|) NIL)
+ ((EQL |n| 0) NIL)
+ ('T (CONS (CAR |s|) (|streamTake| (- |n| 1) (CDR |s|))))))
(DEFUN |shoeFileLines| (|lines| |fn|)
- (PROG ()
- (RETURN
- (PROGN
- (|shoeFileLine| " " |fn|)
- (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|)))))
+ (PROGN
+ (|shoeFileLine| " " |fn|)
+ (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|)
- (PROG ()
- (RETURN
- (PROGN
- (|shoeConsole| " ")
- (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| " ")))))
+ (PROGN
+ (|shoeConsole| " ")
+ (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|)
- (PROG () (RETURN (PROGN (WRITE-LINE |x| |stream|) |x|))))
+ (PROGN (WRITE-LINE |x| |stream|) |x|))
(DEFUN |shoeFileTrees| (|s| |st|)
(PROG (|a|)
@@ -385,7 +356,7 @@
(SETQ |s| (CDR |s|)))))))))
(DEFUN |shoePPtoFile| (|x| |stream|)
- (PROG () (RETURN (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))))
+ (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))
(DEFUN |shoeConsoleTrees| (|s|)
(PROG (|fn|)
@@ -401,8 +372,7 @@
(REALLYPRETTYPRINT |fn|)
(SETQ |s| (CDR |s|)))))))))
-(DEFUN |shoeAddComment| (|l|)
- (PROG () (RETURN (CONCAT "; " (CAR |l|)))))
+(DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))
(DEFUN |genImportDeclaration| (|op| |sig|)
(PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
@@ -496,8 +466,31 @@
|n|))))
('T (LIST 'DECLAIM (LIST 'TYPE |t| |n|)))))))
+(DEFUN |translateToplevelExpression| (|expr|)
+ (PROG (|expr'|)
+ (RETURN
+ (PROGN
+ (SETQ |expr'|
+ (CDR (CDR (|shoeCompTran|
+ (LIST 'LAMBDA (LIST '|x|) |expr|)))))
+ (LET ((|bfVar#5| |expr'|) (|t| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#5|)
+ (PROGN (SETQ |t| (CAR |bfVar#5|)) NIL))
+ (RETURN NIL))
+ ('T
+ (COND
+ ((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE))
+ (IDENTITY (RPLACA |t| 'DECLAIM))))))
+ (SETQ |bfVar#5| (CDR |bfVar#5|))))
+ (|shoeEVALANDFILEACTQ|
+ (COND
+ ((< 1 (LENGTH |expr'|)) (CONS 'PROGN |expr'|))
+ ('T (CAR |expr'|))))))))
+
(DEFUN |bpOutItem| ()
- (PROG (|bfVar#6| |bfVar#5| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
+ (PROG (|bfVar#7| |bfVar#6| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
(DECLARE (SPECIAL |$op|))
(RETURN
(PROGN
@@ -521,47 +514,41 @@
(|bpPush| (LIST (LIST 'DEFPARAMETER |l| |r|))))
('T
(PROGN
- (SETQ |bfVar#5| |b|)
- (SETQ |bfVar#6| (CDR |bfVar#5|))
- (CASE (CAR |bfVar#5|)
+ (SETQ |bfVar#6| |b|)
+ (SETQ |bfVar#7| (CDR |bfVar#6|))
+ (CASE (CAR |bfVar#6|)
(|Signature|
- (LET ((|op| (CAR |bfVar#6|)) (|t| (CADR |bfVar#6|)))
+ (LET ((|op| (CAR |bfVar#7|)) (|t| (CADR |bfVar#7|)))
(|bpPush| (LIST (|genDeclaration| |op| |t|)))))
(|Module|
- (LET ((|m| (CAR |bfVar#6|)))
+ (LET ((|m| (CAR |bfVar#7|)))
(|bpPush|
(LIST (|shoeCompileTimeEvaluation|
(LIST 'PROVIDE |m|))))))
(|Import|
- (LET ((|m| (CAR |bfVar#6|)))
+ (LET ((|m| (CAR |bfVar#7|)))
(|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
(|ImportSignature|
- (LET ((|x| (CAR |bfVar#6|))
- (|sig| (CADR |bfVar#6|)))
+ (LET ((|x| (CAR |bfVar#7|))
+ (|sig| (CADR |bfVar#7|)))
(|bpPush|
(LIST (|genImportDeclaration| |x| |sig|)))))
(|TypeAlias|
- (LET ((|t| (CAR |bfVar#6|))
- (|args| (CADR |bfVar#6|))
- (|rhs| (CADDR |bfVar#6|)))
+ (LET ((|t| (CAR |bfVar#7|))
+ (|args| (CADR |bfVar#7|))
+ (|rhs| (CADDR |bfVar#7|)))
(|bpPush|
(LIST (LIST 'DEFTYPE |t| |args|
(LIST 'QUOTE |rhs|))))))
(|ConstantDefinition|
- (LET ((|n| (CAR |bfVar#6|)) (|e| (CADR |bfVar#6|)))
+ (LET ((|n| (CAR |bfVar#7|)) (|e| (CADR |bfVar#7|)))
(|bpPush| (LIST (LIST 'DEFCONSTANT |n| |e|)))))
- (T (PROGN
- (SETQ |b|
- (|shoeCompTran|
- (LIST 'LAMBDA (LIST '|x|) |b|)))
- (|bpPush|
- (LIST (|shoeEVALANDFILEACTQ| (CADDR |b|))))))))))))))
+ (T (|bpPush| (LIST (|translateToplevelExpression| |b|))))))))))))
-(DEFUN |shoeAddbootIfNec| (|s|)
- (PROG () (RETURN (|shoeAddStringIfNec| ".boot" |s|))))
+(DEFUN |shoeAddbootIfNec| (|s|) (|shoeAddStringIfNec| ".boot" |s|))
(DEFUN |shoeRemovebootIfNec| (|s|)
- (PROG () (RETURN (|shoeRemoveStringIfNec| ".boot" |s|))))
+ (|shoeRemoveStringIfNec| ".boot" |s|))
(DEFUN |shoeAddStringIfNec| (|str| |s|)
(PROG (|a|)
@@ -612,17 +599,17 @@
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
(SETQ |a|
- (LET ((|bfVar#8| NIL) (|bfVar#7| (HKEYS |$bootDefined|))
+ (LET ((|bfVar#9| NIL) (|bfVar#8| (HKEYS |$bootDefined|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#7|)
- (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
- (RETURN (NREVERSE |bfVar#8|)))
+ ((OR (ATOM |bfVar#8|)
+ (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
+ (RETURN (NREVERSE |bfVar#9|)))
(#0='T
(AND (NULL (GETHASH |i| |$bootUsed|))
- (SETQ |bfVar#8| (CONS |i| |bfVar#8|)))))
- (SETQ |bfVar#7| (CDR |bfVar#7|)))))
+ (SETQ |bfVar#9| (CONS |i| |bfVar#9|)))))
+ (SETQ |bfVar#8| (CDR |bfVar#8|)))))
(|bootOut| (SSORT |a|) |stream|)
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "DEFINED TWICE" |stream|)
@@ -630,37 +617,35 @@
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "USED and not DEFINED" |stream|)
(SETQ |a|
- (LET ((|bfVar#10| NIL) (|bfVar#9| (HKEYS |$bootUsed|))
+ (LET ((|bfVar#11| NIL) (|bfVar#10| (HKEYS |$bootUsed|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#9|)
- (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
- (RETURN (NREVERSE |bfVar#10|)))
+ ((OR (ATOM |bfVar#10|)
+ (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
+ (RETURN (NREVERSE |bfVar#11|)))
(#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))
+ (SETQ |bfVar#11| (CONS |i| |bfVar#11|)))))
+ (SETQ |bfVar#10| (CDR |bfVar#10|)))))
+ (LET ((|bfVar#12| (SSORT |a|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#11|)
- (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |i| (CAR |bfVar#12|)) 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|))))))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
(DEFUN |shoeDefUse| (|s|)
- (PROG ()
- (RETURN
- (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|
@@ -751,16 +736,16 @@
(#1# (CONS |nee| |$bootDefinedTwice|)))))
('T (HPUT |$bootDefined| |nee| T)))
(|defuse1| |e| |niens|)
- (LET ((|bfVar#12| |$used|) (|i| NIL))
+ (LET ((|bfVar#13| |$used|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#12|)
- (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ ((OR (ATOM |bfVar#13|)
+ (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
(RETURN NIL))
('T
(HPUT |$bootUsed| |i|
(CONS |nee| (GETHASH |i| |$bootUsed|)))))
- (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
+ (SETQ |bfVar#13| (CDR |bfVar#13|))))))))
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
@@ -798,14 +783,14 @@
(SETQ |LETTMP#1| (|defSeparate| |a|))
(SETQ |dol| (CAR |LETTMP#1|))
(SETQ |ndol| (CADR |LETTMP#1|))
- (LET ((|bfVar#13| |dol|) (|i| NIL))
+ (LET ((|bfVar#14| |dol|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#13|)
- (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
+ ((OR (ATOM |bfVar#14|)
+ (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
(RETURN NIL))
(#2='T (HPUT |$bootDefined| |i| T)))
- (SETQ |bfVar#13| (CDR |bfVar#13|))))
+ (SETQ |bfVar#14| (CDR |bfVar#14|))))
(|defuse1| (APPEND |ndol| |e|) |b|)))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
(PROGN (SETQ |a| (CDR |y|)) #1#))
@@ -814,14 +799,14 @@
(PROGN (SETQ |a| (CDR |y|)) #1#))
NIL)
(#0#
- (LET ((|bfVar#14| |y|) (|i| NIL))
+ (LET ((|bfVar#15| |y|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#14|)
- (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
+ ((OR (ATOM |bfVar#15|)
+ (PROGN (SETQ |i| (CAR |bfVar#15|)) NIL))
(RETURN NIL))
(#2# (|defuse1| |e| |i|)))
- (SETQ |bfVar#14| (CDR |bfVar#14|)))))))))
+ (SETQ |bfVar#15| (CDR |bfVar#15|)))))))))
(DEFUN |defSeparate| (|x|)
(PROG (|x2| |x1| |LETTMP#1| |f|)
@@ -850,26 +835,21 @@
('T (CONS (CAR |x|) (|unfluidlist| (CDR |x|))))))))
(DEFUN |defusebuiltin| (|x|)
- (PROG ()
- (DECLARE (SPECIAL |$lispWordTable|))
- (RETURN (GETHASH |x| |$lispWordTable|))))
+ (DECLARE (SPECIAL |$lispWordTable|))
+ (GETHASH |x| |$lispWordTable|))
(DEFUN |bootOut| (|l| |outfn|)
- (PROG ()
- (RETURN
- (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|)))))))
+ (LET ((|bfVar#16| |l|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#16|) (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
+ (SETQ |bfVar#16| (CDR |bfVar#16|)))))
-(DEFUN CLESSP (|s1| |s2|)
- (PROG () (RETURN (NULL (SHOEGREATERP |s1| |s2|)))))
+(DEFUN CLESSP (|s1| |s2|) (NULL (SHOEGREATERP |s1| |s2|)))
-(DEFUN SSORT (|l|) (PROG () (RETURN (SORT |l| #'CLESSP))))
+(DEFUN SSORT (|l|) (SORT |l| #'CLESSP))
(DEFUN |bootOutLines| (|l| |outfn| |s|)
(PROG (|a|)
@@ -917,24 +897,23 @@
(PROGN
(|shoeFileLine| "USED and where DEFINED" |stream|)
(SETQ |c| (SSORT (HKEYS |$bootUsed|)))
- (LET ((|bfVar#16| |c|) (|i| NIL))
+ (LET ((|bfVar#17| |c|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#16|)
- (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ ((OR (ATOM |bfVar#17|)
+ (PROGN (SETQ |i| (CAR |bfVar#17|)) 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|))))))))
+ (SETQ |bfVar#17| (CDR |bfVar#17|))))))))
-(DEFUN FBO (|name| |fn|)
- (PROG () (RETURN (|shoeGeneralFC| #'BO |name| |fn|))))
+(DEFUN FBO (|name| |fn|) (|shoeGeneralFC| #'BO |name| |fn|))
(DEFUN FEV (|name| |fn|)
- (PROG () (RETURN (|shoeGeneralFC| #'EVAL-BOOT-FILE |name| |fn|))))
+ (|shoeGeneralFC| #'EVAL-BOOT-FILE |name| |fn|))
(DEFUN |shoeGeneralFC| (|f| |name| |fn|)
(PROG (|$GenVarCounter| |$bfClamming| |filename| |a| |infn|)
@@ -970,63 +949,58 @@
(SETQ |filename|
(CONCAT "/tmp/" |filename| ".boot"))
(|shoeOpenOutputFile| |stream| |filename|
- (LET ((|bfVar#17| |lines|) (|line| NIL))
+ (LET ((|bfVar#18| |lines|) (|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#17|)
+ ((OR (ATOM |bfVar#18|)
(PROGN
- (SETQ |line| (CAR |bfVar#17|))
+ (SETQ |line| (CAR |bfVar#18|))
NIL))
(RETURN NIL))
('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#17| (CDR |bfVar#17|)))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
T))
('T NIL))))))
(DEFUN |shoeTransform2| (|str|)
- (PROG ()
- (RETURN
- (|bNext| #'|shoeItem|
- (|streamTake| 1
- (|bNext| #'|shoePileInsert|
- (|bNext| #'|shoeLineToks| |str|)))))))
+ (|bNext| #'|shoeItem|
+ (|streamTake| 1
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|)))))
(DEFUN |shoeItem| (|str|)
(PROG (|dq|)
(RETURN
(PROGN
(SETQ |dq| (CAR |str|))
- (CONS (LIST (LET ((|bfVar#19| NIL)
- (|bfVar#18| (|shoeDQlines| |dq|))
+ (CONS (LIST (LET ((|bfVar#20| NIL)
+ (|bfVar#19| (|shoeDQlines| |dq|))
(|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#18|)
+ ((OR (ATOM |bfVar#19|)
(PROGN
- (SETQ |line| (CAR |bfVar#18|))
+ (SETQ |line| (CAR |bfVar#19|))
NIL))
- (RETURN (NREVERSE |bfVar#19|)))
+ (RETURN (NREVERSE |bfVar#20|)))
('T
- (SETQ |bfVar#19|
- (CONS (CAR |line|) |bfVar#19|))))
- (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (SETQ |bfVar#20|
+ (CONS (CAR |line|) |bfVar#20|))))
+ (SETQ |bfVar#19| (CDR |bfVar#19|)))))
(CDR |str|))))))
(DEFUN |stripm| (|x| |pk| |bt|)
- (PROG ()
- (RETURN
- (COND
- ((ATOM |x|)
- (COND
- ((IDENTP |x|)
- (COND
- ((EQUAL (SYMBOL-PACKAGE |x|) |bt|)
- (INTERN (PNAME |x|) |pk|))
- (#0='T |x|)))
- (#0# |x|)))
- (#0#
- (CONS (|stripm| (CAR |x|) |pk| |bt|)
- (|stripm| (CDR |x|) |pk| |bt|)))))))
+ (COND
+ ((ATOM |x|)
+ (COND
+ ((IDENTP |x|)
+ (COND
+ ((EQUAL (SYMBOL-PACKAGE |x|) |bt|) (INTERN (PNAME |x|) |pk|))
+ (#0='T |x|)))
+ (#0# |x|)))
+ (#0#
+ (CONS (|stripm| (CAR |x|) |pk| |bt|)
+ (|stripm| (CDR |x|) |pk| |bt|)))))
(DEFUN |shoePCompile| (|fn|)
(PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
@@ -1067,15 +1041,13 @@
(|shoePCompileTrees| (|shoeTransformString| |lines|))))))
(DEFUN |shoePCompileTrees| (|s|)
- (PROG ()
- (RETURN
- (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|)
@@ -1149,13 +1121,15 @@
|result|))))
(DEFUN |defaultBootToLispFile| (|file|)
- (PROG () (RETURN (CONCAT (|shoeRemovebootIfNec| |file|) ".clisp"))))
+ (CONCAT (|shoeRemovebootIfNec| |file|) ".clisp"))
(DEFUN |translateBootFile| (|progname| |options| |file|)
(PROG (|outFile|)
(RETURN
(PROGN
- (SETQ |outFile| (|getOutputPathname| |options|))
+ (SETQ |outFile|
+ (OR (|getOutputPathname| |options|)
+ (|defaultBootToLispFile| |file|)))
(BOOTTOCL |file| (ENOUGH-NAMESTRING |outFile|))))))
(DEFUN |compileBootHandler| (|progname| |options| |file|)
@@ -1175,14 +1149,10 @@
('T NIL))))))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (PROG ()
- (RETURN
- (|associateRequestWithFileType| (|Option| "translate") "boot"
- #'|translateBootFile|))))
+ (|associateRequestWithFileType| (|Option| "translate") "boot"
+ #'|translateBootFile|))
(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (PROG ()
- (RETURN
- (|associateRequestWithFileType| (|Option| "compile") "boot"
- #'|compileBootHandler|))))
+ (|associateRequestWithFileType| (|Option| "compile") "boot"
+ #'|compileBootHandler|))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 01:41:47 +0000