diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-19 07:20:55 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-19 07:20:55 +0000 |
commit | c6179efd4a1f1770d4d31415582eabebbe2ab6a0 (patch) | |
tree | b97b313c66be49e76f6f5fcc7e387ab362105c19 /src/boot | |
parent | a4a45e923a2435574c09619da442fd15e71b2652 (diff) | |
download | open-axiom-c6179efd4a1f1770d4d31415582eabebbe2ab6a0.tar.gz |
* boot/ast.boot (%Module): Now take three arguments.
* boot/parser.boot (bpModuleInterface): Rename from bpExports.
(bpModuleExports): New.
(bpModule): Now allow specification of exported names.
Diffstat (limited to 'src/boot')
-rw-r--r-- | src/boot/ast.boot | 2 | ||||
-rw-r--r-- | src/boot/parser.boot | 27 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 842 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 27 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 42 | ||||
-rw-r--r-- | src/boot/translator.boot | 8 |
6 files changed, 491 insertions, 457 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 0fc4a122..ec973521 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -85,7 +85,7 @@ structure %Name == structure %Ast == %Command(%String) -- includer command %Lisp(%String) -- )lisp command - %Module(%Name,%List) -- module declaration + %Module(%Name,%List,%List) -- module declaration %Namespace(%Name) -- namespace AxiomCore %Import(%String) -- import module %ImportSignature(%Name,%Signature) -- import function declaration diff --git a/src/boot/parser.boot b/src/boot/parser.boot index cfa034d8..eeb147ac 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -415,20 +415,31 @@ bpExportItem() == bpExportItemList() == bpListAndRecover function bpExportItem -++ Exports: -++ pile-bracketed ExporItemList -bpExports() == - bpPileBracketed function bpExportItemList +++ ModuleInterface: +++ WHERE pile-bracketed ExporItemList +bpModuleInterface() == + bpEqKey "WHERE" => + bpPileBracketed function bpExportItemList + or (bpExportItem() and bpPush [bpPop1()]) + or bpTrap() + bpPush nil + +++ ModuleExports: +++ OPAREN IdList CPAREN +bpModuleExports() == + bpParenthesized function bpIdList => bpPush bfUntuple bpPop1() + bpPush nil ++ Parse a module definitoin ++ Module: -++ MODULE QUOTE String +++ MODULE Name OptionalModuleExports OptionalModuleInterface bpModule() == bpEqKey "MODULE" => bpName() or bpTrap() - bpEqKey "WHERE" => - bpExports() and bpPush %Module(bpPop2(), bpPop1()) - bpPush %Module(bpPop1(),nil) + bpModuleExports() + bpModuleInterface() + bpPush %Module(bpPop3(),bpPop2(),bpPop1()) + nil ++ Parse a module import, or a import declaration for a foreign entity. ++ Import: diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 81ae3841..7b10b10b 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -33,130 +33,130 @@ (DEFUN |%Lisp| #0=(|bfVar#3|) (CONS '|%Lisp| (LIST . #0#))) -(DEFUN |%Module| #0=(|bfVar#4| |bfVar#5|) +(DEFUN |%Module| #0=(|bfVar#4| |bfVar#5| |bfVar#6|) (CONS '|%Module| (LIST . #0#))) -(DEFUN |%Namespace| #0=(|bfVar#6|) (CONS '|%Namespace| (LIST . #0#))) +(DEFUN |%Namespace| #0=(|bfVar#7|) (CONS '|%Namespace| (LIST . #0#))) -(DEFUN |%Import| #0=(|bfVar#7|) (CONS '|%Import| (LIST . #0#))) +(DEFUN |%Import| #0=(|bfVar#8|) (CONS '|%Import| (LIST . #0#))) -(DEFUN |%ImportSignature| #0=(|bfVar#8| |bfVar#9|) +(DEFUN |%ImportSignature| #0=(|bfVar#9| |bfVar#10|) (CONS '|%ImportSignature| (LIST . #0#))) -(DEFUN |%TypeAlias| #0=(|bfVar#10| |bfVar#11|) +(DEFUN |%TypeAlias| #0=(|bfVar#11| |bfVar#12|) (CONS '|%TypeAlias| (LIST . #0#))) -(DEFUN |%Signature| #0=(|bfVar#12| |bfVar#13|) +(DEFUN |%Signature| #0=(|bfVar#13| |bfVar#14|) (CONS '|%Signature| (LIST . #0#))) -(DEFUN |%Mapping| #0=(|bfVar#14| |bfVar#15|) +(DEFUN |%Mapping| #0=(|bfVar#15| |bfVar#16|) (CONS '|%Mapping| (LIST . #0#))) -(DEFUN |%SuffixDot| #0=(|bfVar#16|) (CONS '|%SuffixDot| (LIST . #0#))) +(DEFUN |%SuffixDot| #0=(|bfVar#17|) (CONS '|%SuffixDot| (LIST . #0#))) -(DEFUN |%Quote| #0=(|bfVar#17|) (CONS '|%Quote| (LIST . #0#))) +(DEFUN |%Quote| #0=(|bfVar#18|) (CONS '|%Quote| (LIST . #0#))) -(DEFUN |%EqualName| #0=(|bfVar#18|) (CONS '|%EqualName| (LIST . #0#))) +(DEFUN |%EqualName| #0=(|bfVar#19|) (CONS '|%EqualName| (LIST . #0#))) -(DEFUN |%Colon| #0=(|bfVar#19|) (CONS '|%Colon| (LIST . #0#))) +(DEFUN |%Colon| #0=(|bfVar#20|) (CONS '|%Colon| (LIST . #0#))) -(DEFUN |%QualifiedName| #0=(|bfVar#20| |bfVar#21|) +(DEFUN |%QualifiedName| #0=(|bfVar#21| |bfVar#22|) (CONS '|%QualifiedName| (LIST . #0#))) -(DEFUN |%DefaultValue| #0=(|bfVar#22| |bfVar#23|) +(DEFUN |%DefaultValue| #0=(|bfVar#23| |bfVar#24|) (CONS '|%DefaultValue| (LIST . #0#))) -(DEFUN |%Bracket| #0=(|bfVar#24|) (CONS '|%Bracket| (LIST . #0#))) +(DEFUN |%Bracket| #0=(|bfVar#25|) (CONS '|%Bracket| (LIST . #0#))) -(DEFUN |%UnboundedSegment| #0=(|bfVar#25|) +(DEFUN |%UnboundedSegment| #0=(|bfVar#26|) (CONS '|%UnboundedSegment| (LIST . #0#))) -(DEFUN |%BoundedSgement| #0=(|bfVar#26| |bfVar#27|) +(DEFUN |%BoundedSgement| #0=(|bfVar#27| |bfVar#28|) (CONS '|%BoundedSgement| (LIST . #0#))) -(DEFUN |%Tuple| #0=(|bfVar#28|) (CONS '|%Tuple| (LIST . #0#))) +(DEFUN |%Tuple| #0=(|bfVar#29|) (CONS '|%Tuple| (LIST . #0#))) -(DEFUN |%ColonAppend| #0=(|bfVar#29| |bfVar#30|) +(DEFUN |%ColonAppend| #0=(|bfVar#30| |bfVar#31|) (CONS '|%ColonAppend| (LIST . #0#))) -(DEFUN |%Pretend| #0=(|bfVar#31| |bfVar#32|) +(DEFUN |%Pretend| #0=(|bfVar#32| |bfVar#33|) (CONS '|%Pretend| (LIST . #0#))) -(DEFUN |%Is| #0=(|bfVar#33| |bfVar#34|) (CONS '|%Is| (LIST . #0#))) +(DEFUN |%Is| #0=(|bfVar#34| |bfVar#35|) (CONS '|%Is| (LIST . #0#))) -(DEFUN |%Isnt| #0=(|bfVar#35| |bfVar#36|) +(DEFUN |%Isnt| #0=(|bfVar#36| |bfVar#37|) (CONS '|%Isnt| (LIST . #0#))) -(DEFUN |%Reduce| #0=(|bfVar#37| |bfVar#38|) +(DEFUN |%Reduce| #0=(|bfVar#38| |bfVar#39|) (CONS '|%Reduce| (LIST . #0#))) -(DEFUN |%PrefixExpr| #0=(|bfVar#39| |bfVar#40|) +(DEFUN |%PrefixExpr| #0=(|bfVar#40| |bfVar#41|) (CONS '|%PrefixExpr| (LIST . #0#))) -(DEFUN |%Call| #0=(|bfVar#41| |bfVar#42|) +(DEFUN |%Call| #0=(|bfVar#42| |bfVar#43|) (CONS '|%Call| (LIST . #0#))) -(DEFUN |%InfixExpr| #0=(|bfVar#43| |bfVar#44| |bfVar#45|) +(DEFUN |%InfixExpr| #0=(|bfVar#44| |bfVar#45| |bfVar#46|) (CONS '|%InfixExpr| (LIST . #0#))) -(DEFUN |%ConstantDefinition| #0=(|bfVar#46| |bfVar#47|) +(DEFUN |%ConstantDefinition| #0=(|bfVar#47| |bfVar#48|) (CONS '|%ConstantDefinition| (LIST . #0#))) -(DEFUN |%Definition| #0=(|bfVar#48| |bfVar#49| |bfVar#50|) +(DEFUN |%Definition| #0=(|bfVar#49| |bfVar#50| |bfVar#51|) (CONS '|%Definition| (LIST . #0#))) -(DEFUN |%Macro| #0=(|bfVar#51| |bfVar#52| |bfVar#53|) +(DEFUN |%Macro| #0=(|bfVar#52| |bfVar#53| |bfVar#54|) (CONS '|%Macro| (LIST . #0#))) -(DEFUN |%Lambda| #0=(|bfVar#54| |bfVar#55|) +(DEFUN |%Lambda| #0=(|bfVar#55| |bfVar#56|) (CONS '|%Lambda| (LIST . #0#))) -(DEFUN |%SuchThat| #0=(|bfVar#56|) (CONS '|%SuchThat| (LIST . #0#))) +(DEFUN |%SuchThat| #0=(|bfVar#57|) (CONS '|%SuchThat| (LIST . #0#))) -(DEFUN |%Assignment| #0=(|bfVar#57| |bfVar#58|) +(DEFUN |%Assignment| #0=(|bfVar#58| |bfVar#59|) (CONS '|%Assignment| (LIST . #0#))) -(DEFUN |%While| #0=(|bfVar#59|) (CONS '|%While| (LIST . #0#))) +(DEFUN |%While| #0=(|bfVar#60|) (CONS '|%While| (LIST . #0#))) -(DEFUN |%Until| #0=(|bfVar#60|) (CONS '|%Until| (LIST . #0#))) +(DEFUN |%Until| #0=(|bfVar#61|) (CONS '|%Until| (LIST . #0#))) -(DEFUN |%For| #0=(|bfVar#61| |bfVar#62| |bfVar#63|) +(DEFUN |%For| #0=(|bfVar#62| |bfVar#63| |bfVar#64|) (CONS '|%For| (LIST . #0#))) -(DEFUN |%Implies| #0=(|bfVar#64| |bfVar#65|) +(DEFUN |%Implies| #0=(|bfVar#65| |bfVar#66|) (CONS '|%Implies| (LIST . #0#))) -(DEFUN |%Iterators| #0=(|bfVar#66|) (CONS '|%Iterators| (LIST . #0#))) +(DEFUN |%Iterators| #0=(|bfVar#67|) (CONS '|%Iterators| (LIST . #0#))) -(DEFUN |%Cross| #0=(|bfVar#67|) (CONS '|%Cross| (LIST . #0#))) +(DEFUN |%Cross| #0=(|bfVar#68|) (CONS '|%Cross| (LIST . #0#))) -(DEFUN |%Repeat| #0=(|bfVar#68| |bfVar#69|) +(DEFUN |%Repeat| #0=(|bfVar#69| |bfVar#70|) (CONS '|%Repeat| (LIST . #0#))) -(DEFUN |%Pile| #0=(|bfVar#70|) (CONS '|%Pile| (LIST . #0#))) +(DEFUN |%Pile| #0=(|bfVar#71|) (CONS '|%Pile| (LIST . #0#))) -(DEFUN |%Append| #0=(|bfVar#71|) (CONS '|%Append| (LIST . #0#))) +(DEFUN |%Append| #0=(|bfVar#72|) (CONS '|%Append| (LIST . #0#))) -(DEFUN |%Case| #0=(|bfVar#72| |bfVar#73|) +(DEFUN |%Case| #0=(|bfVar#73| |bfVar#74|) (CONS '|%Case| (LIST . #0#))) -(DEFUN |%Return| #0=(|bfVar#74|) (CONS '|%Return| (LIST . #0#))) +(DEFUN |%Return| #0=(|bfVar#75|) (CONS '|%Return| (LIST . #0#))) -(DEFUN |%Leave| #0=(|bfVar#75|) (CONS '|%Leave| (LIST . #0#))) +(DEFUN |%Leave| #0=(|bfVar#76|) (CONS '|%Leave| (LIST . #0#))) -(DEFUN |%Throw| #0=(|bfVar#76|) (CONS '|%Throw| (LIST . #0#))) +(DEFUN |%Throw| #0=(|bfVar#77|) (CONS '|%Throw| (LIST . #0#))) -(DEFUN |%Catch| #0=(|bfVar#77| |bfVar#78|) +(DEFUN |%Catch| #0=(|bfVar#78| |bfVar#79|) (CONS '|%Catch| (LIST . #0#))) -(DEFUN |%Finally| #0=(|bfVar#79|) (CONS '|%Finally| (LIST . #0#))) +(DEFUN |%Finally| #0=(|bfVar#80|) (CONS '|%Finally| (LIST . #0#))) -(DEFUN |%Try| #0=(|bfVar#80| |bfVar#81|) (CONS '|%Try| (LIST . #0#))) +(DEFUN |%Try| #0=(|bfVar#81| |bfVar#82|) (CONS '|%Try| (LIST . #0#))) -(DEFUN |%Where| #0=(|bfVar#82| |bfVar#83|) +(DEFUN |%Where| #0=(|bfVar#83| |bfVar#84|) (CONS '|%Where| (LIST . #0#))) -(DEFUN |%Structure| #0=(|bfVar#84| |bfVar#85|) +(DEFUN |%Structure| #0=(|bfVar#85| |bfVar#86|) (CONS '|%Structure| (LIST . #0#))) (DEFPARAMETER |$inDefIS| NIL) @@ -259,21 +259,21 @@ (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) (T (LIST |b|)))) (COND - ((LET ((|bfVar#87| NIL) (|bfVar#86| |a|) (|x| NIL)) + ((LET ((|bfVar#88| NIL) (|bfVar#87| |a|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#86|) - (PROGN (SETQ |x| (CAR |bfVar#86|)) NIL)) - (RETURN |bfVar#87|)) + ((OR (ATOM |bfVar#87|) + (PROGN (SETQ |x| (CAR |bfVar#87|)) NIL)) + (RETURN |bfVar#88|)) (T (PROGN - (SETQ |bfVar#87| + (SETQ |bfVar#88| (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))) - (COND (|bfVar#87| (RETURN |bfVar#87|)))))) - (SETQ |bfVar#86| (CDR |bfVar#86|)))) + (COND (|bfVar#88| (RETURN |bfVar#88|)))))) + (SETQ |bfVar#87| (CDR |bfVar#87|)))) (|bfMakeCons| |a|)) (T (CONS 'LIST |a|))))))) @@ -425,19 +425,19 @@ (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) (T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) - (LET ((|bfVar#90| NIL) (|bfVar#88| |f|) (|i| NIL) - (|bfVar#89| |r|) (|j| NIL)) + (LET ((|bfVar#91| NIL) (|bfVar#89| |f|) (|i| NIL) + (|bfVar#90| |r|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#88|) - (PROGN (SETQ |i| (CAR |bfVar#88|)) NIL) - (ATOM |bfVar#89|) - (PROGN (SETQ |j| (CAR |bfVar#89|)) NIL)) - (RETURN (NREVERSE |bfVar#90|))) - (T (SETQ |bfVar#90| - (CONS (APPEND |i| |j|) |bfVar#90|)))) - (SETQ |bfVar#88| (CDR |bfVar#88|)) - (SETQ |bfVar#89| (CDR |bfVar#89|))))))))) + ((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|))) + (T (SETQ |bfVar#91| + (CONS (APPEND |i| |j|) |bfVar#91|)))) + (SETQ |bfVar#89| (CDR |bfVar#89|)) + (SETQ |bfVar#90| (CDR |bfVar#90|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) @@ -555,25 +555,25 @@ (COND (|vars| (SETQ |loop| (LIST 'LET - (LET ((|bfVar#93| NIL) - (|bfVar#91| |vars|) (|v| NIL) - (|bfVar#92| |inits|) (|i| NIL)) + (LET ((|bfVar#94| NIL) + (|bfVar#92| |vars|) (|v| NIL) + (|bfVar#93| |inits|) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#91|) + ((OR (ATOM |bfVar#92|) (PROGN - (SETQ |v| (CAR |bfVar#91|)) + (SETQ |v| (CAR |bfVar#92|)) NIL) - (ATOM |bfVar#92|) + (ATOM |bfVar#93|) (PROGN - (SETQ |i| (CAR |bfVar#92|)) + (SETQ |i| (CAR |bfVar#93|)) NIL)) - (RETURN (NREVERSE |bfVar#93|))) + (RETURN (NREVERSE |bfVar#94|))) (T - (SETQ |bfVar#93| - (CONS (LIST |v| |i|) |bfVar#93|)))) - (SETQ |bfVar#91| (CDR |bfVar#91|)) - (SETQ |bfVar#92| (CDR |bfVar#92|)))) + (SETQ |bfVar#94| + (CONS (LIST |v| |i|) |bfVar#94|)))) + (SETQ |bfVar#92| (CDR |bfVar#92|)) + (SETQ |bfVar#93| (CDR |bfVar#93|)))) |loop|)))) |loop|)))) @@ -1104,16 +1104,16 @@ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |seq| (CAR |ISTMP#1|)) T))) (CONSP |seq|) - (LET ((|bfVar#95| T) (|bfVar#94| |seq|) (|y| NIL)) + (LET ((|bfVar#96| T) (|bfVar#95| |seq|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#94|) - (PROGN (SETQ |y| (CAR |bfVar#94|)) NIL)) - (RETURN |bfVar#95|)) + ((OR (ATOM |bfVar#95|) + (PROGN (SETQ |y| (CAR |bfVar#95|)) NIL)) + (RETURN |bfVar#96|)) (T (PROGN - (SETQ |bfVar#95| (APPLY |pred| |y| NIL)) - (COND ((NOT |bfVar#95|) (RETURN NIL)))))) - (SETQ |bfVar#94| (CDR |bfVar#94|)))))))) + (SETQ |bfVar#96| (APPLY |pred| |y| NIL)) + (COND ((NOT |bfVar#96|) (RETURN NIL)))))) + (SETQ |bfVar#95| (CDR |bfVar#95|)))))))) (DEFUN |bfMember| (|var| |seq|) (PROG (|ISTMP#1|) @@ -1173,32 +1173,32 @@ ((NULL |l|) NIL) ((NULL (CDR |l|)) (CAR |l|)) (T (CONS 'OR - (LET ((|bfVar#97| NIL) (|bfVar#96| |l|) (|c| NIL)) + (LET ((|bfVar#98| NIL) (|bfVar#97| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#96|) - (PROGN (SETQ |c| (CAR |bfVar#96|)) NIL)) - (RETURN (NREVERSE |bfVar#97|))) - (T (SETQ |bfVar#97| + ((OR (ATOM |bfVar#97|) + (PROGN (SETQ |c| (CAR |bfVar#97|)) NIL)) + (RETURN (NREVERSE |bfVar#98|))) + (T (SETQ |bfVar#98| (APPEND (REVERSE (|bfFlatten| 'OR |c|)) - |bfVar#97|)))) - (SETQ |bfVar#96| (CDR |bfVar#96|)))))))) + |bfVar#98|)))) + (SETQ |bfVar#97| (CDR |bfVar#97|)))))))) (DEFUN |bfAND| (|l|) (COND ((NULL |l|) T) ((NULL (CDR |l|)) (CAR |l|)) (T (CONS 'AND - (LET ((|bfVar#99| NIL) (|bfVar#98| |l|) (|c| NIL)) + (LET ((|bfVar#100| NIL) (|bfVar#99| |l|) (|c| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#98|) - (PROGN (SETQ |c| (CAR |bfVar#98|)) NIL)) - (RETURN (NREVERSE |bfVar#99|))) - (T (SETQ |bfVar#99| + ((OR (ATOM |bfVar#99|) + (PROGN (SETQ |c| (CAR |bfVar#99|)) NIL)) + (RETURN (NREVERSE |bfVar#100|))) + (T (SETQ |bfVar#100| (APPEND (REVERSE (|bfFlatten| 'AND |c|)) - |bfVar#99|)))) - (SETQ |bfVar#98| (CDR |bfVar#98|)))))))) + |bfVar#100|)))) + (SETQ |bfVar#99| (CDR |bfVar#99|)))))))) (DEFUN |defQuoteId| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|)))) @@ -1258,52 +1258,52 @@ (SETQ |nargl| (CADDR . #0#)) (SETQ |largl| (CADDDR . #0#)) (SETQ |sb| - (LET ((|bfVar#102| NIL) (|bfVar#100| |nargl|) (|i| NIL) - (|bfVar#101| |sgargl|) (|j| NIL)) + (LET ((|bfVar#103| NIL) (|bfVar#101| |nargl|) (|i| NIL) + (|bfVar#102| |sgargl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#100|) - (PROGN (SETQ |i| (CAR |bfVar#100|)) NIL) - (ATOM |bfVar#101|) - (PROGN (SETQ |j| (CAR |bfVar#101|)) NIL)) - (RETURN (NREVERSE |bfVar#102|))) - (T (SETQ |bfVar#102| - (CONS (CONS |i| |j|) |bfVar#102|)))) - (SETQ |bfVar#100| (CDR |bfVar#100|)) - (SETQ |bfVar#101| (CDR |bfVar#101|))))) + ((OR (ATOM |bfVar#101|) + (PROGN (SETQ |i| (CAR |bfVar#101|)) NIL) + (ATOM |bfVar#102|) + (PROGN (SETQ |j| (CAR |bfVar#102|)) NIL)) + (RETURN (NREVERSE |bfVar#103|))) + (T (SETQ |bfVar#103| + (CONS (CONS |i| |j|) |bfVar#103|)))) + (SETQ |bfVar#101| (CDR |bfVar#101|)) + (SETQ |bfVar#102| (CDR |bfVar#102|))))) (SETQ |body| (SUBLIS |sb| |body|)) (SETQ |sb2| - (LET ((|bfVar#105| NIL) (|bfVar#103| |sgargl|) (|i| NIL) - (|bfVar#104| |largl|) (|j| NIL)) + (LET ((|bfVar#106| NIL) (|bfVar#104| |sgargl|) (|i| NIL) + (|bfVar#105| |largl|) (|j| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#103|) - (PROGN (SETQ |i| (CAR |bfVar#103|)) NIL) - (ATOM |bfVar#104|) - (PROGN (SETQ |j| (CAR |bfVar#104|)) NIL)) - (RETURN (NREVERSE |bfVar#105|))) - (T (SETQ |bfVar#105| + ((OR (ATOM |bfVar#104|) + (PROGN (SETQ |i| (CAR |bfVar#104|)) NIL) + (ATOM |bfVar#105|) + (PROGN (SETQ |j| (CAR |bfVar#105|)) NIL)) + (RETURN (NREVERSE |bfVar#106|))) + (T (SETQ |bfVar#106| (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|) - |bfVar#105|)))) - (SETQ |bfVar#103| (CDR |bfVar#103|)) - (SETQ |bfVar#104| (CDR |bfVar#104|))))) + |bfVar#106|)))) + (SETQ |bfVar#104| (CDR |bfVar#104|)) + (SETQ |bfVar#105| (CDR |bfVar#105|))))) (SETQ |body| (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|))) (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) (SETQ |def| (LIST |op| |lamex|)) (CONS (|shoeComp| |def|) - (LET ((|bfVar#107| NIL) (|bfVar#106| |$wheredefs|) + (LET ((|bfVar#108| NIL) (|bfVar#107| |$wheredefs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#106|) - (PROGN (SETQ |d| (CAR |bfVar#106|)) NIL)) - (RETURN (NREVERSE |bfVar#107|))) - (T (SETQ |bfVar#107| + ((OR (ATOM |bfVar#107|) + (PROGN (SETQ |d| (CAR |bfVar#107|)) NIL)) + (RETURN (NREVERSE |bfVar#108|))) + (T (SETQ |bfVar#108| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#107|)))) - (SETQ |bfVar#106| (CDR |bfVar#106|))))))))) + |bfVar#108|)))) + (SETQ |bfVar#107| (CDR |bfVar#107|))))))))) (DEFUN |bfGargl| (|argl|) (PROG (|f| |d| |c| |b| |a| |LETTMP#1|) @@ -1323,13 +1323,13 @@ (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|) (CONS |f| |d|))))))))) -(DEFUN |bfDef1| (|bfVar#108|) +(DEFUN |bfDef1| (|bfVar#109|) (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op|) (RETURN (PROGN - (SETQ |op| (CAR |bfVar#108|)) - (SETQ |args| (CADR . #0=(|bfVar#108|))) + (SETQ |op| (CAR |bfVar#109|)) + (SETQ |args| (CADR . #0=(|bfVar#109|))) (SETQ |body| (CADDR . #0#)) (SETQ |argl| (COND @@ -1370,30 +1370,30 @@ (SETQ |arg1| (CADDR . #0#)) (SETQ |body1| (CDDDR . #0#)) (|bfCompHash| |op1| |arg1| |body1|)) (T (|bfTuple| - (LET ((|bfVar#110| NIL) - (|bfVar#109| + (LET ((|bfVar#111| NIL) + (|bfVar#110| (CONS (LIST |op| |args| |body|) |$wheredefs|)) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#109|) - (PROGN (SETQ |d| (CAR |bfVar#109|)) NIL)) - (RETURN (NREVERSE |bfVar#110|))) - (T (SETQ |bfVar#110| + ((OR (ATOM |bfVar#110|) + (PROGN (SETQ |d| (CAR |bfVar#110|)) NIL)) + (RETURN (NREVERSE |bfVar#111|))) + (T (SETQ |bfVar#111| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) - |bfVar#110|)))) - (SETQ |bfVar#109| (CDR |bfVar#109|)))))))))) + |bfVar#111|)))) + (SETQ |bfVar#110| (CDR |bfVar#110|)))))))))) (DEFUN |shoeComps| (|x|) - (LET ((|bfVar#112| NIL) (|bfVar#111| |x|) (|def| NIL)) + (LET ((|bfVar#113| NIL) (|bfVar#112| |x|) (|def| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#111|) - (PROGN (SETQ |def| (CAR |bfVar#111|)) NIL)) - (RETURN (NREVERSE |bfVar#112|))) - (T (SETQ |bfVar#112| (CONS (|shoeComp| |def|) |bfVar#112|)))) - (SETQ |bfVar#111| (CDR |bfVar#111|))))) + ((OR (ATOM |bfVar#112|) + (PROGN (SETQ |def| (CAR |bfVar#112|)) NIL)) + (RETURN (NREVERSE |bfVar#113|))) + (T (SETQ |bfVar#113| (CONS (|shoeComp| |def|) |bfVar#113|)))) + (SETQ |bfVar#112| (CDR |bfVar#112|))))) (DEFUN |shoeComp| (|x|) (PROG (|a|) @@ -1535,16 +1535,16 @@ (COND ((MEMQ |op| '(RETURN RETURN-FROM)) T) ((MEMQ |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL) - ((LET ((|bfVar#114| NIL) (|bfVar#113| |body|) (|t| NIL)) + ((LET ((|bfVar#115| NIL) (|bfVar#114| |body|) (|t| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#113|) - (PROGN (SETQ |t| (CAR |bfVar#113|)) NIL)) - (RETURN |bfVar#114|)) + ((OR (ATOM |bfVar#114|) + (PROGN (SETQ |t| (CAR |bfVar#114|)) NIL)) + (RETURN |bfVar#115|)) (T (PROGN - (SETQ |bfVar#114| (|needsPROG| |t|)) - (COND (|bfVar#114| (RETURN |bfVar#114|)))))) - (SETQ |bfVar#113| (CDR |bfVar#113|)))) + (SETQ |bfVar#115| (|needsPROG| |t|)) + (COND (|bfVar#115| (RETURN |bfVar#115|)))))) + (SETQ |bfVar#114| (CDR |bfVar#114|)))) T) (T NIL))))))) @@ -1638,11 +1638,11 @@ (RPLACA (CDR |x|) (CADR |l|))))) ((EQ U '|%Leave|) (RPLACA |x| 'RETURN)) ((MEMQ U '(PROG LAMBDA)) (SETQ |newbindings| NIL) - (LET ((|bfVar#115| (CADR |x|)) (|y| NIL)) + (LET ((|bfVar#116| (CADR |x|)) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#115|) - (PROGN (SETQ |y| (CAR |bfVar#115|)) NIL)) + ((OR (ATOM |bfVar#116|) + (PROGN (SETQ |y| (CAR |bfVar#116|)) NIL)) (RETURN NIL)) (T (COND ((NOT (MEMQ |y| |$locVars|)) @@ -1651,22 +1651,22 @@ (SETQ |$locVars| (CONS |y| |$locVars|)) (SETQ |newbindings| (CONS |y| |newbindings|)))))))) - (SETQ |bfVar#115| (CDR |bfVar#115|)))) + (SETQ |bfVar#116| (CDR |bfVar#116|)))) (SETQ |res| (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| - (LET ((|bfVar#117| NIL) (|bfVar#116| |$locVars|) + (LET ((|bfVar#118| NIL) (|bfVar#117| |$locVars|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#116|) + ((OR (ATOM |bfVar#117|) (PROGN - (SETQ |y| (CAR |bfVar#116|)) + (SETQ |y| (CAR |bfVar#117|)) NIL)) - (RETURN (NREVERSE |bfVar#117|))) + (RETURN (NREVERSE |bfVar#118|))) (T (AND (NOT (MEMQ |y| |newbindings|)) - (SETQ |bfVar#117| - (CONS |y| |bfVar#117|))))) - (SETQ |bfVar#116| (CDR |bfVar#116|)))))) + (SETQ |bfVar#118| + (CONS |y| |bfVar#118|))))) + (SETQ |bfVar#117| (CDR |bfVar#117|)))))) (T (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))) @@ -1757,13 +1757,13 @@ (RETURN (PROGN (SETQ |a| - (LET ((|bfVar#118| NIL) (|c| |l|)) + (LET ((|bfVar#119| NIL) (|c| |l|)) (LOOP (COND - ((ATOM |c|) (RETURN (NREVERSE |bfVar#118|))) - (T (SETQ |bfVar#118| + ((ATOM |c|) (RETURN (NREVERSE |bfVar#119|))) + (T (SETQ |bfVar#119| (APPEND (REVERSE (|bfFlattenSeq| |c|)) - |bfVar#118|)))) + |bfVar#119|)))) (SETQ |c| (CDR |c|))))) (COND ((NULL |a|) NIL) @@ -1781,17 +1781,17 @@ ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) (COND ((CDR |x|) - (LET ((|bfVar#120| NIL) (|bfVar#119| (CDR |f|)) + (LET ((|bfVar#121| NIL) (|bfVar#120| (CDR |f|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#119|) - (PROGN (SETQ |i| (CAR |bfVar#119|)) NIL)) - (RETURN (NREVERSE |bfVar#120|))) + ((OR (ATOM |bfVar#120|) + (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL)) + (RETURN (NREVERSE |bfVar#121|))) (T (AND (NOT (ATOM |i|)) - (SETQ |bfVar#120| - (CONS |i| |bfVar#120|))))) - (SETQ |bfVar#119| (CDR |bfVar#119|))))) + (SETQ |bfVar#121| + (CONS |i| |bfVar#121|))))) + (SETQ |bfVar#120| (CDR |bfVar#120|))))) (T (CDR |f|)))) (T (LIST |f|)))))))) @@ -1840,11 +1840,11 @@ (COND ((NULL |l|) NIL) (T (SETQ |transform| - (LET ((|bfVar#122| NIL) (|bfVar#121| |l|) (|x| NIL)) + (LET ((|bfVar#123| NIL) (|bfVar#122| |l|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#121|) - (PROGN (SETQ |x| (CAR |bfVar#121|)) NIL) + ((OR (ATOM |bfVar#122|) + (PROGN (SETQ |x| (CAR |bfVar#122|)) NIL) (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND) (PROGN (SETQ |ISTMP#1| (CDR |x|)) @@ -1878,11 +1878,11 @@ (SETQ |b| (CAR |ISTMP#5|)) T)))))))))))))) - (RETURN (NREVERSE |bfVar#122|))) - (T (SETQ |bfVar#122| + (RETURN (NREVERSE |bfVar#123|))) + (T (SETQ |bfVar#123| (CONS (|bfAlternative| |a| |b|) - |bfVar#122|)))) - (SETQ |bfVar#121| (CDR |bfVar#121|))))) + |bfVar#123|)))) + (SETQ |bfVar#122| (CDR |bfVar#122|))))) (SETQ |no| (LENGTH |transform|)) (SETQ |before| (|bfTake| |no| |l|)) (SETQ |aft| (|bfDrop| |no| |l|)) @@ -1914,17 +1914,17 @@ (SETQ |defs| (CADR . #0=(|LETTMP#1|))) (SETQ |nondefs| (CADDR . #0#)) (SETQ |a| - (LET ((|bfVar#124| NIL) (|bfVar#123| |defs|) (|d| NIL)) + (LET ((|bfVar#125| NIL) (|bfVar#124| |defs|) (|d| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#123|) - (PROGN (SETQ |d| (CAR |bfVar#123|)) NIL)) - (RETURN (NREVERSE |bfVar#124|))) - (T (SETQ |bfVar#124| + ((OR (ATOM |bfVar#124|) + (PROGN (SETQ |d| (CAR |bfVar#124|)) NIL)) + (RETURN (NREVERSE |bfVar#125|))) + (T (SETQ |bfVar#125| (CONS (LIST (CAR |d|) (CADR |d|) (|bfSUBLIS| |opassoc| (CADDR |d|))) - |bfVar#124|)))) - (SETQ |bfVar#123| (CDR |bfVar#123|))))) + |bfVar#125|)))) + (SETQ |bfVar#124| (CDR |bfVar#124|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|)))))))) @@ -2008,16 +2008,16 @@ ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) (T (SETQ |a| - (LET ((|bfVar#126| NIL) (|bfVar#125| (CDR |x|)) + (LET ((|bfVar#127| NIL) (|bfVar#126| (CDR |x|)) (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#125|) - (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL)) - (RETURN (NREVERSE |bfVar#126|))) - (T (SETQ |bfVar#126| - (CONS (|bfGenSymbol|) |bfVar#126|)))) - (SETQ |bfVar#125| (CDR |bfVar#125|))))) + ((OR (ATOM |bfVar#126|) + (PROGN (SETQ |i| (CAR |bfVar#126|)) NIL)) + (RETURN (NREVERSE |bfVar#127|))) + (T (SETQ |bfVar#127| + (CONS (|bfGenSymbol|) |bfVar#127|)))) + (SETQ |bfVar#126| (CDR |bfVar#126|))))) (LIST 'DEFUN (CAR |x|) |a| (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) @@ -2044,21 +2044,21 @@ (DEFUN |bfCaseItems| (|g| |x|) (PROG (|j| |ISTMP#1| |i|) (RETURN - (LET ((|bfVar#129| NIL) (|bfVar#128| |x|) (|bfVar#127| NIL)) + (LET ((|bfVar#130| NIL) (|bfVar#129| |x|) (|bfVar#128| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#128|) - (PROGN (SETQ |bfVar#127| (CAR |bfVar#128|)) NIL)) - (RETURN (NREVERSE |bfVar#129|))) - (T (AND (CONSP |bfVar#127|) + ((OR (ATOM |bfVar#129|) + (PROGN (SETQ |bfVar#128| (CAR |bfVar#129|)) NIL)) + (RETURN (NREVERSE |bfVar#130|))) + (T (AND (CONSP |bfVar#128|) (PROGN - (SETQ |i| (CAR |bfVar#127|)) - (SETQ |ISTMP#1| (CDR |bfVar#127|)) + (SETQ |i| (CAR |bfVar#128|)) + (SETQ |ISTMP#1| (CDR |bfVar#128|)) (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |j| (CAR |ISTMP#1|)) T))) - (SETQ |bfVar#129| - (CONS (|bfCI| |g| |i| |j|) |bfVar#129|))))) - (SETQ |bfVar#128| (CDR |bfVar#128|))))))) + (SETQ |bfVar#130| + (CONS (|bfCI| |g| |i| |j|) |bfVar#130|))))) + (SETQ |bfVar#129| (CDR |bfVar#129|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|)) @@ -2070,19 +2070,19 @@ (COND ((NULL |a|) (LIST (CAR |x|) |y|)) (T (SETQ |b| - (LET ((|bfVar#131| NIL) (|bfVar#130| |a|) (|i| NIL) + (LET ((|bfVar#132| NIL) (|bfVar#131| |a|) (|i| NIL) (|j| 1)) (LOOP (COND - ((OR (ATOM |bfVar#130|) - (PROGN (SETQ |i| (CAR |bfVar#130|)) NIL)) - (RETURN (NREVERSE |bfVar#131|))) + ((OR (ATOM |bfVar#131|) + (PROGN (SETQ |i| (CAR |bfVar#131|)) NIL)) + (RETURN (NREVERSE |bfVar#132|))) (T (AND (NOT (EQ |i| 'DOT)) - (SETQ |bfVar#131| + (SETQ |bfVar#132| (CONS (LIST |i| (|bfCARCDR| |j| |g|)) - |bfVar#131|))))) - (SETQ |bfVar#130| (CDR |bfVar#130|)) + |bfVar#132|))))) + (SETQ |bfVar#131| (CDR |bfVar#131|)) (SETQ |j| (+ |j| 1))))) (COND ((NULL |b|) (LIST (CAR |x|) |y|)) @@ -2218,16 +2218,16 @@ ((ATOM |form|) (COND ((MEMBER |form| |params|) |form|) (T (|quote| |form|)))) (T (CONS 'LIST - (LET ((|bfVar#133| NIL) (|bfVar#132| |form|) (|t| NIL)) + (LET ((|bfVar#134| NIL) (|bfVar#133| |form|) (|t| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#132|) - (PROGN (SETQ |t| (CAR |bfVar#132|)) NIL)) - (RETURN (NREVERSE |bfVar#133|))) - (T (SETQ |bfVar#133| + ((OR (ATOM |bfVar#133|) + (PROGN (SETQ |t| (CAR |bfVar#133|)) NIL)) + (RETURN (NREVERSE |bfVar#134|))) + (T (SETQ |bfVar#134| (CONS (|backquote| |t| |params|) - |bfVar#133|)))) - (SETQ |bfVar#132| (CDR |bfVar#132|)))))))) + |bfVar#134|)))) + (SETQ |bfVar#133| (CDR |bfVar#133|)))))))) (DEFUN |genTypeAlias| (|head| |body|) (PROG (|args| |op|) @@ -2427,47 +2427,47 @@ (RETURN (PROGN (SETQ |argtypes| - (LET ((|bfVar#135| NIL) (|bfVar#134| |s|) (|x| NIL)) + (LET ((|bfVar#136| NIL) (|bfVar#135| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#134|) - (PROGN (SETQ |x| (CAR |bfVar#134|)) NIL)) - (RETURN (NREVERSE |bfVar#135|))) - (T (SETQ |bfVar#135| + ((OR (ATOM |bfVar#135|) + (PROGN (SETQ |x| (CAR |bfVar#135|)) NIL)) + (RETURN (NREVERSE |bfVar#136|))) + (T (SETQ |bfVar#136| (CONS (|nativeArgumentType| |x|) - |bfVar#135|)))) - (SETQ |bfVar#134| (CDR |bfVar#134|))))) + |bfVar#136|)))) + (SETQ |bfVar#135| (CDR |bfVar#135|))))) (SETQ |rettype| (|nativeReturnType| |t|)) (COND - ((LET ((|bfVar#137| T) (|bfVar#136| (CONS |t| |s|)) + ((LET ((|bfVar#138| T) (|bfVar#137| (CONS |t| |s|)) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#136|) - (PROGN (SETQ |x| (CAR |bfVar#136|)) NIL)) - (RETURN |bfVar#137|)) + ((OR (ATOM |bfVar#137|) + (PROGN (SETQ |x| (CAR |bfVar#137|)) NIL)) + (RETURN |bfVar#138|)) (T (PROGN - (SETQ |bfVar#137| (|isSimpleNativeType| |x|)) - (COND ((NOT |bfVar#137|) (RETURN NIL)))))) - (SETQ |bfVar#136| (CDR |bfVar#136|)))) + (SETQ |bfVar#138| (|isSimpleNativeType| |x|)) + (COND ((NOT |bfVar#138|) (RETURN NIL)))))) + (SETQ |bfVar#137| (CDR |bfVar#137|)))) (LIST (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| (PNAME |op'|))))) (T (SETQ |cop| (CONCAT (PNAME |op'|) "_stub")) (SETQ |cargs| - (LET ((|bfVar#144| NIL) - (|bfVar#143| (- (LENGTH |s|) 1)) (|i| 0)) + (LET ((|bfVar#145| NIL) + (|bfVar#144| (- (LENGTH |s|) 1)) (|i| 0)) (LOOP (COND - ((> |i| |bfVar#143|) - (RETURN (NREVERSE |bfVar#144|))) - (T (SETQ |bfVar#144| + ((> |i| |bfVar#144|) + (RETURN (NREVERSE |bfVar#145|))) + (T (SETQ |bfVar#145| (CONS (|genGCLnativeTranslation,mkCArgName| |i|) - |bfVar#144|)))) + |bfVar#145|)))) (SETQ |i| (+ |i| 1))))) (SETQ |ccode| - (LET ((|bfVar#140| "") - (|bfVar#142| + (LET ((|bfVar#141| "") + (|bfVar#143| (CONS (|genGCLnativeTranslation,gclTypeInC| |t|) (CONS " " @@ -2475,20 +2475,20 @@ (CONS "(" (APPEND (LET - ((|bfVar#138| NIL) (|x| |s|) + ((|bfVar#139| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND ((OR (ATOM |x|) (ATOM |a|)) (RETURN - (NREVERSE |bfVar#138|))) + (NREVERSE |bfVar#139|))) (T - (SETQ |bfVar#138| + (SETQ |bfVar#139| (CONS (|genGCLnativeTranslation,cparm| |x| |a|) - |bfVar#138|)))) + |bfVar#139|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS ") { " @@ -2501,7 +2501,7 @@ (CONS "(" (APPEND (LET - ((|bfVar#139| NIL) + ((|bfVar#140| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND @@ -2509,27 +2509,27 @@ (ATOM |a|)) (RETURN (NREVERSE - |bfVar#139|))) + |bfVar#140|))) (T - (SETQ |bfVar#139| + (SETQ |bfVar#140| (CONS (|genGCLnativeTranslation,gclArgsInC| |x| |a|) - |bfVar#139|)))) + |bfVar#140|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS "); }" NIL)))))))))))) - (|bfVar#141| NIL)) + (|bfVar#142| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#142|) + ((OR (ATOM |bfVar#143|) (PROGN - (SETQ |bfVar#141| (CAR |bfVar#142|)) + (SETQ |bfVar#142| (CAR |bfVar#143|)) NIL)) - (RETURN |bfVar#140|)) - (T (SETQ |bfVar#140| - (CONCAT |bfVar#140| |bfVar#141|)))) - (SETQ |bfVar#142| (CDR |bfVar#142|))))) + (RETURN |bfVar#141|)) + (T (SETQ |bfVar#141| + (CONCAT |bfVar#141| |bfVar#142|)))) + (SETQ |bfVar#143| (CDR |bfVar#143|))))) (LIST (LIST 'CLINES |ccode|) (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| |cop|))))))))) @@ -2589,17 +2589,17 @@ (PROGN (SETQ |args| NIL) (SETQ |argtypes| NIL) - (LET ((|bfVar#145| |s|) (|x| NIL)) + (LET ((|bfVar#146| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#145|) - (PROGN (SETQ |x| (CAR |bfVar#145|)) NIL)) + ((OR (ATOM |bfVar#146|) + (PROGN (SETQ |x| (CAR |bfVar#146|)) NIL)) (RETURN NIL)) (T (PROGN (SETQ |argtypes| (CONS (|nativeArgumentType| |x|) |argtypes|)) (SETQ |args| (CONS (GENSYM) |args|))))) - (SETQ |bfVar#145| (CDR |bfVar#145|)))) + (SETQ |bfVar#146| (CDR |bfVar#146|)))) (SETQ |args| (REVERSE |args|)) (SETQ |rettype| (|nativeReturnType| |t|)) (LIST (LIST 'DEFUN |op| |args| @@ -2610,39 +2610,39 @@ :ONE-LINER T))))))) (DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|) - (LET ((|bfVar#149| "") - (|bfVar#151| + (LET ((|bfVar#150| "") + (|bfVar#152| (CONS (PNAME |op|) (CONS "(" - (APPEND (LET ((|bfVar#148| NIL) - (|bfVar#146| (- |n| 1)) (|i| 0) - (|bfVar#147| |s|) (|x| NIL)) + (APPEND (LET ((|bfVar#149| NIL) + (|bfVar#147| (- |n| 1)) (|i| 0) + (|bfVar#148| |s|) (|x| NIL)) (LOOP (COND - ((OR (> |i| |bfVar#146|) - (ATOM |bfVar#147|) + ((OR (> |i| |bfVar#147|) + (ATOM |bfVar#148|) (PROGN - (SETQ |x| (CAR |bfVar#147|)) + (SETQ |x| (CAR |bfVar#148|)) NIL)) - (RETURN (NREVERSE |bfVar#148|))) + (RETURN (NREVERSE |bfVar#149|))) (T - (SETQ |bfVar#148| + (SETQ |bfVar#149| (CONS (|genECLnativeTranslation,sharpArg| |i| |x|) - |bfVar#148|)))) + |bfVar#149|)))) (SETQ |i| (+ |i| 1)) - (SETQ |bfVar#147| - (CDR |bfVar#147|)))) + (SETQ |bfVar#148| + (CDR |bfVar#148|)))) (CONS ")" NIL))))) - (|bfVar#150| NIL)) + (|bfVar#151| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#151|) - (PROGN (SETQ |bfVar#150| (CAR |bfVar#151|)) NIL)) - (RETURN |bfVar#149|)) - (T (SETQ |bfVar#149| (CONCAT |bfVar#149| |bfVar#150|)))) - (SETQ |bfVar#151| (CDR |bfVar#151|))))) + ((OR (ATOM |bfVar#152|) + (PROGN (SETQ |bfVar#151| (CAR |bfVar#152|)) NIL)) + (RETURN |bfVar#150|)) + (T (SETQ |bfVar#150| (CONCAT |bfVar#150| |bfVar#151|)))) + (SETQ |bfVar#152| (CDR |bfVar#152|))))) (DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|) (COND @@ -2682,38 +2682,38 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#153| NIL) (|bfVar#152| |s|) (|x| NIL)) + (LET ((|bfVar#154| NIL) (|bfVar#153| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#152|) - (PROGN (SETQ |x| (CAR |bfVar#152|)) NIL)) - (RETURN (NREVERSE |bfVar#153|))) - (T (SETQ |bfVar#153| + ((OR (ATOM |bfVar#153|) + (PROGN (SETQ |x| (CAR |bfVar#153|)) NIL)) + (RETURN (NREVERSE |bfVar#154|))) + (T (SETQ |bfVar#154| (CONS (|nativeArgumentType| |x|) - |bfVar#153|)))) - (SETQ |bfVar#152| (CDR |bfVar#152|))))) + |bfVar#154|)))) + (SETQ |bfVar#153| (CDR |bfVar#153|))))) (SETQ |n| (INTERN (CONCAT (PNAME |op|) "%clisp-hack"))) (SETQ |parms| - (LET ((|bfVar#155| NIL) (|bfVar#154| |s|) (|x| NIL)) + (LET ((|bfVar#156| NIL) (|bfVar#155| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#154|) - (PROGN (SETQ |x| (CAR |bfVar#154|)) NIL)) - (RETURN (NREVERSE |bfVar#155|))) - (T (SETQ |bfVar#155| - (CONS (GENSYM "parm") |bfVar#155|)))) - (SETQ |bfVar#154| (CDR |bfVar#154|))))) + ((OR (ATOM |bfVar#155|) + (PROGN (SETQ |x| (CAR |bfVar#155|)) NIL)) + (RETURN (NREVERSE |bfVar#156|))) + (T (SETQ |bfVar#156| + (CONS (GENSYM "parm") |bfVar#156|)))) + (SETQ |bfVar#155| (CDR |bfVar#155|))))) (SETQ |unstableArgs| NIL) - (LET ((|bfVar#156| |parms|) (|p| NIL) (|bfVar#157| |s|) - (|x| NIL) (|bfVar#158| |argtypes|) (|y| NIL)) + (LET ((|bfVar#157| |parms|) (|p| NIL) (|bfVar#158| |s|) + (|x| NIL) (|bfVar#159| |argtypes|) (|y| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#156|) - (PROGN (SETQ |p| (CAR |bfVar#156|)) NIL) - (ATOM |bfVar#157|) - (PROGN (SETQ |x| (CAR |bfVar#157|)) NIL) + ((OR (ATOM |bfVar#157|) + (PROGN (SETQ |p| (CAR |bfVar#157|)) NIL) (ATOM |bfVar#158|) - (PROGN (SETQ |y| (CAR |bfVar#158|)) NIL)) + (PROGN (SETQ |x| (CAR |bfVar#158|)) NIL) + (ATOM |bfVar#159|) + (PROGN (SETQ |y| (CAR |bfVar#159|)) NIL)) (RETURN NIL)) (T (COND ((|needsStableReference?| |x|) @@ -2721,31 +2721,31 @@ (SETQ |unstableArgs| (CONS (CONS |p| (CONS |x| |y|)) |unstableArgs|))))))) - (SETQ |bfVar#156| (CDR |bfVar#156|)) (SETQ |bfVar#157| (CDR |bfVar#157|)) - (SETQ |bfVar#158| (CDR |bfVar#158|)))) + (SETQ |bfVar#158| (CDR |bfVar#158|)) + (SETQ |bfVar#159| (CDR |bfVar#159|)))) (SETQ |foreignDecl| (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n| (LIST :NAME (PNAME |op'|)) (CONS :ARGUMENTS - (LET ((|bfVar#161| NIL) - (|bfVar#159| |argtypes|) (|x| NIL) - (|bfVar#160| |parms|) (|a| NIL)) + (LET ((|bfVar#162| NIL) + (|bfVar#160| |argtypes|) (|x| NIL) + (|bfVar#161| |parms|) (|a| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#159|) + ((OR (ATOM |bfVar#160|) (PROGN - (SETQ |x| (CAR |bfVar#159|)) + (SETQ |x| (CAR |bfVar#160|)) NIL) - (ATOM |bfVar#160|) + (ATOM |bfVar#161|) (PROGN - (SETQ |a| (CAR |bfVar#160|)) + (SETQ |a| (CAR |bfVar#161|)) NIL)) - (RETURN (NREVERSE |bfVar#161|))) - (T (SETQ |bfVar#161| - (CONS (LIST |a| |x|) |bfVar#161|)))) - (SETQ |bfVar#159| (CDR |bfVar#159|)) - (SETQ |bfVar#160| (CDR |bfVar#160|))))) + (RETURN (NREVERSE |bfVar#162|))) + (T (SETQ |bfVar#162| + (CONS (LIST |a| |x|) |bfVar#162|)))) + (SETQ |bfVar#160| (CDR |bfVar#160|)) + (SETQ |bfVar#161| (CDR |bfVar#161|))))) (LIST :RETURN-TYPE |rettype|) (LIST :LANGUAGE :STDC))) (SETQ |forwardingFun| @@ -2753,66 +2753,66 @@ ((NULL |unstableArgs|) (LIST 'DEFUN |op| |parms| (CONS |n| |parms|))) (T (SETQ |localPairs| - (LET ((|bfVar#164| NIL) - (|bfVar#163| |unstableArgs|) - (|bfVar#162| NIL)) + (LET ((|bfVar#165| NIL) + (|bfVar#164| |unstableArgs|) + (|bfVar#163| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#163|) + ((OR (ATOM |bfVar#164|) (PROGN - (SETQ |bfVar#162| - (CAR |bfVar#163|)) + (SETQ |bfVar#163| + (CAR |bfVar#164|)) NIL)) - (RETURN (NREVERSE |bfVar#164|))) - (T (AND (CONSP |bfVar#162|) + (RETURN (NREVERSE |bfVar#165|))) + (T (AND (CONSP |bfVar#163|) (PROGN - (SETQ |a| (CAR |bfVar#162|)) + (SETQ |a| (CAR |bfVar#163|)) (SETQ |ISTMP#1| - (CDR |bfVar#162|)) + (CDR |bfVar#163|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |x| (CAR |ISTMP#1|)) (SETQ |y| (CDR |ISTMP#1|)) T))) - (SETQ |bfVar#164| + (SETQ |bfVar#165| (CONS (CONS |a| (CONS |x| (CONS |y| (GENSYM "loc")))) - |bfVar#164|))))) - (SETQ |bfVar#163| (CDR |bfVar#163|))))) + |bfVar#165|))))) + (SETQ |bfVar#164| (CDR |bfVar#164|))))) (SETQ |call| (CONS |n| - (LET ((|bfVar#166| NIL) - (|bfVar#165| |parms|) (|p| NIL)) + (LET ((|bfVar#167| NIL) + (|bfVar#166| |parms|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#165|) + ((OR (ATOM |bfVar#166|) (PROGN - (SETQ |p| (CAR |bfVar#165|)) + (SETQ |p| (CAR |bfVar#166|)) NIL)) - (RETURN (NREVERSE |bfVar#166|))) + (RETURN (NREVERSE |bfVar#167|))) (T - (SETQ |bfVar#166| + (SETQ |bfVar#167| (CONS (|genCLISPnativeTranslation,actualArg| |p| |localPairs|) - |bfVar#166|)))) - (SETQ |bfVar#165| (CDR |bfVar#165|)))))) + |bfVar#167|)))) + (SETQ |bfVar#166| (CDR |bfVar#166|)))))) (SETQ |call| (PROGN (SETQ |fixups| - (LET ((|bfVar#168| NIL) - (|bfVar#167| |localPairs|) + (LET ((|bfVar#169| NIL) + (|bfVar#168| |localPairs|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#167|) + ((OR (ATOM |bfVar#168|) (PROGN - (SETQ |p| (CAR |bfVar#167|)) + (SETQ |p| (CAR |bfVar#168|)) NIL)) (RETURN - (NREVERSE |bfVar#168|))) + (NREVERSE |bfVar#169|))) (T (AND (NOT @@ -2820,26 +2820,26 @@ (SETQ |q| (|genCLISPnativeTranslation,copyBack| |p|)))) - (SETQ |bfVar#168| - (CONS |q| |bfVar#168|))))) - (SETQ |bfVar#167| - (CDR |bfVar#167|))))) + (SETQ |bfVar#169| + (CONS |q| |bfVar#169|))))) + (SETQ |bfVar#168| + (CDR |bfVar#168|))))) (COND ((NULL |fixups|) (LIST |call|)) (T (LIST (CONS 'PROG1 (CONS |call| |fixups|))))))) - (LET ((|bfVar#170| |localPairs|) (|bfVar#169| NIL)) + (LET ((|bfVar#171| |localPairs|) (|bfVar#170| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#170|) + ((OR (ATOM |bfVar#171|) (PROGN - (SETQ |bfVar#169| (CAR |bfVar#170|)) + (SETQ |bfVar#170| (CAR |bfVar#171|)) NIL)) (RETURN NIL)) - (T (AND (CONSP |bfVar#169|) + (T (AND (CONSP |bfVar#170|) (PROGN - (SETQ |p| (CAR |bfVar#169|)) - (SETQ |ISTMP#1| (CDR |bfVar#169|)) + (SETQ |p| (CAR |bfVar#170|)) + (SETQ |ISTMP#1| (CDR |bfVar#170|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |x| (CAR |ISTMP#1|)) @@ -2862,18 +2862,18 @@ |p|) |p|) |call|))))))) - (SETQ |bfVar#170| (CDR |bfVar#170|)))) + (SETQ |bfVar#171| (CDR |bfVar#171|)))) (CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))) (SETQ |$foreignsDefsForCLisp| (CONS |foreignDecl| |$foreignsDefsForCLisp|)) (LIST |forwardingFun|))))) -(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#171|) +(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#172|) (PROG (|a| |y| |x| |p|) (RETURN (PROGN - (SETQ |p| (CAR |bfVar#171|)) - (SETQ |x| (CADR . #0=(|bfVar#171|))) + (SETQ |p| (CAR |bfVar#172|)) + (SETQ |x| (CADR . #0=(|bfVar#172|))) (SETQ |y| (CADDR . #0#)) (SETQ |a| (CDDDR . #0#)) (COND @@ -2897,35 +2897,35 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#173| NIL) (|bfVar#172| |s|) (|x| NIL)) + (LET ((|bfVar#174| NIL) (|bfVar#173| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#172|) - (PROGN (SETQ |x| (CAR |bfVar#172|)) NIL)) - (RETURN (NREVERSE |bfVar#173|))) - (T (SETQ |bfVar#173| + ((OR (ATOM |bfVar#173|) + (PROGN (SETQ |x| (CAR |bfVar#173|)) NIL)) + (RETURN (NREVERSE |bfVar#174|))) + (T (SETQ |bfVar#174| (CONS (|nativeArgumentType| |x|) - |bfVar#173|)))) - (SETQ |bfVar#172| (CDR |bfVar#172|))))) + |bfVar#174|)))) + (SETQ |bfVar#173| (CDR |bfVar#173|))))) (SETQ |args| - (LET ((|bfVar#175| NIL) (|bfVar#174| |s|) (|x| NIL)) + (LET ((|bfVar#176| NIL) (|bfVar#175| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#174|) - (PROGN (SETQ |x| (CAR |bfVar#174|)) NIL)) - (RETURN (NREVERSE |bfVar#175|))) - (T (SETQ |bfVar#175| (CONS (GENSYM) |bfVar#175|)))) - (SETQ |bfVar#174| (CDR |bfVar#174|))))) + ((OR (ATOM |bfVar#175|) + (PROGN (SETQ |x| (CAR |bfVar#175|)) NIL)) + (RETURN (NREVERSE |bfVar#176|))) + (T (SETQ |bfVar#176| (CONS (GENSYM) |bfVar#176|)))) + (SETQ |bfVar#175| (CDR |bfVar#175|))))) (SETQ |unstableArgs| NIL) (SETQ |newArgs| NIL) - (LET ((|bfVar#176| |args|) (|a| NIL) (|bfVar#177| |s|) + (LET ((|bfVar#177| |args|) (|a| NIL) (|bfVar#178| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#176|) - (PROGN (SETQ |a| (CAR |bfVar#176|)) NIL) - (ATOM |bfVar#177|) - (PROGN (SETQ |x| (CAR |bfVar#177|)) NIL)) + ((OR (ATOM |bfVar#177|) + (PROGN (SETQ |a| (CAR |bfVar#177|)) NIL) + (ATOM |bfVar#178|) + (PROGN (SETQ |x| (CAR |bfVar#178|)) NIL)) (RETURN NIL)) (T (PROGN (SETQ |newArgs| @@ -2934,8 +2934,8 @@ (COND ((|needsStableReference?| |x|) (SETQ |unstableArgs| (CONS |a| |unstableArgs|))))))) - (SETQ |bfVar#176| (CDR |bfVar#176|)) - (SETQ |bfVar#177| (CDR |bfVar#177|)))) + (SETQ |bfVar#177| (CDR |bfVar#177|)) + (SETQ |bfVar#178| (CDR |bfVar#178|)))) (SETQ |op'| (COND ((|%hasFeature| :WIN32) (CONCAT "_" (PNAME |op'|))) @@ -2972,36 +2972,36 @@ (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| - (LET ((|bfVar#179| NIL) (|bfVar#178| |s|) (|x| NIL)) + (LET ((|bfVar#180| NIL) (|bfVar#179| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#178|) - (PROGN (SETQ |x| (CAR |bfVar#178|)) NIL)) - (RETURN (NREVERSE |bfVar#179|))) - (T (SETQ |bfVar#179| + ((OR (ATOM |bfVar#179|) + (PROGN (SETQ |x| (CAR |bfVar#179|)) NIL)) + (RETURN (NREVERSE |bfVar#180|))) + (T (SETQ |bfVar#180| (CONS (|nativeArgumentType| |x|) - |bfVar#179|)))) - (SETQ |bfVar#178| (CDR |bfVar#178|))))) + |bfVar#180|)))) + (SETQ |bfVar#179| (CDR |bfVar#179|))))) (SETQ |parms| - (LET ((|bfVar#181| NIL) (|bfVar#180| |s|) (|x| NIL)) + (LET ((|bfVar#182| NIL) (|bfVar#181| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#180|) - (PROGN (SETQ |x| (CAR |bfVar#180|)) NIL)) - (RETURN (NREVERSE |bfVar#181|))) - (T (SETQ |bfVar#181| - (CONS (GENSYM "parm") |bfVar#181|)))) - (SETQ |bfVar#180| (CDR |bfVar#180|))))) + ((OR (ATOM |bfVar#181|) + (PROGN (SETQ |x| (CAR |bfVar#181|)) NIL)) + (RETURN (NREVERSE |bfVar#182|))) + (T (SETQ |bfVar#182| + (CONS (GENSYM "parm") |bfVar#182|)))) + (SETQ |bfVar#181| (CDR |bfVar#181|))))) (SETQ |strPairs| NIL) (SETQ |aryPairs| NIL) - (LET ((|bfVar#182| |parms|) (|p| NIL) (|bfVar#183| |s|) + (LET ((|bfVar#183| |parms|) (|p| NIL) (|bfVar#184| |s|) (|x| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#182|) - (PROGN (SETQ |p| (CAR |bfVar#182|)) NIL) - (ATOM |bfVar#183|) - (PROGN (SETQ |x| (CAR |bfVar#183|)) NIL)) + ((OR (ATOM |bfVar#183|) + (PROGN (SETQ |p| (CAR |bfVar#183|)) NIL) + (ATOM |bfVar#184|) + (PROGN (SETQ |x| (CAR |bfVar#184|)) NIL)) (RETURN NIL)) (T (COND ((EQ |x| '|string|) @@ -3023,33 +3023,33 @@ (NULL (CDR |ISTMP#3|))))))))) (SETQ |aryPairs| (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))))) - (SETQ |bfVar#182| (CDR |bfVar#182|)) - (SETQ |bfVar#183| (CDR |bfVar#183|)))) + (SETQ |bfVar#183| (CDR |bfVar#183|)) + (SETQ |bfVar#184| (CDR |bfVar#184|)))) (COND ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT '_ |op'|)))) (SETQ |call| (CONS (|bfColonColon| 'CCL 'EXTERNAL-CALL) (CONS (STRING |op'|) - (APPEND (LET ((|bfVar#186| NIL) - (|bfVar#184| |argtypes|) - (|x| NIL) (|bfVar#185| |parms|) + (APPEND (LET ((|bfVar#187| NIL) + (|bfVar#185| |argtypes|) + (|x| NIL) (|bfVar#186| |parms|) (|p| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#184|) + ((OR (ATOM |bfVar#185|) (PROGN (SETQ |x| - (CAR |bfVar#184|)) + (CAR |bfVar#185|)) NIL) - (ATOM |bfVar#185|) + (ATOM |bfVar#186|) (PROGN (SETQ |p| - (CAR |bfVar#185|)) + (CAR |bfVar#186|)) NIL)) (RETURN - (NREVERSE |bfVar#186|))) + (NREVERSE |bfVar#187|))) (T - (SETQ |bfVar#186| + (SETQ |bfVar#187| (APPEND (REVERSE (LIST |x| @@ -3061,45 +3061,45 @@ (ASSOC |p| |aryPairs|)) (CDR |p'|)) (T |p|)))) - |bfVar#186|)))) - (SETQ |bfVar#184| - (CDR |bfVar#184|)) + |bfVar#187|)))) (SETQ |bfVar#185| - (CDR |bfVar#185|)))) + (CDR |bfVar#185|)) + (SETQ |bfVar#186| + (CDR |bfVar#186|)))) (CONS |rettype| NIL))))) (COND ((EQ |t| '|string|) (SETQ |call| (LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|)))) - (LET ((|bfVar#187| |aryPairs|) (|arg| NIL)) + (LET ((|bfVar#188| |aryPairs|) (|arg| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#187|) - (PROGN (SETQ |arg| (CAR |bfVar#187|)) NIL)) + ((OR (ATOM |bfVar#188|) + (PROGN (SETQ |arg| (CAR |bfVar#188|)) NIL)) (RETURN NIL)) (T (SETQ |call| (LIST (|bfColonColon| 'CCL 'WITH-POINTER-TO-IVECTOR) (LIST (CDR |arg|) (CAR |arg|)) |call|)))) - (SETQ |bfVar#187| (CDR |bfVar#187|)))) + (SETQ |bfVar#188| (CDR |bfVar#188|)))) (COND (|strPairs| (SETQ |call| (LIST (|bfColonColon| 'CCL 'WITH-CSTRS) - (LET ((|bfVar#189| NIL) - (|bfVar#188| |strPairs|) (|arg| NIL)) + (LET ((|bfVar#190| NIL) + (|bfVar#189| |strPairs|) (|arg| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#188|) + ((OR (ATOM |bfVar#189|) (PROGN - (SETQ |arg| (CAR |bfVar#188|)) + (SETQ |arg| (CAR |bfVar#189|)) NIL)) - (RETURN (NREVERSE |bfVar#189|))) - (T (SETQ |bfVar#189| + (RETURN (NREVERSE |bfVar#190|))) + (T (SETQ |bfVar#190| (CONS (LIST (CDR |arg|) (CAR |arg|)) - |bfVar#189|)))) - (SETQ |bfVar#188| (CDR |bfVar#188|)))) + |bfVar#190|)))) + (SETQ |bfVar#189| (CDR |bfVar#189|)))) |call|)))) (LIST (LIST 'DEFUN |op| |parms| |call|)))))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 7b978080..89cb3dee 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -461,19 +461,26 @@ (DEFUN |bpExportItemList| () (|bpListAndRecover| #'|bpExportItem|)) -(DEFUN |bpExports| () (|bpPileBracketed| #'|bpExportItemList|)) +(DEFUN |bpModuleInterface| () + (COND + ((|bpEqKey| 'WHERE) + (OR (|bpPileBracketed| #'|bpExportItemList|) + (AND (|bpExportItem|) (|bpPush| (LIST (|bpPop1|)))) + (|bpTrap|))) + (T (|bpPush| NIL)))) + +(DEFUN |bpModuleExports| () + (COND + ((|bpParenthesized| #'|bpIdList|) + (|bpPush| (|bfUntuple| (|bpPop1|)))) + (T (|bpPush| NIL)))) (DEFUN |bpModule| () (COND - ((|bpEqKey| 'MODULE) - (IDENTITY - (PROGN - (OR (|bpName|) (|bpTrap|)) - (COND - ((|bpEqKey| 'WHERE) - (AND (|bpExports|) - (|bpPush| (|%Module| (|bpPop2|) (|bpPop1|))))) - (T (|bpPush| (|%Module| (|bpPop1|) NIL))))))))) + ((|bpEqKey| 'MODULE) (OR (|bpName|) (|bpTrap|)) (|bpModuleExports|) + (|bpModuleInterface|) + (|bpPush| (|%Module| (|bpPop3|) (|bpPop2|) (|bpPop1|)))) + (T NIL))) (DEFUN |bpImport| () (PROG (|a|) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 0968b9ea..0a0c8ee2 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -581,6 +581,9 @@ (|$InteractiveMode| |expr'|) (T (|shoeEVALANDFILEACTQ| |expr'|))))))) +(DEFUN |exportNames| (|ns|) + (COND ((NULL |ns|) NIL) (T (LIST (CONS 'EXPORT |ns|))))) + (DEFUN |translateToplevel| (|b| |export?|) (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |xs|) (DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode| @@ -600,25 +603,34 @@ (|body| (CADDDR |b|))) (CDR (|bfDef| |op| |args| |body|)))) (|%Module| - (LET ((|m| (CADR |b|)) (|ds| (CADDR |b|))) + (LET ((|m| (CADR |b|)) (|ns| (CADDR |b|)) + (|ds| (CADDDR |b|))) (PROGN (SETQ |$currentModuleName| |m|) (SETQ |$foreignsDefsForCLisp| NIL) (CONS (LIST 'PROVIDE (SYMBOL-NAME |m|)) - (LET ((|bfVar#11| NIL) (|bfVar#10| |ds|) - (|d| NIL)) - (LOOP - (COND - ((OR (ATOM |bfVar#10|) - (PROGN - (SETQ |d| (CAR |bfVar#10|)) - NIL)) - (RETURN (NREVERSE |bfVar#11|))) - (T (SETQ |bfVar#11| - (CONS - (CAR (|translateToplevel| |d| T)) - |bfVar#11|)))) - (SETQ |bfVar#10| (CDR |bfVar#10|)))))))) + (APPEND (|exportNames| |ns|) + (LET + ((|bfVar#11| NIL) (|bfVar#10| |ds|) + (|d| NIL)) + (LOOP + (COND + ((OR (ATOM |bfVar#10|) + (PROGN + (SETQ |d| + (CAR |bfVar#10|)) + NIL)) + (RETURN + (NREVERSE |bfVar#11|))) + (T + (SETQ |bfVar#11| + (CONS + (CAR + (|translateToplevel| |d| + T)) + |bfVar#11|)))) + (SETQ |bfVar#10| + (CDR |bfVar#10|))))))))) (|%Import| (LET ((|m| (CADR |b|))) (PROGN diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 4b803b0c..fb0d750f 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -403,6 +403,10 @@ translateToplevelExpression expr == $InteractiveMode => expr' shoeEVALANDFILEACTQ expr' +exportNames ns == + ns = nil => nil + [["EXPORT",:ns]] + translateToplevel(b,export?) == atom b => [b] -- generally happens in interactive mode. b is ["TUPLE",:xs] => coreError '"invalid AST" @@ -410,10 +414,10 @@ translateToplevel(b,export?) == %Signature(op,t) => [genDeclaration(op,t)] %Definition(op,args,body) => rest bfDef(op,args,body) - %Module(m,ds) => + %Module(m,ns,ds) => $currentModuleName := m $foreignsDefsForCLisp := nil - [["PROVIDE", symbolName m], + [["PROVIDE", symbolName m], :exportNames ns, :[first translateToplevel(d,true) for d in ds]] %Import(m) => |