aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-01-28 04:16:25 +0000
committerdos-reis <gdr@axiomatics.org>2008-01-28 04:16:25 +0000
commita27cc2ac7bf6a0ad60cc6c9f949a988d0444bb4e (patch)
treecb71095e082c97f38f06f11828ca1f898ba3f72e /src/boot/strap
parent58cae19381750526539e986ca1de122803ac2293 (diff)
downloadopen-axiom-a27cc2ac7bf6a0ad60cc6c9f949a988d0444bb4e.tar.gz
* boot/Makefile.pamphlet: Remove.
* boot/translator.boot: New. * boot/translator.boot: Remove. * boot/tokens.boot: New. * boot/tokens.boot.pamphlet: Remove. * boot/scanner.boot: New. * boot/scanner.boot.pamphlet: Remove. * boot/pile.boot: New. * boot/pile.boot.pamphlet: Remove. * boot/parser.boot: New. * boot/parser.boot.pamphlet: New. * boot/initial-env.lisp: New. * boot/initial-env.lisp.pamphlet: Remove. * boot/includer.boot: New. * boot/includer.boot.pamphlet: Remove. * boot/ast.boot: New. * boot/ast.boot.pamphlet: Remove.
Diffstat (limited to 'src/boot/strap')
-rw-r--r--src/boot/strap/ast.clisp2086
-rw-r--r--src/boot/strap/includer.clisp553
-rw-r--r--src/boot/strap/parser.clisp1331
-rw-r--r--src/boot/strap/pile.clisp154
-rw-r--r--src/boot/strap/scanner.clisp626
-rw-r--r--src/boot/strap/tokens.clisp352
-rw-r--r--src/boot/strap/translator.clisp1156
7 files changed, 6258 insertions, 0 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
new file mode 100644
index 00000000..591bd9bf
--- /dev/null
+++ b/src/boot/strap/ast.clisp
@@ -0,0 +1,2086 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-ast"))
+
+(IMPORT-MODULE "includer")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |$bfClamming| NIL)
+
+(DEFTYPE |String| () 'STRING)
+
+(DEFTYPE |Symbol| () 'SYMBOL)
+
+(DEFTYPE |Sequence| () 'SEQUENCE)
+
+(DEFTYPE |List| () '(OR NIL CONS))
+
+(DEFUN |Name| #0=(|bfVar#1|) (CONS '|Name| (LIST . #0#)))
+
+(DEFUN |Command| #0=(|bfVar#2|) (CONS '|Command| (LIST . #0#)))
+
+(DEFUN |Module| #0=(|bfVar#3|) (CONS '|Module| (LIST . #0#)))
+
+(DEFUN |Import| #0=(|bfVar#4|) (CONS '|Import| (LIST . #0#)))
+
+(DEFUN |ImportSignature| #0=(|bfVar#5| |bfVar#6|)
+ (CONS '|ImportSignature| (LIST . #0#)))
+
+(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8| |bfVar#9|)
+ (CONS '|TypeAlias| (LIST . #0#)))
+
+(DEFUN |Signature| #0=(|bfVar#10| |bfVar#11|)
+ (CONS '|Signature| (LIST . #0#)))
+
+(DEFUN |Mapping| #0=(|bfVar#12| |bfVar#13|)
+ (CONS '|Mapping| (LIST . #0#)))
+
+(DEFUN |SuffixDot| #0=(|bfVar#14|) (CONS '|SuffixDot| (LIST . #0#)))
+
+(DEFUN |Quote| #0=(|bfVar#15|) (CONS '|Quote| (LIST . #0#)))
+
+(DEFUN |EqualName| #0=(|bfVar#16|) (CONS '|EqualName| (LIST . #0#)))
+
+(DEFUN |Colon| #0=(|bfVar#17|) (CONS '|Colon| (LIST . #0#)))
+
+(DEFUN |QualifiedName| #0=(|bfVar#18| |bfVar#19|)
+ (CONS '|QualifiedName| (LIST . #0#)))
+
+(DEFUN |Bracket| #0=(|bfVar#20|) (CONS '|Bracket| (LIST . #0#)))
+
+(DEFUN |UnboundedSegment| #0=(|bfVar#21|)
+ (CONS '|UnboundedSegment| (LIST . #0#)))
+
+(DEFUN |BoundedSgement| #0=(|bfVar#22| |bfVar#23|)
+ (CONS '|BoundedSgement| (LIST . #0#)))
+
+(DEFUN |Tuple| #0=(|bfVar#24|) (CONS '|Tuple| (LIST . #0#)))
+
+(DEFUN |ColonAppend| #0=(|bfVar#25| |bfVar#26|)
+ (CONS '|ColonAppend| (LIST . #0#)))
+
+(DEFUN |Is| #0=(|bfVar#27| |bfVar#28|) (CONS '|Is| (LIST . #0#)))
+
+(DEFUN |Isnt| #0=(|bfVar#29| |bfVar#30|) (CONS '|Isnt| (LIST . #0#)))
+
+(DEFUN |Reduce| #0=(|bfVar#31| |bfVar#32|)
+ (CONS '|Reduce| (LIST . #0#)))
+
+(DEFUN |PrefixExpr| #0=(|bfVar#33| |bfVar#34|)
+ (CONS '|PrefixExpr| (LIST . #0#)))
+
+(DEFUN |Call| #0=(|bfVar#35| |bfVar#36|) (CONS '|Call| (LIST . #0#)))
+
+(DEFUN |InfixExpr| #0=(|bfVar#37| |bfVar#38| |bfVar#39|)
+ (CONS '|InfixExpr| (LIST . #0#)))
+
+(DEFUN |ConstantDefinition| #0=(|bfVar#40| |bfVar#41|)
+ (CONS '|ConstantDefinition| (LIST . #0#)))
+
+(DEFUN |Definition| #0=(|bfVar#42| |bfVar#43| |bfVar#44| |bfVar#45|)
+ (CONS '|Definition| (LIST . #0#)))
+
+(DEFUN |Macro| #0=(|bfVar#46| |bfVar#47| |bfVar#48|)
+ (CONS '|Macro| (LIST . #0#)))
+
+(DEFUN |SuchThat| #0=(|bfVar#49|) (CONS '|SuchThat| (LIST . #0#)))
+
+(DEFUN |Assignment| #0=(|bfVar#50| |bfVar#51|)
+ (CONS '|Assignment| (LIST . #0#)))
+
+(DEFUN |While| #0=(|bfVar#52|) (CONS '|While| (LIST . #0#)))
+
+(DEFUN |Until| #0=(|bfVar#53|) (CONS '|Until| (LIST . #0#)))
+
+(DEFUN |For| #0=(|bfVar#54| |bfVar#55| |bfVar#56|)
+ (CONS '|For| (LIST . #0#)))
+
+(DEFUN |Exit| #0=(|bfVar#57| |bfVar#58|) (CONS '|Exit| (LIST . #0#)))
+
+(DEFUN |Iterators| #0=(|bfVar#59|) (CONS '|Iterators| (LIST . #0#)))
+
+(DEFUN |Cross| #0=(|bfVar#60|) (CONS '|Cross| (LIST . #0#)))
+
+(DEFUN |Repeat| #0=(|bfVar#61| |bfVar#62|)
+ (CONS '|Repeat| (LIST . #0#)))
+
+(DEFUN |Pile| #0=(|bfVar#63|) (CONS '|Pile| (LIST . #0#)))
+
+(DEFUN |Append| #0=(|bfVar#64|) (CONS '|Append| (LIST . #0#)))
+
+(DEFUN |Case| #0=(|bfVar#65| |bfVar#66|) (CONS '|Case| (LIST . #0#)))
+
+(DEFUN |Return| #0=(|bfVar#67|) (CONS '|Return| (LIST . #0#)))
+
+(DEFUN |Where| #0=(|bfVar#68| |bfVar#69|)
+ (CONS '|Where| (LIST . #0#)))
+
+(DEFUN |Structure| #0=(|bfVar#70| |bfVar#71|)
+ (CONS '|Structure| (LIST . #0#)))
+
+(DEFPARAMETER |$inDefIS| NIL)
+
+(DEFUN |bfGenSymbol| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1))
+ (INTERN (CONCAT "bfVar#" (STRINGIMAGE |$GenVarCounter|)))))))
+
+(DEFUN |bfListOf| (|x|) (PROG () (RETURN |x|)))
+
+(DEFUN |bfColon| (|x|) (PROG () (RETURN (LIST 'COLON |x|))))
+
+(DEFUN |bfColonColon| (|package| |name|)
+ (PROG () (RETURN (INTERN (SYMBOL-NAME |name|) |package|))))
+
+(DEFUN |bfSymbol| (|x|)
+ (PROG () (RETURN (COND ((STRINGP |x|) |x|) ('T (LIST 'QUOTE |x|))))))
+
+(DEFUN |bfDot| () (PROG () (RETURN 'DOT)))
+
+(DEFUN |bfSuffixDot| (|x|) (PROG () (RETURN (LIST |x| 'DOT))))
+
+(DEFUN |bfEqual| (|name|) (PROG () (RETURN (LIST 'EQUAL |name|))))
+
+(DEFUN |bfBracket| (|part|) (PROG () (RETURN |part|)))
+
+(DEFUN |bfPile| (|part|) (PROG () (RETURN |part|)))
+
+(DEFUN |bfAppend| (|x|) (PROG () (RETURN (APPLY #'APPEND |x|))))
+
+(DEFUN |bfColonAppend| (|x| |y|)
+ (PROG (|a|)
+ (RETURN
+ (COND
+ ((NULL |x|)
+ (COND
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)
+ (PROGN (SETQ |a| (CDR |y|)) 'T))
+ (LIST '&REST (CONS 'QUOTE |a|)))
+ (#0='T (LIST '&REST |y|))))
+ (#0# (CONS (CAR |x|) (|bfColonAppend| (CDR |x|) |y|)))))))
+
+(DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|)
+ (PROG () (RETURN (LIST 'DEF |bflhsitems| |bfrhs| |body|))))
+
+(DEFUN |bfMDefinition| (|bflhsitems| |bfrhs| |body|)
+ (PROG () (RETURN (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|))))
+
+(DEFUN |bfCompDef| (|x|)
+ (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
+ |bfVar#73| |bfVar#72|)
+ (RETURN
+ (PROGN
+ (SETQ |bfVar#72| |x|)
+ (SETQ |bfVar#73| (CDR |bfVar#72|))
+ (CASE (CAR |bfVar#72|)
+ (|ConstantDefinition|
+ (LET ((|n| (CAR |bfVar#73|)) (|e| (CADR |bfVar#73|)))
+ |x|))
+ (T (COND
+ ((AND (CONSP |x|)
+ (PROGN
+ (SETQ |def| (CAR |x|))
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |args| (CAR |ISTMP#2|))
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |body| (CAR |ISTMP#3|))
+ 'T))))))))
+ (|bfDef| |def| |op| |args| |body|))
+ ('T (|coreError| "invalid AST")))))))))
+
+(DEFUN |bfBeginsDollar| (|x|)
+ (PROG () (RETURN (EQL (ELT "$" 0) (ELT (PNAME |x|) 0)))))
+
+(DEFUN |compFluid| (|id|) (PROG () (RETURN (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|))))))))
+
+(DEFUN |bfTuple| (|x|) (PROG () (RETURN (CONS 'TUPLE |x|))))
+
+(DEFUN |bfTupleP| (|x|) (PROG () (RETURN (EQCAR |x| 'TUPLE))))
+
+(DEFUN |bfTupleIf| (|x|)
+ (PROG ()
+ (RETURN (COND ((|bfTupleP| |x|) |x|) ('T (|bfTuple| |x|))))))
+
+(DEFUN |bfTupleConstruct| (|b|)
+ (PROG (|ISTMP#1| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
+ (COND
+ ((LET ((|bfVar#75| NIL) (|bfVar#74| |a|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#74|)
+ (PROGN (SETQ |x| (CAR |bfVar#74|)) NIL))
+ (RETURN |bfVar#75|))
+ ('T
+ (PROGN
+ (SETQ |bfVar#75|
+ (AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (EQ (CDR |ISTMP#1|) NIL)))))
+ (COND (|bfVar#75| (RETURN |bfVar#75|))))))
+ (SETQ |bfVar#74| (CDR |bfVar#74|))))
+ (|bfMakeCons| |a|))
+ ('T (CONS 'LIST |a|)))))))
+
+(DEFUN |bfConstruct| (|b|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
+ (|bfMakeCons| |a|)))))
+
+(DEFUN |bfMakeCons| (|l|)
+ (PROG (|l1| |a| |ISTMP#2| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |l|) NIL)
+ ((AND (CONSP |l|)
+ (PROGN
+ (SETQ |ISTMP#1| (CAR |l|))
+ (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'COLON)
+ (PROGN
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#2|)) #0='T)))))
+ (PROGN (SETQ |l1| (CDR |l|)) #0#))
+ (COND
+ (|l1| (LIST 'APPEND |a| (|bfMakeCons| |l1|)))
+ (#1='T |a|)))
+ (#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))))))
+
+(DEFUN |bfForTree| (OP |lhs| |whole|)
+ (PROG (G)
+ (RETURN
+ (PROGN
+ (SETQ |whole|
+ (COND
+ ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|)))
+ (#0='T |whole|)))
+ (COND
+ ((ATOM |lhs|) (|bfINON| (LIST OP |lhs| |whole|)))
+ (#1='T
+ (PROGN
+ (SETQ |lhs|
+ (COND
+ ((|bfTupleP| |lhs|) (CADR |lhs|))
+ (#0# |lhs|)))
+ (COND
+ ((EQCAR |lhs| 'L%T)
+ (PROGN
+ (SETQ G (CADR |lhs|))
+ (APPEND (|bfINON| (LIST OP G |whole|))
+ (|bfSuchthat| (|bfIS| G (CADDR |lhs|))))))
+ (#1#
+ (PROGN
+ (SETQ G (|bfGenSymbol|))
+ (APPEND (|bfINON| (LIST OP G |whole|))
+ (|bfSuchthat| (|bfIS| G |lhs|)))))))))))))
+
+(DEFUN |bfSTEP| (|id| |fst| |step| |lst|)
+ (PROG (|suc| |ex| |pred| |final| |g2| |inc| |g1| |initval| |initvar|)
+ (RETURN
+ (PROGN
+ (SETQ |initvar| (LIST |id|))
+ (SETQ |initval| (LIST |fst|))
+ (SETQ |inc|
+ (COND
+ ((ATOM |step|) |step|)
+ (#0='T (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |initvar| (CONS |g1| |initvar|))
+ (SETQ |initval| (CONS |step| |initval|)) |g1|)))
+ (SETQ |final|
+ (COND
+ ((ATOM |lst|) |lst|)
+ (#0# (SETQ |g2| (|bfGenSymbol|))
+ (SETQ |initvar| (CONS |g2| |initvar|))
+ (SETQ |initval| (CONS |lst| |initval|)) |g2|)))
+ (SETQ |ex|
+ (COND
+ ((NULL |lst|) NIL)
+ ((INTEGERP |inc|)
+ (PROGN
+ (SETQ |pred| (COND ((MINUSP |inc|) '<) (#0# '>)))
+ (LIST (LIST |pred| |id| |final|))))
+ ('T
+ (LIST (LIST 'COND
+ (LIST (LIST 'MINUSP |inc|)
+ (LIST '< |id| |final|))
+ (LIST 'T (LIST '> |id| |final|)))))))
+ (SETQ |suc| (LIST (LIST 'SETQ |id| (LIST '+ |id| |inc|))))
+ (LIST (LIST |initvar| |initval| |suc| NIL |ex| NIL))))))
+
+(DEFUN |bfINON| (|x|)
+ (PROG (|whole| |id| |op|)
+ (RETURN
+ (PROGN
+ (SETQ |op| (CAR |x|))
+ (SETQ |id| (CADR . #0=(|x|)))
+ (SETQ |whole| (CADDR . #0#))
+ (COND
+ ((EQ |op| 'ON) (|bfON| |id| |whole|))
+ ('T (|bfIN| |id| |whole|)))))))
+
+(DEFUN |bfIN| (|x| E)
+ (PROG (|g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (LIST (LIST (LIST |g| |x|) (LIST E NIL)
+ (LIST (LIST 'SETQ |g| (LIST 'CDR |g|))) NIL
+ (LIST (LIST 'OR (LIST 'ATOM |g|)
+ (LIST 'PROGN
+ (LIST 'SETQ |x| (LIST 'CAR |g|))
+ 'NIL)))
+ 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)))))
+
+(DEFUN |bfSuchthat| (|p|)
+ (PROG () (RETURN (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL)))))
+
+(DEFUN |bfWhile| (|p|)
+ (PROG ()
+ (RETURN (LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL)))))
+
+(DEFUN |bfUntil| (|p|)
+ (PROG (|g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (LIST (LIST (LIST |g|) (LIST NIL) (LIST (LIST 'SETQ |g| |p|))
+ NIL (LIST |g|) NIL))))))
+
+(DEFUN |bfIterators| (|x|) (PROG () (RETURN (CONS 'ITERATORS |x|))))
+
+(DEFUN |bfCross| (|x|) (PROG () (RETURN (CONS 'CROSS |x|))))
+
+(DEFUN |bfLp| (|iters| |body|)
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(DEFUN |bfSep| (|iters|)
+ (PROG (|r| |f|)
+ (RETURN
+ (COND
+ ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
+ ('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
+ (LET ((|bfVar#78| NIL) (|bfVar#76| |f|) (|i| NIL)
+ (|bfVar#77| |r|) (|j| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#76|)
+ (PROGN (SETQ |i| (CAR |bfVar#76|)) NIL)
+ (ATOM |bfVar#77|)
+ (PROGN (SETQ |j| (CAR |bfVar#77|)) NIL))
+ (RETURN (NREVERSE |bfVar#78|)))
+ ('T
+ (SETQ |bfVar#78| (CONS (APPEND |i| |j|) |bfVar#78|))))
+ (SETQ |bfVar#76| (CDR |bfVar#76|))
+ (SETQ |bfVar#77| (CDR |bfVar#77|)))))))))
+
+(DEFUN |bfReduce| (|op| |y|)
+ (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a|
+ (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
+ (SETQ |op| (|bfReName| |a|))
+ (SETQ |init| (GET |op| 'SHOETHETA))
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |body| (LIST 'SETQ |g| (LIST |op| |g| |g1|)))
+ (COND
+ ((NULL |init|) (SETQ |g2| (|bfGenSymbol|))
+ (SETQ |init| (LIST 'CAR |g2|)) (SETQ |ny| (LIST 'CDR |g2|))
+ (SETQ |it|
+ (CONS 'ITERATORS
+ (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL
+ NIL NIL (LIST |g|)))
+ (|bfIN| |g1| |ny|))))
+ (|bfMKPROGN|
+ (LIST (LIST 'L%T |g2| |y|) (|bfLp| |it| |body|))))
+ (#0# (SETQ |init| (CAR |init|))
+ (SETQ |it|
+ (CONS 'ITERATORS
+ (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL
+ NIL NIL (LIST |g|)))
+ (|bfIN| |g1| |y|))))
+ (|bfLp| |it| |body|)))))))
+
+(DEFUN |bfReduceCollect| (|op| |y|)
+ (PROG (|init| |a| |itl| |body|)
+ (RETURN
+ (COND
+ ((EQCAR |y| 'COLLECT) (SETQ |body| (ELT |y| 1))
+ (SETQ |itl| (ELT |y| 2))
+ (SETQ |a|
+ (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
+ (SETQ |op| (|bfReName| |a|))
+ (SETQ |init| (GET |op| 'SHOETHETA))
+ (|bfOpReduce| |op| |init| |body| |itl|))
+ (#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1)))
+ (|bfReduce| |op| |a|))))))
+
+(DEFUN |bfDCollect| (|y| |itl|)
+ (PROG () (RETURN (LIST 'COLLECT |y| |itl|))))
+
+(DEFUN |bfDTuple| (|x|) (PROG () (RETURN (LIST 'DTUPLE |x|))))
+
+(DEFUN |bfCollect| (|y| |itl|)
+ (PROG (|newBody| |a| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'COLON)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) 'T))))
+ (|bf0APPEND| |a| |itl|))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE))
+ (PROGN
+ (SETQ |newBody| (|bfConstruct| |y|))
+ (|bf0APPEND| |newBody| |itl|)))
+ ('T (|bf0COLLECT| |y| |itl|))))))
+
+(DEFUN |bf0COLLECT| (|y| |itl|)
+ (PROG () (RETURN (|bfListReduce| 'CONS |y| |itl|))))
+
+(DEFUN |bf0APPEND| (|y| |itl|)
+ (PROG (|extrait| |body| |g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |body|
+ (LIST 'SETQ |g| (LIST 'APPEND (LIST 'REVERSE |y|) |g|)))
+ (SETQ |extrait|
+ (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
+ (LIST (LIST 'NREVERSE |g|)))))
+ (|bfLp2| |extrait| |itl| |body|)))))
+
+(DEFUN |bfListReduce| (|op| |y| |itl|)
+ (PROG (|extrait| |body| |g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |body| (LIST 'SETQ |g| (LIST |op| |y| |g|)))
+ (SETQ |extrait|
+ (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL
+ (LIST (LIST 'NREVERSE |g|)))))
+ (|bfLp2| |extrait| |itl| |body|)))))
+
+(DEFUN |bfLp1| (|iters| |body|)
+ (PROG (|loop| |nbody| |value| |exits| |filters| |sucs| |inits| |vars|
+ |LETTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |LETTMP#1| (|bfSep| (|bfAppend| |iters|)))
+ (SETQ |vars| (CAR |LETTMP#1|))
+ (SETQ |inits| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |sucs| (CADDR . #0#))
+ (SETQ |filters| (CADDDR . #0#))
+ (SETQ |exits| (CAR #1=(CDDDDR . #0#)))
+ (SETQ |value| (CADR #1#))
+ (SETQ |nbody|
+ (COND
+ ((NULL |filters|) |body|)
+ (#2='T (|bfAND| (APPEND |filters| (CONS |body| NIL))))))
+ (SETQ |value| (COND ((NULL |value|) 'NIL) (#2# (CAR |value|))))
+ (SETQ |exits|
+ (LIST 'COND
+ (LIST (|bfOR| |exits|) (LIST 'RETURN |value|))
+ (LIST ''T |nbody|)))
+ (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|)))
+ (COND
+ (|vars| (SETQ |loop|
+ (LIST 'LET
+ (LET ((|bfVar#81| NIL)
+ (|bfVar#79| |vars|) (|v| NIL)
+ (|bfVar#80| |inits|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#79|)
+ (PROGN
+ (SETQ |v| (CAR |bfVar#79|))
+ NIL)
+ (ATOM |bfVar#80|)
+ (PROGN
+ (SETQ |i| (CAR |bfVar#80|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#81|)))
+ ('T
+ (SETQ |bfVar#81|
+ (CONS (LIST |v| |i|) |bfVar#81|))))
+ (SETQ |bfVar#79| (CDR |bfVar#79|))
+ (SETQ |bfVar#80| (CDR |bfVar#80|))))
+ |loop|))))
+ |loop|))))
+
+(DEFUN |bfLp2| (|extrait| |itl| |body|)
+ (PROG (|iters|)
+ (RETURN
+ (COND
+ ((EQCAR |itl| 'ITERATORS)
+ (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|))
+ ('T
+ (PROGN
+ (SETQ |iters| (CDR |itl|))
+ (|bfLpCross|
+ (CONS (CONS 'ITERATORS (CONS |extrait| (CDAR |iters|)))
+ (CDR |iters|))
+ |body|)))))))
+
+(DEFUN |bfOpReduce| (|op| |init| |y| |itl|)
+ (PROG (|extrait| |g1| |body| |g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |body|
+ (COND
+ ((EQ |op| 'AND)
+ (|bfMKPROGN|
+ (LIST (LIST 'SETQ |g| |y|)
+ (LIST 'COND
+ (LIST (LIST 'NOT |g|)
+ (LIST 'RETURN 'NIL))))))
+ ((EQ |op| 'OR)
+ (|bfMKPROGN|
+ (LIST (LIST 'SETQ |g| |y|)
+ (LIST 'COND (LIST |g| (LIST 'RETURN |g|))))))
+ ('T (LIST 'SETQ |g| (LIST |op| |g| |y|)))))
+ (COND
+ ((NULL |init|) (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |init| (LIST 'CAR |g1|)) (SETQ |y| (LIST 'CDR |g1|))
+ (SETQ |extrait|
+ (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL
+ (LIST |g|))))
+ (|bfMKPROGN|
+ (LIST (LIST 'L%T |g1| |y|)
+ (|bfLp2| |extrait| |itl| |body|))))
+ ('T (SETQ |init| (CAR |init|))
+ (SETQ |extrait|
+ (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL
+ (LIST |g|))))
+ (|bfLp2| |extrait| |itl| |body|)))))))
+
+(DEFUN |bfLoop1| (|body|)
+ (PROG () (RETURN (|bfLp| (|bfIterators| NIL) |body|))))
+
+(DEFUN |bfSegment1| (|lo|)
+ (PROG () (RETURN (LIST 'SEGMENT |lo| NIL))))
+
+(DEFUN |bfSegment2| (|lo| |hi|)
+ (PROG () (RETURN (LIST 'SEGMENT |lo| |hi|))))
+
+(DEFUN |bfForInBy| (|variable| |collection| |step|)
+ (PROG () (RETURN (|bfFor| |variable| |collection| |step|))))
+
+(DEFUN |bfForin| (|lhs| U) (PROG () (RETURN (|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|)))))
+
+(DEFUN |bfTake| (|n| |x|)
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(DEFUN |bfDefSequence| (|l|) (PROG () (RETURN (CONS 'SEQ |l|))))
+
+(DEFUN |bfReturnNoName| (|a|) (PROG () (RETURN (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|))))))))
+
+(DEFUN |bfSUBLIS1| (|p| |e|)
+ (PROG (|f|)
+ (RETURN
+ (COND
+ ((NULL |p|) |e|)
+ (#0='T
+ (PROGN
+ (SETQ |f| (CAR |p|))
+ (COND
+ ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|)))
+ (#0# (|bfSUBLIS1| (CDR |p|) |e|)))))))))
+
+(DEFUN |defSheepAndGoats| (|x|)
+ (PROG (|defstack| |op1| |opassoc| |argl| |body| |args| |op| |def|)
+ (DECLARE (SPECIAL |$op|))
+ (RETURN
+ (COND
+ ((EQCAR |x| 'DEF)
+ (PROGN
+ (SETQ |def| (CAR |x|))
+ (SETQ |op| (CADR . #0=(|x|)))
+ (SETQ |args| (CADDR . #0#))
+ (SETQ |body| (CADDDR . #0#))
+ (SETQ |argl|
+ (COND
+ ((|bfTupleP| |args|) (CDR |args|))
+ (#1='T (LIST |args|))))
+ (COND
+ ((NULL |argl|) (SETQ |opassoc| (LIST (CONS |op| |body|)))
+ (LIST |opassoc| NIL NIL))
+ (#1#
+ (SETQ |op1|
+ (INTERN (CONCAT (PNAME |$op|) "," (PNAME |op|))))
+ (SETQ |opassoc| (LIST (CONS |op| |op1|)))
+ (SETQ |defstack| (LIST (LIST 'DEF |op1| |args| |body|)))
+ (LIST |opassoc| |defstack| NIL)))))
+ ((EQCAR |x| 'SEQ) (|defSheepAndGoatsList| (CDR |x|)))
+ ('T (LIST NIL NIL (LIST |x|)))))))
+
+(DEFUN |defSheepAndGoatsList| (|x|)
+ (PROG (|nondefs1| |defs1| |opassoc1| |nondefs| |defs| |opassoc|
+ |LETTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |x|) (LIST NIL NIL NIL))
+ ('T (SETQ |LETTMP#1| (|defSheepAndGoats| (CAR |x|)))
+ (SETQ |opassoc| (CAR |LETTMP#1|))
+ (SETQ |defs| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |nondefs| (CADDR . #0#))
+ (SETQ |LETTMP#1| (|defSheepAndGoatsList| (CDR |x|)))
+ (SETQ |opassoc1| (CAR |LETTMP#1|))
+ (SETQ |defs1| (CADR . #1=(|LETTMP#1|)))
+ (SETQ |nondefs1| (CADDR . #1#))
+ (LIST (APPEND |opassoc| |opassoc1|) (APPEND |defs| |defs1|)
+ (APPEND |nondefs| |nondefs1|)))))))
+
+(DEFUN |bfLetForm| (|lhs| |rhs|)
+ (PROG () (RETURN (LIST 'L%T |lhs| |rhs|))))
+
+(DEFUN |bfLET1| (|lhs| |rhs|)
+ (PROG (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|)
+ (DECLARE (SPECIAL |$letGenVarCounter|))
+ (RETURN
+ (COND
+ ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))
+ (|bfLetForm| |lhs| |rhs|))
+ ((AND (IDENTP |rhs|) (NULL (|bfCONTAINED| |rhs| |lhs|)))
+ (PROGN
+ (SETQ |rhs1| (|bfLET2| |lhs| |rhs|))
+ (COND
+ ((EQCAR |rhs1| 'L%T) (|bfMKPROGN| (LIST |rhs1| |rhs|)))
+ ((EQCAR |rhs1| 'PROGN) (APPEND |rhs1| (LIST |rhs|)))
+ (#0='T
+ (PROGN
+ (COND
+ ((IDENTP (CAR |rhs1|))
+ (SETQ |rhs1| (CONS |rhs1| NIL))))
+ (|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL))))))))
+ ((AND (CONSP |rhs|) (EQCAR |rhs| 'L%T)
+ (IDENTP (SETQ |name| (CADR |rhs|))))
+ (PROGN
+ (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|)))
+ (SETQ |l2| (|bfLET1| |lhs| |name|))
+ (COND
+ ((EQCAR |l2| 'PROGN) (|bfMKPROGN| (CONS |l1| (CDR |l2|))))
+ (#0#
+ (PROGN
+ (COND
+ ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
+ (|bfMKPROGN|
+ (CONS |l1| (APPEND |l2| (CONS |name| NIL)))))))))
+ (#0#
+ (PROGN
+ (SETQ |g|
+ (INTERN (CONCAT "LETTMP#"
+ (STRINGIMAGE |$letGenVarCounter|))))
+ (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
+ (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
+ (SETQ |let1| (|bfLET1| |lhs| |g|))
+ (COND
+ ((EQCAR |let1| 'PROGN)
+ (|bfMKPROGN| (CONS |rhs1| (CDR |let1|))))
+ (#0#
+ (PROGN
+ (COND
+ ((IDENTP (CAR |let1|))
+ (SETQ |let1| (CONS |let1| NIL))))
+ (|bfMKPROGN|
+ (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|))))))))
+
+(DEFUN |bfLET2| (|lhs| |rhs|)
+ (PROG (|isPred| |val1| |ISTMP#3| |g| |rev| |patrev| |l2| |l1| |var2|
+ |var1| |b| |ISTMP#2| |a| |ISTMP#1|)
+ (DECLARE (SPECIAL |$inDefIS| |$letGenVarCounter|))
+ (RETURN
+ (COND
+ ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
+ ((NULL |lhs|) NIL)
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))
+ (|bfLetForm| |lhs| |rhs|))
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |a| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0='T))))))
+ (PROGN
+ (SETQ |a| (|bfLET2| |a| |rhs|))
+ (COND
+ ((NULL (SETQ |b| (|bfLET2| |b| |rhs|))) |a|)
+ ((ATOM |b|) (LIST |a| |b|))
+ ((CONSP (CAR |b|)) (CONS |a| |b|))
+ (#1='T (LIST |a| |b|)))))
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'CONS)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |var1| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#))))))
+ (COND
+ ((OR (EQ |var1| 'DOT)
+ (AND (CONSP |var1|) (EQCAR |var1| 'QUOTE)))
+ (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|)))
+ (#1#
+ (PROGN
+ (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|)))
+ (COND
+ ((OR (NULL |var2|) (EQ |var2| 'DOT)) |l1|)
+ (#1#
+ (PROGN
+ (COND
+ ((AND (CONSP |l1|) (ATOM (CAR |l1|)))
+ (SETQ |l1| (CONS |l1| NIL))))
+ (COND
+ ((IDENTP |var2|)
+ (APPEND |l1|
+ (CONS (|bfLetForm| |var2|
+ (|addCARorCDR| 'CDR |rhs|))
+ NIL)))
+ (#1#
+ (PROGN
+ (SETQ |l2|
+ (|bfLET2| |var2|
+ (|addCARorCDR| 'CDR |rhs|)))
+ (COND
+ ((AND (CONSP |l2|) (ATOM (CAR |l2|)))
+ (SETQ |l2| (CONS |l2| NIL))))
+ (APPEND |l1| |l2|)))))))))))
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'APPEND)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |var1| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#))))))
+ (PROGN
+ (SETQ |patrev| (|bfISReverse| |var2| |var1|))
+ (SETQ |rev| (LIST 'REVERSE |rhs|))
+ (SETQ |g|
+ (INTERN (CONCAT "LETTMP#"
+ (STRINGIMAGE |$letGenVarCounter|))))
+ (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1))
+ (SETQ |l2| (|bfLET2| |patrev| |g|))
+ (COND
+ ((AND (CONSP |l2|) (ATOM (CAR |l2|)))
+ (SETQ |l2| (CONS |l2| NIL))))
+ (COND
+ ((EQ |var1| 'DOT) (CONS (LIST 'L%T |g| |rev|) |l2|))
+ ((PROGN
+ (SETQ |ISTMP#1| (|last| |l2|))
+ (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQUAL (CAR |ISTMP#2|) |var1|)
+ (PROGN
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |val1| (CAR |ISTMP#3|))
+ #0#)))))))
+ (CONS (LIST 'L%T |g| |rev|)
+ (APPEND (REVERSE (CDR (REVERSE |l2|)))
+ (CONS (|bfLetForm| |var1|
+ (LIST 'NREVERSE |val1|))
+ NIL))))
+ (#1#
+ (CONS (LIST 'L%T |g| |rev|)
+ (APPEND |l2|
+ (CONS (|bfLetForm| |var1|
+ (LIST 'NREVERSE |var1|))
+ NIL)))))))
+ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |lhs|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |var1| (CAR |ISTMP#1|)) #0#))))
+ (LIST 'COND (LIST (LIST 'EQUAL |var1| |rhs|) |var1|)))
+ (#1#
+ (PROGN
+ (SETQ |isPred|
+ (COND
+ (|$inDefIS| (|bfIS1| |rhs| |lhs|))
+ (#1# (|bfIS| |rhs| |lhs|))))
+ (LIST 'COND (LIST |isPred| |rhs|))))))))
+
+(DEFUN |bfLET| (|lhs| |rhs|)
+ (PROG (|$letGenVarCounter|)
+ (DECLARE (SPECIAL |$letGenVarCounter|))
+ (RETURN
+ (PROGN (SETQ |$letGenVarCounter| 1) (|bfLET1| |lhs| |rhs|)))))
+
+(DEFUN |addCARorCDR| (|acc| |expr|)
+ (PROG (|funsR| |funsA| |p| |funs|)
+ (RETURN
+ (COND
+ ((NULL (CONSP |expr|)) (LIST |acc| |expr|))
+ ((AND (EQ |acc| 'CAR) (EQCAR |expr| 'REVERSE))
+ (LIST 'CAR (CONS 'LAST (CDR |expr|))))
+ (#0='T
+ (PROGN
+ (SETQ |funs|
+ '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
+ CDAAR CDDAR CDADR CDDDR))
+ (SETQ |p| (|bfPosition| (CAR |expr|) |funs|))
+ (COND
+ ((EQUAL |p| (- 1)) (LIST |acc| |expr|))
+ (#0#
+ (PROGN
+ (SETQ |funsA|
+ '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR
+ CAAADR CAADDR CADAAR CADDAR CADADR CADDDR))
+ (SETQ |funsR|
+ '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR
+ CDAADR CDADDR CDDAAR CDDDAR CDDADR CDDDDR))
+ (COND
+ ((EQ |acc| 'CAR)
+ (CONS (ELT |funsA| |p|) (CDR |expr|)))
+ ('T (CONS (ELT |funsR| |p|) (CDR |expr|)))))))))))))
+
+(DEFUN |bfPosition| (|x| |l|) (PROG () (RETURN (|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)))))))
+
+(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|))))))
+
+(DEFUN |bfIS| (|left| |right|)
+ (PROG (|$inDefIS| |$isGenVarCounter|)
+ (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$isGenVarCounter| 1)
+ (SETQ |$inDefIS| T)
+ (|bfIS1| |left| |right|)))))
+
+(DEFUN |bfISReverse| (|x| |a|)
+ (PROG (|y|)
+ (RETURN
+ (COND
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'CONS))
+ (COND
+ ((NULL (CADDR |x|)) (LIST 'CONS (CADR |x|) |a|))
+ (#0='T
+ (PROGN
+ (SETQ |y| (|bfISReverse| (CADDR |x|) NIL))
+ (RPLACA (CDDR |y|) (LIST 'CONS (CADR |x|) |a|))
+ |y|))))
+ (#0#
+ (PROGN
+ (|bpSpecificErrorHere| "Error in bfISReverse")
+ (|bpTrap|)))))))
+
+(DEFUN |bfIS1| (|lhs| |rhs|)
+ (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |b| |g| |l| |d| |ISTMP#2|
+ |c| |a| |ISTMP#1|)
+ (DECLARE (SPECIAL |$isGenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |rhs|) (LIST 'NULL |lhs|))
+ ((STRINGP |rhs|) (LIST 'EQ |lhs| (LIST 'QUOTE (INTERN |rhs|))))
+ ((NUMBERP |rhs|) (LIST 'EQUAL |lhs| |rhs|))
+ ((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) ''T))
+ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |rhs|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T))))
+ (COND
+ ((IDENTP |a|) (LIST 'EQ |lhs| |rhs|))
+ (#1='T (LIST 'EQUAL |lhs| |rhs|))))
+ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |rhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |c| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |d| (CAR |ISTMP#2|)) #0#))))))
+ (PROGN
+ (SETQ |l| (|bfLET| |c| |lhs|))
+ (|bfAND| (LIST (|bfIS1| |lhs| |d|)
+ (|bfMKPROGN| (LIST |l| ''T))))))
+ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'EQUAL)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |rhs|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0#))))
+ (LIST 'EQUAL |lhs| |a|))
+ ((CONSP |lhs|)
+ (PROGN
+ (SETQ |g|
+ (INTERN (CONCAT "ISTMP#"
+ (STRINGIMAGE |$isGenVarCounter|))))
+ (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
+ (|bfMKPROGN|
+ (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|)))))
+ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'CONS)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |rhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |a| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0#))))))
+ (COND
+ ((EQ |a| 'DOT)
+ (COND
+ ((NULL |b|)
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (LIST 'EQ (LIST 'CDR |lhs|) 'NIL))))
+ (#1#
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (|bfIS1| (LIST 'CDR |lhs|) |b|))))))
+ ((NULL |b|)
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (LIST 'EQ (LIST 'CDR |lhs|) 'NIL)
+ (|bfIS1| (LIST 'CAR |lhs|) |a|))))
+ ((EQ |b| 'DOT)
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (|bfIS1| (LIST 'CAR |lhs|) |a|))))
+ (#1#
+ (PROGN
+ (SETQ |a1| (|bfIS1| (LIST 'CAR |lhs|) |a|))
+ (SETQ |b1| (|bfIS1| (LIST 'CDR |lhs|) |b|))
+ (COND
+ ((AND (CONSP |a1|) (EQ (CAR |a1|) 'PROGN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |a1|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |c| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (EQUAL (CAR |ISTMP#2|) ''T)))))
+ (CONSP |b1|) (EQ (CAR |b1|) 'PROGN)
+ (PROGN (SETQ |cls| (CDR |b1|)) #0#))
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (|bfMKPROGN| (CONS |c| |cls|)))))
+ (#1# (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|))))))))
+ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'APPEND)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |rhs|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |a| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0#))))))
+ (PROGN
+ (SETQ |patrev| (|bfISReverse| |b| |a|))
+ (SETQ |g|
+ (INTERN (CONCAT "ISTMP#"
+ (STRINGIMAGE |$isGenVarCounter|))))
+ (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1))
+ (SETQ |rev|
+ (|bfAND| (LIST (LIST 'CONSP |lhs|)
+ (LIST 'PROGN
+ (LIST 'L%T |g|
+ (LIST 'REVERSE |lhs|))
+ ''T))))
+ (SETQ |l2| (|bfIS1| |g| |patrev|))
+ (COND
+ ((AND (CONSP |l2|) (ATOM (CAR |l2|)))
+ (SETQ |l2| (CONS |l2| NIL))))
+ (COND
+ ((EQ |a| 'DOT) (|bfAND| (CONS |rev| |l2|)))
+ (#1#
+ (|bfAND| (CONS |rev|
+ (APPEND |l2|
+ (CONS
+ (LIST 'PROGN
+ (|bfLetForm| |a|
+ (LIST 'NREVERSE |a|))
+ ''T)
+ NIL))))))))
+ (#1#
+ (PROGN
+ (|bpSpecificErrorHere| "bad IS code is generated")
+ (|bpTrap|)))))))
+
+(DEFUN |bfApplication| (|bfop| |bfarg|)
+ (PROG ()
+ (RETURN
+ (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 |bfReName| (|x|)
+ (PROG (|oldName| |newName| |a|)
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (RETURN
+ (PROGN
+ (SETQ |newName|
+ (COND
+ ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|))
+ (#0='T |x|)))
+ (COND
+ ((AND |$translatingOldBoot| (NULL (|bfSameMeaning| |x|)))
+ (PROGN
+ (SETQ |oldName| (|bfGetOldBootName| |x|))
+ (COND
+ ((NOT (EQUAL |newName| |oldName|))
+ (|warn| (LIST (PNAME |x|) " as `" (PNAME |newName|)
+ "' differs from Old Boot `"
+ (PNAME |oldName|) "'"))))
+ |oldName|))
+ (#0# |newName|))))))
+
+(DEFUN |bfInfApplication| (|op| |left| |right|)
+ (PROG ()
+ (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|))))))
+
+(DEFUN |bfNOT| (|x|)
+ (PROG (|a| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'NOT)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T))))
+ |a|)
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'NULL)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0#))))
+ |a|)
+ ('T (LIST 'NOT |x|))))))
+
+(DEFUN |bfFlatten| (|op| |x|)
+ (PROG ()
+ (RETURN (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|))))))))))
+
+(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|))))))))))
+
+(DEFUN |defQuoteId| (|x|)
+ (PROG () (RETURN (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))))
+
+(DEFUN |bfSmintable| (|x|)
+ (PROG ()
+ (RETURN
+ (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|))))))
+
+(DEFUN |bfLessp| (|l| |r|)
+ (PROG ()
+ (RETURN
+ (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|
+ |LETTMP#1| |argl|)
+ (DECLARE (SPECIAL |$wheredefs|))
+ (RETURN
+ (PROGN
+ (SETQ |argl|
+ (COND
+ ((|bfTupleP| |args|) (CDR |args|))
+ ('T (LIST |args|))))
+ (SETQ |LETTMP#1| (|bfGargl| |argl|))
+ (SETQ |gargl| (CAR |LETTMP#1|))
+ (SETQ |sgargl| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |nargl| (CADDR . #0#))
+ (SETQ |largl| (CADDDR . #0#))
+ (SETQ |sb|
+ (LET ((|bfVar#88| NIL) (|bfVar#86| |nargl|) (|i| NIL)
+ (|bfVar#87| |sgargl|) (|j| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#86|)
+ (PROGN (SETQ |i| (CAR |bfVar#86|)) NIL)
+ (ATOM |bfVar#87|)
+ (PROGN (SETQ |j| (CAR |bfVar#87|)) NIL))
+ (RETURN (NREVERSE |bfVar#88|)))
+ (#1='T
+ (SETQ |bfVar#88| (CONS (CONS |i| |j|) |bfVar#88|))))
+ (SETQ |bfVar#86| (CDR |bfVar#86|))
+ (SETQ |bfVar#87| (CDR |bfVar#87|)))))
+ (SETQ |body| (SUBLIS |sb| |body|))
+ (SETQ |sb2|
+ (LET ((|bfVar#91| NIL) (|bfVar#89| |sgargl|) (|i| NIL)
+ (|bfVar#90| |largl|) (|j| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#89|)
+ (PROGN (SETQ |i| (CAR |bfVar#89|)) NIL)
+ (ATOM |bfVar#90|)
+ (PROGN (SETQ |j| (CAR |bfVar#90|)) NIL))
+ (RETURN (NREVERSE |bfVar#91|)))
+ (#1#
+ (SETQ |bfVar#91|
+ (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
+ |bfVar#91|))))
+ (SETQ |bfVar#89| (CDR |bfVar#89|))
+ (SETQ |bfVar#90| (CDR |bfVar#90|)))))
+ (SETQ |body|
+ (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
+ (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
+ (SETQ |def| (LIST |op| |lamex|))
+ (|bfTuple|
+ (CONS (|shoeComp| |def|)
+ (LET ((|bfVar#93| NIL) (|bfVar#92| |$wheredefs|)
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#92|)
+ (PROGN (SETQ |d| (CAR |bfVar#92|)) NIL))
+ (RETURN (NREVERSE |bfVar#93|)))
+ (#1#
+ (SETQ |bfVar#93|
+ (APPEND (REVERSE
+ (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#93|))))
+ (SETQ |bfVar#92| (CDR |bfVar#92|))))))))))
+
+(DEFUN |bfGargl| (|argl|)
+ (PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |argl|) (LIST NIL NIL NIL NIL))
+ (#0='T (SETQ |LETTMP#1| (|bfGargl| (CDR |argl|)))
+ (SETQ |a| (CAR |LETTMP#1|))
+ (SETQ |b| (CADR . #1=(|LETTMP#1|))) (SETQ |c| (CADDR . #1#))
+ (SETQ |d| (CADDDR . #1#))
+ (COND
+ ((EQ (CAR |argl|) '&REST)
+ (LIST (CONS (CAR |argl|) |b|) |b| |c|
+ (CONS (LIST 'CONS (LIST 'QUOTE 'LIST) (CAR |d|))
+ (CDR |d|))))
+ (#0# (SETQ |f| (|bfGenSymbol|))
+ (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
+ (CONS |f| |d|)))))))))
+
+(DEFUN |bfDef1| (|bfVar#94|)
+ (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
+ |op| |defOp|)
+ (RETURN
+ (PROGN
+ (SETQ |defOp| (CAR |bfVar#94|))
+ (SETQ |op| (CADR . #0=(|bfVar#94|)))
+ (SETQ |args| (CADDR . #0#))
+ (SETQ |body| (CADDDR . #0#))
+ (SETQ |argl|
+ (COND
+ ((|bfTupleP| |args|) (CDR |args|))
+ ('T (LIST |args|))))
+ (SETQ |LETTMP#1| (|bfInsertLet| |argl| |body|))
+ (SETQ |quotes| (CAR |LETTMP#1|))
+ (SETQ |control| (CADR . #1=(|LETTMP#1|)))
+ (SETQ |arglp| (CADDR . #1#))
+ (SETQ |body| (CADDDR . #1#))
+ (COND
+ (|quotes| (|shoeLAM| |op| |arglp| |control| |body|))
+ ('T (LIST (LIST |op| (LIST 'LAMBDA |arglp| |body|)))))))))
+
+(DEFUN |shoeLAM| (|op| |args| |control| |body|)
+ (PROG (|innerfunc| |margs|)
+ (RETURN
+ (PROGN
+ (SETQ |margs| (|bfGenSymbol|))
+ (SETQ |innerfunc| (INTERN (CONCAT (PNAME |op|) '|,LAM|)))
+ (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|))
+ (LIST |op|
+ (LIST 'MLAMBDA (LIST '&REST |margs|)
+ (LIST 'CONS (LIST 'QUOTE |innerfunc|)
+ (LIST 'WRAP |margs|
+ (LIST 'QUOTE |control|))))))))))
+
+(DEFUN |bfDef| (|defOp| |op| |args| |body|)
+ (PROG (|body1| |arg1| |op1| |LETTMP#1|)
+ (DECLARE (SPECIAL |$wheredefs| |$bfClamming|))
+ (RETURN
+ (COND
+ (|$bfClamming|
+ (PROGN
+ (SETQ |LETTMP#1|
+ (|shoeComp|
+ (CAR (|bfDef1|
+ (LIST |defOp| |op| |args| |body|)))))
+ (SETQ |op1| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |arg1| (CADDR . #0#))
+ (SETQ |body1| (CDDDR . #0#))
+ (|bfCompHash| |op1| |arg1| |body1|)))
+ ('T
+ (|bfTuple|
+ (LET ((|bfVar#96| NIL)
+ (|bfVar#95|
+ (CONS (LIST |defOp| |op| |args| |body|)
+ |$wheredefs|))
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#95|)
+ (PROGN (SETQ |d| (CAR |bfVar#95|)) NIL))
+ (RETURN (NREVERSE |bfVar#96|)))
+ ('T
+ (SETQ |bfVar#96|
+ (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#96|))))
+ (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|)))))))
+
+(DEFUN |shoeComp| (|x|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeCompTran| (CADR |x|)))
+ (COND
+ ((EQCAR |a| 'LAMBDA)
+ (CONS 'DEFUN (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|)))))
+ ('T
+ (CONS 'DEFMACRO
+ (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|))))))))))
+
+(DEFUN |bfInsertLet| (|x| |body|)
+ (PROG (|body2| |name2| |norq1| |b1| |body1| |name1| |norq| |LETTMP#1|
+ |b| |a| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |x|) (LIST NIL NIL |x| |body|))
+ ((AND (CONSP |x|) (EQ (CAR |x|) '&REST)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T))))
+ (COND
+ ((AND (CONSP |a|) (EQ (CAR |a|) 'QUOTE)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |a|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |b| (CAR |ISTMP#1|)) #0#))))
+ (LIST T 'QUOTE (LIST '&REST |b|) |body|))
+ (#1='T (LIST NIL NIL |x| |body|))))
+ (#1# (SETQ |LETTMP#1| (|bfInsertLet1| (CAR |x|) |body|))
+ (SETQ |b| (CAR |LETTMP#1|))
+ (SETQ |norq| (CADR . #2=(|LETTMP#1|)))
+ (SETQ |name1| (CADDR . #2#)) (SETQ |body1| (CADDDR . #2#))
+ (SETQ |LETTMP#1| (|bfInsertLet| (CDR |x|) |body1|))
+ (SETQ |b1| (CAR |LETTMP#1|))
+ (SETQ |norq1| (CADR . #3=(|LETTMP#1|)))
+ (SETQ |name2| (CADDR . #3#)) (SETQ |body2| (CADDDR . #3#))
+ (LIST (OR |b| |b1|) (CONS |norq| |norq1|)
+ (CONS |name1| |name2|) |body2|))))))
+
+(DEFUN |bfInsertLet1| (|y| |body|)
+ (PROG (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |r| (CAR |ISTMP#2|)) #0='T))))))
+ (LIST NIL NIL |l|
+ (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|))))
+ ((IDENTP |y|) (LIST NIL NIL |y| |body|))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |b| (CAR |ISTMP#1|)) #0#))))
+ (LIST T 'QUOTE |b| |body|))
+ ('T (SETQ |g| (|bfGenSymbol|))
+ (COND
+ ((ATOM |y|) (LIST NIL NIL |g| |body|))
+ ('T
+ (LIST NIL NIL |g|
+ (|bfMKPROGN|
+ (LIST (|bfLET| (|compFluidize| |y|) |g|) |body|))))))))))
+
+(DEFUN |shoeCompTran| (|x|)
+ (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars|
+ |lvars| |body| |args| |lamtype|)
+ (DECLARE (SPECIAL |$typings| |$dollarVars| |$fluidVars| |$locVars|))
+ (RETURN
+ (PROGN
+ (SETQ |lamtype| (CAR |x|))
+ (SETQ |args| (CADR |x|))
+ (SETQ |body| (CDDR |x|))
+ (SETQ |$fluidVars| NIL)
+ (SETQ |$locVars| NIL)
+ (SETQ |$dollarVars| NIL)
+ (|shoeCompTran1| |body|)
+ (SETQ |$locVars|
+ (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|))))
+ (SETQ |fl| (|shoeFluids| |args|))
+ (SETQ |body|
+ (COND
+ (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|)))
+ (CONS |fvs| |body|))
+ (#1# |body|)))
+ (CONS |lamtype| (CONS |args| |body|))))))
+
+(DEFUN |shoePROG| (|v| |b|)
+ (PROG (|blist| |blast| |LETTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |b|) (LIST (LIST 'PROG |v|)))
+ ('T
+ (PROGN
+ (SETQ |LETTMP#1| (REVERSE |b|))
+ (SETQ |blast| (CAR |LETTMP#1|))
+ (SETQ |blist| (NREVERSE (CDR |LETTMP#1|)))
+ (LIST (CONS 'PROG
+ (CONS |v|
+ (APPEND |blist|
+ (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|))))))))
+
+(DEFUN |shoeATOMs| (|x|)
+ (PROG ()
+ (RETURN
+ (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)
+ (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|))
+ (RETURN
+ (COND
+ ((ATOM |x|)
+ (COND
+ ((AND (IDENTP |x|) (|bfBeginsDollar| |x|))
+ (SETQ |$dollarVars|
+ (COND
+ ((MEMQ |x| |$dollarVars|) |$dollarVars|)
+ (#0='T (CONS |x| |$dollarVars|)))))
+ (#0# NIL)))
+ (#0#
+ (PROGN
+ (SETQ U (CAR |x|))
+ (COND
+ ((EQ U 'QUOTE) NIL)
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |r| (CAR |ISTMP#2|)) 'T))))))
+ (PROGN
+ (RPLACA |x| 'SETQ)
+ (|shoeCompTran1| |r|)
+ (COND
+ ((IDENTP |l|)
+ (COND
+ ((NULL (|bfBeginsDollar| |l|))
+ (SETQ |$locVars|
+ (COND
+ ((MEMQ |l| |$locVars|) |$locVars|)
+ (#0# (CONS |l| |$locVars|)))))
+ (#0#
+ (SETQ |$dollarVars|
+ (COND
+ ((MEMQ |l| |$dollarVars|) |$dollarVars|)
+ (#0# (CONS |l| |$dollarVars|)))))))
+ ((EQCAR |l| 'FLUID)
+ (PROGN
+ (SETQ |$fluidVars|
+ (COND
+ ((MEMQ (CADR |l|) |$fluidVars|)
+ |$fluidVars|)
+ (#0# (CONS (CADR |l|) |$fluidVars|))))
+ (RPLACA (CDR |x|) (CADR |l|)))))))
+ ((MEMQ U '(PROG LAMBDA))
+ (PROGN
+ (SETQ |newbindings| NIL)
+ (LET ((|bfVar#99| (CADR |x|)) (|y| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#99|)
+ (PROGN (SETQ |y| (CAR |bfVar#99|)) NIL))
+ (RETURN NIL))
+ (#1='T
+ (COND
+ ((NULL (MEMQ |y| |$locVars|))
+ (IDENTITY
+ (PROGN
+ (SETQ |$locVars| (CONS |y| |$locVars|))
+ (SETQ |newbindings|
+ (CONS |y| |newbindings|))))))))
+ (SETQ |bfVar#99| (CDR |bfVar#99|))))
+ (SETQ |res| (|shoeCompTran1| (CDDR |x|)))
+ (SETQ |$locVars|
+ (LET ((|bfVar#101| NIL) (|bfVar#100| |$locVars|)
+ (|y| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#100|)
+ (PROGN
+ (SETQ |y| (CAR |bfVar#100|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#101|)))
+ (#1#
+ (AND (NULL (MEMQ |y| |newbindings|))
+ (SETQ |bfVar#101|
+ (CONS |y| |bfVar#101|)))))
+ (SETQ |bfVar#100| (CDR |bfVar#100|)))))))
+ (#0#
+ (PROGN
+ (|shoeCompTran1| (CAR |x|))
+ (|shoeCompTran1| (CDR |x|)))))))))))
+
+(DEFUN |bfTagged| (|a| |b|)
+ (PROG ()
+ (DECLARE (SPECIAL |$typings|))
+ (RETURN
+ (COND
+ ((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|))))))
+
+(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|))))))
+
+(DEFUN |bfElt| (|expr| |sel|)
+ (PROG (|y|)
+ (RETURN
+ (PROGN
+ (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION)))
+ (COND
+ (|y| (COND
+ ((INTEGERP |y|) (LIST 'ELT |expr| |y|))
+ (#0='T (LIST |y| |expr|))))
+ (#0# (LIST 'ELT |expr| |sel|)))))))
+
+(DEFUN |defSETELT| (|var| |sel| |expr|)
+ (PROG (|y|)
+ (RETURN
+ (PROGN
+ (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION)))
+ (COND
+ (|y| (COND
+ ((INTEGERP |y|)
+ (LIST 'SETF (LIST 'ELT |var| |y|) |expr|))
+ (#0='T (LIST 'SETF (LIST |y| |var|) |expr|))))
+ (#0# (LIST 'SETF (LIST 'ELT |var| |sel|) |expr|)))))))
+
+(DEFUN |bfIfThenOnly| (|a| |b|)
+ (PROG (|b1|)
+ (RETURN
+ (PROGN
+ (SETQ |b1|
+ (COND ((EQCAR |b| 'PROGN) (CDR |b|)) ('T (LIST |b|))))
+ (LIST 'COND (CONS |a| |b1|))))))
+
+(DEFUN |bfIf| (|a| |b| |c|)
+ (PROG (|c1| |b1|)
+ (RETURN
+ (PROGN
+ (SETQ |b1|
+ (COND ((EQCAR |b| 'PROGN) (CDR |b|)) (#0='T (LIST |b|))))
+ (COND
+ ((EQCAR |c| 'COND)
+ (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|))))
+ ('T
+ (PROGN
+ (SETQ |c1|
+ (COND
+ ((EQCAR |c| 'PROGN) (CDR |c|))
+ (#0# (LIST |c|))))
+ (LIST 'COND (CONS |a| |b1|) (CONS ''T |c1|)))))))))
+
+(DEFUN |bfExit| (|a| |b|)
+ (PROG () (RETURN (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|))))))
+
+(DEFUN |bfMKPROGN| (|l|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a|
+ (LET ((|bfVar#102| NIL) (|c| |l|))
+ (LOOP
+ (COND
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#102|)))
+ ('T
+ (SETQ |bfVar#102|
+ (APPEND (REVERSE (|bfFlattenSeq| |c|))
+ |bfVar#102|))))
+ (SETQ |c| (CDR |c|)))))
+ (COND
+ ((NULL |a|) NIL)
+ ((NULL (CDR |a|)) (CAR |a|))
+ ('T (CONS 'PROGN |a|)))))))
+
+(DEFUN |bfFlattenSeq| (|x|)
+ (PROG (|f|)
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ (#0='T
+ (PROGN
+ (SETQ |f| (CAR |x|))
+ (COND
+ ((ATOM |f|) (COND ((CDR |x|) NIL) ('T (LIST |f|))))
+ ((EQCAR |f| 'PROGN)
+ (COND
+ ((CDR |x|)
+ (LET ((|bfVar#104| NIL) (|bfVar#103| (CDR |f|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#103|)
+ (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL))
+ (RETURN (NREVERSE |bfVar#104|)))
+ ('T
+ (AND (NULL (ATOM |i|))
+ (SETQ |bfVar#104| (CONS |i| |bfVar#104|)))))
+ (SETQ |bfVar#103| (CDR |bfVar#103|)))))
+ (#0# (CDR |f|))))
+ (#0# (LIST |f|)))))))))
+
+(DEFUN |bfSequence| (|l|)
+ (PROG (|f| |aft| |before| |no| |transform| |b| |ISTMP#5| |ISTMP#4|
+ |ISTMP#3| |a| |ISTMP#2| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |l|) NIL)
+ (#0='T
+ (PROGN
+ (SETQ |transform|
+ (LET ((|bfVar#106| NIL) (|bfVar#105| |l|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#105|)
+ (PROGN (SETQ |x| (CAR |bfVar#105|)) NIL)
+ (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN
+ (SETQ |ISTMP#2|
+ (CAR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |a|
+ (CAR |ISTMP#2|))
+ (SETQ |ISTMP#3|
+ (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |ISTMP#4|
+ (CAR |ISTMP#3|))
+ (AND (CONSP |ISTMP#4|)
+ (EQ (CAR |ISTMP#4|)
+ 'IDENTITY)
+ (PROGN
+ (SETQ |ISTMP#5|
+ (CDR |ISTMP#4|))
+ (AND
+ (CONSP |ISTMP#5|)
+ (EQ
+ (CDR |ISTMP#5|)
+ NIL)
+ (PROGN
+ (SETQ |b|
+ (CAR |ISTMP#5|))
+ 'T))))))))))))))
+ (RETURN (NREVERSE |bfVar#106|)))
+ ('T
+ (SETQ |bfVar#106|
+ (CONS (LIST |a| |b|) |bfVar#106|))))
+ (SETQ |bfVar#105| (CDR |bfVar#105|)))))
+ (SETQ |no| (LENGTH |transform|))
+ (SETQ |before| (|bfTake| |no| |l|))
+ (SETQ |aft| (|bfDrop| |no| |l|))
+ (COND
+ ((NULL |before|)
+ (COND
+ ((NULL (CDR |l|))
+ (PROGN
+ (SETQ |f| (CAR |l|))
+ (COND
+ ((EQCAR |f| 'PROGN) (|bfSequence| (CDR |f|)))
+ ('T |f|))))
+ (#0#
+ (|bfMKPROGN|
+ (LIST (CAR |l|) (|bfSequence| (CDR |l|)))))))
+ ((NULL |aft|) (CONS 'COND |transform|))
+ (#0#
+ (CONS 'COND
+ (APPEND |transform|
+ (CONS (LIST ''T (|bfSequence| |aft|)) NIL)))))))))))
+
+(DEFUN |bfWhere| (|context| |expr|)
+ (PROG (|a| |body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
+ |nondefs| |defs| |opassoc| |LETTMP#1|)
+ (DECLARE (SPECIAL |$wheredefs|))
+ (RETURN
+ (PROGN
+ (SETQ |LETTMP#1| (|defSheepAndGoats| |context|))
+ (SETQ |opassoc| (CAR |LETTMP#1|))
+ (SETQ |defs| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |nondefs| (CADDR . #0#))
+ (SETQ |a|
+ (LET ((|bfVar#108| NIL) (|bfVar#107| |defs|) (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#107|)
+ (PROGN (SETQ |d| (CAR |bfVar#107|)) NIL))
+ (RETURN (NREVERSE |bfVar#108|)))
+ ('T
+ (AND (CONSP |d|)
+ (PROGN
+ (SETQ |def| (CAR |d|))
+ (SETQ |ISTMP#1| (CDR |d|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |args| (CAR |ISTMP#2|))
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CDR |ISTMP#3|) NIL)
+ (PROGN
+ (SETQ |body| (CAR |ISTMP#3|))
+ 'T)))))))
+ (SETQ |bfVar#108|
+ (CONS (LIST |def| |op| |args|
+ (|bfSUBLIS| |opassoc| |body|))
+ |bfVar#108|)))))
+ (SETQ |bfVar#107| (CDR |bfVar#107|)))))
+ (SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
+ (|bfMKPROGN|
+ (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
+
+(DEFUN |bfReadLisp| (|string|)
+ (PROG () (RETURN (|bfTuple| (|shoeReadLispString| |string| 0)))))
+
+(DEFUN |bfCompHash| (|op| |argl| |body|)
+ (PROG (|computeFunction| |auxfn|)
+ (RETURN
+ (PROGN
+ (SETQ |auxfn| (INTERN (CONCAT (PNAME |op|) ";")))
+ (SETQ |computeFunction|
+ (CONS 'DEFUN (CONS |auxfn| (CONS |argl| |body|))))
+ (|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|)))))))
+
+(DEFUN |shoeCompileTimeEvaluation| (|x|)
+ (PROG () (RETURN (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|))))
+
+(DEFUN |shoeEVALANDFILEACTQ| (|x|)
+ (PROG ()
+ (RETURN (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|)
+ (RETURN
+ (PROGN
+ (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |arg| (LIST '&REST |g1|))
+ (SETQ |computeValue|
+ (LIST 'APPLY (LIST 'FUNCTION |auxfn|) |g1|))
+ (SETQ |cacheName| (INTERN (CONCAT (PNAME |op|) ";AL")))
+ (SETQ |g2| (|bfGenSymbol|))
+ (SETQ |getCode| (LIST 'GETHASH |g1| |cacheName|))
+ (SETQ |secondPredPair| (LIST (LIST 'SETQ |g2| |getCode|) |g2|))
+ (SETQ |putCode| (LIST 'SETF |getCode| |computeValue|))
+ (SETQ |thirdPredPair| (LIST ''T |putCode|))
+ (SETQ |codeBody|
+ (LIST 'PROG (LIST |g2|)
+ (LIST 'RETURN
+ (LIST 'COND |secondPredPair| |thirdPredPair|))))
+ (SETQ |mainFunction| (LIST 'DEFUN |op| |arg| |codeBody|))
+ (SETQ |cacheType| '|hash-table|)
+ (SETQ |cacheResetCode|
+ (LIST 'SETQ |cacheName|
+ (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL))))
+ (SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|))
+ (SETQ |cacheVector|
+ (LIST |op| |cacheName| |cacheType| |cacheResetCode|
+ |cacheCountCode|))
+ (LIST |mainFunction|
+ (|shoeEVALANDFILEACTQ|
+ (LIST 'SETF
+ (LIST 'GET (LIST 'QUOTE |op|)
+ (LIST 'QUOTE '|cacheInfo|))
+ (LIST 'QUOTE |cacheVector|)))
+ (|shoeEVALANDFILEACTQ| |cacheResetCode|))))))
+
+(DEFUN |bfNameOnly| (|x|)
+ (PROG () (RETURN (COND ((EQ |x| '|t|) (LIST 'T)) ('T (LIST |x|))))))
+
+(DEFUN |bfNameArgs| (|x| |y|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (SETQ |y|
+ (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|))))
+ (CONS |x| |y|)))))
+
+(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|))))))))
+
+(DEFUN |bfCreateDef| (|x|)
+ (PROG (|a| |f|)
+ (RETURN
+ (COND
+ ((NULL (CDR |x|)) (SETQ |f| (CAR |x|))
+ (LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
+ ('T
+ (SETQ |a|
+ (LET ((|bfVar#112| NIL) (|bfVar#111| (CDR |x|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#111|)
+ (PROGN (SETQ |i| (CAR |bfVar#111|)) NIL))
+ (RETURN (NREVERSE |bfVar#112|)))
+ ('T
+ (SETQ |bfVar#112|
+ (CONS (|bfGenSymbol|) |bfVar#112|))))
+ (SETQ |bfVar#111| (CDR |bfVar#111|)))))
+ (LIST 'DEFUN (CAR |x|) |a|
+ (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
+
+(DEFUN |bfCaseItem| (|x| |y|) (PROG () (RETURN (LIST |x| |y|))))
+
+(DEFUN |bfCase| (|x| |y|)
+ (PROG (|c| |b| |a| |g1| |g|)
+ (RETURN
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |a| (|bfLET| |g| |x|))
+ (SETQ |b| (|bfLET| |g1| (LIST 'CDR |g|)))
+ (SETQ |c| (|bfCaseItems| |g1| |y|))
+ (|bfMKPROGN|
+ (LIST |a| |b| (CONS 'CASE (CONS (LIST 'CAR |g|) |c|))))))))
+
+(DEFUN |bfCaseItems| (|g| |x|)
+ (PROG (|j| |ISTMP#1| |i|)
+ (RETURN
+ (LET ((|bfVar#115| NIL) (|bfVar#114| |x|) (|bfVar#113| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#114|)
+ (PROGN (SETQ |bfVar#113| (CAR |bfVar#114|)) NIL))
+ (RETURN (NREVERSE |bfVar#115|)))
+ ('T
+ (AND (CONSP |bfVar#113|)
+ (PROGN
+ (SETQ |i| (CAR |bfVar#113|))
+ (SETQ |ISTMP#1| (CDR |bfVar#113|))
+ (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|)))))))
+
+(DEFUN |bfCI| (|g| |x| |y|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (CDR |x|))
+ (COND
+ ((NULL |a|) (LIST (CAR |x|) |y|))
+ ('T
+ (SETQ |b|
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |a|) (|i| NIL)
+ (|j| 0))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |i| (CAR |bfVar#116|)) NIL))
+ (RETURN (NREVERSE |bfVar#117|)))
+ ('T
+ (SETQ |bfVar#117|
+ (CONS (LIST |i| (|bfCARCDR| |j| |g|))
+ |bfVar#117|))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|))
+ (SETQ |j| (+ |j| 1)))))
+ (LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
+
+(DEFUN |bfCARCDR| (|n| |g|)
+ (PROG ()
+ (RETURN (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|))))
+
+(DEFUN |bfDs| (|n|)
+ (PROG ()
+ (RETURN
+ (COND ((EQL |n| 0) "") ('T (CONCAT "D" (|bfDs| (- |n| 1))))))))
+
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
new file mode 100644
index 00000000..a2324315
--- /dev/null
+++ b/src/boot/strap/includer.clisp
@@ -0,0 +1,553 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-includer"))
+
+(IMPORT-MODULE "tokens")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFUN PNAME (|x|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((SYMBOLP |x|) (SYMBOL-NAME |x|))
+ ((CHARACTERP |x|) (STRING |x|))
+ ('T NIL)))))
+
+(DEFUN |char| (|x|) (PROG () (RETURN (CHAR (PNAME |x|) 0))))
+
+(DEFUN EQCAR (|x| |y|)
+ (PROG () (RETURN (AND (CONSP |x|) (EQ (CAR |x|) |y|)))))
+
+(DEFUN STRINGIMAGE (|x|) (PROG () (RETURN (WRITE-TO-STRING |x|))))
+
+(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
+
+(DEFUN |shoeNotFound| (|fn|)
+ (PROG ()
+ (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
+
+(DEFUN |shoeReadLispString| (|s| |n|)
+ (PROG (|l|)
+ (RETURN
+ (PROGN
+ (SETQ |l| (LENGTH |s|))
+ (COND
+ ((NOT (< |n| |l|)) NIL)
+ ('T
+ (READ-FROM-STRING
+ (CONCAT '|(| (SUBSTRING |s| |n| (- |l| |n|)) '|)|))))))))
+
+(DEFUN |shoeReadLine| (|stream|)
+ (PROG () (RETURN (READ-LINE |stream| NIL NIL))))
+
+(DEFUN |shoeConsole| (|line|)
+ (PROG () (RETURN (WRITE-LINE |line| *TERMINAL-IO*))))
+
+(DEFUN |shoeSpaces| (|n|) (PROG () (RETURN (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|)))))
+
+(DEFUN |bpSpecificErrorAtToken| (|tok| |key|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeTokPosn| |tok|))
+ (|SoftShoeError| |a| |key|)))))
+
+(DEFUN |bpSpecificErrorHere| (|key|)
+ (PROG ()
+ (DECLARE (SPECIAL |$stok|))
+ (RETURN (|bpSpecificErrorAtToken| |$stok| |key|))))
+
+(DEFUN |bpGeneralErrorHere| ()
+ (PROG () (RETURN (|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|)) "|"))))))
+
+(DEFUN |lineNo| (|p|) (PROG () (RETURN (CDAAR |p|))))
+
+(DEFUN |lineString| (|p|) (PROG () (RETURN (CAAAR |p|))))
+
+(DEFUN |lineCharacter| (|p|) (PROG () (RETURN (CDR |p|))))
+
+(DEFUN |shoePackageStartsAt| (|lines| |sz| |name| |stream|)
+ (PROG (|a|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |stream|) (LIST NIL (LIST '|nullstream|)))
+ ('T
+ (PROGN
+ (SETQ |a| (CAAR |stream|))
+ (COND
+ ((AND (NOT (< (LENGTH |a|) 8))
+ (EQUAL (SUBSTRING |a| 0 8) ")package"))
+ (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|)
+ |sz| |name| (CDR |stream|)))
+ ((< (LENGTH |a|) |sz|)
+ (|shoePackageStartsAt| |lines| |sz| |name|
+ (CDR |stream|)))
+ ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
+ (< |sz| (LENGTH |a|))
+ (NULL (|shoeIdChar| (ELT |a| |sz|))))
+ (LIST |lines| |stream|))
+ ('T
+ (|shoePackageStartsAt| |lines| |sz| |name|
+ (CDR |stream|))))))))))
+
+(DEFUN |shoeFindLines| (|fn| |name| |a|)
+ (PROG (|b| |lines| |LETTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|) NIL)
+ (#0='T
+ (SETQ |LETTMP#1|
+ (|shoePackageStartsAt| NIL (LENGTH |name|) |name|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0)))))
+ (SETQ |lines| (CAR |LETTMP#1|)) (SETQ |b| (CADR |LETTMP#1|))
+ (SETQ |b| (|shoeTransform2| |b|))
+ (COND
+ ((|bStreamNull| |b|)
+ (|shoeConsole| (CONCAT |name| " not found in " |fn|)) NIL)
+ (#0#
+ (COND
+ ((NULL |lines|) (|shoeConsole| ")package not found")))
+ (APPEND (REVERSE |lines|) (CAR |b|)))))))))
+
+(DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))
+
+(DEFUN |bStreamNull| (|x|)
+ (PROG (|st|)
+ (RETURN
+ (COND
+ ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
+ ('T
+ (PROGN
+ (LOOP
+ (COND
+ ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
+ (RPLACA |x| (CAR |st|))
+ (RPLACD |x| (CDR |st|))))))
+ (EQCAR |x| '|nullstream|)))))))
+
+(DEFUN |bMap| (|f| |x|)
+ (PROG () (RETURN (|bDelay| #'|bMap1| (LIST |f| |x|)))))
+
+(DEFUN |bMap1| (&REST |z|)
+ (PROG (|x| |f|)
+ (DECLARE (SPECIAL |$bStreamNil|))
+ (RETURN
+ (PROGN
+ (SETQ |f| (CAR |z|))
+ (SETQ |x| (CADR |z|))
+ (COND
+ ((|bStreamNull| |x|) |$bStreamNil|)
+ ('T (CONS (FUNCALL |f| (CAR |x|)) (|bMap| |f| (CDR |x|)))))))))
+
+(DEFUN |shoeFileMap| (|f| |fn|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$bStreamNil|))
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeInputFile| |fn|))
+ (COND
+ ((NULL |a|)
+ (PROGN
+ (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
+ |$bStreamNil|))
+ ('T
+ (PROGN
+ (|shoeConsole| (CONCAT "READING " |fn|))
+ (|shoeInclude|
+ (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
+ (|bIgen| 0))))))))))
+
+(DEFUN |bDelay| (|f| |x|)
+ (PROG () (RETURN (CONS '|nonnullstream| (CONS |f| |x|)))))
+
+(DEFUN |bAppend| (|x| |y|)
+ (PROG () (RETURN (|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|))))))))
+
+(DEFUN |bNext| (|f| |s|)
+ (PROG () (RETURN (|bDelay| #'|bNext1| (LIST |f| |s|)))))
+
+(DEFUN |bNext1| (|f| |s|)
+ (PROG (|h|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (LIST '|nullstream|))
+ ('T
+ (PROGN
+ (SETQ |h| (APPLY |f| (LIST |s|)))
+ (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
+
+(DEFUN |bRgen| (|s|)
+ (PROG () (RETURN (|bDelay| #'|bRgen1| (LIST |s|)))))
+
+(DEFUN |bRgen1| (&REST |s|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeReadLine| (CAR |s|)))
+ (COND
+ ((|shoePLACEP| |a|) (LIST '|nullstream|))
+ ('T (CONS |a| (|bRgen| (CAR |s|)))))))))
+
+(DEFUN |bIgen| (|n|)
+ (PROG () (RETURN (|bDelay| #'|bIgen1| (LIST |n|)))))
+
+(DEFUN |bIgen1| (&REST |n|)
+ (PROG ()
+ (RETURN
+ (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))))
+
+(DEFUN |bAddLineNumber| (|f1| |f2|)
+ (PROG () (RETURN (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))))
+
+(DEFUN |bAddLineNumber1| (&REST |f|)
+ (PROG (|f2| |f1|)
+ (RETURN
+ (PROGN
+ (SETQ |f1| (CAR |f|))
+ (SETQ |f2| (CADR |f|))
+ (COND
+ ((|bStreamNull| |f1|) (LIST '|nullstream|))
+ ((|bStreamNull| |f2|) (LIST '|nullstream|))
+ ('T
+ (CONS (CONS (CAR |f1|) (CAR |f2|))
+ (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))))))
+
+(DEFUN |shoeFileInput| (|fn|)
+ (PROG () (RETURN (|shoeFileMap| #'IDENTITY |fn|))))
+
+(DEFUN |shoePrefixLisp| (|x|) (PROG () (RETURN (CONCAT ")lisp" |x|))))
+
+(DEFUN |shoeLispFileInput| (|fn|)
+ (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLisp| |fn|))))
+
+(DEFUN |shoePrefixLine| (|x|) (PROG () (RETURN (CONCAT ")line" |x|))))
+
+(DEFUN |shoeLineFileInput| (|fn|)
+ (PROG () (RETURN (|shoeFileMap| #'|shoePrefixLine| |fn|))))
+
+(DEFUN |shoePrefix?| (|prefix| |whole|)
+ (PROG (|good|)
+ (RETURN
+ (COND
+ ((< (LENGTH |whole|) (LENGTH |prefix|)) NIL)
+ ('T
+ (PROGN
+ (SETQ |good| T)
+ (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
+ (LOOP
+ (COND
+ ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
+ ('T
+ (SETQ |good|
+ (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ |j| (+ |j| 1))))
+ (COND
+ (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
+ ('T |good|))))))))
+
+(DEFUN |shoePlainLine?| (|s|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((EQL (LENGTH |s|) 0) T)
+ ('T (NOT (EQUAL (ELT |s| 0) (|char| '|)|))))))))
+
+(DEFUN |shoeSay?| (|s|) (PROG () (RETURN (|shoePrefix?| ")say" |s|))))
+
+(DEFUN |shoeEval?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")eval" |s|))))
+
+(DEFUN |shoeInclude?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")include" |s|))))
+
+(DEFUN |shoeFin?| (|s|) (PROG () (RETURN (|shoePrefix?| ")fin" |s|))))
+
+(DEFUN |shoeIf?| (|s|) (PROG () (RETURN (|shoePrefix?| ")if" |s|))))
+
+(DEFUN |shoeEndIf?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")endif" |s|))))
+
+(DEFUN |shoeElse?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")else" |s|))))
+
+(DEFUN |shoeElseIf?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")elseif" |s|))))
+
+(DEFUN |shoePackage?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")package" |s|))))
+
+(DEFUN |shoeLisp?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")lisp" |s|))))
+
+(DEFUN |shoeIncludeLisp?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")includelisp" |s|))))
+
+(DEFUN |shoeLine?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")line" |s|))))
+
+(DEFUN |shoeIncludeLines?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")includelines" |s|))))
+
+(DEFUN |shoeIncludeFunction?| (|s|)
+ (PROG () (RETURN (|shoePrefix?| ")includefunction" |s|))))
+
+(DEFUN |shoeBiteOff| (|x|)
+ (PROG (|n1| |n|)
+ (RETURN
+ (PROGN
+ (SETQ |n| (STRPOSL " " |x| 0 T))
+ (COND
+ ((NULL |n|) NIL)
+ (#0='T
+ (PROGN
+ (SETQ |n1| (STRPOSL " " |x| |n| NIL))
+ (COND
+ ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
+ (#0#
+ (LIST (SUBSTRING |x| |n| (- |n1| |n|))
+ (SUBSTRING |x| |n1| NIL)))))))))))
+
+(DEFUN |shoeFileName| (|x|)
+ (PROG (|c| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeBiteOff| |x|))
+ (COND
+ ((NULL |a|) "")
+ (#0='T
+ (PROGN
+ (SETQ |c| (|shoeBiteOff| (CADR |a|)))
+ (COND
+ ((NULL |c|) (CAR |a|))
+ (#0# (CONCAT (CAR |a|) "." (CAR |c|)))))))))))
+
+(DEFUN |shoeFnFileName| (|x|)
+ (PROG (|c| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeBiteOff| |x|))
+ (COND
+ ((NULL |a|) (LIST "" ""))
+ (#0='T
+ (PROGN
+ (SETQ |c| (|shoeFileName| (CADR |a|)))
+ (COND
+ ((NULL |c|) (LIST (CAR |a|) ""))
+ (#0# (LIST (CAR |a|) |c|))))))))))
+
+(DEFUN |shoeFunctionFileInput| (|bfVar#2|)
+ (PROG (|fn| |fun|)
+ (RETURN
+ (PROGN
+ (SETQ |fun| (CAR |bfVar#2|))
+ (SETQ |fn| (CADR |bfVar#2|))
+ (|shoeOpenInputFile| |a| |fn|
+ (|shoeInclude|
+ (|bAddLineNumber| (|shoeFindLines| |fn| |fun| |a|)
+ (|bIgen| 0))))))))
+
+(DEFUN |shoeInclude| (|s|)
+ (PROG () (RETURN (|bDelay| #'|shoeInclude1| (LIST |s|)))))
+
+(DEFUN |shoeInclude1| (|s|)
+ (PROG (|command| |string| |t| |h|)
+ (DECLARE (SPECIAL |$bStreamNil|))
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) |s|)
+ (#0='T
+ (PROGN
+ (SETQ |h| (CAR |s|))
+ (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
+ ((SETQ |command| (|shoeIf?| |string|))
+ (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
+ (#0#
+ (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|))))))))))
+
+(DEFUN |shoeSimpleLine| (|h|)
+ (PROG (|command| |string|)
+ (RETURN
+ (PROGN
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((|shoePlainLine?| |string|) (LIST |h|))
+ ((SETQ |command| (|shoeLisp?| |string|)) (LIST |h|))
+ ((SETQ |command| (|shoeIncludeLisp?| |string|))
+ (|shoeLispFileInput| (|shoeFileName| |command|)))
+ ((SETQ |command| (|shoeIncludeFunction?| |string|))
+ (|shoeFunctionFileInput| (|shoeFnFileName| |command|)))
+ ((SETQ |command| (|shoeLine?| |string|)) (LIST |h|))
+ ((SETQ |command| (|shoeIncludeLines?| |string|))
+ (|shoeLineFileInput| (|shoeFileName| |command|)))
+ ((SETQ |command| (|shoeInclude?| |string|))
+ (|shoeFileInput| (|shoeFileName| |command|)))
+ ((SETQ |command| (|shoePackage?| |string|)) (LIST |h|))
+ ((SETQ |command| (|shoeSay?| |string|))
+ (PROGN (|shoeConsole| |command|) NIL))
+ ((SETQ |command| (|shoeEval?| |string|))
+ (PROGN (STTOMC |command|) NIL))
+ ('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
+
+(DEFUN |shoeThen| (|keep| |b| |s|)
+ (PROG () (RETURN (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))))
+
+(DEFUN |shoeThen1| (|keep| |b| |s|)
+ (PROG (|b1| |keep1| |command| |string| |t| |h|)
+ (RETURN
+ (COND
+ ((|bPremStreamNull| |s|) |s|)
+ (#0='T
+ (PROGN
+ (SETQ |h| (CAR |s|))
+ (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|))
+ (|bPremStreamNil| |h|))
+ (#0#
+ (PROGN
+ (SETQ |keep1| (CAR |keep|))
+ (SETQ |b1| (CAR |b|))
+ (COND
+ ((SETQ |command| (|shoeIf?| |string|))
+ (COND
+ ((AND |keep1| |b1|)
+ (|shoeThen| (CONS T |keep|)
+ (CONS (STTOMC |command|) |b|) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+ ((SETQ |command| (|shoeElseIf?| |string|))
+ (COND
+ ((AND |keep1| (NULL |b1|))
+ (|shoeThen| (CONS T (CDR |keep|))
+ (CONS (STTOMC |command|) (CDR |b|)) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL (CDR |keep|))
+ (CONS NIL (CDR |b|)) |t|))))
+ ((SETQ |command| (|shoeElse?| |string|))
+ (COND
+ ((AND |keep1| (NULL |b1|))
+ (|shoeElse| (CONS T (CDR |keep|))
+ (CONS T (CDR |b|)) |t|))
+ (#0#
+ (|shoeElse| (CONS NIL (CDR |keep|))
+ (CONS NIL (CDR |b|)) |t|))))
+ ((SETQ |command| (|shoeEndIf?| |string|))
+ (COND
+ ((NULL (CDR |b|)) (|shoeInclude| |t|))
+ (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+ ((AND |keep1| |b1|)
+ (|bAppend| (|shoeSimpleLine| |h|)
+ (|shoeThen| |keep| |b| |t|)))
+ (#0# (|shoeThen| |keep| |b| |t|))))))))))))
+
+(DEFUN |shoeElse| (|keep| |b| |s|)
+ (PROG () (RETURN (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))))
+
+(DEFUN |shoeElse1| (|keep| |b| |s|)
+ (PROG (|keep1| |b1| |command| |string| |t| |h|)
+ (RETURN
+ (COND
+ ((|bPremStreamNull| |s|) |s|)
+ (#0='T
+ (PROGN
+ (SETQ |h| (CAR |s|))
+ (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|))
+ (|bPremStreamNil| |h|))
+ (#0#
+ (PROGN
+ (SETQ |b1| (CAR |b|))
+ (SETQ |keep1| (CAR |keep|))
+ (COND
+ ((SETQ |command| (|shoeIf?| |string|))
+ (COND
+ ((AND |keep1| |b1|)
+ (|shoeThen| (CONS T |keep|)
+ (CONS (STTOMC |command|) |b|) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+ ((SETQ |command| (|shoeEndIf?| |string|))
+ (COND
+ ((NULL (CDR |b|)) (|shoeInclude| |t|))
+ (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+ ((AND |keep1| |b1|)
+ (|bAppend| (|shoeSimpleLine| |h|)
+ (|shoeElse| |keep| |b| |t|)))
+ (#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")))))
+
+(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|))))
+
+(DEFUN |bPremStreamNull| (|s|)
+ (PROG ()
+ (RETURN
+ (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
new file mode 100644
index 00000000..cfc9b0fa
--- /dev/null
+++ b/src/boot/strap/parser.clisp
@@ -0,0 +1,1331 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-parser"))
+
+(IMPORT-MODULE "includer")
+
+(IMPORT-MODULE "scanner")
+
+(IMPORT-MODULE "ast")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |$sawParenthesizedHead| NIL)
+
+(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))))
+
+(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))))))
+
+(DEFUN |bpNext| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$inputStream|))
+ (RETURN
+ (PROGN
+ (SETQ |$inputStream| (CDR |$inputStream|))
+ (|bpFirstTok|)))))
+
+(DEFUN |bpNextToken| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$inputStream|))
+ (RETURN
+ (PROGN
+ (SETQ |$inputStream| (CDR |$inputStream|))
+ (|bpFirstToken|)))))
+
+(DEFUN |bpState| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack|
+ |$inputStream|))
+ (RETURN (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))))
+
+(DEFUN |bpPush| (|x|)
+ (PROG ()
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN (SETQ |$stack| (CONS |x| |$stack|)))))
+
+(DEFUN |bpPushId| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$stack| |$ttok|))
+ (RETURN (SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))))
+
+(DEFUN |bpPop1| ()
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (PROGN
+ (SETQ |a| (CAR |$stack|))
+ (SETQ |$stack| (CDR |$stack|))
+ |a|))))
+
+(DEFUN |bpPop2| ()
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (PROGN
+ (SETQ |a| (CADR |$stack|))
+ (RPLACD |$stack| (CDDR |$stack|))
+ |a|))))
+
+(DEFUN |bpPop3| ()
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (PROGN
+ (SETQ |a| (CADDR |$stack|))
+ (RPLACD (CDR |$stack|) (CDDDR |$stack|))
+ |a|))))
+
+(DEFUN |bpIndentParenthesized| (|f|)
+ (PROG (|$bpCount| |a|)
+ (DECLARE (SPECIAL |$inputStream| |$bpCount| |$bpParenCount|
+ |$stok|))
+ (RETURN
+ (PROGN
+ (SETQ |$bpCount| 0)
+ (SETQ |a| |$stok|)
+ (COND
+ ((|bpEqPeek| 'OPAREN)
+ (SETQ |$bpParenCount| (+ |$bpParenCount| 1)) (|bpNext|)
+ (COND
+ ((AND (APPLY |f| NIL) (|bpFirstTok|)
+ (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1))
+ (|bpNextToken|)
+ (COND
+ ((EQL |$bpCount| 0) T)
+ (#0='T
+ (PROGN
+ (SETQ |$inputStream|
+ (APPEND (|bpAddTokens| |$bpCount|)
+ |$inputStream|))
+ (|bpFirstToken|)
+ (COND
+ ((EQL |$bpParenCount| 0) (PROGN (|bpCancel|) T))
+ (#0# T))))))
+ ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
+ (SETQ |$bpParenCount| (- |$bpParenCount| 1))
+ (|bpNextToken|) T)
+ (#1='T (|bpParenTrap| |a|))))
+ (#1# NIL))))))
+
+(DEFUN |bpParenthesized| (|f|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stok|))
+ (RETURN
+ (PROGN
+ (SETQ |a| |$stok|)
+ (COND
+ ((|bpEqKey| 'OPAREN)
+ (COND
+ ((AND (APPLY |f| NIL)
+ (OR (|bpEqKey| 'CPAREN) (|bpParenTrap| |a|)))
+ T)
+ ((|bpEqKey| 'CPAREN) (|bpPush| (|bfTuple| NIL)) T)
+ (#0='T (|bpParenTrap| |a|))))
+ (#0# NIL))))))
+
+(DEFUN |bpBracket| (|f|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stok|))
+ (RETURN
+ (PROGN
+ (SETQ |a| |$stok|)
+ (COND
+ ((|bpEqKey| 'OBRACK)
+ (COND
+ ((AND (APPLY |f| NIL)
+ (OR (|bpEqKey| 'CBRACK) (|bpBrackTrap| |a|)))
+ (|bpPush| (|bfBracket| (|bpPop1|))))
+ ((|bpEqKey| 'CBRACK) (|bpPush| NIL))
+ (#0='T (|bpBrackTrap| |a|))))
+ (#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)))))
+
+(DEFUN |bpListof| (|f| |str1| |g|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (COND
+ ((APPLY |f| NIL)
+ (COND
+ ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))
+ (SETQ |a| |$stack|) (SETQ |$stack| NIL)
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
+ (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (|bpPush|
+ (FUNCALL |g|
+ (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (#0='T T)))
+ (#0# NIL)))))
+
+(DEFUN |bpListofFun| (|f| |h| |g|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (COND
+ ((APPLY |f| NIL)
+ (COND
+ ((AND (APPLY |h| NIL) (OR (APPLY |f| NIL) (|bpTrap|)))
+ (SETQ |a| |$stack|) (SETQ |$stack| NIL)
+ (LOOP
+ (COND
+ ((NOT (AND (APPLY |h| NIL)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
+ (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (|bpPush|
+ (FUNCALL |g|
+ (|bfListOf|
+ (CONS (|bpPop3|)
+ (CONS (|bpPop2|) (|bpPop1|)))))))
+ (#0='T T)))
+ (#0# NIL)))))
+
+(DEFUN |bpList| (|f| |str1| |g|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (COND
+ ((APPLY |f| NIL)
+ (COND
+ ((AND (|bpEqKey| |str1|) (OR (APPLY |f| NIL) (|bpTrap|)))
+ (SETQ |a| |$stack|) (SETQ |$stack| NIL)
+ (LOOP
+ (COND
+ ((NOT (AND (|bpEqKey| |str1|)
+ (OR (APPLY |f| NIL) (|bpTrap|))))
+ (RETURN NIL))
+ ('T 0)))
+ (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (|bpPush|
+ (FUNCALL |g|
+ (CONS (|bpPop3|) (CONS (|bpPop2|) (|bpPop1|))))))
+ (#0='T (|bpPush| (FUNCALL |g| (LIST (|bpPop1|)))))))
+ (#0# (|bpPush| (FUNCALL |g| NIL)))))))
+
+(DEFUN |bpOneOrMore| (|f|)
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$stack|))
+ (RETURN
+ (COND
+ ((APPLY |f| NIL)
+ (PROGN
+ (SETQ |a| |$stack|)
+ (SETQ |$stack| NIL)
+ (LOOP (COND ((NOT (APPLY |f| NIL)) (RETURN NIL)) ('T 0)))
+ (SETQ |$stack| (CONS (NREVERSE |$stack|) |a|))
+ (|bpPush| (CONS (|bpPop2|) (|bpPop1|)))))
+ ('T NIL)))))
+
+(DEFUN |bpAnyNo| (|s|)
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(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)))))
+
+(DEFUN |bpElse| (|f|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((|bpBacksetElse|)
+ (AND (OR (APPLY |f| NIL) (|bpTrap|))
+ (|bpPush| (|bfIf| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))
+ ('T (|bpRestore| |a|)
+ (|bpPush| (|bfIfThenOnly| (|bpPop2|) (|bpPop1|)))))))))
+
+(DEFUN |bpBacksetElse| ()
+ (PROG ()
+ (RETURN
+ (COND
+ ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE))
+ ('T (|bpEqKey| 'ELSE))))))
+
+(DEFUN |bpEqPeek| (|s|)
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|)))))
+
+(DEFUN |bpEqKey| (|s|)
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN (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|)))))
+
+(DEFUN |bpPileTrap| () (PROG () (RETURN (|bpMissing| 'BACKTAB))))
+
+(DEFUN |bpBrackTrap| (|x|)
+ (PROG () (RETURN (|bpMissingMate| '] |x|))))
+
+(DEFUN |bpParenTrap| (|x|)
+ (PROG () (RETURN (|bpMissingMate| '|)| |x|))))
+
+(DEFUN |bpMissingMate| (|close| |open|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (|bpSpecificErrorAtToken| |open| "possibly missing mate")
+ (|bpMissing| |close|)))))
+
+(DEFUN |bpMissing| (|s|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (|bpSpecificErrorHere|
+ (CONCAT (PNAME |s|) " possibly missing"))
+ (THROW 'TRAPPOINT 'TRAPPED)))))
+
+(DEFUN |bpCompMissing| (|s|)
+ (PROG () (RETURN (OR (|bpEqKey| |s|) (|bpMissing| |s|)))))
+
+(DEFUN |bpTrap| ()
+ (PROG ()
+ (RETURN
+ (PROGN (|bpGeneralErrorHere|) (THROW 'TRAPPOINT 'TRAPPED)))))
+
+(DEFUN |bpRecoverTrap| ()
+ (PROG (|pos2| |pos1|)
+ (DECLARE (SPECIAL |$stok|))
+ (RETURN
+ (PROGN
+ (|bpFirstToken|)
+ (SETQ |pos1| (|shoeTokPosn| |$stok|))
+ (|bpMoveTo| 0)
+ (SETQ |pos2| (|shoeTokPosn| |$stok|))
+ (|bpIgnoredFromTo| |pos1| |pos2|)
+ (|bpPush| (LIST (LIST "pile syntax error")))))))
+
+(DEFUN |bpListAndRecover| (|f|)
+ (PROG (|found| |c| |done| |b| |a|)
+ (DECLARE (SPECIAL |$inputStream| |$stack|))
+ (RETURN
+ (PROGN
+ (SETQ |a| |$stack|)
+ (SETQ |b| NIL)
+ (SETQ |$stack| NIL)
+ (SETQ |done| NIL)
+ (SETQ |c| |$inputStream|)
+ (LOOP
+ (COND
+ (|done| (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |found| (CATCH 'TRAPPOINT (APPLY |f| NIL)))
+ (COND
+ ((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
+ (|bpRecoverTrap|))
+ ((NULL |found|) (SETQ |$inputStream| |c|)
+ (|bpGeneralErrorHere|) (|bpRecoverTrap|)))
+ (COND
+ ((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
+ ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
+ (SETQ |done| T))
+ (#0='T (SETQ |$inputStream| |c|)
+ (|bpGeneralErrorHere|) (|bpRecoverTrap|)
+ (COND
+ ((OR (|bpEqPeek| 'BACKTAB) (NULL |$inputStream|))
+ (SETQ |done| T))
+ (#0# (|bpNext|) (SETQ |c| |$inputStream|)))))
+ (SETQ |b| (CONS (|bpPop1|) |b|))))))
+ (SETQ |$stack| |a|)
+ (|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|)))))))
+
+(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)))))
+
+(DEFUN |bpName| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$stok|))
+ (RETURN
+ (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|))))))
+
+(DEFUN |bpModule| ()
+ (PROG ()
+ (RETURN
+ (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)))))
+
+(DEFUN |bpTypeAliasDefition| ()
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(DEFUN |bpMapping| ()
+ (PROG ()
+ (RETURN
+ (AND (OR (|bpName|) (|bpIdList|)) (|bpEqKey| 'ARROW) (|bpName|)
+ (|bpPush| (|Mapping| (|bpPop1|) (|bpPop1|)))))))
+
+(DEFUN |bpCancel| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((|bpEqKeyNextTok| 'SETTAB)
+ (COND
+ ((|bpCancel|)
+ (COND
+ ((|bpEqKeyNextTok| 'BACKTAB) T)
+ (#0='T (|bpRestore| |a|) NIL)))
+ ((|bpEqKeyNextTok| 'BACKTAB) T)
+ (#0# (|bpRestore| |a|) NIL)))
+ (#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))))))))
+
+(DEFUN |bpExceptions| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
+ (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB)
+ (|bpEqPeek| 'BACKTAB) (|bpEqPeek| 'BACKSET)))))
+
+(DEFUN |bpSexpKey| ()
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN
+ (COND
+ ((AND (EQCAR |$stok| 'KEY) (NULL (|bpExceptions|)))
+ (PROGN
+ (SETQ |a| (GET |$ttok| 'SHOEINF))
+ (COND
+ ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|)))
+ (#0='T (AND (|bpPush| |a|) (|bpNext|))))))
+ (#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|))))))
+
+(DEFUN |bpSexp| ()
+ (PROG ()
+ (RETURN
+ (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)))))
+
+(DEFUN |bpPrimary1| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpName|) (|bpDot|) (|bpConstTok|) (|bpConstruct|)
+ (|bpCase|) (|bpStruct|) (|bpPDefinition|)
+ (|bpBPileDefinition|)))))
+
+(DEFUN |bpPrimary| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpFirstTok|) (OR (|bpPrimary1|) (|bpPrefixOperator|))))))
+
+(DEFUN |bpDot| ()
+ (PROG () (RETURN (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))))
+
+(DEFUN |bpPrefixOperator| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN
+ (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|)))))
+
+(DEFUN |bpSelector| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpEqKey| 'DOT)
+ (OR (AND (|bpPrimary|)
+ (|bpPush| (|bfElt| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfSuffixDot| (|bpPop1|))))))))
+
+(DEFUN |bpOperator| ()
+ (PROG () (RETURN (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)))))
+
+(DEFUN |bpApplication| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpPrimary|) (|bpAnyNo| #'|bpSelector|)
+ (OR (AND (|bpApplication|)
+ (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ T)))))
+
+(DEFUN |bpTagged| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpApplication|)
+ (OR (AND (|bpEqKey| 'COLON)
+ (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
+ T)))))
+
+(DEFUN |bpExpt| ()
+ (PROG () (RETURN (|bpRightAssoc| '(POWER) #'|bpTagged|))))
+
+(DEFUN |bpInfKey| (|s|)
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN
+ (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|)
+ (|bpNext|)))))
+
+(DEFUN |bpInfGeneric| (|s|)
+ (PROG ()
+ (RETURN (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T)))))
+
+(DEFUN |bpRightAssoc| (|o| |p|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((APPLY |p| NIL)
+ (LOOP
+ (COND
+ ((NOT (AND (|bpInfGeneric| |o|)
+ (OR (|bpRightAssoc| |o| |p|) (|bpTrap|))))
+ (RETURN NIL))
+ ('T
+ (|bpPush|
+ (|bfInfApplication| (|bpPop2|) (|bpPop2|)
+ (|bpPop1|))))))
+ T)
+ ('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)))))
+
+(DEFUN |bpString| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN
+ (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)))))
+
+(DEFUN |bpReduceOperator| ()
+ (PROG ()
+ (RETURN (OR (|bpInfixOperator|) (|bpString|) (|bpThetaName|)))))
+
+(DEFUN |bpReduce| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((AND (|bpReduceOperator|) (|bpEqKey| 'SLASH))
+ (COND
+ ((|bpEqPeek| 'OBRACK)
+ (AND (OR (|bpDConstruct|) (|bpTrap|))
+ (|bpPush| (|bfReduceCollect| (|bpPop2|) (|bpPop1|)))))
+ ('T
+ (AND (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|bfReduce| (|bpPop2|) (|bpPop1|)))))))
+ ('T (|bpRestore| |a|) NIL))))))
+
+(DEFUN |bpTimes| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpReduce|) (|bpLeftAssoc| '(TIMES SLASH) #'|bpExpt|)))))
+
+(DEFUN |bpMinus| ()
+ (PROG ()
+ (RETURN
+ (OR (AND (|bpInfGeneric| '(MINUS)) (OR (|bpTimes|) (|bpTrap|))
+ (|bpPush| (|bfApplication| (|bpPop2|) (|bpPop1|))))
+ (|bpTimes|)))))
+
+(DEFUN |bpArith| ()
+ (PROG () (RETURN (|bpLeftAssoc| '(PLUS MINUS) #'|bpMinus|))))
+
+(DEFUN |bpIs| ()
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(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)))))
+
+(DEFUN |bpAnd| ()
+ (PROG () (RETURN (|bpLeftAssoc| '(AND) #'|bpCompare|))))
+
+(DEFUN |bpNoteReturnStmt| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$bodyHasReturn|))
+ (RETURN (PROGN (SETQ |$bodyHasReturn| T) T))))
+
+(DEFUN |bpReturn| ()
+ (PROG ()
+ (RETURN
+ (OR (AND (|bpEqKey| 'RETURN) (|bpNoteReturnStmt|)
+ (OR (|bpAnd|) (|bpTrap|))
+ (|bpPush| (|bfReturnNoName| (|bpPop1|))))
+ (|bpAnd|)))))
+
+(DEFUN |bpLogical| ()
+ (PROG () (RETURN (|bpLeftAssoc| '(OR) #'|bpReturn|))))
+
+(DEFUN |bpExpression| ()
+ (PROG ()
+ (RETURN
+ (OR (AND (|bpEqKey| 'COLON)
+ (OR (AND (|bpLogical|)
+ (|bpPush| (|bfApplication| 'COLON (|bpPop1|))))
+ (|bpTrap|)))
+ (|bpLogical|)))))
+
+(DEFUN |bpStatement| ()
+ (PROG ()
+ (RETURN
+ (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|))))))))
+
+(DEFUN |bpSuchThat| ()
+ (PROG () (RETURN (|bpAndOr| 'BAR #'|bpWhere| #'|bfSuchthat|))))
+
+(DEFUN |bpWhile| ()
+ (PROG () (RETURN (|bpAndOr| 'WHILE #'|bpLogical| #'|bfWhile|))))
+
+(DEFUN |bpUntil| ()
+ (PROG () (RETURN (|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|))))))))
+
+(DEFUN |bpSeg| ()
+ (PROG ()
+ (RETURN
+ (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|)))))
+
+(DEFUN |bpIteratorList| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpOneOrMore| #'|bpIterator|)
+ (|bpPush| (|bfIterators| (|bpPop1|)))))))
+
+(DEFUN |bpCrossBackSet| ()
+ (PROG ()
+ (RETURN (AND (|bpEqKey| 'CROSS) (OR (|bpEqKey| 'BACKSET) T)))))
+
+(DEFUN |bpIterators| ()
+ (PROG ()
+ (RETURN
+ (|bpListofFun| #'|bpIteratorList| #'|bpCrossBackSet| #'|bfCross|))))
+
+(DEFUN |bpAssign| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((|bpStatement|)
+ (COND
+ ((|bpEqPeek| 'BEC) (|bpRestore| |a|)
+ (OR (|bpAssignment|) (|bpTrap|)))
+ (#0='T T)))
+ (#0# (|bpRestore| |a|) NIL))))))
+
+(DEFUN |bpAssignment| ()
+ (PROG ()
+ (RETURN
+ (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)))))
+
+(DEFUN |bpBeginDefinition| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (RETURN
+ (OR (|bpEqPeek| 'DEF)
+ (AND |$sawParenthesizedHead| (|bpEqPeek| 'COLON))))))
+
+(DEFUN |bpDefinition| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((|bpExit|)
+ (COND
+ ((|bpBeginDefinition|)
+ (PROGN (|bpRestore| |a|) (|bpDef|)))
+ ((|bpEqPeek| 'TDEF)
+ (PROGN (|bpRestore| |a|) (|bpTypeAliasDefition|)))
+ ((|bpEqPeek| 'MDEF) (PROGN (|bpRestore| |a|) (|bpMdef|)))
+ (#0='T T)))
+ (#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))))
+
+(DEFUN |bpReturnType| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$returnType| |$sawParenthesizedHead|))
+ (RETURN
+ (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|)))))))
+
+(DEFUN |bpDDef| () (PROG () (RETURN (AND (|bpName|) (|bpDefTail|)))))
+
+(DEFUN |bpSimpleDefinitionTail| ()
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(DEFUN |bpDefTail| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpSimpleDefinitionTail|) (|bpCompoundDefinitionTail|)))))
+
+(DEFUN |bpMDefTail| ()
+ (PROG ()
+ (RETURN
+ (AND (OR (|bpVariable|) (|bpTrap|)) (|bpEqKey| 'MDEF)
+ (OR (|bpWhere|) (|bpTrap|))
+ (|bpPush|
+ (|bfMDefinition| (|bpPop3|) (|bpPop2|) (|bpPop1|)))))))
+
+(DEFUN |bpMdef| ()
+ (PROG () (RETURN (AND (|bpName|) (|bpStoreName|) (|bpMDefTail|)))))
+
+(DEFUN |bpWhere| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpDefinition|)
+ (OR (AND (|bpEqKey| 'WHERE)
+ (OR (|bpDefinitionItem|) (|bpTrap|))
+ (|bpPush| (|bfWhere| (|bpPop1|) (|bpPop1|))))
+ T)))))
+
+(DEFUN |bpDefinitionItem| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpState|))
+ (COND
+ ((|bpDDef|) T)
+ (#0='T (|bpRestore| |a|)
+ (COND
+ ((|bpBDefinitionPileItems|) T)
+ (#0# (|bpRestore| |a|)
+ (COND
+ ((|bpPDefinitionItems|) T)
+ (#0# (|bpRestore| |a|) (|bpWhere|)))))))))))
+
+(DEFUN |bpDefinitionPileItems| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpListAndRecover| #'|bpDefinitionItem|)
+ (|bpPush| (|bfDefSequence| (|bpPop1|)))))))
+
+(DEFUN |bpBDefinitionPileItems| ()
+ (PROG () (RETURN (|bpPileBracketed| #'|bpDefinitionPileItems|))))
+
+(DEFUN |bpSemiColonDefinition| ()
+ (PROG ()
+ (RETURN (|bpSemiListing| #'|bpDefinitionItem| #'|bfDefSequence|))))
+
+(DEFUN |bpPDefinitionItems| ()
+ (PROG () (RETURN (|bpParenthesized| #'|bpSemiColonDefinition|))))
+
+(DEFUN |bpComma| ()
+ (PROG ()
+ (RETURN (OR (|bpModule|) (|bpImport|) (|bpTuple| #'|bpWhere|)))))
+
+(DEFUN |bpTuple| (|p|)
+ (PROG ()
+ (RETURN (|bpListofFun| |p| #'|bpCommaBackSet| #'|bfTuple|))))
+
+(DEFUN |bpCommaBackSet| ()
+ (PROG ()
+ (RETURN (AND (|bpEqKey| 'COMMA) (OR (|bpEqKey| 'BACKSET) T)))))
+
+(DEFUN |bpSemiColon| ()
+ (PROG () (RETURN (|bpSemiListing| #'|bpComma| #'|bfSequence|))))
+
+(DEFUN |bpSemiListing| (|p| |f|)
+ (PROG () (RETURN (|bpListofFun| |p| #'|bpSemiBackSet| |f|))))
+
+(DEFUN |bpSemiBackSet| ()
+ (PROG ()
+ (RETURN (AND (|bpEqKey| 'SEMICOLON) (OR (|bpEqKey| 'BACKSET) T)))))
+
+(DEFUN |bpPDefinition| ()
+ (PROG () (RETURN (|bpIndentParenthesized| #'|bpSemiColon|))))
+
+(DEFUN |bpPileItems| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpListAndRecover| #'|bpSemiColon|)
+ (|bpPush| (|bfSequence| (|bpPop1|)))))))
+
+(DEFUN |bpBPileDefinition| ()
+ (PROG () (RETURN (|bpPileBracketed| #'|bpPileItems|))))
+
+(DEFUN |bpIteratorTail| ()
+ (PROG () (RETURN (AND (OR (|bpEqKey| 'REPEAT) T) (|bpIterators|)))))
+
+(DEFUN |bpConstruct| ()
+ (PROG () (RETURN (|bpBracket| #'|bpConstruction|))))
+
+(DEFUN |bpConstruction| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpComma|)
+ (OR (AND (|bpIteratorTail|)
+ (|bpPush| (|bfCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfTupleConstruct| (|bpPop1|))))))))
+
+(DEFUN |bpDConstruct| ()
+ (PROG () (RETURN (|bpBracket| #'|bpDConstruction|))))
+
+(DEFUN |bpDConstruction| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpComma|)
+ (OR (AND (|bpIteratorTail|)
+ (|bpPush| (|bfDCollect| (|bpPop2|) (|bpPop1|))))
+ (|bpPush| (|bfDTuple| (|bpPop1|))))))))
+
+(DEFUN |bpPattern| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
+ (|bpConstTok|)))))
+
+(DEFUN |bpEqual| ()
+ (PROG ()
+ (RETURN
+ (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|)))))
+
+(DEFUN |bpRegularPatternItemL| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpRegularPatternItem|) (|bpPush| (LIST (|bpPop1|)))))))
+
+(DEFUN |bpRegularList| ()
+ (PROG ()
+ (RETURN
+ (|bpListof| #'|bpRegularPatternItemL| 'COMMA #'|bfAppend|))))
+
+(DEFUN |bpPatternColon| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpEqKey| 'COLON) (OR (|bpRegularPatternItem|) (|bpTrap|))
+ (|bpPush| (LIST (|bfColon| (|bpPop1|))))))))
+
+(DEFUN |bpPatternL| ()
+ (PROG ()
+ (RETURN (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|))))))
+
+(DEFUN |bpPatternTail| ()
+ (PROG ()
+ (RETURN
+ (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|)))))
+
+(DEFUN |bpBVString| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$ttok| |$stok|))
+ (RETURN
+ (AND (EQ (|shoeTokType| |$stok|) 'STRING)
+ (|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))))
+
+(DEFUN |bpRegularBVItemL| ()
+ (PROG ()
+ (RETURN (AND (|bpRegularBVItem|) (|bpPush| (LIST (|bpPop1|)))))))
+
+(DEFUN |bpColonName| ()
+ (PROG ()
+ (RETURN
+ (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|)))))))))
+
+(DEFUN |bpBeginParameterList| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (RETURN (PROGN (SETQ |$sawParenthesizedHead| NIL) T))))
+
+(DEFUN |bpEndParameterList| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$sawParenthesizedHead|))
+ (RETURN (SETQ |$sawParenthesizedHead| T))))
+
+(DEFUN |bpVariable| ()
+ (PROG ()
+ (RETURN
+ (OR (AND (|bpBeginParameterList|)
+ (|bpParenthesized| #'|bpBoundVariablelist|)
+ (|bpPush| (|bfTupleIf| (|bpPop1|)))
+ (|bpEndParameterList|))
+ (|bpBracketConstruct| #'|bpPatternL|) (|bpName|)
+ (|bpConstTok|)))))
+
+(DEFUN |bpAssignVariable| ()
+ (PROG ()
+ (RETURN
+ (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)))))
+
+(DEFUN |bpChecknull| ()
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (|bpPop1|))
+ (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|)))))))
+
+(DEFUN |bpTypeList| ()
+ (PROG ()
+ (RETURN
+ (OR (|bpPileBracketed| #'|bpTypeItemList|)
+ (AND (|bpTerm|) (|bpPush| (LIST (|bpPop1|))))))))
+
+(DEFUN |bpTypeItemList| ()
+ (PROG () (RETURN (|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|)))))))
+
+(DEFUN |bpIdList| () (PROG () (RETURN (|bpTuple| #'|bpName|))))
+
+(DEFUN |bpCase| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpEqKey| 'CASE) (OR (|bpWhere|) (|bpTrap|))
+ (OR (|bpEqKey| 'OF) (|bpMissing| 'OF)) (|bpPiledCaseItems|)))))
+
+(DEFUN |bpPiledCaseItems| ()
+ (PROG ()
+ (RETURN
+ (AND (|bpPileBracketed| #'|bpCaseItemList|)
+ (|bpPush| (|bfCase| (|bpPop2|) (|bpPop1|)))))))
+
+(DEFUN |bpCaseItemList| ()
+ (PROG () (RETURN (|bpListAndRecover| #'|bpCaseItem|))))
+
+(DEFUN |bpCaseItem| ()
+ (PROG ()
+ (RETURN
+ (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
new file mode 100644
index 00000000..caa56d3e
--- /dev/null
+++ b/src/boot/strap/pile.clisp
@@ -0,0 +1,154 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-pile"))
+
+(IMPORT-MODULE "includer")
+
+(IMPORT-MODULE "scanner")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFUN |shoeFirstTokPosn| (|t|)
+ (PROG () (RETURN (|shoeTokPosn| (CAAR |t|)))))
+
+(DEFUN |shoeLastTokPosn| (|t|)
+ (PROG () (RETURN (|shoeTokPosn| (CADR |t|)))))
+
+(DEFUN |shoePileColumn| (|t|)
+ (PROG () (RETURN (CDR (|shoeTokPosn| (CAAR |t|))))))
+
+(DEFUN |shoePileInsert| (|s|)
+ (PROG (|a| |toktype|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (CONS NIL |s|))
+ (#0='T (SETQ |toktype| (|shoeTokType| (CAAAR |s|)))
+ (COND
+ ((OR (EQ |toktype| 'LISP) (EQ |toktype| 'LINE))
+ (CONS (LIST (CAR |s|)) (CDR |s|)))
+ (#0# (SETQ |a| (|shoePileTree| (- 1) |s|))
+ (CONS (LIST (ELT |a| 2)) (ELT |a| 3)))))))))
+
+(DEFUN |shoePileTree| (|n| |s|)
+ (PROG (|hh| |t| |h| |LETTMP#1|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
+ (#0='T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
+ (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
+ (SETQ |hh| (|shoePileColumn| |h|))
+ (COND
+ ((< |n| |hh|) (|shoePileForests| |h| |hh| |t|))
+ (#0# (LIST NIL |n| NIL |s|))))))))
+
+(DEFUN |eqshoePileTree| (|n| |s|)
+ (PROG (|hh| |t| |h| |LETTMP#1|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
+ (#0='T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
+ (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
+ (SETQ |hh| (|shoePileColumn| |h|))
+ (COND
+ ((EQUAL |hh| |n|) (|shoePileForests| |h| |hh| |t|))
+ (#0# (LIST NIL |n| NIL |s|))))))))
+
+(DEFUN |shoePileForest| (|n| |s|)
+ (PROG (|t1| |h1| |t| |h| |hh| |b| |LETTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |LETTMP#1| (|shoePileTree| |n| |s|))
+ (SETQ |b| (CAR |LETTMP#1|))
+ (SETQ |hh| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |h| (CADDR . #0#))
+ (SETQ |t| (CADDDR . #0#))
+ (COND
+ (|b| (SETQ |LETTMP#1| (|shoePileForest1| |hh| |t|))
+ (SETQ |h1| (CAR |LETTMP#1|))
+ (SETQ |t1| (CADR |LETTMP#1|))
+ (LIST (CONS |h| |h1|) |t1|))
+ ('T (LIST NIL |s|)))))))
+
+(DEFUN |shoePileForest1| (|n| |s|)
+ (PROG (|t1| |h1| |t| |h| |n1| |b| |LETTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |LETTMP#1| (|eqshoePileTree| |n| |s|))
+ (SETQ |b| (CAR |LETTMP#1|))
+ (SETQ |n1| (CADR . #0=(|LETTMP#1|)))
+ (SETQ |h| (CADDR . #0#))
+ (SETQ |t| (CADDDR . #0#))
+ (COND
+ (|b| (SETQ |LETTMP#1| (|shoePileForest1| |n| |t|))
+ (SETQ |h1| (CAR |LETTMP#1|))
+ (SETQ |t1| (CADR |LETTMP#1|))
+ (LIST (CONS |h| |h1|) |t1|))
+ ('T (LIST NIL |s|)))))))
+
+(DEFUN |shoePileForests| (|h| |n| |s|)
+ (PROG (|t1| |h1| |LETTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |LETTMP#1| (|shoePileForest| |n| |s|))
+ (SETQ |h1| (CAR |LETTMP#1|))
+ (SETQ |t1| (CADR |LETTMP#1|))
+ (COND
+ ((|bStreamNull| |h1|) (LIST T |n| |h| |s|))
+ ('T (|shoePileForests| (|shoePileCtree| |h| |h1|) |n| |t1|)))))))
+
+(DEFUN |shoePileCtree| (|x| |y|)
+ (PROG () (RETURN (|dqAppend| |x| (|shoePileCforest| |y|)))))
+
+(DEFUN |shoePileCforest| (|x|)
+ (PROG (|b| |a|)
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ ((NULL (CDR |x|)) (CAR |x|))
+ (#0='T (SETQ |a| (CAR |x|))
+ (SETQ |b| (|shoePileCoagulate| |a| (CDR |x|)))
+ (COND
+ ((NULL (CDR |b|)) (CAR |b|))
+ (#0# (|shoeEnPile| (|shoeSeparatePiles| |b|)))))))))
+
+(DEFUN |shoePileCoagulate| (|a| |b|)
+ (PROG (|e| |d| |c|)
+ (RETURN
+ (COND
+ ((NULL |b|) (LIST |a|))
+ (#0='T (SETQ |c| (CAR |b|))
+ (COND
+ ((OR (EQ (|shoeTokPart| (CAAR |c|)) 'THEN)
+ (EQ (|shoeTokPart| (CAAR |c|)) 'ELSE))
+ (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
+ (#0# (SETQ |d| (CADR |a|)) (SETQ |e| (|shoeTokPart| |d|))
+ (COND
+ ((AND (EQCAR |d| 'KEY)
+ (OR (GET |e| 'SHOEINF) (EQ |e| 'COMMA)
+ (EQ |e| 'SEMICOLON)))
+ (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
+ (#0# (CONS |a| (|shoePileCoagulate| |c| (CDR |b|))))))))))))
+
+(DEFUN |shoeSeparatePiles| (|x|)
+ (PROG (|semicolon| |a|)
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ ((NULL (CDR |x|)) (CAR |x|))
+ ('T (SETQ |a| (CAR |x|))
+ (SETQ |semicolon|
+ (|dqUnit|
+ (|shoeTokConstruct| 'KEY 'BACKSET
+ (|shoeLastTokPosn| |a|))))
+ (|dqConcat|
+ (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|))))))))
+
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
new file mode 100644
index 00000000..50078c3d
--- /dev/null
+++ b/src/boot/strap/scanner.clisp
@@ -0,0 +1,626 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-lexer"))
+
+(IMPORT-MODULE "tokens")
+
+(IMPORT-MODULE "includer")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFUN |double| (|x|) (PROG () (RETURN (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|)))))
+
+(DEFUN |dqConcat| (|ld|)
+ (PROG ()
+ (RETURN
+ (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 |shoeConstructToken| (|ln| |lp| |b| |n|)
+ (PROG ()
+ (RETURN (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))))
+
+(DEFUN |shoeTokType| (|x|) (PROG () (RETURN (CAR |x|))))
+
+(DEFUN |shoeTokPart| (|x|) (PROG () (RETURN (CADR |x|))))
+
+(DEFUN |shoeTokPosn| (|x|) (PROG () (RETURN (CDDR |x|))))
+
+(DEFUN |shoeTokConstruct| (|x| |y| |z|)
+ (PROG () (RETURN (CONS |x| (CONS |y| |z|)))))
+
+(DEFUN |shoeNextLine| (|s|)
+ (PROG (|s1| |a|)
+ (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|))
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) NIL)
+ ('T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|))
+ (SETQ |$r| (CDR |s|)) (SETQ |$ln| (CAR |$f|))
+ (SETQ |$n| (STRPOSL " " |$ln| 0 T))
+ (SETQ |$sz| (LENGTH |$ln|))
+ (COND
+ ((NULL |$n|) T)
+ ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|)
+ (PROGN
+ (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
+ (SETF (ELT |$ln| |$n|) (ELT " " 0))
+ (SETQ |$ln| (CONCAT |a| |$ln|))
+ (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
+ (|shoeNextLine| |s1|)))
+ ('T T)))))))
+
+(DEFUN |shoeLineToks| (|s|)
+ (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |a|
+ |dq| |command| |fst|)
+ (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$ln| |$r| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |$f| NIL)
+ (SETQ |$r| NIL)
+ (SETQ |$ln| NIL)
+ (SETQ |$n| NIL)
+ (SETQ |$sz| NIL)
+ (SETQ |$floatok| T)
+ (SETQ |$linepos| |s|)
+ (COND
+ ((NULL (|shoeNextLine| |s|)) (CONS NIL NIL))
+ ((NULL |$n|) (|shoeLineToks| |$r|))
+ (#0='T
+ (PROGN
+ (SETQ |fst| (QENUM |$ln| 0))
+ (COND
+ ((EQL |fst| |shoeCLOSEPAREN|)
+ (COND
+ ((SETQ |command| (|shoeLine?| |$ln|))
+ (PROGN
+ (SETQ |dq|
+ (|dqUnit|
+ (|shoeConstructToken| |$ln| |$linepos|
+ (|shoeLeafLine| |command|) 0)))
+ (CONS (LIST |dq|) |$r|)))
+ ((SETQ |command| (|shoeLisp?| |$ln|))
+ (|shoeLispToken| |$r| |command|))
+ ((SETQ |command| (|shoePackage?| |$ln|))
+ (PROGN
+ (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
+ (SETQ |dq|
+ (|dqUnit|
+ (|shoeConstructToken| |$ln| |$linepos|
+ (|shoeLeafLisp| |a|) 0)))
+ (CONS (LIST |dq|) |$r|)))
+ (#0# (|shoeLineToks| |$r|))))
+ (#0#
+ (PROGN
+ (SETQ |toks| NIL)
+ (LOOP
+ (COND
+ ((NOT (< |$n| |$sz|)) (RETURN NIL))
+ ('T
+ (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
+ (COND
+ ((NULL |toks|) (|shoeLineToks| |$r|))
+ (#0# (CONS (LIST |toks|) |$r|)))))))))))))
+
+(DEFUN |shoeLispToken| (|s| |string|)
+ (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
+ (DECLARE (SPECIAL |$linepos| |$ln|))
+ (RETURN
+ (PROGN
+ (SETQ |string|
+ (COND
+ ((OR (EQL (LENGTH |string|) 0)
+ (EQL (QENUM |string| 0) (QENUM ";" 0)))
+ "")
+ ('T |string|)))
+ (SETQ |ln| |$ln|)
+ (SETQ |linepos| |$linepos|)
+ (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|))
+ (SETQ |r| (CAR |LETTMP#1|))
+ (SETQ |st| (CDR |LETTMP#1|))
+ (SETQ |dq|
+ (|dqUnit|
+ (|shoeConstructToken| |ln| |linepos|
+ (|shoeLeafLisp| |st|) 0)))
+ (CONS (LIST |dq|) |r|)))))
+
+(DEFUN |shoeAccumulateLines| (|s| |string|)
+ (PROG (|a| |command| |fst|)
+ (DECLARE (SPECIAL |$ln| |$r| |$n|))
+ (RETURN
+ (COND
+ ((NULL (|shoeNextLine| |s|)) (CONS |s| |string|))
+ ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
+ ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
+ (#0='T
+ (PROGN
+ (SETQ |fst| (QENUM |$ln| 0))
+ (COND
+ ((EQL |fst| |shoeCLOSEPAREN|)
+ (PROGN
+ (SETQ |command| (|shoeLisp?| |$ln|))
+ (COND
+ ((AND |command| (< 0 (LENGTH |command|)))
+ (COND
+ ((EQL (QENUM |command| 0) (QENUM ";" 0))
+ (|shoeAccumulateLines| |$r| |string|))
+ (#0#
+ (PROGN
+ (SETQ |a| (STRPOS ";" |command| 0 NIL))
+ (COND
+ (|a| (|shoeAccumulateLines| |$r|
+ (CONCAT |string|
+ (SUBSTRING |command| 0 (- |a| 1)))))
+ (#0#
+ (|shoeAccumulateLines| |$r|
+ (CONCAT |string| |command|))))))))
+ (#0# (|shoeAccumulateLines| |$r| |string|)))))
+ (#0# (CONS |s| |string|)))))))))
+
+(DEFUN |shoeCloser| (|t|)
+ (PROG () (RETURN (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))))
+
+(DEFUN |shoeToken| ()
+ (PROG (|b| |ch| |n| |linepos| |c| |ln|)
+ (DECLARE (SPECIAL |$linepos| |$n| |$ln|))
+ (RETURN
+ (PROGN
+ (SETQ |ln| |$ln|)
+ (SETQ |c| (QENUM |$ln| |$n|))
+ (SETQ |linepos| |$linepos|)
+ (SETQ |n| |$n|)
+ (SETQ |ch| (ELT |$ln| |$n|))
+ (SETQ |b|
+ (COND
+ ((|shoeStartsComment|) (PROGN (|shoeComment|) NIL))
+ ((|shoeStartsNegComment|)
+ (PROGN (|shoeNegComment|) NIL))
+ ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|))
+ ((|shoePunctuation| |c|) (|shoePunct|))
+ ((|shoeStartsId| |ch|) (|shoeWord| NIL))
+ ((EQUAL |c| |shoeSPACE|) (PROGN (|shoeSpace|) NIL))
+ ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|))
+ ((|shoeDigit| |ch|) (|shoeNumber|))
+ ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|))
+ ((EQUAL |c| |shoeTAB|)
+ (PROGN (SETQ |$n| (+ |$n| 1)) NIL))
+ (#0='T (|shoeError|))))
+ (COND
+ ((NULL |b|) NIL)
+ (#0#
+ (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|))))))))
+
+(DEFUN |shoeLeafId| (|x|) (PROG () (RETURN (LIST 'ID (INTERN |x|)))))
+
+(DEFUN |shoeLeafKey| (|x|)
+ (PROG () (RETURN (LIST 'KEY (|shoeKeyWord| |x|)))))
+
+(DEFUN |shoeLeafInteger| (|x|)
+ (PROG () (RETURN (LIST 'INTEGER (|shoeIntValue| |x|)))))
+
+(DEFUN |shoeLeafFloat| (|a| |w| |e|)
+ (PROG (|c| |b|)
+ (RETURN
+ (PROGN
+ (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|)))
+ (SETQ |c|
+ (* (|double| |b|)
+ (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
+ (LIST 'FLOAT |c|)))))
+
+(DEFUN |shoeLeafString| (|x|) (PROG () (RETURN (LIST 'STRING |x|))))
+
+(DEFUN |shoeLeafLisp| (|x|) (PROG () (RETURN (LIST 'LISP |x|))))
+
+(DEFUN |shoeLeafLispExp| (|x|) (PROG () (RETURN (LIST 'LISPEXP |x|))))
+
+(DEFUN |shoeLeafLine| (|x|) (PROG () (RETURN (LIST 'LINE |x|))))
+
+(DEFUN |shoeLeafComment| (|x|) (PROG () (RETURN (LIST 'COMMENT |x|))))
+
+(DEFUN |shoeLeafNegComment| (|x|)
+ (PROG () (RETURN (LIST 'NEGCOMMENT |x|))))
+
+(DEFUN |shoeLeafError| (|x|) (PROG () (RETURN (LIST 'ERROR |x|))))
+
+(DEFUN |shoeLeafSpaces| (|x|) (PROG () (RETURN (LIST 'SPACES |x|))))
+
+(DEFUN |shoeLispEscape| ()
+ (PROG (|n| |exp| |a|)
+ (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
+ (|shoeLeafError| (ELT |$ln| |$n|)))
+ ('T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
+ (COND
+ ((NULL |a|)
+ (PROGN
+ (|SoftShoeError| (CONS |$linepos| |$n|)
+ "lisp escape error")
+ (|shoeLeafError| (ELT |$ln| |$n|))))
+ (#0='T
+ (PROGN
+ (SETQ |exp| (CAR |a|))
+ (SETQ |n| (CADR |a|))
+ (COND
+ ((NULL |n|)
+ (PROGN (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|)))
+ (#0#
+ (PROGN (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))))))
+
+(DEFUN |shoeEscape| ()
+ (PROG (|a|)
+ (DECLARE (SPECIAL |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |$n| (+ |$n| 1))
+ (SETQ |a| (|shoeEsc|))
+ (COND (|a| (|shoeWord| T)) ('T NIL))))))
+
+(DEFUN |shoeEsc| ()
+ (PROG (|n1|)
+ (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|))
+ (RETURN
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (COND
+ ((|shoeNextLine| |$r|)
+ (LOOP
+ (COND (|$n| (RETURN NIL)) (#0='T (|shoeNextLine| |$r|))))
+ (|shoeEsc|) NIL)
+ (#1='T NIL)))
+ (#1# (SETQ |n1| (STRPOSL " " |$ln| |$n| T))
+ (COND
+ ((NULL |n1|) (|shoeNextLine| |$r|)
+ (LOOP
+ (COND (|$n| (RETURN NIL)) (#0# (|shoeNextLine| |$r|))))
+ (|shoeEsc|) NIL)
+ (#1# T)))))))
+
+(DEFUN |shoeStartsComment| ()
+ (PROG (|www|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (COND
+ ((< |$n| |$sz|)
+ (COND
+ ((EQUAL (QENUM |$ln| |$n|) |shoePLUSCOMMENT|)
+ (SETQ |www| (+ |$n| 1))
+ (COND
+ ((NOT (< |www| |$sz|)) NIL)
+ (#0='T (EQUAL (QENUM |$ln| |www|) |shoePLUSCOMMENT|))))
+ (#0# NIL)))
+ (#0# NIL)))))
+
+(DEFUN |shoeStartsNegComment| ()
+ (PROG (|www|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (COND
+ ((< |$n| |$sz|)
+ (COND
+ ((EQUAL (QENUM |$ln| |$n|) |shoeMINUSCOMMENT|)
+ (SETQ |www| (+ |$n| 1))
+ (COND
+ ((NOT (< |www| |$sz|)) NIL)
+ (#0='T (EQUAL (QENUM |$ln| |www|) |shoeMINUSCOMMENT|))))
+ (#0# NIL)))
+ (#0# NIL)))))
+
+(DEFUN |shoeNegComment| ()
+ (PROG (|n|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| |$sz|)
+ (|shoeLeafNegComment| (SUBSTRING |$ln| |n| NIL))))))
+
+(DEFUN |shoeComment| ()
+ (PROG (|n|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| |$sz|)
+ (|shoeLeafComment| (SUBSTRING |$ln| |n| NIL))))))
+
+(DEFUN |shoePunct| ()
+ (PROG (|sss|)
+ (DECLARE (SPECIAL |$n| |$ln|))
+ (RETURN
+ (PROGN
+ (SETQ |sss| (|shoeMatch| |$ln| |$n|))
+ (SETQ |$n| (+ |$n| (LENGTH |sss|)))
+ (|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|))))))
+
+(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|))))))
+
+(DEFUN |shoeSpace| ()
+ (PROG (|n|)
+ (DECLARE (SPECIAL |$floatok| |$ln| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| (STRPOSL " " |$ln| |$n| T))
+ (SETQ |$floatok| T)
+ (COND
+ ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|)))
+ ('T (|shoeLeafSpaces| (- |$n| |n|))))))))
+
+(DEFUN |shoeString| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$floatok| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |$n| (+ |$n| 1))
+ (SETQ |$floatok| NIL)
+ (|shoeLeafString| (|shoeS|))))))
+
+(DEFUN |shoeS| ()
+ (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
+ (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
+ (RETURN
+ (COND
+ ((NOT (< |$n| |$sz|))
+ (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
+ (#0='T (SETQ |n| |$n|)
+ (SETQ |strsym| (OR (STRPOS "\"" |$ln| |$n| NIL) |$sz|))
+ (SETQ |escsym| (OR (STRPOS "_" |$ln| |$n| NIL) |$sz|))
+ (SETQ |mn| (MIN |strsym| |escsym|))
+ (COND
+ ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
+ (|SoftShoeError| (CONS |$linepos| |$n|) "quote added")
+ (SUBSTRING |$ln| |n| NIL))
+ ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1))
+ (SUBSTRING |$ln| |n| (- |mn| |n|)))
+ (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |mn| |n|)))
+ (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |b|
+ (COND
+ (|a| (SETQ |str| (CONCAT |str| (ELT |$ln| |$n|)))
+ (SETQ |$n| (+ |$n| 1)) (|shoeS|))
+ (#0# (|shoeS|))))
+ (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|))))
+
+(DEFUN |shoeDigit| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|))))
+
+(DEFUN |shoeW| (|b|)
+ (PROG (|bb| |a| |str| |endid| |l| |n1|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n1| |$n|)
+ (SETQ |$n| (+ |$n| 1))
+ (SETQ |l| |$sz|)
+ (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
+ (COND
+ ((OR (EQUAL |endid| |l|)
+ (NOT (EQUAL (QENUM |$ln| |endid|) |shoeESCAPE|)))
+ (SETQ |$n| |endid|)
+ (LIST |b| (SUBSTRING |$ln| |n1| (- |endid| |n1|))))
+ (#0='T (SETQ |str| (SUBSTRING |$ln| |n1| (- |endid| |n1|)))
+ (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |bb| (COND (|a| (|shoeW| T)) (#0# (LIST |b| ""))))
+ (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1)))))))))
+
+(DEFUN |shoeWord| (|esp|)
+ (PROG (|w| |aaa|)
+ (DECLARE (SPECIAL |$floatok|))
+ (RETURN
+ (PROGN
+ (SETQ |aaa| (|shoeW| NIL))
+ (SETQ |w| (ELT |aaa| 1))
+ (SETQ |$floatok| NIL)
+ (COND
+ ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|))
+ ((|shoeKeyWordP| |w|) (SETQ |$floatok| T)
+ (|shoeLeafKey| |w|))
+ ('T (|shoeLeafId| |w|)))))))
+
+(DEFUN |shoeInteger| () (PROG () (RETURN (|shoeInteger1| NIL))))
+
+(DEFUN |shoeInteger1| (|zro|)
+ (PROG (|bb| |a| |str| |l| |n|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |l| |$sz|)
+ (LOOP
+ (COND
+ ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|))))
+ (RETURN NIL))
+ ('T (SETQ |$n| (+ |$n| 1)))))
+ (COND
+ ((OR (EQUAL |$n| |l|)
+ (NOT (EQUAL (QENUM |$ln| |$n|) |shoeESCAPE|)))
+ (COND
+ ((AND (EQUAL |n| |$n|) |zro|) "0")
+ (#0='T (SUBSTRING |$ln| |n| (- |$n| |n|)))))
+ (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |$n| |n|)))
+ (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|))
+ (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|)))))))
+
+(DEFUN |shoeIntValue| (|s|)
+ (PROG (|d| |ival| |ns|)
+ (RETURN
+ (PROGN
+ (SETQ |ns| (LENGTH |s|))
+ (SETQ |ival| 0)
+ (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#1|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|)))
+ (SETQ |ival| (+ (* 10 |ival|) |d|)))))
+ (SETQ |i| (+ |i| 1))))
+ |ival|))))
+
+(DEFUN |shoeNumber| ()
+ (PROG (|w| |n| |a|)
+ (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |a| (|shoeInteger|))
+ (COND
+ ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
+ ((AND |$floatok| (EQUAL (QENUM |$ln| |$n|) |shoeDOT|))
+ (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) |shoeDOT|))
+ (SETQ |$n| |n|) (|shoeLeafInteger| |a|))
+ (#0='T (SETQ |w| (|shoeInteger1| T))
+ (|shoeExponent| |a| |w|))))
+ (#0# (|shoeLeafInteger| |a|)))))))
+
+(DEFUN |shoeExponent| (|a| |w|)
+ (PROG (|c1| |e| |c| |n|)
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
+ (RETURN
+ (COND
+ ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
+ (#0='T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|))
+ (COND
+ ((OR (EQUAL |c| |shoeEXPONENT1|)
+ (EQUAL |c| |shoeEXPONENT2|))
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
+ (|shoeLeafFloat| |a| |w| 0))
+ ((|shoeDigit| (ELT |$ln| |$n|))
+ (SETQ |e| (|shoeInteger|))
+ (SETQ |e| (|shoeIntValue| |e|))
+ (|shoeLeafFloat| |a| |w| |e|))
+ (#0# (SETQ |c1| (QENUM |$ln| |$n|))
+ (COND
+ ((OR (EQUAL |c1| |shoePLUSCOMMENT|)
+ (EQUAL |c1| |shoeMINUSCOMMENT|))
+ (SETQ |$n| (+ |$n| 1))
+ (COND
+ ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
+ (|shoeLeafFloat| |a| |w| 0))
+ ((|shoeDigit| (ELT |$ln| |$n|))
+ (SETQ |e| (|shoeInteger|))
+ (SETQ |e| (|shoeIntValue| |e|))
+ (|shoeLeafFloat| |a| |w|
+ (COND
+ ((EQUAL |c1| |shoeMINUSCOMMENT|) (- |e|))
+ (#0# |e|))))
+ (#0# (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
+ (#0# (|shoeLeafFloat| |a| |w| 0))))))))
+
+(DEFUN |shoeError| ()
+ (PROG (|n|)
+ (DECLARE (SPECIAL |$ln| |$linepos| |$n|))
+ (RETURN
+ (PROGN
+ (SETQ |n| |$n|)
+ (SETQ |$n| (+ |$n| 1))
+ (|SoftShoeError| (CONS |$linepos| |n|)
+ (CONCAT "The character whose number is "
+ (STRINGIMAGE (QENUM |$ln| |n|))
+ " is not a Boot character"))
+ (|shoeLeafError| (ELT |$ln| |n|))))))
+
+(DEFUN |shoeOrdToNum| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|))))
+
+(DEFUN |shoeKeyWord| (|st|)
+ (PROG () (RETURN (GETHASH |st| |shoeKeyTable|))))
+
+(DEFUN |shoeKeyWordP| (|st|)
+ (PROG () (RETURN (NULL (NULL (GETHASH |st| |shoeKeyTable|))))))
+
+(DEFUN |shoeMatch| (|l| |i|)
+ (PROG () (RETURN (|shoeSubStringMatch| |l| |shoeDict| |i|))))
+
+(DEFUN |shoeSubStringMatch| (|l| |d| |i|)
+ (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
+ (RETURN
+ (PROGN
+ (SETQ |h| (QENUM |l| |i|))
+ (SETQ |u| (ELT |d| |h|))
+ (SETQ |ll| (SIZE |l|))
+ (SETQ |done| NIL)
+ (SETQ |s1| "")
+ (LET ((|bfVar#2| (- (SIZE |u|) 1)) (|j| 0))
+ (LOOP
+ (COND
+ ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL))
+ (#0='T
+ (PROGN
+ (SETQ |s| (ELT |u| |j|))
+ (SETQ |ls| (SIZE |s|))
+ (SETQ |done|
+ (COND
+ ((< |ll| (+ |ls| |i|)) NIL)
+ (#1='T (SETQ |eql| T)
+ (LET ((|bfVar#3| (- |ls| 1)) (|k| 1))
+ (LOOP
+ (COND
+ ((OR (> |k| |bfVar#3|) (NOT |eql|))
+ (RETURN NIL))
+ (#0#
+ (SETQ |eql|
+ (EQL (QENUM |s| |k|)
+ (QENUM |l| (+ |k| |i|))))))
+ (SETQ |k| (+ |k| 1))))
+ (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL))))))))
+ (SETQ |j| (+ |j| 1))))
+ |s1|))))
+
+(DEFUN |shoePunctuation| (|c|)
+ (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1))))
+
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
new file mode 100644
index 00000000..3ce6a7c8
--- /dev/null
+++ b/src/boot/strap/tokens.clisp
@@ -0,0 +1,352 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-tokens"))
+
+(IMPORT-MODULE "initial-env")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |shoeKeyWords|
+ (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
+ (LIST "cross" 'CROSS) (LIST "else" 'ELSE) (LIST "for" 'FOR)
+ (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
+ (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
+ (LIST "of" 'OF) (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
+ (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
+ (LIST "then" 'THEN) (LIST "until" 'UNTIL)
+ (LIST "where" 'WHERE) (LIST "while" 'WHILE) (LIST "." 'DOT)
+ (LIST ":" 'COLON) (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
+ (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
+ (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
+ (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
+ (LIST "=" 'SHOEEQ) (LIST "^" 'NOT) (LIST "^=" 'SHOENE)
+ (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
+ (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "==" 'DEF)
+ (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
+ (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK)
+ (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR)
+ (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
+
+(DEFUN |shoeKeyTableCons| ()
+ (PROG (|KeyTable|)
+ (RETURN
+ (PROGN
+ (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
+ (LET ((|bfVar#1| |shoeKeyWords|) (|st| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
+ |KeyTable|))))
+
+(DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|))
+
+(DEFPARAMETER |shoeSPACE| (QENUM " " 0))
+
+(DEFPARAMETER |shoeESCAPE| (QENUM "_ " 0))
+
+(DEFPARAMETER |shoeLispESCAPE| (QENUM "! " 0))
+
+(DEFPARAMETER |shoeSTRINGCHAR| (QENUM "\" " 0))
+
+(DEFPARAMETER |shoePLUSCOMMENT| (QENUM "+ " 0))
+
+(DEFPARAMETER |shoeMINUSCOMMENT| (QENUM "- " 0))
+
+(DEFPARAMETER |shoeDOT| (QENUM ". " 0))
+
+(DEFPARAMETER |shoeEXPONENT1| (QENUM "E " 0))
+
+(DEFPARAMETER |shoeEXPONENT2| (QENUM "e " 0))
+
+(DEFPARAMETER |shoeCLOSEPAREN| (QENUM ") " 0))
+
+(DEFPARAMETER |shoeTAB| 9)
+
+(DEFUN |shoeInsert| (|s| |d|)
+ (PROG (|v| |k| |n| |u| |h| |l|)
+ (RETURN
+ (PROGN
+ (SETQ |l| (LENGTH |s|))
+ (SETQ |h| (QENUM |s| 0))
+ (SETQ |u| (ELT |d| |h|))
+ (SETQ |n| (LENGTH |u|))
+ (SETQ |k| 0)
+ (LOOP
+ (COND
+ ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
+ (#0='T (SETQ |k| (+ |k| 1)))))
+ (SETQ |v| (MAKE-VEC (+ |n| 1)))
+ (LET ((|bfVar#2| (- |k| 1)) (|i| 0))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#2|) (RETURN NIL))
+ (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
+ (SETQ |i| (+ |i| 1))))
+ (VEC-SETELT |v| |k| |s|)
+ (LET ((|bfVar#3| (- |n| 1)) (|i| |k|))
+ (LOOP
+ (COND
+ ((> |i| |bfVar#3|) (RETURN NIL))
+ (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
+ (SETQ |i| (+ |i| 1))))
+ (VEC-SETELT |d| |h| |v|)
+ |s|))))
+
+(DEFUN |shoeDictCons| ()
+ (PROG (|d| |b| |a| |l|)
+ (RETURN
+ (PROGN
+ (SETQ |l| (HKEYS |shoeKeyTable|))
+ (SETQ |d|
+ (PROGN
+ (SETQ |a| (MAKE-VEC 256))
+ (SETQ |b| (MAKE-VEC 1))
+ (VEC-SETELT |b| 0 (MAKE-CVEC 0))
+ (LET ((|i| 0))
+ (LOOP
+ (COND
+ ((> |i| 255) (RETURN NIL))
+ (#0='T (VEC-SETELT |a| |i| |b|)))
+ (SETQ |i| (+ |i| 1))))
+ |a|))
+ (LET ((|bfVar#4| |l|) (|s| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#4|)
+ (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
+ (RETURN NIL))
+ (#0# (|shoeInsert| |s| |d|)))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))
+ |d|))))
+
+(DEFPARAMETER |shoeDict| (|shoeDictCons|))
+
+(DEFUN |shoePunCons| ()
+ (PROG (|a| |listing|)
+ (RETURN
+ (PROGN
+ (SETQ |listing| (HKEYS |shoeKeyTable|))
+ (SETQ |a| (MAKE-BVEC 256))
+ (LET ((|i| 0))
+ (LOOP
+ (COND
+ ((> |i| 255) (RETURN NIL))
+ (#0='T (BVEC-SETELT |a| |i| 0)))
+ (SETQ |i| (+ |i| 1))))
+ (LET ((|bfVar#5| |listing|) (|k| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#5|)
+ (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (COND
+ ((NULL (|shoeStartsId| (ELT |k| 0)))
+ (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
+ (SETQ |bfVar#5| (CDR |bfVar#5|))))
+ |a|))))
+
+(DEFPARAMETER |shoePun| (|shoePunCons|))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (LET ((|bfVar#6| (LIST 'NOT 'LENGTH)) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#6|)
+ (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET |i| 'SHOEPRE) 'T)))
+ (SETQ |bfVar#6| (CDR |bfVar#6|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (LET ((|bfVar#7|
+ (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*)
+ (LIST 'PLUS '+) (LIST 'IS '|is|)
+ (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
+ (LIST 'OR '|or|) (LIST 'SLASH '/)
+ (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<)
+ (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=)
+ (LIST 'SHOENE '^=)))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+ (RETURN NIL))
+ ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (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|)))))))
+
+(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|)))))))
+
+(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|)))))))
+
+(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|)))))))
+
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
new file mode 100644
index 00000000..0b849cfc
--- /dev/null
+++ b/src/boot/strap/translator.clisp
@@ -0,0 +1,1156 @@
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-translator"))
+
+(IMPORT-MODULE "includer")
+
+(IMPORT-MODULE "scanner")
+
+(IMPORT-MODULE "pile")
+
+(IMPORT-MODULE "parser")
+
+(IMPORT-MODULE "ast")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFPARAMETER |$translatingOldBoot| NIL)
+
+(DEFUN |AxiomCore|::|%sysInit| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$translatingOldBoot|))
+ (RETURN
+ (COND
+ ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|)))
+ "old")
+ (SETQ |$translatingOldBoot| T))))))
+
+(DEFUN |setCurrentPackage| (|x|)
+ (PROG () (RETURN (SETQ *PACKAGE* |x|))))
+
+(DEFUN |shoeCOMPILE-FILE| (|lspFileName|)
+ (PROG () (RETURN (COMPILE-FILE |lspFileName|))))
+
+(DEFUN BOOTTOCL (|fn| |out|)
+ (PROG () (RETURN (BOOTTOCLLINES NIL |fn| |out|))))
+
+(DEFUN BOOTCLAM (|fn| |out|)
+ (PROG ()
+ (DECLARE (SPECIAL |$bfClamming|))
+ (RETURN
+ (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
+
+(DEFUN BOOTCLAMLINES (|lines| |fn| |out|)
+ (PROG () (RETURN (BOOTTOCLLINES |lines| |fn| |out|))))
+
+(DEFUN BOOTTOCLLINES (|lines| |fn| |outfn|)
+ (PROG (|result| |infn| |callingPackage|)
+ (RETURN
+ (PROGN
+ (SETQ *READ-DEFAULT-FLOAT-FORMAT* 'DOUBLE-FLOAT)
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClLines| |a| |fn| |lines| |outfn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#1| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
+ (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
+ |outfn|)))))
+
+(DEFUN BOOTTOCLC (|fn| |out|)
+ (PROG () (RETURN (BOOTTOCLCLINES NIL |fn| |out|))))
+
+(DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
+ (PROG (|result| |infn| |callingPackage|)
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClCLines| |a| |fn| |lines| |outfn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#2| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#2|)
+ (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#2| (CDR |bfVar#2|))))
+ (|shoeFileTrees|
+ (|shoeTransformToFile| |stream|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))
+ |stream|)))
+ |outfn|)))))
+
+(DEFUN BOOTTOMC (|fn|)
+ (PROG (|$GenVarCounter| |result| |infn| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn| (|shoeMc| |a| |fn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeMc| (|a| |fn|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (|shoePCompileTrees| (|shoeTransformStream| |a|))
+ (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))))
+
+(DEFUN EVAL-BOOT-FILE (|fn|)
+ (PROG (|outfn| |infn| |b|)
+ (RETURN
+ (PROGN
+ (SETQ |b| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |outfn|
+ (CONCAT (|shoeRemovebootIfNec| |fn|) "."
+ *LISP-SOURCE-FILETYPE*))
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeClLines| |a| |infn| NIL |outfn|))
+ (|setCurrentPackage| |b|)
+ (LOAD |outfn|)))))
+
+(DEFUN BO (|fn|)
+ (PROG (|$GenVarCounter| |infn| |b|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |b| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (|shoeOpenInputFile| |a| |infn| (|shoeToConsole| |a| |fn|))
+ (|setCurrentPackage| |b|)))))
+
+(DEFUN BOCLAM (|fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |result| |infn|
+ |callingPackage|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |$bfClamming| T)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |result|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeToConsole| |a| |fn|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeToConsole| (|a| |fn|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T
+ (|shoeConsoleTrees|
+ (|shoeTransformToConsole|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))))))))
+
+(DEFUN STOUT (|string|) (PROG () (RETURN (PSTOUT (LIST |string|)))))
+
+(DEFUN STEVAL (|string|)
+ (PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |a| (|shoeTransformString| (LIST |string|)))
+ (SETQ |result|
+ (COND
+ ((|bStreamPackageNull| |a|) NIL)
+ ('T
+ (PROGN
+ (SETQ |fn|
+ (|stripm| (CAR |a|) *PACKAGE*
+ (FIND-PACKAGE "BOOTTRAN")))
+ (EVAL |fn|)))))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN STTOMC (|string|)
+ (PROG (|$GenVarCounter| |result| |a| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |a| (|shoeTransformString| (LIST |string|)))
+ (SETQ |result|
+ (COND
+ ((|bStreamPackageNull| |a|) NIL)
+ ('T (|shoePCompile| (CAR |a|)))))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |shoeCompileTrees| (|s|)
+ (PROG ()
+ (RETURN
+ (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|)
+ (RETURN
+ (COND
+ ((AND (CONSP |fn|) (EQ (CAR |fn|) 'DEFUN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |fn|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |name| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |bv| (CAR |ISTMP#2|))
+ (SETQ |body| (CDR |ISTMP#2|))
+ 'T))))))
+ (COMPILE |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ('T (EVAL |fn|))))))
+
+(DEFUN |shoeTransform| (|str|)
+ (PROG ()
+ (RETURN
+ (|bNext| #'|shoeTreeConstruct|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeTransformString| (|s|)
+ (PROG ()
+ (RETURN
+ (|shoeTransform|
+ (|shoeInclude| (|bAddLineNumber| |s| (|bIgen| 0)))))))
+
+(DEFUN |shoeTransformStream| (|s|)
+ (PROG () (RETURN (|shoeTransformString| (|bRgen| |s|)))))
+
+(DEFUN |shoeTransformToConsole| (|str|)
+ (PROG ()
+ (RETURN
+ (|bNext| #'|shoeConsoleItem|
+ (|bNext| #'|shoePileInsert|
+ (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeTransformToFile| (|fn| |str|)
+ (PROG ()
+ (RETURN
+ (|bFileNext| |fn|
+ (|bNext| #'|shoePileInsert| (|bNext| #'|shoeLineToks| |str|))))))
+
+(DEFUN |shoeConsoleItem| (|str|)
+ (PROG (|dq|)
+ (RETURN
+ (PROGN
+ (SETQ |dq| (CAR |str|))
+ (|shoeConsoleLines| (|shoeDQlines| |dq|))
+ (CONS (|shoeParseTrees| |dq|) (CDR |str|))))))
+
+(DEFUN |bFileNext| (|fn| |s|)
+ (PROG () (RETURN (|bDelay| #'|bFileNext1| (LIST |fn| |s|)))))
+
+(DEFUN |bFileNext1| (|fn| |s|)
+ (PROG (|dq|)
+ (RETURN
+ (COND
+ ((|bStreamNull| |s|) (LIST '|nullstream|))
+ ('T
+ (PROGN
+ (SETQ |dq| (CAR |s|))
+ (|shoeFileLines| (|shoeDQlines| |dq|) |fn|)
+ (|bAppend| (|shoeParseTrees| |dq|)
+ (|bFileNext| |fn| (CDR |s|)))))))))
+
+(DEFUN |shoeParseTrees| (|dq|)
+ (PROG (|toklist|)
+ (RETURN
+ (PROGN
+ (SETQ |toklist| (|dqToList| |dq|))
+ (COND ((NULL |toklist|) NIL) ('T (|shoeOutParse| |toklist|)))))))
+
+(DEFUN |shoeTreeConstruct| (|str|)
+ (PROG () (RETURN (CONS (|shoeParseTrees| (CAR |str|)) (CDR |str|)))))
+
+(DEFUN |shoeDQlines| (|dq|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (CDAAR (|shoeLastTokPosn| |dq|)))
+ (SETQ |b| (CDAAR (|shoeFirstTokPosn| |dq|)))
+ (|streamTake| (+ (- |a| |b|) 1)
+ (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|))))))))
+
+(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|)))))
+
+(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| " ")))))
+
+(DEFUN |shoeFileLine| (|x| |stream|)
+ (PROG () (RETURN (PROGN (WRITE-LINE |x| |stream|) |x|))))
+
+(DEFUN |shoeFileTrees| (|s| |st|)
+ (PROG (|a|)
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CAR |s|))
+ (COND
+ ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|))
+ ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |shoePPtoFile| (|x| |stream|)
+ (PROG () (RETURN (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))))
+
+(DEFUN |shoeConsoleTrees| (|s|)
+ (PROG (|fn|)
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |fn|
+ (|stripm| (CAR |s|) *PACKAGE*
+ (FIND-PACKAGE "BOOTTRAN")))
+ (REALLYPRETTYPRINT |fn|)
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |shoeAddComment| (|l|)
+ (PROG () (RETURN (CONCAT "; " (CAR |l|)))))
+
+(DEFUN |genImportDeclaration| (|op| |sig|)
+ (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |sig|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |op'| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |m| (CAR |ISTMP#2|))
+ #0='T)))))))
+ (|coreError| "invalid signature"))
+ ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|Mapping|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |m|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |t| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |s| (CAR |ISTMP#2|))
+ #0#)))))))
+ (|coreError| "invalid function type"))
+ ((|%hasFeature| :GCL)
+ (PROGN
+ (COND ((SYMBOLP |s|) (SETQ |s| (LIST |s|))))
+ (LIST 'DEFENTRY |op| |s| (LIST |t| (SYMBOL-NAME |op'|)))))
+ ('T
+ (|fatalError|
+ "import declaration not implemented for this Lisp"))))))
+
+(DEFUN |shoeOutParse| (|stream|)
+ (PROG (|$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
+ |$op| |$ttok| |$stok| |$stack| |$inputStream| |found|)
+ (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings|
+ |$wheredefs| |$op| |$ttok| |$stok| |$stack|
+ |$inputStream|))
+ (RETURN
+ (PROGN
+ (SETQ |$inputStream| |stream|)
+ (SETQ |$stack| NIL)
+ (SETQ |$stok| NIL)
+ (SETQ |$ttok| NIL)
+ (SETQ |$op| NIL)
+ (SETQ |$wheredefs| NIL)
+ (SETQ |$typings| NIL)
+ (SETQ |$returns| NIL)
+ (SETQ |$bpCount| 0)
+ (SETQ |$bpParenCount| 0)
+ (|bpFirstTok|)
+ (SETQ |found| (CATCH 'TRAPPOINT (|bpOutItem|)))
+ (COND
+ ((EQ |found| 'TRAPPED) NIL)
+ ((NULL (|bStreamNull| |$inputStream|)) (|bpGeneralErrorHere|)
+ NIL)
+ ((NULL |$stack|) (|bpGeneralErrorHere|) NIL)
+ ('T (CAR |$stack|)))))))
+
+(DEFUN |bpOutItem| ()
+ (PROG (|bfVar#6| |bfVar#5| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
+ (RETURN
+ (PROGN
+ (OR (|bpComma|) (|bpTrap|))
+ (SETQ |b| (|bpPop1|))
+ (COND
+ ((EQCAR |b| 'TUPLE) (|bpPush| (CDR |b|)))
+ ((EQCAR |b| '+LINE) (|bpPush| (LIST |b|)))
+ ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |b|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN (SETQ |r| (CAR |ISTMP#2|)) 'T)))))
+ (IDENTP |l|))
+ (|bpPush| (LIST (LIST 'DEFPARAMETER |l| |r|))))
+ ('T
+ (PROGN
+ (SETQ |bfVar#5| |b|)
+ (SETQ |bfVar#6| (CDR |bfVar#5|))
+ (CASE (CAR |bfVar#5|)
+ (|Module|
+ (LET ((|m| (CAR |bfVar#6|)))
+ (|bpPush|
+ (LIST (|shoeCompileTimeEvaluation|
+ (LIST 'PROVIDE |m|))))))
+ (|Import|
+ (LET ((|m| (CAR |bfVar#6|)))
+ (|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
+ (|ImportSignature|
+ (LET ((|x| (CAR |bfVar#6|))
+ (|sig| (CADR |bfVar#6|)))
+ (|bpPush|
+ (LIST (|genImportDeclaration| |x| |sig|)))))
+ (|TypeAlias|
+ (LET ((|t| (CAR |bfVar#6|))
+ (|args| (CADR |bfVar#6|))
+ (|rhs| (CADDR |bfVar#6|)))
+ (|bpPush|
+ (LIST (LIST 'DEFTYPE |t| |args|
+ (LIST 'QUOTE |rhs|))))))
+ (|ConstantDefinition|
+ (LET ((|n| (CAR |bfVar#6|)) (|e| (CADR |bfVar#6|)))
+ (|bpPush| (LIST (LIST 'DEFCONSTANT |n| |e|)))))
+ (T (PROGN
+ (SETQ |b|
+ (|shoeCompTran|
+ (LIST 'LAMBDA (LIST '|x|) |b|)))
+ (|bpPush|
+ (LIST (|shoeEVALANDFILEACTQ| (CADDR |b|))))))))))))))
+
+(DEFUN |shoeAddbootIfNec| (|s|)
+ (PROG () (RETURN (|shoeAddStringIfNec| ".boot" |s|))))
+
+(DEFUN |shoeRemovebootIfNec| (|s|)
+ (PROG () (RETURN (|shoeRemoveStringIfNec| ".boot" |s|))))
+
+(DEFUN |shoeAddStringIfNec| (|str| |s|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (STRPOS |str| |s| 0 NIL))
+ (COND ((NULL |a|) (CONCAT |s| |str|)) ('T |s|))))))
+
+(DEFUN |shoeRemoveStringIfNec| (|str| |s|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (STRPOS |str| |s| 0 NIL))
+ (COND ((NULL |a|) |s|) ('T (SUBSTRING |s| 0 |a|)))))))
+
+(DEFUN DEFUSE (|fn|)
+ (PROG (|infn|)
+ (RETURN
+ (PROGN
+ (SETQ |infn| (CONCAT |fn| ".boot"))
+ (|shoeOpenInputFile| |a| |infn| (|shoeDfu| |a| |fn|))))))
+
+(DEFUN |shoeDfu| (|a| |fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootDefinedTwice| |$bootUsed|
+ |$bootDefined| |$lispWordTable| |out|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|
+ |$bootDefinedTwice| |$bootUsed| |$bootDefined|
+ |$lispWordTable|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
+ (HPUT |$lispWordTable| |i| T))
+ (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootDefinedTwice| NIL) (SETQ |$GenVarCounter| 0)
+ (SETQ |$bfClamming| NIL)
+ (|shoeDefUse| (|shoeTransformStream| |a|))
+ (SETQ |out| (CONCAT |fn| ".defuse"))
+ (|shoeOpenOutputFile| |stream| |out| (|shoeReport| |stream|))
+ |out|)))))
+
+(DEFUN |shoeReport| (|stream|)
+ (PROG (|b| |a|)
+ (DECLARE (SPECIAL |$bootDefinedTwice| |$bootUsed| |$bootDefined|))
+ (RETURN
+ (PROGN
+ (|shoeFileLine| "DEFINED and not USED" |stream|)
+ (SETQ |a|
+ (LET ((|bfVar#8| NIL) (|bfVar#7| (HKEYS |$bootDefined|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
+ (RETURN (NREVERSE |bfVar#8|)))
+ (#0='T
+ (AND (NULL (GETHASH |i| |$bootUsed|))
+ (SETQ |bfVar#8| (CONS |i| |bfVar#8|)))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))
+ (|bootOut| (SSORT |a|) |stream|)
+ (|shoeFileLine| " " |stream|)
+ (|shoeFileLine| "DEFINED TWICE" |stream|)
+ (|bootOut| (SSORT |$bootDefinedTwice|) |stream|)
+ (|shoeFileLine| " " |stream|)
+ (|shoeFileLine| "USED and not DEFINED" |stream|)
+ (SETQ |a|
+ (LET ((|bfVar#10| NIL) (|bfVar#9| (HKEYS |$bootUsed|))
+ (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#9|)
+ (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
+ (RETURN (NREVERSE |bfVar#10|)))
+ (#0#
+ (AND (NULL (GETHASH |i| |$bootDefined|))
+ (SETQ |bfVar#10| (CONS |i| |bfVar#10|)))))
+ (SETQ |bfVar#9| (CDR |bfVar#9|)))))
+ (LET ((|bfVar#11| (SSORT |a|)) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#11|)
+ (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
+ (RETURN NIL))
+ (#0#
+ (PROGN
+ (SETQ |b| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |b|))))
+ (SETQ |bfVar#11| (CDR |bfVar#11|))))))))
+
+(DEFUN |shoeDefUse| (|s|)
+ (PROG ()
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |defuse| (|e| |x|)
+ (PROG (|$used| |niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id|
+ |ISTMP#4| |ISTMP#3| |body| |bv| |ISTMP#2| |name|
+ |ISTMP#1|)
+ (DECLARE (SPECIAL |$bootUsed| |$used| |$bootDefinedTwice|
+ |$bootDefined|))
+ (RETURN
+ (PROGN
+ (SETQ |x| (|stripm| |x| *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+ (SETQ |$used| NIL)
+ (SETQ |LETTMP#1|
+ (COND
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'DEFUN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |name| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |bv| (CAR |ISTMP#2|))
+ (SETQ |body| (CDR |ISTMP#2|))
+ #0='T))))))
+ (LIST |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'DEFMACRO)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |name| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |bv| (CAR |ISTMP#2|))
+ (SETQ |body| (CDR |ISTMP#2|))
+ #0#))))))
+ (LIST |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'EVAL-WHEN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |ISTMP#3| (CAR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|)
+ (EQ (CAR |ISTMP#3|) 'SETQ)
+ (PROGN
+ (SETQ |ISTMP#4|
+ (CDR |ISTMP#3|))
+ (AND (CONSP |ISTMP#4|)
+ (PROGN
+ (SETQ |id| (CAR |ISTMP#4|))
+ (SETQ |ISTMP#5|
+ (CDR |ISTMP#4|))
+ (AND (CONSP |ISTMP#5|)
+ (EQ (CDR |ISTMP#5|) NIL)
+ (PROGN
+ (SETQ |exp|
+ (CAR |ISTMP#5|))
+ #0#))))))))))))
+ (LIST |id| |exp|))
+ ((AND (CONSP |x|) (EQ (CAR |x|) 'SETQ)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |id| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (EQ (CDR |ISTMP#2|) NIL)
+ (PROGN
+ (SETQ |exp| (CAR |ISTMP#2|))
+ #0#))))))
+ (LIST |id| |exp|))
+ (#1='T (LIST 'TOP-LEVEL |x|))))
+ (SETQ |nee| (CAR |LETTMP#1|))
+ (SETQ |niens| (CADR |LETTMP#1|))
+ (COND
+ ((GETHASH |nee| |$bootDefined|)
+ (SETQ |$bootDefinedTwice|
+ (COND
+ ((EQ |nee| 'TOP-LEVEL) |$bootDefinedTwice|)
+ (#1# (CONS |nee| |$bootDefinedTwice|)))))
+ ('T (HPUT |$bootDefined| |nee| T)))
+ (|defuse1| |e| |niens|)
+ (LET ((|bfVar#12| |$used|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#12|)
+ (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ (RETURN NIL))
+ ('T
+ (HPUT |$bootUsed| |i|
+ (CONS |nee| (GETHASH |i| |$bootUsed|)))))
+ (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
+
+(DEFUN |defuse1| (|e| |y|)
+ (PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
+ (DECLARE (SPECIAL |$bootDefined| |$used|))
+ (RETURN
+ (COND
+ ((ATOM |y|)
+ (COND
+ ((IDENTP |y|)
+ (SETQ |$used|
+ (COND
+ ((MEMQ |y| |e|) |$used|)
+ ((MEMQ |y| |$used|) |$used|)
+ ((|defusebuiltin| |y|) |$used|)
+ (#0='T (UNION (LIST |y|) |$used|)))))
+ (#0# NIL)))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'LAMBDA)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |a| (CAR |ISTMP#1|))
+ (SETQ |b| (CDR |ISTMP#1|))
+ #1='T))))
+ (|defuse1| (APPEND (|unfluidlist| |a|) |e|) |b|))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'PROG)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |a| (CAR |ISTMP#1|))
+ (SETQ |b| (CDR |ISTMP#1|))
+ #1#))))
+ (PROGN
+ (SETQ |LETTMP#1| (|defSeparate| |a|))
+ (SETQ |dol| (CAR |LETTMP#1|))
+ (SETQ |ndol| (CADR |LETTMP#1|))
+ (LET ((|bfVar#13| |dol|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#13|)
+ (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
+ (RETURN NIL))
+ (#2='T (HPUT |$bootDefined| |i| T)))
+ (SETQ |bfVar#13| (CDR |bfVar#13|))))
+ (|defuse1| (APPEND |ndol| |e|) |b|)))
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
+ (PROGN (SETQ |a| (CDR |y|)) #1#))
+ NIL)
+ ((AND (CONSP |y|) (EQ (CAR |y|) '+LINE)
+ (PROGN (SETQ |a| (CDR |y|)) #1#))
+ NIL)
+ (#0#
+ (LET ((|bfVar#14| |y|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#14|)
+ (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
+ (RETURN NIL))
+ (#2# (|defuse1| |e| |i|)))
+ (SETQ |bfVar#14| (CDR |bfVar#14|)))))))))
+
+(DEFUN |defSeparate| (|x|)
+ (PROG (|x2| |x1| |LETTMP#1| |f|)
+ (RETURN
+ (COND
+ ((NULL |x|) (LIST NIL NIL))
+ (#0='T (SETQ |f| (CAR |x|))
+ (SETQ |LETTMP#1| (|defSeparate| (CDR |x|)))
+ (SETQ |x1| (CAR |LETTMP#1|)) (SETQ |x2| (CADR |LETTMP#1|))
+ (COND
+ ((|bfBeginsDollar| |f|) (LIST (CONS |f| |x1|) |x2|))
+ (#0# (LIST |x1| (CONS |f| |x2|)))))))))
+
+(DEFUN |unfluidlist| (|x|)
+ (PROG (|y| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ ((ATOM |x|) (LIST |x|))
+ ((AND (CONSP |x|) (EQ (CAR |x|) '&REST)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |y| (CAR |ISTMP#1|)) 'T))))
+ (LIST |y|))
+ ('T (CONS (CAR |x|) (|unfluidlist| (CDR |x|))))))))
+
+(DEFUN |defusebuiltin| (|x|)
+ (PROG ()
+ (DECLARE (SPECIAL |$lispWordTable|))
+ (RETURN (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|)))))))
+
+(DEFUN CLESSP (|s1| |s2|)
+ (PROG () (RETURN (NULL (SHOEGREATERP |s1| |s2|)))))
+
+(DEFUN SSORT (|l|) (PROG () (RETURN (SORT |l| #'CLESSP))))
+
+(DEFUN |bootOutLines| (|l| |outfn| |s|)
+ (PROG (|a|)
+ (RETURN
+ (COND
+ ((NULL |l|) (|shoeFileLine| |s| |outfn|))
+ (#0='T (SETQ |a| (PNAME (CAR |l|)))
+ (COND
+ ((< 70 (+ (LENGTH |s|) (LENGTH |a|)))
+ (|shoeFileLine| |s| |outfn|)
+ (|bootOutLines| |l| |outfn| " "))
+ (#0#
+ (|bootOutLines| (CDR |l|) |outfn| (CONCAT |s| " " |a|)))))))))
+
+(DEFUN XREF (|fn|)
+ (PROG (|infn|)
+ (RETURN
+ (PROGN
+ (SETQ |infn| (CONCAT |fn| ".boot"))
+ (|shoeOpenInputFile| |a| |infn| (|shoeXref| |a| |fn|))))))
+
+(DEFUN |shoeXref| (|a| |fn|)
+ (PROG (|$bfClamming| |$GenVarCounter| |$bootUsed| |$bootDefined|
+ |$lispWordTable| |out|)
+ (DECLARE (SPECIAL |$bfClamming| |$GenVarCounter| |$bootUsed|
+ |$bootDefined| |$lispWordTable|))
+ (RETURN
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
+ (HPUT |$lispWordTable| |i| T))
+ (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$GenVarCounter| 0) (SETQ |$bfClamming| NIL)
+ (|shoeDefUse| (|shoeTransformStream| |a|))
+ (SETQ |out| (CONCAT |fn| ".xref"))
+ (|shoeOpenOutputFile| |stream| |out| (|shoeXReport| |stream|))
+ |out|)))))
+
+(DEFUN |shoeXReport| (|stream|)
+ (PROG (|a| |c|)
+ (DECLARE (SPECIAL |$bootUsed|))
+ (RETURN
+ (PROGN
+ (|shoeFileLine| "USED and where DEFINED" |stream|)
+ (SETQ |c| (SSORT (HKEYS |$bootUsed|)))
+ (LET ((|bfVar#16| |c|) (|i| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#16|)
+ (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |a| (CONCAT (PNAME |i|) " is used in "))
+ (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
+ |stream| |a|))))
+ (SETQ |bfVar#16| (CDR |bfVar#16|))))))))
+
+(DEFUN FBO (|name| |fn|)
+ (PROG () (RETURN (|shoeGeneralFC| #'BO |name| |fn|))))
+
+(DEFUN FEV (|name| |fn|)
+ (PROG () (RETURN (|shoeGeneralFC| #'EVAL-BOOT-FILE |name| |fn|))))
+
+(DEFUN |shoeGeneralFC| (|f| |name| |fn|)
+ (PROG (|$GenVarCounter| |$bfClamming| |filename| |a| |infn|)
+ (DECLARE (SPECIAL |$GenVarCounter| |$bfClamming|))
+ (RETURN
+ (PROGN
+ (SETQ |$bfClamming| NIL)
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (SETQ |a|
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeFindName2| |fn| |name| |a|)))
+ (SETQ |filename|
+ (COND
+ ((< 8 (LENGTH |name|)) (SUBSTRING |name| 0 8))
+ ('T |name|)))
+ (COND
+ (|a| (FUNCALL |f| (CONCAT "/tmp/" |filename|)))
+ ('T NIL))))))
+
+(DEFUN |shoeFindName2| (|fn| |name| |a|)
+ (PROG (|filename| |lines|)
+ (RETURN
+ (PROGN
+ (SETQ |lines| (|shoeFindLines| |fn| |name| |a|))
+ (COND
+ (|lines| (PROGN
+ (SETQ |filename|
+ (COND
+ ((< 8 (LENGTH |name|))
+ (SUBSTRING |name| 0 8))
+ ('T |name|)))
+ (SETQ |filename|
+ (CONCAT "/tmp/" |filename| ".boot"))
+ (|shoeOpenOutputFile| |stream| |filename|
+ (LET ((|bfVar#17| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#17|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#17|))
+ NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#17| (CDR |bfVar#17|)))))
+ T))
+ ('T NIL))))))
+
+(DEFUN |shoeTransform2| (|str|)
+ (PROG ()
+ (RETURN
+ (|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|))
+ (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#18|)
+ (PROGN
+ (SETQ |line| (CAR |bfVar#18|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#19|)))
+ ('T
+ (SETQ |bfVar#19|
+ (CONS (CAR |line|) |bfVar#19|))))
+ (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (CDR |str|))))))
+
+(DEFUN |stripm| (|x| |pk| |bt|)
+ (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|)))))))
+
+(DEFUN |shoePCompile| (|fn|)
+ (PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
+ (RETURN
+ (PROGN
+ (SETQ |fn| (|stripm| |fn| *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
+ (COND
+ ((AND (CONSP |fn|) (EQ (CAR |fn|) 'DEFUN)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |fn|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |name| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|)
+ (PROGN
+ (SETQ |bv| (CAR |ISTMP#2|))
+ (SETQ |body| (CDR |ISTMP#2|))
+ 'T))))))
+ (COMPILE |name| (CONS 'LAMBDA (CONS |bv| |body|))))
+ ('T (EVAL |fn|)))))))
+
+(DEFUN FC (|name| |fn|)
+ (PROG (|$GenVarCounter| |infn|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |infn| (|shoeAddbootIfNec| |fn|))
+ (|shoeOpenInputFile| |a| |infn|
+ (|shoeFindName| |fn| |name| |a|))))))
+
+(DEFUN |shoeFindName| (|fn| |name| |a|)
+ (PROG (|lines|)
+ (RETURN
+ (PROGN
+ (SETQ |lines| (|shoeFindLines| |fn| |name| |a|))
+ (|shoePCompileTrees| (|shoeTransformString| |lines|))))))
+
+(DEFUN |shoePCompileTrees| (|s|)
+ (PROG ()
+ (RETURN
+ (LOOP
+ (COND
+ ((|bStreamPackageNull| |s|) (RETURN NIL))
+ ('T
+ (PROGN
+ (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|)))
+ (SETQ |s| (CDR |s|)))))))))
+
+(DEFUN |bStreamPackageNull| (|s|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |b| (|bStreamNull| |s|))
+ (|setCurrentPackage| |a|)
+ |b|))))
+
+(DEFUN PSTTOMC (|string|)
+ (PROG (|$GenVarCounter|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoePCompileTrees| (|shoeTransformString| |string|))))))
+
+(DEFUN BOOTLOOP ()
+ (PROG (|stream| |b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (READ-LINE))
+ (COND
+ ((EQL (LENGTH |a|) 0)
+ (PROGN
+ (WRITE-LINE "Boot Loop; to exit type ] ")
+ (BOOTLOOP)))
+ (#0='T
+ (PROGN
+ (SETQ |b| (|shoePrefix?| ")console" |a|))
+ (COND
+ (|b| (PROGN
+ (SETQ |stream| *TERMINAL-IO*)
+ (PSTTOMC (|bRgen| |stream|))
+ (BOOTLOOP)))
+ ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ (#0# (PROGN (PSTTOMC (LIST |a|)) (BOOTLOOP)))))))))))
+
+(DEFUN BOOTPO ()
+ (PROG (|stream| |b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (READ-LINE))
+ (COND
+ ((EQL (LENGTH |a|) 0)
+ (PROGN (WRITE-LINE "Boot Loop; to exit type ] ") (BOOTPO)))
+ (#0='T
+ (PROGN
+ (SETQ |b| (|shoePrefix?| ")console" |a|))
+ (COND
+ (|b| (PROGN
+ (SETQ |stream| *TERMINAL-IO*)
+ (PSTOUT (|bRgen| |stream|))
+ (BOOTPO)))
+ ((EQUAL (ELT |a| 0) (ELT "]" 0)) NIL)
+ (#0# (PROGN (PSTOUT (LIST |a|)) (BOOTPO)))))))))))
+
+(DEFUN PSTOUT (|string|)
+ (PROG (|$GenVarCounter| |result| |callingPackage|)
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |callingPackage| *PACKAGE*)
+ (IN-PACKAGE "BOOTTRAN")
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |result|
+ (|shoeConsoleTrees| (|shoeTransformString| |string|)))
+ (|setCurrentPackage| |callingPackage|)
+ |result|))))
+
+(DEFUN |defaultBootToLispFile| (|file|)
+ (PROG () (RETURN (CONCAT (|shoeRemovebootIfNec| |file|) ".clisp"))))
+
+(DEFUN |translateBootFile| (|progname| |options| |file|)
+ (PROG (|outFile|)
+ (RETURN
+ (PROGN
+ (SETQ |outFile| (|getOutputPathname| |options|))
+ (BOOTTOCL |file| (ENOUGH-NAMESTRING |outFile|))))))
+
+(DEFUN |compileBootHandler| (|progname| |options| |file|)
+ (PROG (|objFile| |intFile|)
+ (RETURN
+ (PROGN
+ (SETQ |intFile|
+ (BOOTTOCL |file| (|defaultBootToLispFile| |file|)))
+ (COND
+ (|intFile|
+ (PROGN
+ (SETQ |objFile|
+ (|compileLispHandler| |progname| |options|
+ |intFile|))
+ (DELETE-FILE |intFile|)
+ |objFile|))
+ ('T NIL))))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (|associateRequestWithFileType| (|Option| "translate") "boot"
+ #'|translateBootFile|))))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
+ (PROG ()
+ (RETURN
+ (|associateRequestWithFileType| (|Option| "compile") "boot"
+ #'|compileBootHandler|))))
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 22:02:47 +0000