From 441c2259ea4bdda1c2a0a4091a55955536998270 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Fri, 30 Sep 2011 04:20:34 +0000 Subject: * boot/ast.boot (bfFor): Tidy. Handle hashtable iterator forms. (bfIterateTable): New. (separateIterators): Likewise. (bfExpandTableIters): Likewise. (bfLp1): Use them. --- src/boot/strap/ast.clisp | 5303 ++++++++++++++++++++++------------------------ 1 file changed, 2577 insertions(+), 2726 deletions(-) (limited to 'src/boot/strap/ast.clisp') diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index a5faf9a0..71922a32 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -11,139 +11,125 @@ (DEFPARAMETER |$activeNamespace| NIL) -(DEFUN |%Command| #0=(|bfVar#1|) (CONS '|%Command| (LIST . #0#))) +(DEFUN |%Command| #1=(|bfVar#1|) (CONS '|%Command| (LIST . #1#))) -(DEFUN |%Lisp| #0=(|bfVar#2|) (CONS '|%Lisp| (LIST . #0#))) +(DEFUN |%Lisp| #1=(|bfVar#2|) (CONS '|%Lisp| (LIST . #1#))) -(DEFUN |%Module| #0=(|bfVar#3| |bfVar#4| |bfVar#5|) - (CONS '|%Module| (LIST . #0#))) +(DEFUN |%Module| #1=(|bfVar#3| |bfVar#4| |bfVar#5|) + (CONS '|%Module| (LIST . #1#))) -(DEFUN |%Namespace| #0=(|bfVar#6|) (CONS '|%Namespace| (LIST . #0#))) +(DEFUN |%Namespace| #1=(|bfVar#6|) (CONS '|%Namespace| (LIST . #1#))) -(DEFUN |%Import| #0=(|bfVar#7|) (CONS '|%Import| (LIST . #0#))) +(DEFUN |%Import| #1=(|bfVar#7|) (CONS '|%Import| (LIST . #1#))) -(DEFUN |%ImportSignature| #0=(|bfVar#8| |bfVar#9|) - (CONS '|%ImportSignature| (LIST . #0#))) +(DEFUN |%ImportSignature| #1=(|bfVar#8| |bfVar#9|) + (CONS '|%ImportSignature| (LIST . #1#))) -(DEFUN |%TypeAlias| #0=(|bfVar#10| |bfVar#11|) - (CONS '|%TypeAlias| (LIST . #0#))) +(DEFUN |%TypeAlias| #1=(|bfVar#10| |bfVar#11|) + (CONS '|%TypeAlias| (LIST . #1#))) -(DEFUN |%Signature| #0=(|bfVar#12| |bfVar#13|) - (CONS '|%Signature| (LIST . #0#))) +(DEFUN |%Signature| #1=(|bfVar#12| |bfVar#13|) + (CONS '|%Signature| (LIST . #1#))) -(DEFUN |%Mapping| #0=(|bfVar#14| |bfVar#15|) - (CONS '|%Mapping| (LIST . #0#))) +(DEFUN |%Mapping| #1=(|bfVar#14| |bfVar#15|) (CONS '|%Mapping| (LIST . #1#))) -(DEFUN |%Forall| #0=(|bfVar#16| |bfVar#17|) - (CONS '|%Forall| (LIST . #0#))) +(DEFUN |%Forall| #1=(|bfVar#16| |bfVar#17|) (CONS '|%Forall| (LIST . #1#))) -(DEFUN |%SuffixDot| #0=(|bfVar#18|) (CONS '|%SuffixDot| (LIST . #0#))) +(DEFUN |%SuffixDot| #1=(|bfVar#18|) (CONS '|%SuffixDot| (LIST . #1#))) -(DEFUN |%Quote| #0=(|bfVar#19|) (CONS '|%Quote| (LIST . #0#))) +(DEFUN |%Quote| #1=(|bfVar#19|) (CONS '|%Quote| (LIST . #1#))) -(DEFUN |%EqualPattern| #0=(|bfVar#20|) - (CONS '|%EqualPattern| (LIST . #0#))) +(DEFUN |%EqualPattern| #1=(|bfVar#20|) (CONS '|%EqualPattern| (LIST . #1#))) -(DEFUN |%Colon| #0=(|bfVar#21|) (CONS '|%Colon| (LIST . #0#))) +(DEFUN |%Colon| #1=(|bfVar#21|) (CONS '|%Colon| (LIST . #1#))) -(DEFUN |%QualifiedName| #0=(|bfVar#22| |bfVar#23|) - (CONS '|%QualifiedName| (LIST . #0#))) +(DEFUN |%QualifiedName| #1=(|bfVar#22| |bfVar#23|) + (CONS '|%QualifiedName| (LIST . #1#))) -(DEFUN |%DefaultValue| #0=(|bfVar#24| |bfVar#25|) - (CONS '|%DefaultValue| (LIST . #0#))) +(DEFUN |%DefaultValue| #1=(|bfVar#24| |bfVar#25|) + (CONS '|%DefaultValue| (LIST . #1#))) -(DEFUN |%Bracket| #0=(|bfVar#26|) (CONS '|%Bracket| (LIST . #0#))) +(DEFUN |%Bracket| #1=(|bfVar#26|) (CONS '|%Bracket| (LIST . #1#))) -(DEFUN |%UnboundedSegment| #0=(|bfVar#27|) - (CONS '|%UnboundedSegment| (LIST . #0#))) +(DEFUN |%UnboundedSegment| #1=(|bfVar#27|) + (CONS '|%UnboundedSegment| (LIST . #1#))) -(DEFUN |%BoundedSgement| #0=(|bfVar#28| |bfVar#29|) - (CONS '|%BoundedSgement| (LIST . #0#))) +(DEFUN |%BoundedSgement| #1=(|bfVar#28| |bfVar#29|) + (CONS '|%BoundedSgement| (LIST . #1#))) -(DEFUN |%Tuple| #0=(|bfVar#30|) (CONS '|%Tuple| (LIST . #0#))) +(DEFUN |%Tuple| #1=(|bfVar#30|) (CONS '|%Tuple| (LIST . #1#))) -(DEFUN |%ColonAppend| #0=(|bfVar#31| |bfVar#32|) - (CONS '|%ColonAppend| (LIST . #0#))) +(DEFUN |%ColonAppend| #1=(|bfVar#31| |bfVar#32|) + (CONS '|%ColonAppend| (LIST . #1#))) -(DEFUN |%Pretend| #0=(|bfVar#33| |bfVar#34|) - (CONS '|%Pretend| (LIST . #0#))) +(DEFUN |%Pretend| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Pretend| (LIST . #1#))) -(DEFUN |%Is| #0=(|bfVar#35| |bfVar#36|) (CONS '|%Is| (LIST . #0#))) +(DEFUN |%Is| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Is| (LIST . #1#))) -(DEFUN |%Isnt| #0=(|bfVar#37| |bfVar#38|) - (CONS '|%Isnt| (LIST . #0#))) +(DEFUN |%Isnt| #1=(|bfVar#37| |bfVar#38|) (CONS '|%Isnt| (LIST . #1#))) -(DEFUN |%Reduce| #0=(|bfVar#39| |bfVar#40|) - (CONS '|%Reduce| (LIST . #0#))) +(DEFUN |%Reduce| #1=(|bfVar#39| |bfVar#40|) (CONS '|%Reduce| (LIST . #1#))) -(DEFUN |%PrefixExpr| #0=(|bfVar#41| |bfVar#42|) - (CONS '|%PrefixExpr| (LIST . #0#))) +(DEFUN |%PrefixExpr| #1=(|bfVar#41| |bfVar#42|) + (CONS '|%PrefixExpr| (LIST . #1#))) -(DEFUN |%Call| #0=(|bfVar#43| |bfVar#44|) - (CONS '|%Call| (LIST . #0#))) +(DEFUN |%Call| #1=(|bfVar#43| |bfVar#44|) (CONS '|%Call| (LIST . #1#))) -(DEFUN |%InfixExpr| #0=(|bfVar#45| |bfVar#46| |bfVar#47|) - (CONS '|%InfixExpr| (LIST . #0#))) +(DEFUN |%InfixExpr| #1=(|bfVar#45| |bfVar#46| |bfVar#47|) + (CONS '|%InfixExpr| (LIST . #1#))) -(DEFUN |%ConstantDefinition| #0=(|bfVar#48| |bfVar#49|) - (CONS '|%ConstantDefinition| (LIST . #0#))) +(DEFUN |%ConstantDefinition| #1=(|bfVar#48| |bfVar#49|) + (CONS '|%ConstantDefinition| (LIST . #1#))) -(DEFUN |%Definition| #0=(|bfVar#50| |bfVar#51| |bfVar#52|) - (CONS '|%Definition| (LIST . #0#))) +(DEFUN |%Definition| #1=(|bfVar#50| |bfVar#51| |bfVar#52|) + (CONS '|%Definition| (LIST . #1#))) -(DEFUN |%Macro| #0=(|bfVar#53| |bfVar#54| |bfVar#55|) - (CONS '|%Macro| (LIST . #0#))) +(DEFUN |%Macro| #1=(|bfVar#53| |bfVar#54| |bfVar#55|) + (CONS '|%Macro| (LIST . #1#))) -(DEFUN |%Lambda| #0=(|bfVar#56| |bfVar#57|) - (CONS '|%Lambda| (LIST . #0#))) +(DEFUN |%Lambda| #1=(|bfVar#56| |bfVar#57|) (CONS '|%Lambda| (LIST . #1#))) -(DEFUN |%SuchThat| #0=(|bfVar#58|) (CONS '|%SuchThat| (LIST . #0#))) +(DEFUN |%SuchThat| #1=(|bfVar#58|) (CONS '|%SuchThat| (LIST . #1#))) -(DEFUN |%Assignment| #0=(|bfVar#59| |bfVar#60|) - (CONS '|%Assignment| (LIST . #0#))) +(DEFUN |%Assignment| #1=(|bfVar#59| |bfVar#60|) + (CONS '|%Assignment| (LIST . #1#))) -(DEFUN |%While| #0=(|bfVar#61|) (CONS '|%While| (LIST . #0#))) +(DEFUN |%While| #1=(|bfVar#61|) (CONS '|%While| (LIST . #1#))) -(DEFUN |%Until| #0=(|bfVar#62|) (CONS '|%Until| (LIST . #0#))) +(DEFUN |%Until| #1=(|bfVar#62|) (CONS '|%Until| (LIST . #1#))) -(DEFUN |%For| #0=(|bfVar#63| |bfVar#64| |bfVar#65|) - (CONS '|%For| (LIST . #0#))) +(DEFUN |%For| #1=(|bfVar#63| |bfVar#64| |bfVar#65|) (CONS '|%For| (LIST . #1#))) -(DEFUN |%Implies| #0=(|bfVar#66| |bfVar#67|) - (CONS '|%Implies| (LIST . #0#))) +(DEFUN |%Implies| #1=(|bfVar#66| |bfVar#67|) (CONS '|%Implies| (LIST . #1#))) -(DEFUN |%Iterators| #0=(|bfVar#68|) (CONS '|%Iterators| (LIST . #0#))) +(DEFUN |%Iterators| #1=(|bfVar#68|) (CONS '|%Iterators| (LIST . #1#))) -(DEFUN |%Cross| #0=(|bfVar#69|) (CONS '|%Cross| (LIST . #0#))) +(DEFUN |%Cross| #1=(|bfVar#69|) (CONS '|%Cross| (LIST . #1#))) -(DEFUN |%Repeat| #0=(|bfVar#70| |bfVar#71|) - (CONS '|%Repeat| (LIST . #0#))) +(DEFUN |%Repeat| #1=(|bfVar#70| |bfVar#71|) (CONS '|%Repeat| (LIST . #1#))) -(DEFUN |%Pile| #0=(|bfVar#72|) (CONS '|%Pile| (LIST . #0#))) +(DEFUN |%Pile| #1=(|bfVar#72|) (CONS '|%Pile| (LIST . #1#))) -(DEFUN |%Append| #0=(|bfVar#73|) (CONS '|%Append| (LIST . #0#))) +(DEFUN |%Append| #1=(|bfVar#73|) (CONS '|%Append| (LIST . #1#))) -(DEFUN |%Case| #0=(|bfVar#74| |bfVar#75|) - (CONS '|%Case| (LIST . #0#))) +(DEFUN |%Case| #1=(|bfVar#74| |bfVar#75|) (CONS '|%Case| (LIST . #1#))) -(DEFUN |%Return| #0=(|bfVar#76|) (CONS '|%Return| (LIST . #0#))) +(DEFUN |%Return| #1=(|bfVar#76|) (CONS '|%Return| (LIST . #1#))) -(DEFUN |%Leave| #0=(|bfVar#77|) (CONS '|%Leave| (LIST . #0#))) +(DEFUN |%Leave| #1=(|bfVar#77|) (CONS '|%Leave| (LIST . #1#))) -(DEFUN |%Throw| #0=(|bfVar#78|) (CONS '|%Throw| (LIST . #0#))) +(DEFUN |%Throw| #1=(|bfVar#78|) (CONS '|%Throw| (LIST . #1#))) -(DEFUN |%Catch| #0=(|bfVar#79| |bfVar#80|) - (CONS '|%Catch| (LIST . #0#))) +(DEFUN |%Catch| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Catch| (LIST . #1#))) -(DEFUN |%Finally| #0=(|bfVar#81|) (CONS '|%Finally| (LIST . #0#))) +(DEFUN |%Finally| #1=(|bfVar#81|) (CONS '|%Finally| (LIST . #1#))) -(DEFUN |%Try| #0=(|bfVar#82| |bfVar#83|) (CONS '|%Try| (LIST . #0#))) +(DEFUN |%Try| #1=(|bfVar#82| |bfVar#83|) (CONS '|%Try| (LIST . #1#))) -(DEFUN |%Where| #0=(|bfVar#84| |bfVar#85|) - (CONS '|%Where| (LIST . #0#))) +(DEFUN |%Where| #1=(|bfVar#84| |bfVar#85|) (CONS '|%Where| (LIST . #1#))) -(DEFUN |%Structure| #0=(|bfVar#86| |bfVar#87|) - (CONS '|%Structure| (LIST . #0#))) +(DEFUN |%Structure| #1=(|bfVar#86| |bfVar#87|) + (CONS '|%Structure| (LIST . #1#))) (DEFPARAMETER |$inDefIS| NIL) @@ -154,38 +140,36 @@ (DEFUN |bfGenSymbol| () (DECLARE (SPECIAL |$GenVarCounter|)) (PROGN - (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1)) - (INTERN (CONCAT "bfVar#" (WRITE-TO-STRING |$GenVarCounter|))))) + (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1)) + (INTERN (CONCAT "bfVar#" (WRITE-TO-STRING |$GenVarCounter|))))) (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfLetVar|)) (DEFUN |bfLetVar| () (DECLARE (SPECIAL |$letGenVarCounter|)) (PROGN - (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1)) - (INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING |$letGenVarCounter|))))) + (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1)) + (INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING |$letGenVarCounter|))))) (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfIsVar|)) (DEFUN |bfIsVar| () (DECLARE (SPECIAL |$isGenVarCounter|)) (PROGN - (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1)) - (INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING |$isGenVarCounter|))))) + (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1)) + (INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING |$isGenVarCounter|))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfColon|)) (DEFUN |bfColon| (|x|) (LIST 'COLON |x|)) -(DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Symbol|) |%Symbol|) - |bfColonColon|)) +(DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Symbol|) |%Symbol|) |bfColonColon|)) (DEFUN |bfColonColon| (|package| |name|) (COND - ((AND (|%hasFeature| :CLISP) - (|symbolMember?| |package| '(EXT FFI))) - (FIND-SYMBOL (SYMBOL-NAME |name|) |package|)) - (T (INTERN (SYMBOL-NAME |name|) |package|)))) + ((AND (|%hasFeature| :CLISP) (|symbolMember?| |package| '(EXT FFI))) + (FIND-SYMBOL (SYMBOL-NAME |name|) |package|)) + (T (INTERN (SYMBOL-NAME |name|) |package|)))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|)) @@ -207,70 +191,60 @@ (DEFUN |bfBracket| (|part|) |part|) -(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|)) (|%List| |%Form|)) - |bfPile|)) +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|)) (|%List| |%Form|)) |bfPile|)) (DEFUN |bfPile| (|part|) |part|) (DEFUN |bfDo| (|x|) |x|) -(DEFUN |bfAtScope| (|s| |x|) - (LIST 'LET (LIST (LIST '*PACKAGE* |s|)) |x|)) +(DEFUN |bfAtScope| (|s| |x|) (LIST 'LET (LIST (LIST '*PACKAGE* |s|)) |x|)) -(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Form|))) - (|%List| |%Form|)) - |bfAppend|)) +(DECLAIM + (FTYPE (FUNCTION ((|%List| (|%List| |%Form|))) (|%List| |%Form|)) |bfAppend|)) (DEFUN |bfAppend| (|ls|) (PROG (|p| |r| |l|) (RETURN - (COND - ((NOT (AND (CONSP |ls|) - (PROGN - (SETQ |l| (CAR |ls|)) - (SETQ |ls| (CDR |ls|)) - T))) - NIL) - (T (SETQ |r| (|copyList| |l|)) (SETQ |p| |r|) - (LOOP - (COND - ((NOT (AND (CONSP |ls|) - (PROGN - (SETQ |l| (CAR |ls|)) - (SETQ |ls| (CDR |ls|)) - T))) - (RETURN |r|)) - ((NULL |l|) NIL) - (T (RPLACD (|lastNode| |p|) (|copyList| |l|)) - (SETQ |p| (CDR |p|)))))))))) + (COND + ((NOT + (AND (CONSP |ls|) + (PROGN (SETQ |l| (CAR |ls|)) (SETQ |ls| (CDR |ls|)) T))) + NIL) + (T (SETQ |r| (|copyList| |l|)) (SETQ |p| |r|) + (LOOP + (COND + ((NOT + (AND (CONSP |ls|) + (PROGN (SETQ |l| (CAR |ls|)) (SETQ |ls| (CDR |ls|)) T))) + (RETURN |r|)) + ((NULL |l|) NIL) + (T (RPLACD (|lastNode| |p|) (|copyList| |l|)) + (SETQ |p| (CDR |p|)))))))))) -(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|) |%Form|) |%Form|) - |bfColonAppend|)) +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|) |%Form|) |%Form|) |bfColonAppend|)) (DEFUN |bfColonAppend| (|x| |y|) (PROG (|a|) (RETURN - (COND - ((NULL |x|) - (COND - ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)) - (SETQ |a| (CDR |y|)) (LIST '&REST (CONS 'QUOTE |a|))) - (T (LIST '&REST |y|)))) - (T (CONS (CAR |x|) (|bfColonAppend| (CDR |x|) |y|))))))) + (COND + ((NULL |x|) + (COND + ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)) (SETQ |a| (CDR |y|)) + (LIST '&REST (CONS 'QUOTE |a|))) + (T (LIST '&REST |y|)))) + (T (CONS (CAR |x|) (|bfColonAppend| (CDR |x|) |y|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) -(DEFUN |bfBeginsDollar| (|x|) - (CHAR= (SCHAR (SYMBOL-NAME |x|) 0) (|char| '$))) +(DEFUN |bfBeginsDollar| (|x|) (CHAR= (SCHAR (SYMBOL-NAME |x|) 0) (|char| '$))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) (DEFUN |compFluidize| (|x|) - (COND - ((NULL |x|) NIL) - ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|)) - ((|atomic?| |x|) |x|) - (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|)))))) + (COND ((NULL |x|) NIL) + ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|)) + ((|atomic?| |x|) |x|) + (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|)))))) (DEFUN |bfPlace| (|x|) (CONS '|%Place| |x|)) @@ -278,179 +252,167 @@ (DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE))) -(DEFUN |bfUntuple| (|bf|) - (COND ((|bfTupleP| |bf|) (CDR |bf|)) (T |bf|))) +(DEFUN |bfUntuple| (|bf|) (COND ((|bfTupleP| |bf|) (CDR |bf|)) (T |bf|))) -(DEFUN |bfTupleIf| (|x|) - (COND ((|bfTupleP| |x|) |x|) (T (|bfTuple| |x|)))) +(DEFUN |bfTupleIf| (|x|) (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#2| NIL) (|bfVar#1| |a|) (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| - (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (NULL (CDR |ISTMP#1|)))))) - (COND (|bfVar#2| (RETURN |bfVar#2|))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - (|bfMakeCons| |a|)) - (T (CONS 'LIST |a|))))))) + (PROGN + (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) (T (LIST |b|)))) + (COND + ((LET ((|bfVar#2| NIL) (|bfVar#1| |a|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T + (SETQ |bfVar#2| + (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))) + (COND (|bfVar#2| (RETURN |bfVar#2|))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (|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|))))) + (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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |a| (CAR |ISTMP#2|)) T)))))) - (SETQ |l1| (CDR |l|)) - (COND - (|l1| (LIST '|append| |a| (|bfMakeCons| |l1|))) - (T |a|))) - (T (LIST 'CONS (CAR |l|) (|bfMakeCons| (CDR |l|)))))))) - -(DEFUN |bfFor| (|bflhs| U |step|) + (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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |a| (CAR |ISTMP#2|)) T)))))) + (SETQ |l1| (CDR |l|)) + (COND (|l1| (LIST '|append| |a| (|bfMakeCons| |l1|))) (T |a|))) + (T (LIST 'CONS (CAR |l|) (|bfMakeCons| (CDR |l|)))))))) + +(DEFUN |bfFor| (|lhs| |u| |step|) (COND - ((AND (CONSP U) (EQ (CAR U) '|tails|)) - (|bfForTree| 'ON |bflhs| (CADR U))) - ((AND (CONSP U) (EQ (CAR U) 'SEGMENT)) - (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U))) - (T (|bfForTree| 'IN |bflhs| U)))) + ((AND (CONSP |u|) (EQ (CAR |u|) '|tails|)) + (|bfForTree| 'ON |lhs| (CADR |u|))) + ((AND (CONSP |u|) (EQ (CAR |u|) 'SEGMENT)) + (|bfSTEP| |lhs| (CADR |u|) |step| (CADDR |u|))) + ((AND (CONSP |u|) (EQ (CAR |u|) '|entries|)) + (|bfIterateTable| |lhs| (CADR |u|))) + (T (|bfForTree| 'IN |lhs| |u|)))) (DEFUN |bfForTree| (OP |lhs| |whole|) (PROG (G) (RETURN - (PROGN - (SETQ |whole| - (COND - ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|))) - (T |whole|))) - (COND - ((NOT (CONSP |lhs|)) (|bfINON| (LIST OP |lhs| |whole|))) - (T (SETQ |lhs| - (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (T |lhs|))) + (PROGN + (SETQ |whole| + (COND ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|))) + (T |whole|))) + (COND ((NOT (CONSP |lhs|)) (|bfINON| (LIST OP |lhs| |whole|))) + (T (SETQ |lhs| (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (T |lhs|))) (COND - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T)) - (SETQ G (CADR |lhs|)) - (|append| (|bfINON| (LIST OP G |whole|)) - (|bfSuchthat| (|bfIS| G (CADDR |lhs|))))) - (T (SETQ G (|bfGenSymbol|)) - (|append| (|bfINON| (LIST OP G |whole|)) - (|bfSuchthat| (|bfIS| G |lhs|))))))))))) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T)) (SETQ G (CADR |lhs|)) + (|append| (|bfINON| (LIST OP G |whole|)) + (|bfSuchthat| (|bfIS| G (CADDR |lhs|))))) + (T (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 - (COND ((EQ |id| 'DOT) (SETQ |id| (|bfGenSymbol|)))) - (SETQ |initvar| (LIST |id|)) - (SETQ |initval| (LIST |fst|)) - (SETQ |inc| - (COND - ((NOT (CONSP |step|)) |step|) - (T (SETQ |g1| (|bfGenSymbol|)) - (SETQ |initvar| (CONS |g1| |initvar|)) - (SETQ |initval| (CONS |step| |initval|)) |g1|))) - (SETQ |final| - (COND - ((NOT (CONSP |lst|)) |lst|) - (T (SETQ |g2| (|bfGenSymbol|)) - (SETQ |initvar| (CONS |g2| |initvar|)) - (SETQ |initval| (CONS |lst| |initval|)) |g2|))) - (SETQ |ex| - (COND - ((NULL |lst|) NIL) - ((INTEGERP |inc|) - (SETQ |pred| (COND ((MINUSP |inc|) '<) (T '>))) - (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)))))) + (PROGN + (COND ((EQ |id| 'DOT) (SETQ |id| (|bfGenSymbol|)))) + (SETQ |initvar| (LIST |id|)) + (SETQ |initval| (LIST |fst|)) + (SETQ |inc| + (COND ((NOT (CONSP |step|)) |step|) + (T (SETQ |g1| (|bfGenSymbol|)) + (SETQ |initvar| (CONS |g1| |initvar|)) + (SETQ |initval| (CONS |step| |initval|)) |g1|))) + (SETQ |final| + (COND ((NOT (CONSP |lst|)) |lst|) + (T (SETQ |g2| (|bfGenSymbol|)) + (SETQ |initvar| (CONS |g2| |initvar|)) + (SETQ |initval| (CONS |lst| |initval|)) |g2|))) + (SETQ |ex| + (COND ((NULL |lst|) NIL) + ((INTEGERP |inc|) + (SETQ |pred| (COND ((MINUSP |inc|) '<) (T '>))) + (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 |bfIterateTable| (|e| |t|) (LIST '|%tbliter| |e| |t| (GENSYM))) (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|))))))) + (PROGN + (SETQ |op| (CAR |x|)) + (SETQ |id| (CADR . #1=(|x|))) + (SETQ |whole| (CADDR . #1#)) + (COND ((EQ |op| 'ON) (|bfON| |id| |whole|)) (T (|bfIN| |id| |whole|))))))) (DEFUN |bfIN| (|x| E) (PROG (|exitCond| |inits| |vars| |g|) (RETURN - (PROGN - (SETQ |g| (|bfGenSymbol|)) - (SETQ |vars| (LIST |g|)) - (SETQ |inits| (LIST E)) - (SETQ |exitCond| (LIST 'NOT (LIST 'CONSP |g|))) - (COND - ((NOT (EQ |x| 'DOT)) - (SETQ |vars| (|append| |vars| (CONS |x| NIL))) - (SETQ |inits| (|append| |inits| (CONS NIL NIL))) - (SETQ |exitCond| - (LIST 'OR |exitCond| - (LIST 'PROGN (LIST 'SETQ |x| (LIST 'CAR |g|)) - 'NIL))))) - (LIST (LIST |vars| |inits| - (LIST (LIST 'SETQ |g| (LIST 'CDR |g|))) NIL - (LIST |exitCond|) NIL)))))) + (PROGN + (SETQ |g| (|bfGenSymbol|)) + (SETQ |vars| (LIST |g|)) + (SETQ |inits| (LIST E)) + (SETQ |exitCond| (LIST 'NOT (LIST 'CONSP |g|))) + (COND + ((NOT (EQ |x| 'DOT)) (SETQ |vars| (|append| |vars| (CONS |x| NIL))) + (SETQ |inits| (|append| |inits| (CONS NIL NIL))) + (SETQ |exitCond| + (LIST 'OR |exitCond| + (LIST 'PROGN (LIST 'SETQ |x| (LIST 'CAR |g|)) 'NIL))))) + (LIST + (LIST |vars| |inits| (LIST (LIST 'SETQ |g| (LIST 'CDR |g|))) NIL + (LIST |exitCond|) NIL)))))) (DEFUN |bfON| (|x| E) (PROG (|var| |init|) (RETURN - (PROGN - (COND ((EQ |x| 'DOT) (SETQ |x| (|bfGenSymbol|)))) - (SETQ |var| (SETQ |init| NIL)) - (COND - ((OR (NOT (SYMBOLP E)) (NOT (EQ |x| E))) - (SETQ |var| (LIST |x|)) (SETQ |init| (LIST E)))) - (LIST (LIST |var| |init| - (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL - (LIST (LIST 'NOT (LIST 'CONSP |x|))) NIL)))))) + (PROGN + (COND ((EQ |x| 'DOT) (SETQ |x| (|bfGenSymbol|)))) + (SETQ |var| (SETQ |init| NIL)) + (COND + ((OR (NOT (SYMBOLP E)) (NOT (EQ |x| E))) (SETQ |var| (LIST |x|)) + (SETQ |init| (LIST E)))) + (LIST + (LIST |var| |init| (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL + (LIST (LIST 'NOT (LIST 'CONSP |x|))) NIL)))))) -(DEFUN |bfSuchthat| (|p|) - (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL))) +(DEFUN |bfSuchthat| (|p|) (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL))) -(DEFUN |bfWhile| (|p|) - (LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL))) +(DEFUN |bfWhile| (|p|) (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)))))) + (PROGN + (SETQ |g| (|bfGenSymbol|)) + (LIST + (LIST (LIST |g|) (LIST NIL) (LIST (LIST 'SETQ |g| |p|)) NIL (LIST |g|) + NIL)))))) (DEFUN |bfIterators| (|x|) (CONS 'ITERATORS |x|)) @@ -458,93 +420,90 @@ (DEFUN |bfLp| (|iters| |body|) (COND - ((AND (CONSP |iters|) (EQ (CAR |iters|) 'ITERATORS)) - (|bfLp1| (CDR |iters|) |body|)) - (T (|bfLpCross| (CDR |iters|) |body|)))) + ((AND (CONSP |iters|) (EQ (CAR |iters|) 'ITERATORS)) + (|bfLp1| (CDR |iters|) |body|)) + (T (|bfLpCross| (CDR |iters|) |body|)))) (DEFUN |bfLpCross| (|iters| |body|) - (COND - ((NULL (CDR |iters|)) (|bfLp| (CAR |iters|) |body|)) - (T (|bfLp| (CAR |iters|) (|bfLpCross| (CDR |iters|) |body|))))) + (COND ((NULL (CDR |iters|)) (|bfLp| (CAR |iters|) |body|)) + (T (|bfLp| (CAR |iters|) (|bfLpCross| (CDR |iters|) |body|))))) (DEFUN |bfSep| (|iters|) (PROG (|r| |f|) (RETURN - (COND - ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) - (T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) - (LET ((|bfVar#3| NIL) (|bfVar#4| NIL) (|bfVar#1| |f|) - (|i| NIL) (|bfVar#2| |r|) (|j| NIL)) - (LOOP + (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) + (T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) + (LET ((|bfVar#3| NIL) + (|bfVar#4| NIL) + (|bfVar#1| |f|) + (|i| NIL) + (|bfVar#2| |r|) + (|j| NIL)) + (LOOP (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL) - (NOT (CONSP |bfVar#2|)) - (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL)) - (RETURN |bfVar#3|)) - ((NULL |bfVar#3|) - (SETQ |bfVar#3| #0=(CONS (|append| |i| |j|) NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #0#) - (SETQ |bfVar#4| (CDR |bfVar#4|)))) + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL) + (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL)) + (RETURN |bfVar#3|)) + ((NULL |bfVar#3|) + (SETQ |bfVar#3| #1=(CONS (|append| |i| |j|) NIL)) + (SETQ |bfVar#4| |bfVar#3|)) + (T (RPLACD |bfVar#4| #1#) (SETQ |bfVar#4| (CDR |bfVar#4|)))) (SETQ |bfVar#1| (CDR |bfVar#1|)) (SETQ |bfVar#2| (CDR |bfVar#2|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) (RETURN - (PROGN - (SETQ |a| - (COND - ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) (CADR |op|)) - (T |op|))) - (SETQ |op| (|bfReName| |a|)) - (SETQ |init| (OR (GET |a| 'SHOETHETA) (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|)))) - (T (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|))))))) + (PROGN + (SETQ |a| + (COND ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) (CADR |op|)) + (T |op|))) + (SETQ |op| (|bfReName| |a|)) + (SETQ |init| (OR (GET |a| 'SHOETHETA) (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|)))) + (T (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 (|seq| |init| |a| |itl| |body|) (RETURN - (COND - ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT)) - (SETQ |body| (CADR |y|)) (SETQ |itl| (CADDR |y|)) - (SETQ |a| - (COND - ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) - (CADR |op|)) - (T |op|))) - (COND - ((EQ |a| '|append!|) - (|bfDoCollect| |body| |itl| '|lastNode| '|skipNil|)) - ((EQ |a| '|append|) - (|bfDoCollect| (LIST '|copyList| |body|) |itl| '|lastNode| - '|skipNil|)) - (T (SETQ |op| (|bfReName| |a|)) - (SETQ |init| - (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) - (|bfOpReduce| |op| |init| |body| |itl|)))) - (T (SETQ |seq| - (COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|)))) - (|bfReduce| |op| (|bfTupleConstruct| |seq|))))))) + (COND + ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT)) (SETQ |body| (CADR |y|)) + (SETQ |itl| (CADDR |y|)) + (SETQ |a| + (COND ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) (CADR |op|)) + (T |op|))) + (COND + ((EQ |a| '|append!|) + (|bfDoCollect| |body| |itl| '|lastNode| '|skipNil|)) + ((EQ |a| '|append|) + (|bfDoCollect| (LIST '|copyList| |body|) |itl| '|lastNode| + '|skipNil|)) + (T (SETQ |op| (|bfReName| |a|)) + (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) + (|bfOpReduce| |op| |init| |body| |itl|)))) + (T (SETQ |seq| (COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|)))) + (|bfReduce| |op| (|bfTupleConstruct| |seq|))))))) (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|)) @@ -553,154 +512,255 @@ (DEFUN |bfCollect| (|y| |itl|) (PROG (|a| |ISTMP#1|) (RETURN - (COND - ((AND (CONSP |y|) (EQ (CAR |y|) 'COLON) - (PROGN - (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) - (COND - ((OR (AND (CONSP |a|) (EQ (CAR |a|) 'CONS)) - (AND (CONSP |a|) (EQ (CAR |a|) 'LIST))) - (|bfDoCollect| |a| |itl| '|lastNode| '|skipNil|)) - (T (|bfDoCollect| (LIST '|copyList| |a|) |itl| '|lastNode| - '|skipNil|)))) - ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) - (|bfDoCollect| (|bfConstruct| |y|) |itl| '|lastNode| - '|skipNil|)) - (T (|bfDoCollect| (LIST 'CONS |y| 'NIL) |itl| 'CDR NIL)))))) + (COND + ((AND (CONSP |y|) (EQ (CAR |y|) 'COLON) + (PROGN + (SETQ |ISTMP#1| (CDR |y|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + (COND + ((OR (AND (CONSP |a|) (EQ (CAR |a|) 'CONS)) + (AND (CONSP |a|) (EQ (CAR |a|) 'LIST))) + (|bfDoCollect| |a| |itl| '|lastNode| '|skipNil|)) + (T + (|bfDoCollect| (LIST '|copyList| |a|) |itl| '|lastNode| '|skipNil|)))) + ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) + (|bfDoCollect| (|bfConstruct| |y|) |itl| '|lastNode| '|skipNil|)) + (T (|bfDoCollect| (LIST 'CONS |y| 'NIL) |itl| 'CDR NIL)))))) (DEFUN |bfMakeCollectInsn| (|expr| |prev| |head| |adv|) (PROG (|otherTime| |firstTime|) (RETURN - (PROGN - (SETQ |firstTime| + (PROGN + (SETQ |firstTime| (|bfMKPROGN| - (LIST (LIST 'SETQ |head| |expr|) - (LIST 'SETQ |prev| - (COND - ((EQ |adv| 'CDR) |head|) - (T (LIST |adv| |head|))))))) - (SETQ |otherTime| + (LIST (LIST 'SETQ |head| |expr|) + (LIST 'SETQ |prev| + (COND ((EQ |adv| 'CDR) |head|) + (T (LIST |adv| |head|))))))) + (SETQ |otherTime| (|bfMKPROGN| - (LIST (LIST 'RPLACD |prev| |expr|) - (LIST 'SETQ |prev| (LIST |adv| |prev|))))) - (|bfIf| (LIST 'NULL |head|) |firstTime| |otherTime|))))) + (LIST (LIST 'RPLACD |prev| |expr|) + (LIST 'SETQ |prev| (LIST |adv| |prev|))))) + (|bfIf| (LIST 'NULL |head|) |firstTime| |otherTime|))))) (DEFUN |bfDoCollect| (|expr| |itl| |adv| |k|) (PROG (|extrait| |body| |x| |prev| |head|) (RETURN - (PROGN - (SETQ |head| (|bfGenSymbol|)) - (SETQ |prev| (|bfGenSymbol|)) - (SETQ |body| + (PROGN + (SETQ |head| (|bfGenSymbol|)) + (SETQ |prev| (|bfGenSymbol|)) + (SETQ |body| (COND - ((EQ |k| '|skipNil|) (SETQ |x| (|bfGenSymbol|)) - (LIST 'LET (LIST (LIST |x| |expr|)) - (|bfIf| (LIST 'NULL |x|) 'NIL - (|bfMakeCollectInsn| |x| |prev| |head| - |adv|)))) - (T (|bfMakeCollectInsn| |expr| |prev| |head| |adv|)))) - (SETQ |extrait| - (LIST (LIST (LIST |head| |prev|) (LIST 'NIL 'NIL) NIL NIL - NIL (LIST |head|)))) - (|bfLp2| |extrait| |itl| |body|))))) + ((EQ |k| '|skipNil|) (SETQ |x| (|bfGenSymbol|)) + (LIST 'LET (LIST (LIST |x| |expr|)) + (|bfIf| (LIST 'NULL |x|) 'NIL + (|bfMakeCollectInsn| |x| |prev| |head| |adv|)))) + (T (|bfMakeCollectInsn| |expr| |prev| |head| |adv|)))) + (SETQ |extrait| + (LIST + (LIST (LIST |head| |prev|) (LIST 'NIL 'NIL) NIL NIL NIL + (LIST |head|)))) + (|bfLp2| |extrait| |itl| |body|))))) + +(DEFUN |separateIterators| (|iters|) + (PROG (|y| |x|) + (RETURN + (PROGN + (SETQ |x| NIL) + (SETQ |y| NIL) + (LET ((|bfVar#1| |iters|) (|iter| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |iter| (CAR |bfVar#1|)) NIL)) + (RETURN NIL)) + ((AND (CONSP |iter|) (EQ (CAR |iter|) '|%tbliter|)) + (SETQ |y| (CONS (CDR |iter|) |y|))) + (T (SETQ |x| (CONS |iter| |x|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (LIST (|reverse!| |x|) (|reverse!| |y|)))))) + +(DEFUN |bfExpandTableIters| (|iters|) + (PROG (|ISTMP#5| |v| |ISTMP#4| CONS |ISTMP#3| |k| |x| |g| |ISTMP#2| |t| + |ISTMP#1| |e| |exits| |localBindings| |inits|) + (RETURN + (PROGN + (SETQ |inits| NIL) + (SETQ |localBindings| NIL) + (SETQ |exits| NIL) + (LET ((|bfVar#2| |iters|) (|bfVar#1| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |bfVar#1| (CAR |bfVar#2|)) NIL)) + (RETURN NIL)) + (T + (AND (CONSP |bfVar#1|) + (PROGN + (SETQ |e| (CAR |bfVar#1|)) + (SETQ |ISTMP#1| (CDR |bfVar#1|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |t| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |g| (CAR |ISTMP#2|)) T))))) + (PROGN + (SETQ |inits| (CONS (LIST |g| |t|) |inits|)) + (SETQ |x| (GENSYM)) + (SETQ |exits| (CONS (LIST 'NOT |x|) |exits|)) + (COND + ((AND (CONSP |e|) (EQ (CAR |e|) 'CONS) + (PROGN + (SETQ |ISTMP#1| (CDR |e|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |k| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN + (SETQ |ISTMP#3| (CAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (PROGN + (SETQ CONS (CAR |ISTMP#3|)) + (SETQ |ISTMP#4| (CDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (PROGN + (SETQ |v| (CAR |ISTMP#4|)) + (SETQ |ISTMP#5| + (CDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (NULL (CDR |ISTMP#5|)) + (EQ (CAR |ISTMP#5|) + 'NIL))))))))))) + (|ident?| |k|) (|ident?| |v|)) + (SETQ |localBindings| + (CONS + (LIST 'MULTIPLE-VALUE-BIND (LIST |x| |k| |v|) + (LIST |g|)) + |localBindings|))) + (T (SETQ |k| (GENSYM)) (SETQ |v| (GENSYM)) + (SETQ |localBindings| + (CONS + (LIST 'MULTIPLE-VALUE-BIND (LIST |x| |k| |v|) + (LIST |g|) + (|bfLET1| + (LIST 'CONS |k| (LIST 'CONS |v| 'NIL)) |e|)) + |localBindings|)))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|)))) + (LIST |inits| |localBindings| |exits|))))) (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|) - (T (|bfAND| (|append| |filters| (CONS |body| NIL)))))) - (SETQ |value| (COND ((NULL |value|) 'NIL) (T (CAR |value|)))) - (SETQ |exits| - (COND - ((NULL |exits|) |nbody|) - (T (|bfIf| (|bfOR| |exits|) (LIST 'RETURN |value|) - |nbody|)))) - (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|))) - (COND - (|vars| (SETQ |loop| - (LIST 'LET - (LET ((|bfVar#3| NIL) (|bfVar#4| NIL) - (|bfVar#1| |vars|) (|v| NIL) - (|bfVar#2| |inits|) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN - (SETQ |v| (CAR |bfVar#1|)) - NIL) - (NOT (CONSP |bfVar#2|)) - (PROGN - (SETQ |i| (CAR |bfVar#2|)) - NIL)) - (RETURN |bfVar#3|)) - ((NULL |bfVar#3|) - (SETQ |bfVar#3| - #2=(CONS (LIST |v| |i|) NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #2#) - (SETQ |bfVar#4| (CDR |bfVar#4|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)) - (SETQ |bfVar#2| (CDR |bfVar#2|)))) - |loop|)))) - |loop|)))) + (PROG (|loop| |nbody| |tblExits| |tblLocs| |tblInits| |value| |exits| + |filters| |sucs| |inits| |vars| |tbls| |LETTMP#1|) + (RETURN + (PROGN + (SETQ |LETTMP#1| (|separateIterators| |iters|)) + (SETQ |iters| (CAR |LETTMP#1|)) + (SETQ |tbls| (CADR |LETTMP#1|)) + (SETQ |LETTMP#1| (|bfSep| (|bfAppend| |iters|))) + (SETQ |vars| (CAR |LETTMP#1|)) + (SETQ |inits| (CADR . #1=(|LETTMP#1|))) + (SETQ |sucs| (CADDR . #1#)) + (SETQ |filters| (CADDDR . #1#)) + (SETQ |exits| (CAR #2=(CDDDDR . #1#))) + (SETQ |value| (CADR #2#)) + (SETQ |LETTMP#1| (|bfExpandTableIters| |tbls|)) + (SETQ |tblInits| (CAR |LETTMP#1|)) + (SETQ |tblLocs| (CADR . #3=(|LETTMP#1|))) + (SETQ |tblExits| (CADDR . #3#)) + (SETQ |nbody| + (COND ((NULL |filters|) |body|) + (T (|bfAND| (|append| |filters| (CONS |body| NIL)))))) + (SETQ |value| (COND ((NULL |value|) 'NIL) (T (CAR |value|)))) + (SETQ |exits| + (COND ((AND (NULL |exits|) (NULL |tblExits|)) |nbody|) + (T + (|bfIf| (|bfOR| (|append| |exits| |tblExits|)) + (LIST 'RETURN |value|) |nbody|)))) + (LET ((|bfVar#1| |tblLocs|) (|locBinding| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |locBinding| (CAR |bfVar#1|)) NIL)) + (RETURN NIL)) + (T (SETQ |exits| (|append| |locBinding| (CONS |exits| NIL))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|))) + (COND + (|vars| + (SETQ |loop| + (LIST 'LET + (LET ((|bfVar#4| NIL) + (|bfVar#5| NIL) + (|bfVar#2| |vars|) + (|v| NIL) + (|bfVar#3| |inits|) + (|i| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |v| (CAR |bfVar#2|)) NIL) + (NOT (CONSP |bfVar#3|)) + (PROGN (SETQ |i| (CAR |bfVar#3|)) NIL)) + (RETURN |bfVar#4|)) + ((NULL |bfVar#4|) + (SETQ |bfVar#4| #4=(CONS (LIST |v| |i|) NIL)) + (SETQ |bfVar#5| |bfVar#4|)) + (T (RPLACD |bfVar#5| #4#) + (SETQ |bfVar#5| (CDR |bfVar#5|)))) + (SETQ |bfVar#2| (CDR |bfVar#2|)) + (SETQ |bfVar#3| (CDR |bfVar#3|)))) + |loop|)))) + (LET ((|bfVar#6| |tblInits|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#6|)) (PROGN (SETQ |x| (CAR |bfVar#6|)) NIL)) + (RETURN NIL)) + (T (SETQ |loop| (LIST 'WITH-HASH-TABLE-ITERATOR |x| |loop|)))) + (SETQ |bfVar#6| (CDR |bfVar#6|)))) + |loop|)))) (DEFUN |bfLp2| (|extrait| |itl| |body|) (PROG (|iters|) (RETURN - (COND - ((AND (CONSP |itl|) (EQ (CAR |itl|) 'ITERATORS)) - (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|)) - (T (SETQ |iters| (CDR |itl|)) - (|bfLpCross| - (CONS (CONS 'ITERATORS (CONS |extrait| (CDAR |iters|))) - (CDR |iters|)) - |body|)))))) + (COND + ((AND (CONSP |itl|) (EQ (CAR |itl|) 'ITERATORS)) + (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|)) + (T (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| + (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|))))))) + ((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|) (|bfLp| (|bfIterators| NIL) |body|)) @@ -714,1546 +774,1442 @@ (DEFUN |bfForin| (|lhs| U) (|bfFor| |lhs| U 1)) (DEFUN |bfLocal| (|a| |b|) - (COND - ((EQ |b| 'FLUID) (|compFluid| |a|)) - ((EQ |b| '|local|) (|compFluid| |a|)) - (T |a|))) + (COND ((EQ |b| 'FLUID) (|compFluid| |a|)) + ((EQ |b| '|local|) (|compFluid| |a|)) (T |a|))) (DEFUN |bfTake| (|n| |x|) - (COND - ((NULL |x|) |x|) - ((EQL |n| 0) NIL) - (T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|)))))) + (COND ((NULL |x|) |x|) ((EQL |n| 0) NIL) + (T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|)))))) (DEFUN |bfDrop| (|n| |x|) - (COND - ((OR (NULL |x|) (EQL |n| 0)) |x|) - (T (|bfDrop| (- |n| 1) (CDR |x|))))) + (COND ((OR (NULL |x|) (EQL |n| 0)) |x|) (T (|bfDrop| (- |n| 1) (CDR |x|))))) (DEFUN |bfReturnNoName| (|a|) (LIST 'RETURN |a|)) (DEFUN |bfLeave| (|x|) (LIST '|%Leave| |x|)) (DEFUN |bfSUBLIS| (|p| |e|) - (COND - ((NOT (CONSP |e|)) (|bfSUBLIS1| |p| |e|)) - ((EQ (CAR |e|) 'QUOTE) |e|) - (T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|)))))) + (COND ((NOT (CONSP |e|)) (|bfSUBLIS1| |p| |e|)) ((EQ (CAR |e|) 'QUOTE) |e|) + (T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|)))))) (DEFUN |bfSUBLIS1| (|p| |e|) (PROG (|f|) (RETURN - (COND - ((NULL |p|) |e|) - (T (SETQ |f| (CAR |p|)) - (COND - ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|))) - (T (|bfSUBLIS1| (CDR |p|) |e|)))))))) + (COND ((NULL |p|) |e|) + (T (SETQ |f| (CAR |p|)) + (COND ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|))) + (T (|bfSUBLIS1| (CDR |p|) |e|)))))))) (DEFUN |defSheepAndGoats| (|x|) (PROG (|defstack| |op1| |opassoc| |argl|) (DECLARE (SPECIAL |$op|)) (RETURN - (CASE (CAR |x|) - (|%Definition| - (LET ((|op| (CADR |x|)) (|args| (CADDR |x|)) - (|body| (CADDDR |x|))) - (PROGN - (SETQ |argl| - (COND - ((|bfTupleP| |args|) (CDR |args|)) - (T (LIST |args|)))) - (COND - ((NULL |argl|) - (SETQ |opassoc| (LIST (CONS |op| |body|))) - (LIST |opassoc| NIL NIL)) - (T (SETQ |op1| - (INTERN (CONCAT (SYMBOL-NAME |$op|) "," - (SYMBOL-NAME |op|)))) - (SETQ |opassoc| (LIST (CONS |op| |op1|))) - (SETQ |defstack| - (LIST (LIST |op1| |args| |body|))) - (LIST |opassoc| |defstack| NIL)))))) - (|%Pile| (LET ((|defs| (CADR |x|))) - (|defSheepAndGoatsList| |defs|))) - (T (LIST NIL NIL (LIST |x|))))))) + (CASE (CAR |x|) + (|%Definition| + (LET ((|op| (CADR |x|)) (|args| (CADDR |x|)) (|body| (CADDDR |x|))) + (PROGN + (SETQ |argl| + (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) + (COND + ((NULL |argl|) (SETQ |opassoc| (LIST (CONS |op| |body|))) + (LIST |opassoc| NIL NIL)) + (T + (SETQ |op1| + (INTERN + (CONCAT (SYMBOL-NAME |$op|) "," (SYMBOL-NAME |op|)))) + (SETQ |opassoc| (LIST (CONS |op| |op1|))) + (SETQ |defstack| (LIST (LIST |op1| |args| |body|))) + (LIST |opassoc| |defstack| NIL)))))) + (|%Pile| + (LET ((|defs| (CADR |x|))) + (|defSheepAndGoatsList| |defs|))) + (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|))))))) + (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 . #1=(|LETTMP#1|))) + (SETQ |nondefs| (CADDR . #1#)) + (SETQ |LETTMP#1| (|defSheepAndGoatsList| (CDR |x|))) + (SETQ |opassoc1| (CAR |LETTMP#1|)) + (SETQ |defs1| (CADR . #2=(|LETTMP#1|))) + (SETQ |nondefs1| (CADDR . #2#)) + (LIST (|append| |opassoc| |opassoc1|) (|append| |defs| |defs1|) + (|append| |nondefs| |nondefs1|))))))) (DEFUN |bfLetForm| (|lhs| |rhs|) (LIST 'L%T |lhs| |rhs|)) (DEFUN |bfLET1| (|lhs| |rhs|) (PROG (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|) (RETURN - (COND - ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|)) - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) - (PROGN - (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) - (|bfLetForm| |lhs| |rhs|)) - ((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) - (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) - (COND - ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T)) - (|bfMKPROGN| (LIST |rhs1| |rhs|))) - ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN)) - (|append| |rhs1| (LIST |rhs|))) - (T (COND - ((SYMBOLP (CAR |rhs1|)) - (SETQ |rhs1| (CONS |rhs1| NIL)))) + (COND ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|)) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) + (PROGN + (SETQ |ISTMP#1| (CDR |lhs|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + (|bfLetForm| |lhs| |rhs|)) + ((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) + (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) + (COND + ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T)) + (|bfMKPROGN| (LIST |rhs1| |rhs|))) + ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN)) + (|append| |rhs1| (LIST |rhs|))) + (T (COND ((SYMBOLP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL)))) (|bfMKPROGN| (|append| |rhs1| (CONS |rhs| NIL)))))) - ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T) - (SYMBOLP (SETQ |name| (CADR |rhs|)))) - (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|))) - (SETQ |l2| (|bfLET1| |lhs| |name|)) - (COND - ((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN)) - (|bfMKPROGN| (CONS |l1| (CDR |l2|)))) - (T (COND - ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL)))) - (|bfMKPROGN| - (CONS |l1| (|append| |l2| (CONS |name| NIL))))))) - (T (SETQ |g| (|bfLetVar|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|)) - (SETQ |let1| (|bfLET1| |lhs| |g|)) - (COND + ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T) + (SYMBOLP (SETQ |name| (CADR |rhs|)))) + (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|))) + (SETQ |l2| (|bfLET1| |lhs| |name|)) + (COND + ((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN)) + (|bfMKPROGN| (CONS |l1| (CDR |l2|)))) + (T (COND ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL)))) + (|bfMKPROGN| (CONS |l1| (|append| |l2| (CONS |name| NIL))))))) + (T (SETQ |g| (|bfLetVar|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|)) + (SETQ |let1| (|bfLET1| |lhs| |g|)) + (COND ((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN)) (|bfMKPROGN| (CONS |rhs1| (CDR |let1|)))) - (T (COND - ((SYMBOLP (CAR |let1|)) - (SETQ |let1| (CONS |let1| NIL)))) - (|bfMKPROGN| - (CONS |rhs1| (|append| |let1| (CONS |g| NIL))))))))))) + (T (COND ((SYMBOLP (CAR |let1|)) (SETQ |let1| (CONS |let1| NIL)))) + (|bfMKPROGN| + (CONS |rhs1| (|append| |let1| (CONS |g| NIL))))))))))) (DEFUN |bfCONTAINED| (|x| |y|) - (COND - ((EQ |x| |y|) T) - ((NOT (CONSP |y|)) NIL) - (T (OR (|bfCONTAINED| |x| (CAR |y|)) (|bfCONTAINED| |x| (CDR |y|)))))) + (COND ((EQ |x| |y|) T) ((NOT (CONSP |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|) + (PROG (|isPred| |val1| |ISTMP#3| |g| |rev| |patrev| |l2| |l1| |var2| |var1| + |b| |ISTMP#2| |a| |ISTMP#1|) (DECLARE (SPECIAL |$inDefIS|)) (RETURN - (COND - ((NULL |lhs|) NIL) - ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|)) - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) - (PROGN - (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) - (|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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) - (SETQ |a| (|bfLET2| |a| |rhs|)) - (COND - ((NULL (SETQ |b| (|bfLET2| |b| |rhs|))) |a|) - ((NOT (CONSP |b|)) (LIST |a| |b|)) - ((CONSP (CAR |b|)) (CONS |a| |b|)) - (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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) - (COND - ((OR (EQ |var1| 'DOT) - (AND (CONSP |var1|) (EQ (CAR |var1|) 'QUOTE))) - (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) - (T (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|))) - (COND - ((OR (NULL |var2|) (EQ |var2| 'DOT)) |l1|) - (T (COND - ((AND (CONSP |l1|) (NOT (CONSP (CAR |l1|)))) - (SETQ |l1| (CONS |l1| NIL)))) - (COND - ((SYMBOLP |var2|) - (|append| |l1| - (CONS (|bfLetForm| |var2| - (|addCARorCDR| 'CDR |rhs|)) - NIL))) - (T (SETQ |l2| - (|bfLET2| |var2| - (|addCARorCDR| 'CDR |rhs|))) - (COND - ((AND (CONSP |l2|) (NOT (CONSP (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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) - (SETQ |patrev| (|bfISReverse| |var2| |var1|)) - (SETQ |rev| (LIST '|reverse| |rhs|)) (SETQ |g| (|bfLetVar|)) - (SETQ |l2| (|bfLET2| |patrev| |g|)) - (COND - ((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|)))) - (SETQ |l2| (CONS |l2| NIL)))) - (COND - ((EQ |var1| 'DOT) (CONS (LIST 'L%T |g| |rev|) |l2|)) - ((PROGN - (SETQ |ISTMP#1| (CAR (|lastNode| |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|) - (NULL (CDR |ISTMP#3|)) - (PROGN - (SETQ |val1| (CAR |ISTMP#3|)) - T))))))) - (CONS (LIST 'L%T |g| |rev|) - (|append| (|reverse| (CDR (|reverse| |l2|))) - (CONS (|bfLetForm| |var1| - (LIST '|reverse!| |val1|)) - NIL)))) - (T (CONS (LIST 'L%T |g| |rev|) - (|append| |l2| - (CONS (|bfLetForm| |var1| - (LIST '|reverse!| |var1|)) - NIL)))))) - ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL) - (PROGN - (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |var1| (CAR |ISTMP#1|)) T)))) - (LIST 'COND (LIST (|bfQ| |var1| |rhs|) |var1|))) - (T (SETQ |isPred| - (COND - (|$inDefIS| (|bfIS1| |rhs| |lhs|)) - (T (|bfIS| |rhs| |lhs|)))) - (LIST 'COND (LIST |isPred| |rhs|))))))) + (COND ((NULL |lhs|) NIL) ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|)) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) + (PROGN + (SETQ |ISTMP#1| (CDR |lhs|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + (|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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) + (SETQ |a| (|bfLET2| |a| |rhs|)) + (COND ((NULL (SETQ |b| (|bfLET2| |b| |rhs|))) |a|) + ((NOT (CONSP |b|)) (LIST |a| |b|)) + ((CONSP (CAR |b|)) (CONS |a| |b|)) (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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) + (COND + ((OR (EQ |var1| 'DOT) + (AND (CONSP |var1|) (EQ (CAR |var1|) 'QUOTE))) + (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) + (T (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|))) + (COND ((OR (NULL |var2|) (EQ |var2| 'DOT)) |l1|) + (T + (COND + ((AND (CONSP |l1|) (NOT (CONSP (CAR |l1|)))) + (SETQ |l1| (CONS |l1| NIL)))) + (COND + ((SYMBOLP |var2|) + (|append| |l1| + (CONS + (|bfLetForm| |var2| + (|addCARorCDR| 'CDR |rhs|)) + NIL))) + (T + (SETQ |l2| (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) + (COND + ((AND (CONSP |l2|) (NOT (CONSP (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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) + (SETQ |patrev| (|bfISReverse| |var2| |var1|)) + (SETQ |rev| (LIST '|reverse| |rhs|)) (SETQ |g| (|bfLetVar|)) + (SETQ |l2| (|bfLET2| |patrev| |g|)) + (COND + ((AND (CONSP |l2|) (NOT (CONSP (CAR |l2|)))) + (SETQ |l2| (CONS |l2| NIL)))) + (COND ((EQ |var1| 'DOT) (CONS (LIST 'L%T |g| |rev|) |l2|)) + ((PROGN + (SETQ |ISTMP#1| (CAR (|lastNode| |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|) (NULL (CDR |ISTMP#3|)) + (PROGN + (SETQ |val1| (CAR |ISTMP#3|)) + T))))))) + (CONS (LIST 'L%T |g| |rev|) + (|append| (|reverse| (CDR (|reverse| |l2|))) + (CONS + (|bfLetForm| |var1| + (LIST '|reverse!| |val1|)) + NIL)))) + (T + (CONS (LIST 'L%T |g| |rev|) + (|append| |l2| + (CONS + (|bfLetForm| |var1| + (LIST '|reverse!| |var1|)) + NIL)))))) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL) + (PROGN + (SETQ |ISTMP#1| (CDR |lhs|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |var1| (CAR |ISTMP#1|)) T)))) + (LIST 'COND (LIST (|bfQ| |var1| |rhs|) |var1|))) + (T + (SETQ |isPred| + (COND (|$inDefIS| (|bfIS1| |rhs| |lhs|)) + (T (|bfIS| |rhs| |lhs|)))) + (LIST 'COND (LIST |isPred| |rhs|))))))) (DEFUN |bfLET| (|lhs| |rhs|) (PROG (|$letGenVarCounter|) (DECLARE (SPECIAL |$letGenVarCounter|)) - (RETURN - (PROGN (SETQ |$letGenVarCounter| 0) (|bfLET1| |lhs| |rhs|))))) + (RETURN (PROGN (SETQ |$letGenVarCounter| 0) (|bfLET1| |lhs| |rhs|))))) (DEFUN |addCARorCDR| (|acc| |expr|) (PROG (|funsR| |funsA| |p| |funs|) (RETURN - (COND - ((NOT (CONSP |expr|)) (LIST |acc| |expr|)) - ((AND (EQ |acc| 'CAR) (CONSP |expr|) - (EQ (CAR |expr|) '|reverse|)) - (LIST 'CAR (CONS '|lastNode| (CDR |expr|)))) - (T (SETQ |funs| - '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR - CDAAR CDDAR CDADR CDDDR)) - (SETQ |p| (|bfPosition| (CAR |expr|) |funs|)) - (COND - ((EQL |p| (- 1)) (LIST |acc| |expr|)) - (T (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|))))))))))) + (COND ((NOT (CONSP |expr|)) (LIST |acc| |expr|)) + ((AND (EQ |acc| 'CAR) (CONSP |expr|) (EQ (CAR |expr|) '|reverse|)) + (LIST 'CAR (CONS '|lastNode| (CDR |expr|)))) + (T + (SETQ |funs| + '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR CDAAR + CDDAR CDADR CDDDR)) + (SETQ |p| (|bfPosition| (CAR |expr|) |funs|)) + (COND ((EQL |p| (- 1)) (LIST |acc| |expr|)) + (T + (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|) (|bfPosn| |x| |l| 0)) (DEFUN |bfPosn| (|x| |l| |n|) - (COND - ((NULL |l|) (- 1)) - ((EQUAL |x| (CAR |l|)) |n|) - (T (|bfPosn| |x| (CDR |l|) (+ |n| 1))))) + (COND ((NULL |l|) (- 1)) ((EQUAL |x| (CAR |l|)) |n|) + (T (|bfPosn| |x| (CDR |l|) (+ |n| 1))))) (DEFUN |bfISApplication| (|op| |left| |right|) - (COND - ((EQ |op| 'IS) (|bfIS| |left| |right|)) - ((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |left| |right|))) - (T (LIST |op| |left| |right|)))) + (COND ((EQ |op| 'IS) (|bfIS| |left| |right|)) + ((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |left| |right|))) + (T (LIST |op| |left| |right|)))) (DEFUN |bfIS| (|left| |right|) (PROG (|$inDefIS| |$isGenVarCounter|) - (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|)) + (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|)) (RETURN - (PROGN - (SETQ |$isGenVarCounter| 0) - (SETQ |$inDefIS| T) - (|bfIS1| |left| |right|))))) + (PROGN + (SETQ |$isGenVarCounter| 0) + (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|)) - (T (SETQ |y| (|bfISReverse| (CADDR |x|) NIL)) + (COND + ((AND (CONSP |x|) (EQ (CAR |x|) 'CONS)) + (COND ((NULL (CADDR |x|)) (LIST 'CONS (CADR |x|) |a|)) + (T (SETQ |y| (|bfISReverse| (CADDR |x|) NIL)) (RPLACA (CDR (CDR |y|)) (LIST 'CONS (CADR |x|) |a|)) |y|))) - (T (|bpSpecificErrorHere| "Error in bfISReverse") (|bpTrap|)))))) + (T (|bpSpecificErrorHere| "Error in bfISReverse") (|bpTrap|)))))) (DEFUN |bfIS1| (|lhs| |rhs|) - (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |g| |b| |ISTMP#2| - |ISTMP#1| |l| |d| |c| |a|) - (RETURN - (COND - ((NULL |rhs|) (LIST 'NULL |lhs|)) - ((|bfString?| |rhs|) - (|bfAND| (LIST (LIST 'STRINGP |lhs|) - (LIST 'STRING= |lhs| |rhs|)))) - ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) - (LIST 'EQL |lhs| |rhs|)) - ((NOT (CONSP |rhs|)) - (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T)) - ((EQ (CAR |rhs|) 'QUOTE) (SETQ |a| (CADR |rhs|)) - (COND - ((SYMBOLP |a|) (LIST 'EQ |lhs| |rhs|)) - ((STRINGP |a|) - (|bfAND| (LIST (LIST 'STRINGP |lhs|) - (LIST 'STRING= |lhs| |a|)))) - (T (LIST 'EQUAL |lhs| |rhs|)))) - ((EQ (CAR |rhs|) 'L%T) (SETQ |c| (CADR . #0=(|rhs|))) - (SETQ |d| (CADDR . #0#)) (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|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) - (|bfQ| |lhs| |a|)) - ((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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |b| (CAR |ISTMP#2|)) T))))) - (EQ |a| 'DOT) (EQ |b| 'DOT)) - (LIST 'CONSP |lhs|)) - ((CONSP |lhs|) (SETQ |g| (|bfIsVar|)) - (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|)))) - ((EQ (CAR |rhs|) 'CONS) (SETQ |a| (CADR . #1=(|rhs|))) - (SETQ |b| (CADDR . #1#)) - (COND - ((EQ |a| 'DOT) + (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |g| |b| |ISTMP#2| |ISTMP#1| |l| + |d| |c| |a|) + (RETURN + (COND ((NULL |rhs|) (LIST 'NULL |lhs|)) + ((|bfString?| |rhs|) + (|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|)))) + ((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|)) + ((NOT (CONSP |rhs|)) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) 'T)) + ((EQ (CAR |rhs|) 'QUOTE) (SETQ |a| (CADR |rhs|)) + (COND ((SYMBOLP |a|) (LIST 'EQ |lhs| |rhs|)) + ((STRINGP |a|) + (|bfAND| + (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |a|)))) + (T (LIST 'EQUAL |lhs| |rhs|)))) + ((EQ (CAR |rhs|) 'L%T) (SETQ |c| (CADR . #1=(|rhs|))) + (SETQ |d| (CADDR . #1#)) (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|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + (|bfQ| |lhs| |a|)) + ((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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |b| (CAR |ISTMP#2|)) T))))) + (EQ |a| 'DOT) (EQ |b| 'DOT)) + (LIST 'CONSP |lhs|)) + ((CONSP |lhs|) (SETQ |g| (|bfIsVar|)) + (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|)))) + ((EQ (CAR |rhs|) 'CONS) (SETQ |a| (CADR . #2=(|rhs|))) + (SETQ |b| (CADDR . #2#)) (COND - ((NULL |b|) - (|bfAND| (LIST (LIST 'CONSP |lhs|) - (LIST 'NULL (LIST 'CDR |lhs|))))) - ((EQ |b| 'DOT) (LIST 'CONSP |lhs|)) - (T (|bfAND| (LIST (LIST 'CONSP |lhs|) - (|bfIS1| (LIST 'CDR |lhs|) |b|)))))) - ((NULL |b|) - (|bfAND| (LIST (LIST 'CONSP |lhs|) - (LIST 'NULL (LIST 'CDR |lhs|)) - (|bfIS1| (LIST 'CAR |lhs|) |a|)))) - ((EQ |b| 'DOT) - (|bfAND| (LIST (LIST 'CONSP |lhs|) - (|bfIS1| (LIST 'CAR |lhs|) |a|)))) - (T (SETQ |a1| (|bfIS1| (LIST 'CAR |lhs|) |a|)) + ((EQ |a| 'DOT) + (COND + ((NULL |b|) + (|bfAND| + (LIST (LIST 'CONSP |lhs|) (LIST 'NULL (LIST 'CDR |lhs|))))) + ((EQ |b| 'DOT) (LIST 'CONSP |lhs|)) + (T + (|bfAND| + (LIST (LIST 'CONSP |lhs|) (|bfIS1| (LIST 'CDR |lhs|) |b|)))))) + ((NULL |b|) + (|bfAND| + (LIST (LIST 'CONSP |lhs|) (LIST 'NULL (LIST 'CDR |lhs|)) + (|bfIS1| (LIST 'CAR |lhs|) |a|)))) + ((EQ |b| 'DOT) + (|bfAND| + (LIST (LIST 'CONSP |lhs|) (|bfIS1| (LIST 'CAR |lhs|) |a|)))) + (T (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|) - (NULL (CDR |ISTMP#2|)) - (EQ (CAR |ISTMP#2|) 'T))))) - (CONSP |b1|) (EQ (CAR |b1|) 'PROGN)) - (SETQ |cls| (CDR |b1|)) - (|bfAND| (LIST (LIST 'CONSP |lhs|) - (|bfMKPROGN| (CONS |c| |cls|))))) - (T (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|))))))) - ((EQ (CAR |rhs|) '|append|) (SETQ |a| (CADR . #2=(|rhs|))) - (SETQ |b| (CADDR . #2#)) - (SETQ |patrev| (|bfISReverse| |b| |a|)) (SETQ |g| (|bfIsVar|)) - (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|) (NOT (CONSP (CAR |l2|)))) - (SETQ |l2| (CONS |l2| NIL)))) - (COND - ((EQ |a| 'DOT) (|bfAND| (CONS |rev| |l2|))) - (T (|bfAND| (CONS |rev| - (|append| |l2| - (CONS (LIST 'PROGN - (|bfLetForm| |a| - (LIST '|reverse!| |a|)) - 'T) - NIL))))))) - (T (|bpSpecificErrorHere| "bad IS code is generated") - (|bpTrap|)))))) + ((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|) (NULL (CDR |ISTMP#2|)) + (EQ (CAR |ISTMP#2|) 'T))))) + (CONSP |b1|) (EQ (CAR |b1|) 'PROGN)) + (SETQ |cls| (CDR |b1|)) + (|bfAND| + (LIST (LIST 'CONSP |lhs|) (|bfMKPROGN| (CONS |c| |cls|))))) + (T (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|))))))) + ((EQ (CAR |rhs|) '|append|) (SETQ |a| (CADR . #3=(|rhs|))) + (SETQ |b| (CADDR . #3#)) (SETQ |patrev| (|bfISReverse| |b| |a|)) + (SETQ |g| (|bfIsVar|)) + (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|) (NOT (CONSP (CAR |l2|)))) + (SETQ |l2| (CONS |l2| NIL)))) + (COND ((EQ |a| 'DOT) (|bfAND| (CONS |rev| |l2|))) + (T + (|bfAND| + (CONS |rev| + (|append| |l2| + (CONS + (LIST 'PROGN + (|bfLetForm| |a| + (LIST '|reverse!| |a|)) + 'T) + NIL))))))) + (T (|bpSpecificErrorHere| "bad IS code is generated") (|bpTrap|)))))) (DEFUN |bfHas| (|expr| |prop|) - (COND - ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|))) - (T (|bpSpecificErrorHere| "expected identifier as property name")))) + (COND ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|))) + (T (|bpSpecificErrorHere| "expected identifier as property name")))) (DEFUN |bfApplication| (|bfop| |bfarg|) - (COND - ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) - (T (LIST |bfop| |bfarg|)))) + (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) + (T (LIST |bfop| |bfarg|)))) (DEFUN |bfReName| (|x|) (PROG (|a|) - (RETURN - (COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) (T |x|))))) + (RETURN (COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) (T |x|))))) (DEFUN |sequence?| (|x| |pred|) (PROG (|seq| |ISTMP#1|) (RETURN - (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |seq| (CAR |ISTMP#1|)) T))) - (CONSP |seq|) - (LET ((|bfVar#2| T) (|bfVar#1| |seq|) (|y| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (APPLY |pred| |y| NIL)) - (COND ((NOT |bfVar#2|) (RETURN NIL))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) + (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |seq| (CAR |ISTMP#1|)) T))) + (CONSP |seq|) + (LET ((|bfVar#2| T) (|bfVar#1| |seq|) (|y| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T (SETQ |bfVar#2| (APPLY |pred| |y| NIL)) + (COND ((NOT |bfVar#2|) (RETURN NIL))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) (DEFUN |idList?| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'LIST) (LET ((|bfVar#2| T) (|bfVar#1| (CDR |x|)) (|arg| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (|defQuoteId| |arg|)) - (COND ((NOT |bfVar#2|) (RETURN NIL))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T (SETQ |bfVar#2| (|defQuoteId| |arg|)) + (COND ((NOT |bfVar#2|) (RETURN NIL))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))) (DEFUN |charList?| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'LIST) (LET ((|bfVar#2| T) (|bfVar#1| (CDR |x|)) (|arg| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (|bfChar?| |arg|)) - (COND ((NOT |bfVar#2|) (RETURN NIL))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T (SETQ |bfVar#2| (|bfChar?| |arg|)) + (COND ((NOT |bfVar#2|) (RETURN NIL))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))) (DEFUN |stringList?| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'LIST) (LET ((|bfVar#2| T) (|bfVar#1| (CDR |x|)) (|arg| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (|bfString?| |arg|)) - (COND ((NOT |bfVar#2|) (RETURN NIL))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |arg| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T (SETQ |bfVar#2| (|bfString?| |arg|)) + (COND ((NOT |bfVar#2|) (RETURN NIL))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))) (DEFUN |bfMember| (|var| |seq|) (PROG (|y| |x| |ISTMP#2| |ISTMP#1|) (RETURN - (COND - ((OR (INTEGERP |var|) (|sequence?| |seq| #'INTEGERP)) - (COND - ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (LIST 'EQL |var| |x|)) - (T (LIST '|scalarMember?| |var| |seq|)))) - ((OR (|defQuoteId| |var|) (|sequence?| |seq| #'SYMBOLP)) - (COND - ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (LIST 'EQ |var| (|quote| |x|))) - (T (LIST '|symbolMember?| |var| |seq|)))) - ((|idList?| |seq|) - (COND - ((PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) - (CONS 'EQ (CONS |var| (CDR |seq|)))) - ((AND (SYMBOLP |var|) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |x| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) - (|bfOR| (LIST (LIST 'EQ |var| |x|) (LIST 'EQ |var| |y|)))) - (T (LIST '|symbolMember?| |var| |seq|)))) - ((OR (|bfChar?| |var|) (|sequence?| |seq| #'CHARACTERP)) - (COND - ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (LIST 'CHAR= |var| |x|)) - (T (LIST '|charMember?| |var| |seq|)))) - ((|charList?| |seq|) - (COND - ((PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) - (CONS 'CHAR= (CONS |var| (CDR |seq|)))) - ((AND (SYMBOLP |var|) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |x| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) - (|bfOR| (LIST (LIST 'CHAR= |var| |x|) - (LIST 'CHAR= |var| |y|)))) - (T (LIST '|charMember?| |var| |seq|)))) - ((OR (|bfString?| |var|) (|sequence?| |seq| #'STRINGP)) - (COND - ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (LIST 'STRING= |var| |x|)) - (T (LIST '|stringMember?| |var| |seq|)))) - ((|stringList?| |seq|) - (COND - ((PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) - (CONS 'STRING= (CONS |var| (CDR |seq|)))) - ((AND (SYMBOLP |var|) - (PROGN - (SETQ |ISTMP#1| (CDR |seq|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |x| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) - (|bfOR| (LIST (LIST 'STRING= |var| |x|) - (LIST 'STRING= |var| |y|)))) - (T (LIST '|stringMember?| |var| |seq|)))) - (T (LIST 'MEMBER |var| |seq|)))))) + (COND + ((OR (INTEGERP |var|) (|sequence?| |seq| #'INTEGERP)) + (COND + ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) + (LIST 'EQL |var| |x|)) + (T (LIST '|scalarMember?| |var| |seq|)))) + ((OR (|defQuoteId| |var|) (|sequence?| |seq| #'SYMBOLP)) + (COND + ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) + (LIST 'EQ |var| (|quote| |x|))) + (T (LIST '|symbolMember?| |var| |seq|)))) + ((|idList?| |seq|) + (COND + ((PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) + (CONS 'EQ (CONS |var| (CDR |seq|)))) + ((AND (SYMBOLP |var|) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |x| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) + (|bfOR| (LIST (LIST 'EQ |var| |x|) (LIST 'EQ |var| |y|)))) + (T (LIST '|symbolMember?| |var| |seq|)))) + ((OR (|bfChar?| |var|) (|sequence?| |seq| #'CHARACTERP)) + (COND + ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) + (LIST 'CHAR= |var| |x|)) + (T (LIST '|charMember?| |var| |seq|)))) + ((|charList?| |seq|) + (COND + ((PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) + (CONS 'CHAR= (CONS |var| (CDR |seq|)))) + ((AND (SYMBOLP |var|) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |x| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) + (|bfOR| (LIST (LIST 'CHAR= |var| |x|) (LIST 'CHAR= |var| |y|)))) + (T (LIST '|charMember?| |var| |seq|)))) + ((OR (|bfString?| |var|) (|sequence?| |seq| #'STRINGP)) + (COND + ((AND (CONSP |seq|) (EQ (CAR |seq|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) + (LIST 'STRING= |var| |x|)) + (T (LIST '|stringMember?| |var| |seq|)))) + ((|stringList?| |seq|) + (COND + ((PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))) + (CONS 'STRING= (CONS |var| (CDR |seq|)))) + ((AND (SYMBOLP |var|) + (PROGN + (SETQ |ISTMP#1| (CDR |seq|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |x| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |y| (CAR |ISTMP#2|)) T)))))) + (|bfOR| (LIST (LIST 'STRING= |var| |x|) (LIST 'STRING= |var| |y|)))) + (T (LIST '|stringMember?| |var| |seq|)))) + (T (LIST 'MEMBER |var| |seq|)))))) (DEFUN |bfInfApplication| (|op| |left| |right|) - (COND - ((EQ |op| 'EQUAL) (|bfQ| |left| |right|)) - ((EQ |op| '/=) (|bfNOT| (|bfQ| |left| |right|))) - ((EQ |op| '>) (|bfLessp| |right| |left|)) - ((EQ |op| '<) (|bfLessp| |left| |right|)) - ((EQ |op| '<=) (|bfNOT| (|bfLessp| |right| |left|))) - ((EQ |op| '>=) (|bfNOT| (|bfLessp| |left| |right|))) - ((EQ |op| 'OR) (|bfOR| (LIST |left| |right|))) - ((EQ |op| 'AND) (|bfAND| (LIST |left| |right|))) - ((EQ |op| 'IN) (|bfMember| |left| |right|)) - (T (LIST |op| |left| |right|)))) + (COND ((EQ |op| 'EQUAL) (|bfQ| |left| |right|)) + ((EQ |op| '/=) (|bfNOT| (|bfQ| |left| |right|))) + ((EQ |op| '>) (|bfLessp| |right| |left|)) + ((EQ |op| '<) (|bfLessp| |left| |right|)) + ((EQ |op| '<=) (|bfNOT| (|bfLessp| |right| |left|))) + ((EQ |op| '>=) (|bfNOT| (|bfLessp| |left| |right|))) + ((EQ |op| 'OR) (|bfOR| (LIST |left| |right|))) + ((EQ |op| 'AND) (|bfAND| (LIST |left| |right|))) + ((EQ |op| 'IN) (|bfMember| |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|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) - |a|) - ((AND (CONSP |x|) (EQ (CAR |x|) 'NULL) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) - |a|) - (T (LIST 'NOT |x|)))))) + (COND + ((AND (CONSP |x|) (EQ (CAR |x|) 'NOT) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + |a|) + ((AND (CONSP |x|) (EQ (CAR |x|) 'NULL) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + |a|) + (T (LIST 'NOT |x|)))))) (DEFUN |bfFlatten| (|op| |x|) - (COND - ((AND (CONSP |x|) (EQUAL (CAR |x|) |op|)) (CDR |x|)) - (T (LIST |x|)))) + (COND ((AND (CONSP |x|) (EQUAL (CAR |x|) |op|)) (CDR |x|)) (T (LIST |x|)))) (DEFUN |bfOR| (|l|) - (COND - ((NULL |l|) NIL) - ((NULL (CDR |l|)) (CAR |l|)) - (T (CONS 'OR - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) - (|c| NIL)) - (LOOP - (COND + (COND ((NULL |l|) NIL) ((NULL (CDR |l|)) (CAR |l|)) + (T + (CONS 'OR + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) (|c| NIL)) + (LOOP + (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |c| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (LET ((|bfVar#4| - (|copyList| (|bfFlatten| 'OR |c|)))) - (COND - ((NULL |bfVar#4|) NIL) - ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) - (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) - (T (RPLACD |bfVar#3| |bfVar#4|) + (T + (LET ((|bfVar#4| (|copyList| (|bfFlatten| 'OR |c|)))) + (COND ((NULL |bfVar#4|) NIL) + ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) + (T (RPLACD |bfVar#3| |bfVar#4|) (SETQ |bfVar#3| (|lastNode| |bfVar#3|))))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) (DEFUN |bfAND| (|l|) - (COND - ((NULL |l|) T) - ((NULL (CDR |l|)) (CAR |l|)) - (T (CONS 'AND - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) - (|c| NIL)) - (LOOP - (COND + (COND ((NULL |l|) T) ((NULL (CDR |l|)) (CAR |l|)) + (T + (CONS 'AND + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) (|c| NIL)) + (LOOP + (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |c| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (LET ((|bfVar#4| - (|copyList| (|bfFlatten| 'AND |c|)))) - (COND - ((NULL |bfVar#4|) NIL) - ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) - (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) - (T (RPLACD |bfVar#3| |bfVar#4|) + (T + (LET ((|bfVar#4| (|copyList| (|bfFlatten| 'AND |c|)))) + (COND ((NULL |bfVar#4|) NIL) + ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) + (T (RPLACD |bfVar#3| |bfVar#4|) (SETQ |bfVar#3| (|lastNode| |bfVar#3|))))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) (DEFUN |defQuoteId| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|)))) (DEFUN |bfChar?| (|x|) (OR (CHARACTERP |x|) - (AND (CONSP |x|) - (|symbolMember?| (CAR |x|) '(|char| CODE-CHAR SCHAR))))) + (AND (CONSP |x|) (|symbolMember?| (CAR |x|) '(|char| CODE-CHAR SCHAR))))) (DEFUN |bfSmintable| (|x|) (OR (INTEGERP |x|) (AND (CONSP |x|) - (|symbolMember?| (CAR |x|) - '(SIZE LENGTH CHAR-CODE MAXINDEX + -))))) + (|symbolMember?| (CAR |x|) '(SIZE LENGTH CHAR-CODE MAXINDEX + -))))) (DEFUN |bfString?| (|x|) (OR (STRINGP |x|) (AND (CONSP |x|) - (|symbolMember?| (CAR |x|) - '(STRING SYMBOL-NAME |subString|))))) + (|symbolMember?| (CAR |x|) '(STRING SYMBOL-NAME |subString|))))) (DEFUN |bfQ| (|l| |r|) - (COND - ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|)) - ((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|)) - ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|)) - ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING= |l| |r|)) - ((OR (EQ |l| '|%nothing|) (EQ |r| '|%nothing|)) (LIST 'EQ |l| |r|)) - (T (LIST 'EQUAL |l| |r|)))) + (COND ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|)) + ((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|)) + ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|)) + ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING= |l| |r|)) + ((OR (EQ |l| '|%nothing|) (EQ |r| '|%nothing|)) (LIST 'EQ |l| |r|)) + (T (LIST 'EQUAL |l| |r|)))) (DEFUN |bfLessp| (|l| |r|) - (COND - ((EQL |l| 0) (LIST 'PLUSP |r|)) - ((EQL |r| 0) (LIST 'MINUSP |l|)) - ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|)) - ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING< |l| |r|)) - (T (LIST '< |l| |r|)))) + (COND ((EQL |l| 0) (LIST 'PLUSP |r|)) ((EQL |r| 0) (LIST 'MINUSP |l|)) + ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR< |l| |r|)) + ((OR (|bfString?| |l|) (|bfString?| |r|)) (LIST 'STRING< |l| |r|)) + (T (LIST '< |l| |r|)))) (DEFUN |bfLambda| (|vars| |body|) (PROGN - (SETQ |vars| - (COND ((|bfTupleP| |vars|) (CDR |vars|)) (T (LIST |vars|)))) - (LIST 'LAMBDA |vars| |body|))) + (SETQ |vars| (COND ((|bfTupleP| |vars|) (CDR |vars|)) (T (LIST |vars|)))) + (LIST 'LAMBDA |vars| |body|))) (DEFUN |bfMDef| (|op| |args| |body|) - (PROG (|def| |lamex| |sb2| |sb| |largl| |nargl| |sgargl| |gargl| - |LETTMP#1| |argl|) + (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#3| NIL) (|bfVar#4| NIL) (|bfVar#1| |nargl|) - (|i| NIL) (|bfVar#2| |sgargl|) (|j| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL) - (NOT (CONSP |bfVar#2|)) - (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL)) - (RETURN |bfVar#3|)) - ((NULL |bfVar#3|) - (SETQ |bfVar#3| #1=(CONS (CONS |i| |j|) NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #1#) - (SETQ |bfVar#4| (CDR |bfVar#4|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)) - (SETQ |bfVar#2| (CDR |bfVar#2|))))) - (SETQ |body| (|applySubst| |sb| |body|)) - (SETQ |sb2| - (LET ((|bfVar#7| NIL) (|bfVar#8| NIL) - (|bfVar#5| |sgargl|) (|i| NIL) (|bfVar#6| |largl|) + (PROGN + (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) + (SETQ |LETTMP#1| (|bfGargl| |argl|)) + (SETQ |gargl| (CAR |LETTMP#1|)) + (SETQ |sgargl| (CADR . #1=(|LETTMP#1|))) + (SETQ |nargl| (CADDR . #1#)) + (SETQ |largl| (CADDDR . #1#)) + (SETQ |sb| + (LET ((|bfVar#3| NIL) + (|bfVar#4| NIL) + (|bfVar#1| |nargl|) + (|i| NIL) + (|bfVar#2| |sgargl|) (|j| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#5|)) - (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL) - (NOT (CONSP |bfVar#6|)) - (PROGN (SETQ |j| (CAR |bfVar#6|)) NIL)) - (RETURN |bfVar#7|)) - ((NULL |bfVar#7|) - (SETQ |bfVar#7| - #2=(CONS (LIST 'CONS (|quote| |i|) |j|) NIL)) - (SETQ |bfVar#8| |bfVar#7|)) - (T (RPLACD |bfVar#8| #2#) - (SETQ |bfVar#8| (CDR |bfVar#8|)))) - (SETQ |bfVar#5| (CDR |bfVar#5|)) - (SETQ |bfVar#6| (CDR |bfVar#6|))))) - (SETQ |body| - (LIST '|applySubst| (CONS 'LIST |sb2|) (|quote| |body|))) - (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) - (SETQ |def| (LIST |op| |lamex|)) - (CONS (|shoeComp| |def|) - (LET ((|bfVar#10| NIL) (|bfVar#11| NIL) - (|bfVar#9| |$wheredefs|) (|d| NIL)) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL) + (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL)) + (RETURN |bfVar#3|)) + ((NULL |bfVar#3|) + (SETQ |bfVar#3| #2=(CONS (CONS |i| |j|) NIL)) + (SETQ |bfVar#4| |bfVar#3|)) + (T (RPLACD |bfVar#4| #2#) (SETQ |bfVar#4| (CDR |bfVar#4|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)) + (SETQ |bfVar#2| (CDR |bfVar#2|))))) + (SETQ |body| (|applySubst| |sb| |body|)) + (SETQ |sb2| + (LET ((|bfVar#7| NIL) + (|bfVar#8| NIL) + (|bfVar#5| |sgargl|) + (|i| NIL) + (|bfVar#6| |largl|) + (|j| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#9|)) - (PROGN (SETQ |d| (CAR |bfVar#9|)) NIL)) - (RETURN |bfVar#10|)) - (T (LET ((|bfVar#12| - (|copyList| - (|shoeComps| (|bfDef1| |d|))))) - (COND - ((NULL |bfVar#12|) NIL) - ((NULL |bfVar#10|) - (SETQ |bfVar#10| |bfVar#12|) - (SETQ |bfVar#11| (|lastNode| |bfVar#10|))) - (T (RPLACD |bfVar#11| |bfVar#12|) - (SETQ |bfVar#11| (|lastNode| |bfVar#11|))))))) - (SETQ |bfVar#9| (CDR |bfVar#9|))))))))) + (COND + ((OR (NOT (CONSP |bfVar#5|)) + (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL) + (NOT (CONSP |bfVar#6|)) + (PROGN (SETQ |j| (CAR |bfVar#6|)) NIL)) + (RETURN |bfVar#7|)) + ((NULL |bfVar#7|) + (SETQ |bfVar#7| + #3=(CONS (LIST 'CONS (|quote| |i|) |j|) NIL)) + (SETQ |bfVar#8| |bfVar#7|)) + (T (RPLACD |bfVar#8| #3#) (SETQ |bfVar#8| (CDR |bfVar#8|)))) + (SETQ |bfVar#5| (CDR |bfVar#5|)) + (SETQ |bfVar#6| (CDR |bfVar#6|))))) + (SETQ |body| (LIST '|applySubst| (CONS 'LIST |sb2|) (|quote| |body|))) + (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) + (SETQ |def| (LIST |op| |lamex|)) + (CONS (|shoeComp| |def|) + (LET ((|bfVar#10| NIL) + (|bfVar#11| NIL) + (|bfVar#9| |$wheredefs|) + (|d| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#9|)) + (PROGN (SETQ |d| (CAR |bfVar#9|)) NIL)) + (RETURN |bfVar#10|)) + (T + (LET ((|bfVar#12| (|copyList| (|shoeComps| (|bfDef1| |d|))))) + (COND ((NULL |bfVar#12|) NIL) + ((NULL |bfVar#10|) (SETQ |bfVar#10| |bfVar#12|) + (SETQ |bfVar#11| (|lastNode| |bfVar#10|))) + (T (RPLACD |bfVar#11| |bfVar#12|) + (SETQ |bfVar#11| (|lastNode| |bfVar#11|))))))) + (SETQ |bfVar#9| (CDR |bfVar#9|))))))))) (DEFUN |bfGargl| (|argl|) (PROG (|f| |d| |c| |b| |a| |LETTMP#1|) (RETURN - (COND - ((NULL |argl|) (LIST NIL NIL NIL NIL)) - (T (SETQ |LETTMP#1| (|bfGargl| (CDR |argl|))) - (SETQ |a| (CAR |LETTMP#1|)) - (SETQ |b| (CADR . #0=(|LETTMP#1|))) (SETQ |c| (CADDR . #0#)) - (SETQ |d| (CADDDR . #0#)) - (COND + (COND ((NULL |argl|) (LIST NIL NIL NIL NIL)) + (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 (|quote| 'LIST) (CAR |d|)) - (CDR |d|)))) + (CONS (LIST 'CONS (|quote| 'LIST) (CAR |d|)) (CDR |d|)))) (T (SETQ |f| (|bfGenSymbol|)) - (LIST (CONS |f| |a|) (CONS |f| |b|) - (CONS (CAR |argl|) |c|) (CONS |f| |d|))))))))) + (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|) + (CONS |f| |d|))))))))) (DEFUN |bfDef1| (|bfVar#1|) - (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| - |op|) - (RETURN - (PROGN - (SETQ |op| (CAR |bfVar#1|)) - (SETQ |args| (CADR . #0=(|bfVar#1|))) - (SETQ |body| (CADDR . #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|))))))))) + (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op|) + (RETURN + (PROGN + (SETQ |op| (CAR |bfVar#1|)) + (SETQ |args| (CADR . #1=(|bfVar#1|))) + (SETQ |body| (CADDR . #1#)) + (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) + (SETQ |LETTMP#1| (|bfInsertLet| |argl| |body|)) + (SETQ |quotes| (CAR |LETTMP#1|)) + (SETQ |control| (CADR . #2=(|LETTMP#1|))) + (SETQ |arglp| (CADDR . #2#)) + (SETQ |body| (CADDDR . #2#)) + (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 (SYMBOL-NAME |op|) ",LAM"))) - (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) - (LIST |op| - (LIST 'MLAMBDA (LIST '&REST |margs|) - (LIST 'CONS (|quote| |innerfunc|) - (LIST 'WRAP |margs| - (|quote| |control|)))))))))) + (PROGN + (SETQ |margs| (|bfGenSymbol|)) + (SETQ |innerfunc| (INTERN (CONCAT (SYMBOL-NAME |op|) ",LAM"))) + (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) + (LIST |op| + (LIST 'MLAMBDA (LIST '&REST |margs|) + (LIST 'CONS (|quote| |innerfunc|) + (LIST 'WRAP |margs| (|quote| |control|)))))))))) (DEFUN |bfDef| (|op| |args| |body|) (PROG (|body1| |arg1| |op1| |LETTMP#1|) - (DECLARE (SPECIAL |$wheredefs| |$bfClamming|)) + (DECLARE (SPECIAL |$bfClamming| |$wheredefs|)) (RETURN - (COND - (|$bfClamming| - (SETQ |LETTMP#1| - (|shoeComp| - (CAR (|bfDef1| (LIST |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#2| NIL) (|bfVar#3| NIL) - (|bfVar#1| - (CONS (LIST |op| |args| |body|) |$wheredefs|)) - (|d| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (LET ((|bfVar#4| - (|copyList| - (|shoeComps| (|bfDef1| |d|))))) - (COND - ((NULL |bfVar#4|) NIL) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| |bfVar#4|) - (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) - (T (RPLACD |bfVar#3| |bfVar#4|) - (SETQ |bfVar#3| (|lastNode| |bfVar#3|))))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))))))) + (COND + (|$bfClamming| + (SETQ |LETTMP#1| + (|shoeComp| (CAR (|bfDef1| (LIST |op| |args| |body|))))) + (SETQ |op1| (CADR . #1=(|LETTMP#1|))) (SETQ |arg1| (CADDR . #1#)) + (SETQ |body1| (CDDDR . #1#)) (|bfCompHash| |op1| |arg1| |body1|)) + (T + (|bfTuple| + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| (CONS (LIST |op| |args| |body|) |$wheredefs|)) + (|d| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T + (LET ((|bfVar#4| (|copyList| (|shoeComps| (|bfDef1| |d|))))) + (COND ((NULL |bfVar#4|) NIL) + ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) + (T (RPLACD |bfVar#3| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#3|))))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))))) (DEFUN |shoeComps| (|x|) (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |x|) (|def| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |def| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| #0=(CONS (|shoeComp| |def|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (COND + ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |def| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (|shoeComp| |def|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) (DEFUN |shoeComp| (|x|) (PROG (|a|) (RETURN - (PROGN - (SETQ |a| (|shoeCompTran| (CADR |x|))) - (COND - ((AND (CONSP |a|) (EQ (CAR |a|) 'LAMBDA)) - (CONS 'DEFUN (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|))))) - (T (CONS 'DEFMACRO - (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|)))))))))) + (PROGN + (SETQ |a| (|shoeCompTran| (CADR |x|))) + (COND + ((AND (CONSP |a|) (EQ (CAR |a|) 'LAMBDA)) + (CONS 'DEFUN (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|))))) + (T (CONS 'DEFMACRO (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|)))))))))) (DEFUN |bfParameterList| (|p1| |p2|) - (COND - ((AND (NULL |p2|) (CONSP |p1|)) |p1|) - ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL)) - (COND - ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))) - (|bpSpecificErrorHere| "default value required")) - (T (CONS (CAR |p1|) (|append| (CDR |p1|) (CDR |p2|)))))) - ((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)) - (CONS |p1| (CONS (CAR |p2|) (CDR |p2|)))) - (T (CONS |p1| |p2|)))) + (COND ((AND (NULL |p2|) (CONSP |p1|)) |p1|) + ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL)) + (COND + ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))) + (|bpSpecificErrorHere| "default value required")) + (T (CONS (CAR |p1|) (|append| (CDR |p1|) (CDR |p2|)))))) + ((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)) + (CONS |p1| (CONS (CAR |p2|) (CDR |p2|)))) + (T (CONS |p1| |p2|)))) (DEFUN |bfInsertLet| (|x| |body|) - (PROG (|body2| |name2| |norq1| |b1| |body1| |name1| |norq| |LETTMP#1| - |b| |a| |ISTMP#1|) + (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|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) - (COND - ((AND (CONSP |a|) (EQ (CAR |a|) 'QUOTE) + (COND ((NULL |x|) (LIST NIL NIL |x| |body|)) + ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) (PROGN - (SETQ |ISTMP#1| (CDR |a|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) - (LIST T 'QUOTE (LIST '&REST |b|) |body|)) - (T (LIST NIL NIL |x| |body|)))) - (T (SETQ |LETTMP#1| (|bfInsertLet1| (CAR |x|) |body|)) - (SETQ |b| (CAR |LETTMP#1|)) - (SETQ |norq| (CADR . #0=(|LETTMP#1|))) - (SETQ |name1| (CADDR . #0#)) (SETQ |body1| (CADDDR . #0#)) - (SETQ |LETTMP#1| (|bfInsertLet| (CDR |x|) |body1|)) - (SETQ |b1| (CAR |LETTMP#1|)) - (SETQ |norq1| (CADR . #1=(|LETTMP#1|))) - (SETQ |name2| (CADDR . #1#)) (SETQ |body2| (CADDDR . #1#)) - (LIST (OR |b| |b1|) (CONS |norq| |norq1|) - (|bfParameterList| |name1| |name2|) |body2|)))))) + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) + (COND + ((AND (CONSP |a|) (EQ (CAR |a|) 'QUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |a|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) + (LIST T 'QUOTE (LIST '&REST |b|) |body|)) + (T (LIST NIL NIL |x| |body|)))) + (T (SETQ |LETTMP#1| (|bfInsertLet1| (CAR |x|) |body|)) + (SETQ |b| (CAR |LETTMP#1|)) (SETQ |norq| (CADR . #1=(|LETTMP#1|))) + (SETQ |name1| (CADDR . #1#)) (SETQ |body1| (CADDDR . #1#)) + (SETQ |LETTMP#1| (|bfInsertLet| (CDR |x|) |body1|)) + (SETQ |b1| (CAR |LETTMP#1|)) + (SETQ |norq1| (CADR . #2=(|LETTMP#1|))) + (SETQ |name2| (CADDR . #2#)) (SETQ |body2| (CADDDR . #2#)) + (LIST (OR |b| |b1|) (CONS |norq| |norq1|) + (|bfParameterList| |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|) (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) - (LIST NIL NIL |l| - (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|)))) - ((SYMBOLP |y|) (LIST NIL NIL |y| |body|)) - ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE) - (PROGN - (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) - (LIST T 'QUOTE |b| |body|)) - (T (SETQ |g| (|bfGenSymbol|)) - (COND - ((NOT (CONSP |y|)) (LIST NIL NIL |g| |body|)) - (T (CASE (CAR |y|) - (|%DefaultValue| - (LET ((|p| (CADR |y|)) (|v| (CADDR |y|))) - (LIST NIL NIL (LIST '&OPTIONAL (LIST |p| |v|)) - |body|))) - (T (LIST NIL NIL |g| - (|bfMKPROGN| - (LIST (|bfLET| (|compFluidize| |y|) |g|) - |body|)))))))))))) + (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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) + (LIST NIL NIL |l| (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|)))) + ((SYMBOLP |y|) (LIST NIL NIL |y| |body|)) + ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE) + (PROGN + (SETQ |ISTMP#1| (CDR |y|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) + (LIST T 'QUOTE |b| |body|)) + (T (SETQ |g| (|bfGenSymbol|)) + (COND ((NOT (CONSP |y|)) (LIST NIL NIL |g| |body|)) + (T + (CASE (CAR |y|) + (|%DefaultValue| + (LET ((|p| (CADR |y|)) (|v| (CADDR |y|))) + (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| - |body'| |lvars| |body| |args| |lamtype|) - (DECLARE (SPECIAL |$typings| |$dollarVars| |$fluidVars| |$locVars|)) - (RETURN - (PROGN - (SETQ |lamtype| (CAR |x|)) - (SETQ |args| (CADR . #0=(|x|))) - (SETQ |body| (CDDR . #0#)) - (SETQ |$fluidVars| NIL) - (SETQ |$locVars| NIL) - (SETQ |$dollarVars| NIL) - (|shoeCompTran1| |body|) - (SETQ |$locVars| - (|setDifference| - (|setDifference| |$locVars| |$fluidVars|) - (|shoeATOMs| |args|))) - (SETQ |body| + (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars| |body'| + |lvars| |body| |args| |lamtype|) + (DECLARE (SPECIAL |$typings| |$dollarVars| |$locVars| |$fluidVars|)) + (RETURN + (PROGN + (SETQ |lamtype| (CAR |x|)) + (SETQ |args| (CADR . #1=(|x|))) + (SETQ |body| (CDDR . #1#)) + (SETQ |$fluidVars| NIL) + (SETQ |$locVars| NIL) + (SETQ |$dollarVars| NIL) + (|shoeCompTran1| |body|) + (SETQ |$locVars| + (|setDifference| (|setDifference| |$locVars| |$fluidVars|) + (|shoeATOMs| |args|))) + (SETQ |body| (PROGN - (SETQ |lvars| (|append| |$fluidVars| |$locVars|)) - (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|)) - (SETQ |body'| |body|) - (COND - (|$typings| - (SETQ |body'| - (CONS (CONS 'DECLARE |$typings|) |body'|)))) - (COND - (|$fluidVars| - (SETQ |fvars| - (LIST 'DECLARE - (CONS 'SPECIAL |$fluidVars|))) - (SETQ |body'| (CONS |fvars| |body'|)))) - (COND - ((OR |lvars| (|needsPROG| |body|)) - (|shoePROG| |lvars| |body'|)) - (T |body'|)))) - (SETQ |fl| (|shoeFluids| |args|)) - (SETQ |body| + (SETQ |lvars| (|append| |$fluidVars| |$locVars|)) + (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|)) + (SETQ |body'| |body|) + (COND + (|$typings| + (SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|)))) + (COND + (|$fluidVars| + (SETQ |fvars| (LIST 'DECLARE (CONS 'SPECIAL |$fluidVars|))) + (SETQ |body'| (CONS |fvars| |body'|)))) + (COND + ((OR |lvars| (|needsPROG| |body|)) + (|shoePROG| |lvars| |body'|)) + (T |body'|)))) + (SETQ |fl| (|shoeFluids| |args|)) + (SETQ |body| (COND - (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|))) - (CONS |fvs| |body|)) - (T |body|))) - (CONS |lamtype| (CONS |args| |body|)))))) + (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|))) + (CONS |fvs| |body|)) + (T |body|))) + (CONS |lamtype| (CONS |args| |body|)))))) (DEFUN |needsPROG| (|body|) (PROG (|args| |op|) (RETURN - (COND - ((NOT (CONSP |body|)) NIL) - (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|)) - (COND - ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T) - ((|symbolMember?| |op| - '(LET PROG LOOP BLOCK DECLARE LAMBDA)) - NIL) - (T (LET ((|bfVar#2| NIL) (|bfVar#1| |body|) (|t| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |t| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (|needsPROG| |t|)) - (COND (|bfVar#2| (RETURN |bfVar#2|))))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))))))))) + (COND ((NOT (CONSP |body|)) NIL) + (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|)) + (COND ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T) + ((|symbolMember?| |op| + '(LET PROG + LOOP + BLOCK + DECLARE + LAMBDA)) + NIL) + (T + (LET ((|bfVar#2| NIL) (|bfVar#1| |body|) (|t| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |t| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + (T (SETQ |bfVar#2| (|needsPROG| |t|)) + (COND (|bfVar#2| (RETURN |bfVar#2|))))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))))))))) (DEFUN |shoePROG| (|v| |b|) (PROG (|blist| |blast| |LETTMP#1|) (RETURN - (COND - ((NULL |b|) (LIST (LIST 'PROG |v|))) - (T (SETQ |LETTMP#1| (|reverse| |b|)) - (SETQ |blast| (CAR |LETTMP#1|)) - (SETQ |blist| (|reverse!| (CDR |LETTMP#1|))) - (LIST (CONS 'PROG - (CONS |v| - (|append| |blist| - (CONS (LIST 'RETURN |blast|) NIL)))))))))) + (COND ((NULL |b|) (LIST (LIST 'PROG |v|))) + (T (SETQ |LETTMP#1| (|reverse| |b|)) (SETQ |blast| (CAR |LETTMP#1|)) + (SETQ |blist| (|reverse!| (CDR |LETTMP#1|))) + (LIST + (CONS 'PROG + (CONS |v| + (|append| |blist| + (CONS (LIST 'RETURN |blast|) NIL)))))))))) (DEFUN |shoeFluids| (|x|) - (COND - ((AND (|ident?| |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) - ((|atomic?| |x|) NIL) - (T (|append| (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|)))))) + (COND ((AND (|ident?| |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) + ((|atomic?| |x|) NIL) + (T (|append| (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|)))))) (DEFUN |shoeATOMs| (|x|) - (COND - ((|ident?| |x|) (LIST |x|)) - ((|atomic?| |x|) NIL) - (T (|append| (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|)))))) + (COND ((|ident?| |x|) (LIST |x|)) ((|atomic?| |x|) NIL) + (T (|append| (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|)))))) (DEFUN |isDynamicVariable| (|x|) (PROG (|y|) - (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|)) + (DECLARE (SPECIAL |$constantIdentifiers| |$activeNamespace|)) (RETURN - (COND - ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) - (COND - ((|symbolMember?| |x| |$constantIdentifiers|) NIL) - ((CONSTANTP |x|) NIL) - ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) - ((SETQ |y| - (FIND-SYMBOL (SYMBOL-NAME |x|) |$activeNamespace|)) - (NOT (CONSTANTP |y|))) - (T T))) - (T NIL))))) + (COND + ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) + (COND ((|symbolMember?| |x| |$constantIdentifiers|) NIL) + ((CONSTANTP |x|) NIL) + ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) + ((SETQ |y| (FIND-SYMBOL (SYMBOL-NAME |x|) |$activeNamespace|)) + (NOT (CONSTANTP |y|))) + (T T))) + (T NIL))))) (DEFUN |shoeCompTran1| (|x|) - (PROG (|n| |elts| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| - U) - (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|)) + (PROG (|n| |elts| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| U) + (DECLARE (SPECIAL |$dollarVars| |$locVars| |$fluidVars|)) (RETURN - (COND - ((NOT (CONSP |x|)) - (COND - ((AND (|isDynamicVariable| |x|) - (NOT (|symbolMember?| |x| |$dollarVars|))) - (SETQ |$dollarVars| (CONS |x| |$dollarVars|)))) - |x|) - (T (SETQ U (CAR |x|)) - (COND - ((EQ U 'QUOTE) |x|) + (COND + ((NOT (CONSP |x|)) + (COND + ((AND (|isDynamicVariable| |x|) + (NOT (|symbolMember?| |x| |$dollarVars|))) + (SETQ |$dollarVars| (CONS |x| |$dollarVars|)))) + |x|) + (T (SETQ U (CAR |x|)) + (COND ((EQ U 'QUOTE) |x|) ((AND (CONSP |x|) (EQ (CAR |x|) 'CASE) (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |y| (CAR |ISTMP#1|)) - (SETQ |zs| (CDR |ISTMP#1|)) - T)))) + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |y| (CAR |ISTMP#1|)) + (SETQ |zs| (CDR |ISTMP#1|)) + T)))) (SETF (CADR |x|) (|shoeCompTran1| |y|)) (LOOP - (COND - ((NOT |zs|) (RETURN NIL)) - (T (SETF (CADR (CAR |zs|)) - (|shoeCompTran1| (CADR (CAR |zs|)))) - (SETQ |zs| (CDR |zs|))))) + (COND ((NOT |zs|) (RETURN NIL)) + (T + (SETF (CADR (CAR |zs|)) + (|shoeCompTran1| (CADR (CAR |zs|)))) + (SETQ |zs| (CDR |zs|))))) |x|) ((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|) - (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) - (RPLACA |x| 'SETQ) - (SETF (CADDR |x|) (|shoeCompTran1| |r|)) + (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|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) + (RPLACA |x| 'SETQ) (SETF (CADDR |x|) (|shoeCompTran1| |r|)) (COND - ((SYMBOLP |l|) - (COND - ((|bfBeginsDollar| |l|) - (COND - ((NOT (|symbolMember?| |l| |$dollarVars|)) - (SETQ |$dollarVars| (CONS |l| |$dollarVars|)))) - |x|) - (T (COND - ((NOT (|symbolMember?| |l| |$locVars|)) - (SETQ |$locVars| (CONS |l| |$locVars|)))) - |x|))) - ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID)) - (COND - ((NOT (|symbolMember?| (CADR |l|) |$fluidVars|)) - (SETQ |$fluidVars| (CONS (CADR |l|) |$fluidVars|)))) - (RPLACA (CDR |x|) (CADR |l|)) |x|))) + ((SYMBOLP |l|) + (COND + ((|bfBeginsDollar| |l|) + (COND + ((NOT (|symbolMember?| |l| |$dollarVars|)) + (SETQ |$dollarVars| (CONS |l| |$dollarVars|)))) + |x|) + (T + (COND + ((NOT (|symbolMember?| |l| |$locVars|)) + (SETQ |$locVars| (CONS |l| |$locVars|)))) + |x|))) + ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID)) + (COND + ((NOT (|symbolMember?| (CADR |l|) |$fluidVars|)) + (SETQ |$fluidVars| (CONS (CADR |l|) |$fluidVars|)))) + (RPLACA (CDR |x|) (CADR |l|)) |x|))) ((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|) - ((|symbolMember?| U '(PROG LAMBDA)) - (SETQ |newbindings| NIL) + ((|symbolMember?| U '(PROG LAMBDA)) (SETQ |newbindings| NIL) (LET ((|bfVar#1| (CADR |x|)) (|y| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL)) - (RETURN NIL)) - ((NOT (|symbolMember?| |y| |$locVars|)) - (IDENTITY - (PROGN - (SETQ |$locVars| (CONS |y| |$locVars|)) - (SETQ |newbindings| - (CONS |y| |newbindings|)))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL)) + (RETURN NIL)) + ((NOT (|symbolMember?| |y| |$locVars|)) + (IDENTITY + (PROGN + (SETQ |$locVars| (CONS |y| |$locVars|)) + (SETQ |newbindings| (CONS |y| |newbindings|)))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) (RPLACD (CDR |x|) (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| - (LET ((|bfVar#3| NIL) (|bfVar#4| NIL) - (|bfVar#2| |$locVars|) (|y| NIL)) - (LOOP - (COND + (LET ((|bfVar#3| NIL) + (|bfVar#4| NIL) + (|bfVar#2| |$locVars|) + (|y| NIL)) + (LOOP + (COND ((OR (NOT (CONSP |bfVar#2|)) (PROGN (SETQ |y| (CAR |bfVar#2|)) NIL)) (RETURN |bfVar#3|)) - (T (AND (NOT (|symbolMember?| |y| - |newbindings|)) - (COND - ((NULL |bfVar#3|) - (SETQ |bfVar#3| #0=(CONS |y| NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #0#) - (SETQ |bfVar#4| (CDR |bfVar#4|))))))) - (SETQ |bfVar#2| (CDR |bfVar#2|))))) + (T + (AND (NOT (|symbolMember?| |y| |newbindings|)) + (COND + ((NULL |bfVar#3|) + (SETQ |bfVar#3| #1=(CONS |y| NIL)) + (SETQ |bfVar#4| |bfVar#3|)) + (T (RPLACD |bfVar#4| #1#) + (SETQ |bfVar#4| (CDR |bfVar#4|))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|))))) |x|) ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|) (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |elts| (CAR |ISTMP#1|)) T)))) - (RPLACA |x| 'VECTOR) - (COND - ((EQ |elts| 'NIL) (RPLACD |x| NIL)) - (T (RPLACD |x| (|shoeCompTran1| (CDR |elts|))))) + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |elts| (CAR |ISTMP#1|)) T)))) + (COND ((EQ |elts| 'NIL) (RPLACA |x| 'VECTOR) (RPLACD |x| NIL)) + ((AND (CONSP |elts|) (EQ (CAR |elts|) 'LIST)) + (RPLACA |x| 'VECTOR) + (RPLACD |x| (|shoeCompTran1| (CDR |elts|)))) + ((NOT (CONSP |elts|)) + (SETQ |elts| (|shoeCompTran1| |elts|)) + (RPLACA |x| 'MAKE-ARRAY) + (RPLACD |x| + (LIST (LIST 'LIST-LENGTH |elts|) :INITIAL-CONTENTS + |elts|))) + (T (RPLACA |x| 'COERCE) + (RPLACD |x| + (LIST (|shoeCompTran1| |elts|) + (|quote| 'VECTOR))))) |x|) ((AND (CONSP |x|) (EQ (CAR |x|) '|%Namespace|) (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |n| (CAR |ISTMP#1|)) T)))) - (COND - ((EQ |n| 'DOT) '*PACKAGE*) - (T (LIST 'FIND-PACKAGE (SYMBOL-NAME |n|))))) + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |n| (CAR |ISTMP#1|)) T)))) + (COND ((EQ |n| 'DOT) '*PACKAGE*) + (T (LIST 'FIND-PACKAGE (SYMBOL-NAME |n|))))) (T (RPLACA |x| (|shoeCompTran1| (CAR |x|))) - (RPLACD |x| (|shoeCompTran1| (CDR |x|))) |x|))))))) + (RPLACD |x| (|shoeCompTran1| (CDR |x|))) |x|))))))) (DEFUN |bfTagged| (|a| |b|) - (DECLARE (SPECIAL |$typings| |$op|)) - (COND - ((NULL |$op|) (|%Signature| |a| |b|)) - ((SYMBOLP |a|) - (COND - ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL)) - ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL)) - (T (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|)) |a|))) - (T (LIST 'THE |b| |a|)))) + (DECLARE (SPECIAL |$op| |$typings|)) + (COND ((NULL |$op|) (|%Signature| |a| |b|)) + ((SYMBOLP |a|) + (COND ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL)) + ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL)) + (T (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|)) + |a|))) + (T (LIST 'THE |b| |a|)))) (DEFUN |bfAssign| (|l| |r|) (PROG (|l'|) (RETURN - (COND - ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) - ((AND (CONSP |l|) (EQ (CAR |l|) '|%Place|)) - (SETQ |l'| (CDR |l|)) (LIST 'SETF |l'| |r|)) - (T (|bfLET| |l| |r|)))))) + (COND ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) + ((AND (CONSP |l|) (EQ (CAR |l|) '|%Place|)) (SETQ |l'| (CDR |l|)) + (LIST 'SETF |l'| |r|)) + (T (|bfLET| |l| |r|)))))) (DEFUN |bfSetelt| (|e| |l| |r|) - (COND - ((NULL (CDR |l|)) (|defSETELT| |e| (CAR |l|) |r|)) - (T (|bfSetelt| (|bfElt| |e| (CAR |l|)) (CDR |l|) |r|)))) + (COND ((NULL (CDR |l|)) (|defSETELT| |e| (CAR |l|) |r|)) + (T (|bfSetelt| (|bfElt| |e| (CAR |l|)) (CDR |l|) |r|)))) (DEFUN |bfElt| (|expr| |sel|) (PROG (|y|) (RETURN - (PROGN - (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION))) - (COND - (|y| (COND - ((INTEGERP |y|) (LIST 'ELT |expr| |y|)) - (T (LIST |y| |expr|)))) - (T (LIST 'ELT |expr| |sel|))))))) + (PROGN + (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION))) + (COND + (|y| + (COND ((INTEGERP |y|) (LIST 'ELT |expr| |y|)) (T (LIST |y| |expr|)))) + (T (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|)) - ((EQ |y| 'CAR) (LIST 'RPLACA |var| |expr|)) - ((EQ |y| 'CDR) (LIST 'RPLACD |var| |expr|)) - (T (LIST 'SETF (LIST |y| |var|) |expr|)))) - (T (LIST 'SETF (LIST 'ELT |var| |sel|) |expr|))))))) + (PROGN + (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION))) + (COND + (|y| + (COND ((INTEGERP |y|) (LIST 'SETF (LIST 'ELT |var| |y|) |expr|)) + ((EQ |y| 'CAR) (LIST 'RPLACA |var| |expr|)) + ((EQ |y| 'CDR) (LIST 'RPLACD |var| |expr|)) + (T (LIST 'SETF (LIST |y| |var|) |expr|)))) + (T (LIST 'SETF (LIST 'ELT |var| |sel|) |expr|))))))) (DEFUN |bfIfThenOnly| (|a| |b|) (PROG (|b1|) (RETURN - (PROGN - (SETQ |b1| - (COND - ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|)) - (T (LIST |b|)))) - (LIST 'COND (CONS |a| |b1|)))))) + (PROGN + (SETQ |b1| + (COND ((AND (CONSP |b|) (EQ (CAR |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 - ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|)) - (T (LIST |b|)))) - (COND - ((AND (CONSP |c|) (EQ (CAR |c|) 'COND)) - (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|)))) - (T (SETQ |c1| - (COND - ((AND (CONSP |c|) (EQ (CAR |c|) 'PROGN)) - (CDR |c|)) - (T (LIST |c|)))) - (LIST 'COND (CONS |a| |b1|) (CONS 'T |c1|)))))))) + (PROGN + (SETQ |b1| + (COND ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|)) + (T (LIST |b|)))) + (COND + ((AND (CONSP |c|) (EQ (CAR |c|) 'COND)) + (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|)))) + (T + (SETQ |c1| + (COND ((AND (CONSP |c|) (EQ (CAR |c|) 'PROGN)) (CDR |c|)) + (T (LIST |c|)))) + (LIST 'COND (CONS |a| |b1|) (CONS 'T |c1|)))))))) -(DEFUN |bfExit| (|a| |b|) - (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|)))) +(DEFUN |bfExit| (|a| |b|) (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|)))) (DEFUN |bfFlattenSeq| (|l|) (PROG (|xs| |x|) (RETURN - (COND - ((NULL |l|) |l|) - (T (SETQ |x| (CAR |l|)) (SETQ |xs| (CDR |l|)) - (COND + (COND ((NULL |l|) |l|) + (T (SETQ |x| (CAR |l|)) (SETQ |xs| (CDR |l|)) + (COND ((NOT (CONSP |x|)) (COND ((NULL |xs|) |l|) (T (|bfFlattenSeq| |xs|)))) - ((EQ (CAR |x|) 'PROGN) - (|bfFlattenSeq| (|append| (CDR |x|) |xs|))) + ((EQ (CAR |x|) 'PROGN) (|bfFlattenSeq| (|append| (CDR |x|) |xs|))) (T (CONS |x| (|bfFlattenSeq| |xs|))))))))) (DEFUN |bfMKPROGN| (|l|) (PROGN - (SETQ |l| (|bfFlattenSeq| |l|)) - (COND - ((NULL |l|) NIL) - ((AND (CONSP |l|) (NULL (CDR |l|))) (CAR |l|)) - (T (CONS 'PROGN |l|))))) + (SETQ |l| (|bfFlattenSeq| |l|)) + (COND ((NULL |l|) NIL) ((AND (CONSP |l|) (NULL (CDR |l|))) (CAR |l|)) + (T (CONS 'PROGN |l|))))) (DEFUN |bfWashCONDBranchBody| (|x|) (PROG (|y|) (RETURN - (COND - ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)) (SETQ |y| (CDR |x|)) - |y|) - (T (LIST |x|)))))) + (COND ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)) (SETQ |y| (CDR |x|)) |y|) + (T (LIST |x|)))))) (DEFUN |bfAlternative| (|a| |b|) - (PROG (|conds| |ISTMP#5| |stmt| |ISTMP#4| |ISTMP#3| |ISTMP#2| - |ISTMP#1|) + (PROG (|conds| |ISTMP#5| |stmt| |ISTMP#4| |ISTMP#3| |ISTMP#2| |ISTMP#1|) (RETURN - (COND - ((AND (CONSP |a|) (EQ (CAR |a|) 'AND) - (PROGN - (SETQ |ISTMP#1| (CDR |a|)) - (AND (CONSP |ISTMP#1|) - (PROGN (SETQ |ISTMP#2| (|reverse| |ISTMP#1|)) T) - (CONSP |ISTMP#2|) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) 'PROGN) - (PROGN - (SETQ |ISTMP#4| (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |stmt| (CAR |ISTMP#4|)) - (SETQ |ISTMP#5| (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (NULL (CDR |ISTMP#5|)) - (EQ (CAR |ISTMP#5|) 'T))))))) - (PROGN (SETQ |conds| (CDR |ISTMP#2|)) T) - (PROGN (SETQ |conds| (|reverse!| |conds|)) T)))) - (CONS (CONS 'AND |conds|) - (|bfWashCONDBranchBody| (|bfMKPROGN| (LIST |stmt| |b|))))) - (T (CONS |a| (|bfWashCONDBranchBody| |b|))))))) + (COND + ((AND (CONSP |a|) (EQ (CAR |a|) 'AND) + (PROGN + (SETQ |ISTMP#1| (CDR |a|)) + (AND (CONSP |ISTMP#1|) + (PROGN (SETQ |ISTMP#2| (|reverse| |ISTMP#1|)) T) + (CONSP |ISTMP#2|) + (PROGN + (SETQ |ISTMP#3| (CAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) (EQ (CAR |ISTMP#3|) 'PROGN) + (PROGN + (SETQ |ISTMP#4| (CDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (PROGN + (SETQ |stmt| (CAR |ISTMP#4|)) + (SETQ |ISTMP#5| (CDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) (NULL (CDR |ISTMP#5|)) + (EQ (CAR |ISTMP#5|) 'T))))))) + (PROGN (SETQ |conds| (CDR |ISTMP#2|)) T) + (PROGN (SETQ |conds| (|reverse!| |conds|)) T)))) + (CONS (CONS 'AND |conds|) + (|bfWashCONDBranchBody| (|bfMKPROGN| (LIST |stmt| |b|))))) + (T (CONS |a| (|bfWashCONDBranchBody| |b|))))))) (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) - (T (SETQ |transform| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) - (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL) - (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) + (PROG (|f| |aft| |before| |no| |transform| |b| |ISTMP#5| |ISTMP#4| |ISTMP#3| + |a| |ISTMP#2| |ISTMP#1|) + (RETURN + (COND ((NULL |l|) NIL) + (T + (SETQ |transform| + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| |l|) + (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL) + (NOT + (AND (CONSP |x|) (EQ (CAR |x|) 'COND) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN - (SETQ |ISTMP#2| - (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |a| - (CAR |ISTMP#2|)) - (SETQ |ISTMP#3| - (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (NULL (CDR |ISTMP#3|)) + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (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|) - (NULL - (CDR |ISTMP#5|)) + (SETQ |a| (CAR |ISTMP#2|)) + (SETQ |ISTMP#3| + (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (NULL (CDR |ISTMP#3|)) (PROGN - (SETQ |b| - (CAR |ISTMP#5|)) - T)))))))))))))) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|bfAlternative| |a| |b|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |no| (LENGTH |transform|)) - (SETQ |before| (|bfTake| |no| |l|)) - (SETQ |aft| (|bfDrop| |no| |l|)) - (COND + (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|) + (NULL + (CDR |ISTMP#5|)) + (PROGN + (SETQ |b| + (CAR + |ISTMP#5|)) + T)))))))))))))) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| + #1=(CONS (|bfAlternative| |a| |b|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) + (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |no| (LENGTH |transform|)) + (SETQ |before| (|bfTake| |no| |l|)) + (SETQ |aft| (|bfDrop| |no| |l|)) + (COND ((NULL |before|) (COND - ((AND (CONSP |l|) (NULL (CDR |l|))) - (SETQ |f| (CAR |l|)) - (COND - ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) - (|bfSequence| (CDR |f|))) - (T |f|))) - (T (|bfMKPROGN| - (LIST (CAR |l|) (|bfSequence| (CDR |l|))))))) + ((AND (CONSP |l|) (NULL (CDR |l|))) (SETQ |f| (CAR |l|)) + (COND + ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) + (|bfSequence| (CDR |f|))) + (T |f|))) + (T (|bfMKPROGN| (LIST (CAR |l|) (|bfSequence| (CDR |l|))))))) ((NULL |aft|) (CONS 'COND |transform|)) - (T (CONS 'COND - (|append| |transform| - (CONS (|bfAlternative| 'T - (|bfSequence| |aft|)) - NIL)))))))))) + (T + (CONS 'COND + (|append| |transform| + (CONS (|bfAlternative| 'T (|bfSequence| |aft|)) + NIL)))))))))) (DEFUN |bfWhere| (|context| |expr|) (PROG (|a| |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#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |defs|) + (PROGN + (SETQ |LETTMP#1| (|defSheepAndGoats| |context|)) + (SETQ |opassoc| (CAR |LETTMP#1|)) + (SETQ |defs| (CADR . #1=(|LETTMP#1|))) + (SETQ |nondefs| (CADDR . #1#)) + (SETQ |a| + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| |defs|) (|d| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #1=(CONS (LIST (CAR |d|) (CADR |d|) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| + #2=(CONS + (LIST (CAR |d|) (CADR |d|) (|bfSUBLIS| |opassoc| (CADDR |d|))) - NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #1#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |$wheredefs| (|append| |a| |$wheredefs|)) - (|bfMKPROGN| - (|bfSUBLIS| |opassoc| (|append!| |nondefs| (LIST |expr|)))))))) + NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #2#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |$wheredefs| (|append| |a| |$wheredefs|)) + (|bfMKPROGN| + (|bfSUBLIS| |opassoc| (|append!| |nondefs| (LIST |expr|)))))))) (DEFUN |bfCompHash| (|op| |argl| |body|) (PROG (|computeFunction| |auxfn|) (RETURN - (PROGN - (SETQ |auxfn| (INTERN (CONCAT (SYMBOL-NAME |op|) ";"))) - (SETQ |computeFunction| + (PROGN + (SETQ |auxfn| (INTERN (CONCAT (SYMBOL-NAME |op|) ";"))) + (SETQ |computeFunction| (CONS 'DEFUN (CONS |auxfn| (CONS |argl| |body|)))) - (|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|))))))) + (|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|))))))) (DEFUN |shoeCompileTimeEvaluation| (|x|) (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|)) (DEFUN |bfMain| (|auxfn| |op|) - (PROG (|defCode| |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 (SYMBOL-NAME |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| + (PROG (|defCode| |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 (SYMBOL-NAME |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| + (SETQ |mainFunction| (LIST 'DEFUN |op| |arg| |codeBody|)) + (SETQ |cacheType| '|hash-table|) + (SETQ |cacheResetCode| (LIST 'SETQ |cacheName| (LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL)))) - (SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|)) - (SETQ |cacheVector| + (SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|)) + (SETQ |cacheVector| (LIST |op| |cacheName| |cacheType| |cacheResetCode| |cacheCountCode|)) - (SETQ |defCode| + (SETQ |defCode| (LIST 'DEFPARAMETER |cacheName| (LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL)))) - (LIST |defCode| |mainFunction| - (LIST 'SETF - (LIST 'GET (|quote| |op|) (|quote| '|cacheInfo|)) - (|quote| |cacheVector|))))))) + (LIST |defCode| |mainFunction| + (LIST 'SETF (LIST 'GET (|quote| |op|) (|quote| '|cacheInfo|)) + (|quote| |cacheVector|))))))) (DEFUN |bfNamespace| (|x|) (LIST '|%Namespace| |x|)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfNameOnly|)) -(DEFUN |bfNameOnly| (|x|) - (COND ((EQ |x| '|t|) (LIST 'T)) (T (LIST |x|)))) +(DEFUN |bfNameOnly| (|x|) (COND ((EQ |x| '|t|) (LIST 'T)) (T (LIST |x|)))) -(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) (|%List| |%Form|)) - |bfNameArgs|)) +(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) (|%List| |%Form|)) |bfNameArgs|)) (DEFUN |bfNameArgs| (|x| |y|) (PROGN - (SETQ |y| - (COND - ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (CDR |y|)) - (T (LIST |y|)))) - (CONS |x| |y|))) + (SETQ |y| + (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (CDR |y|)) + (T (LIST |y|)))) + (CONS |x| |y|))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfCreateDef|)) (DEFUN |bfCreateDef| (|x|) (PROG (|a| |f|) (RETURN - (COND - ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) - (LIST 'DEFCONSTANT |f| (LIST 'LIST (|quote| |f|)))) - (T (SETQ |a| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) - (|bfVar#1| (CDR |x|)) (|i| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| #0=(CONS (|bfGenSymbol|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (LIST 'DEFUN (CAR |x|) |a| - (LIST 'CONS (|quote| (CAR |x|)) (CONS 'LIST |a|)))))))) + (COND + ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) + (LIST 'DEFCONSTANT |f| (LIST 'LIST (|quote| |f|)))) + (T + (SETQ |a| + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| (CDR |x|)) + (|i| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| #1=(CONS (|bfGenSymbol|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (LIST 'DEFUN (CAR |x|) |a| + (LIST 'CONS (|quote| (CAR |x|)) (CONS 'LIST |a|)))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Form|) |bfCaseItem|)) @@ -2264,245 +2220,216 @@ (DEFUN |bfCase| (|x| |y|) (PROG (|body| |g|) (RETURN - (PROGN - (SETQ |g| (COND ((NOT (CONSP |x|)) |x|) (T (|bfGenSymbol|)))) - (SETQ |body| - (CONS 'CASE - (CONS (LIST 'CAR |g|) (|bfCaseItems| |g| |y|)))) - (COND - ((EQ |g| |x|) |body|) - (T (LIST 'LET (LIST (LIST |g| |x|)) |body|))))))) + (PROGN + (SETQ |g| (COND ((NOT (CONSP |x|)) |x|) (T (|bfGenSymbol|)))) + (SETQ |body| (CONS 'CASE (CONS (LIST 'CAR |g|) (|bfCaseItems| |g| |y|)))) + (COND ((EQ |g| |x|) |body|) + (T (LIST 'LET (LIST (LIST |g| |x|)) |body|))))))) -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%List| |%Form|)) - (|%List| |%Form|)) - |bfCaseItems|)) +(DECLAIM + (FTYPE (FUNCTION (|%Thing| (|%List| |%Form|)) (|%List| |%Form|)) + |bfCaseItems|)) (DEFUN |bfCaseItems| (|g| |x|) (PROG (|j| |ISTMP#1| |i|) (RETURN - (LET ((|bfVar#3| NIL) (|bfVar#4| NIL) (|bfVar#2| |x|) - (|bfVar#1| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#2|)) - (PROGN (SETQ |bfVar#1| (CAR |bfVar#2|)) NIL)) - (RETURN |bfVar#3|)) - (T (AND (CONSP |bfVar#1|) - (PROGN - (SETQ |i| (CAR |bfVar#1|)) - (SETQ |ISTMP#1| (CDR |bfVar#1|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |j| (CAR |ISTMP#1|)) T))) - (COND - ((NULL |bfVar#3|) - (SETQ |bfVar#3| - #0=(CONS (|bfCI| |g| |i| |j|) NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #0#) - (SETQ |bfVar#4| (CDR |bfVar#4|))))))) - (SETQ |bfVar#2| (CDR |bfVar#2|))))))) + (LET ((|bfVar#3| NIL) (|bfVar#4| NIL) (|bfVar#2| |x|) (|bfVar#1| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |bfVar#1| (CAR |bfVar#2|)) NIL)) + (RETURN |bfVar#3|)) + (T + (AND (CONSP |bfVar#1|) + (PROGN + (SETQ |i| (CAR |bfVar#1|)) + (SETQ |ISTMP#1| (CDR |bfVar#1|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |j| (CAR |ISTMP#1|)) T))) + (COND + ((NULL |bfVar#3|) + (SETQ |bfVar#3| #1=(CONS (|bfCI| |g| |i| |j|) NIL)) + (SETQ |bfVar#4| |bfVar#3|)) + (T (RPLACD |bfVar#4| #1#) (SETQ |bfVar#4| (CDR |bfVar#4|))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Form|) |bfCI|)) (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#2| NIL) (|bfVar#3| NIL) - (|bfVar#1| |a|) (|i| NIL) (|j| 1)) - (LOOP - (COND + (PROGN + (SETQ |a| (CDR |x|)) + (COND ((NULL |a|) (LIST (CAR |x|) |y|)) + (T + (SETQ |b| + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| |a|) + (|i| NIL) + (|j| 1)) + (LOOP + (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (AND (NOT (EQ |i| 'DOT)) - (COND - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS - (LIST |i| - (|bfCARCDR| |j| |g|)) - NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|))))))) - (SETQ |bfVar#1| (CDR |bfVar#1|)) - (SETQ |j| (+ |j| 1))))) - (COND - ((NULL |b|) (LIST (CAR |x|) |y|)) - (T (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))))) + (T + (AND (NOT (EQ |i| 'DOT)) + (COND + ((NULL |bfVar#2|) + (SETQ |bfVar#2| + #1=(CONS + (LIST |i| (|bfCARCDR| |j| |g|)) + NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) + (SETQ |bfVar#3| (CDR |bfVar#3|))))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)) + (SETQ |j| (+ |j| 1))))) + (COND ((NULL |b|) (LIST (CAR |x|) |y|)) + (T (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))))) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Thing|) |%Form|) |bfCARCDR|)) -(DEFUN |bfCARCDR| (|n| |g|) - (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|)) +(DEFUN |bfCARCDR| (|n| |g|) (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|)) (DECLAIM (FTYPE (FUNCTION (|%Short|) |%String|) |bfDs|)) -(DEFUN |bfDs| (|n|) - (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1)))))) +(DEFUN |bfDs| (|n|) (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1)))))) -(DEFUN |bfHandlers| (|n| |e| |hs|) - (|bfHandlers,main| |n| |e| |hs| NIL)) +(DEFUN |bfHandlers| (|n| |e| |hs|) (|bfHandlers,main| |n| |e| |hs| NIL)) (DEFUN |bfHandlers,main| (|n| |e| |hs| |xs|) - (PROG (|hs'| |s| |ISTMP#6| |t| |ISTMP#5| |v| |ISTMP#4| |ISTMP#3| - |ISTMP#2| |ISTMP#1|) + (PROG (|hs'| |s| |ISTMP#6| |t| |ISTMP#5| |v| |ISTMP#4| |ISTMP#3| |ISTMP#2| + |ISTMP#1|) (RETURN - (COND - ((NULL |hs|) - (CONS 'COND - (|reverse!| (CONS (LIST T - (LIST 'THROW - :OPEN-AXIOM-CATCH-POINT |n|)) - |xs|)))) - ((AND (CONSP |hs|) - (PROGN - (SETQ |ISTMP#1| (CAR |hs|)) - (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) '|%Catch|) - (PROGN - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |ISTMP#3| (CAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (EQ (CAR |ISTMP#3|) '|%Signature|) - (PROGN - (SETQ |ISTMP#4| (CDR |ISTMP#3|)) - (AND (CONSP |ISTMP#4|) - (PROGN - (SETQ |v| (CAR |ISTMP#4|)) - (SETQ |ISTMP#5| - (CDR |ISTMP#4|)) - (AND (CONSP |ISTMP#5|) - (NULL (CDR |ISTMP#5|)) - (PROGN + (COND + ((NULL |hs|) + (CONS 'COND + (|reverse!| + (CONS (LIST T (LIST 'THROW :OPEN-AXIOM-CATCH-POINT |n|)) |xs|)))) + ((AND (CONSP |hs|) + (PROGN + (SETQ |ISTMP#1| (CAR |hs|)) + (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) '|%Catch|) + (PROGN + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SETQ |ISTMP#3| (CAR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (EQ (CAR |ISTMP#3|) '|%Signature|) + (PROGN + (SETQ |ISTMP#4| (CDR |ISTMP#3|)) + (AND (CONSP |ISTMP#4|) + (PROGN + (SETQ |v| (CAR |ISTMP#4|)) + (SETQ |ISTMP#5| (CDR |ISTMP#4|)) + (AND (CONSP |ISTMP#5|) + (NULL (CDR |ISTMP#5|)) + (PROGN (SETQ |t| (CAR |ISTMP#5|)) T))))))) - (PROGN - (SETQ |ISTMP#6| (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#6|) - (NULL (CDR |ISTMP#6|)) - (PROGN - (SETQ |s| (CAR |ISTMP#6|)) - T)))))))) - (SETQ |hs'| (CDR |hs|)) - (SETQ |t| - (COND - ((SYMBOLP |t|) (|quote| (LIST |t|))) - (T (|quote| |t|)))) - (|bfHandlers,main| |n| |e| |hs'| - (CONS (LIST (|bfQ| (LIST 'CAR |e|) |t|) - (LIST 'LET (LIST (LIST |v| (LIST 'CDR |e|))) - |s|)) - |xs|))) - (T (|bpTrap|)))))) + (PROGN + (SETQ |ISTMP#6| (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#6|) (NULL (CDR |ISTMP#6|)) + (PROGN (SETQ |s| (CAR |ISTMP#6|)) T)))))))) + (SETQ |hs'| (CDR |hs|)) + (SETQ |t| (COND ((SYMBOLP |t|) (|quote| (LIST |t|))) (T (|quote| |t|)))) + (|bfHandlers,main| |n| |e| |hs'| + (CONS + (LIST (|bfQ| (LIST 'CAR |e|) |t|) + (LIST 'LET (LIST (LIST |v| (LIST 'CDR |e|))) + |s|)) + |xs|))) + (T (|bpTrap|)))))) (DEFUN |codeForCatchHandlers| (|g| |e| |cs|) (PROG (|ehTest|) (RETURN - (PROGN - (SETQ |ehTest| + (PROGN + (SETQ |ehTest| (LIST 'AND (LIST 'CONSP |g|) (|bfQ| (LIST 'CAR |g|) :OPEN-AXIOM-CATCH-POINT))) - (LIST 'LET - (LIST (LIST |g| - (LIST 'CATCH :OPEN-AXIOM-CATCH-POINT |e|))) - (LIST 'COND - (LIST |ehTest| - (|bfHandlers| |g| (LIST 'CDR |g|) |cs|)) - (LIST T |g|))))))) + (LIST 'LET (LIST (LIST |g| (LIST 'CATCH :OPEN-AXIOM-CATCH-POINT |e|))) + (LIST 'COND (LIST |ehTest| (|bfHandlers| |g| (LIST 'CDR |g|) |cs|)) + (LIST T |g|))))))) -(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%List| |%Form|)) |%Thing|) - |bfTry|)) +(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%List| |%Form|)) |%Thing|) |bfTry|)) (DEFUN |bfTry| (|e| |cs|) (PROG (|s| |cs'| |f| |ISTMP#1| |g|) (RETURN - (PROGN - (SETQ |g| (GENSYM)) - (COND - ((AND (CONSP |cs|) - (PROGN (SETQ |ISTMP#1| (|reverse| |cs|)) T) - (CONSP |ISTMP#1|) - (PROGN - (SETQ |f| (CAR |ISTMP#1|)) - (SETQ |cs'| (CDR |ISTMP#1|)) - T) - (PROGN (SETQ |cs'| (|reverse!| |cs'|)) T) (CONSP |f|) - (EQ (CAR |f|) '|%Finally|) - (PROGN - (SETQ |ISTMP#1| (CDR |f|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN (SETQ |s| (CAR |ISTMP#1|)) T)))) - (COND - ((NULL |cs'|) (LIST 'UNWIND-PROTECT |e| |s|)) - (T (LIST 'UNWIND-PROTECT - (|codeForCatchHandlers| |g| |e| |cs'|) |s|)))) - (T (|codeForCatchHandlers| |g| |e| |cs|))))))) + (PROGN + (SETQ |g| (GENSYM)) + (COND + ((AND (CONSP |cs|) (PROGN (SETQ |ISTMP#1| (|reverse| |cs|)) T) + (CONSP |ISTMP#1|) + (PROGN (SETQ |f| (CAR |ISTMP#1|)) (SETQ |cs'| (CDR |ISTMP#1|)) T) + (PROGN (SETQ |cs'| (|reverse!| |cs'|)) T) (CONSP |f|) + (EQ (CAR |f|) '|%Finally|) + (PROGN + (SETQ |ISTMP#1| (CDR |f|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |s| (CAR |ISTMP#1|)) T)))) + (COND ((NULL |cs'|) (LIST 'UNWIND-PROTECT |e| |s|)) + (T + (LIST 'UNWIND-PROTECT (|codeForCatchHandlers| |g| |e| |cs'|) + |s|)))) + (T (|codeForCatchHandlers| |g| |e| |cs|))))))) (DEFUN |bfThrow| (|e|) (PROG (|x| |t|) (RETURN - (PROGN - (SETQ |t| NIL) - (SETQ |x| NIL) - (COND - ((AND (CONSP |e|) (EQ (CAR |e|) '|%Pretend|)) - (SETQ |t| (CADDR |e|)) (SETQ |x| (CADR |e|))) - (T (SETQ |t| '|SystemException|) (SETQ |x| |e|))) - (SETQ |t| - (COND - ((SYMBOLP |t|) (|quote| (LIST |t|))) - (T (|quote| |t|)))) - (LIST 'THROW :OPEN-AXIOM-CATCH-POINT - (LIST 'CONS :OPEN-AXIOM-CATCH-POINT (LIST 'CONS |t| |x|))))))) + (PROGN + (SETQ |t| NIL) + (SETQ |x| NIL) + (COND + ((AND (CONSP |e|) (EQ (CAR |e|) '|%Pretend|)) (SETQ |t| (CADDR |e|)) + (SETQ |x| (CADR |e|))) + (T (SETQ |t| '|SystemException|) (SETQ |x| |e|))) + (SETQ |t| (COND ((SYMBOLP |t|) (|quote| (LIST |t|))) (T (|quote| |t|)))) + (LIST 'THROW :OPEN-AXIOM-CATCH-POINT + (LIST 'CONS :OPEN-AXIOM-CATCH-POINT (LIST 'CONS |t| |x|))))))) -(DECLAIM (FTYPE (FUNCTION (|%Form| (|%List| |%Symbol|)) |%Form|) - |backquote|)) +(DECLAIM (FTYPE (FUNCTION (|%Form| (|%List| |%Symbol|)) |%Form|) |backquote|)) (DEFUN |backquote| (|form| |params|) - (COND - ((NULL |params|) (|quote| |form|)) - ((NOT (CONSP |form|)) - (COND - ((|symbolMember?| |form| |params|) |form|) - (T (|quote| |form|)))) - (T (CONS 'LIST - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |form|) - (|t| NIL)) - (LOOP - (COND + (COND ((NULL |params|) (|quote| |form|)) + ((NOT (CONSP |form|)) + (COND ((|symbolMember?| |form| |params|) |form|) + (T (|quote| |form|)))) + (T + (CONS 'LIST + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| |form|) + (|t| NIL)) + (LOOP + (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |t| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|backquote| |t| |params|) NIL)) + (SETQ |bfVar#2| #1=(CONS (|backquote| |t| |params|) NIL)) (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) (DEFUN |genTypeAlias| (|head| |body|) (PROG (|args| |op|) (RETURN - (PROGN - (SETQ |op| (CAR |head|)) - (SETQ |args| (CDR |head|)) - (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))) + (PROGN + (SETQ |op| (CAR |head|)) + (SETQ |args| (CDR |head|)) + (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))) (DEFCONSTANT |$NativeSimpleDataTypes| - '(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16| - |int32| |uint32| |int64| |uint64| |float| |float32| - |double| |float64|)) + '(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16| |int32| + |uint32| |int64| |uint64| |float| |float32| |double| |float64|)) (DEFCONSTANT |$NativeSimpleReturnTypes| - (|append| |$NativeSimpleDataTypes| '(|void| |string|))) + (|append| |$NativeSimpleDataTypes| '(|void| |string|))) (DEFUN |isSimpleNativeType| (|t|) (|objectMember?| |t| |$NativeSimpleReturnTypes|)) @@ -2521,136 +2448,117 @@ (DEFUN |nativeType| (|t|) (PROG (|t'|) (RETURN - (COND - ((NULL |t|) |t|) - ((NOT (CONSP |t|)) - (COND - ((SETQ |t'| - (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|))) - (SETQ |t'| - (COND - ((|%hasFeature| :SBCL) - (|bfColonColon| 'SB-ALIEN |t'|)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|)) - (T |t'|))) - (COND - ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL)) - (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE - 'BASE-CHAR)) - (T |t'|))) - ((|symbolMember?| |t| '(|byte| |uint8|)) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT8)) - ((OR (|%hasFeature| :ECL) (|%hasFeature| :CLOZURE)) - :UNSIGNED-BYTE) - (T (|nativeType| '|char|)))) - ((EQ |t| '|int16|) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 16)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT16)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T)) - :INT16-T) - ((|%hasFeature| :CLOZURE) :SIGNED-HALFWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|uint16|) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 16)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT16)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T)) - :UINT16-T) - ((|%hasFeature| :CLOZURE) :UNSIGNED-HALFWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|int32|) + (COND ((NULL |t|) |t|) + ((NOT (CONSP |t|)) (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 32)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T)) - :INT32-T) - ((|%hasFeature| :CLOZURE) :SIGNED-FULLWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|uint32|) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 32)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T)) - :UINT32-T) - ((|%hasFeature| :CLOZURE) :UNSIGNED-FULLWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|int64|) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 64)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT64)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T)) - :INT64-T) - ((|%hasFeature| :CLOZURE) :SIGNED-DOUBLEWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|uint64|) - (COND - ((|%hasFeature| :SBCL) - (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 64)) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT64)) - ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T)) - :UINT64-T) - ((|%hasFeature| :CLOZURE) :UNSIGNED-DOUBLEWORD) - (T (|unknownNativeTypeError| |t|)))) - ((EQ |t| '|float32|) (|nativeType| '|float|)) - ((EQ |t| '|float64|) (|nativeType| '|double|)) - ((EQ |t| '|pointer|) - (COND - ((|%hasFeature| :GCL) '|fixnum|) - ((|%hasFeature| :ECL) :POINTER-VOID) - ((|%hasFeature| :SBCL) - (LIST '* (|bfColonColon| 'SB-ALIEN 'VOID))) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) - ((|%hasFeature| :CLOZURE) :ADDRESS) - (T (|unknownNativeTypeError| |t|)))) - (T (|unknownNativeTypeError| |t|)))) - ((EQ (CAR |t|) '|buffer|) - (COND - ((|%hasFeature| :GCL) 'OBJECT) - ((|%hasFeature| :ECL) :OBJECT) - ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|)))) - ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) - ((|%hasFeature| :CLOZURE) - (LIST :* (|nativeType| (CADR |t|)))) - (T (|unknownNativeTypeError| |t|)))) - ((EQ (CAR |t|) '|pointer|) (|nativeType| '|pointer|)) - (T (|unknownNativeTypeError| |t|)))))) + ((SETQ |t'| (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|))) + (SETQ |t'| + (COND + ((|%hasFeature| :SBCL) (|bfColonColon| 'SB-ALIEN |t'|)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|)) + (T |t'|))) + (COND + ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL)) + (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE 'BASE-CHAR)) + (T |t'|))) + ((|symbolMember?| |t| '(|byte| |uint8|)) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT8)) + ((OR (|%hasFeature| :ECL) (|%hasFeature| :CLOZURE)) + :UNSIGNED-BYTE) + (T (|nativeType| '|char|)))) + ((EQ |t| '|int16|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 16)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT16)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T)) :INT16-T) + ((|%hasFeature| :CLOZURE) :SIGNED-HALFWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|uint16|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 16)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT16)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT16-T)) :UINT16-T) + ((|%hasFeature| :CLOZURE) :UNSIGNED-HALFWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|int32|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 32)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T)) :INT32-T) + ((|%hasFeature| :CLOZURE) :SIGNED-FULLWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|uint32|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 32)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT32)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT32-T)) :UINT32-T) + ((|%hasFeature| :CLOZURE) :UNSIGNED-FULLWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|int64|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'SIGNED) 64)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'INT64)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T)) :INT64-T) + ((|%hasFeature| :CLOZURE) :SIGNED-DOUBLEWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|uint64|) + (COND + ((|%hasFeature| :SBCL) + (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 64)) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT64)) + ((AND (|%hasFeature| :ECL) (|%hasFeature| :UINT64-T)) :UINT64-T) + ((|%hasFeature| :CLOZURE) :UNSIGNED-DOUBLEWORD) + (T (|unknownNativeTypeError| |t|)))) + ((EQ |t| '|float32|) (|nativeType| '|float|)) + ((EQ |t| '|float64|) (|nativeType| '|double|)) + ((EQ |t| '|pointer|) + (COND ((|%hasFeature| :GCL) '|fixnum|) + ((|%hasFeature| :ECL) :POINTER-VOID) + ((|%hasFeature| :SBCL) + (LIST '* (|bfColonColon| 'SB-ALIEN 'VOID))) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) + ((|%hasFeature| :CLOZURE) :ADDRESS) + (T (|unknownNativeTypeError| |t|)))) + (T (|unknownNativeTypeError| |t|)))) + ((EQ (CAR |t|) '|buffer|) + (COND ((|%hasFeature| :GCL) 'OBJECT) ((|%hasFeature| :ECL) :OBJECT) + ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|)))) + ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) + ((|%hasFeature| :CLOZURE) + (LIST :* (|nativeType| (CADR |t|)))) + (T (|unknownNativeTypeError| |t|)))) + ((EQ (CAR |t|) '|pointer|) (|nativeType| '|pointer|)) + (T (|unknownNativeTypeError| |t|)))))) (DEFUN |nativeReturnType| (|t|) - (COND - ((|objectMember?| |t| |$NativeSimpleReturnTypes|) - (|nativeType| |t|)) - (T (|coreError| - (CONCAT "invalid return type for native function: " - (PNAME |t|)))))) + (COND ((|objectMember?| |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|)) + (T + (|coreError| + (CONCAT "invalid return type for native function: " (PNAME |t|)))))) (DEFUN |nativeArgumentType| (|t|) (PROG (|t'| |c| |m|) (RETURN - (COND - ((|objectMember?| |t| |$NativeSimpleDataTypes|) - (|nativeType| |t|)) - ((EQ |t| '|string|) (|nativeType| |t|)) - ((OR (NOT (CONSP |t|)) (NOT (EQL (LENGTH |t|) 2))) - (|coreError| "invalid argument type for a native function")) - (T (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #0=(|t|))) - (SETQ |t'| (CADADR . #0#)) - (COND - ((NOT (|symbolMember?| |m| - '(|readonly| |writeonly| |readwrite|))) + (COND ((|objectMember?| |t| |$NativeSimpleDataTypes|) (|nativeType| |t|)) + ((EQ |t| '|string|) (|nativeType| |t|)) + ((OR (NOT (CONSP |t|)) (NOT (EQL (LENGTH |t|) 2))) + (|coreError| "invalid argument type for a native function")) + (T (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #1=(|t|))) + (SETQ |t'| (CADADR . #1#)) + (COND + ((NOT (|symbolMember?| |m| '(|readonly| |writeonly| |readwrite|))) (|coreError| - "missing modifier for argument type for a native function")) + "missing modifier for argument type for a native function")) ((NOT (|symbolMember?| |c| '(|buffer| |pointer|))) - (|coreError| - "expected 'buffer' or 'pointer' type instance")) + (|coreError| "expected 'buffer' or 'pointer' type instance")) ((NOT (|objectMember?| |t'| |$NativeSimpleDataTypes|)) (|coreError| "expected simple native data type")) (T (|nativeType| (CADR |t|))))))))) @@ -2658,218 +2566,222 @@ (DEFUN |needsStableReference?| (|t|) (PROG (|m|) (RETURN - (AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) T) - (|symbolMember?| |m| '(|readonly| |writeonly| |readwrite|)))))) + (AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) T) + (|symbolMember?| |m| '(|readonly| |writeonly| |readwrite|)))))) (DEFUN |coerceToNativeType| (|a| |t|) (PROG (|y| |c|) (RETURN - (COND - ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL) - (|%hasFeature| :CLISP) (|%hasFeature| :CLOZURE)) - |a|) - ((|%hasFeature| :SBCL) - (COND - ((NOT (|needsStableReference?| |t|)) |a|) - (T (SETQ |c| (CAADR . #0=(|t|))) (SETQ |y| (CADADR . #0#)) + (COND + ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL) (|%hasFeature| :CLISP) + (|%hasFeature| :CLOZURE)) + |a|) + ((|%hasFeature| :SBCL) + (COND ((NOT (|needsStableReference?| |t|)) |a|) + (T (SETQ |c| (CAADR . #1=(|t|))) (SETQ |y| (CADADR . #1#)) (COND - ((EQ |c| '|buffer|) - (LIST (|bfColonColon| 'SB-SYS 'VECTOR-SAP) |a|)) - ((EQ |c| '|pointer|) - (LIST (|bfColonColon| 'SB-SYS 'ALIEN-SAP) |a|)) - ((|needsStableReference?| |t|) - (|fatalError| - (CONCAT "don't know how to coerce argument for native type" - (PNAME |c|)))))))) - (T (|fatalError| - "don't know how to coerce argument for native type")))))) + ((EQ |c| '|buffer|) + (LIST (|bfColonColon| 'SB-SYS 'VECTOR-SAP) |a|)) + ((EQ |c| '|pointer|) + (LIST (|bfColonColon| 'SB-SYS 'ALIEN-SAP) |a|)) + ((|needsStableReference?| |t|) + (|fatalError| + (CONCAT "don't know how to coerce argument for native type" + (PNAME |c|)))))))) + (T (|fatalError| "don't know how to coerce argument for native type")))))) (DEFUN |genGCLnativeTranslation| (|op| |s| |t| |op'|) (PROG (|ccode| |cargs| |cop| |rettype| |argtypes|) (RETURN - (PROGN - (SETQ |argtypes| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) - (|x| NIL)) + (PROGN + (SETQ |argtypes| + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|nativeArgumentType| |x|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |rettype| (|nativeReturnType| |t|)) - (COND - ((LET ((|bfVar#5| T) (|bfVar#4| (CONS |t| |s|)) (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#4|)) - (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) - (RETURN |bfVar#5|)) - (T (SETQ |bfVar#5| (|isSimpleNativeType| |x|)) - (COND ((NOT |bfVar#5|) (RETURN NIL))))) - (SETQ |bfVar#4| (CDR |bfVar#4|)))) - (LIST (LIST 'DEFENTRY |op| |argtypes| - (LIST |rettype| (SYMBOL-NAME |op'|))))) - (T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub")) - (SETQ |cargs| - (LET ((|bfVar#14| NIL) (|bfVar#15| NIL) - (|bfVar#13| (- (LENGTH |s|) 1)) (|i| 0)) - (LOOP - (COND - ((> |i| |bfVar#13|) (RETURN |bfVar#14|)) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| #1=(CONS (|nativeArgumentType| |x|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |rettype| (|nativeReturnType| |t|)) + (COND + ((LET ((|bfVar#5| T) (|bfVar#4| (CONS |t| |s|)) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#4|)) + (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) + (RETURN |bfVar#5|)) + (T (SETQ |bfVar#5| (|isSimpleNativeType| |x|)) + (COND ((NOT |bfVar#5|) (RETURN NIL))))) + (SETQ |bfVar#4| (CDR |bfVar#4|)))) + (LIST + (LIST 'DEFENTRY |op| |argtypes| + (LIST |rettype| (SYMBOL-NAME |op'|))))) + (T (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub")) + (SETQ |cargs| + (LET ((|bfVar#14| NIL) + (|bfVar#15| NIL) + (|bfVar#13| (- (LENGTH |s|) 1)) + (|i| 0)) + (LOOP + (COND ((> |i| |bfVar#13|) (RETURN |bfVar#14|)) ((NULL |bfVar#14|) (SETQ |bfVar#14| - (CONS (|genGCLnativeTranslation,mkCArgName| - |i|) - NIL)) + (CONS + (|genGCLnativeTranslation,mkCArgName| |i|) + NIL)) (SETQ |bfVar#15| |bfVar#14|)) - (T (RPLACD |bfVar#15| - (CONS - (|genGCLnativeTranslation,mkCArgName| - |i|) - NIL)) - (SETQ |bfVar#15| (CDR |bfVar#15|)))) - (SETQ |i| (+ |i| 1))))) - (SETQ |ccode| - (LET ((|bfVar#10| "") - (|bfVar#12| - (CONS (|genGCLnativeTranslation,gclTypeInC| - |t|) - (CONS " " - (CONS |cop| - (CONS "(" - (|append| - (LET - ((|bfVar#6| NIL) - (|bfVar#7| NIL) (|x| |s|) - (|a| |cargs|)) - (LOOP - (COND - ((OR (NOT (CONSP |x|)) - (NOT (CONSP |a|))) - (RETURN |bfVar#6|)) - ((NULL |bfVar#6|) - (SETQ |bfVar#6| - (CONS - (|genGCLnativeTranslation,cparm| - |x| |a|) - NIL)) - (SETQ |bfVar#7| - |bfVar#6|)) - (T - (RPLACD |bfVar#7| - (CONS - (|genGCLnativeTranslation,cparm| - |x| |a|) - NIL)) - (SETQ |bfVar#7| - (CDR |bfVar#7|)))) - (SETQ |x| (CDR |x|)) - (SETQ |a| (CDR |a|)))) - (CONS ") { " - (CONS - (COND - ((NOT (EQ |t| '|void|)) - "return ") - (T '||)) - (CONS (SYMBOL-NAME |op'|) - (CONS "(" - (|append| - (LET - ((|bfVar#8| NIL) - (|bfVar#9| NIL) (|x| |s|) - (|a| |cargs|)) - (LOOP - (COND - ((OR - (NOT (CONSP |x|)) - (NOT (CONSP |a|))) - (RETURN |bfVar#8|)) - ((NULL |bfVar#8|) - (SETQ |bfVar#8| - (CONS - (|genGCLnativeTranslation,gclArgsInC| - |x| |a|) - NIL)) - (SETQ |bfVar#9| - |bfVar#8|)) - (T - (RPLACD |bfVar#9| - (CONS - (|genGCLnativeTranslation,gclArgsInC| - |x| |a|) - NIL)) - (SETQ |bfVar#9| - (CDR |bfVar#9|)))) - (SETQ |x| (CDR |x|)) - (SETQ |a| (CDR |a|)))) - (CONS "); }" NIL)))))))))))) - (|bfVar#11| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#12|)) - (PROGN - (SETQ |bfVar#11| (CAR |bfVar#12|)) - NIL)) - (RETURN |bfVar#10|)) - (T (SETQ |bfVar#10| - (CONCAT |bfVar#10| |bfVar#11|)))) - (SETQ |bfVar#12| (CDR |bfVar#12|))))) - (LIST (LIST 'CLINES |ccode|) - (LIST 'DEFENTRY |op| |argtypes| - (LIST |rettype| |cop|))))))))) + (T + (RPLACD |bfVar#15| + (CONS + (|genGCLnativeTranslation,mkCArgName| |i|) + NIL)) + (SETQ |bfVar#15| (CDR |bfVar#15|)))) + (SETQ |i| (+ |i| 1))))) + (SETQ |ccode| + (LET ((|bfVar#10| "") + (|bfVar#12| + (CONS (|genGCLnativeTranslation,gclTypeInC| |t|) + (CONS " " + (CONS |cop| + (CONS "(" + (|append| + (LET ((|bfVar#6| NIL) + (|bfVar#7| NIL) + (|x| |s|) + (|a| |cargs|)) + (LOOP + (COND + ((OR (NOT (CONSP |x|)) + (NOT (CONSP |a|))) + (RETURN |bfVar#6|)) + ((NULL |bfVar#6|) + (SETQ |bfVar#6| + (CONS + (|genGCLnativeTranslation,cparm| + |x| |a|) + NIL)) + (SETQ |bfVar#7| + |bfVar#6|)) + (T + (RPLACD |bfVar#7| + (CONS + (|genGCLnativeTranslation,cparm| + |x| |a|) + NIL)) + (SETQ |bfVar#7| + (CDR |bfVar#7|)))) + (SETQ |x| (CDR |x|)) + (SETQ |a| (CDR |a|)))) + (CONS ") { " + (CONS + (COND + ((NOT (EQ |t| '|void|)) + "return ") + (T '||)) + (CONS + (SYMBOL-NAME |op'|) + (CONS "(" + (|append| + (LET ((|bfVar#8| + NIL) + (|bfVar#9| + NIL) + (|x| |s|) + (|a| + |cargs|)) + (LOOP + (COND + ((OR + (NOT + (CONSP + |x|)) + (NOT + (CONSP + |a|))) + (RETURN + |bfVar#8|)) + ((NULL + |bfVar#8|) + (SETQ |bfVar#8| + (CONS + (|genGCLnativeTranslation,gclArgsInC| + |x| + |a|) + NIL)) + (SETQ |bfVar#9| + |bfVar#8|)) + (T + (RPLACD + |bfVar#9| + (CONS + (|genGCLnativeTranslation,gclArgsInC| + |x| |a|) + NIL)) + (SETQ |bfVar#9| + (CDR + |bfVar#9|)))) + (SETQ |x| + (CDR + |x|)) + (SETQ |a| + (CDR + |a|)))) + (CONS "); }" + NIL)))))))))))) + (|bfVar#11| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#12|)) + (PROGN (SETQ |bfVar#11| (CAR |bfVar#12|)) NIL)) + (RETURN |bfVar#10|)) + (T (SETQ |bfVar#10| (CONCAT |bfVar#10| |bfVar#11|)))) + (SETQ |bfVar#12| (CDR |bfVar#12|))))) + (LIST (LIST 'CLINES |ccode|) + (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| |cop|))))))))) (DEFUN |genGCLnativeTranslation,mkCArgName| (|i|) (CONCAT "x" (WRITE-TO-STRING |i|))) (DEFUN |genGCLnativeTranslation,cparm| (|x| |a|) - (CONCAT (|genGCLnativeTranslation,gclTypeInC| (CAR |x|)) " " - (CAR |a|) (COND ((CDR |x|) ", ") (T "")))) + (CONCAT (|genGCLnativeTranslation,gclTypeInC| (CAR |x|)) " " (CAR |a|) + (COND ((CDR |x|) ", ") (T "")))) (DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|) (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|) (RETURN - (COND - ((|objectMember?| |x| |$NativeSimpleDataTypes|) - (SYMBOL-NAME |x|)) - ((EQ |x| '|void|) "void") - ((EQ |x| '|string|) "char*") - ((AND (CONSP |x|) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CAR |ISTMP#2|) '|pointer|) - (PROGN + (COND ((|objectMember?| |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|)) + ((EQ |x| '|void|) "void") ((EQ |x| '|string|) "char*") + ((AND (CONSP |x|) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|pointer|) + (PROGN (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (NULL (CDR |ISTMP#3|))))))))) - '|fixnum|) - (T "object"))))) + '|fixnum|) + (T "object"))))) (DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|) (PROG (|y| |c|) (RETURN - (COND - ((|objectMember?| |x| |$NativeSimpleDataTypes|) |a|) - ((EQ |x| '|string|) |a|) - (T (SETQ |c| (CAADR |x|)) (SETQ |y| (CADADR |x|)) - (COND - ((EQ |c| '|pointer|) |a|) - ((EQ |y| '|char|) (CONCAT |a| "->st.st_self")) - ((EQ |y| '|byte|) (CONCAT |a| "->ust.ust_self")) - ((EQ |y| '|int|) (CONCAT |a| "->fixa.fixa_self")) - ((EQ |y| '|float|) (CONCAT |a| "->sfa.sfa_self")) - ((EQ |y| '|double|) (CONCAT |a| "->lfa.lfa_self")) - (T (|coreError| "unknown argument type")))))))) + (COND ((|objectMember?| |x| |$NativeSimpleDataTypes|) |a|) + ((EQ |x| '|string|) |a|) + (T (SETQ |c| (CAADR |x|)) (SETQ |y| (CADADR |x|)) + (COND ((EQ |c| '|pointer|) |a|) + ((EQ |y| '|char|) (CONCAT |a| "->st.st_self")) + ((EQ |y| '|byte|) (CONCAT |a| "->ust.ust_self")) + ((EQ |y| '|int|) (CONCAT |a| "->fixa.fixa_self")) + ((EQ |y| '|float|) (CONCAT |a| "->sfa.sfa_self")) + ((EQ |y| '|double|) (CONCAT |a| "->lfa.lfa_self")) + (T (|coreError| "unknown argument type")))))))) (DEFUN |genGCLnativeTranslation,gclArgsInC| (|x| |a|) (CONCAT (|genGCLnativeTranslation,gclArgInC| (CAR |x|) (CAR |a|)) @@ -2878,626 +2790,565 @@ (DEFUN |genECLnativeTranslation| (|op| |s| |t| |op'|) (PROG (|rettype| |argtypes| |args|) (RETURN - (PROGN - (SETQ |args| NIL) - (SETQ |argtypes| NIL) - (LET ((|bfVar#1| |s|) (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN NIL)) - (T (SETQ |argtypes| - (CONS (|nativeArgumentType| |x|) |argtypes|)) - (SETQ |args| (CONS (GENSYM) |args|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)))) - (SETQ |args| (|reverse| |args|)) - (SETQ |rettype| (|nativeReturnType| |t|)) - (LIST (LIST 'DEFUN |op| |args| - (LIST (|bfColonColon| 'FFI 'C-INLINE) |args| - (|reverse!| |argtypes|) |rettype| - (|genECLnativeTranslation,callTemplate| |op'| - (LENGTH |args|) |s|) - :ONE-LINER T))))))) + (PROGN + (SETQ |args| NIL) + (SETQ |argtypes| NIL) + (LET ((|bfVar#1| |s|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN NIL)) + (T (SETQ |argtypes| (CONS (|nativeArgumentType| |x|) |argtypes|)) + (SETQ |args| (CONS (GENSYM) |args|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (SETQ |args| (|reverse| |args|)) + (SETQ |rettype| (|nativeReturnType| |t|)) + (LIST + (LIST 'DEFUN |op| |args| + (LIST (|bfColonColon| 'FFI 'C-INLINE) |args| + (|reverse!| |argtypes|) |rettype| + (|genECLnativeTranslation,callTemplate| |op'| + (LENGTH |args|) |s|) + :ONE-LINER T))))))) (DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|) (LET ((|bfVar#6| "") (|bfVar#8| - (CONS (SYMBOL-NAME |op|) - (CONS "(" - (|append| - (LET ((|bfVar#4| NIL) (|bfVar#5| NIL) - (|bfVar#2| (- |n| 1)) (|i| 0) - (|bfVar#3| |s|) (|x| NIL)) - (LOOP - (COND - ((OR (> |i| |bfVar#2|) - (NOT (CONSP |bfVar#3|)) - (PROGN - (SETQ |x| (CAR |bfVar#3|)) - NIL)) - (RETURN |bfVar#4|)) - ((NULL |bfVar#4|) - (SETQ |bfVar#4| - (CONS - (|genECLnativeTranslation,sharpArg| - |i| |x|) - NIL)) - (SETQ |bfVar#5| |bfVar#4|)) - (T (RPLACD |bfVar#5| - (CONS - (|genECLnativeTranslation,sharpArg| - |i| |x|) - NIL)) - (SETQ |bfVar#5| (CDR |bfVar#5|)))) - (SETQ |i| (+ |i| 1)) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (CONS ")" NIL))))) + (CONS (SYMBOL-NAME |op|) + (CONS "(" + (|append| + (LET ((|bfVar#4| NIL) + (|bfVar#5| NIL) + (|bfVar#2| (- |n| 1)) + (|i| 0) + (|bfVar#3| |s|) + (|x| NIL)) + (LOOP + (COND + ((OR (> |i| |bfVar#2|) (NOT (CONSP |bfVar#3|)) + (PROGN (SETQ |x| (CAR |bfVar#3|)) NIL)) + (RETURN |bfVar#4|)) + ((NULL |bfVar#4|) + (SETQ |bfVar#4| + (CONS + (|genECLnativeTranslation,sharpArg| |i| + |x|) + NIL)) + (SETQ |bfVar#5| |bfVar#4|)) + (T + (RPLACD |bfVar#5| + (CONS + (|genECLnativeTranslation,sharpArg| |i| + |x|) + NIL)) + (SETQ |bfVar#5| (CDR |bfVar#5|)))) + (SETQ |i| (+ |i| 1)) + (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (CONS ")" NIL))))) (|bfVar#7| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#8|)) - (PROGN (SETQ |bfVar#7| (CAR |bfVar#8|)) NIL)) - (RETURN |bfVar#6|)) - (T (SETQ |bfVar#6| (CONCAT |bfVar#6| |bfVar#7|)))) - (SETQ |bfVar#8| (CDR |bfVar#8|))))) + (COND + ((OR (NOT (CONSP |bfVar#8|)) + (PROGN (SETQ |bfVar#7| (CAR |bfVar#8|)) NIL)) + (RETURN |bfVar#6|)) + (T (SETQ |bfVar#6| (CONCAT |bfVar#6| |bfVar#7|)))) + (SETQ |bfVar#8| (CDR |bfVar#8|))))) (DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|) (COND - ((EQL |i| 0) - (CONCAT "(#0)" (|genECLnativeTranslation,selectDatum| |x|))) - (T (CONCAT "," "(#" (WRITE-TO-STRING |i|) ")" - (|genECLnativeTranslation,selectDatum| |x|))))) + ((EQL |i| 0) (CONCAT "(#0)" (|genECLnativeTranslation,selectDatum| |x|))) + (T + (CONCAT "," "(#" (WRITE-TO-STRING |i|) ")" + (|genECLnativeTranslation,selectDatum| |x|))))) (DEFUN |genECLnativeTranslation,selectDatum| (|x|) (PROG (|y| |c|) (RETURN - (COND - ((|isSimpleNativeType| |x|) "") - (T (SETQ |c| (CAADR |x|)) (SETQ |y| (CADADR |x|)) - (COND + (COND ((|isSimpleNativeType| |x|) "") + (T (SETQ |c| (CAADR |x|)) (SETQ |y| (CADADR |x|)) + (COND ((EQ |c| '|buffer|) (COND - ((OR (EQ |y| '|char|) (EQ |y| '|byte|)) - (COND - ((< |$ECLVersionNumber| 90100) "->vector.self.ch") - ((EQ |y| '|char|) "->vector.self.i8") - (T "->vector.self.b8"))) - ((EQ |y| '|int|) "->vector.self.fix") - ((EQ |y| '|float|) "->vector.self.sf") - ((EQ |y| '|double|) "->vector.self.df") - (T (|coreError| - "unknown argument to buffer type constructor")))) + ((OR (EQ |y| '|char|) (EQ |y| '|byte|)) + (COND ((< |$ECLVersionNumber| 90100) "->vector.self.ch") + ((EQ |y| '|char|) "->vector.self.i8") + (T "->vector.self.b8"))) + ((EQ |y| '|int|) "->vector.self.fix") + ((EQ |y| '|float|) "->vector.self.sf") + ((EQ |y| '|double|) "->vector.self.df") + (T + (|coreError| "unknown argument to buffer type constructor")))) ((EQ |c| '|pointer|) "") (T (|coreError| "unknown type constructor")))))))) (DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|) - (PROG (|forwardingFun| |ISTMP#2| |p| |fixups| |q| |call| |localPairs| - |y| |x| |ISTMP#1| |a| |foreignDecl| |unstableArgs| |parms| - |n| |argtypes| |rettype|) + (PROG (|forwardingFun| |ISTMP#2| |p| |fixups| |q| |call| |localPairs| |y| |x| + |ISTMP#1| |a| |foreignDecl| |unstableArgs| |parms| |n| |argtypes| + |rettype|) (DECLARE (SPECIAL |$foreignsDefsForCLisp|)) (RETURN - (PROGN - (SETQ |rettype| (|nativeReturnType| |t|)) - (SETQ |argtypes| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) - (|x| NIL)) + (PROGN + (SETQ |rettype| (|nativeReturnType| |t|)) + (SETQ |argtypes| + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|nativeArgumentType| |x|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack"))) - (SETQ |parms| - (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) - (|x| NIL)) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| #1=(CONS (|nativeArgumentType| |x|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack"))) + (SETQ |parms| + (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#4|)) - (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) - (RETURN |bfVar#5|)) - ((NULL |bfVar#5|) - (SETQ |bfVar#5| #1=(CONS (GENSYM "parm") NIL)) - (SETQ |bfVar#6| |bfVar#5|)) - (T (RPLACD |bfVar#6| #1#) - (SETQ |bfVar#6| (CDR |bfVar#6|)))) - (SETQ |bfVar#4| (CDR |bfVar#4|))))) - (SETQ |unstableArgs| NIL) - (LET ((|bfVar#7| |parms|) (|p| NIL) (|bfVar#8| |s|) (|x| NIL) - (|bfVar#9| |argtypes|) (|y| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#7|)) - (PROGN (SETQ |p| (CAR |bfVar#7|)) NIL) - (NOT (CONSP |bfVar#8|)) - (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL) - (NOT (CONSP |bfVar#9|)) - (PROGN (SETQ |y| (CAR |bfVar#9|)) NIL)) - (RETURN NIL)) - ((|needsStableReference?| |x|) - (IDENTITY - (SETQ |unstableArgs| - (CONS (CONS |p| (CONS |x| |y|)) - |unstableArgs|))))) - (SETQ |bfVar#7| (CDR |bfVar#7|)) - (SETQ |bfVar#8| (CDR |bfVar#8|)) - (SETQ |bfVar#9| (CDR |bfVar#9|)))) - (SETQ |foreignDecl| + (COND + ((OR (NOT (CONSP |bfVar#4|)) + (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) + (RETURN |bfVar#5|)) + ((NULL |bfVar#5|) + (SETQ |bfVar#5| #2=(CONS (GENSYM "parm") NIL)) + (SETQ |bfVar#6| |bfVar#5|)) + (T (RPLACD |bfVar#6| #2#) (SETQ |bfVar#6| (CDR |bfVar#6|)))) + (SETQ |bfVar#4| (CDR |bfVar#4|))))) + (SETQ |unstableArgs| NIL) + (LET ((|bfVar#7| |parms|) + (|p| NIL) + (|bfVar#8| |s|) + (|x| NIL) + (|bfVar#9| |argtypes|) + (|y| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#7|)) (PROGN (SETQ |p| (CAR |bfVar#7|)) NIL) + (NOT (CONSP |bfVar#8|)) (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL) + (NOT (CONSP |bfVar#9|)) (PROGN (SETQ |y| (CAR |bfVar#9|)) NIL)) + (RETURN NIL)) + ((|needsStableReference?| |x|) + (IDENTITY + (SETQ |unstableArgs| + (CONS (CONS |p| (CONS |x| |y|)) |unstableArgs|))))) + (SETQ |bfVar#7| (CDR |bfVar#7|)) + (SETQ |bfVar#8| (CDR |bfVar#8|)) + (SETQ |bfVar#9| (CDR |bfVar#9|)))) + (SETQ |foreignDecl| (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n| (LIST :NAME (SYMBOL-NAME |op'|)) (CONS :ARGUMENTS - (LET ((|bfVar#12| NIL) (|bfVar#13| NIL) - (|bfVar#10| |argtypes|) (|x| NIL) - (|bfVar#11| |parms|) (|a| NIL)) + (LET ((|bfVar#12| NIL) + (|bfVar#13| NIL) + (|bfVar#10| |argtypes|) + (|x| NIL) + (|bfVar#11| |parms|) + (|a| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#10|)) - (PROGN - (SETQ |x| (CAR |bfVar#10|)) - NIL) - (NOT (CONSP |bfVar#11|)) - (PROGN - (SETQ |a| (CAR |bfVar#11|)) - NIL)) - (RETURN |bfVar#12|)) - ((NULL |bfVar#12|) - (SETQ |bfVar#12| - #2=(CONS (LIST |a| |x|) NIL)) - (SETQ |bfVar#13| |bfVar#12|)) - (T (RPLACD |bfVar#13| #2#) - (SETQ |bfVar#13| (CDR |bfVar#13|)))) - (SETQ |bfVar#10| (CDR |bfVar#10|)) - (SETQ |bfVar#11| (CDR |bfVar#11|))))) - (LIST :RETURN-TYPE |rettype|) - (LIST :LANGUAGE :STDC))) - (SETQ |forwardingFun| - (COND - ((NULL |unstableArgs|) - (LIST 'DEFUN |op| |parms| (CONS |n| |parms|))) - (T (SETQ |localPairs| - (LET ((|bfVar#16| NIL) (|bfVar#17| NIL) - (|bfVar#15| |unstableArgs|) - (|bfVar#14| NIL)) - (LOOP (COND - ((OR (NOT (CONSP |bfVar#15|)) - (PROGN - (SETQ |bfVar#14| - (CAR |bfVar#15|)) - NIL)) - (RETURN |bfVar#16|)) - (T (AND (CONSP |bfVar#14|) - (PROGN - (SETQ |a| (CAR |bfVar#14|)) - (SETQ |ISTMP#1| - (CDR |bfVar#14|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |x| (CAR |ISTMP#1|)) - (SETQ |y| (CDR |ISTMP#1|)) - T))) - (COND - ((NULL |bfVar#16|) - (SETQ |bfVar#16| - #3=(CONS - (CONS |a| - (CONS |x| - (CONS |y| - (GENSYM "loc")))) - NIL)) - (SETQ |bfVar#17| |bfVar#16|)) - (T (RPLACD |bfVar#17| #3#) - (SETQ |bfVar#17| - (CDR |bfVar#17|))))))) - (SETQ |bfVar#15| (CDR |bfVar#15|))))) - (SETQ |call| - (CONS |n| - (LET ((|bfVar#19| NIL) (|bfVar#20| NIL) - (|bfVar#18| |parms|) (|p| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#18|)) - (PROGN - (SETQ |p| (CAR |bfVar#18|)) - NIL)) - (RETURN |bfVar#19|)) - ((NULL |bfVar#19|) - (SETQ |bfVar#19| - (CONS - (|genCLISPnativeTranslation,actualArg| - |p| |localPairs|) - NIL)) - (SETQ |bfVar#20| |bfVar#19|)) - (T - (RPLACD |bfVar#20| - (CONS - (|genCLISPnativeTranslation,actualArg| - |p| |localPairs|) - NIL)) - (SETQ |bfVar#20| - (CDR |bfVar#20|)))) - (SETQ |bfVar#18| (CDR |bfVar#18|)))))) - (SETQ |call| - (PROGN - (SETQ |fixups| + ((OR (NOT (CONSP |bfVar#10|)) + (PROGN (SETQ |x| (CAR |bfVar#10|)) NIL) + (NOT (CONSP |bfVar#11|)) + (PROGN (SETQ |a| (CAR |bfVar#11|)) NIL)) + (RETURN |bfVar#12|)) + ((NULL |bfVar#12|) + (SETQ |bfVar#12| #3=(CONS (LIST |a| |x|) NIL)) + (SETQ |bfVar#13| |bfVar#12|)) + (T (RPLACD |bfVar#13| #3#) + (SETQ |bfVar#13| (CDR |bfVar#13|)))) + (SETQ |bfVar#10| (CDR |bfVar#10|)) + (SETQ |bfVar#11| (CDR |bfVar#11|))))) + (LIST :RETURN-TYPE |rettype|) (LIST :LANGUAGE :STDC))) + (SETQ |forwardingFun| + (COND + ((NULL |unstableArgs|) + (LIST 'DEFUN |op| |parms| (CONS |n| |parms|))) + (T + (SETQ |localPairs| + (LET ((|bfVar#16| NIL) + (|bfVar#17| NIL) + (|bfVar#15| |unstableArgs|) + (|bfVar#14| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#15|)) + (PROGN + (SETQ |bfVar#14| (CAR |bfVar#15|)) + NIL)) + (RETURN |bfVar#16|)) + (T + (AND (CONSP |bfVar#14|) + (PROGN + (SETQ |a| (CAR |bfVar#14|)) + (SETQ |ISTMP#1| (CDR |bfVar#14|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |x| (CAR |ISTMP#1|)) + (SETQ |y| (CDR |ISTMP#1|)) + T))) + (COND + ((NULL |bfVar#16|) + (SETQ |bfVar#16| + #4=(CONS + (CONS |a| + (CONS |x| + (CONS |y| + (GENSYM + "loc")))) + NIL)) + (SETQ |bfVar#17| |bfVar#16|)) + (T (RPLACD |bfVar#17| #4#) + (SETQ |bfVar#17| (CDR |bfVar#17|))))))) + (SETQ |bfVar#15| (CDR |bfVar#15|))))) + (SETQ |call| + (CONS |n| + (LET ((|bfVar#19| NIL) + (|bfVar#20| NIL) + (|bfVar#18| |parms|) + (|p| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#18|)) + (PROGN (SETQ |p| (CAR |bfVar#18|)) NIL)) + (RETURN |bfVar#19|)) + ((NULL |bfVar#19|) + (SETQ |bfVar#19| + (CONS + (|genCLISPnativeTranslation,actualArg| + |p| |localPairs|) + NIL)) + (SETQ |bfVar#20| |bfVar#19|)) + (T + (RPLACD |bfVar#20| + (CONS + (|genCLISPnativeTranslation,actualArg| + |p| |localPairs|) + NIL)) + (SETQ |bfVar#20| (CDR |bfVar#20|)))) + (SETQ |bfVar#18| (CDR |bfVar#18|)))))) + (SETQ |call| + (PROGN + (SETQ |fixups| (LET ((|bfVar#22| NIL) (|bfVar#23| NIL) (|bfVar#21| |localPairs|) (|p| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#21|)) - (PROGN + (COND + ((OR (NOT (CONSP |bfVar#21|)) + (PROGN (SETQ |p| (CAR |bfVar#21|)) NIL)) - (RETURN |bfVar#22|)) - (T - (AND - (NOT - (NULL - (SETQ |q| - (|genCLISPnativeTranslation,copyBack| - |p|)))) - (COND - ((NULL |bfVar#22|) - (SETQ |bfVar#22| - (CONS |q| NIL)) - (SETQ |bfVar#23| - |bfVar#22|)) - (T - (RPLACD |bfVar#23| - (CONS |q| NIL)) - (SETQ |bfVar#23| - (CDR |bfVar#23|))))))) - (SETQ |bfVar#21| (CDR |bfVar#21|))))) - (COND - ((NULL |fixups|) (LIST |call|)) - (T (LIST (CONS 'PROG1 - (CONS |call| |fixups|))))))) - (LET ((|bfVar#25| |localPairs|) (|bfVar#24| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#25|)) - (PROGN - (SETQ |bfVar#24| (CAR |bfVar#25|)) - NIL)) - (RETURN NIL)) - (T (AND (CONSP |bfVar#24|) - (PROGN - (SETQ |p| (CAR |bfVar#24|)) - (SETQ |ISTMP#1| (CDR |bfVar#24|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SETQ |x| (CAR |ISTMP#1|)) - (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SETQ |y| (CAR |ISTMP#2|)) - (SETQ |a| (CDR |ISTMP#2|)) - T))))) - (SETQ |call| - (LIST - (CONS - (|bfColonColon| 'FFI - 'WITH-FOREIGN-OBJECT) - (CONS - (LIST |a| + (RETURN |bfVar#22|)) + (T + (AND + (NOT + (NULL + (SETQ |q| + (|genCLISPnativeTranslation,copyBack| + |p|)))) + (COND + ((NULL |bfVar#22|) + (SETQ |bfVar#22| (CONS |q| NIL)) + (SETQ |bfVar#23| |bfVar#22|)) + (T (RPLACD |bfVar#23| (CONS |q| NIL)) + (SETQ |bfVar#23| + (CDR |bfVar#23|))))))) + (SETQ |bfVar#21| (CDR |bfVar#21|))))) + (COND ((NULL |fixups|) (LIST |call|)) + (T + (LIST (CONS 'PROG1 (CONS |call| |fixups|))))))) + (LET ((|bfVar#25| |localPairs|) (|bfVar#24| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#25|)) + (PROGN (SETQ |bfVar#24| (CAR |bfVar#25|)) NIL)) + (RETURN NIL)) + (T + (AND (CONSP |bfVar#24|) + (PROGN + (SETQ |p| (CAR |bfVar#24|)) + (SETQ |ISTMP#1| (CDR |bfVar#24|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |x| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) + (PROGN + (SETQ |y| (CAR |ISTMP#2|)) + (SETQ |a| (CDR |ISTMP#2|)) + T))))) + (SETQ |call| + (LIST + (CONS + (|bfColonColon| 'FFI 'WITH-FOREIGN-OBJECT) + (CONS + (LIST |a| (LIST 'FUNCALL - (LIST 'INTERN - "getCLISPType" "BOOTTRAN") - |p|) + (LIST 'INTERN "getCLISPType" + "BOOTTRAN") + |p|) |p|) - |call|))))))) - (SETQ |bfVar#25| (CDR |bfVar#25|)))) - (CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))) - (SETQ |$foreignsDefsForCLisp| + |call|))))))) + (SETQ |bfVar#25| (CDR |bfVar#25|)))) + (CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))) + (SETQ |$foreignsDefsForCLisp| (CONS |foreignDecl| |$foreignsDefsForCLisp|)) - (LIST |forwardingFun|))))) + (LIST |forwardingFun|))))) (DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#26|) (PROG (|a| |y| |x| |p|) (RETURN - (PROGN - (SETQ |p| (CAR |bfVar#26|)) - (SETQ |x| (CADR . #0=(|bfVar#26|))) - (SETQ |y| (CADDR . #0#)) - (SETQ |a| (CDDDR . #0#)) - (COND - ((AND (CONSP |x|) (EQ (CAR |x|) '|readonly|)) NIL) - (T (LIST 'SETF |p| + (PROGN + (SETQ |p| (CAR |bfVar#26|)) + (SETQ |x| (CADR . #1=(|bfVar#26|))) + (SETQ |y| (CADDR . #1#)) + (SETQ |a| (CDDDR . #1#)) + (COND ((AND (CONSP |x|) (EQ (CAR |x|) '|readonly|)) NIL) + (T + (LIST 'SETF |p| (LIST (|bfColonColon| 'FFI 'FOREIGN-VALUE) |a|)))))))) (DEFUN |genCLISPnativeTranslation,actualArg| (|p| |pairs|) (PROG (|a'|) (RETURN - (COND - ((SETQ |a'| (CDR (ASSOC |p| |pairs|))) (CDR (CDR |a'|))) - (T |p|))))) + (COND ((SETQ |a'| (CDR (ASSOC |p| |pairs|))) (CDR (CDR |a'|))) (T |p|))))) -(DEFUN |getCLISPType| (|a|) - (LIST (|bfColonColon| 'FFI 'C-ARRAY) (LENGTH |a|))) +(DEFUN |getCLISPType| (|a|) (LIST (|bfColonColon| 'FFI 'C-ARRAY) (LENGTH |a|))) (DEFUN |genSBCLnativeTranslation| (|op| |s| |t| |op'|) (PROG (|newArgs| |unstableArgs| |args| |argtypes| |rettype|) (RETURN - (PROGN - (SETQ |rettype| (|nativeReturnType| |t|)) - (SETQ |argtypes| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) - (|x| NIL)) + (PROGN + (SETQ |rettype| (|nativeReturnType| |t|)) + (SETQ |argtypes| + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|nativeArgumentType| |x|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |args| - (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) - (|x| NIL)) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| #1=(CONS (|nativeArgumentType| |x|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |args| + (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#4|)) - (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) - (RETURN |bfVar#5|)) - ((NULL |bfVar#5|) - (SETQ |bfVar#5| #1=(CONS (GENSYM) NIL)) - (SETQ |bfVar#6| |bfVar#5|)) - (T (RPLACD |bfVar#6| #1#) - (SETQ |bfVar#6| (CDR |bfVar#6|)))) - (SETQ |bfVar#4| (CDR |bfVar#4|))))) - (SETQ |unstableArgs| NIL) - (SETQ |newArgs| NIL) - (LET ((|bfVar#7| |args|) (|a| NIL) (|bfVar#8| |s|) (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#7|)) - (PROGN (SETQ |a| (CAR |bfVar#7|)) NIL) - (NOT (CONSP |bfVar#8|)) - (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL)) - (RETURN NIL)) - (T (SETQ |newArgs| - (CONS (|coerceToNativeType| |a| |x|) |newArgs|)) (COND - ((|needsStableReference?| |x|) - (SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))) - (SETQ |bfVar#7| (CDR |bfVar#7|)) - (SETQ |bfVar#8| (CDR |bfVar#8|)))) - (SETQ |op'| - (COND - ((|%hasFeature| :WIN32) - (CONCAT "_" (SYMBOL-NAME |op'|))) - (T (SYMBOL-NAME |op'|)))) - (COND - ((NULL |unstableArgs|) - (LIST (LIST 'DEFUN |op| |args| - (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") - (CONS (LIST - (INTERN "EXTERN-ALIEN" "SB-ALIEN") - |op'| - (CONS 'FUNCTION - (CONS |rettype| |argtypes|))) - |args|))))) - (T (LIST (LIST 'DEFUN |op| |args| - (LIST (|bfColonColon| 'SB-SYS - 'WITH-PINNED-OBJECTS) - (|reverse!| |unstableArgs|) - (CONS (INTERN "ALIEN-FUNCALL" - "SB-ALIEN") - (CONS - (LIST - (INTERN "EXTERN-ALIEN" - "SB-ALIEN") - |op'| - (CONS 'FUNCTION - (CONS |rettype| |argtypes|))) - (|reverse!| |newArgs|)))))))))))) + ((OR (NOT (CONSP |bfVar#4|)) + (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) + (RETURN |bfVar#5|)) + ((NULL |bfVar#5|) (SETQ |bfVar#5| #2=(CONS (GENSYM) NIL)) + (SETQ |bfVar#6| |bfVar#5|)) + (T (RPLACD |bfVar#6| #2#) (SETQ |bfVar#6| (CDR |bfVar#6|)))) + (SETQ |bfVar#4| (CDR |bfVar#4|))))) + (SETQ |unstableArgs| NIL) + (SETQ |newArgs| NIL) + (LET ((|bfVar#7| |args|) (|a| NIL) (|bfVar#8| |s|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#7|)) (PROGN (SETQ |a| (CAR |bfVar#7|)) NIL) + (NOT (CONSP |bfVar#8|)) (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL)) + (RETURN NIL)) + (T (SETQ |newArgs| (CONS (|coerceToNativeType| |a| |x|) |newArgs|)) + (COND + ((|needsStableReference?| |x|) + (SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))) + (SETQ |bfVar#7| (CDR |bfVar#7|)) + (SETQ |bfVar#8| (CDR |bfVar#8|)))) + (SETQ |op'| + (COND ((|%hasFeature| :WIN32) (CONCAT "_" (SYMBOL-NAME |op'|))) + (T (SYMBOL-NAME |op'|)))) + (COND + ((NULL |unstableArgs|) + (LIST + (LIST 'DEFUN |op| |args| + (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") + (CONS + (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") |op'| + (CONS 'FUNCTION (CONS |rettype| |argtypes|))) + |args|))))) + (T + (LIST + (LIST 'DEFUN |op| |args| + (LIST (|bfColonColon| 'SB-SYS 'WITH-PINNED-OBJECTS) + (|reverse!| |unstableArgs|) + (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") + (CONS + (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") |op'| + (CONS 'FUNCTION (CONS |rettype| |argtypes|))) + (|reverse!| |newArgs|)))))))))))) (DEFUN |genCLOZUREnativeTranslation| (|op| |s| |t| |op'|) - (PROG (|call| |p'| |ISTMP#3| |ISTMP#2| |ISTMP#1| |aryPairs| - |strPairs| |parms| |argtypes| |rettype|) - (RETURN - (PROGN - (SETQ |rettype| (|nativeReturnType| |t|)) - (SETQ |argtypes| - (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) - (|x| NIL)) + (PROG (|call| |p'| |ISTMP#3| |ISTMP#2| |ISTMP#1| |aryPairs| |strPairs| + |parms| |argtypes| |rettype|) + (RETURN + (PROGN + (SETQ |rettype| (|nativeReturnType| |t|)) + (SETQ |argtypes| + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) - (RETURN |bfVar#2|)) - ((NULL |bfVar#2|) - (SETQ |bfVar#2| - #0=(CONS (|nativeArgumentType| |x|) NIL)) - (SETQ |bfVar#3| |bfVar#2|)) - (T (RPLACD |bfVar#3| #0#) - (SETQ |bfVar#3| (CDR |bfVar#3|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|))))) - (SETQ |parms| - (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) - (|x| NIL)) + (COND + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) + (SETQ |bfVar#2| #1=(CONS (|nativeArgumentType| |x|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + (SETQ |parms| + (LET ((|bfVar#5| NIL) (|bfVar#6| NIL) (|bfVar#4| |s|) (|x| NIL)) (LOOP - (COND - ((OR (NOT (CONSP |bfVar#4|)) - (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) - (RETURN |bfVar#5|)) - ((NULL |bfVar#5|) - (SETQ |bfVar#5| #1=(CONS (GENSYM "parm") NIL)) - (SETQ |bfVar#6| |bfVar#5|)) - (T (RPLACD |bfVar#6| #1#) - (SETQ |bfVar#6| (CDR |bfVar#6|)))) - (SETQ |bfVar#4| (CDR |bfVar#4|))))) - (SETQ |strPairs| NIL) - (SETQ |aryPairs| NIL) - (LET ((|bfVar#7| |parms|) (|p| NIL) (|bfVar#8| |s|) (|x| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#7|)) - (PROGN (SETQ |p| (CAR |bfVar#7|)) NIL) - (NOT (CONSP |bfVar#8|)) - (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL)) - (RETURN NIL)) - ((EQ |x| '|string|) - (SETQ |strPairs| - (CONS (CONS |p| (GENSYM "loc")) |strPairs|))) - ((AND (CONSP |x|) - (PROGN - (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) - (PROGN - (SETQ |ISTMP#2| (CAR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (CAR |ISTMP#2|) '|buffer|) - (PROGN - (SETQ |ISTMP#3| (CDR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (NULL (CDR |ISTMP#3|))))))))) - (SETQ |aryPairs| - (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))) - (SETQ |bfVar#7| (CDR |bfVar#7|)) - (SETQ |bfVar#8| (CDR |bfVar#8|)))) - (COND - ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT "_" |op'|)))) - (SETQ |call| + (COND + ((OR (NOT (CONSP |bfVar#4|)) + (PROGN (SETQ |x| (CAR |bfVar#4|)) NIL)) + (RETURN |bfVar#5|)) + ((NULL |bfVar#5|) + (SETQ |bfVar#5| #2=(CONS (GENSYM "parm") NIL)) + (SETQ |bfVar#6| |bfVar#5|)) + (T (RPLACD |bfVar#6| #2#) (SETQ |bfVar#6| (CDR |bfVar#6|)))) + (SETQ |bfVar#4| (CDR |bfVar#4|))))) + (SETQ |strPairs| NIL) + (SETQ |aryPairs| NIL) + (LET ((|bfVar#7| |parms|) (|p| NIL) (|bfVar#8| |s|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#7|)) (PROGN (SETQ |p| (CAR |bfVar#7|)) NIL) + (NOT (CONSP |bfVar#8|)) (PROGN (SETQ |x| (CAR |bfVar#8|)) NIL)) + (RETURN NIL)) + ((EQ |x| '|string|) + (SETQ |strPairs| (CONS (CONS |p| (GENSYM "loc")) |strPairs|))) + ((AND (CONSP |x|) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN + (SETQ |ISTMP#2| (CAR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|buffer|) + (PROGN + (SETQ |ISTMP#3| (CDR |ISTMP#2|)) + (AND (CONSP |ISTMP#3|) + (NULL (CDR |ISTMP#3|))))))))) + (SETQ |aryPairs| (CONS (CONS |p| (GENSYM "loc")) |aryPairs|)))) + (SETQ |bfVar#7| (CDR |bfVar#7|)) + (SETQ |bfVar#8| (CDR |bfVar#8|)))) + (COND ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT "_" |op'|)))) + (SETQ |call| (CONS (|bfColonColon| 'CCL 'EXTERNAL-CALL) (CONS (STRING |op'|) (|append| - (LET ((|bfVar#11| NIL) (|bfVar#12| NIL) - (|bfVar#9| |argtypes|) (|x| NIL) - (|bfVar#10| |parms|) (|p| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#9|)) - (PROGN - (SETQ |x| (CAR |bfVar#9|)) - NIL) - (NOT (CONSP |bfVar#10|)) - (PROGN - (SETQ |p| (CAR |bfVar#10|)) - NIL)) - (RETURN |bfVar#11|)) - (T - (LET - ((|bfVar#13| - (LIST |x| - (COND - ((SETQ |p'| - (ASSOC |p| |strPairs|)) - (CDR |p'|)) - ((SETQ |p'| - (ASSOC |p| |aryPairs|)) - (CDR |p'|)) - (T |p|))))) - (COND - ((NULL |bfVar#13|) NIL) - ((NULL |bfVar#11|) - (SETQ |bfVar#11| |bfVar#13|) - (SETQ |bfVar#12| - (|lastNode| |bfVar#11|))) - (T - (RPLACD |bfVar#12| - |bfVar#13|) - (SETQ |bfVar#12| - (|lastNode| |bfVar#12|))))))) - (SETQ |bfVar#9| (CDR |bfVar#9|)) - (SETQ |bfVar#10| (CDR |bfVar#10|)))) - (CONS |rettype| NIL))))) - (COND - ((EQ |t| '|string|) + (LET ((|bfVar#11| NIL) + (|bfVar#12| NIL) + (|bfVar#9| |argtypes|) + (|x| NIL) + (|bfVar#10| |parms|) + (|p| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#9|)) + (PROGN (SETQ |x| (CAR |bfVar#9|)) NIL) + (NOT (CONSP |bfVar#10|)) + (PROGN (SETQ |p| (CAR |bfVar#10|)) NIL)) + (RETURN |bfVar#11|)) + (T + (LET ((|bfVar#13| + (LIST |x| + (COND + ((SETQ |p'| + (ASSOC |p| |strPairs|)) + (CDR |p'|)) + ((SETQ |p'| + (ASSOC |p| |aryPairs|)) + (CDR |p'|)) + (T |p|))))) + (COND ((NULL |bfVar#13|) NIL) + ((NULL |bfVar#11|) + (SETQ |bfVar#11| |bfVar#13|) + (SETQ |bfVar#12| + (|lastNode| |bfVar#11|))) + (T (RPLACD |bfVar#12| |bfVar#13|) + (SETQ |bfVar#12| + (|lastNode| |bfVar#12|))))))) + (SETQ |bfVar#9| (CDR |bfVar#9|)) + (SETQ |bfVar#10| (CDR |bfVar#10|)))) + (CONS |rettype| NIL))))) + (COND + ((EQ |t| '|string|) + (SETQ |call| (LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|)))) + (LET ((|bfVar#14| |aryPairs|) (|arg| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#14|)) + (PROGN (SETQ |arg| (CAR |bfVar#14|)) NIL)) + (RETURN NIL)) + (T (SETQ |call| - (LIST (|bfColonColon| 'CCL 'GET-CSTRING) |call|)))) - (LET ((|bfVar#14| |aryPairs|) (|arg| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#14|)) - (PROGN (SETQ |arg| (CAR |bfVar#14|)) NIL)) - (RETURN NIL)) - (T (SETQ |call| - (LIST (|bfColonColon| 'CCL - 'WITH-POINTER-TO-IVECTOR) - (LIST (CDR |arg|) (CAR |arg|)) |call|)))) - (SETQ |bfVar#14| (CDR |bfVar#14|)))) - (COND - (|strPairs| (SETQ |call| - (LIST (|bfColonColon| 'CCL 'WITH-CSTRS) - (LET ((|bfVar#16| NIL) - (|bfVar#17| NIL) - (|bfVar#15| |strPairs|) - (|arg| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#15|)) - (PROGN - (SETQ |arg| - (CAR |bfVar#15|)) + (LIST (|bfColonColon| 'CCL 'WITH-POINTER-TO-IVECTOR) + (LIST (CDR |arg|) (CAR |arg|)) |call|)))) + (SETQ |bfVar#14| (CDR |bfVar#14|)))) + (COND + (|strPairs| + (SETQ |call| + (LIST (|bfColonColon| 'CCL 'WITH-CSTRS) + (LET ((|bfVar#16| NIL) + (|bfVar#17| NIL) + (|bfVar#15| |strPairs|) + (|arg| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#15|)) + (PROGN (SETQ |arg| (CAR |bfVar#15|)) NIL)) + (RETURN |bfVar#16|)) + ((NULL |bfVar#16|) + (SETQ |bfVar#16| + #3=(CONS (LIST (CDR |arg|) (CAR |arg|)) NIL)) - (RETURN |bfVar#16|)) - ((NULL |bfVar#16|) - (SETQ |bfVar#16| - #2=(CONS - (LIST (CDR |arg|) - (CAR |arg|)) - NIL)) - (SETQ |bfVar#17| |bfVar#16|)) - (T (RPLACD |bfVar#17| #2#) - (SETQ |bfVar#17| - (CDR |bfVar#17|)))) - (SETQ |bfVar#15| - (CDR |bfVar#15|)))) - |call|)))) - (LIST (LIST 'DEFUN |op| |parms| |call|)))))) + (SETQ |bfVar#17| |bfVar#16|)) + (T (RPLACD |bfVar#17| #3#) + (SETQ |bfVar#17| (CDR |bfVar#17|)))) + (SETQ |bfVar#15| (CDR |bfVar#15|)))) + |call|)))) + (LIST (LIST 'DEFUN |op| |parms| |call|)))))) (DEFUN |genImportDeclaration| (|op| |sig|) (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|) (RETURN - (COND - ((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|) + (COND + ((NOT + (AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|) + (PROGN + (SETQ |ISTMP#1| (CDR |sig|)) + (AND (CONSP |ISTMP#1|) (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|) - (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |m| (CAR |ISTMP#2|)) T))))))) - (|coreError| "invalid signature")) - ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|%Mapping|) + (SETQ |op'| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |m| (CAR |ISTMP#2|)) T))))))) + (|coreError| "invalid signature")) + ((NOT + (AND (CONSP |m|) (EQ (CAR |m|) '|%Mapping|) + (PROGN + (SETQ |ISTMP#1| (CDR |m|)) + (AND (CONSP |ISTMP#1|) (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|) - (NULL (CDR |ISTMP#2|)) - (PROGN (SETQ |s| (CAR |ISTMP#2|)) T))))))) - (|coreError| "invalid function type")) - (T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|)))) - (COND - ((|%hasFeature| :GCL) - (|genGCLnativeTranslation| |op| |s| |t| |op'|)) - ((|%hasFeature| :SBCL) - (|genSBCLnativeTranslation| |op| |s| |t| |op'|)) - ((|%hasFeature| :CLISP) - (|genCLISPnativeTranslation| |op| |s| |t| |op'|)) - ((|%hasFeature| :ECL) - (|genECLnativeTranslation| |op| |s| |t| |op'|)) - ((|%hasFeature| :CLOZURE) - (|genCLOZUREnativeTranslation| |op| |s| |t| |op'|)) - (T (|fatalError| - "import declaration not implemented for this Lisp")))))))) + (SETQ |t| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |s| (CAR |ISTMP#2|)) T))))))) + (|coreError| "invalid function type")) + (T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|)))) + (COND + ((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|)) + ((|%hasFeature| :SBCL) (|genSBCLnativeTranslation| |op| |s| |t| |op'|)) + ((|%hasFeature| :CLISP) + (|genCLISPnativeTranslation| |op| |s| |t| |op'|)) + ((|%hasFeature| :ECL) (|genECLnativeTranslation| |op| |s| |t| |op'|)) + ((|%hasFeature| :CLOZURE) + (|genCLOZUREnativeTranslation| |op| |s| |t| |op'|)) + (T + (|fatalError| + "import declaration not implemented for this Lisp")))))))) -- cgit v1.2.3