aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/ast.clisp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-09-30 04:20:34 +0000
committerdos-reis <gdr@axiomatics.org>2011-09-30 04:20:34 +0000
commit441c2259ea4bdda1c2a0a4091a55955536998270 (patch)
treea70ec6244fe67bf0a2f8161892ae67ea54fd7cf2 /src/boot/strap/ast.clisp
parent589f3335fb070375ba16d84859ee00267577f8ab (diff)
downloadopen-axiom-441c2259ea4bdda1c2a0a4091a55955536998270.tar.gz
* boot/ast.boot (bfFor): Tidy. Handle hashtable iterator forms.
(bfIterateTable): New. (separateIterators): Likewise. (bfExpandTableIters): Likewise. (bfLp1): Use them.
Diffstat (limited to 'src/boot/strap/ast.clisp')
-rw-r--r--src/boot/strap/ast.clisp5303
1 files changed, 2577 insertions, 2726 deletions
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 ((NULL |t|) |t|)
+ ((NOT (CONSP |t|))
(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|))))))
+ ((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"))))))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-04 15:46:43 +0000