diff options
Diffstat (limited to 'src/boot/strap/ast.clisp')
-rw-r--r-- | src/boot/strap/ast.clisp | 540 |
1 files changed, 308 insertions, 232 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index e3f18dd0..5bbd792c 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -22,9 +22,7 @@ (DEFTYPE |%Sequence| () 'SEQUENCE) -(DEFTYPE |%List| () 'LIST) - -(DEFUN |Name| #0=(|bfVar#1|) (CONS '|Name| (LIST . #0#))) +(DEFUN |%Name| #0=(|bfVar#1|) (CONS '|%Name| (LIST . #0#))) (DEFUN |Command| #0=(|bfVar#2|) (CONS '|Command| (LIST . #0#))) @@ -35,106 +33,111 @@ (DEFUN |ImportSignature| #0=(|bfVar#5| |bfVar#6|) (CONS '|ImportSignature| (LIST . #0#))) -(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8| |bfVar#9|) +(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8|) (CONS '|TypeAlias| (LIST . #0#))) -(DEFUN |Signature| #0=(|bfVar#10| |bfVar#11|) +(DEFUN |Signature| #0=(|bfVar#9| |bfVar#10|) (CONS '|Signature| (LIST . #0#))) -(DEFUN |Mapping| #0=(|bfVar#12| |bfVar#13|) +(DEFUN |Mapping| #0=(|bfVar#11| |bfVar#12|) (CONS '|Mapping| (LIST . #0#))) -(DEFUN |SuffixDot| #0=(|bfVar#14|) (CONS '|SuffixDot| (LIST . #0#))) +(DEFUN |SuffixDot| #0=(|bfVar#13|) (CONS '|SuffixDot| (LIST . #0#))) -(DEFUN |Quote| #0=(|bfVar#15|) (CONS '|Quote| (LIST . #0#))) +(DEFUN |Quote| #0=(|bfVar#14|) (CONS '|Quote| (LIST . #0#))) -(DEFUN |EqualName| #0=(|bfVar#16|) (CONS '|EqualName| (LIST . #0#))) +(DEFUN |EqualName| #0=(|bfVar#15|) (CONS '|EqualName| (LIST . #0#))) -(DEFUN |Colon| #0=(|bfVar#17|) (CONS '|Colon| (LIST . #0#))) +(DEFUN |Colon| #0=(|bfVar#16|) (CONS '|Colon| (LIST . #0#))) -(DEFUN |QualifiedName| #0=(|bfVar#18| |bfVar#19|) +(DEFUN |QualifiedName| #0=(|bfVar#17| |bfVar#18|) (CONS '|QualifiedName| (LIST . #0#))) -(DEFUN |Bracket| #0=(|bfVar#20|) (CONS '|Bracket| (LIST . #0#))) +(DEFUN |%DefaultValue| #0=(|bfVar#19| |bfVar#20|) + (CONS '|%DefaultValue| (LIST . #0#))) -(DEFUN |UnboundedSegment| #0=(|bfVar#21|) +(DEFUN |Bracket| #0=(|bfVar#21|) (CONS '|Bracket| (LIST . #0#))) + +(DEFUN |UnboundedSegment| #0=(|bfVar#22|) (CONS '|UnboundedSegment| (LIST . #0#))) -(DEFUN |BoundedSgement| #0=(|bfVar#22| |bfVar#23|) +(DEFUN |BoundedSgement| #0=(|bfVar#23| |bfVar#24|) (CONS '|BoundedSgement| (LIST . #0#))) -(DEFUN |Tuple| #0=(|bfVar#24|) (CONS '|Tuple| (LIST . #0#))) +(DEFUN |Tuple| #0=(|bfVar#25|) (CONS '|Tuple| (LIST . #0#))) -(DEFUN |ColonAppend| #0=(|bfVar#25| |bfVar#26|) +(DEFUN |ColonAppend| #0=(|bfVar#26| |bfVar#27|) (CONS '|ColonAppend| (LIST . #0#))) -(DEFUN |Is| #0=(|bfVar#27| |bfVar#28|) (CONS '|Is| (LIST . #0#))) +(DEFUN |Is| #0=(|bfVar#28| |bfVar#29|) (CONS '|Is| (LIST . #0#))) -(DEFUN |Isnt| #0=(|bfVar#29| |bfVar#30|) (CONS '|Isnt| (LIST . #0#))) +(DEFUN |Isnt| #0=(|bfVar#30| |bfVar#31|) (CONS '|Isnt| (LIST . #0#))) -(DEFUN |Reduce| #0=(|bfVar#31| |bfVar#32|) +(DEFUN |Reduce| #0=(|bfVar#32| |bfVar#33|) (CONS '|Reduce| (LIST . #0#))) -(DEFUN |PrefixExpr| #0=(|bfVar#33| |bfVar#34|) +(DEFUN |PrefixExpr| #0=(|bfVar#34| |bfVar#35|) (CONS '|PrefixExpr| (LIST . #0#))) -(DEFUN |Call| #0=(|bfVar#35| |bfVar#36|) (CONS '|Call| (LIST . #0#))) +(DEFUN |Call| #0=(|bfVar#36| |bfVar#37|) (CONS '|Call| (LIST . #0#))) -(DEFUN |InfixExpr| #0=(|bfVar#37| |bfVar#38| |bfVar#39|) +(DEFUN |InfixExpr| #0=(|bfVar#38| |bfVar#39| |bfVar#40|) (CONS '|InfixExpr| (LIST . #0#))) -(DEFUN |ConstantDefinition| #0=(|bfVar#40| |bfVar#41|) +(DEFUN |ConstantDefinition| #0=(|bfVar#41| |bfVar#42|) (CONS '|ConstantDefinition| (LIST . #0#))) -(DEFUN |Definition| #0=(|bfVar#42| |bfVar#43| |bfVar#44| |bfVar#45|) +(DEFUN |Definition| #0=(|bfVar#43| |bfVar#44| |bfVar#45| |bfVar#46|) (CONS '|Definition| (LIST . #0#))) -(DEFUN |Macro| #0=(|bfVar#46| |bfVar#47| |bfVar#48|) +(DEFUN |Macro| #0=(|bfVar#47| |bfVar#48| |bfVar#49|) (CONS '|Macro| (LIST . #0#))) -(DEFUN |SuchThat| #0=(|bfVar#49|) (CONS '|SuchThat| (LIST . #0#))) +(DEFUN |SuchThat| #0=(|bfVar#50|) (CONS '|SuchThat| (LIST . #0#))) -(DEFUN |Assignment| #0=(|bfVar#50| |bfVar#51|) +(DEFUN |Assignment| #0=(|bfVar#51| |bfVar#52|) (CONS '|Assignment| (LIST . #0#))) -(DEFUN |While| #0=(|bfVar#52|) (CONS '|While| (LIST . #0#))) +(DEFUN |While| #0=(|bfVar#53|) (CONS '|While| (LIST . #0#))) -(DEFUN |Until| #0=(|bfVar#53|) (CONS '|Until| (LIST . #0#))) +(DEFUN |Until| #0=(|bfVar#54|) (CONS '|Until| (LIST . #0#))) -(DEFUN |For| #0=(|bfVar#54| |bfVar#55| |bfVar#56|) +(DEFUN |For| #0=(|bfVar#55| |bfVar#56| |bfVar#57|) (CONS '|For| (LIST . #0#))) -(DEFUN |Exit| #0=(|bfVar#57| |bfVar#58|) (CONS '|Exit| (LIST . #0#))) +(DEFUN |Exit| #0=(|bfVar#58| |bfVar#59|) (CONS '|Exit| (LIST . #0#))) -(DEFUN |Iterators| #0=(|bfVar#59|) (CONS '|Iterators| (LIST . #0#))) +(DEFUN |Iterators| #0=(|bfVar#60|) (CONS '|Iterators| (LIST . #0#))) -(DEFUN |Cross| #0=(|bfVar#60|) (CONS '|Cross| (LIST . #0#))) +(DEFUN |Cross| #0=(|bfVar#61|) (CONS '|Cross| (LIST . #0#))) -(DEFUN |Repeat| #0=(|bfVar#61| |bfVar#62|) +(DEFUN |Repeat| #0=(|bfVar#62| |bfVar#63|) (CONS '|Repeat| (LIST . #0#))) -(DEFUN |Pile| #0=(|bfVar#63|) (CONS '|Pile| (LIST . #0#))) +(DEFUN |Pile| #0=(|bfVar#64|) (CONS '|Pile| (LIST . #0#))) -(DEFUN |Append| #0=(|bfVar#64|) (CONS '|Append| (LIST . #0#))) +(DEFUN |Append| #0=(|bfVar#65|) (CONS '|Append| (LIST . #0#))) -(DEFUN |Case| #0=(|bfVar#65| |bfVar#66|) (CONS '|Case| (LIST . #0#))) +(DEFUN |Case| #0=(|bfVar#66| |bfVar#67|) (CONS '|Case| (LIST . #0#))) -(DEFUN |Return| #0=(|bfVar#67|) (CONS '|Return| (LIST . #0#))) +(DEFUN |Return| #0=(|bfVar#68|) (CONS '|Return| (LIST . #0#))) -(DEFUN |%Throw| #0=(|bfVar#68|) (CONS '|%Throw| (LIST . #0#))) +(DEFUN |%Throw| #0=(|bfVar#69|) (CONS '|%Throw| (LIST . #0#))) -(DEFUN |%Catch| #0=(|bfVar#69|) (CONS '|%Catch| (LIST . #0#))) +(DEFUN |%Catch| #0=(|bfVar#70|) (CONS '|%Catch| (LIST . #0#))) -(DEFUN |%Try| #0=(|bfVar#70| |bfVar#71|) (CONS '|%Try| (LIST . #0#))) +(DEFUN |%Try| #0=(|bfVar#71| |bfVar#72|) (CONS '|%Try| (LIST . #0#))) -(DEFUN |Where| #0=(|bfVar#72| |bfVar#73|) +(DEFUN |Where| #0=(|bfVar#73| |bfVar#74|) (CONS '|Where| (LIST . #0#))) -(DEFUN |Structure| #0=(|bfVar#74| |bfVar#75|) +(DEFUN |Structure| #0=(|bfVar#75| |bfVar#76|) (CONS '|Structure| (LIST . #0#))) (DEFPARAMETER |$inDefIS| NIL) +(DEFUN |quote| (|x|) (LIST 'QUOTE |x|)) + (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfGenSymbol|)) (DEFUN |bfGenSymbol| () @@ -151,11 +154,14 @@ (DEFUN |bfColon| (|x|) (LIST 'COLON |x|)) -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Symbol|) |%Symbol|) +(DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Symbol|) |%Symbol|) |bfColonColon|)) (DEFUN |bfColonColon| (|package| |name|) - (INTERN (SYMBOL-NAME |name|) |package|)) + (COND + ((AND (|%hasFeature| :CLISP) (MEMBER |package| '(EXT FFI))) + (FIND-SYMBOL (SYMBOL-NAME |name|) |package|)) + ('T (INTERN (SYMBOL-NAME |name|) |package|)))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|)) @@ -216,14 +222,14 @@ (DEFUN |bfCompDef| (|x|) (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def| - |bfVar#77| |bfVar#76|) + |bfVar#78| |bfVar#77|) (RETURN (PROGN - (SETQ |bfVar#76| |x|) - (SETQ |bfVar#77| (CDR |bfVar#76|)) - (CASE (CAR |bfVar#76|) + (SETQ |bfVar#77| |x|) + (SETQ |bfVar#78| (CDR |bfVar#77|)) + (CASE (CAR |bfVar#77|) (|ConstantDefinition| - (LET ((|n| (CAR |bfVar#77|)) (|e| (CADR |bfVar#77|))) + (LET ((|n| (CAR |bfVar#78|)) (|e| (CADR |bfVar#78|))) |x|)) (T (COND ((AND (CONSP |x|) @@ -275,22 +281,22 @@ (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|)))) (COND - ((LET ((|bfVar#79| NIL) (|bfVar#78| |a|) (|x| NIL)) + ((LET ((|bfVar#80| NIL) (|bfVar#79| |a|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#78|) - (PROGN (SETQ |x| (CAR |bfVar#78|)) NIL)) - (RETURN |bfVar#79|)) + ((OR (ATOM |bfVar#79|) + (PROGN (SETQ |x| (CAR |bfVar#79|)) NIL)) + (RETURN |bfVar#80|)) ('T (PROGN - (SETQ |bfVar#79| + (SETQ |bfVar#80| (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))) - (COND (|bfVar#79| (RETURN |bfVar#79|)))))) - (SETQ |bfVar#78| (CDR |bfVar#78|)))) + (COND (|bfVar#80| (RETURN |bfVar#80|)))))) + (SETQ |bfVar#79| (CDR |bfVar#79|)))) (|bfMakeCons| |a|)) ('T (CONS 'LIST |a|))))))) @@ -450,19 +456,19 @@ (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) ('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) - (LET ((|bfVar#82| NIL) (|bfVar#80| |f|) (|i| NIL) - (|bfVar#81| |r|) (|j| NIL)) + (LET ((|bfVar#83| NIL) (|bfVar#81| |f|) (|i| NIL) + (|bfVar#82| |r|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#80|) - (PROGN (SETQ |i| (CAR |bfVar#80|)) NIL) - (ATOM |bfVar#81|) - (PROGN (SETQ |j| (CAR |bfVar#81|)) NIL)) - (RETURN (NREVERSE |bfVar#82|))) + ((OR (ATOM |bfVar#81|) + (PROGN (SETQ |i| (CAR |bfVar#81|)) NIL) + (ATOM |bfVar#82|) + (PROGN (SETQ |j| (CAR |bfVar#82|)) NIL)) + (RETURN (NREVERSE |bfVar#83|))) ('T - (SETQ |bfVar#82| (CONS (APPEND |i| |j|) |bfVar#82|)))) - (SETQ |bfVar#80| (CDR |bfVar#80|)) - (SETQ |bfVar#81| (CDR |bfVar#81|))))))))) + (SETQ |bfVar#83| (CONS (APPEND |i| |j|) |bfVar#83|)))) + (SETQ |bfVar#81| (CDR |bfVar#81|)) + (SETQ |bfVar#82| (CDR |bfVar#82|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) @@ -577,25 +583,25 @@ (COND (|vars| (SETQ |loop| (LIST 'LET - (LET ((|bfVar#85| NIL) - (|bfVar#83| |vars|) (|v| NIL) - (|bfVar#84| |inits|) (|i| NIL)) + (LET ((|bfVar#86| NIL) + (|bfVar#84| |vars|) (|v| NIL) + (|bfVar#85| |inits|) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#83|) + ((OR (ATOM |bfVar#84|) (PROGN - (SETQ |v| (CAR |bfVar#83|)) + (SETQ |v| (CAR |bfVar#84|)) NIL) - (ATOM |bfVar#84|) + (ATOM |bfVar#85|) (PROGN - (SETQ |i| (CAR |bfVar#84|)) + (SETQ |i| (CAR |bfVar#85|)) NIL)) - (RETURN (NREVERSE |bfVar#85|))) + (RETURN (NREVERSE |bfVar#86|))) ('T - (SETQ |bfVar#85| - (CONS (LIST |v| |i|) |bfVar#85|)))) - (SETQ |bfVar#83| (CDR |bfVar#83|)) - (SETQ |bfVar#84| (CDR |bfVar#84|)))) + (SETQ |bfVar#86| + (CONS (LIST |v| |i|) |bfVar#86|)))) + (SETQ |bfVar#84| (CDR |bfVar#84|)) + (SETQ |bfVar#85| (CDR |bfVar#85|)))) |loop|)))) |loop|)))) @@ -754,7 +760,7 @@ (SETQ |ISTMP#1| (CDR |lhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)))) (|bfLetForm| |lhs| |rhs|)) - ((AND (IDENTP |rhs|) (NULL (|bfCONTAINED| |rhs| |lhs|))) + ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) (PROGN (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) (COND @@ -1160,7 +1166,7 @@ ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) (#0='T |x|))) (COND - ((AND |$translatingOldBoot| (NULL (|bfSameMeaning| |x|))) + ((AND |$translatingOldBoot| (NOT (|bfSameMeaning| |x|))) (PROGN (SETQ |oldName| (|bfGetOldBootName| |x|)) (COND @@ -1210,17 +1216,17 @@ ((NULL (CDR |l|)) (CAR |l|)) ('T (CONS 'OR - (LET ((|bfVar#87| NIL) (|bfVar#86| |l|) (|c| NIL)) + (LET ((|bfVar#88| NIL) (|bfVar#87| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#86|) - (PROGN (SETQ |c| (CAR |bfVar#86|)) NIL)) - (RETURN (NREVERSE |bfVar#87|))) + ((OR (ATOM |bfVar#87|) + (PROGN (SETQ |c| (CAR |bfVar#87|)) NIL)) + (RETURN (NREVERSE |bfVar#88|))) ('T - (SETQ |bfVar#87| + (SETQ |bfVar#88| (APPEND (REVERSE (|bfFlatten| 'OR |c|)) - |bfVar#87|)))) - (SETQ |bfVar#86| (CDR |bfVar#86|)))))))) + |bfVar#88|)))) + (SETQ |bfVar#87| (CDR |bfVar#87|)))))))) (DEFUN |bfAND| (|l|) (COND @@ -1228,17 +1234,17 @@ ((NULL (CDR |l|)) (CAR |l|)) ('T (CONS 'AND - (LET ((|bfVar#89| NIL) (|bfVar#88| |l|) (|c| NIL)) + (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#88|) - (PROGN (SETQ |c| (CAR |bfVar#88|)) NIL)) - (RETURN (NREVERSE |bfVar#89|))) + ((OR (ATOM |bfVar#89|) + (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL)) + (RETURN (NREVERSE |bfVar#90|))) ('T - (SETQ |bfVar#89| + (SETQ |bfVar#90| (APPEND (REVERSE (|bfFlatten| 'AND |c|)) - |bfVar#89|)))) - (SETQ |bfVar#88| (CDR |bfVar#88|)))))))) + |bfVar#90|)))) + (SETQ |bfVar#89| (CDR |bfVar#89|)))))))) (DEFUN |defQuoteId| (|x|) (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|)))) @@ -1273,55 +1279,55 @@ (SETQ |nargl| (CADDR . #0#)) (SETQ |largl| (CADDDR . #0#)) (SETQ |sb| - (LET ((|bfVar#92| NIL) (|bfVar#90| |nargl|) (|i| NIL) - (|bfVar#91| |sgargl|) (|j| NIL)) + (LET ((|bfVar#93| NIL) (|bfVar#91| |nargl|) (|i| NIL) + (|bfVar#92| |sgargl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#90|) - (PROGN (SETQ |i| (CAR |bfVar#90|)) NIL) - (ATOM |bfVar#91|) - (PROGN (SETQ |j| (CAR |bfVar#91|)) NIL)) - (RETURN (NREVERSE |bfVar#92|))) + ((OR (ATOM |bfVar#91|) + (PROGN (SETQ |i| (CAR |bfVar#91|)) NIL) + (ATOM |bfVar#92|) + (PROGN (SETQ |j| (CAR |bfVar#92|)) NIL)) + (RETURN (NREVERSE |bfVar#93|))) (#1='T - (SETQ |bfVar#92| (CONS (CONS |i| |j|) |bfVar#92|)))) - (SETQ |bfVar#90| (CDR |bfVar#90|)) - (SETQ |bfVar#91| (CDR |bfVar#91|))))) + (SETQ |bfVar#93| (CONS (CONS |i| |j|) |bfVar#93|)))) + (SETQ |bfVar#91| (CDR |bfVar#91|)) + (SETQ |bfVar#92| (CDR |bfVar#92|))))) (SETQ |body| (SUBLIS |sb| |body|)) (SETQ |sb2| - (LET ((|bfVar#95| NIL) (|bfVar#93| |sgargl|) (|i| NIL) - (|bfVar#94| |largl|) (|j| NIL)) + (LET ((|bfVar#96| NIL) (|bfVar#94| |sgargl|) (|i| NIL) + (|bfVar#95| |largl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#93|) - (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL) - (ATOM |bfVar#94|) - (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL)) - (RETURN (NREVERSE |bfVar#95|))) + ((OR (ATOM |bfVar#94|) + (PROGN (SETQ |i| (CAR |bfVar#94|)) NIL) + (ATOM |bfVar#95|) + (PROGN (SETQ |j| (CAR |bfVar#95|)) NIL)) + (RETURN (NREVERSE |bfVar#96|))) (#1# - (SETQ |bfVar#95| + (SETQ |bfVar#96| (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|) - |bfVar#95|)))) - (SETQ |bfVar#93| (CDR |bfVar#93|)) - (SETQ |bfVar#94| (CDR |bfVar#94|))))) + |bfVar#96|)))) + (SETQ |bfVar#94| (CDR |bfVar#94|)) + (SETQ |bfVar#95| (CDR |bfVar#95|))))) (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#97| NIL) (|bfVar#96| |$wheredefs|) + (LET ((|bfVar#98| NIL) (|bfVar#97| |$wheredefs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#96|) - (PROGN (SETQ |d| (CAR |bfVar#96|)) NIL)) - (RETURN (NREVERSE |bfVar#97|))) + ((OR (ATOM |bfVar#97|) + (PROGN (SETQ |d| (CAR |bfVar#97|)) NIL)) + (RETURN (NREVERSE |bfVar#98|))) (#1# - (SETQ |bfVar#97| + (SETQ |bfVar#98| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#97|)))) - (SETQ |bfVar#96| (CDR |bfVar#96|)))))))))) + |bfVar#98|)))) + (SETQ |bfVar#97| (CDR |bfVar#97|)))))))))) (DEFUN |bfGargl| (|argl|) (PROG (|f| |d| |c| |b| |a| |LETTMP#1|) @@ -1341,13 +1347,13 @@ (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|) (CONS |f| |d|))))))))) -(DEFUN |bfDef1| (|bfVar#98|) +(DEFUN |bfDef1| (|bfVar#99|) (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op| |defOp|) (RETURN (PROGN - (SETQ |defOp| (CAR |bfVar#98|)) - (SETQ |op| (CADR . #0=(|bfVar#98|))) + (SETQ |defOp| (CAR |bfVar#99|)) + (SETQ |op| (CADR . #0=(|bfVar#99|))) (SETQ |args| (CADDR . #0#)) (SETQ |body| (CADDDR . #0#)) (SETQ |argl| @@ -1393,31 +1399,31 @@ (|bfCompHash| |op1| |arg1| |body1|))) ('T (|bfTuple| - (LET ((|bfVar#100| NIL) - (|bfVar#99| + (LET ((|bfVar#101| NIL) + (|bfVar#100| (CONS (LIST |defOp| |op| |args| |body|) |$wheredefs|)) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#99|) - (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL)) - (RETURN (NREVERSE |bfVar#100|))) + ((OR (ATOM |bfVar#100|) + (PROGN (SETQ |d| (CAR |bfVar#100|)) NIL)) + (RETURN (NREVERSE |bfVar#101|))) ('T - (SETQ |bfVar#100| + (SETQ |bfVar#101| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#100|)))) - (SETQ |bfVar#99| (CDR |bfVar#99|)))))))))) + |bfVar#101|)))) + (SETQ |bfVar#100| (CDR |bfVar#100|)))))))))) (DEFUN |shoeComps| (|x|) - (LET ((|bfVar#102| NIL) (|bfVar#101| |x|) (|def| NIL)) + (LET ((|bfVar#103| NIL) (|bfVar#102| |x|) (|def| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#101|) - (PROGN (SETQ |def| (CAR |bfVar#101|)) NIL)) - (RETURN (NREVERSE |bfVar#102|))) - ('T (SETQ |bfVar#102| (CONS (|shoeComp| |def|) |bfVar#102|)))) - (SETQ |bfVar#101| (CDR |bfVar#101|))))) + ((OR (ATOM |bfVar#102|) + (PROGN (SETQ |def| (CAR |bfVar#102|)) NIL)) + (RETURN (NREVERSE |bfVar#103|))) + ('T (SETQ |bfVar#103| (CONS (|shoeComp| |def|) |bfVar#103|)))) + (SETQ |bfVar#102| (CDR |bfVar#102|))))) (DEFUN |shoeComp| (|x|) (PROG (|a|) @@ -1431,6 +1437,18 @@ (CONS 'DEFMACRO (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|)))))))))) +(DEFUN |bfParameterList| (|p1| |p2|) + (COND + ((AND (NULL |p2|) (NOT (ATOM |p1|))) |p1|) + ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL)) + (COND + ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))) + (|bpSpecificErrorHere| "default value required")) + (#0='T (CONS (CAR |p1|) (APPEND (CDR |p1|) (CDR |p2|)))))) + ((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)) + (CONS |p1| (CONS (CAR |p2|) (CDR |p2|)))) + (#0# (CONS |p1| |p2|)))) + (DEFUN |bfInsertLet| (|x| |body|) (PROG (|body2| |name2| |norq1| |b1| |body1| |name1| |norq| |LETTMP#1| |b| |a| |ISTMP#1|) @@ -1459,10 +1477,10 @@ (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|)))))) + (|bfParameterList| |name1| |name2|) |body2|)))))) (DEFUN |bfInsertLet1| (|y| |body|) - (PROG (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|) + (PROG (|bfVar#105| |bfVar#104| |g| |b| |r| |ISTMP#2| |l| |ISTMP#1|) (RETURN (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'L%T) @@ -1483,13 +1501,25 @@ (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|)))))))))) + (#1='T + (PROGN + (SETQ |g| (|bfGenSymbol|)) + (COND + ((ATOM |y|) (LIST NIL NIL |g| |body|)) + (#1# + (PROGN + (SETQ |bfVar#104| |y|) + (SETQ |bfVar#105| (CDR |bfVar#104|)) + (CASE (CAR |bfVar#104|) + (|%DefaultValue| + (LET ((|p| (CAR |bfVar#105|)) + (|v| (CADR |bfVar#105|))) + (LIST NIL NIL (LIST '&OPTIONAL (LIST |p| |v|)) + |body|))) + (T (LIST NIL NIL |g| + (|bfMKPROGN| + (LIST (|bfLET| (|compFluidize| |y|) |g|) + |body|)))))))))))))) (DEFUN |shoeCompTran| (|x|) (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars| @@ -1546,17 +1576,17 @@ (COND ((MEMBER |op| '(RETURN RETURN-FROM)) T) ((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL) - ((LET ((|bfVar#104| NIL) (|bfVar#103| |body|) (|t| NIL)) + ((LET ((|bfVar#107| NIL) (|bfVar#106| |body|) (|t| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#103|) - (PROGN (SETQ |t| (CAR |bfVar#103|)) NIL)) - (RETURN |bfVar#104|)) + ((OR (ATOM |bfVar#106|) + (PROGN (SETQ |t| (CAR |bfVar#106|)) NIL)) + (RETURN |bfVar#107|)) ('T (PROGN - (SETQ |bfVar#104| (|needsPROG| |t|)) - (COND (|bfVar#104| (RETURN |bfVar#104|)))))) - (SETQ |bfVar#103| (CDR |bfVar#103|)))) + (SETQ |bfVar#107| (|needsPROG| |t|)) + (COND (|bfVar#107| (RETURN |bfVar#107|)))))) + (SETQ |bfVar#106| (CDR |bfVar#106|)))) T) (#0# NIL)))))))) @@ -1623,7 +1653,7 @@ (COND ((IDENTP |l|) (COND - ((NULL (|bfBeginsDollar| |l|)) + ((NOT (|bfBeginsDollar| |l|)) (SETQ |$locVars| (COND ((MEMQ |l| |$locVars|) |$locVars|) @@ -1644,37 +1674,37 @@ ((MEMQ U '(PROG LAMBDA)) (PROGN (SETQ |newbindings| NIL) - (LET ((|bfVar#105| (CADR |x|)) (|y| NIL)) + (LET ((|bfVar#108| (CADR |x|)) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#105|) - (PROGN (SETQ |y| (CAR |bfVar#105|)) NIL)) + ((OR (ATOM |bfVar#108|) + (PROGN (SETQ |y| (CAR |bfVar#108|)) NIL)) (RETURN NIL)) (#1='T (COND - ((NULL (MEMQ |y| |$locVars|)) + ((NOT (MEMQ |y| |$locVars|)) (IDENTITY (PROGN (SETQ |$locVars| (CONS |y| |$locVars|)) (SETQ |newbindings| (CONS |y| |newbindings|)))))))) - (SETQ |bfVar#105| (CDR |bfVar#105|)))) + (SETQ |bfVar#108| (CDR |bfVar#108|)))) (SETQ |res| (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| - (LET ((|bfVar#107| NIL) (|bfVar#106| |$locVars|) + (LET ((|bfVar#110| NIL) (|bfVar#109| |$locVars|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#106|) + ((OR (ATOM |bfVar#109|) (PROGN - (SETQ |y| (CAR |bfVar#106|)) + (SETQ |y| (CAR |bfVar#109|)) NIL)) - (RETURN (NREVERSE |bfVar#107|))) + (RETURN (NREVERSE |bfVar#110|))) (#1# - (AND (NULL (MEMQ |y| |newbindings|)) - (SETQ |bfVar#107| - (CONS |y| |bfVar#107|))))) - (SETQ |bfVar#106| (CDR |bfVar#106|))))))) + (AND (NOT (MEMQ |y| |newbindings|)) + (SETQ |bfVar#110| + (CONS |y| |bfVar#110|))))) + (SETQ |bfVar#109| (CDR |bfVar#109|))))))) (#0# (PROGN (|shoeCompTran1| (CAR |x|)) @@ -1761,14 +1791,14 @@ (RETURN (PROGN (SETQ |a| - (LET ((|bfVar#108| NIL) (|c| |l|)) + (LET ((|bfVar#111| NIL) (|c| |l|)) (LOOP (COND - ((ATOM |c|) (RETURN (NREVERSE |bfVar#108|))) + ((ATOM |c|) (RETURN (NREVERSE |bfVar#111|))) ('T - (SETQ |bfVar#108| + (SETQ |bfVar#111| (APPEND (REVERSE (|bfFlattenSeq| |c|)) - |bfVar#108|)))) + |bfVar#111|)))) (SETQ |c| (CDR |c|))))) (COND ((NULL |a|) NIL) @@ -1788,17 +1818,17 @@ ((EQCAR |f| 'PROGN) (COND ((CDR |x|) - (LET ((|bfVar#110| NIL) (|bfVar#109| (CDR |f|)) + (LET ((|bfVar#113| NIL) (|bfVar#112| (CDR |f|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#109|) - (PROGN (SETQ |i| (CAR |bfVar#109|)) NIL)) - (RETURN (NREVERSE |bfVar#110|))) + ((OR (ATOM |bfVar#112|) + (PROGN (SETQ |i| (CAR |bfVar#112|)) NIL)) + (RETURN (NREVERSE |bfVar#113|))) ('T - (AND (NULL (ATOM |i|)) - (SETQ |bfVar#110| (CONS |i| |bfVar#110|))))) - (SETQ |bfVar#109| (CDR |bfVar#109|))))) + (AND (NOT (ATOM |i|)) + (SETQ |bfVar#113| (CONS |i| |bfVar#113|))))) + (SETQ |bfVar#112| (CDR |bfVar#112|))))) (#0# (CDR |f|)))) (#0# (LIST |f|))))))))) @@ -1811,11 +1841,11 @@ (#0='T (PROGN (SETQ |transform| - (LET ((|bfVar#112| NIL) (|bfVar#111| |l|) (|x| NIL)) + (LET ((|bfVar#115| NIL) (|bfVar#114| |l|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#111|) - (PROGN (SETQ |x| (CAR |bfVar#111|)) NIL) + ((OR (ATOM |bfVar#114|) + (PROGN (SETQ |x| (CAR |bfVar#114|)) NIL) (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND) (PROGN (SETQ |ISTMP#1| (CDR |x|)) @@ -1850,11 +1880,11 @@ (SETQ |b| (CAR |ISTMP#5|)) 'T)))))))))))))) - (RETURN (NREVERSE |bfVar#112|))) + (RETURN (NREVERSE |bfVar#115|))) ('T - (SETQ |bfVar#112| - (CONS (LIST |a| |b|) |bfVar#112|)))) - (SETQ |bfVar#111| (CDR |bfVar#111|))))) + (SETQ |bfVar#115| + (CONS (LIST |a| |b|) |bfVar#115|)))) + (SETQ |bfVar#114| (CDR |bfVar#114|))))) (SETQ |no| (LENGTH |transform|)) (SETQ |before| (|bfTake| |no| |l|)) (SETQ |aft| (|bfDrop| |no| |l|)) @@ -1887,12 +1917,12 @@ (SETQ |defs| (CADR . #0=(|LETTMP#1|))) (SETQ |nondefs| (CADDR . #0#)) (SETQ |a| - (LET ((|bfVar#114| NIL) (|bfVar#113| |defs|) (|d| NIL)) + (LET ((|bfVar#117| NIL) (|bfVar#116| |defs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#113|) - (PROGN (SETQ |d| (CAR |bfVar#113|)) NIL)) - (RETURN (NREVERSE |bfVar#114|))) + ((OR (ATOM |bfVar#116|) + (PROGN (SETQ |d| (CAR |bfVar#116|)) NIL)) + (RETURN (NREVERSE |bfVar#117|))) ('T (AND (CONSP |d|) (PROGN @@ -1911,11 +1941,11 @@ (PROGN (SETQ |body| (CAR |ISTMP#3|)) 'T))))))) - (SETQ |bfVar#114| + (SETQ |bfVar#117| (CONS (LIST |def| |op| |args| (|bfSUBLIS| |opassoc| |body|)) - |bfVar#114|))))) - (SETQ |bfVar#113| (CDR |bfVar#113|))))) + |bfVar#117|))))) + (SETQ |bfVar#116| (CDR |bfVar#116|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|)))))))) @@ -1993,16 +2023,16 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfStruct|)) (DEFUN |bfStruct| (|name| |arglist|) - (|bfTuple| (LET ((|bfVar#116| NIL) (|bfVar#115| |arglist|) (|i| NIL)) + (|bfTuple| (LET ((|bfVar#119| NIL) (|bfVar#118| |arglist|) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#115|) - (PROGN (SETQ |i| (CAR |bfVar#115|)) NIL)) - (RETURN (NREVERSE |bfVar#116|))) + ((OR (ATOM |bfVar#118|) + (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL)) + (RETURN (NREVERSE |bfVar#119|))) ('T - (SETQ |bfVar#116| - (CONS (|bfCreateDef| |i|) |bfVar#116|)))) - (SETQ |bfVar#115| (CDR |bfVar#115|)))))) + (SETQ |bfVar#119| + (CONS (|bfCreateDef| |i|) |bfVar#119|)))) + (SETQ |bfVar#118| (CDR |bfVar#118|)))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|)) @@ -2014,17 +2044,17 @@ (LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|)))) ('T (SETQ |a| - (LET ((|bfVar#118| NIL) (|bfVar#117| (CDR |x|)) + (LET ((|bfVar#121| NIL) (|bfVar#120| (CDR |x|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#117|) - (PROGN (SETQ |i| (CAR |bfVar#117|)) NIL)) - (RETURN (NREVERSE |bfVar#118|))) + ((OR (ATOM |bfVar#120|) + (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL)) + (RETURN (NREVERSE |bfVar#121|))) ('T - (SETQ |bfVar#118| - (CONS (|bfGenSymbol|) |bfVar#118|)))) - (SETQ |bfVar#117| (CDR |bfVar#117|))))) + (SETQ |bfVar#121| + (CONS (|bfGenSymbol|) |bfVar#121|)))) + (SETQ |bfVar#120| (CDR |bfVar#120|))))) (LIST 'DEFUN (CAR |x|) |a| (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) @@ -2051,22 +2081,22 @@ (DEFUN |bfCaseItems| (|g| |x|) (PROG (|j| |ISTMP#1| |i|) (RETURN - (LET ((|bfVar#121| NIL) (|bfVar#120| |x|) (|bfVar#119| NIL)) + (LET ((|bfVar#124| NIL) (|bfVar#123| |x|) (|bfVar#122| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#120|) - (PROGN (SETQ |bfVar#119| (CAR |bfVar#120|)) NIL)) - (RETURN (NREVERSE |bfVar#121|))) + ((OR (ATOM |bfVar#123|) + (PROGN (SETQ |bfVar#122| (CAR |bfVar#123|)) NIL)) + (RETURN (NREVERSE |bfVar#124|))) ('T - (AND (CONSP |bfVar#119|) + (AND (CONSP |bfVar#122|) (PROGN - (SETQ |i| (CAR |bfVar#119|)) - (SETQ |ISTMP#1| (CDR |bfVar#119|)) + (SETQ |i| (CAR |bfVar#122|)) + (SETQ |ISTMP#1| (CDR |bfVar#122|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T))) - (SETQ |bfVar#121| - (CONS (|bfCI| |g| |i| |j|) |bfVar#121|))))) - (SETQ |bfVar#120| (CDR |bfVar#120|))))))) + (SETQ |bfVar#124| + (CONS (|bfCI| |g| |i| |j|) |bfVar#124|))))) + (SETQ |bfVar#123| (CDR |bfVar#123|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|)) @@ -2079,18 +2109,18 @@ ((NULL |a|) (LIST (CAR |x|) |y|)) ('T (SETQ |b| - (LET ((|bfVar#123| NIL) (|bfVar#122| |a|) (|i| NIL) + (LET ((|bfVar#126| NIL) (|bfVar#125| |a|) (|i| NIL) (|j| 0)) (LOOP (COND - ((OR (ATOM |bfVar#122|) - (PROGN (SETQ |i| (CAR |bfVar#122|)) NIL)) - (RETURN (NREVERSE |bfVar#123|))) + ((OR (ATOM |bfVar#125|) + (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL)) + (RETURN (NREVERSE |bfVar#126|))) ('T - (SETQ |bfVar#123| + (SETQ |bfVar#126| (CONS (LIST |i| (|bfCARCDR| |j| |g|)) - |bfVar#123|)))) - (SETQ |bfVar#122| (CDR |bfVar#122|)) + |bfVar#126|)))) + (SETQ |bfVar#125| (CDR |bfVar#125|)) (SETQ |j| (+ |j| 1))))) (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))) @@ -2107,17 +2137,17 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%Thing|) |bfTry|)) (DEFUN |bfTry| (|e| |cs|) - (PROG (|bfVar#125| |bfVar#124|) + (PROG (|bfVar#128| |bfVar#127|) (RETURN (COND ((NULL |cs|) |e|) (#0='T (PROGN - (SETQ |bfVar#124| (CAR |cs|)) - (SETQ |bfVar#125| (CDR |bfVar#124|)) - (CASE (CAR |bfVar#124|) + (SETQ |bfVar#127| (CAR |cs|)) + (SETQ |bfVar#128| (CDR |bfVar#127|)) + (CASE (CAR |bfVar#127|) (|%Catch| - (LET ((|tag| (CAR |bfVar#125|))) + (LET ((|tag| (CAR |bfVar#128|))) (COND ((ATOM |tag|) (|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|) @@ -2128,6 +2158,52 @@ (DEFUN |bfThrow| (|e|) (COND ((ATOM |e|) (LIST 'THROW (LIST 'QUOTE |e|) NIL)) - ((NULL (ATOM (CAR |e|))) (|bpTrap|)) + ((NOT (ATOM (CAR |e|))) (|bpTrap|)) ('T (CONS 'THROW (CONS (LIST 'QUOTE (CAR |e|)) (CDR |e|)))))) +(DEFUN |backquote| (|form| |params|) + (COND + ((NULL |params|) (|quote| |form|)) + ((ATOM |form|) + (COND ((MEMBER |form| |params|) |form|) (#0='T (|quote| |form|)))) + (#0# + (CONS 'LIST + (LET ((|bfVar#130| NIL) (|bfVar#129| |form|) (|t| NIL)) + (LOOP + (COND + ((OR (ATOM |bfVar#129|) + (PROGN (SETQ |t| (CAR |bfVar#129|)) NIL)) + (RETURN (NREVERSE |bfVar#130|))) + ('T + (SETQ |bfVar#130| + (CONS (|backquote| |t| |params|) |bfVar#130|)))) + (SETQ |bfVar#129| (CDR |bfVar#129|)))))))) + +(DEFUN |genTypeAlias| (|head| |body|) + (PROG (|args| |op|) + (RETURN + (PROGN + (SETQ |op| (CAR |head|)) + (SETQ |args| (CDR |head|)) + (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))) + +(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|)) + +(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|)) + +(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |bootSymbol|)) + +(DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|))) + +(DEFUN |nativeType| (|t|) + (PROG (|t'|) + (DECLARE (SPECIAL |$NativeTypeTable|)) + (RETURN + (COND + ((NULL |t|) |t|) + ((SETQ |t'| (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|)) + (|bootSymbol| (CDR |t'|))) + ('T + (|fatalError| + (CONCAT "unsupported native type: " (SYMBOL-NAME |t|)))))))) + |