open-axiom repository from github
(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IN-PACKAGE "BOOTTRAN")
(PROVIDE "ast")
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
(EXPORT '(|quote| |translateForm|)))
(DEFPARAMETER |$bfClamming| NIL)
(DEFPARAMETER |$constantIdentifiers| NIL)
(DEFPARAMETER |$activeNamespace| NIL)
(DEFUN |%Command| #1=(|bfVar#1|) (CONS '|%Command| (LIST . #1#)))
(DEFUN |%Lisp| #1=(|bfVar#2|) (CONS '|%Lisp| (LIST . #1#)))
(DEFUN |%Module| #1=(|bfVar#3| |bfVar#4| |bfVar#5|)
(CONS '|%Module| (LIST . #1#)))
(DEFUN |%Namespace| #1=(|bfVar#6|) (CONS '|%Namespace| (LIST . #1#)))
(DEFUN |%Import| #1=(|bfVar#7|) (CONS '|%Import| (LIST . #1#)))
(DEFUN |%ImportSignature| #1=(|bfVar#8| |bfVar#9|)
(CONS '|%ImportSignature| (LIST . #1#)))
(DEFUN |%Record| #1=(|bfVar#10| |bfVar#11|) (CONS '|%Record| (LIST . #1#)))
(DEFUN |%AccessorDef| #1=(|bfVar#12| |bfVar#13|)
(CONS '|%AccessorDef| (LIST . #1#)))
(DEFUN |%TypeAlias| #1=(|bfVar#14| |bfVar#15|)
(CONS '|%TypeAlias| (LIST . #1#)))
(DEFUN |%Signature| #1=(|bfVar#16| |bfVar#17|)
(CONS '|%Signature| (LIST . #1#)))
(DEFUN |%Mapping| #1=(|bfVar#18| |bfVar#19|) (CONS '|%Mapping| (LIST . #1#)))
(DEFUN |%Forall| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Forall| (LIST . #1#)))
(DEFUN |%Dynamic| #1=(|bfVar#22|) (CONS '|%Dynamic| (LIST . #1#)))
(DEFUN |%SuffixDot| #1=(|bfVar#23|) (CONS '|%SuffixDot| (LIST . #1#)))
(DEFUN |%Quote| #1=(|bfVar#24|) (CONS '|%Quote| (LIST . #1#)))
(DEFUN |%EqualPattern| #1=(|bfVar#25|) (CONS '|%EqualPattern| (LIST . #1#)))
(DEFUN |%Colon| #1=(|bfVar#26|) (CONS '|%Colon| (LIST . #1#)))
(DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|)
(CONS '|%QualifiedName| (LIST . #1#)))
(DEFUN |%Restrict| #1=(|bfVar#29| |bfVar#30|) (CONS '|%Restrict| (LIST . #1#)))
(DEFUN |%DefaultValue| #1=(|bfVar#31| |bfVar#32|)
(CONS '|%DefaultValue| (LIST . #1#)))
(DEFUN |%Key| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Key| (LIST . #1#)))
(DEFUN |%Bracket| #1=(|bfVar#35|) (CONS '|%Bracket| (LIST . #1#)))
(DEFUN |%UnboundedSegment| #1=(|bfVar#36|)
(CONS '|%UnboundedSegment| (LIST . #1#)))
(DEFUN |%BoundedSgement| #1=(|bfVar#37| |bfVar#38|)
(CONS '|%BoundedSgement| (LIST . #1#)))
(DEFUN |%Tuple| #1=(|bfVar#39|) (CONS '|%Tuple| (LIST . #1#)))
(DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|)
(CONS '|%ColonAppend| (LIST . #1#)))
(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#)))
(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#)))
(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#)))
(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|)
(CONS '|%PrefixExpr| (LIST . #1#)))
(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#)))
(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|)
(CONS '|%InfixExpr| (LIST . #1#)))
(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|)
(CONS '|%ConstantDefinition| (LIST . #1#)))
(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|)
(CONS '|%Definition| (LIST . #1#)))
(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|)
(CONS '|%Macro| (LIST . #1#)))
(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#)))
(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#)))
(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|)
(CONS '|%Assignment| (LIST . #1#)))
(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#)))
(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#)))
(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#)))
(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#)))
(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#)))
(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#)))
(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#)))
(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#)))
(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#)))
(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#)))
(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#)))
(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#)))
(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#)))
(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#)))
(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#)))
(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#)))
(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#)))
(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|)
(CONS '|%Structure| (LIST . #1#)))
(DEFSTRUCT (|%LoadUnit| (:COPIER |copy%LoadUnit|))
|fdefs|
|sigs|
|xports|
|csts|
|varno|
|letno|
|isno|
|sconds|
|op|)
(DEFMACRO |mk%LoadUnit|
(|fdefs| |sigs| |xports| |csts| |varno| |letno| |isno| |sconds| |op|)
(LIST '|MAKE-%LoadUnit| :|fdefs| |fdefs| :|sigs| |sigs| :|xports| |xports|
:|csts| |csts| :|varno| |varno| :|letno| |letno| :|isno| |isno|
:|sconds| |sconds| :|op| |op|))
(DEFMACRO |functionDefinitions| (|bfVar#1|) (LIST '|%LoadUnit-fdefs| |bfVar#1|))
(DEFMACRO |globalSignatures| (|bfVar#1|) (LIST '|%LoadUnit-sigs| |bfVar#1|))
(DEFMACRO |exportedNames| (|bfVar#1|) (LIST '|%LoadUnit-xports| |bfVar#1|))
(DEFMACRO |constantBindings| (|bfVar#1|) (LIST '|%LoadUnit-csts| |bfVar#1|))
(DEFMACRO |currentGensymNumber| (|bfVar#1|) (LIST '|%LoadUnit-varno| |bfVar#1|))
(DEFMACRO |letVariableNumer| (|bfVar#1|) (LIST '|%LoadUnit-letno| |bfVar#1|))
(DEFMACRO |isVariableNumber| (|bfVar#1|) (LIST '|%LoadUnit-isno| |bfVar#1|))
(DEFMACRO |sideConditions| (|bfVar#1|) (LIST '|%LoadUnit-sconds| |bfVar#1|))
(DEFMACRO |enclosingFunction| (|bfVar#1|) (LIST '|%LoadUnit-op| |bfVar#1|))
(DEFUN |makeLoadUnit| () (|mk%LoadUnit| NIL NIL NIL NIL 0 0 0 NIL NIL))
(DEFUN |pushFunctionDefinition| (|tu| |def|)
(SETF (|functionDefinitions| |tu|) (CONS |def| (|functionDefinitions| |tu|))))
(DEFPARAMETER |$inDefIS| NIL)
(DEFUN |quote| (|x|) (LIST 'QUOTE |x|))
(DEFUN |bfSpecificErrorHere| (|msg|)
(THROW :OPEN-AXIOM-CATCH-POINT
(CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootSpecificError|) |msg|))))
(DECLAIM (FTYPE (FUNCTION (|%LoadUnit|) |%Symbol|) |bfGenSymbol|))
(DEFUN |bfGenSymbol| (|tu|)
(PROGN
(SETF (|currentGensymNumber| |tu|) (+ (|currentGensymNumber| |tu|) 1))
(INTERN (CONCAT "bfVar#" (WRITE-TO-STRING (|currentGensymNumber| |tu|))))))
(DECLAIM (FTYPE (FUNCTION (|%LoadUnit|) |%Symbol|) |bfLetVar|))
(DEFUN |bfLetVar| (|tu|)
(PROGN
(SETF (|letVariableNumer| |tu|) (+ (|letVariableNumer| |tu|) 1))
(INTERN (CONCAT "LETTMP#" (WRITE-TO-STRING (|letVariableNumer| |tu|))))))
(DECLAIM (FTYPE (FUNCTION (|%LoadUnit|) |%Symbol|) |bfIsVar|))
(DEFUN |bfIsVar| (|tu|)
(PROGN
(SETF (|isVariableNumber| |tu|) (+ (|isVariableNumber| |tu|) 1))
(INTERN (CONCAT "ISTMP#" (WRITE-TO-STRING (|isVariableNumber| |tu|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Form|) |bfColon|))
(DEFUN |bfColon| (|x|) (LIST 'COLON |x|))
(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|))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|))
(DEFUN |bfSymbol| (|x|) (COND ((STRINGP |x|) |x|) (T (|quote| |x|))))
(DEFUN |bfFunction| (|x|) (LIST 'FUNCTION |x|))
(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfDot|))
(DEFUN |bfDot| () 'DOT)
(DECLAIM (FTYPE (FUNCTION (|%Form|) |%Form|) |bfSuffixDot|))
(DEFUN |bfSuffixDot| (|x|) (LIST |x| 'DOT))
(DECLAIM (FTYPE (FUNCTION (|%Form|) |%Form|) |bfEqual|))
(DEFUN |bfEqual| (|name|) (LIST 'EQUAL |name|))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfBracket|))
(DEFUN |bfBracket| (|part|) |part|)
(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|))
(DECLAIM
(FTYPE (FUNCTION ((|%List| (|%List| |%Form|))) (|%List| |%Form|)) |bfAppend|))
(DEFUN |bfAppend| (|ls|)
(LET* (|p| |r| |l|)
(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|))
(DEFUN |bfColonAppend| (|x| |y|)
(LET* (|a|)
(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 |compFluid| (|id|) (LIST '|%Dynamic| |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|))))))
(DEFUN |bfPlace| (|x|) (CONS '|%Place| |x|))
(DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|))
(DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE)))
(DEFUN |bfUntuple| (|bf|) (COND ((|bfTupleP| |bf|) (CDR |bf|)) (T |bf|)))
(DEFUN |bfTupleIf| (|x|) (COND ((|bfTupleP| |x|) |x|) (T (|bfTuple| |x|))))
(DEFUN |bfTupleConstruct| (|b|)
(LET* (|ISTMP#1| |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|)
(LET* (|a|)
(PROGN
(SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) (T (LIST |b|))))
(|bfMakeCons| |a|))))
(DEFUN |bfMakeCons| (|l|)
(LET* (|l1| |a| |ISTMP#2| |ISTMP#1|)
(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| (|tu| |lhs| |u| |step|)
(COND
((AND (CONSP |u|) (EQ (CAR |u|) '|tails|))
(|bfForTree| |tu| 'ON |lhs| (CADR |u|)))
((AND (CONSP |u|) (EQ (CAR |u|) 'SEGMENT))
(|bfSTEP| |tu| |lhs| (CADR |u|) |step| (CADDR |u|)))
((AND (CONSP |u|) (EQ (CAR |u|) '|entries|))
(|bfIterateTable| |tu| |lhs| (CADR |u|)))
(T (|bfForTree| |tu| 'IN |lhs| |u|))))
(DEFUN |bfForTree| (|tu| OP |lhs| |whole|)
(LET* (G)
(PROGN
(SETQ |whole|
(COND ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|)))
(T |whole|)))
(COND ((NOT (CONSP |lhs|)) (|bfINON| |tu| (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| |tu| (LIST OP G |whole|))
(|bfSuchthat| |tu| (|bfIS| |tu| G (CADDR |lhs|)))))
(T (SETQ G (|bfGenSymbol| |tu|))
(|append| (|bfINON| |tu| (LIST OP G |whole|))
(|bfSuchthat| |tu| (|bfIS| |tu| G |lhs|))))))))))
(DEFUN |bfSTEP| (|tu| |id| |fst| |step| |lst|)
(LET* (|suc| |ex| |pred| |final| |g2| |inc| |g1| |initval| |initvar|)
(PROGN
(COND ((EQ |id| 'DOT) (SETQ |id| (|bfGenSymbol| |tu|))))
(SETQ |initvar| (LIST |id|))
(SETQ |initval| (LIST |fst|))
(SETQ |inc|
(COND ((NOT (CONSP |step|)) |step|)
(T (SETQ |g1| (|bfGenSymbol| |tu|))
(SETQ |initvar| (CONS |g1| |initvar|))
(SETQ |initval| (CONS |step| |initval|)) |g1|)))
(SETQ |final|
(COND ((NOT (CONSP |lst|)) |lst|)
(T (SETQ |g2| (|bfGenSymbol| |tu|))
(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| (|tu| |e| |t|) (LIST '|%tbliter| |e| |t| (GENSYM)))
(DEFUN |bfINON| (|tu| |x|)
(LET* (|whole| |id| |op|)
(PROGN
(SETQ |op| (CAR |x|))
(SETQ |id| (CADR . #1=(|x|)))
(SETQ |whole| (CADDR . #1#))
(COND ((EQ |op| 'ON) (|bfON| |tu| |id| |whole|))
(T (|bfIN| |tu| |id| |whole|))))))
(DEFUN |bfIN| (|tu| |x| E)
(LET* (|exitCond| |inits| |vars| |g|)
(PROGN
(SETQ |g| (|bfGenSymbol| |tu|))
(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| (|tu| |x| E)
(LET* (|var| |init|)
(PROGN
(COND ((EQ |x| 'DOT) (SETQ |x| (|bfGenSymbol| |tu|))))
(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| (|tu| |p|) (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL)))
(DEFUN |bfWhile| (|tu| |p|)
(LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL)))
(DEFUN |bfUntil| (|tu| |p|)
(LET* (|g|)
(PROGN
(SETQ |g| (|bfGenSymbol| |tu|))
(LIST
(LIST (LIST |g|) (LIST NIL) (LIST (LIST 'SETQ |g| |p|)) NIL (LIST |g|)
NIL)))))
(DEFUN |bfIterators| (|x|) (CONS 'ITERATORS |x|))
(DEFUN |bfCross| (|x|) (CONS 'CROSS |x|))
(DEFUN |bfLp| (|tu| |iters| |body|)
(COND
((AND (CONSP |iters|) (EQ (CAR |iters|) 'ITERATORS))
(|bfLp1| |tu| (CDR |iters|) |body|))
(T (|bfLpCross| |tu| (CDR |iters|) |body|))))
(DEFUN |bfLpCross| (|tu| |iters| |body|)
(COND ((NULL (CDR |iters|)) (|bfLp| |tu| (CAR |iters|) |body|))
(T
(|bfLp| |tu| (CAR |iters|) (|bfLpCross| |tu| (CDR |iters|) |body|)))))
(DEFUN |bfSep| (|iters|)
(LET* (|r| |f|)
(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| #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| (|tu| |op| |y|)
(LET* (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
(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| |tu|))
(SETQ |g1| (|bfGenSymbol| |tu|))
(SETQ |body| (LIST 'SETQ |g| (LIST |op| |g| |g1|)))
(COND
((NULL |init|) (SETQ |g2| (|bfGenSymbol| |tu|))
(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| |tu| |g1| |ny|))))
(|bfMKPROGN| (LIST (LIST 'L%T |g2| |y|) (|bfLp| |tu| |it| |body|))))
(T (SETQ |init| (CAR |init|))
(SETQ |it|
(CONS 'ITERATORS
(LIST
(LIST
(LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|)))
(|bfIN| |tu| |g1| |y|))))
(|bfLp| |tu| |it| |body|))))))
(DEFUN |bfReduceCollect| (|tu| |op| |y|)
(LET* (|seq| |init| |a| |itl| |body|)
(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| |tu| |body| |itl| '|lastNode| '|skipNil|))
((EQ |a| '|append|)
(|bfDoCollect| |tu| (LIST '|copyList| |body|) |itl| '|lastNode|
'|skipNil|))
(T (SETQ |op| (|bfReName| |a|))
(SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
(|bfOpReduce| |tu| |op| |init| |body| |itl|))))
(T (SETQ |seq| (COND ((NULL |y|) (|bfTuple| NIL)) (T (CADR |y|))))
(|bfReduce| |tu| |op| (|bfTupleConstruct| |seq|))))))
(DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|))
(DEFUN |bfDTuple| (|x|) (LIST 'DTUPLE |x|))
(DEFUN |bfCollect| (|tu| |y| |itl|)
(LET* (|a| |ISTMP#1|)
(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| |tu| |a| |itl| '|lastNode| '|skipNil|))
(T
(|bfDoCollect| |tu| (LIST '|copyList| |a|) |itl| '|lastNode|
'|skipNil|))))
((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE))
(|bfDoCollect| |tu| (|bfConstruct| |y|) |itl| '|lastNode| '|skipNil|))
(T (|bfDoCollect| |tu| (LIST 'CONS |y| 'NIL) |itl| 'CDR NIL)))))
(DEFUN |bfMakeCollectInsn| (|expr| |prev| |head| |adv|)
(LET* (|otherTime| |firstTime|)
(PROGN
(SETQ |firstTime|
(|bfMKPROGN|
(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|))))
(DEFUN |bfDoCollect| (|tu| |expr| |itl| |adv| |k|)
(LET* (|extrait| |body| |x| |prev| |head|)
(PROGN
(SETQ |head| (|bfGenSymbol| |tu|))
(SETQ |prev| (|bfGenSymbol| |tu|))
(SETQ |body|
(COND
((EQ |k| '|skipNil|) (SETQ |x| (|bfGenSymbol| |tu|))
(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| |tu| |extrait| |itl| |body|))))
(DEFUN |separateIterators| (|iters|)
(LET* (|y| |x|)
(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 |bfTableIteratorBindingForm| (|tu| |keyval| |end?| |succ|)
(LET* (|k| |v| |val| |ISTMP#2| |key| |ISTMP#1|)
(COND
((AND (CONSP |keyval|) (EQ (CAR |keyval|) 'CONS)
(PROGN
(SETQ |ISTMP#1| (CDR |keyval|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |key| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
(PROGN (SETQ |val| (CAR |ISTMP#2|)) T))))))
(COND ((EQ |key| 'DOT) (SETQ |key| (GENSYM))))
(COND ((EQ |val| 'DOT) (SETQ |val| (GENSYM))))
(COND
((AND (|ident?| |key|) (|ident?| |val|))
(LIST 'MULTIPLE-VALUE-BIND (LIST |end?| |key| |val|) (LIST |succ|)))
((|ident?| |key|) (SETQ |v| (GENSYM))
(LIST 'MULTIPLE-VALUE-BIND (LIST |end?| |key| |v|) (LIST |succ|)
(|bfLET| |tu| |val| |v|)))
(T (SETQ |k| (GENSYM))
(COND
((|ident?| |val|)
(LIST 'MULTIPLE-VALUE-BIND (LIST |end?| |k| |val|) (LIST |succ|)
(|bfLET| |tu| |key| |k|)))
(T (SETQ |v| (GENSYM))
(LIST 'MULTIPLE-VALUE-BIND (LIST |end?| |k| |v|) (LIST |succ|)
(|bfLET| |tu| |key| |k|) (|bfLET| |tu| |val| |v|)))))))
(T (SETQ |k| (GENSYM)) (SETQ |v| (GENSYM))
(LIST 'MULTIPLE-VALUE-BIND (LIST |end?| |k| |v|) (LIST |succ|)
(|bfLET| |tu| |keyval| (LIST 'CONS |k| |v|)))))))
(DEFUN |bfExpandTableIters| (|tu| |iters|)
(LET* (|x| |g| |ISTMP#2| |t| |ISTMP#1| |e| |exits| |localBindings| |inits|)
(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|))
(SETQ |localBindings|
(CONS (|bfTableIteratorBindingForm| |tu| |e| |x| |g|)
|localBindings|))))))
(SETQ |bfVar#2| (CDR |bfVar#2|))))
(LIST |inits| |localBindings| |exits|))))
(DEFUN |bfLp1| (|tu| |iters| |body|)
(LET* (|loop|
|nbody|
|tblExits|
|tblLocs|
|tblInits|
|value|
|exits|
|filters|
|sucs|
|inits|
|vars|
|tbls|
|LETTMP#1|)
(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| |tu| |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| (|tu| |extrait| |itl| |body|)
(LET* (|iters|)
(COND
((AND (CONSP |itl|) (EQ (CAR |itl|) 'ITERATORS))
(|bfLp1| |tu| (CONS |extrait| (CDR |itl|)) |body|))
(T (SETQ |iters| (CDR |itl|))
(|bfLpCross| |tu|
(CONS (CONS 'ITERATORS (CONS |extrait| (CDAR |iters|)))
(CDR |iters|))
|body|)))))
(DEFUN |bfOpReduce| (|tu| |op| |init| |y| |itl|)
(LET* (|extrait| |g1| |body| |g|)
(PROGN
(SETQ |g| (|bfGenSymbol| |tu|))
(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| |tu|))
(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| |tu| |extrait| |itl| |body|))))
(T (SETQ |init| (CAR |init|))
(SETQ |extrait|
(LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|))))
(|bfLp2| |tu| |extrait| |itl| |body|))))))
(DEFUN |bfLoop1| (|tu| |body|) (|bfLp| |tu| (|bfIterators| NIL) |body|))
(DEFUN |bfSegment1| (|lo|) (LIST 'SEGMENT |lo| NIL))
(DEFUN |bfSegment2| (|lo| |hi|) (LIST 'SEGMENT |lo| |hi|))
(DEFUN |bfForInBy| (|tu| |variable| |collection| |step|)
(|bfFor| |tu| |variable| |collection| |step|))
(DEFUN |bfForin| (|tu| |lhs| U) (|bfFor| |tu| |lhs| U 1))
(DEFUN |bfSignature| (|a| |b|)
(COND ((EQ |b| '|local|) (|compFluid| |a|)) (T (LIST '|%Signature| |a| |b|))))
(DEFUN |bfTake| (|n| |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|)))))
(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|))))))
(DEFUN |bfSUBLIS1| (|p| |e|)
(LET* (|f|)
(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| (|tu| |x|)
(LET* (|defstack| |op1| |opassoc| |argl|)
(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| (|translateForm| |body|))))
(LIST |opassoc| NIL NIL))
(T
(SETQ |op1|
(INTERN
(CONCAT (SYMBOL-NAME (|enclosingFunction| |tu|)) ","
(SYMBOL-NAME |op|))))
(SETQ |opassoc| (LIST (CONS |op| |op1|)))
(SETQ |defstack|
(LIST (LIST |op1| |args| (|translateForm| |body|))))
(LIST |opassoc| |defstack| NIL))))))
(|%Pile|
(LET ((|defs| (CADR |x|)))
(|defSheepAndGoatsList| |tu| |defs|)))
(T (LIST NIL NIL (LIST |x|))))))
(DEFUN |defSheepAndGoatsList| (|tu| |x|)
(LET* (|nondefs1| |defs1| |opassoc1| |nondefs| |defs| |opassoc| |LETTMP#1|)
(COND ((NULL |x|) (LIST NIL NIL NIL))
(T (SETQ |LETTMP#1| (|defSheepAndGoats| |tu| (CAR |x|)))
(SETQ |opassoc| (CAR |LETTMP#1|))
(SETQ |defs| (CADR . #1=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #1#))
(SETQ |LETTMP#1| (|defSheepAndGoatsList| |tu| (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| (|tu| |lhs| |rhs|)
(LET* (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|)
(COND ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
((OR
(AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Dynamic|)
(PROGN
(SETQ |ISTMP#1| (CDR |lhs|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
(AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|)))
(|bfLetForm| |lhs| |rhs|))
((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
(SETQ |rhs1| (|bfLET2| |tu| |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| |tu| |name| (CADDR |rhs|)))
(SETQ |l2| (|bfLET1| |tu| |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| |tu|)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
(SETQ |let1| (|bfLET1| |tu| |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))))))))))
(DEFUN |bfCONTAINED| (|x| |y|)
(COND ((EQ |x| |y|) T) ((NOT (CONSP |y|)) NIL)
(T (OR (|bfCONTAINED| |x| (CAR |y|)) (|bfCONTAINED| |x| (CDR |y|))))))
(DEFUN |bfLET2| (|tu| |lhs| |rhs|)
(LET* (|isPred|
|val1|
|ISTMP#3|
|g|
|rev|
|patrev|
|l2|
|l1|
|var2|
|var1|
|b|
|ISTMP#2|
|a|
|ISTMP#1|)
(DECLARE (SPECIAL |$inDefIS|))
(COND ((NULL |lhs|) NIL) ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Dynamic|)
(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| |tu| |a| |rhs|))
(COND ((NULL (SETQ |b| (|bfLET2| |tu| |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| |tu| |var2| (|addCARorCDR| 'CDR |rhs|)))
(T (SETQ |l1| (|bfLET2| |tu| |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| |tu| |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| |tu|))
(SETQ |l2| (|bfLET2| |tu| |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| |tu| |rhs| |lhs|))
(T (|bfIS| |tu| |rhs| |lhs|))))
(LIST 'COND (LIST |isPred| |rhs|))))))
(DEFUN |bfLET| (|tu| |lhs| |rhs|)
(LET* (|letno|)
(PROGN
(SETQ |letno| (|letVariableNumer| |tu|))
(UNWIND-PROTECT
(PROGN (SETF (|letVariableNumer| |tu|) 0) (|bfLET1| |tu| |lhs| |rhs|))
(SETF (|letVariableNumer| |tu|) |letno|)))))
(DEFUN |addCARorCDR| (|acc| |expr|)
(LET* (|funsR| |funsA| |p| |funs|)
(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)))))
(DEFUN |bfISApplication| (|tu| |op| |left| |right|)
(COND ((EQ |op| 'IS) (|bfIS| |tu| |left| |right|))
((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |tu| |left| |right|)))
(T (LIST |op| |left| |right|))))
(DEFUN |bfIS| (|tu| |left| |right|)
(LET* (|isno|)
(PROGN
(SETQ |isno| (|isVariableNumber| |tu|))
(UNWIND-PROTECT
(PROGN
(SETF (|isVariableNumber| |tu|) 0)
(LET ((|$inDefIS| T))
(DECLARE (SPECIAL |$inDefIS|))
(|bfIS1| |tu| |left| |right|)))
(SETF (|isVariableNumber| |tu|) |isno|)))))
(DEFUN |bfISReverse| (|x| |a|)
(LET* (|y|)
(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 (|bfSpecificErrorHere| "Error in bfISReverse")))))
(DEFUN |bfIS1| (|tu| |lhs| |rhs|)
(LET* (|l2|
|rev|
|patrev|
|cls|
|b1|
|a1|
|g|
|b|
|ISTMP#2|
|ISTMP#1|
|l|
|d|
|c|
|a|)
(COND ((NULL |rhs|) (LIST 'NULL |lhs|))
((EQ |rhs| T) (LIST 'EQ |lhs| |rhs|))
((|bfString?| |rhs|)
(|bfAND| (LIST (LIST 'STRINGP |lhs|) (LIST 'STRING= |lhs| |rhs|))))
((OR (|bfChar?| |rhs|) (INTEGERP |rhs|)) (LIST 'EQL |lhs| |rhs|))
((KEYWORDP |rhs|) (LIST 'EQ |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| |tu| |c| |lhs|))
(|bfAND|
(LIST (|bfIS1| |tu| |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| |tu|))
(|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |tu| |g| |rhs|))))
((EQ (CAR |rhs|) 'CONS) (SETQ |a| (CADR . #2=(|rhs|)))
(SETQ |b| (CADDR . #2#))
(COND
((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| |tu| (LIST 'CDR |lhs|) |b|))))))
((NULL |b|)
(|bfAND|
(LIST (LIST 'CONSP |lhs|) (LIST 'NULL (LIST 'CDR |lhs|))
(|bfIS1| |tu| (LIST 'CAR |lhs|) |a|))))
((EQ |b| 'DOT)
(|bfAND|
(LIST (LIST 'CONSP |lhs|) (|bfIS1| |tu| (LIST 'CAR |lhs|) |a|))))
(T (SETQ |a1| (|bfIS1| |tu| (LIST 'CAR |lhs|) |a|))
(SETQ |b1| (|bfIS1| |tu| (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 . #3=(|rhs|)))
(SETQ |b| (CADDR . #3#)) (SETQ |patrev| (|bfISReverse| |b| |a|))
(SETQ |g| (|bfIsVar| |tu|))
(SETQ |rev|
(|bfAND|
(LIST (LIST 'CONSP |lhs|)
(LIST 'PROGN (LIST 'L%T |g| (LIST '|reverse| |lhs|))
'T))))
(SETQ |l2| (|bfIS1| |tu| |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 (|bfSpecificErrorHere| "bad IS code is generated")))))
(DEFUN |bfHas| (|expr| |prop|)
(COND ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|)))
(T (|bfSpecificErrorHere| "expected identifier as property name"))))
(DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|))
(DEFUN |bfInert| (|x|) (INTERN |x| "KEYWORD"))
(DEFUN |lispKey| (|k|) (|bfInert| (STRING-UPCASE (SYMBOL-NAME |k|))))
(DEFUN |bfExpandKeys| (|l|)
(LET* (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|)
(PROGN
(SETQ |args| NIL)
(LOOP
(COND
((NOT
(AND (CONSP |l|) (PROGN (SETQ |a| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
(RETURN NIL))
((AND (CONSP |a|) (EQ (CAR |a|) '|%Key|)
(PROGN
(SETQ |ISTMP#1| (CDR |a|))
(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 |x| (CAR |ISTMP#2|)) T))))))
(SETQ |args| (CONS |x| (CONS (|lispKey| |k|) |args|))))
(T (SETQ |args| (CONS |a| |args|)))))
(|reverse!| |args|))))
(DEFUN |bfApplication| (|bfop| |bfarg|)
(LET* (|v| |ISTMP#2| |k| |ISTMP#1|)
(COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|))))
((AND (CONSP |bfarg|) (EQ (CAR |bfarg|) '|%Key|)
(PROGN
(SETQ |ISTMP#1| (CDR |bfarg|))
(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 |v| (CAR |ISTMP#2|)) T))))))
(LIST |bfop| (|lispKey| |k|) |v|))
(T (LIST |bfop| |bfarg|)))))
(DEFUN |bfReName| (|x|)
(LET* (|a|)
(COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) (T |x|))))
(DEFUN |sequence?| (|x| |pred|)
(LET* (|seq| |ISTMP#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| (FUNCALL |pred| |y|))
(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|))))))
(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|))))))
(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|))))))
(DEFUN |bfMember| (|var| |seq|)
(LET* (|y| |x| |ISTMP#2| |ISTMP#1|)
(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|))))
(DEFUN |bfNOT| (|x|)
(LET* (|a| |ISTMP#1|)
(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|))))
(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
((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|)
(SETQ |bfVar#3| (|lastNode| |bfVar#3|)))))))
(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
((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|)
(SETQ |bfVar#3| (|lastNode| |bfVar#3|)))))))
(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)))))
(DEFUN |bfNumber?| (|x|)
(OR (INTEGERP |x|) (FLOATP |x|)
(AND (CONSP |x|)
(|symbolMember?| (CAR |x|) '(SIZE LENGTH CHAR-CODE MAXINDEX + -)))))
(DEFUN |bfString?| (|x|)
(OR (STRINGP |x|)
(AND (CONSP |x|)
(|symbolMember?| (CAR |x|) '(STRING SYMBOL-NAME |subString|)))))
(DEFUN |bfQ| (|l| |r|)
(COND ((OR (|bfChar?| |l|) (|bfChar?| |r|)) (LIST 'CHAR= |l| |r|))
((OR (|bfNumber?| |l|) (|bfNumber?| |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 ((AND (OR (INTEGERP |l|) (FLOATP |l|)) (EQL |l| 0)) (LIST 'PLUSP |r|))
((AND (OR (INTEGERP |r|) (FLOATP |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|)))
(DEFUN |bfMDef| (|tu| |op| |args| |body|)
(LET* (|def| |lamex| |argl|)
(PROGN
(SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|))))
(SETQ |lamex| (LIST 'MLAMBDA |argl| (|backquote| |body| |argl|)))
(SETQ |def| (LIST |op| |lamex|))
(CONS (|shoeComp| |def|)
(LET ((|bfVar#2| NIL)
(|bfVar#3| NIL)
(|bfVar#1| (|sideConditions| |tu|))
(|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| |tu| |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 |bfGargl| (|tu| |argl|)
(LET* (|f| |d| |c| |b| |a| |LETTMP#1|)
(COND ((NULL |argl|) (LIST NIL NIL NIL NIL))
(T (SETQ |LETTMP#1| (|bfGargl| |tu| (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|))))
(T (SETQ |f| (|bfGenSymbol| |tu|))
(LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
(CONS |f| |d|))))))))
(DEFUN |bfDef1| (|tu| |bfVar#1|)
(LET* (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op|)
(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| |tu| |argl| |body|))
(SETQ |quotes| (CAR |LETTMP#1|))
(SETQ |control| (CADR . #2=(|LETTMP#1|)))
(SETQ |arglp| (CADDR . #2#))
(SETQ |body| (CADDDR . #2#))
(COND (|quotes| (|shoeLAM| |tu| |op| |arglp| |control| |body|))
(T (LIST (LIST |op| (LIST 'LAMBDA |arglp| |body|))))))))
(DEFUN |shoeLAM| (|tu| |op| |args| |control| |body|)
(LET* (|innerfunc| |margs|)
(PROGN
(SETQ |margs| (|bfGenSymbol| |tu|))
(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| (|tu| |op| |args| |body|)
(LET* (|body1| |arg1| |op1| |LETTMP#1|)
(DECLARE (SPECIAL |$bfClamming|))
(COND
(|$bfClamming|
(SETQ |LETTMP#1|
(|shoeComp| (CAR (|bfDef1| |tu| (LIST |op| |args| |body|)))))
(SETQ |op1| (CADR . #1=(|LETTMP#1|))) (SETQ |arg1| (CADDR . #1#))
(SETQ |body1| (CDDDR . #1#)) (|bfCompHash| |tu| |op1| |arg1| |body1|))
(T
(|bfTuple|
(LET ((|bfVar#2| NIL)
(|bfVar#3| NIL)
(|bfVar#1|
(CONS (LIST |op| |args| |body|) (|sideConditions| |tu|)))
(|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| |tu| |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| #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|)
(LET* (|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)))
(|bfSpecificErrorHere| "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| (|tu| |x| |body|)
(LET* (|body2|
|name2|
|norq1|
|b1|
|body1|
|name1|
|norq|
|LETTMP#1|
|b|
|a|
|ISTMP#1|)
(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)
(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| |tu| (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| |tu| (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| (|tu| |y| |body|)
(LET* (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
(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| |tu| |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| |tu|))
(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| |tu| (|compFluidize| |y|) |g|)
|body|)))))))))))
(DEFUN |shoeCompTran| (|x|)
(LET* (|fl|
|vars|
|fvars|
|body'|
|dollarVars|
|locVars|
|fluidVars|
|body|
|args|
|lamtype|)
(PROGN
(SETQ |lamtype| (CAR |x|))
(SETQ |args| (CADR . #1=(|x|)))
(SETQ |body| (CDDR . #1#))
(SETQ |fluidVars| (|ref| NIL))
(SETQ |locVars| (|ref| NIL))
(SETQ |dollarVars| (|ref| NIL))
(|shoeCompTran1| |body| |fluidVars| |locVars| |dollarVars|)
(SETF (|deref| |locVars|)
(|setDifference|
(|setDifference| (|deref| |locVars|) (|deref| |fluidVars|))
(|shoeATOMs| |args|)))
(SETQ |body|
(PROGN
(SETQ |body'| |body|)
(COND
((SETQ |fvars|
(|setDifference| (|deref| |dollarVars|)
(|deref| |fluidVars|)))
(SETQ |body'|
(CONS (LIST 'DECLARE (CONS 'SPECIAL |fvars|))
|body'|))))
(COND
((SETQ |vars| (|deref| |locVars|))
(|declareLocalVars| |vars| |body'|))
(T (|maybeAddBlock| |body'|)))))
(COND
((SETQ |fl| (|shoeFluids| |args|))
(SETQ |body| (CONS (LIST 'DECLARE (CONS 'SPECIAL |fl|)) |body|))))
(CONS |lamtype| (CONS |args| |body|)))))
(DEFUN |declareLocalVars| (|vars| |stmts|)
(LET* (|inits| |ISTMP#2| |ISTMP#1|)
(COND
((AND (CONSP |stmts|) (NULL (CDR |stmts|))
(PROGN
(SETQ |ISTMP#1| (CAR |stmts|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET*)
(PROGN
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|)
(PROGN
(SETQ |inits| (CAR |ISTMP#2|))
(SETQ |stmts| (CDR |ISTMP#2|))
T))))))
(LIST
(CONS 'LET*
(CONS (|append| |inits| |vars|) (|maybeAddBlock| |stmts|)))))
(T (LIST (CONS 'LET* (CONS |vars| (|maybeAddBlock| |stmts|))))))))
(DEFUN |maybeAddBlock| (|stmts|)
(LET* (|decls| |expr| |LETTMP#1|)
(PROGN
(SETQ |LETTMP#1| (|reverse| |stmts|))
(SETQ |expr| (CAR |LETTMP#1|))
(SETQ |decls| (|reverse!| (CDR |LETTMP#1|)))
(COND
((|hasReturn?| |expr|)
(COND ((NULL |decls|) (LIST (CONS 'BLOCK (CONS 'NIL |stmts|))))
(T (|append| |decls| (CONS (LIST 'BLOCK 'NIL |expr|) NIL)))))
(T |stmts|)))))
(DEFUN |hasReturn?| (|x|)
(COND ((NOT (CONSP |x|)) NIL) ((EQ (CAR |x|) 'RETURN) T)
((|symbolMember?| (CAR |x|) '(LOOP PROG BLOCK LAMBDA DECLARE)) NIL)
(T
(LET ((|bfVar#2| NIL) (|bfVar#1| |x|) (|t| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#1|))
(PROGN (SETQ |t| (CAR |bfVar#1|)) NIL))
(RETURN |bfVar#2|))
(T (SETQ |bfVar#2| (|hasReturn?| |t|))
(COND (|bfVar#2| (RETURN |bfVar#2|)))))
(SETQ |bfVar#1| (CDR |bfVar#1|)))))))
(DEFUN |shoeFluids| (|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|))))))
(DEFUN |isDynamicVariable| (|x|)
(LET* (|y|)
(DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|))
(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| |fluidVars| |locVars| |dollarVars|)
(LET* (|n| |elts| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| U)
(COND
((NOT (CONSP |x|))
(COND
((AND (|isDynamicVariable| |x|)
(NOT (|symbolMember?| |x| (|deref| |dollarVars|))))
(SETF (|deref| |dollarVars|) (CONS |x| (|deref| |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))))
(SETF (CADR |x|)
(|shoeCompTran1| |y| |fluidVars| |locVars| |dollarVars|))
(LOOP
(COND ((NOT |zs|) (RETURN NIL))
(T
(SETF (CADR (CAR |zs|))
(|shoeCompTran1| (CADR (CAR |zs|)) |fluidVars|
|locVars| |dollarVars|))
(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))))))
(SETF (CADDR |x|)
(|shoeCompTran1| |r| |fluidVars| |locVars| |dollarVars|))
(COND
((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|)
(PROGN
(SETQ |ISTMP#1| (CDR |l|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
(COND
((NOT (|symbolMember?| |y| (|deref| |fluidVars|)))
(SETF (|deref| |fluidVars|)
(CONS |y| (|deref| |fluidVars|)))))
(SETF (CADR |x|) |y|) |x|)
((AND (CONSP |l|) (EQ (CAR |l|) '|%Signature|)) |x|)
(T (RPLACA |x| 'SETQ)
(COND
((SYMBOLP |l|)
(COND
((|bfBeginsDollar| |l|)
(COND
((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
(SETF (|deref| |dollarVars|)
(CONS |l| (|deref| |dollarVars|)))))
|x|)
(T
(COND
((NOT (|symbolMember?| |l| (|deref| |locVars|)))
(SETF (|deref| |locVars|)
(CONS |l| (|deref| |locVars|)))))
|x|)))
(T |x|)))))
((EQ U '|%Leave|) (RPLACA |x| 'RETURN)
(RPLACD |x|
(|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
|dollarVars|))
|x|)
((|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| (|deref| |locVars|)))
(IDENTITY
(PROGN
(SETF (|deref| |locVars|) (CONS |y| (|deref| |locVars|)))
(SETQ |newbindings| (CONS |y| |newbindings|))))))
(SETQ |bfVar#1| (CDR |bfVar#1|))))
(RPLACD (CDR |x|)
(|shoeCompTran1| (CDDR |x|) |fluidVars| |locVars|
|dollarVars|))
(SETF (|deref| |locVars|)
(LET ((|bfVar#3| NIL)
(|bfVar#4| NIL)
(|bfVar#2| (|deref| |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| #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))))
(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|) |fluidVars| |locVars|
|dollarVars|)))
((NOT (CONSP |elts|))
(SETQ |elts|
(|shoeCompTran1| |elts| |fluidVars| |locVars|
|dollarVars|))
(RPLACA |x| 'MAKE-ARRAY)
(RPLACD |x|
(LIST (LIST 'LIST-LENGTH |elts|) :INITIAL-CONTENTS
|elts|)))
(T (RPLACA |x| 'COERCE)
(RPLACD |x|
(LIST
(|shoeCompTran1| |elts| |fluidVars| |locVars|
|dollarVars|)
(|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|)))))
(T
(RPLACA |x|
(|shoeCompTran1| (CAR |x|) |fluidVars| |locVars|
|dollarVars|))
(RPLACD |x|
(|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
|dollarVars|))
(|bindFluidVars!| |x|)))))))
(DEFUN |bindFluidVars!| (|x|)
(LET* (|y|
|init|
|stmts|
|expr|
|ISTMP#6|
|t|
|ISTMP#5|
|v|
|ISTMP#4|
|ISTMP#3|
|ISTMP#2|
|ISTMP#1|)
(COND
((AND (CONSP |x|)
(PROGN
(SETQ |ISTMP#1| (CAR |x|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T)
(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 |expr| (CAR |ISTMP#6|)) T))))))))
(SETQ |stmts| (CDR |x|))
(RPLACA |x|
(COND
((NULL |stmts|)
(LIST 'LET (LIST (LIST |v| |expr|))
(LIST 'DECLARE (LIST 'TYPE |t|)) |v|))
(T
(CONS 'LET
(CONS (LIST (LIST |v| |expr|))
(CONS (LIST 'DECLARE (LIST 'TYPE |t|))
(|bindFluidVars!| |stmts|)))))))
(RPLACD |x| NIL) |x|)
(T
(COND
((AND (CONSP |x|)
(PROGN
(SETQ |ISTMP#1| (CAR |x|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T)
(PROGN (SETQ |init| (CDR |ISTMP#1|)) T)))
(PROGN (SETQ |stmts| (CDR |x|)) T))
(RPLACA |x|
(|groupFluidVars| (LIST |init|) (LIST (CAR |init|)) |stmts|))
(RPLACD |x| NIL)))
(COND
((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
|y|)
(T |x|))))))
(DEFUN |groupFluidVars| (|inits| |vars| |stmts|)
(LET* (|stmts'|
|vars'|
|ISTMP#6|
|ISTMP#5|
|ISTMP#4|
|ISTMP#3|
|inits'|
|ISTMP#2|
|ISTMP#1|)
(COND
((AND (CONSP |stmts|) (NULL (CDR |stmts|))
(PROGN
(SETQ |ISTMP#1| (CAR |stmts|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET)
(PROGN
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|)
(PROGN
(SETQ |inits'| (CAR |ISTMP#2|))
(SETQ |ISTMP#3| (CDR |ISTMP#2|))
(AND (CONSP |ISTMP#3|)
(PROGN
(SETQ |ISTMP#4| (CAR |ISTMP#3|))
(AND (CONSP |ISTMP#4|)
(EQ (CAR |ISTMP#4|) 'DECLARE)
(PROGN
(SETQ |ISTMP#5| (CDR |ISTMP#4|))
(AND (CONSP |ISTMP#5|)
(NULL (CDR |ISTMP#5|))
(PROGN
(SETQ |ISTMP#6| (CAR |ISTMP#5|))
(AND (CONSP |ISTMP#6|)
(EQ (CAR |ISTMP#6|) 'SPECIAL)
(PROGN
(SETQ |vars'| (CDR |ISTMP#6|))
T)))))))
(PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T)))))))
(CONSP |inits'|) (NULL (CDR |inits'|)))
(|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
|stmts'|))
((AND (CONSP |stmts|) (NULL (CDR |stmts|))
(PROGN
(SETQ |ISTMP#1| (CAR |stmts|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET*)
(PROGN
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|)
(PROGN
(SETQ |inits'| (CAR |ISTMP#2|))
(SETQ |ISTMP#3| (CDR |ISTMP#2|))
(AND (CONSP |ISTMP#3|)
(PROGN
(SETQ |ISTMP#4| (CAR |ISTMP#3|))
(AND (CONSP |ISTMP#4|)
(EQ (CAR |ISTMP#4|) 'DECLARE)
(PROGN
(SETQ |ISTMP#5| (CDR |ISTMP#4|))
(AND (CONSP |ISTMP#5|)
(NULL (CDR |ISTMP#5|))
(PROGN
(SETQ |ISTMP#6| (CAR |ISTMP#5|))
(AND (CONSP |ISTMP#6|)
(EQ (CAR |ISTMP#6|) 'SPECIAL)
(PROGN
(SETQ |vars'| (CDR |ISTMP#6|))
T)))))))
(PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T))))))))
(|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
|stmts'|))
((AND (CONSP |inits|) (NULL (CDR |inits|)))
(LIST 'LET |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
(|bfMKPROGN| |stmts|)))
(T
(LIST 'LET* |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
(|bfMKPROGN| |stmts|))))))
(DEFUN |bfRestrict| (|x| |t|) (LIST 'THE |t| |x|))
(DEFUN |bfAssign| (|tu| |l| |r|)
(LET* (|l'|)
(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| |tu| |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|))))
(DEFUN |bfElt| (|expr| |sel|)
(LET* (|y|)
(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|)
(LET* (|y|)
(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|)
(LET* (|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|)
(LET* (|c1| |b1|)
(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 |bfFlattenSeq| (|l|)
(LET* (|xs| |x|)
(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|)))
(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|)))))
(DEFUN |bfWashCONDBranchBody| (|x|)
(LET* (|y|)
(COND ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)) (SETQ |y| (CDR |x|)) |y|)
(T (LIST |x|)))))
(DEFUN |bfAlternative| (|a| |b|)
(LET* (|conds| |ISTMP#5| |stmt| |ISTMP#4| |ISTMP#3| |ISTMP#2| |ISTMP#1|)
(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|)
(LET* (|f|
|aft|
|before|
|no|
|transform|
|b|
|ISTMP#5|
|ISTMP#4|
|ISTMP#3|
|a|
|ISTMP#2|
|ISTMP#1|)
(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|))
(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|))
(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|)))))))
((NULL |aft|) (CONS 'COND |transform|))
(T
(CONS 'COND
(|append| |transform|
(CONS (|bfAlternative| 'T (|bfSequence| |aft|))
NIL)))))))))
(DEFUN |bfWhere| (|tu| |context| |expr|)
(LET* (|a| |nondefs| |defs| |opassoc| |LETTMP#1|)
(PROGN
(SETQ |LETTMP#1| (|defSheepAndGoats| |tu| |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|
#2=(CONS
(LIST (CAR |d|) (CADR |d|)
(|bfSUBLIS| |opassoc| (CADDR |d|)))
NIL))
(SETQ |bfVar#3| |bfVar#2|))
(T (RPLACD |bfVar#3| #2#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
(SETQ |bfVar#1| (CDR |bfVar#1|)))))
(SETF (|sideConditions| |tu|) (|append| |a| (|sideConditions| |tu|)))
(|bfMKPROGN| (|bfSUBLIS| |opassoc| (|append!| |nondefs| (LIST |expr|)))))))
(DEFUN |bfCompHash| (|tu| |op| |argl| |body|)
(LET* (|computeFunction| |auxfn|)
(PROGN
(SETQ |auxfn| (INTERN (CONCAT (SYMBOL-NAME |op|) ";")))
(SETQ |computeFunction| (CONS 'DEFUN (CONS |auxfn| (CONS |argl| |body|))))
(|bfTuple| (CONS |computeFunction| (|bfMain| |tu| |auxfn| |op|))))))
(DEFUN |shoeCompileTimeEvaluation| (|x|)
(LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|))
(DEFUN |bfMain| (|tu| |auxfn| |op|)
(LET* (|defCode|
|cacheVector|
|cacheCountCode|
|cacheResetCode|
|cacheType|
|mainFunction|
|codeBody|
|thirdPredPair|
|putCode|
|secondPredPair|
|getCode|
|g2|
|cacheName|
|computeValue|
|arg|
|g1|)
(PROGN
(SETQ |g1| (|bfGenSymbol| |tu|))
(SETQ |arg| (LIST '&REST |g1|))
(SETQ |computeValue| (LIST 'APPLY (LIST 'FUNCTION |auxfn|) |g1|))
(SETQ |cacheName| (INTERN (CONCAT (SYMBOL-NAME |op|) ";AL")))
(SETQ |g2| (|bfGenSymbol| |tu|))
(SETQ |getCode| (LIST 'GETHASH |g1| |cacheName|))
(SETQ |secondPredPair| (LIST (LIST 'SETQ |g2| |getCode|) |g2|))
(SETQ |putCode| (LIST 'SETF |getCode| |computeValue|))
(SETQ |thirdPredPair| (LIST 'T |putCode|))
(SETQ |codeBody|
(LIST 'PROG (LIST |g2|)
(LIST 'RETURN
(LIST 'COND |secondPredPair| |thirdPredPair|))))
(SETQ |mainFunction| (LIST 'DEFUN |op| |arg| |codeBody|))
(SETQ |cacheType| '|hash-table|)
(SETQ |cacheResetCode|
(LIST 'SETQ |cacheName| (LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL))))
(SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|))
(SETQ |cacheVector|
(LIST |op| |cacheName| |cacheType| |cacheResetCode|
|cacheCountCode|))
(SETQ |defCode|
(LIST 'DEFPARAMETER |cacheName|
(LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL))))
(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|))))
(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|)))
(DECLAIM (FTYPE (FUNCTION (|%LoadUnit| |%Thing|) |%Form|) |bfCreateDef|))
(DEFUN |bfCreateDef| (|tu| |x|)
(LET* (|a| |f|)
(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| |tu|) 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|))
(DEFUN |bfCaseItem| (|x| |y|) (LIST |x| |y|))
(DECLAIM (FTYPE (FUNCTION (|%LoadUnit| |%Thing| |%Thing|) |%Form|) |bfCase|))
(DEFUN |bfCase| (|tu| |x| |y|)
(LET* (|body| |g|)
(PROGN
(SETQ |g| (COND ((NOT (CONSP |x|)) |x|) (T (|bfGenSymbol| |tu|))))
(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|))
(DEFUN |bfCaseItems| (|g| |x|)
(LET* (|j| |ISTMP#1| |i|)
(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|)
(LET* (|b| |a|)
(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|
#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|))
(DECLAIM (FTYPE (FUNCTION (|%Short|) |%String|) |bfDs|))
(DEFUN |bfDs| (|n|) (COND ((EQL |n| 0) "") (T (CONCAT "D" (|bfDs| (- |n| 1))))))
(DEFUN |ctorName| (|x|) (COND ((CONSP |x|) (|ctorName| (CAR |x|))) (T |x|)))
(DEFUN |bfEnum| (|t| |csts|)
(LIST 'DEFTYPE (|ctorName| |t|) NIL (|backquote| (CONS 'MEMBER |csts|) NIL)))
(DEFUN |bfRecordDef| (|tu| |s| |fields| |accessors|)
(LET* (|accDefs|
|f|
|acc|
|ctorDef|
|args|
|recDef|
|ctor|
|fun|
|parms|
|ISTMP#2|
|x|
|ISTMP#1|)
(PROGN
(SETQ |s| (|ctorName| |s|))
(SETQ |parms|
(LET ((|bfVar#2| NIL)
(|bfVar#3| NIL)
(|bfVar#1| |fields|)
(|f| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#1|))
(PROGN (SETQ |f| (CAR |bfVar#1|)) NIL))
(RETURN |bfVar#2|))
(T
(AND (CONSP |f|) (EQ (CAR |f|) '|%Signature|)
(PROGN
(SETQ |ISTMP#1| (CDR |f|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))))))
(COND
((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS |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 |fun| (INTERN (CONCAT "mk" (SYMBOL-NAME |s|))))
(SETQ |ctor| (INTERN (CONCAT "MAKE-" (SYMBOL-NAME |s|))))
(SETQ |recDef|
(CONS 'DEFSTRUCT
(CONS
(LIST |s|
(LIST (|bfColonColon| 'KEYWORD 'COPIER)
(INTERN (CONCAT "copy" (SYMBOL-NAME |s|)))))
(LET ((|bfVar#6| NIL)
(|bfVar#7| NIL)
(|bfVar#5| |fields|)
(|bfVar#4| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#5|))
(PROGN (SETQ |bfVar#4| (CAR |bfVar#5|)) NIL))
(RETURN |bfVar#6|))
(T
(AND (CONSP |bfVar#4|)
(EQ (CAR |bfVar#4|) '|%Signature|)
(PROGN
(SETQ |ISTMP#1| (CDR |bfVar#4|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|)
(NULL (CDR |ISTMP#2|))))))
(COND
((NULL |bfVar#6|)
(SETQ |bfVar#6| #2=(CONS |x| NIL))
(SETQ |bfVar#7| |bfVar#6|))
(T (RPLACD |bfVar#7| #2#)
(SETQ |bfVar#7| (CDR |bfVar#7|)))))))
(SETQ |bfVar#5| (CDR |bfVar#5|)))))))
(SETQ |ctorDef|
(PROGN
(SETQ |args|
(LET ((|bfVar#9| NIL)
(|bfVar#10| NIL)
(|bfVar#8| |parms|)
(|p| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#8|))
(PROGN (SETQ |p| (CAR |bfVar#8|)) NIL))
(RETURN |bfVar#9|))
(T
(LET ((|bfVar#11|
(LIST (|bfColonColon| 'KEYWORD |p|) |p|)))
(COND ((NULL |bfVar#11|) NIL)
((NULL |bfVar#9|)
(SETQ |bfVar#9| |bfVar#11|)
(SETQ |bfVar#10| (|lastNode| |bfVar#9|)))
(T (RPLACD |bfVar#10| |bfVar#11|)
(SETQ |bfVar#10|
(|lastNode| |bfVar#10|)))))))
(SETQ |bfVar#8| (CDR |bfVar#8|)))))
(LIST 'DEFMACRO |fun| |parms|
(CONS 'LIST (CONS (|quote| |ctor|) |args|)))))
(SETQ |accDefs|
(COND ((NULL |accessors|) NIL)
(T (SETQ |x| (|bfGenSymbol| |tu|))
(LET ((|bfVar#14| NIL)
(|bfVar#15| NIL)
(|bfVar#13| |accessors|)
(|bfVar#12| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#13|))
(PROGN (SETQ |bfVar#12| (CAR |bfVar#13|)) NIL))
(RETURN |bfVar#14|))
(T
(AND (CONSP |bfVar#12|)
(EQ (CAR |bfVar#12|) '|%AccessorDef|)
(PROGN
(SETQ |ISTMP#1| (CDR |bfVar#12|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |acc| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|)
(NULL (CDR |ISTMP#2|))
(PROGN
(SETQ |f| (CAR |ISTMP#2|))
T)))))
(COND
((NULL |bfVar#14|)
(SETQ |bfVar#14|
#3=(CONS
(LIST 'DEFMACRO |acc| (LIST |x|)
(LIST 'LIST
(|quote|
(INTERN
(CONCAT
(SYMBOL-NAME |s|)
"-"
(SYMBOL-NAME |f|))))
|x|))
NIL))
(SETQ |bfVar#15| |bfVar#14|))
(T (RPLACD |bfVar#15| #3#)
(SETQ |bfVar#15| (CDR |bfVar#15|)))))))
(SETQ |bfVar#13| (CDR |bfVar#13|)))))))
(CONS |recDef| (CONS |ctorDef| |accDefs|)))))
(DEFUN |bfHandlers| (|n| |e| |hs|) (|bfHandlers,main| |n| |e| |hs| NIL))
(DEFUN |bfHandlers,main| (|n| |e| |hs| |xs|)
(LET* (|hs'|
|s|
|ISTMP#6|
|t|
|ISTMP#5|
|v|
|ISTMP#4|
|ISTMP#3|
|ISTMP#2|
|ISTMP#1|)
(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 (|bfSpecificErrorHere| "invalid handler message")))))
(DEFUN |codeForCatchHandlers| (|g| |e| |cs|)
(LET* (|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|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%List| |%Form|)) |%Thing|) |bfTry|))
(DEFUN |bfTry| (|e| |cs|)
(LET* (|s| |cs'| |f| |ISTMP#1| |g|)
(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|)
(LET* (|x| |t|)
(PROGN
(SETQ |t| NIL)
(SETQ |x| NIL)
(COND
((AND (CONSP |e|) (EQ (CAR |e|) '|%Signature|)) (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|))))))
(DEFUN |bfType| (|x|)
(LET* (|s| |ISTMP#2| |t| |ISTMP#1|)
(COND
((AND (CONSP |x|) (EQ (CAR |x|) '|%Mapping|)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(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))))))
(COND ((|bfTupleP| |s|) (SETQ |s| (CDR |s|))))
(COND ((|ident?| |s|) (SETQ |s| (LIST |s|))))
(LIST 'FUNCTION
(LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |s|) (|y| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#1|))
(PROGN (SETQ |y| (CAR |bfVar#1|)) NIL))
(RETURN |bfVar#2|))
((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (|bfType| |y|) NIL))
(SETQ |bfVar#3| |bfVar#2|))
(T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
(SETQ |bfVar#1| (CDR |bfVar#1|))))
(|bfType| |t|)))
((CONSP |x|)
(CONS (CAR |x|)
(LET ((|bfVar#5| NIL)
(|bfVar#6| NIL)
(|bfVar#4| (CDR |x|))
(|y| NIL))
(LOOP
(COND
((OR (NOT (CONSP |bfVar#4|))
(PROGN (SETQ |y| (CAR |bfVar#4|)) NIL))
(RETURN |bfVar#5|))
((NULL |bfVar#5|) (SETQ |bfVar#5| #2=(CONS (|bfType| |y|) NIL))
(SETQ |bfVar#6| |bfVar#5|))
(T (RPLACD |bfVar#6| #2#) (SETQ |bfVar#6| (CDR |bfVar#6|))))
(SETQ |bfVar#4| (CDR |bfVar#4|))))))
(T |x|))))
(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|)
((OR (INTEGERP |form|) (STRINGP |form|)) |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| #1=(CONS (|backquote| |t| |params|) NIL))
(SETQ |bfVar#3| |bfVar#2|))
(T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
(SETQ |bfVar#1| (CDR |bfVar#1|))))))))
(DEFUN |genTypeAlias| (|head| |body|)
(LET* (|args| |op|)
(PROGN
(SETQ |op| (CAR |head|))
(SETQ |args| (CDR |head|))
(LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))
(DEFUN |translateForm| (|x|)
(LET* (|ISTMP#2| |bindings| |init| |var| |ys| |args| |fun| |ISTMP#1|)
(COND ((NOT (CONSP |x|)) |x|) ((EQ (CAR |x|) 'QUOTE) |x|)
((AND (EQ (CAR |x|) '|apply|)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |fun| (CAR |ISTMP#1|))
(SETQ |args| (CDR |ISTMP#1|))
T))))
(COND
((EQ (|lastItem| |args|) 'NIL)
(CONS 'FUNCALL
(|listMap!| (|butLast!| (CDR |x|)) #'|translateForm|)))
((AND (CONSP |args|) (NULL (CDR |args|))
(PROGN
(SETQ |ISTMP#1| (CAR |args|))
(AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LIST)
(PROGN (SETQ |ys| (CDR |ISTMP#1|)) T))))
(CONS 'FUNCALL
(CONS (|translateForm| |fun|)
(|listMap!| |ys| #'|translateForm|))))
(T (CONS 'APPLY (|listMap!| (CDR |x|) #'|translateForm|)))))
((EQ (CAR |x|) 'LET)
(SETQ |bindings|
(LET ((|bfVar#3| NIL)
(|bfVar#4| NIL)
(|bfVar#2| (CAR (CDR |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 |var| (CAR |bfVar#1|))
(SETQ |ISTMP#1| (CDR |bfVar#1|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
(PROGN (SETQ |init| (CAR |ISTMP#1|)) T)))
(COND
((NULL |bfVar#3|)
(SETQ |bfVar#3|
#1=(CONS
(LIST |var|
(|translateForm| |init|))
NIL))
(SETQ |bfVar#4| |bfVar#3|))
(T (RPLACD |bfVar#4| #1#)
(SETQ |bfVar#4| (CDR |bfVar#4|)))))))
(SETQ |bfVar#2| (CDR |bfVar#2|)))))
(LIST (CAR |x|) |bindings| (|translateForm| (CADR (CDR |x|)))))
((AND (CONSP |x|) (EQ (CAR |x|) 'L%T)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |var| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
(PROGN (SETQ |init| (CAR |ISTMP#2|)) T))))))
(LIST (CAR |x|) |var| (|translateForm| |init|)))
((|symbolMember?| (CAR |x|) '(PROGN LOOP RETURN))
(CONS (CAR |x|) (|listMap!| (CDR |x|) #'|translateForm|)))
(T (|listMap!| |x| #'|translateForm|)))))
(DEFCONSTANT |$NativeSimpleDataTypes|
'(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16| |int32|
|uint32| |int64| |uint64| |float| |float32| |double| |float64|))
(DEFCONSTANT |$NativeSimpleReturnTypes|
(|append| |$NativeSimpleDataTypes| '(|void| |string|)))
(DEFUN |isSimpleNativeType| (|t|)
(|objectMember?| |t| |$NativeSimpleReturnTypes|))
(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|))
(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|))
(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |bootSymbol|))
(DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|)))
(DEFUN |unknownNativeTypeError| (|t|)
(|fatalError| (CONCAT "unsupported native type: " (PNAME |t|))))
(DEFUN |nativeType| (|t|)
(LET* (|t'|)
(COND ((NULL |t|) |t|)
((NOT (CONSP |t|))
(COND
((SETQ |t'|
(CDR
(|objectAssoc| (|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|))))))
(DEFUN |nativeArgumentType| (|t|)
(LET* (|t'| |c| |m|)
(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"))
((NOT (|symbolMember?| |c| '(|buffer| |pointer|)))
(|coreError| "expected 'buffer' or 'pointer' type instance"))
((NOT (|objectMember?| |t'| |$NativeSimpleDataTypes|))
(|coreError| "expected simple native data type"))
(T (|nativeType| (CADR |t|))))))))
(DEFUN |needsStableReference?| (|t|)
(LET* (|m|)
(AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) T)
(|symbolMember?| |m| '(|readonly| |writeonly| |readwrite|)))))
(DEFUN |coerceToNativeType| (|a| |t|)
(LET* (|y| |c|)
(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")))))
(DEFUN |genGCLnativeTranslation| (|op| |s| |t| |op'|)
(LET* (|ccode| |cargs| |cop| |rettype| |argtypes|)
(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| #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))
(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|))))))))
(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 ""))))
(DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|)
(LET* (|ISTMP#3| |ISTMP#2| |ISTMP#1|)
(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"))))
(DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|)
(LET* (|y| |c|)
(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|))
(COND ((CDR |x|) ", ") (T ""))))
(DEFUN |genECLnativeTranslation| (|op| |s| |t| |op'|)
(LET* (|rettype| |argtypes| |args|)
(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)))))
(|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|)))))
(DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|)
(COND
((EQL |i| 0) (CONCAT "(#0)" (|genECLnativeTranslation,selectDatum| |x|)))
(T
(CONCAT "," "(#" (WRITE-TO-STRING |i|) ")"
(|genECLnativeTranslation,selectDatum| |x|)))))
(DEFUN |genECLnativeTranslation,selectDatum| (|x|)
(LET* (|y| |c|)
(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"))))
((EQ |c| '|pointer|) "")
(T (|coreError| "unknown type constructor")))))))
(DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|)
(LET* (|forwardingFun|
|ISTMP#2|
|p|
|fixups|
|q|
|call|
|localPairs|
|y|
|x|
|ISTMP#1|
|a|
|foreignDecl|
|unstableArgs|
|parms|
|n|
|argtypes|
|rettype|)
(DECLARE (SPECIAL |$foreignsDefsForCLisp|))
(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| #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| #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))
(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| #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
(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|
(LIST 'FUNCALL
(LIST 'INTERN "getCLISPType"
"BOOTTRAN")
|p|)
|p|)
|call|)))))))
(SETQ |bfVar#25| (CDR |bfVar#25|))))
(CONS 'DEFUN (CONS |op| (CONS |parms| |call|))))))
(SETQ |$foreignsDefsForCLisp|
(CONS |foreignDecl| |$foreignsDefsForCLisp|))
(LIST |forwardingFun|))))
(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#1|)
(LET* (|a| |y| |x| |p|)
(PROGN
(SETQ |p| (CAR |bfVar#1|))
(SETQ |x| (CADR . #1=(|bfVar#1|)))
(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|)
(LET* (|a'|)
(COND ((SETQ |a'| (CDR (|objectAssoc| |p| |pairs|))) (CDR (CDR |a'|)))
(T |p|))))
(DEFUN |getCLISPType| (|a|) (LIST (|bfColonColon| 'FFI 'C-ARRAY) (LENGTH |a|)))
(DEFUN |genSBCLnativeTranslation| (|op| |s| |t| |op'|)
(LET* (|newArgs| |unstableArgs| |args| |argtypes| |rettype|)
(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| #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| #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'| (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'|)
(LET* (|call|
|p'|
|ISTMP#3|
|ISTMP#2|
|ISTMP#1|
|aryPairs|
|strPairs|
|parms|
|argtypes|
|rettype|)
(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| #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| #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'|
(|objectAssoc| |p|
|strPairs|))
(CDR |p'|))
((SETQ |p'|
(|objectAssoc| |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 '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))
(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|)))))
(DEFPARAMETER |$ffs| NIL)
(DEFUN |genImportDeclaration| (|op| |sig|)
(LET* (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
(DECLARE (SPECIAL |$ffs|))
(COND
((NOT
(AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|)
(PROGN
(SETQ |ISTMP#1| (CDR |sig|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |op'| (CAR |ISTMP#1|))
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (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 |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|))))
(SETQ |$ffs| (CONS |op| |$ffs|))
(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")))))))