(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 |Import| #0=(|bfVar#5|) (CONS '|Import| (LIST . #0#)))
(DEFUN |ImportSignature| #0=(|bfVar#6| |bfVar#7|)
(CONS '|ImportSignature| (LIST . #0#)))
(DEFUN |%TypeAlias| #0=(|bfVar#8| |bfVar#9|)
(CONS '|%TypeAlias| (LIST . #0#)))
(DEFUN |Signature| #0=(|bfVar#10| |bfVar#11|)
(CONS '|Signature| (LIST . #0#)))
(DEFUN |Mapping| #0=(|bfVar#12| |bfVar#13|)
(CONS '|Mapping| (LIST . #0#)))
(DEFUN |SuffixDot| #0=(|bfVar#14|) (CONS '|SuffixDot| (LIST . #0#)))
(DEFUN |Quote| #0=(|bfVar#15|) (CONS '|Quote| (LIST . #0#)))
(DEFUN |EqualName| #0=(|bfVar#16|) (CONS '|EqualName| (LIST . #0#)))
(DEFUN |Colon| #0=(|bfVar#17|) (CONS '|Colon| (LIST . #0#)))
(DEFUN |QualifiedName| #0=(|bfVar#18| |bfVar#19|)
(CONS '|QualifiedName| (LIST . #0#)))
(DEFUN |%DefaultValue| #0=(|bfVar#20| |bfVar#21|)
(CONS '|%DefaultValue| (LIST . #0#)))
(DEFUN |Bracket| #0=(|bfVar#22|) (CONS '|Bracket| (LIST . #0#)))
(DEFUN |UnboundedSegment| #0=(|bfVar#23|)
(CONS '|UnboundedSegment| (LIST . #0#)))
(DEFUN |BoundedSgement| #0=(|bfVar#24| |bfVar#25|)
(CONS '|BoundedSgement| (LIST . #0#)))
(DEFUN |Tuple| #0=(|bfVar#26|) (CONS '|Tuple| (LIST . #0#)))
(DEFUN |ColonAppend| #0=(|bfVar#27| |bfVar#28|)
(CONS '|ColonAppend| (LIST . #0#)))
(DEFUN |Is| #0=(|bfVar#29| |bfVar#30|) (CONS '|Is| (LIST . #0#)))
(DEFUN |Isnt| #0=(|bfVar#31| |bfVar#32|) (CONS '|Isnt| (LIST . #0#)))
(DEFUN |Reduce| #0=(|bfVar#33| |bfVar#34|)
(CONS '|Reduce| (LIST . #0#)))
(DEFUN |PrefixExpr| #0=(|bfVar#35| |bfVar#36|)
(CONS '|PrefixExpr| (LIST . #0#)))
(DEFUN |Call| #0=(|bfVar#37| |bfVar#38|) (CONS '|Call| (LIST . #0#)))
(DEFUN |InfixExpr| #0=(|bfVar#39| |bfVar#40| |bfVar#41|)
(CONS '|InfixExpr| (LIST . #0#)))
(DEFUN |ConstantDefinition| #0=(|bfVar#42| |bfVar#43|)
(CONS '|ConstantDefinition| (LIST . #0#)))
(DEFUN |Definition| #0=(|bfVar#44| |bfVar#45| |bfVar#46| |bfVar#47|)
(CONS '|Definition| (LIST . #0#)))
(DEFUN |Macro| #0=(|bfVar#48| |bfVar#49| |bfVar#50|)
(CONS '|Macro| (LIST . #0#)))
(DEFUN |SuchThat| #0=(|bfVar#51|) (CONS '|SuchThat| (LIST . #0#)))
(DEFUN |%Assignment| #0=(|bfVar#52| |bfVar#53|)
(CONS '|%Assignment| (LIST . #0#)))
(DEFUN |While| #0=(|bfVar#54|) (CONS '|While| (LIST . #0#)))
(DEFUN |Until| #0=(|bfVar#55|) (CONS '|Until| (LIST . #0#)))
(DEFUN |For| #0=(|bfVar#56| |bfVar#57| |bfVar#58|)
(CONS '|For| (LIST . #0#)))
(DEFUN |Exit| #0=(|bfVar#59| |bfVar#60|) (CONS '|Exit| (LIST . #0#)))
(DEFUN |Iterators| #0=(|bfVar#61|) (CONS '|Iterators| (LIST . #0#)))
(DEFUN |Cross| #0=(|bfVar#62|) (CONS '|Cross| (LIST . #0#)))
(DEFUN |Repeat| #0=(|bfVar#63| |bfVar#64|)
(CONS '|Repeat| (LIST . #0#)))
(DEFUN |Pile| #0=(|bfVar#65|) (CONS '|Pile| (LIST . #0#)))
(DEFUN |Append| #0=(|bfVar#66|) (CONS '|Append| (LIST . #0#)))
(DEFUN |Case| #0=(|bfVar#67| |bfVar#68|) (CONS '|Case| (LIST . #0#)))
(DEFUN |Return| #0=(|bfVar#69|) (CONS '|Return| (LIST . #0#)))
(DEFUN |%Throw| #0=(|bfVar#70|) (CONS '|%Throw| (LIST . #0#)))
(DEFUN |%Catch| #0=(|bfVar#71|) (CONS '|%Catch| (LIST . #0#)))
(DEFUN |%Try| #0=(|bfVar#72| |bfVar#73|) (CONS '|%Try| (LIST . #0#)))
(DEFUN |Where| #0=(|bfVar#74| |bfVar#75|)
(CONS '|Where| (LIST . #0#)))
(DEFUN |Structure| #0=(|bfVar#76| |bfVar#77|)
(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#79| |bfVar#78|)
(RETURN
(PROGN
(SETQ |bfVar#78| |x|)
(SETQ |bfVar#79| (CDR |bfVar#78|))
(CASE (CAR |bfVar#78|)
(|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#81| NIL) (|bfVar#80| |a|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#80|)
(PROGN (SETQ |x| (CAR |bfVar#80|)) NIL))
(RETURN |bfVar#81|))
('T
(PROGN
(SETQ |bfVar#81|
(AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(EQ (CDR |ISTMP#1|) NIL)))))
(COND (|bfVar#81| (RETURN |bfVar#81|))))))
(SETQ |bfVar#80| (CDR |bfVar#80|))))
(|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#84| NIL) (|bfVar#82| |f|) (|i| NIL)
(|bfVar#83| |r|) (|j| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#82|)
(PROGN (SETQ |i| (CAR |bfVar#82|)) NIL)
(ATOM |bfVar#83|)
(PROGN (SETQ |j| (CAR |bfVar#83|)) NIL))
(RETURN (NREVERSE |bfVar#84|)))
('T
(SETQ |bfVar#84| (CONS (APPEND |i| |j|) |bfVar#84|))))
(SETQ |bfVar#82| (CDR |bfVar#82|))
(SETQ |bfVar#83| (CDR |bfVar#83|)))))))))
(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#87| NIL)
(|bfVar#85| |vars|) (|v| NIL)
(|bfVar#86| |inits|) (|i| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#85|)
(PROGN
(SETQ |v| (CAR |bfVar#85|))
NIL)
(ATOM |bfVar#86|)
(PROGN
(SETQ |i| (CAR |bfVar#86|))
NIL))
(RETURN (NREVERSE |bfVar#87|)))
('T
(SETQ |bfVar#87|
(CONS (LIST |v| |i|) |bfVar#87|))))
(SETQ |bfVar#85| (CDR |bfVar#85|))
(SETQ |bfVar#86| (CDR |bfVar#86|))))
|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 |bfGetOldBootName| (|x|)
(PROG (|a|)
(RETURN
(COND ((SETQ |a| (GET |x| 'OLD-BOOT)) (CAR |a|)) ('T |x|)))))
(DEFUN |bfSameMeaning| (|x|) (GET |x| 'RENAME-OK))
(DEFUN |bfReName| (|x|)
(PROG (|oldName| |newName| |a|)
(DECLARE (SPECIAL |$stok| |$translatingOldBoot|))
(RETURN
(PROGN
(SETQ |newName|
(COND
((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|))
(#0='T |x|)))
(COND
((AND |$translatingOldBoot| (NOT (|bfSameMeaning| |x|)))
(PROGN
(SETQ |oldName| (|bfGetOldBootName| |x|))
(COND
((NOT (EQUAL |newName| |oldName|))
(|warn| (LIST (PNAME |x|) " as `" (PNAME |newName|)
"' differs from Old Boot `"
(PNAME |oldName|) "' at "
(|diagnosticLocation| |$stok|)))))
|oldName|))
(#0# |newName|))))))
(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#89| NIL) (|bfVar#88| |l|) (|c| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#88|)
(PROGN (SETQ |c| (CAR |bfVar#88|)) NIL))
(RETURN (NREVERSE |bfVar#89|)))
('T
(SETQ |bfVar#89|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
|bfVar#89|))))
(SETQ |bfVar#88| (CDR |bfVar#88|))))))))
(DEFUN |bfAND| (|l|)
(COND
((NULL |l|) 'T)
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'AND
(LET ((|bfVar#91| NIL) (|bfVar#90| |l|) (|c| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#90|)
(PROGN (SETQ |c| (CAR |bfVar#90|)) NIL))
(RETURN (NREVERSE |bfVar#91|)))
('T
(SETQ |bfVar#91|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
|bfVar#91|))))
(SETQ |bfVar#90| (CDR |bfVar#90|))))))))
(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#94| NIL) (|bfVar#92| |nargl|) (|i| NIL)
(|bfVar#93| |sgargl|) (|j| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#92|)
(PROGN (SETQ |i| (CAR |bfVar#92|)) NIL)
(ATOM |bfVar#93|)
(PROGN (SETQ |j| (CAR |bfVar#93|)) NIL))
(RETURN (NREVERSE |bfVar#94|)))
(#1='T
(SETQ |bfVar#94| (CONS (CONS |i| |j|) |bfVar#94|))))
(SETQ |bfVar#92| (CDR |bfVar#92|))
(SETQ |bfVar#93| (CDR |bfVar#93|)))))
(SETQ |body| (SUBLIS |sb| |body|))
(SETQ |sb2|
(LET ((|bfVar#97| NIL) (|bfVar#95| |sgargl|) (|i| NIL)
(|bfVar#96| |largl|) (|j| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#95|)
(PROGN (SETQ |i| (CAR |bfVar#95|)) NIL)
(ATOM |bfVar#96|)
(PROGN (SETQ |j| (CAR |bfVar#96|)) NIL))
(RETURN (NREVERSE |bfVar#97|)))
(#1#
(SETQ |bfVar#97|
(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
|bfVar#97|))))
(SETQ |bfVar#95| (CDR |bfVar#95|))
(SETQ |bfVar#96| (CDR |bfVar#96|)))))
(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#99| NIL) (|bfVar#98| |$wheredefs|)
(|d| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#98|)
(PROGN (SETQ |d| (CAR |bfVar#98|)) NIL))
(RETURN (NREVERSE |bfVar#99|)))
(#1#
(SETQ |bfVar#99|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
|bfVar#99|))))
(SETQ |bfVar#98| (CDR |bfVar#98|))))))))))
(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#100|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op| |defOp|)
(RETURN
(PROGN
(SETQ |defOp| (CAR |bfVar#100|))
(SETQ |op| (CADR . #0=(|bfVar#100|)))
(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#102| NIL)
(|bfVar#101|
(CONS (LIST |defOp| |op| |args| |body|)
|$wheredefs|))
(|d| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#101|)
(PROGN (SETQ |d| (CAR |bfVar#101|)) NIL))
(RETURN (NREVERSE |bfVar#102|)))
('T
(SETQ |bfVar#102|
(APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
|bfVar#102|))))
(SETQ |bfVar#101| (CDR |bfVar#101|))))))))))
(DEFUN |shoeComps| (|x|)
(LET ((|bfVar#104| NIL) (|bfVar#103| |x|) (|def| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#103|)
(PROGN (SETQ |def| (CAR |bfVar#103|)) NIL))
(RETURN (NREVERSE |bfVar#104|)))
('T (SETQ |bfVar#104| (CONS (|shoeComp| |def|) |bfVar#104|))))
(SETQ |bfVar#103| (CDR |bfVar#103|)))))
(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#106| |bfVar#105| |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#105| |y|)
(SETQ |bfVar#106| (CDR |bfVar#105|))
(CASE (CAR |bfVar#105|)
(|%DefaultValue|
(LET ((|p| (CAR |bfVar#106|))
(|v| (CADR |bfVar#106|)))
(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#108| NIL) (|bfVar#107| |body|) (|t| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#107|)
(PROGN (SETQ |t| (CAR |bfVar#107|)) NIL))
(RETURN |bfVar#108|))
('T
(PROGN
(SETQ |bfVar#108| (|needsPROG| |t|))
(COND (|bfVar#108| (RETURN |bfVar#108|))))))
(SETQ |bfVar#107| (CDR |bfVar#107|))))
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#109| (CADR |x|)) (|y| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#109|)
(PROGN (SETQ |y| (CAR |bfVar#109|)) NIL))
(RETURN NIL))
(#1='T
(COND
((NOT (MEMQ |y| |$locVars|))
(IDENTITY
(PROGN
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
(SETQ |bfVar#109| (CDR |bfVar#109|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
(LET ((|bfVar#111| NIL) (|bfVar#110| |$locVars|)
(|y| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#110|)
(PROGN
(SETQ |y| (CAR |bfVar#110|))
NIL))
(RETURN (NREVERSE |bfVar#111|)))
(#1#
(AND (NOT (MEMQ |y| |newbindings|))
(SETQ |bfVar#111|
(CONS |y| |bfVar#111|)))))
(SETQ |bfVar#110| (CDR |bfVar#110|)))))))
(#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#112| NIL) (|c| |l|))
(LOOP
(COND
((ATOM |c|) (RETURN (NREVERSE |bfVar#112|)))
('T
(SETQ |bfVar#112|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
|bfVar#112|))))
(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#114| NIL) (|bfVar#113| (CDR |f|))
(|i| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#113|)
(PROGN (SETQ |i| (CAR |bfVar#113|)) NIL))
(RETURN (NREVERSE |bfVar#114|)))
('T
(AND (NOT (ATOM |i|))
(SETQ |bfVar#114| (CONS |i| |bfVar#114|)))))
(SETQ |bfVar#113| (CDR |bfVar#113|)))))
(#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#116| NIL) (|bfVar#115| |l|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#115|)
(PROGN (SETQ |x| (CAR |bfVar#115|)) 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#116|)))
('T
(SETQ |bfVar#116|
(CONS (LIST |a| |b|) |bfVar#116|))))
(SETQ |bfVar#115| (CDR |bfVar#115|)))))
(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#118| NIL) (|bfVar#117| |defs|) (|d| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#117|)
(PROGN (SETQ |d| (CAR |bfVar#117|)) NIL))
(RETURN (NREVERSE |bfVar#118|)))
('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#118|
(CONS (LIST |def| |op| |args|
(|bfSUBLIS| |opassoc| |body|))
|bfVar#118|)))))
(SETQ |bfVar#117| (CDR |bfVar#117|)))))
(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#120| NIL) (|bfVar#119| |arglist|) (|i| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#119|)
(PROGN (SETQ |i| (CAR |bfVar#119|)) NIL))
(RETURN (NREVERSE |bfVar#120|)))
('T
(SETQ |bfVar#120|
(CONS (|bfCreateDef| |i|) |bfVar#120|))))
(SETQ |bfVar#119| (CDR |bfVar#119|))))))
(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#122| NIL) (|bfVar#121| (CDR |x|))
(|i| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#121|)
(PROGN (SETQ |i| (CAR |bfVar#121|)) NIL))
(RETURN (NREVERSE |bfVar#122|)))
('T
(SETQ |bfVar#122|
(CONS (|bfGenSymbol|) |bfVar#122|))))
(SETQ |bfVar#121| (CDR |bfVar#121|)))))
(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#125| NIL) (|bfVar#124| |x|) (|bfVar#123| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#124|)
(PROGN (SETQ |bfVar#123| (CAR |bfVar#124|)) NIL))
(RETURN (NREVERSE |bfVar#125|)))
('T
(AND (CONSP |bfVar#123|)
(PROGN
(SETQ |i| (CAR |bfVar#123|))
(SETQ |ISTMP#1| (CDR |bfVar#123|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
(SETQ |bfVar#125|
(CONS (|bfCI| |g| |i| |j|) |bfVar#125|)))))
(SETQ |bfVar#124| (CDR |bfVar#124|)))))))
(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#127| NIL) (|bfVar#126| |a|) (|i| NIL)
(|j| 0))
(LOOP
(COND
((OR (ATOM |bfVar#126|)
(PROGN (SETQ |i| (CAR |bfVar#126|)) NIL))
(RETURN (NREVERSE |bfVar#127|)))
('T
(AND (NOT (EQ |i| 'DOT))
(SETQ |bfVar#127|
(CONS
(LIST |i| (|bfCARCDR| |j| |g|))
|bfVar#127|)))))
(SETQ |bfVar#126| (CDR |bfVar#126|))
(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#129| |bfVar#128|)
(RETURN
(COND
((NULL |cs|) |e|)
(#0='T
(PROGN
(SETQ |bfVar#128| (CAR |cs|))
(SETQ |bfVar#129| (CDR |bfVar#128|))
(CASE (CAR |bfVar#128|)
(|%Catch|
(LET ((|tag| (CAR |bfVar#129|)))
(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#131| NIL) (|bfVar#130| |form|) (|t| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#130|)
(PROGN (SETQ |t| (CAR |bfVar#130|)) NIL))
(RETURN (NREVERSE |bfVar#131|)))
('T
(SETQ |bfVar#131|
(CONS (|backquote| |t| |params|) |bfVar#131|))))
(SETQ |bfVar#130| (CDR |bfVar#130|))))))))
(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#133| NIL) (|bfVar#132| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#132|)
(PROGN (SETQ |x| (CAR |bfVar#132|)) NIL))
(RETURN (NREVERSE |bfVar#133|)))
(#0='T
(SETQ |bfVar#133|
(CONS (|nativeArgumentType| |x|)
|bfVar#133|))))
(SETQ |bfVar#132| (CDR |bfVar#132|)))))
(SETQ |rettype| (|nativeReturnType| |t|))
(COND
((LET ((|bfVar#135| T) (|bfVar#134| (CONS |t| |s|))
(|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#134|)
(PROGN (SETQ |x| (CAR |bfVar#134|)) NIL))
(RETURN |bfVar#135|))
(#0#
(PROGN
(SETQ |bfVar#135| (|isSimpleNativeType| |x|))
(COND ((NOT |bfVar#135|) (RETURN NIL))))))
(SETQ |bfVar#134| (CDR |bfVar#134|))))
(LIST (LIST 'DEFENTRY |op| |argtypes|
(LIST |rettype| (SYMBOL-NAME |op'|)))))
(#1='T
(PROGN
(SETQ |cop| (CONCAT (SYMBOL-NAME |op'|) "_stub"))
(SETQ |cargs|
(LET ((|bfVar#142| NIL)
(|bfVar#141| (- (LENGTH |s|) 1)) (|i| 0))
(LOOP
(COND
((> |i| |bfVar#141|)
(RETURN (NREVERSE |bfVar#142|)))
(#0#
(SETQ |bfVar#142|
(CONS (|genGCLnativeTranslation,mkCArgName|
|i|)
|bfVar#142|))))
(SETQ |i| (+ |i| 1)))))
(SETQ |ccode|
(LET ((|bfVar#138| "")
(|bfVar#140|
(CONS (|genGCLnativeTranslation,gclTypeInC|
|t|)
(CONS " "
(CONS |cop|
(CONS "("
(APPEND
(LET
((|bfVar#136| NIL) (|x| |s|)
(|a| |cargs|))
(LOOP
(COND
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
(NREVERSE |bfVar#136|)))
(#0#
(SETQ |bfVar#136|
(CONS
(|genGCLnativeTranslation,cparm|
|x| |a|)
|bfVar#136|))))
(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#137| NIL)
(|x| |s|) (|a| |cargs|))
(LOOP
(COND
((OR (ATOM |x|)
(ATOM |a|))
(RETURN
(NREVERSE
|bfVar#137|)))
(#0#
(SETQ |bfVar#137|
(CONS
(|genGCLnativeTranslation,gclArgsInC|
|x| |a|)
|bfVar#137|))))
(SETQ |x| (CDR |x|))
(SETQ |a| (CDR |a|))))
(CONS "); }" NIL))))))))))))
(|bfVar#139| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#140|)
(PROGN
(SETQ |bfVar#139| (CAR |bfVar#140|))
NIL))
(RETURN |bfVar#138|))
(#0#
(SETQ |bfVar#138|
(CONCAT |bfVar#138| |bfVar#139|))))
(SETQ |bfVar#140| (CDR |bfVar#140|)))))
(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#143| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#143|)
(PROGN (SETQ |x| (CAR |bfVar#143|)) NIL))
(RETURN NIL))
('T
(PROGN
(SETQ |argtypes|
(CONS (|nativeArgumentType| |x|) |argtypes|))
(SETQ |args| (CONS (GENSYM) |args|)))))
(SETQ |bfVar#143| (CDR |bfVar#143|))))
(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#147| "")
(|bfVar#149|
(CONS (SYMBOL-NAME |op|)
(CONS "("
(APPEND (LET ((|bfVar#146| NIL)
(|bfVar#144| (- |n| 1)) (|i| 0)
(|bfVar#145| |s|) (|x| NIL))
(LOOP
(COND
((OR (> |i| |bfVar#144|)
(ATOM |bfVar#145|)
(PROGN
(SETQ |x| (CAR |bfVar#145|))
NIL))
(RETURN (NREVERSE |bfVar#146|)))
(#0='T
(SETQ |bfVar#146|
(CONS
(|genECLnativeTranslation,sharpArg|
|i| |x|)
|bfVar#146|))))
(SETQ |i| (+ |i| 1))
(SETQ |bfVar#145|
(CDR |bfVar#145|))))
(CONS ")" NIL)))))
(|bfVar#148| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#149|)
(PROGN (SETQ |bfVar#148| (CAR |bfVar#149|)) NIL))
(RETURN |bfVar#147|))
(#0# (SETQ |bfVar#147| (CONCAT |bfVar#147| |bfVar#148|))))
(SETQ |bfVar#149| (CDR |bfVar#149|)))))
(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#151| NIL) (|bfVar#150| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#150|)
(PROGN (SETQ |x| (CAR |bfVar#150|)) NIL))
(RETURN (NREVERSE |bfVar#151|)))
(#0='T
(SETQ |bfVar#151|
(CONS (|nativeArgumentType| |x|)
|bfVar#151|))))
(SETQ |bfVar#150| (CDR |bfVar#150|)))))
(SETQ |n| (INTERN (CONCAT (SYMBOL-NAME |op|) "%clisp-hack")))
(SETQ |parms|
(LET ((|bfVar#153| NIL) (|bfVar#152| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#152|)
(PROGN (SETQ |x| (CAR |bfVar#152|)) NIL))
(RETURN (NREVERSE |bfVar#153|)))
(#0#
(SETQ |bfVar#153|
(CONS (GENSYM "parm") |bfVar#153|))))
(SETQ |bfVar#152| (CDR |bfVar#152|)))))
(SETQ |unstableArgs| NIL)
(LET ((|bfVar#154| |parms|) (|p| NIL) (|bfVar#155| |s|)
(|x| NIL) (|bfVar#156| |argtypes|) (|y| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#154|)
(PROGN (SETQ |p| (CAR |bfVar#154|)) NIL)
(ATOM |bfVar#155|)
(PROGN (SETQ |x| (CAR |bfVar#155|)) NIL)
(ATOM |bfVar#156|)
(PROGN (SETQ |y| (CAR |bfVar#156|)) NIL))
(RETURN NIL))
(#0#
(COND
((|needsStableReference?| |x|)
(IDENTITY
(SETQ |unstableArgs|
(CONS (CONS |p| (CONS |x| |y|))
|unstableArgs|)))))))
(SETQ |bfVar#154| (CDR |bfVar#154|))
(SETQ |bfVar#155| (CDR |bfVar#155|))
(SETQ |bfVar#156| (CDR |bfVar#156|))))
(SETQ |foreignDecl|
(LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT) |n|
(LIST :NAME (SYMBOL-NAME |op'|))
(CONS :ARGUMENTS
(LET ((|bfVar#159| NIL)
(|bfVar#157| |argtypes|) (|x| NIL)
(|bfVar#158| |parms|) (|a| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#157|)
(PROGN
(SETQ |x| (CAR |bfVar#157|))
NIL)
(ATOM |bfVar#158|)
(PROGN
(SETQ |a| (CAR |bfVar#158|))
NIL))
(RETURN (NREVERSE |bfVar#159|)))
(#0#
(SETQ |bfVar#159|
(CONS (LIST |a| |x|)
|bfVar#159|))))
(SETQ |bfVar#157| (CDR |bfVar#157|))
(SETQ |bfVar#158| (CDR |bfVar#158|)))))
(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#162| NIL)
(|bfVar#161| |unstableArgs|)
(|bfVar#160| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#161|)
(PROGN
(SETQ |bfVar#160|
(CAR |bfVar#161|))
NIL))
(RETURN (NREVERSE |bfVar#162|)))
(#0#
(AND (CONSP |bfVar#160|)
(PROGN
(SETQ |a| (CAR |bfVar#160|))
(SETQ |ISTMP#1|
(CDR |bfVar#160|))
(AND (CONSP |ISTMP#1|)
(PROGN
(SETQ |x| (CAR |ISTMP#1|))
(SETQ |y| (CDR |ISTMP#1|))
#2='T)))
(SETQ |bfVar#162|
(CONS
(CONS |a|
(CONS |x|
(CONS |y| (GENSYM "loc"))))
|bfVar#162|)))))
(SETQ |bfVar#161| (CDR |bfVar#161|)))))
(SETQ |call|
(CONS |n|
(LET ((|bfVar#164| NIL)
(|bfVar#163| |parms|) (|p| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#163|)
(PROGN
(SETQ |p| (CAR |bfVar#163|))
NIL))
(RETURN (NREVERSE |bfVar#164|)))
(#0#
(SETQ |bfVar#164|
(CONS
(|genCLISPnativeTranslation,actualArg|
|p| |localPairs|)
|bfVar#164|))))
(SETQ |bfVar#163| (CDR |bfVar#163|))))))
(SETQ |call|
(PROGN
(SETQ |fixups|
(LET ((|bfVar#166| NIL)
(|bfVar#165| |localPairs|)
(|p| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#165|)
(PROGN
(SETQ |p| (CAR |bfVar#165|))
NIL))
(RETURN
(NREVERSE |bfVar#166|)))
(#0#
(AND
(NOT
(NULL
(SETQ |q|
(|genCLISPnativeTranslation,copyBack|
|p|))))
(SETQ |bfVar#166|
(CONS |q| |bfVar#166|)))))
(SETQ |bfVar#165|
(CDR |bfVar#165|)))))
(COND
((NULL |fixups|) (LIST |call|))
(#1#
(LIST (CONS 'PROG1
(CONS |call| |fixups|)))))))
(LET ((|bfVar#168| |localPairs|) (|bfVar#167| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#168|)
(PROGN
(SETQ |bfVar#167| (CAR |bfVar#168|))
NIL))
(RETURN NIL))
(#0#
(AND (CONSP |bfVar#167|)
(PROGN
(SETQ |p| (CAR |bfVar#167|))
(SETQ |ISTMP#1| (CDR |bfVar#167|))
(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#168| (CDR |bfVar#168|))))
(CONS 'DEFUN (CONS |op| (CONS |parms| |call|)))))))
(SETQ |$foreignsDefsForCLisp|
(CONS |foreignDecl| |$foreignsDefsForCLisp|))
(LIST |forwardingFun|)))))
(DEFUN |genCLISPnativeTranslation,copyBack| (|bfVar#169|)
(PROG (|a| |y| |x| |p|)
(RETURN
(PROGN
(SETQ |p| (CAR |bfVar#169|))
(SETQ |x| (CADR . #0=(|bfVar#169|)))
(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#171| NIL) (|bfVar#170| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#170|)
(PROGN (SETQ |x| (CAR |bfVar#170|)) NIL))
(RETURN (NREVERSE |bfVar#171|)))
(#0='T
(SETQ |bfVar#171|
(CONS (|nativeArgumentType| |x|)
|bfVar#171|))))
(SETQ |bfVar#170| (CDR |bfVar#170|)))))
(SETQ |args|
(LET ((|bfVar#173| NIL) (|bfVar#172| |s|) (|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#172|)
(PROGN (SETQ |x| (CAR |bfVar#172|)) NIL))
(RETURN (NREVERSE |bfVar#173|)))
(#0#
(SETQ |bfVar#173| (CONS (GENSYM) |bfVar#173|))))
(SETQ |bfVar#172| (CDR |bfVar#172|)))))
(SETQ |unstableArgs| NIL)
(SETQ |newArgs| NIL)
(LET ((|bfVar#174| |args|) (|a| NIL) (|bfVar#175| |s|)
(|x| NIL))
(LOOP
(COND
((OR (ATOM |bfVar#174|)
(PROGN (SETQ |a| (CAR |bfVar#174|)) NIL)
(ATOM |bfVar#175|)
(PROGN (SETQ |x| (CAR |bfVar#175|)) NIL))
(RETURN NIL))
(#0#
(PROGN
(SETQ |newArgs|
(CONS (|coerceToNativeType| |a| |x|) |newArgs|))
(COND
((|needsStableReference?| |x|)
(SETQ |unstableArgs| (CONS |a| |unstableArgs|)))))))
(SETQ |bfVar#174| (CDR |bfVar#174|))
(SETQ |bfVar#175| (CDR |bfVar#175|))))
(COND
((NULL |unstableArgs|)
(LIST (LIST 'DEFUN |op| |args|
(CONS (INTERN "ALIEN-FUNCALL" "SB-ALIEN")
(CONS (LIST
(INTERN "EXTERN-ALIEN" "SB-ALIEN")
(SYMBOL-NAME |op'|)
(CONS 'FUNCTION
(CONS |rettype| |argtypes|)))
|args|)))))
('T
(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")
(SYMBOL-NAME |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")))))))))