(PROCLAIM '(OPTIMIZE SPEED)) (IMPORT-MODULE "includer") (IN-PACKAGE "BOOTTRAN") (PROVIDE "ast") (DEFPARAMETER |$bfClamming| NIL) (DEFPARAMETER |$constantIdentifiers| NIL) (DEFPARAMETER |$activeNamespace| NIL) (DEFTYPE |%Thing| () 'T) (DEFTYPE |%Boolean| () 'BOOLEAN) (DEFTYPE |%String| () 'STRING) (DEFTYPE |%Symbol| () 'SYMBOL) (DEFTYPE |%Short| () 'FIXNUM) (DEFTYPE |%List| () 'LIST) (DEFTYPE |%Vector| () 'VECTOR) (DEFTYPE |%Sequence| () 'SEQUENCE) (DEFUN |%Name| #0=(|bfVar#1|) (CONS '|%Name| (LIST . #0#))) (DEFUN |%Command| #0=(|bfVar#2|) (CONS '|%Command| (LIST . #0#))) (DEFUN |%Module| #0=(|bfVar#3| |bfVar#4|) (CONS '|%Module| (LIST . #0#))) (DEFUN |%Namespace| #0=(|bfVar#5|) (CONS '|%Namespace| (LIST . #0#))) (DEFUN |%Import| #0=(|bfVar#6|) (CONS '|%Import| (LIST . #0#))) (DEFUN |%ImportSignature| #0=(|bfVar#7| |bfVar#8|) (CONS '|%ImportSignature| (LIST . #0#))) (DEFUN |%TypeAlias| #0=(|bfVar#9| |bfVar#10|) (CONS '|%TypeAlias| (LIST . #0#))) (DEFUN |%Signature| #0=(|bfVar#11| |bfVar#12|) (CONS '|%Signature| (LIST . #0#))) (DEFUN |%Mapping| #0=(|bfVar#13| |bfVar#14|) (CONS '|%Mapping| (LIST . #0#))) (DEFUN |%SuffixDot| #0=(|bfVar#15|) (CONS '|%SuffixDot| (LIST . #0#))) (DEFUN |%Quote| #0=(|bfVar#16|) (CONS '|%Quote| (LIST . #0#))) (DEFUN |%EqualName| #0=(|bfVar#17|) (CONS '|%EqualName| (LIST . #0#))) (DEFUN |%Colon| #0=(|bfVar#18|) (CONS '|%Colon| (LIST . #0#))) (DEFUN |%QualifiedName| #0=(|bfVar#19| |bfVar#20|) (CONS '|%QualifiedName| (LIST . #0#))) (DEFUN |%DefaultValue| #0=(|bfVar#21| |bfVar#22|) (CONS '|%DefaultValue| (LIST . #0#))) (DEFUN |%Bracket| #0=(|bfVar#23|) (CONS '|%Bracket| (LIST . #0#))) (DEFUN |%UnboundedSegment| #0=(|bfVar#24|) (CONS '|%UnboundedSegment| (LIST . #0#))) (DEFUN |%BoundedSgement| #0=(|bfVar#25| |bfVar#26|) (CONS '|%BoundedSgement| (LIST . #0#))) (DEFUN |%Tuple| #0=(|bfVar#27|) (CONS '|%Tuple| (LIST . #0#))) (DEFUN |%ColonAppend| #0=(|bfVar#28| |bfVar#29|) (CONS '|%ColonAppend| (LIST . #0#))) (DEFUN |%Is| #0=(|bfVar#30| |bfVar#31|) (CONS '|%Is| (LIST . #0#))) (DEFUN |%Isnt| #0=(|bfVar#32| |bfVar#33|) (CONS '|%Isnt| (LIST . #0#))) (DEFUN |%Reduce| #0=(|bfVar#34| |bfVar#35|) (CONS '|%Reduce| (LIST . #0#))) (DEFUN |%PrefixExpr| #0=(|bfVar#36| |bfVar#37|) (CONS '|%PrefixExpr| (LIST . #0#))) (DEFUN |%Call| #0=(|bfVar#38| |bfVar#39|) (CONS '|%Call| (LIST . #0#))) (DEFUN |%InfixExpr| #0=(|bfVar#40| |bfVar#41| |bfVar#42|) (CONS '|%InfixExpr| (LIST . #0#))) (DEFUN |%ConstantDefinition| #0=(|bfVar#43| |bfVar#44|) (CONS '|%ConstantDefinition| (LIST . #0#))) (DEFUN |%Definition| #0=(|bfVar#45| |bfVar#46| |bfVar#47| |bfVar#48|) (CONS '|%Definition| (LIST . #0#))) (DEFUN |%Macro| #0=(|bfVar#49| |bfVar#50| |bfVar#51|) (CONS '|%Macro| (LIST . #0#))) (DEFUN |%SuchThat| #0=(|bfVar#52|) (CONS '|%SuchThat| (LIST . #0#))) (DEFUN |%Assignment| #0=(|bfVar#53| |bfVar#54|) (CONS '|%Assignment| (LIST . #0#))) (DEFUN |%While| #0=(|bfVar#55|) (CONS '|%While| (LIST . #0#))) (DEFUN |%Until| #0=(|bfVar#56|) (CONS '|%Until| (LIST . #0#))) (DEFUN |%For| #0=(|bfVar#57| |bfVar#58| |bfVar#59|) (CONS '|%For| (LIST . #0#))) (DEFUN |%Implies| #0=(|bfVar#60| |bfVar#61|) (CONS '|%Implies| (LIST . #0#))) (DEFUN |%Iterators| #0=(|bfVar#62|) (CONS '|%Iterators| (LIST . #0#))) (DEFUN |%Cross| #0=(|bfVar#63|) (CONS '|%Cross| (LIST . #0#))) (DEFUN |%Repeat| #0=(|bfVar#64| |bfVar#65|) (CONS '|%Repeat| (LIST . #0#))) (DEFUN |%Pile| #0=(|bfVar#66|) (CONS '|%Pile| (LIST . #0#))) (DEFUN |%Append| #0=(|bfVar#67|) (CONS '|%Append| (LIST . #0#))) (DEFUN |%Case| #0=(|bfVar#68| |bfVar#69|) (CONS '|%Case| (LIST . #0#))) (DEFUN |%Return| #0=(|bfVar#70|) (CONS '|%Return| (LIST . #0#))) (DEFUN |%Throw| #0=(|bfVar#71|) (CONS '|%Throw| (LIST . #0#))) (DEFUN |%Catch| #0=(|bfVar#72|) (CONS '|%Catch| (LIST . #0#))) (DEFUN |%Try| #0=(|bfVar#73| |bfVar#74|) (CONS '|%Try| (LIST . #0#))) (DEFUN |%Where| #0=(|bfVar#75| |bfVar#76|) (CONS '|%Where| (LIST . #0#))) (DEFUN |%Structure| #0=(|bfVar#77| |bfVar#78|) (CONS '|%Structure| (LIST . #0#))) (DEFPARAMETER |$inDefIS| NIL) (DEFUN |quote| (|x|) (LIST 'QUOTE |x|)) (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfGenSymbol|)) (DEFUN |bfGenSymbol| () (DECLARE (SPECIAL |$GenVarCounter|)) (PROGN (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1)) (INTERN (CONCAT "bfVar#" (STRINGIMAGE |$GenVarCounter|))))) (DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfListOf|)) (DEFUN |bfListOf| (|x|) |x|) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfColon|)) (DEFUN |bfColon| (|x|) (LIST 'COLON |x|)) (DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Symbol|) |%Symbol|) |bfColonColon|)) (DEFUN |bfColonColon| (|package| |name|) (COND ((AND (|%hasFeature| :CLISP) (MEMBER |package| '(EXT FFI))) (FIND-SYMBOL (SYMBOL-NAME |name|) |package|)) ('T (INTERN (SYMBOL-NAME |name|) |package|)))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|)) (DEFUN |bfSymbol| (|x|) (COND ((STRINGP |x|) |x|) ('T (LIST 'QUOTE |x|)))) (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfDot|)) (DEFUN |bfDot| () 'DOT) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfSuffixDot|)) (DEFUN |bfSuffixDot| (|x|) (LIST |x| 'DOT)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfEqual|)) (DEFUN |bfEqual| (|name|) (LIST 'EQUAL |name|)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfBracket|)) (DEFUN |bfBracket| (|part|) |part|) (DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfPile|)) (DEFUN |bfPile| (|part|) |part|) (DECLAIM (FTYPE (FUNCTION (|%List|) |%List|) |bfAppend|)) (DEFUN |bfAppend| (|x|) (APPLY #'APPEND |x|)) (DECLAIM (FTYPE (FUNCTION (|%List| |%Thing|) |%List|) |bfColonAppend|)) (DEFUN |bfColonAppend| (|x| |y|) (PROG (|a|) (RETURN (COND ((NULL |x|) (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE) (PROGN (SETQ |a| (CDR |y|)) 'T)) (LIST '&REST (CONS 'QUOTE |a|))) (#0='T (LIST '&REST |y|)))) (#0# (CONS (CAR |x|) (|bfColonAppend| (CDR |x|) |y|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfDefinition|)) (DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|) (LIST 'DEF |bflhsitems| |bfrhs| |body|)) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Thing|) |bfSimpleDefinition|)) (DEFUN |bfSimpleDefinition| (|lhs| |rhs|) (PROG (|ISTMP#2| |id| |ISTMP#1|) (DECLARE (SPECIAL |$constantIdentifiers|)) (RETURN (PROGN (COND ((ATOM |lhs|) (SETQ |$constantIdentifiers| (CONS |lhs| |$constantIdentifiers|))) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |id| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL)))))) (SETQ |$constantIdentifiers| (CONS |id| |$constantIdentifiers|)))) (|%ConstantDefinition| |lhs| |rhs|))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfMDefinition|)) (DEFUN |bfMDefinition| (|bflhsitems| |bfrhs| |body|) (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|)) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCompDef|)) (DEFUN |bfCompDef| (|x|) (PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def| |bfVar#80| |bfVar#79|) (RETURN (PROGN (SETQ |bfVar#79| |x|) (SETQ |bfVar#80| (CDR |bfVar#79|)) (CASE (CAR |bfVar#79|) (|%ConstantDefinition| |x|) (T (COND ((AND (CONSP |x|) (PROGN (SETQ |def| (CAR |x|)) (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |op| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (PROGN (SETQ |args| (CAR |ISTMP#2|)) (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (CDR |ISTMP#3|) NIL) (PROGN (SETQ |body| (CAR |ISTMP#3|)) 'T)))))))) (|bfDef| |def| |op| |args| |body|)) ('T (|coreError| "invalid AST"))))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |bfBeginsDollar|)) (DEFUN |bfBeginsDollar| (|x|) (EQL (ELT "$" 0) (ELT (PNAME |x|) 0))) (DEFUN |compFluid| (|id|) (LIST 'FLUID |id|)) (DEFUN |compFluidize| (|x|) (COND ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|)) ((ATOM |x|) |x|) ((EQCAR |x| 'QUOTE) |x|) ('T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|)))))) (DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|)) (DEFUN |bfTupleP| (|x|) (EQCAR |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|) (PROG (|ISTMP#1| |a|) (RETURN (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|)))) (COND ((LET ((|bfVar#82| NIL) (|bfVar#81| |a|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#81|) (PROGN (SETQ |x| (CAR |bfVar#81|)) NIL)) (RETURN |bfVar#82|)) ('T (PROGN (SETQ |bfVar#82| (AND (CONSP |x|) (EQ (CAR |x|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))) (COND (|bfVar#82| (RETURN |bfVar#82|)))))) (SETQ |bfVar#81| (CDR |bfVar#81|)))) (|bfMakeCons| |a|)) ('T (CONS 'LIST |a|))))))) (DEFUN |bfConstruct| (|b|) (PROG (|a|) (RETURN (PROGN (SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|)))) (|bfMakeCons| |a|))))) (DEFUN |bfMakeCons| (|l|) (PROG (|l1| |a| |ISTMP#2| |ISTMP#1|) (RETURN (COND ((NULL |l|) NIL) ((AND (CONSP |l|) (PROGN (SETQ |ISTMP#1| (CAR |l|)) (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'COLON) (PROGN (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#2|)) #0='T))))) (PROGN (SETQ |l1| (CDR |l|)) #0#)) (COND (|l1| (LIST 'APPEND |a| (|bfMakeCons| |l1|))) (#1='T |a|))) (#1# (LIST 'CONS (CAR |l|) (|bfMakeCons| (CDR |l|)))))))) (DEFUN |bfFor| (|bflhs| U |step|) (COND ((EQCAR U '|tails|) (|bfForTree| 'ON |bflhs| (CADR U))) ((EQCAR U 'SEGMENT) (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U))) ('T (|bfForTree| 'IN |bflhs| U)))) (DEFUN |bfForTree| (OP |lhs| |whole|) (PROG (G) (RETURN (PROGN (SETQ |whole| (COND ((|bfTupleP| |whole|) (|bfMakeCons| (CDR |whole|))) (#0='T |whole|))) (COND ((ATOM |lhs|) (|bfINON| (LIST OP |lhs| |whole|))) (#1='T (PROGN (SETQ |lhs| (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (#0# |lhs|))) (COND ((EQCAR |lhs| 'L%T) (PROGN (SETQ G (CADR |lhs|)) (APPEND (|bfINON| (LIST OP G |whole|)) (|bfSuchthat| (|bfIS| G (CADDR |lhs|)))))) (#1# (PROGN (SETQ G (|bfGenSymbol|)) (APPEND (|bfINON| (LIST OP G |whole|)) (|bfSuchthat| (|bfIS| G |lhs|))))))))))))) (DEFUN |bfSTEP| (|id| |fst| |step| |lst|) (PROG (|suc| |ex| |pred| |final| |g2| |inc| |g1| |initval| |initvar|) (RETURN (PROGN (SETQ |initvar| (LIST |id|)) (SETQ |initval| (LIST |fst|)) (SETQ |inc| (COND ((ATOM |step|) |step|) (#0='T (SETQ |g1| (|bfGenSymbol|)) (SETQ |initvar| (CONS |g1| |initvar|)) (SETQ |initval| (CONS |step| |initval|)) |g1|))) (SETQ |final| (COND ((ATOM |lst|) |lst|) (#0# (SETQ |g2| (|bfGenSymbol|)) (SETQ |initvar| (CONS |g2| |initvar|)) (SETQ |initval| (CONS |lst| |initval|)) |g2|))) (SETQ |ex| (COND ((NULL |lst|) NIL) ((INTEGERP |inc|) (PROGN (SETQ |pred| (COND ((MINUSP |inc|) '<) (#0# '>))) (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 |bfINON| (|x|) (PROG (|whole| |id| |op|) (RETURN (PROGN (SETQ |op| (CAR |x|)) (SETQ |id| (CADR . #0=(|x|))) (SETQ |whole| (CADDR . #0#)) (COND ((EQ |op| 'ON) (|bfON| |id| |whole|)) ('T (|bfIN| |id| |whole|))))))) (DEFUN |bfIN| (|x| E) (PROG (|g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (LIST (LIST (LIST |g| |x|) (LIST E NIL) (LIST (LIST 'SETQ |g| (LIST 'CDR |g|))) NIL (LIST (LIST 'OR (LIST 'ATOM |g|) (LIST 'PROGN (LIST 'SETQ |x| (LIST 'CAR |g|)) 'NIL))) NIL)))))) (DEFUN |bfON| (|x| E) (LIST (LIST (LIST |x|) (LIST E) (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL (LIST (LIST 'ATOM |x|)) NIL))) (DEFUN |bfSuchthat| (|p|) (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL))) (DEFUN |bfWhile| (|p|) (LIST (LIST NIL NIL NIL NIL (LIST (|bfNOT| |p|)) NIL))) (DEFUN |bfUntil| (|p|) (PROG (|g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (LIST (LIST (LIST |g|) (LIST NIL) (LIST (LIST 'SETQ |g| |p|)) NIL (LIST |g|) NIL)))))) (DEFUN |bfIterators| (|x|) (CONS 'ITERATORS |x|)) (DEFUN |bfCross| (|x|) (CONS 'CROSS |x|)) (DEFUN |bfLp| (|iters| |body|) (COND ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|)) ('T (|bfLpCross| (CDR |iters|) |body|)))) (DEFUN |bfLpCross| (|iters| |body|) (COND ((NULL (CDR |iters|)) (|bfLp| (CAR |iters|) |body|)) ('T (|bfLp| (CAR |iters|) (|bfLpCross| (CDR |iters|) |body|))))) (DEFUN |bfSep| (|iters|) (PROG (|r| |f|) (RETURN (COND ((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL)) ('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|))) (LET ((|bfVar#85| NIL) (|bfVar#83| |f|) (|i| NIL) (|bfVar#84| |r|) (|j| NIL)) (LOOP (COND ((OR (ATOM |bfVar#83|) (PROGN (SETQ |i| (CAR |bfVar#83|)) NIL) (ATOM |bfVar#84|) (PROGN (SETQ |j| (CAR |bfVar#84|)) NIL)) (RETURN (NREVERSE |bfVar#85|))) ('T (SETQ |bfVar#85| (CONS (APPEND |i| |j|) |bfVar#85|)))) (SETQ |bfVar#83| (CDR |bfVar#83|)) (SETQ |bfVar#84| (CDR |bfVar#84|))))))))) (DEFUN |bfReduce| (|op| |y|) (PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|) (RETURN (PROGN (SETQ |a| (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|))) (SETQ |op| (|bfReName| |a|)) (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) (SETQ |g| (|bfGenSymbol|)) (SETQ |g1| (|bfGenSymbol|)) (SETQ |body| (LIST 'SETQ |g| (LIST |op| |g| |g1|))) (COND ((NULL |init|) (SETQ |g2| (|bfGenSymbol|)) (SETQ |init| (LIST 'CAR |g2|)) (SETQ |ny| (LIST 'CDR |g2|)) (SETQ |it| (CONS 'ITERATORS (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|))) (|bfIN| |g1| |ny|)))) (|bfMKPROGN| (LIST (LIST 'L%T |g2| |y|) (|bfLp| |it| |body|)))) (#0# (SETQ |init| (CAR |init|)) (SETQ |it| (CONS 'ITERATORS (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|))) (|bfIN| |g1| |y|)))) (|bfLp| |it| |body|))))))) (DEFUN |bfReduceCollect| (|op| |y|) (PROG (|init| |a| |itl| |body|) (RETURN (COND ((EQCAR |y| 'COLLECT) (SETQ |body| (ELT |y| 1)) (SETQ |itl| (ELT |y| 2)) (SETQ |a| (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|))) (SETQ |op| (|bfReName| |a|)) (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) (|bfOpReduce| |op| |init| |body| |itl|)) (#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1))) (|bfReduce| |op| |a|)))))) (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|)) (DEFUN |bfDTuple| (|x|) (LIST 'DTUPLE |x|)) (DEFUN |bfCollect| (|y| |itl|) (PROG (|newBody| |a| |ISTMP#1|) (RETURN (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |y|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) 'T)))) (|bf0APPEND| |a| |itl|)) ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (PROGN (SETQ |newBody| (|bfConstruct| |y|)) (|bf0APPEND| |newBody| |itl|))) ('T (|bf0COLLECT| |y| |itl|)))))) (DEFUN |bf0COLLECT| (|y| |itl|) (|bfListReduce| 'CONS |y| |itl|)) (DEFUN |bf0APPEND| (|y| |itl|) (PROG (|extrait| |body| |g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (SETQ |body| (LIST 'SETQ |g| (LIST 'APPEND (LIST 'REVERSE |y|) |g|))) (SETQ |extrait| (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL (LIST (LIST 'NREVERSE |g|))))) (|bfLp2| |extrait| |itl| |body|))))) (DEFUN |bfListReduce| (|op| |y| |itl|) (PROG (|extrait| |body| |g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (SETQ |body| (LIST 'SETQ |g| (LIST |op| |y| |g|))) (SETQ |extrait| (LIST (LIST (LIST |g|) (LIST NIL) NIL NIL NIL (LIST (LIST 'NREVERSE |g|))))) (|bfLp2| |extrait| |itl| |body|))))) (DEFUN |bfLp1| (|iters| |body|) (PROG (|loop| |nbody| |value| |exits| |filters| |sucs| |inits| |vars| |LETTMP#1|) (RETURN (PROGN (SETQ |LETTMP#1| (|bfSep| (|bfAppend| |iters|))) (SETQ |vars| (CAR |LETTMP#1|)) (SETQ |inits| (CADR . #0=(|LETTMP#1|))) (SETQ |sucs| (CADDR . #0#)) (SETQ |filters| (CADDDR . #0#)) (SETQ |exits| (CAR #1=(CDDDDR . #0#))) (SETQ |value| (CADR #1#)) (SETQ |nbody| (COND ((NULL |filters|) |body|) (#2='T (|bfAND| (APPEND |filters| (CONS |body| NIL)))))) (SETQ |value| (COND ((NULL |value|) 'NIL) (#2# (CAR |value|)))) (SETQ |exits| (LIST 'COND (LIST (|bfOR| |exits|) (LIST 'RETURN |value|)) (LIST ''T |nbody|))) (SETQ |loop| (CONS 'LOOP (CONS |exits| |sucs|))) (COND (|vars| (SETQ |loop| (LIST 'LET (LET ((|bfVar#88| NIL) (|bfVar#86| |vars|) (|v| NIL) (|bfVar#87| |inits|) (|i| NIL)) (LOOP (COND ((OR (ATOM |bfVar#86|) (PROGN (SETQ |v| (CAR |bfVar#86|)) NIL) (ATOM |bfVar#87|) (PROGN (SETQ |i| (CAR |bfVar#87|)) NIL)) (RETURN (NREVERSE |bfVar#88|))) ('T (SETQ |bfVar#88| (CONS (LIST |v| |i|) |bfVar#88|)))) (SETQ |bfVar#86| (CDR |bfVar#86|)) (SETQ |bfVar#87| (CDR |bfVar#87|)))) |loop|)))) |loop|)))) (DEFUN |bfLp2| (|extrait| |itl| |body|) (PROG (|iters|) (RETURN (COND ((EQCAR |itl| 'ITERATORS) (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|)) ('T (PROGN (SETQ |iters| (CDR |itl|)) (|bfLpCross| (CONS (CONS 'ITERATORS (CONS |extrait| (CDAR |iters|))) (CDR |iters|)) |body|))))))) (DEFUN |bfOpReduce| (|op| |init| |y| |itl|) (PROG (|extrait| |g1| |body| |g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (SETQ |body| (COND ((EQ |op| 'AND) (|bfMKPROGN| (LIST (LIST 'SETQ |g| |y|) (LIST 'COND (LIST (LIST 'NOT |g|) (LIST 'RETURN 'NIL)))))) ((EQ |op| 'OR) (|bfMKPROGN| (LIST (LIST 'SETQ |g| |y|) (LIST 'COND (LIST |g| (LIST 'RETURN |g|)))))) ('T (LIST 'SETQ |g| (LIST |op| |g| |y|))))) (COND ((NULL |init|) (SETQ |g1| (|bfGenSymbol|)) (SETQ |init| (LIST 'CAR |g1|)) (SETQ |y| (LIST 'CDR |g1|)) (SETQ |extrait| (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|)))) (|bfMKPROGN| (LIST (LIST 'L%T |g1| |y|) (|bfLp2| |extrait| |itl| |body|)))) ('T (SETQ |init| (CAR |init|)) (SETQ |extrait| (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|)))) (|bfLp2| |extrait| |itl| |body|))))))) (DEFUN |bfLoop1| (|body|) (|bfLp| (|bfIterators| NIL) |body|)) (DEFUN |bfSegment1| (|lo|) (LIST 'SEGMENT |lo| NIL)) (DEFUN |bfSegment2| (|lo| |hi|) (LIST 'SEGMENT |lo| |hi|)) (DEFUN |bfForInBy| (|variable| |collection| |step|) (|bfFor| |variable| |collection| |step|)) (DEFUN |bfForin| (|lhs| U) (|bfFor| |lhs| U 1)) (DEFUN |bfLocal| (|a| |b|) (COND ((EQ |b| 'FLUID) (|compFluid| |a|)) ((EQ |b| '|fluid|) (|compFluid| |a|)) ((EQ |b| '|local|) (|compFluid| |a|)) ('T |a|))) (DEFUN |bfTake| (|n| |x|) (COND ((NULL |x|) |x|) ((EQL |n| 0) NIL) ('T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|)))))) (DEFUN |bfDrop| (|n| |x|) (COND ((OR (NULL |x|) (EQL |n| 0)) |x|) ('T (|bfDrop| (- |n| 1) (CDR |x|))))) (DEFUN |bfDefSequence| (|l|) (CONS 'SEQ |l|)) (DEFUN |bfReturnNoName| (|a|) (LIST 'RETURN |a|)) (DEFUN |bfSUBLIS| (|p| |e|) (COND ((ATOM |e|) (|bfSUBLIS1| |p| |e|)) ((EQCAR |e| 'QUOTE) |e|) ('T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|)))))) (DEFUN |bfSUBLIS1| (|p| |e|) (PROG (|f|) (RETURN (COND ((NULL |p|) |e|) (#0='T (PROGN (SETQ |f| (CAR |p|)) (COND ((EQ (CAR |f|) |e|) (|bfSUBLIS| |p| (CDR |f|))) (#0# (|bfSUBLIS1| (CDR |p|) |e|))))))))) (DEFUN |defSheepAndGoats| (|x|) (PROG (|defstack| |op1| |opassoc| |argl| |body| |args| |op| |def|) (DECLARE (SPECIAL |$op|)) (RETURN (COND ((EQCAR |x| 'DEF) (PROGN (SETQ |def| (CAR |x|)) (SETQ |op| (CADR . #0=(|x|))) (SETQ |args| (CADDR . #0#)) (SETQ |body| (CADDDR . #0#)) (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (#1='T (LIST |args|)))) (COND ((NULL |argl|) (SETQ |opassoc| (LIST (CONS |op| |body|))) (LIST |opassoc| NIL NIL)) (#1# (SETQ |op1| (INTERN (CONCAT (PNAME |$op|) "," (PNAME |op|)))) (SETQ |opassoc| (LIST (CONS |op| |op1|))) (SETQ |defstack| (LIST (LIST 'DEF |op1| |args| |body|))) (LIST |opassoc| |defstack| NIL))))) ((EQCAR |x| 'SEQ) (|defSheepAndGoatsList| (CDR |x|))) ('T (LIST NIL NIL (LIST |x|))))))) (DEFUN |defSheepAndGoatsList| (|x|) (PROG (|nondefs1| |defs1| |opassoc1| |nondefs| |defs| |opassoc| |LETTMP#1|) (RETURN (COND ((NULL |x|) (LIST NIL NIL NIL)) ('T (SETQ |LETTMP#1| (|defSheepAndGoats| (CAR |x|))) (SETQ |opassoc| (CAR |LETTMP#1|)) (SETQ |defs| (CADR . #0=(|LETTMP#1|))) (SETQ |nondefs| (CADDR . #0#)) (SETQ |LETTMP#1| (|defSheepAndGoatsList| (CDR |x|))) (SETQ |opassoc1| (CAR |LETTMP#1|)) (SETQ |defs1| (CADR . #1=(|LETTMP#1|))) (SETQ |nondefs1| (CADDR . #1#)) (LIST (APPEND |opassoc| |opassoc1|) (APPEND |defs| |defs1|) (APPEND |nondefs| |nondefs1|))))))) (DEFUN |bfLetForm| (|lhs| |rhs|) (LIST 'L%T |lhs| |rhs|)) (DEFUN |bfLET1| (|lhs| |rhs|) (PROG (|let1| |g| |l2| |l1| |name| |rhs1| |ISTMP#1|) (DECLARE (SPECIAL |$letGenVarCounter|)) (RETURN (COND ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|)) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)))) (|bfLetForm| |lhs| |rhs|)) ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) (PROGN (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) (COND ((EQCAR |rhs1| 'L%T) (|bfMKPROGN| (LIST |rhs1| |rhs|))) ((EQCAR |rhs1| 'PROGN) (APPEND |rhs1| (LIST |rhs|))) (#0='T (PROGN (COND ((IDENTP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL)))) (|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL)))))))) ((AND (CONSP |rhs|) (EQCAR |rhs| 'L%T) (IDENTP (SETQ |name| (CADR |rhs|)))) (PROGN (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|))) (SETQ |l2| (|bfLET1| |lhs| |name|)) (COND ((EQCAR |l2| 'PROGN) (|bfMKPROGN| (CONS |l1| (CDR |l2|)))) (#0# (PROGN (COND ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL)))) (|bfMKPROGN| (CONS |l1| (APPEND |l2| (CONS |name| NIL))))))))) (#0# (PROGN (SETQ |g| (INTERN (CONCAT "LETTMP#" (STRINGIMAGE |$letGenVarCounter|)))) (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1)) (SETQ |rhs1| (LIST 'L%T |g| |rhs|)) (SETQ |let1| (|bfLET1| |lhs| |g|)) (COND ((EQCAR |let1| 'PROGN) (|bfMKPROGN| (CONS |rhs1| (CDR |let1|)))) (#0# (PROGN (COND ((IDENTP (CAR |let1|)) (SETQ |let1| (CONS |let1| NIL)))) (|bfMKPROGN| (CONS |rhs1| (APPEND |let1| (CONS |g| NIL))))))))))))) (DEFUN |bfCONTAINED| (|x| |y|) (COND ((EQ |x| |y|) T) ((ATOM |y|) NIL) ('T (OR (|bfCONTAINED| |x| (CAR |y|)) (|bfCONTAINED| |x| (CDR |y|)))))) (DEFUN |bfLET2| (|lhs| |rhs|) (PROG (|isPred| |val1| |ISTMP#3| |g| |rev| |patrev| |l2| |l1| |var2| |var1| |b| |ISTMP#2| |a| |ISTMP#1|) (DECLARE (SPECIAL |$inDefIS| |$letGenVarCounter|)) (RETURN (COND ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|)) ((NULL |lhs|) NIL) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)))) (|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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0='T)))))) (PROGN (SETQ |a| (|bfLET2| |a| |rhs|)) (COND ((NULL (SETQ |b| (|bfLET2| |b| |rhs|))) |a|) ((ATOM |b|) (LIST |a| |b|)) ((CONSP (CAR |b|)) (CONS |a| |b|)) (#1='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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#)))))) (COND ((OR (EQ |var1| 'DOT) (AND (CONSP |var1|) (EQCAR |var1| 'QUOTE))) (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) (#1# (PROGN (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|))) (COND ((OR (NULL |var2|) (EQ |var2| 'DOT)) |l1|) (#1# (PROGN (COND ((AND (CONSP |l1|) (ATOM (CAR |l1|))) (SETQ |l1| (CONS |l1| NIL)))) (COND ((IDENTP |var2|) (APPEND |l1| (CONS (|bfLetForm| |var2| (|addCARorCDR| 'CDR |rhs|)) NIL))) (#1# (PROGN (SETQ |l2| (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) (COND ((AND (CONSP |l2|) (ATOM (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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#)))))) (PROGN (SETQ |patrev| (|bfISReverse| |var2| |var1|)) (SETQ |rev| (LIST 'REVERSE |rhs|)) (SETQ |g| (INTERN (CONCAT "LETTMP#" (STRINGIMAGE |$letGenVarCounter|)))) (SETQ |$letGenVarCounter| (+ |$letGenVarCounter| 1)) (SETQ |l2| (|bfLET2| |patrev| |g|)) (COND ((AND (CONSP |l2|) (ATOM (CAR |l2|))) (SETQ |l2| (CONS |l2| NIL)))) (COND ((EQ |var1| 'DOT) (CONS (LIST 'L%T |g| |rev|) |l2|)) ((PROGN (SETQ |ISTMP#1| (|last| |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|) (EQ (CDR |ISTMP#3|) NIL) (PROGN (SETQ |val1| (CAR |ISTMP#3|)) #0#))))))) (CONS (LIST 'L%T |g| |rev|) (APPEND (REVERSE (CDR (REVERSE |l2|))) (CONS (|bfLetForm| |var1| (LIST 'NREVERSE |val1|)) NIL)))) (#1# (CONS (LIST 'L%T |g| |rev|) (APPEND |l2| (CONS (|bfLetForm| |var1| (LIST 'NREVERSE |var1|)) NIL))))))) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |var1| (CAR |ISTMP#1|)) #0#)))) (LIST 'COND (LIST (LIST 'EQUAL |var1| |rhs|) |var1|))) (#1# (PROGN (SETQ |isPred| (COND (|$inDefIS| (|bfIS1| |rhs| |lhs|)) (#1# (|bfIS| |rhs| |lhs|)))) (LIST 'COND (LIST |isPred| |rhs|)))))))) (DEFUN |bfLET| (|lhs| |rhs|) (PROG (|$letGenVarCounter|) (DECLARE (SPECIAL |$letGenVarCounter|)) (RETURN (PROGN (SETQ |$letGenVarCounter| 1) (|bfLET1| |lhs| |rhs|))))) (DEFUN |addCARorCDR| (|acc| |expr|) (PROG (|funsR| |funsA| |p| |funs|) (RETURN (COND ((NULL (CONSP |expr|)) (LIST |acc| |expr|)) ((AND (EQ |acc| 'CAR) (EQCAR |expr| 'REVERSE)) (LIST 'CAR (CONS 'LAST (CDR |expr|)))) (#0='T (PROGN (SETQ |funs| '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR CDAAR CDDAR CDADR CDDDR)) (SETQ |p| (|bfPosition| (CAR |expr|) |funs|)) (COND ((EQUAL |p| (- 1)) (LIST |acc| |expr|)) (#0# (PROGN (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| (|op| |left| |right|) (COND ((EQ |op| 'IS) (|bfIS| |left| |right|)) ((EQ |op| 'ISNT) (|bfNOT| (|bfIS| |left| |right|))) ('T (LIST |op| |left| |right|)))) (DEFUN |bfIS| (|left| |right|) (PROG (|$inDefIS| |$isGenVarCounter|) (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|)) (RETURN (PROGN (SETQ |$isGenVarCounter| 1) (SETQ |$inDefIS| T) (|bfIS1| |left| |right|))))) (DEFUN |bfISReverse| (|x| |a|) (PROG (|y|) (RETURN (COND ((AND (CONSP |x|) (EQ (CAR |x|) 'CONS)) (COND ((NULL (CADDR |x|)) (LIST 'CONS (CADR |x|) |a|)) (#0='T (PROGN (SETQ |y| (|bfISReverse| (CADDR |x|) NIL)) (RPLACA (CDDR |y|) (LIST 'CONS (CADR |x|) |a|)) |y|)))) (#0# (PROGN (|bpSpecificErrorHere| "Error in bfISReverse") (|bpTrap|))))))) (DEFUN |bfIS1| (|lhs| |rhs|) (PROG (|l2| |rev| |patrev| |cls| |b1| |a1| |b| |g| |l| |d| |ISTMP#2| |c| |a| |ISTMP#1|) (DECLARE (SPECIAL |$isGenVarCounter|)) (RETURN (COND ((NULL |rhs|) (LIST 'NULL |lhs|)) ((STRINGP |rhs|) (LIST 'EQ |lhs| (LIST 'QUOTE (INTERN |rhs|)))) ((NUMBERP |rhs|) (LIST 'EQUAL |lhs| |rhs|)) ((ATOM |rhs|) (LIST 'PROGN (|bfLetForm| |rhs| |lhs|) ''T)) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T)))) (COND ((IDENTP |a|) (LIST 'EQ |lhs| |rhs|)) (#1='T (LIST 'EQUAL |lhs| |rhs|)))) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |c| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |d| (CAR |ISTMP#2|)) #0#)))))) (PROGN (SETQ |l| (|bfLET| |c| |lhs|)) (|bfAND| (LIST (|bfIS1| |lhs| |d|) (|bfMKPROGN| (LIST |l| ''T)))))) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'EQUAL) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0#)))) (LIST 'EQUAL |lhs| |a|)) ((CONSP |lhs|) (PROGN (SETQ |g| (INTERN (CONCAT "ISTMP#" (STRINGIMAGE |$isGenVarCounter|)))) (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1)) (|bfMKPROGN| (LIST (LIST 'L%T |g| |lhs|) (|bfIS1| |g| |rhs|))))) ((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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0#)))))) (COND ((EQ |a| 'DOT) (COND ((NULL |b|) (|bfAND| (LIST (LIST 'CONSP |lhs|) (LIST 'EQ (LIST 'CDR |lhs|) 'NIL)))) (#1# (|bfAND| (LIST (LIST 'CONSP |lhs|) (|bfIS1| (LIST 'CDR |lhs|) |b|)))))) ((NULL |b|) (|bfAND| (LIST (LIST 'CONSP |lhs|) (LIST 'EQ (LIST 'CDR |lhs|) 'NIL) (|bfIS1| (LIST 'CAR |lhs|) |a|)))) ((EQ |b| 'DOT) (|bfAND| (LIST (LIST 'CONSP |lhs|) (|bfIS1| (LIST 'CAR |lhs|) |a|)))) (#1# (PROGN (SETQ |a1| (|bfIS1| (LIST 'CAR |lhs|) |a|)) (SETQ |b1| (|bfIS1| (LIST 'CDR |lhs|) |b|)) (COND ((AND (CONSP |a1|) (EQ (CAR |a1|) 'PROGN) (PROGN (SETQ |ISTMP#1| (CDR |a1|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |c| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) (EQUAL (CAR |ISTMP#2|) ''T))))) (CONSP |b1|) (EQ (CAR |b1|) 'PROGN) (PROGN (SETQ |cls| (CDR |b1|)) #0#)) (|bfAND| (LIST (LIST 'CONSP |lhs|) (|bfMKPROGN| (CONS |c| |cls|))))) (#1# (|bfAND| (LIST (LIST 'CONSP |lhs|) |a1| |b1|)))))))) ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'APPEND) (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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#2|)) #0#)))))) (PROGN (SETQ |patrev| (|bfISReverse| |b| |a|)) (SETQ |g| (INTERN (CONCAT "ISTMP#" (STRINGIMAGE |$isGenVarCounter|)))) (SETQ |$isGenVarCounter| (+ |$isGenVarCounter| 1)) (SETQ |rev| (|bfAND| (LIST (LIST 'CONSP |lhs|) (LIST 'PROGN (LIST 'L%T |g| (LIST 'REVERSE |lhs|)) ''T)))) (SETQ |l2| (|bfIS1| |g| |patrev|)) (COND ((AND (CONSP |l2|) (ATOM (CAR |l2|))) (SETQ |l2| (CONS |l2| NIL)))) (COND ((EQ |a| 'DOT) (|bfAND| (CONS |rev| |l2|))) (#1# (|bfAND| (CONS |rev| (APPEND |l2| (CONS (LIST 'PROGN (|bfLetForm| |a| (LIST 'NREVERSE |a|)) ''T) NIL)))))))) (#1# (PROGN (|bpSpecificErrorHere| "bad IS code is generated") (|bpTrap|))))))) (DEFUN |bfApplication| (|bfop| |bfarg|) (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) ('T (CONS |bfop| (LIST |bfarg|))))) (DEFUN |bfReName| (|x|) (PROG (|a|) (RETURN (COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) ('T |x|))))) (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|))) ('T (LIST |op| |left| |right|)))) (DEFUN |bfNOT| (|x|) (PROG (|a| |ISTMP#1|) (RETURN (COND ((AND (CONSP |x|) (EQ (CAR |x|) 'NOT) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T)))) |a|) ((AND (CONSP |x|) (EQ (CAR |x|) 'NULL) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0#)))) |a|) ('T (LIST 'NOT |x|)))))) (DEFUN |bfFlatten| (|op| |x|) (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|)))) (DEFUN |bfOR| (|l|) (COND ((NULL |l|) NIL) ((NULL (CDR |l|)) (CAR |l|)) ('T (CONS 'OR (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL)) (LOOP (COND ((OR (ATOM |bfVar#89|) (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL)) (RETURN (NREVERSE |bfVar#90|))) ('T (SETQ |bfVar#90| (APPEND (REVERSE (|bfFlatten| 'OR |c|)) |bfVar#90|)))) (SETQ |bfVar#89| (CDR |bfVar#89|)))))))) (DEFUN |bfAND| (|l|) (COND ((NULL |l|) 'T) ((NULL (CDR |l|)) (CAR |l|)) ('T (CONS 'AND (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL)) (LOOP (COND ((OR (ATOM |bfVar#91|) (PROGN (SETQ |c| (CAR |bfVar#91|)) NIL)) (RETURN (NREVERSE |bfVar#92|))) ('T (SETQ |bfVar#92| (APPEND (REVERSE (|bfFlatten| 'AND |c|)) |bfVar#92|)))) (SETQ |bfVar#91| (CDR |bfVar#91|)))))))) (DEFUN |defQuoteId| (|x|) (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|)))) (DEFUN |bfSmintable| (|x|) (OR (INTEGERP |x|) (AND (CONSP |x|) (MEMBER (CAR |x|) '(SIZE LENGTH |char|))))) (DEFUN |bfQ| (|l| |r|) (COND ((OR (|bfSmintable| |l|) (|bfSmintable| |r|)) (LIST 'EQL |l| |r|)) ((OR (|defQuoteId| |l|) (|defQuoteId| |r|)) (LIST 'EQ |l| |r|)) ((NULL |l|) (LIST 'NULL |r|)) ((NULL |r|) (LIST 'NULL |l|)) ((OR (EQ |l| T) (EQ |r| T)) (LIST 'EQ |l| |r|)) ('T (LIST 'EQUAL |l| |r|)))) (DEFUN |bfLessp| (|l| |r|) (COND ((EQL |r| 0) (LIST 'MINUSP |l|)) ('T (LIST '< |l| |r|)))) (DEFUN |bfMDef| (|defOp| |op| |args| |body|) (PROG (|def| |lamex| |sb2| |sb| |largl| |nargl| |sgargl| |gargl| |LETTMP#1| |argl|) (DECLARE (SPECIAL |$wheredefs|)) (RETURN (PROGN (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) ('T (LIST |args|)))) (SETQ |LETTMP#1| (|bfGargl| |argl|)) (SETQ |gargl| (CAR |LETTMP#1|)) (SETQ |sgargl| (CADR . #0=(|LETTMP#1|))) (SETQ |nargl| (CADDR . #0#)) (SETQ |largl| (CADDDR . #0#)) (SETQ |sb| (LET ((|bfVar#95| NIL) (|bfVar#93| |nargl|) (|i| NIL) (|bfVar#94| |sgargl|) (|j| NIL)) (LOOP (COND ((OR (ATOM |bfVar#93|) (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL) (ATOM |bfVar#94|) (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL)) (RETURN (NREVERSE |bfVar#95|))) (#1='T (SETQ |bfVar#95| (CONS (CONS |i| |j|) |bfVar#95|)))) (SETQ |bfVar#93| (CDR |bfVar#93|)) (SETQ |bfVar#94| (CDR |bfVar#94|))))) (SETQ |body| (SUBLIS |sb| |body|)) (SETQ |sb2| (LET ((|bfVar#98| NIL) (|bfVar#96| |sgargl|) (|i| NIL) (|bfVar#97| |largl|) (|j| NIL)) (LOOP (COND ((OR (ATOM |bfVar#96|) (PROGN (SETQ |i| (CAR |bfVar#96|)) NIL) (ATOM |bfVar#97|) (PROGN (SETQ |j| (CAR |bfVar#97|)) NIL)) (RETURN (NREVERSE |bfVar#98|))) (#1# (SETQ |bfVar#98| (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|) |bfVar#98|)))) (SETQ |bfVar#96| (CDR |bfVar#96|)) (SETQ |bfVar#97| (CDR |bfVar#97|))))) (SETQ |body| (LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|))) (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) (SETQ |def| (LIST |op| |lamex|)) (|bfTuple| (CONS (|shoeComp| |def|) (LET ((|bfVar#100| NIL) (|bfVar#99| |$wheredefs|) (|d| NIL)) (LOOP (COND ((OR (ATOM |bfVar#99|) (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL)) (RETURN (NREVERSE |bfVar#100|))) (#1# (SETQ |bfVar#100| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) |bfVar#100|)))) (SETQ |bfVar#99| (CDR |bfVar#99|)))))))))) (DEFUN |bfGargl| (|argl|) (PROG (|f| |d| |c| |b| |a| |LETTMP#1|) (RETURN (COND ((NULL |argl|) (LIST NIL NIL NIL NIL)) (#0='T (SETQ |LETTMP#1| (|bfGargl| (CDR |argl|))) (SETQ |a| (CAR |LETTMP#1|)) (SETQ |b| (CADR . #1=(|LETTMP#1|))) (SETQ |c| (CADDR . #1#)) (SETQ |d| (CADDDR . #1#)) (COND ((EQ (CAR |argl|) '&REST) (LIST (CONS (CAR |argl|) |b|) |b| |c| (CONS (LIST 'CONS (LIST 'QUOTE 'LIST) (CAR |d|)) (CDR |d|)))) (#0# (SETQ |f| (|bfGenSymbol|)) (LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|) (CONS |f| |d|))))))))) (DEFUN |bfDef1| (|bfVar#101|) (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args| |op| |defOp|) (RETURN (PROGN (SETQ |defOp| (CAR |bfVar#101|)) (SETQ |op| (CADR . #0=(|bfVar#101|))) (SETQ |args| (CADDR . #0#)) (SETQ |body| (CADDDR . #0#)) (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) ('T (LIST |args|)))) (SETQ |LETTMP#1| (|bfInsertLet| |argl| |body|)) (SETQ |quotes| (CAR |LETTMP#1|)) (SETQ |control| (CADR . #1=(|LETTMP#1|))) (SETQ |arglp| (CADDR . #1#)) (SETQ |body| (CADDDR . #1#)) (COND (|quotes| (|shoeLAM| |op| |arglp| |control| |body|)) ('T (LIST (LIST |op| (LIST 'LAMBDA |arglp| |body|))))))))) (DEFUN |shoeLAM| (|op| |args| |control| |body|) (PROG (|innerfunc| |margs|) (RETURN (PROGN (SETQ |margs| (|bfGenSymbol|)) (SETQ |innerfunc| (INTERN (CONCAT (PNAME |op|) '|,LAM|))) (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) (LIST |op| (LIST 'MLAMBDA (LIST '&REST |margs|) (LIST 'CONS (LIST 'QUOTE |innerfunc|) (LIST 'WRAP |margs| (LIST 'QUOTE |control|)))))))))) (DEFUN |bfDef| (|defOp| |op| |args| |body|) (PROG (|body1| |arg1| |op1| |LETTMP#1|) (DECLARE (SPECIAL |$wheredefs| |$bfClamming|)) (RETURN (COND (|$bfClamming| (PROGN (SETQ |LETTMP#1| (|shoeComp| (CAR (|bfDef1| (LIST |defOp| |op| |args| |body|))))) (SETQ |op1| (CADR . #0=(|LETTMP#1|))) (SETQ |arg1| (CADDR . #0#)) (SETQ |body1| (CDDDR . #0#)) (|bfCompHash| |op1| |arg1| |body1|))) ('T (|bfTuple| (LET ((|bfVar#103| NIL) (|bfVar#102| (CONS (LIST |defOp| |op| |args| |body|) |$wheredefs|)) (|d| NIL)) (LOOP (COND ((OR (ATOM |bfVar#102|) (PROGN (SETQ |d| (CAR |bfVar#102|)) NIL)) (RETURN (NREVERSE |bfVar#103|))) ('T (SETQ |bfVar#103| (APPEND (REVERSE (|shoeComps| (|bfDef1| |d|))) |bfVar#103|)))) (SETQ |bfVar#102| (CDR |bfVar#102|)))))))))) (DEFUN |shoeComps| (|x|) (LET ((|bfVar#105| NIL) (|bfVar#104| |x|) (|def| NIL)) (LOOP (COND ((OR (ATOM |bfVar#104|) (PROGN (SETQ |def| (CAR |bfVar#104|)) NIL)) (RETURN (NREVERSE |bfVar#105|))) ('T (SETQ |bfVar#105| (CONS (|shoeComp| |def|) |bfVar#105|)))) (SETQ |bfVar#104| (CDR |bfVar#104|))))) (DEFUN |shoeComp| (|x|) (PROG (|a|) (RETURN (PROGN (SETQ |a| (|shoeCompTran| (CADR |x|))) (COND ((EQCAR |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|) (NOT (ATOM |p1|))) |p1|) ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL)) (COND ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))) (|bpSpecificErrorHere| "default value required")) (#0='T (CONS (CAR |p1|) (APPEND (CDR |p1|) (CDR |p2|)))))) ((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)) (CONS |p1| (CONS (CAR |p2|) (CDR |p2|)))) (#0# (CONS |p1| |p2|)))) (DEFUN |bfInsertLet| (|x| |body|) (PROG (|body2| |name2| |norq1| |b1| |body1| |name1| |norq| |LETTMP#1| |b| |a| |ISTMP#1|) (RETURN (COND ((NULL |x|) (LIST NIL NIL |x| |body|)) ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |a| (CAR |ISTMP#1|)) #0='T)))) (COND ((AND (CONSP |a|) (EQ (CAR |a|) 'QUOTE) (PROGN (SETQ |ISTMP#1| (CDR |a|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#1|)) #0#)))) (LIST T 'QUOTE (LIST '&REST |b|) |body|)) (#1='T (LIST NIL NIL |x| |body|)))) (#1# (SETQ |LETTMP#1| (|bfInsertLet1| (CAR |x|) |body|)) (SETQ |b| (CAR |LETTMP#1|)) (SETQ |norq| (CADR . #2=(|LETTMP#1|))) (SETQ |name1| (CADDR . #2#)) (SETQ |body1| (CADDDR . #2#)) (SETQ |LETTMP#1| (|bfInsertLet| (CDR |x|) |body1|)) (SETQ |b1| (CAR |LETTMP#1|)) (SETQ |norq1| (CADR . #3=(|LETTMP#1|))) (SETQ |name2| (CADDR . #3#)) (SETQ |body2| (CADDDR . #3#)) (LIST (OR |b| |b1|) (CONS |norq| |norq1|) (|bfParameterList| |name1| |name2|) |body2|)))))) (DEFUN |bfInsertLet1| (|y| |body|) (PROG (|bfVar#107| |bfVar#106| |g| |b| |r| |ISTMP#2| |l| |ISTMP#1|) (RETURN (COND ((AND (CONSP |y|) (EQ (CAR |y|) 'L%T) (PROGN (SETQ |ISTMP#1| (CDR |y|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |l| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |r| (CAR |ISTMP#2|)) #0='T)))))) (LIST NIL NIL |l| (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|)))) ((IDENTP |y|) (LIST NIL NIL |y| |body|)) ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE) (PROGN (SETQ |ISTMP#1| (CDR |y|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#1|)) #0#)))) (LIST T 'QUOTE |b| |body|)) (#1='T (PROGN (SETQ |g| (|bfGenSymbol|)) (COND ((ATOM |y|) (LIST NIL NIL |g| |body|)) (#1# (PROGN (SETQ |bfVar#106| |y|) (SETQ |bfVar#107| (CDR |bfVar#106|)) (CASE (CAR |bfVar#106|) (|%DefaultValue| (LET ((|p| (CAR |bfVar#107|)) (|v| (CADR |bfVar#107|))) (LIST NIL NIL (LIST '&OPTIONAL (LIST |p| |v|)) |body|))) (T (LIST NIL NIL |g| (|bfMKPROGN| (LIST (|bfLET| (|compFluidize| |y|) |g|) |body|)))))))))))))) (DEFUN |shoeCompTran| (|x|) (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars| |body'| |lvars| |body| |args| |lamtype|) (DECLARE (SPECIAL |$typings| |$dollarVars| |$fluidVars| |$locVars|)) (RETURN (PROGN (SETQ |lamtype| (CAR |x|)) (SETQ |args| (CADR |x|)) (SETQ |body| (CDDR |x|)) (SETQ |$fluidVars| NIL) (SETQ |$locVars| NIL) (SETQ |$dollarVars| NIL) (|shoeCompTran1| |body|) (SETQ |$locVars| (SETDIFFERENCE (SETDIFFERENCE |$locVars| |$fluidVars|) (|shoeATOMs| |args|))) (SETQ |body| (PROGN (SETQ |lvars| (APPEND |$fluidVars| |$locVars|)) (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|)) (SETQ |body'| |body|) (COND (|$typings| (SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|)))) (COND (|$fluidVars| (SETQ |fvars| (LIST 'DECLARE (CONS 'SPECIAL |$fluidVars|))) (SETQ |body'| (CONS |fvars| |body'|)))) (COND ((OR |lvars| (|needsPROG| |body|)) (|shoePROG| |lvars| |body'|)) (#0='T |body'|)))) (SETQ |fl| (|shoeFluids| |args|)) (SETQ |body| (COND (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|))) (CONS |fvs| |body|)) (#0# |body|))) (CONS |lamtype| (CONS |args| |body|)))))) (DEFUN |needsPROG| (|body|) (PROG (|args| |op|) (RETURN (COND ((ATOM |body|) NIL) (#0='T (PROGN (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|)) (COND ((MEMBER |op| '(RETURN RETURN-FROM)) T) ((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL) ((LET ((|bfVar#109| NIL) (|bfVar#108| |body|) (|t| NIL)) (LOOP (COND ((OR (ATOM |bfVar#108|) (PROGN (SETQ |t| (CAR |bfVar#108|)) NIL)) (RETURN |bfVar#109|)) ('T (PROGN (SETQ |bfVar#109| (|needsPROG| |t|)) (COND (|bfVar#109| (RETURN |bfVar#109|)))))) (SETQ |bfVar#108| (CDR |bfVar#108|)))) T) (#0# NIL)))))))) (DEFUN |shoePROG| (|v| |b|) (PROG (|blist| |blast| |LETTMP#1|) (RETURN (COND ((NULL |b|) (LIST (LIST 'PROG |v|))) ('T (PROGN (SETQ |LETTMP#1| (REVERSE |b|)) (SETQ |blast| (CAR |LETTMP#1|)) (SETQ |blist| (NREVERSE (CDR |LETTMP#1|))) (LIST (CONS 'PROG (CONS |v| (APPEND |blist| (CONS (LIST 'RETURN |blast|) NIL))))))))))) (DEFUN |shoeFluids| (|x|) (COND ((NULL |x|) NIL) ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) ((EQCAR |x| 'QUOTE) NIL) ((ATOM |x|) NIL) ('T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|)))))) (DEFUN |shoeATOMs| (|x|) (COND ((NULL |x|) NIL) ((ATOM |x|) (LIST |x|)) ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|)))))) (DEFUN |isDynamicVariable| (|x|) (PROG (|y|) (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|)) (RETURN (COND ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (COND ((MEMQ |x| |$constantIdentifiers|) NIL) ((CONSTANTP |x|) NIL) ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T) ((SETQ |y| (FIND-SYMBOL (STRING |x|) |$activeNamespace|)) (NOT (CONSTANTP |y|))) (#0='T T))) (#0# NIL))))) (DEFUN |shoeCompTran1| (|x|) (PROG (|res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U) (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|)) (RETURN (COND ((ATOM |x|) (COND ((|isDynamicVariable| |x|) (SETQ |$dollarVars| (COND ((MEMQ |x| |$dollarVars|) |$dollarVars|) (#0='T (CONS |x| |$dollarVars|))))) (#0# NIL))) (#0# (PROGN (SETQ U (CAR |x|)) (COND ((EQ U 'QUOTE) NIL) ((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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |r| (CAR |ISTMP#2|)) 'T)))))) (PROGN (RPLACA |x| 'SETQ) (|shoeCompTran1| |r|) (COND ((IDENTP |l|) (COND ((NOT (|bfBeginsDollar| |l|)) (SETQ |$locVars| (COND ((MEMQ |l| |$locVars|) |$locVars|) (#0# (CONS |l| |$locVars|))))) (#0# (SETQ |$dollarVars| (COND ((MEMQ |l| |$dollarVars|) |$dollarVars|) (#0# (CONS |l| |$dollarVars|))))))) ((EQCAR |l| 'FLUID) (PROGN (SETQ |$fluidVars| (COND ((MEMQ (CADR |l|) |$fluidVars|) |$fluidVars|) (#0# (CONS (CADR |l|) |$fluidVars|)))) (RPLACA (CDR |x|) (CADR |l|))))))) ((MEMQ U '(PROG LAMBDA)) (PROGN (SETQ |newbindings| NIL) (LET ((|bfVar#110| (CADR |x|)) (|y| NIL)) (LOOP (COND ((OR (ATOM |bfVar#110|) (PROGN (SETQ |y| (CAR |bfVar#110|)) NIL)) (RETURN NIL)) (#1='T (COND ((NOT (MEMQ |y| |$locVars|)) (IDENTITY (PROGN (SETQ |$locVars| (CONS |y| |$locVars|)) (SETQ |newbindings| (CONS |y| |newbindings|)))))))) (SETQ |bfVar#110| (CDR |bfVar#110|)))) (SETQ |res| (|shoeCompTran1| (CDDR |x|))) (SETQ |$locVars| (LET ((|bfVar#112| NIL) (|bfVar#111| |$locVars|) (|y| NIL)) (LOOP (COND ((OR (ATOM |bfVar#111|) (PROGN (SETQ |y| (CAR |bfVar#111|)) NIL)) (RETURN (NREVERSE |bfVar#112|))) (#1# (AND (NOT (MEMQ |y| |newbindings|)) (SETQ |bfVar#112| (CONS |y| |bfVar#112|))))) (SETQ |bfVar#111| (CDR |bfVar#111|))))))) (#0# (PROGN (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))))) (DEFUN |bfTagged| (|a| |b|) (DECLARE (SPECIAL |$typings| |$op|)) (COND ((NULL |$op|) (|%Signature| |a| |b|)) ((IDENTP |a|) (COND ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL)) ((EQ |b| '|fluid|) (|bfLET| (|compFluid| |a|) NIL)) ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL)) (#0='T (PROGN (SETQ |$typings| (CONS (LIST 'TYPE |b| |a|) |$typings|)) |a|)))) (#0# (LIST 'THE |b| |a|)))) (DEFUN |bfAssign| (|l| |r|) (COND ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|)) ('T (|bfLET| |l| |r|)))) (DEFUN |bfSetelt| (|e| |l| |r|) (COND ((NULL (CDR |l|)) (|defSETELT| |e| (CAR |l|) |r|)) ('T (|bfSetelt| (|bfElt| |e| (CAR |l|)) (CDR |l|) |r|)))) (DEFUN |bfElt| (|expr| |sel|) (PROG (|y|) (RETURN (PROGN (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION))) (COND (|y| (COND ((INTEGERP |y|) (LIST 'ELT |expr| |y|)) (#0='T (LIST |y| |expr|)))) (#0# (LIST 'ELT |expr| |sel|))))))) (DEFUN |defSETELT| (|var| |sel| |expr|) (PROG (|y|) (RETURN (PROGN (SETQ |y| (AND (SYMBOLP |sel|) (GET |sel| 'SHOESELFUNCTION))) (COND (|y| (COND ((INTEGERP |y|) (LIST 'SETF (LIST 'ELT |var| |y|) |expr|)) (#0='T (LIST 'SETF (LIST |y| |var|) |expr|)))) (#0# (LIST 'SETF (LIST 'ELT |var| |sel|) |expr|))))))) (DEFUN |bfIfThenOnly| (|a| |b|) (PROG (|b1|) (RETURN (PROGN (SETQ |b1| (COND ((EQCAR |b| 'PROGN) (CDR |b|)) ('T (LIST |b|)))) (LIST 'COND (CONS |a| |b1|)))))) (DEFUN |bfIf| (|a| |b| |c|) (PROG (|c1| |b1|) (RETURN (PROGN (SETQ |b1| (COND ((EQCAR |b| 'PROGN) (CDR |b|)) (#0='T (LIST |b|)))) (COND ((EQCAR |c| 'COND) (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|)))) ('T (PROGN (SETQ |c1| (COND ((EQCAR |c| 'PROGN) (CDR |c|)) (#0# (LIST |c|)))) (LIST 'COND (CONS |a| |b1|) (CONS ''T |c1|))))))))) (DEFUN |bfExit| (|a| |b|) (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|)))) (DEFUN |bfMKPROGN| (|l|) (PROG (|a|) (RETURN (PROGN (SETQ |a| (LET ((|bfVar#113| NIL) (|c| |l|)) (LOOP (COND ((ATOM |c|) (RETURN (NREVERSE |bfVar#113|))) ('T (SETQ |bfVar#113| (APPEND (REVERSE (|bfFlattenSeq| |c|)) |bfVar#113|)))) (SETQ |c| (CDR |c|))))) (COND ((NULL |a|) NIL) ((NULL (CDR |a|)) (CAR |a|)) ('T (CONS 'PROGN |a|))))))) (DEFUN |bfFlattenSeq| (|x|) (PROG (|f|) (RETURN (COND ((NULL |x|) NIL) (#0='T (PROGN (SETQ |f| (CAR |x|)) (COND ((ATOM |f|) (COND ((CDR |x|) NIL) ('T (LIST |f|)))) ((EQCAR |f| 'PROGN) (COND ((CDR |x|) (LET ((|bfVar#115| NIL) (|bfVar#114| (CDR |f|)) (|i| NIL)) (LOOP (COND ((OR (ATOM |bfVar#114|) (PROGN (SETQ |i| (CAR |bfVar#114|)) NIL)) (RETURN (NREVERSE |bfVar#115|))) ('T (AND (NOT (ATOM |i|)) (SETQ |bfVar#115| (CONS |i| |bfVar#115|))))) (SETQ |bfVar#114| (CDR |bfVar#114|))))) (#0# (CDR |f|)))) (#0# (LIST |f|))))))))) (DEFUN |bfSequence| (|l|) (PROG (|f| |aft| |before| |no| |transform| |b| |ISTMP#5| |ISTMP#4| |ISTMP#3| |a| |ISTMP#2| |ISTMP#1|) (RETURN (COND ((NULL |l|) NIL) (#0='T (PROGN (SETQ |transform| (LET ((|bfVar#117| NIL) (|bfVar#116| |l|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#116|) (PROGN (SETQ |x| (CAR |bfVar#116|)) NIL) (NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND) (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (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|) (EQ (CDR |ISTMP#3|) NIL) (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|) (EQ (CDR |ISTMP#5|) NIL) (PROGN (SETQ |b| (CAR |ISTMP#5|)) 'T)))))))))))))) (RETURN (NREVERSE |bfVar#117|))) ('T (SETQ |bfVar#117| (CONS (LIST |a| |b|) |bfVar#117|)))) (SETQ |bfVar#116| (CDR |bfVar#116|))))) (SETQ |no| (LENGTH |transform|)) (SETQ |before| (|bfTake| |no| |l|)) (SETQ |aft| (|bfDrop| |no| |l|)) (COND ((NULL |before|) (COND ((NULL (CDR |l|)) (PROGN (SETQ |f| (CAR |l|)) (COND ((EQCAR |f| 'PROGN) (|bfSequence| (CDR |f|))) ('T |f|)))) (#0# (|bfMKPROGN| (LIST (CAR |l|) (|bfSequence| (CDR |l|))))))) ((NULL |aft|) (CONS 'COND |transform|)) (#0# (CONS 'COND (APPEND |transform| (CONS (LIST ''T (|bfSequence| |aft|)) NIL))))))))))) (DEFUN |bfWhere| (|context| |expr|) (PROG (|a| |body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def| |nondefs| |defs| |opassoc| |LETTMP#1|) (DECLARE (SPECIAL |$wheredefs|)) (RETURN (PROGN (SETQ |LETTMP#1| (|defSheepAndGoats| |context|)) (SETQ |opassoc| (CAR |LETTMP#1|)) (SETQ |defs| (CADR . #0=(|LETTMP#1|))) (SETQ |nondefs| (CADDR . #0#)) (SETQ |a| (LET ((|bfVar#119| NIL) (|bfVar#118| |defs|) (|d| NIL)) (LOOP (COND ((OR (ATOM |bfVar#118|) (PROGN (SETQ |d| (CAR |bfVar#118|)) NIL)) (RETURN (NREVERSE |bfVar#119|))) ('T (AND (CONSP |d|) (PROGN (SETQ |def| (CAR |d|)) (SETQ |ISTMP#1| (CDR |d|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |op| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (PROGN (SETQ |args| (CAR |ISTMP#2|)) (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) (EQ (CDR |ISTMP#3|) NIL) (PROGN (SETQ |body| (CAR |ISTMP#3|)) 'T))))))) (SETQ |bfVar#119| (CONS (LIST |def| |op| |args| (|bfSUBLIS| |opassoc| |body|)) |bfVar#119|))))) (SETQ |bfVar#118| (CDR |bfVar#118|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|)))))))) (DEFUN |bfReadLisp| (|string|) (|bfTuple| (|shoeReadLispString| |string| 0))) (DEFUN |bfCompHash| (|op| |argl| |body|) (PROG (|computeFunction| |auxfn|) (RETURN (PROGN (SETQ |auxfn| (INTERN (CONCAT (PNAME |op|) ";"))) (SETQ |computeFunction| (CONS 'DEFUN (CONS |auxfn| (CONS |argl| |body|)))) (|bfTuple| (CONS |computeFunction| (|bfMain| |auxfn| |op|))))))) (DEFUN |shoeCompileTimeEvaluation| (|x|) (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|)) (DEFUN |shoeEVALANDFILEACTQ| (|x|) (LIST 'EVAL-WHEN (LIST :EXECUTE :LOAD-TOPLEVEL) |x|)) (DEFUN |bfMain| (|auxfn| |op|) (PROG (|defCode| |cacheVector| |cacheCountCode| |cacheResetCode| |cacheType| |mainFunction| |codeBody| |thirdPredPair| |putCode| |secondPredPair| |getCode| |g2| |cacheName| |computeValue| |arg| |g1|) (RETURN (PROGN (SETQ |g1| (|bfGenSymbol|)) (SETQ |arg| (LIST '&REST |g1|)) (SETQ |computeValue| (LIST 'APPLY (LIST 'FUNCTION |auxfn|) |g1|)) (SETQ |cacheName| (INTERN (CONCAT (PNAME |op|) ";AL"))) (SETQ |g2| (|bfGenSymbol|)) (SETQ |getCode| (LIST 'GETHASH |g1| |cacheName|)) (SETQ |secondPredPair| (LIST (LIST 'SETQ |g2| |getCode|) |g2|)) (SETQ |putCode| (LIST 'SETF |getCode| |computeValue|)) (SETQ |thirdPredPair| (LIST ''T |putCode|)) (SETQ |codeBody| (LIST 'PROG (LIST |g2|) (LIST 'RETURN (LIST 'COND |secondPredPair| |thirdPredPair|)))) (SETQ |mainFunction| (LIST 'DEFUN |op| |arg| |codeBody|)) (SETQ |cacheType| '|hash-table|) (SETQ |cacheResetCode| (LIST 'SETQ |cacheName| (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL)))) (SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|)) (SETQ |cacheVector| (LIST |op| |cacheName| |cacheType| |cacheResetCode| |cacheCountCode|)) (SETQ |defCode| (LIST 'DEFPARAMETER |cacheName| (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL)))) (LIST |defCode| |mainFunction| (|shoeEVALANDFILEACTQ| (LIST 'SETF (LIST 'GET (LIST 'QUOTE |op|) (LIST 'QUOTE '|cacheInfo|)) (LIST 'QUOTE |cacheVector|)))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfNameOnly|)) (DEFUN |bfNameOnly| (|x|) (COND ((EQ |x| '|t|) (LIST 'T)) ('T (LIST |x|)))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfNameArgs|)) (DEFUN |bfNameArgs| (|x| |y|) (PROGN (SETQ |y| (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|)))) (CONS |x| |y|))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfStruct|)) (DEFUN |bfStruct| (|name| |arglist|) (|bfTuple| (LET ((|bfVar#121| NIL) (|bfVar#120| |arglist|) (|i| NIL)) (LOOP (COND ((OR (ATOM |bfVar#120|) (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL)) (RETURN (NREVERSE |bfVar#121|))) ('T (SETQ |bfVar#121| (CONS (|bfCreateDef| |i|) |bfVar#121|)))) (SETQ |bfVar#120| (CDR |bfVar#120|)))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|)) (DEFUN |bfCreateDef| (|x|) (PROG (|a| |f|) (RETURN (COND ((NULL (CDR |x|)) (SETQ |f| (CAR |x|)) (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) ('T (SETQ |a| (LET ((|bfVar#123| NIL) (|bfVar#122| (CDR |x|)) (|i| NIL)) (LOOP (COND ((OR (ATOM |bfVar#122|) (PROGN (SETQ |i| (CAR |bfVar#122|)) NIL)) (RETURN (NREVERSE |bfVar#123|))) ('T (SETQ |bfVar#123| (CONS (|bfGenSymbol|) |bfVar#123|)))) (SETQ |bfVar#122| (CDR |bfVar#122|))))) (LIST 'DEFUN (CAR |x|) |a| (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfCaseItem|)) (DEFUN |bfCaseItem| (|x| |y|) (LIST |x| |y|)) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%List|) |bfCase|)) (DEFUN |bfCase| (|x| |y|) (PROG (|c| |b| |a| |g1| |g|) (RETURN (PROGN (SETQ |g| (|bfGenSymbol|)) (SETQ |g1| (|bfGenSymbol|)) (SETQ |a| (|bfLET| |g| |x|)) (SETQ |b| (|bfLET| |g1| (LIST 'CDR |g|))) (SETQ |c| (|bfCaseItems| |g1| |y|)) (|bfMKPROGN| (LIST |a| |b| (CONS 'CASE (CONS (LIST 'CAR |g|) |c|)))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfCaseItems|)) (DEFUN |bfCaseItems| (|g| |x|) (PROG (|j| |ISTMP#1| |i|) (RETURN (LET ((|bfVar#126| NIL) (|bfVar#125| |x|) (|bfVar#124| NIL)) (LOOP (COND ((OR (ATOM |bfVar#125|) (PROGN (SETQ |bfVar#124| (CAR |bfVar#125|)) NIL)) (RETURN (NREVERSE |bfVar#126|))) ('T (AND (CONSP |bfVar#124|) (PROGN (SETQ |i| (CAR |bfVar#124|)) (SETQ |ISTMP#1| (CDR |bfVar#124|)) (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) (PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T))) (SETQ |bfVar#126| (CONS (|bfCI| |g| |i| |j|) |bfVar#126|))))) (SETQ |bfVar#125| (CDR |bfVar#125|))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|)) (DEFUN |bfCI| (|g| |x| |y|) (PROG (|b| |a|) (RETURN (PROGN (SETQ |a| (CDR |x|)) (COND ((NULL |a|) (LIST (CAR |x|) |y|)) ('T (SETQ |b| (LET ((|bfVar#128| NIL) (|bfVar#127| |a|) (|i| NIL) (|j| 0)) (LOOP (COND ((OR (ATOM |bfVar#127|) (PROGN (SETQ |i| (CAR |bfVar#127|)) NIL)) (RETURN (NREVERSE |bfVar#128|))) ('T (AND (NOT (EQ |i| 'DOT)) (SETQ |bfVar#128| (CONS (LIST |i| (|bfCARCDR| |j| |g|)) |bfVar#128|))))) (SETQ |bfVar#127| (CDR |bfVar#127|)) (SETQ |j| (+ |j| 1))))) (COND ((NULL |b|) (LIST (CAR |x|) |y|)) ('T (LIST (CAR |x|) (LIST 'LET |b| |y|)))))))))) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Thing|) |%List|) |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)))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%Thing|) |bfTry|)) (DEFUN |bfTry| (|e| |cs|) (PROG (|bfVar#130| |bfVar#129|) (RETURN (COND ((NULL |cs|) |e|) (#0='T (PROGN (SETQ |bfVar#129| (CAR |cs|)) (SETQ |bfVar#130| (CDR |bfVar#129|)) (CASE (CAR |bfVar#129|) (|%Catch| (LET ((|tag| (CAR |bfVar#130|))) (COND ((ATOM |tag|) (|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|) (CDR |cs|))) (#0# (|bpTrap|))))) (T (|bpTrap|))))))))) (DEFUN |bfThrow| (|e|) (COND ((ATOM |e|) (LIST 'THROW (LIST 'QUOTE |e|) NIL)) ((NOT (ATOM (CAR |e|))) (|bpTrap|)) ('T (CONS 'THROW (CONS (LIST 'QUOTE (CAR |e|)) (CDR |e|)))))) (DEFUN |backquote| (|form| |params|) (COND ((NULL |params|) (|quote| |form|)) ((ATOM |form|) (COND ((MEMBER |form| |params|) |form|) (#0='T (|quote| |form|)))) (#0# (CONS 'LIST (LET ((|bfVar#132| NIL) (|bfVar#131| |form|) (|t| NIL)) (LOOP (COND ((OR (ATOM |bfVar#131|) (PROGN (SETQ |t| (CAR |bfVar#131|)) NIL)) (RETURN (NREVERSE |bfVar#132|))) ('T (SETQ |bfVar#132| (CONS (|backquote| |t| |params|) |bfVar#132|)))) (SETQ |bfVar#131| (CDR |bfVar#131|)))))))) (DEFUN |genTypeAlias| (|head| |body|) (PROG (|args| |op|) (RETURN (PROGN (SETQ |op| (CAR |head|)) (SETQ |args| (CDR |head|)) (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|)))))) (DEFCONSTANT |$NativeSimpleDataTypes| '(|char| |byte| |int| |int8| |uint8| |int16| |uint16| |int32| |uint32| |int64| |uint64| |float| |float32| |double| |float64|)) (DEFCONSTANT |$NativeSimpleReturnTypes| (APPEND |$NativeSimpleDataTypes| '(|void| |string|))) (DEFUN |isSimpleNativeType| (|t|) (MEMBER |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: " (SYMBOL-NAME |t|)))) (DEFUN |nativeType| (|t|) (PROG (|t'|) (RETURN (COND ((NULL |t|) |t|) ((ATOM |t|) (COND ((SETQ |t'| (CDR (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|))) (PROGN (SETQ |t'| (COND ((|%hasFeature| :SBCL) (|bfColonColon| 'SB-ALIEN |t'|)) ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI |t'|)) (#0='T |t'|))) (COND ((AND (EQ |t| '|string|) (|%hasFeature| :SBCL)) (LIST |t'| :EXTERNAL-FORMAT :ASCII :ELEMENT-TYPE 'BASE-CHAR)) (#0# |t'|)))) ((MEMBER |t| '(|byte| |uint8|)) (COND ((|%hasFeature| :SBCL) (LIST (|bfColonColon| 'SB-ALIEN 'UNSIGNED) 8)) ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'UINT8)) ((|%hasFeature| :ECL) :UNSIGNED-BYTE) (#0# (|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) (#0# (|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) (#0# (|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) (#0# (|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) (#0# (|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) (#0# (|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) (#0# (|unknownNativeTypeError| |t|)))) ((EQ |t| '|float32|) (|nativeType| '|float|)) ((EQ |t| '|float64|) (|nativeType| '|double|)) (#0# (|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)) (#0# (|unknownNativeTypeError| |t|)))) ((EQ (CAR |t|) '|buffer|) (COND ((|%hasFeature| :GCL) '|fixnum|) ((|%hasFeature| :ECL) :OBJECT) ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|)))) ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER)) (#0# (|unknownNativeTypeError| |t|)))) (#0# (|unknownNativeTypeError| |t|)))))) (DEFUN |nativeReturnType| (|t|) (COND ((MEMBER |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|)) ('T (|coreError| (CONCAT "invalid return type for native function: " (SYMBOL-NAME |t|)))))) (DEFUN |nativeArgumentType| (|t|) (PROG (|t'| |c| |m|) (RETURN (COND ((MEMBER |t| |$NativeSimpleDataTypes|) (|nativeType| |t|)) ((EQ |t| '|string|) (|nativeType| |t|)) ((OR (ATOM |t|) (NOT (EQL (LENGTH |t|) 2))) (|coreError| "invalid argument type for a native function")) (#0='T (PROGN (SETQ |m| (CAR |t|)) (SETQ |c| (CAADR . #1=(|t|))) (SETQ |t'| (CADADR . #1#)) (COND ((NOT (MEMBER |m| '(|readonly| |writeonly| |readwrite|))) (|coreError| "missing modifier for argument type for a native function")) ((NOT (MEMBER |c| '(|buffer| |pointer|))) (|coreError| "expect 'buffer' or 'pointer' type instance")) ((NOT (MEMBER |t'| |$NativeSimpleDataTypes|)) (|coreError| "expected simple native data type")) (#0# (|nativeType| (CADR |t|)))))))))) (DEFUN |needsStableReference?| (|t|) (PROG (|m|) (RETURN (AND (CONSP |t|) (PROGN (SETQ |m| (CAR |t|)) 'T) (MEMBER |m| '(|readonly| |writeonly| |readwrite|)))))) (DEFUN |coerceToNativeType| (|a| |t|) (PROG (|y| |c|) (RETURN (COND ((OR (|%hasFeature| :GCL) (|%hasFeature| :ECL) (|%hasFeature| :CLISP)) |a|) ((|%hasFeature| :SBCL) (COND ((NOT (|needsStableReference?| |t|)) |a|) (#0='T (PROGN (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" (SYMBOL-NAME |c|))))))))) (#0# (|fatalError| "don't know how to coerce argument for native type")))))) (DEFUN |genGCLnativeTranslation| (|op| |s| |t| |op'|) (PROG (|ccode| |cargs| |cop| |rettype| |argtypes|) (RETURN (PROGN (SETQ |argtypes| (LET ((|bfVar#134| NIL) (|bfVar#133| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#133|) (PROGN (SETQ |x| (CAR |bfVar#133|)) NIL)) (RETURN (NREVERSE |bfVar#134|))) (#0='T (SETQ |bfVar#134| (CONS (|nativeArgumentType| |x|) |bfVar#134|)))) (SETQ |bfVar#133| (CDR |bfVar#133|))))) (SETQ |rettype| (|nativeReturnType| |t|)) (COND ((LET ((|bfVar#136| T) (|bfVar#135| (CONS |t| |s|)) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#135|) (PROGN (SETQ |x| (CAR |bfVar#135|)) NIL)) (RETURN |bfVar#136|)) (#0# (PROGN (SETQ |bfVar#136| (|isSimpleNativeType| |x|)) (COND ((NOT |bfVar#136|) (RETURN NIL)))))) (SETQ |bfVar#135| (CDR |bfVar#135|)))) (LIST (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| (SYMBOL-NAME |op'|))))) (#1='T (PROGN (SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub")) (SETQ |cargs| (LET ((|bfVar#143| NIL) (|bfVar#142| (- (LENGTH |s|) 1)) (|i| 0)) (LOOP (COND ((> |i| |bfVar#142|) (RETURN (NREVERSE |bfVar#143|))) (#0# (SETQ |bfVar#143| (CONS (|genGCLnativeTranslation,mkCArgName| |i|) |bfVar#143|)))) (SETQ |i| (+ |i| 1))))) (SETQ |ccode| (LET ((|bfVar#139| "") (|bfVar#141| (CONS (|genGCLnativeTranslation,gclTypeInC| |t|) (CONS " " (CONS |cop| (CONS "(" (APPEND (LET ((|bfVar#137| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND ((OR (ATOM |x|) (ATOM |a|)) (RETURN (NREVERSE |bfVar#137|))) (#0# (SETQ |bfVar#137| (CONS (|genGCLnativeTranslation,cparm| |x| |a|) |bfVar#137|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS ") { " (CONS (COND ((NOT (EQ |t| '|void|)) "return ") (#1# '||)) (CONS (SYMBOL-NAME |op'|) (CONS "(" (APPEND (LET ((|bfVar#138| NIL) (|x| |s|) (|a| |cargs|)) (LOOP (COND ((OR (ATOM |x|) (ATOM |a|)) (RETURN (NREVERSE |bfVar#138|))) (#0# (SETQ |bfVar#138| (CONS (|genGCLnativeTranslation,gclArgsInC| |x| |a|) |bfVar#138|)))) (SETQ |x| (CDR |x|)) (SETQ |a| (CDR |a|)))) (CONS "); }" NIL)))))))))))) (|bfVar#140| NIL)) (LOOP (COND ((OR (ATOM |bfVar#141|) (PROGN (SETQ |bfVar#140| (CAR |bfVar#141|)) NIL)) (RETURN |bfVar#139|)) (#0# (SETQ |bfVar#139| (CONCAT |bfVar#139| |bfVar#140|)))) (SETQ |bfVar#141| (CDR |bfVar#141|))))) (LIST (LIST 'CLINES |ccode|) (LIST 'DEFENTRY |op| |argtypes| (LIST |rettype| |cop|)))))))))) (DEFUN |genGCLnativeTranslation,mkCArgName| (|i|) (CONCAT "x" (STRINGIMAGE |i|))) (DEFUN |genGCLnativeTranslation,cparm| (|x| |a|) (CONCAT (|genGCLnativeTranslation,gclTypeInC| (CAR |x|)) " " (CAR |a|) (COND ((CDR |x|) ", ") ('T "")))) (DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|) (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|) (RETURN (COND ((MEMBER |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|) (EQ (CDR |ISTMP#1|) NIL) (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|) (EQ (CDR |ISTMP#3|) NIL)))))))) '|fixnum|) ('T "object"))))) (DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|) (PROG (|y| |c|) (RETURN (COND ((MEMBER |x| |$NativeSimpleDataTypes|) |a|) ((EQ |x| '|string|) |a|) (#0='T (PROGN (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")) (#0# (|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'|) (PROG (|rettype| |argtypes| |args|) (RETURN (PROGN (SETQ |args| NIL) (SETQ |argtypes| NIL) (LET ((|bfVar#144| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#144|) (PROGN (SETQ |x| (CAR |bfVar#144|)) NIL)) (RETURN NIL)) ('T (PROGN (SETQ |argtypes| (CONS (|nativeArgumentType| |x|) |argtypes|)) (SETQ |args| (CONS (GENSYM) |args|))))) (SETQ |bfVar#144| (CDR |bfVar#144|)))) (SETQ |args| (REVERSE |args|)) (SETQ |rettype| (|nativeReturnType| |t|)) (LIST (LIST 'DEFUN |op| |args| (LIST (|bfColonColon| 'FFI 'C-INLINE) |args| (NREVERSE |argtypes|) |rettype| (|genECLnativeTranslation,callTemplate| |op'| (LENGTH |args|) |s|) :ONE-LINER T))))))) (DEFUN |genECLnativeTranslation,callTemplate| (|op| |n| |s|) (LET ((|bfVar#148| "") (|bfVar#150| (CONS (SYMBOL-NAME |op|) (CONS "(" (APPEND (LET ((|bfVar#147| NIL) (|bfVar#145| (- |n| 1)) (|i| 0) (|bfVar#146| |s|) (|x| NIL)) (LOOP (COND ((OR (> |i| |bfVar#145|) (ATOM |bfVar#146|) (PROGN (SETQ |x| (CAR |bfVar#146|)) NIL)) (RETURN (NREVERSE |bfVar#147|))) (#0='T (SETQ |bfVar#147| (CONS (|genECLnativeTranslation,sharpArg| |i| |x|) |bfVar#147|)))) (SETQ |i| (+ |i| 1)) (SETQ |bfVar#146| (CDR |bfVar#146|)))) (CONS ")" NIL))))) (|bfVar#149| NIL)) (LOOP (COND ((OR (ATOM |bfVar#150|) (PROGN (SETQ |bfVar#149| (CAR |bfVar#150|)) NIL)) (RETURN |bfVar#148|)) (#0# (SETQ |bfVar#148| (CONCAT |bfVar#148| |bfVar#149|)))) (SETQ |bfVar#150| (CDR |bfVar#150|))))) (DEFUN |genECLnativeTranslation,sharpArg| (|i| |x|) (COND ((EQL |i| 0) (CONCAT "(#0)" (|genECLnativeTranslation,selectDatum| |x|))) ('T (CONCAT "," "(#" (STRINGIMAGE |i|) ")" (|genECLnativeTranslation,selectDatum| |x|))))) (DEFUN |genECLnativeTranslation,selectDatum| (|x|) (PROG (|y| |c|) (RETURN (COND ((|isSimpleNativeType| |x|) "") (#0='T (PROGN (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") (#0# "->vector.self.b8"))) ((EQ |y| '|int|) "->vector.self.fix") ((EQ |y| '|float|) "->vector.self.sf") ((EQ |y| '|double|) "->vector.self.df") (#0# (|coreError| "unknown argument to buffer type constructor")))) ((EQ |c| '|pointer|) '||) (#0# (|coreError| "unknown type constructor"))))))))) (DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|) (PROG (|forwardingFun| |ISTMP#2| |p| |fixups| |q| |call| |localPairs| |y| |x| |ISTMP#1| |a| |foreignDecl| |unstableArgs| |parms| |n| |argtypes| |rettype|) (DECLARE (SPECIAL |$foreignsDefsForCLisp|)) (RETURN (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| (LET ((|bfVar#152| NIL) (|bfVar#151| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#151|) (PROGN (SETQ |x| (CAR |bfVar#151|)) NIL)) (RETURN (NREVERSE |bfVar#152|))) (#0='T (SETQ |bfVar#152| (CONS (|nativeArgumentType| |x|) |bfVar#152|)))) (SETQ |bfVar#151| (CDR |bfVar#151|))))) (SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack"))) (SETQ |parms| (LET ((|bfVar#154| NIL) (|bfVar#153| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#153|) (PROGN (SETQ |x| (CAR |bfVar#153|)) NIL)) (RETURN (NREVERSE |bfVar#154|))) (#0# (SETQ |bfVar#154| (CONS (GENSYM "parm") |bfVar#154|)))) (SETQ |bfVar#153| (CDR |bfVar#153|))))) (SETQ |unstableArgs| NIL) (LET ((|bfVar#155| |parms|) (|p| NIL) (|bfVar#156| |s|) (|x| NIL) (|bfVar#157| |argtypes|) (|y| NIL)) (LOOP (COND ((OR (ATOM |bfVar#155|) (PROGN (SETQ |p| (CAR |bfVar#155|)) NIL) (ATOM |bfVar#156|) (PROGN (SETQ |x| (CAR |bfVar#156|)) NIL) (ATOM |bfVar#157|) (PROGN (SETQ |y| (CAR |bfVar#157|)) NIL)) (RETURN NIL)) (#0# (COND ((|needsStableReference?| |x|) (IDENTITY (SETQ |unstableArgs| (CONS (CONS |p| (CONS |x| |y|)) |unstableArgs|))))))) (SETQ |bfVar#155| (CDR |bfVar#155|)) (SETQ |bfVar#156| (CDR |bfVar#156|)) (SETQ |bfVar#157| (CDR |bfVar#157|)))) (SETQ |foreignDecl| (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n| (LIST :NAME (SYMBOL-NAME |op'|)) (CONS :ARGUMENTS (LET ((|bfVar#160| NIL) (|bfVar#158| |argtypes|) (|x| NIL) (|bfVar#159| |parms|) (|a| NIL)) (LOOP (COND ((OR (ATOM |bfVar#158|) (PROGN (SETQ |x| (CAR |bfVar#158|)) NIL) (ATOM |bfVar#159|) (PROGN (SETQ |a| (CAR |bfVar#159|)) NIL)) (RETURN (NREVERSE |bfVar#160|))) (#0# (SETQ |bfVar#160| (CONS (LIST |a| |x|) |bfVar#160|)))) (SETQ |bfVar#158| (CDR |bfVar#158|)) (SETQ |bfVar#159| (CDR |bfVar#159|))))) (LIST :RETURN-TYPE |rettype|) (LIST :LANGUAGE :STDC))) (SETQ |forwardingFun| (COND ((NULL |unstableArgs|) (LIST 'DEFUN |op| |parms| (CONS |n| |parms|))) (#1='T (PROGN (SETQ |localPairs| (LET ((|bfVar#163| NIL) (|bfVar#162| |unstableArgs|) (|bfVar#161| NIL)) (LOOP (COND ((OR (ATOM |bfVar#162|) (PROGN (SETQ |bfVar#161| (CAR |bfVar#162|)) NIL)) (RETURN (NREVERSE |bfVar#163|))) (#0# (AND (CONSP |bfVar#161|) (PROGN (SETQ |a| (CAR |bfVar#161|)) (SETQ |ISTMP#1| (CDR |bfVar#161|)) (AND (CONSP |ISTMP#1|) (PROGN (SETQ |x| (CAR |ISTMP#1|)) (SETQ |y| (CDR |ISTMP#1|)) #2='T))) (SETQ |bfVar#163| (CONS (CONS |a| (CONS |x| (CONS |y| (GENSYM "loc")))) |bfVar#163|))))) (SETQ |bfVar#162| (CDR |bfVar#162|))))) (SETQ |call| (CONS |n| (LET ((|bfVar#165| NIL) (|bfVar#164| |parms|) (|p| NIL)) (LOOP (COND ((OR (ATOM |bfVar#164|) (PROGN (SETQ |p| (CAR |bfVar#164|)) NIL)) (RETURN (NREVERSE |bfVar#165|))) (#0# (SETQ |bfVar#165| (CONS (|genCLISPnativeTranslation,actualArg| |p| |localPairs|) |bfVar#165|)))) (SETQ |bfVar#164| (CDR |bfVar#164|)))))) (SETQ |call| (PROGN (SETQ |fixups| (LET ((|bfVar#167| NIL) (|bfVar#166| |localPairs|) (|p| NIL)) (LOOP (COND ((OR (ATOM |bfVar#166|) (PROGN (SETQ |p| (CAR |bfVar#166|)) NIL)) (RETURN (NREVERSE |bfVar#167|))) (#0# (AND (NOT (NULL (SETQ |q| (|genCLISPnativeTranslation,copyBack| |p|)))) (SETQ |bfVar#167| (CONS |q| |bfVar#167|))))) (SETQ |bfVar#166| (CDR |bfVar#166|))))) (COND ((NULL |fixups|) (LIST |call|)) (#1# (LIST (CONS 'PROG1 (CONS |call| |fixups|))))))) (LET ((|bfVar#169| |localPairs|) (|bfVar#168| NIL)) (LOOP (COND ((OR (ATOM |bfVar#169|) (PROGN (SETQ |bfVar#168| (CAR |bfVar#169|)) NIL)) (RETURN NIL)) (#0# (AND (CONSP |bfVar#168|) (PROGN (SETQ |p| (CAR |bfVar#168|)) (SETQ |ISTMP#1| (CDR |bfVar#168|)) (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|)) #2#))))) (SETQ |call| (LIST (CONS (|bfColonColon| 'FFI 'WITH-FOREIGN-OBJECT) (CONS (LIST |a| (LIST 'FUNCALL (LIST 'INTERN "getCLISPType" "BOOTTRAN") |p|) |p|) |call|))))))) (SETQ |bfVar#169| (CDR |bfVar#169|)))) (CONS 'DEFUN (CONS |op| (CONS |parms| |call|))))))) (SETQ |$foreignsDefsForCLisp| (CONS |foreignDecl| |$foreignsDefsForCLisp|)) (LIST |forwardingFun|))))) (DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#170|) (PROG (|a| |y| |x| |p|) (RETURN (PROGN (SETQ |p| (CAR |bfVar#170|)) (SETQ |x| (CADR . #0=(|bfVar#170|))) (SETQ |y| (CADDR . #0#)) (SETQ |a| (CDDDR . #0#)) (COND ((AND (CONSP |x|) (EQ (CAR |x|) '|readonly|)) NIL) ('T (LIST 'SETF |p| (LIST (|bfColonColon| 'FFI 'FOREIGN-VALUE) |a|)))))))) (DEFUN |genCLISPnativeTranslation,actualArg| (|p| |pairs|) (PROG (|a'|) (RETURN (COND ((SETQ |a'| (CDR (ASSOC |p| |pairs|))) (CDR (CDR |a'|))) ('T |p|))))) (DEFUN |getCLISPType| (|a|) (LIST (|bfColonColon| 'FFI 'C-ARRAY) (LENGTH |a|))) (DEFUN |genSBCLnativeTranslation| (|op| |s| |t| |op'|) (PROG (|newArgs| |unstableArgs| |args| |argtypes| |rettype|) (RETURN (PROGN (SETQ |rettype| (|nativeReturnType| |t|)) (SETQ |argtypes| (LET ((|bfVar#172| NIL) (|bfVar#171| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#171|) (PROGN (SETQ |x| (CAR |bfVar#171|)) NIL)) (RETURN (NREVERSE |bfVar#172|))) (#0='T (SETQ |bfVar#172| (CONS (|nativeArgumentType| |x|) |bfVar#172|)))) (SETQ |bfVar#171| (CDR |bfVar#171|))))) (SETQ |args| (LET ((|bfVar#174| NIL) (|bfVar#173| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#173|) (PROGN (SETQ |x| (CAR |bfVar#173|)) NIL)) (RETURN (NREVERSE |bfVar#174|))) (#0# (SETQ |bfVar#174| (CONS (GENSYM) |bfVar#174|)))) (SETQ |bfVar#173| (CDR |bfVar#173|))))) (SETQ |unstableArgs| NIL) (SETQ |newArgs| NIL) (LET ((|bfVar#175| |args|) (|a| NIL) (|bfVar#176| |s|) (|x| NIL)) (LOOP (COND ((OR (ATOM |bfVar#175|) (PROGN (SETQ |a| (CAR |bfVar#175|)) NIL) (ATOM |bfVar#176|) (PROGN (SETQ |x| (CAR |bfVar#176|)) NIL)) (RETURN NIL)) (#0# (PROGN (SETQ |newArgs| (CONS (|coerceToNativeType| |a| |x|) |newArgs|)) (COND ((|needsStableReference?| |x|) (SETQ |unstableArgs| (CONS |a| |unstableArgs|))))))) (SETQ |bfVar#175| (CDR |bfVar#175|)) (SETQ |bfVar#176| (CDR |bfVar#176|)))) (SETQ |op'| (COND ((|%hasFeature| :WIN32) (CONCAT "_" (SYMBOL-NAME |op'|))) (#1='T (SYMBOL-NAME |op'|)))) (COND ((NULL |unstableArgs|) (LIST (LIST 'DEFUN |op| |args| (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") (CONS (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") |op'| (CONS 'FUNCTION (CONS |rettype| |argtypes|))) |args|))))) (#1# (LIST (LIST 'DEFUN |op| |args| (LIST (|bfColonColon| 'SB-SYS 'WITH-PINNED-OBJECTS) (NREVERSE |unstableArgs|) (CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN") (CONS (LIST (INTERN "EXTERN-ALIEN" "SB-ALIEN") |op'| (CONS 'FUNCTION (CONS |rettype| |argtypes|))) (NREVERSE |newArgs|)))))))))))) (DEFUN |genImportDeclaration| (|op| |sig|) (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|) (RETURN (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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |m| (CAR |ISTMP#2|)) #0='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|) (EQ (CDR |ISTMP#2|) NIL) (PROGN (SETQ |s| (CAR |ISTMP#2|)) #0#))))))) (|coreError| "invalid function type")) (#1='T (PROGN (COND ((AND (NOT (NULL |s|)) (SYMBOLP |s|)) (SETQ |s| (LIST |s|)))) (COND ((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|)) ((|%hasFeature| :SBCL) (|genSBCLnativeTranslation| |op| |s| |t| |op'|)) ((|%hasFeature| :CLISP) (|genCLISPnativeTranslation| |op| |s| |t| |op'|)) ((|%hasFeature| :ECL) (|genECLnativeTranslation| |op| |s| |t| |op'|)) (#1# (|fatalError| "import declaration not implemented for this Lisp")))))))))