aboutsummaryrefslogtreecommitdiff
path: root/src/boot/ast.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
committerdos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
commitab8cc85adde879fb963c94d15675783f2cf4b183 (patch)
treec202482327f474583b750b2c45dedfc4e4312b1d /src/boot/ast.boot.pamphlet
downloadopen-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz
Initial population.
Diffstat (limited to 'src/boot/ast.boot.pamphlet')
-rw-r--r--src/boot/ast.boot.pamphlet3090
1 files changed, 3090 insertions, 0 deletions
diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet
new file mode 100644
index 00000000..bd38fa39
--- /dev/null
+++ b/src/boot/ast.boot.pamphlet
@@ -0,0 +1,3090 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/boot/ast.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+
+\tableofcontents
+\eject
+
+Note that shoeReadLispString has a duplicate definition in this file.
+I don't know why. I've commented out the first definition since it
+gets overwritten.
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+-- - Redistributions of source code must retain the above copyright
+-- notice, this list of conditions and the following disclaimer.
+--
+-- - Redistributions in binary form must reproduce the above copyright
+-- notice, this list of conditions and the following disclaimer in
+-- the documentation and/or other materials provided with the
+-- distribution.
+--
+-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- names of its contributors may be used to endorse or promote products
+-- derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+@
+
+\section{Abstract syntax tree}
+
+<<abstract syntax tree>>=
+++ A Boot string is no different from a Lisp string. Same holds
+++ for symbols and sequences. In an ideal world, these would be
+++ built-in/library data types.
+String <=> STRING
+Symbol <=> SYMBOL
+Sequence <=> SEQUENCE
+
+++ Ideally, we would like to say that a List T if either nil or a
+++ cons of a T and List of T. However, we don't support parameterized
+++ alias definitions yet.
+List <=> nil or cons
+
+++ Currently, the Boot processor uses Lisp symbol datatype for names.
+++ That causes the BOOTTRAN package to contain more symbols than we would
+++ like. In the future, we want want to intern `on demand'. How that
+++ interacts with renaming is to be worked out.
+structure Name == Name(Symbol)
+
+structure Ast ==
+ Command(String) -- includer command
+ Module(String) -- module declaration
+ Import(String) -- import declaration
+ TypeAlias(Name, List, List) -- type alias definition
+ SuffixDot(Ast) -- x .
+ Quote(Ast) -- 'x
+ EqualName(Name) -- =x -- patterns
+ Colon(Name) -- :x
+ QualifiedName(Name, Name) -- m::x
+ Bracket(Ast) -- [x, y]
+ UnboundedSegment(Ast) -- 3..
+ BoundedSgement(Ast, Ast) -- 2..4
+ Tuple(List) -- comma-separated expression sequence
+ ColonAppend(Ast, Ast) -- [:y] or [x, :y]
+ Is(Ast, Ast) -- e is p -- patterns
+ Isnt(Ast, Ast) -- e isnt p -- patterns
+ Reduce(Ast, Ast) -- +/[...]
+ PrefixExpr(Name, Ast) -- #v
+ Call(Ast, Sequence) -- f(x, y , z)
+ InfixExpr(Name, Ast, Ast) -- x + y
+ Definition(Name, List, Ast, Ast) -- x == y or f x == y
+ Macro(Name, List, Ast) -- m x ==> y
+ SuchThat(Ast) -- | p
+ Assignment(Ast, Ast) -- x := y
+ While(Ast) -- while p -- iterator
+ Until(Ast) -- until p -- iterator
+ For(Ast, Ast, Ast) -- for x in e by k -- iterator
+ Exit(Ast, Ast) -- p => x
+ Iterators(List) -- list of iterators
+ Cross(List) -- iterator cross product
+ Repeat(Sequence, Ast) -- while p repeat s
+ Pile(Sequence) -- pile of expression sequence
+ Append(Sequence) -- concatenate lists
+ Case(Ast, Sequence) -- case x of ...
+ Return(Ast) -- return x
+ Where(Ast, Sequence) -- e where f x == y
+ Structure(Ast, Sequence) -- structure Foo == ...
+@
+
+
+\section{Putting it all together}
+<<*>>=
+<<license>>
+
+module '"boot-ast"
+import '"includer"
+
+)package "BOOTTRAN"
+<<abstract syntax tree>>
+
+-- TRUE if we are currently building the syntax tree for an 'is'
+-- expression.
+$inDefIS := false
+
+bfGenSymbol()==
+ $GenVarCounter:=$GenVarCounter+1
+ INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter))
+
+bfListOf x==x
+
+bfColon x== ["COLON",x]
+
+bfColonColon(package, name) ==
+ INTERN(SYMBOL_-NAME name, package)
+
+bfSymbol x==
+ STRINGP x=> x
+ ['QUOTE,x]
+
+bfDot()== "DOT"
+
+bfSuffixDot x==[x,"DOT"]
+
+bfEqual(name)== ["EQUAL",name]
+
+bfBracket(part) == part
+
+bfPile(part) == part
+
+bfAppend x== APPLY(function APPEND,x)
+
+bfColonAppend (x,y) ==
+ if null x
+ then
+ if y is ["BVQUOTE",:a]
+ then ["&REST",["QUOTE",:a]]
+ else ["&REST",y]
+ else cons(CAR x,bfColonAppend(CDR x,y))
+
+bfDefinition(bflhsitems, bfrhs,body) ==
+ ['DEF,bflhsitems,bfrhs,body]
+
+bfMDefinition(bflhsitems, bfrhs,body) ==
+ bfMDef('MDEF,bflhsitems,bfrhs,body)
+
+bfCompDef [def,op,args,body]== bfDef(def,op,args,body)
+
+bfBeginsDollar x== EQL('"$".0,(PNAME x).0)
+
+compFluid id== ["FLUID",id]
+
+compFluidize x==
+ IDENTP x and bfBeginsDollar x=>compFluid x
+ ATOM x =>x
+ EQCAR(x,"QUOTE")=>x
+ cons(compFluidize(CAR x),compFluidize(CDR x))
+
+bfTuple x== ["TUPLE",:x]
+
+bfTupleP x==EQCAR(x,"TUPLE")
+
+bfTupleIf x==
+ if bfTupleP x
+ then x
+ else bfTuple x
+
+bfTupleConstruct b ==
+ a:= if bfTupleP b
+ then cdr b
+ else [b]
+ or/[x is ["COLON",.] for x in a] => bfMakeCons a
+ ["LIST",:a]
+
+bfConstruct b ==
+ a:= if bfTupleP b
+ then cdr b
+ else [b]
+ bfMakeCons a
+
+bfMakeCons l ==
+ null l => NIL
+ l is [["COLON",a],:l1] =>
+ l1 => ['APPEND,a,bfMakeCons l1]
+ a
+ ['CONS,first l,bfMakeCons rest l]
+
+bfFor(bflhs,U,step) ==
+ if EQCAR (U,'tails)
+ then bfForTree('ON, bflhs, CADR U)
+ else
+ if EQCAR(U,"SEGMENT")
+ then bfSTEP(bflhs,CADR U,step,CADDR U)
+ else bfForTree('IN, bflhs, U)
+
+bfForTree(OP,lhs,whole)==
+ whole:=if bfTupleP whole then bfMakeCons cdr whole else whole
+ ATOM lhs =>bfINON [OP,lhs,whole]
+ lhs:=if bfTupleP lhs then CADR lhs else lhs
+ EQCAR(lhs,"L%T") =>
+ G:=CADR lhs
+ [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,CADDR lhs)]
+ G:=bfGenSymbol()
+ [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)]
+
+
+bfSTEP(id,fst,step,lst)==
+ initvar:=[id]
+ initval:=[fst]
+ inc:=if ATOM step
+ then step
+ else
+ g1:=bfGenSymbol()
+ initvar:=cons(g1,initvar)
+ initval:=cons(step,initval)
+ g1
+ final:=if ATOM lst
+ then lst
+ else
+ g2:=bfGenSymbol()
+ initvar:=cons(g2,initvar)
+ initval:=cons(lst,initval)
+ g2
+ ex:=
+ null lst=> []
+ INTEGERP inc =>
+ pred:=if MINUSP inc then "<" else ">"
+ [[pred,id,final]]
+ [['COND,[['MINUSP,inc],
+ ["<",id,final]],['T,[">",id,final]]]]
+ suc:=[['SETQ,id,["+",id,inc]]]
+ [[initvar,initval,suc,[],ex,[]]]
+
+
+bfINON x==
+ [op,id,whole]:=x
+ if EQ(op,"ON")
+ then bfON(id,whole)
+ else bfIN(id,whole)
+
+bfIN(x,E)==
+ g:=bfGenSymbol()
+ [[[g,x],[E,nil],[['SETQ,g,['CDR, g]]],[],
+ [['OR,['ATOM,g],['PROGN,['SETQ,x,['CAR,g]] ,'NIL]]],[]]]
+
+bfON(x,E)==
+ [[[x],[E],[['SETQ,x,['CDR, x]]],[],
+ [['ATOM,x]],[]]]
+
+bfSuchthat p== [[[],[],[],[p],[],[]]]
+
+bfWhile p== [[[],[],[],[],[bfNOT p],[]]]
+
+bfUntil p==
+ g:=bfGenSymbol()
+ [[[g],[nil],[['SETQ,g,p]],[],[g],[]]]
+
+bfIterators x==["ITERATORS",:x]
+
+bfCross x== ["CROSS",:x]
+
+bfLp(iters,body)==
+ EQCAR (iters,"ITERATORS")=>bfLp1(CDR iters,body)
+ bfLpCross(CDR iters,body)
+
+bfLpCross(iters,body)==
+ if null cdr iters
+ then bfLp(car iters,body)
+ else bfLp(car iters,bfLpCross(cdr iters,body))
+
+bfSep(iters)==
+ if null iters
+ then [[],[],[],[],[],[]]
+ else
+ f:=first iters
+ r:=bfSep rest iters
+ [append(i,j) for i in f for j in r]
+
+bfReduce(op,y)==
+ a:=if EQCAR(op,"QUOTE") then CADR op else op
+ op:=bfReName a
+ init:=GET(op,"SHOETHETA")
+ g:=bfGenSymbol()
+ g1:=bfGenSymbol()
+ body:=['SETQ,g,[op,g1,g]]
+ if null init
+ then
+ g2:=bfGenSymbol()
+ init:=['CAR,g2]
+ ny:=['CDR,g2]
+ it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,ny)]]
+ bfMKPROGN [['L%T,g2,y],bfLp(it,body)]
+ else
+ init:=car init
+ it:= ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,y)]]
+ bfLp(it,body)
+
+bfReduceCollect(op,y)==
+ if EQCAR (y,"COLLECT")
+ then
+ body:=y.1
+ itl:=y.2
+ a:=if EQCAR(op,"QUOTE") then CADR op else op
+ op:=bfReName a
+ init:=GET(op,"SHOETHETA")
+ bfOpReduce(op,init,body,itl)
+ else
+ a:=bfTupleConstruct (y.1)
+ bfReduce(op,a)
+
+-- delayed collect
+
+bfDCollect(y,itl)== ["COLLECT",y,itl]
+
+bfDTuple x== ["DTUPLE",x]
+
+bfCollect(y,itl) ==
+ y is ["COLON",a] => bf0APPEND(a,itl)
+ y is ["TUPLE",:.] =>
+ newBody:=bfConstruct y
+ bf0APPEND(newBody,itl)
+ bf0COLLECT(y,itl)
+
+bf0COLLECT(y,itl)==bfListReduce('CONS,y,itl)
+
+
+bf0APPEND(y,itl)==
+ g:=bfGenSymbol()
+ body:=['SETQ,g,['APPEND,['REVERSE,y],g]]
+ extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+ bfLp2(extrait,itl,body)
+
+bfListReduce(op,y,itl)==
+ g:=bfGenSymbol()
+ body:=['SETQ,g,[op,y,g]]
+ extrait:= [[[g],[nil],[],[],[],[['NREVERSE,g]]]]
+ bfLp2(extrait,itl,body)
+
+bfLp1(iters,body)==
+ [vars,inits,sucs,filters,exits,value]:=bfSep bfAppend iters
+ nbody:=if null filters then body else bfAND [:filters,body]
+ value:=if null value then "NIL" else car value
+ exits:= ["COND",[bfOR exits,["RETURN",value]],
+ ['(QUOTE T),nbody]]
+ loop:=
+ [["LAMBDA",vars,
+ ["LOOP",exits,:sucs]],:inits]
+ loop
+
+bfLp2(extrait,itl,body)==
+ EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,CDR itl),body)
+ iters:=cdr itl
+ bfLpCross
+ ([["ITERATORS",extrait,:CDAR iters],:CDR iters],body)
+
+bfOpReduce(op,init,y,itl)==
+ g:=bfGenSymbol()
+ body:=
+ EQ(op,"AND")=>
+ bfMKPROGN [["SETQ",g,y],
+ ['COND, [['NOT,g],['RETURN,'NIL]]]]
+ EQ(op,"OR") =>
+ bfMKPROGN [["SETQ",g,y],
+ ['COND, [g,['RETURN,g]]]]
+ ['SETQ,g,[op,g,y]]
+ if null init
+ then
+ g1:=bfGenSymbol()
+ init:=['CAR,g1]
+ y:=['CDR,g1]
+ extrait:= [[[g],[init],[],[],[],[g]]]
+ bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)]
+ else
+ init:=car init
+ extrait:= [[[g],[init],[],[],[],[g]]]
+ bfLp2(extrait,itl,body)
+
+bfLoop1 body == bfLp (bfIterators nil,body)
+
+bfSegment1(lo)== ["SEGMENT",lo,nil]
+
+bfSegment2(lo,hi)== ["SEGMENT",lo,hi]
+
+bfForInBy(variable,collection,step)==
+ bfFor(variable,collection,step)
+
+bfForin(lhs,U)==bfFor(lhs,U,1)
+
+bfLocal(a,b)==
+ EQ(b,"FLUID")=> compFluid a
+ EQ(b,"fluid")=> compFluid a
+ EQ(b,"local") => compFluid a
+ -- $typings:=cons(["TYPE",b,a],$typings)
+ a
+
+bfTake(n,x)==
+ null x=>x
+ n=0 => nil
+ cons(car x,bfTake(n-1,cdr x))
+
+bfDrop(n,x)==
+ null x or n=0 =>x
+ bfDrop(n-1,cdr x)
+
+bfDefSequence l == ['SEQ,: l]
+
+bfReturnNoName a ==
+ ["RETURN",a]
+
+bfSUBLIS(p,e)==
+ ATOM e=>bfSUBLIS1(p,e)
+ EQCAR(e,"QUOTE")=>e
+ cons(bfSUBLIS(p,car e),bfSUBLIS(p,cdr e))
+
+bfSUBLIS1(p,e)==
+ null p =>e
+ f:=CAR p
+ EQ(CAR f,e)=>CDR f
+ bfSUBLIS1(cdr p,e)
+
+defSheepAndGoats(x)==
+ EQCAR (x,"DEF") =>
+ [def,op,args,body]:=x
+ argl:=if bfTupleP args
+ then cdr args
+ else [args]
+ if null argl
+ then
+ opassoc:=[[op,:body]]
+ [opassoc,[],[]]
+ else
+ op1:=INTERN CONCAT(PNAME $op,'",",PNAME op)
+ opassoc:=[[op,:op1]]
+ defstack:=[["DEF",op1,args,body]]
+ [opassoc,defstack,[]]
+ EQCAR (x,"SEQ") => defSheepAndGoatsList(cdr x)
+ [[],[],[x]]
+
+defSheepAndGoatsList(x)==
+ if null x
+ then [[],[],[]]
+ else
+ [opassoc,defs,nondefs] := defSheepAndGoats car x
+ [opassoc1,defs1,nondefs1] := defSheepAndGoatsList cdr x
+ [append(opassoc,opassoc1),append(defs,defs1),
+ append(nondefs,nondefs1)]
+--% LET
+
+bfLetForm(lhs,rhs) == ['L%T,lhs,rhs]
+
+bfLET1(lhs,rhs) ==
+ IDENTP lhs => bfLetForm(lhs,rhs)
+ lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
+ IDENTP rhs and not bfCONTAINED(rhs,lhs) =>
+ rhs1 := bfLET2(lhs,rhs)
+ EQCAR(rhs1,'L%T) => bfMKPROGN [rhs1,rhs]
+ EQCAR(rhs1,'PROGN) => APPEND(rhs1,[rhs])
+ if IDENTP CAR rhs1 then rhs1 := CONS(rhs1,NIL)
+ bfMKPROGN [:rhs1,rhs]
+ CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := CADR rhs) =>
+ -- handle things like [a] := x := foo
+ l1 := bfLET1(name,CADDR rhs)
+ l2 := bfLET1(lhs,name)
+ EQCAR(l2,'PROGN) => bfMKPROGN [l1,:CDR l2]
+ if IDENTP CAR l2 then l2 := cons(l2,nil)
+ bfMKPROGN [l1,:l2,name]
+ g := INTERN CONCAT('"LETTMP#",STRINGIMAGE $letGenVarCounter)
+ $letGenVarCounter := $letGenVarCounter + 1
+ rhs1 := ['L%T,g,rhs]
+ let1 := bfLET1(lhs,g)
+ EQCAR(let1,'PROGN) => bfMKPROGN [rhs1,:CDR let1]
+ if IDENTP CAR let1 then let1 := CONS(let1,NIL)
+ bfMKPROGN [rhs1,:let1,g]
+
+bfCONTAINED(x,y)==
+ EQ(x,y) => true
+ ATOM y=> false
+ bfCONTAINED(x,car y) or bfCONTAINED(x,cdr y)
+
+bfLET2(lhs,rhs) ==
+ IDENTP lhs => bfLetForm(lhs,rhs)
+ NULL lhs => NIL
+ lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
+ lhs is ['L%T,a,b] =>
+ a := bfLET2(a,rhs)
+ null (b := bfLET2(b,rhs)) => a
+ ATOM b => [a,b]
+ CONSP CAR b => CONS(a,b)
+ [a,b]
+ lhs is ['CONS,var1,var2] =>
+ var1 = "DOT" or (CONSP(var1) and EQCAR(var1,'QUOTE)) =>
+ bfLET2(var2,addCARorCDR('CDR,rhs))
+ l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
+ null var2 or EQ(var2,"DOT") =>l1
+ if CONSP l1 and ATOM CAR l1 then l1 := cons(l1,nil)
+ IDENTP var2 =>
+ [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
+ l2 := bfLET2(var2,addCARorCDR('CDR,rhs))
+ if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+ APPEND(l1,l2)
+ lhs is ['APPEND,var1,var2] =>
+ patrev := bfISReverse(var2,var1)
+ rev := ['REVERSE,rhs]
+ g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter)
+ $letGenVarCounter := $letGenVarCounter + 1
+ l2 := bfLET2(patrev,g)
+ if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+ var1 = "DOT" => [['L%T,g,rev],:l2]
+ last l2 is ['L%T, =var1, val1] =>
+ [['L%T,g,rev],:REVERSE CDR REVERSE l2,
+ bfLetForm(var1,['NREVERSE,val1])]
+ [['L%T,g,rev],:l2,bfLetForm(var1,['NREVERSE,var1])]
+ lhs is ["EQUAL",var1] =>
+ ['COND,[["EQUAL",var1,rhs],var1]]
+ -- The original expression may be one that involves literals as
+ -- sub-patterns, e.g.
+ -- ['SEQ, :l, ['exit, 1, x]] := item
+ -- We continue the processing as if that expression had been written
+ -- item is ['SEQ, :l, ['exit, 1, x]]
+ -- and generate appropriate codes.
+ -- -- gdr/2007-04-02.
+ isPred :=
+ $inDefIS => bfIS1(rhs,lhs)
+ bfIS(rhs,lhs)
+ ['COND,[isPred,rhs]]
+
+
+bfLET(lhs,rhs) ==
+ $letGenVarCounter : local := 1
+-- $inbfLet : local := true
+ bfLET1(lhs,rhs)
+
+addCARorCDR(acc,expr) ==
+ NULL CONSP expr => [acc,expr]
+ acc = 'CAR and EQCAR(expr,'REVERSE) =>
+ ["CAR",["LAST",:CDR expr]]
+ -- cons('last,CDR expr)
+ funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
+ CDAAR CDDAR CDADR CDDDR)
+ p := bfPosition(CAR expr,funs)
+ p = -1 => [acc,expr]
+ funsA := '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR CAAADR
+ CAADDR CADAAR CADDAR CADADR CADDDR)
+ funsR := '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR CDAADR
+ CDADDR CDDAAR CDDDAR CDDADR CDDDDR)
+ if acc = 'CAR then CONS(funsA.p,CDR expr)
+ else CONS(funsR.p,CDR expr)
+
+bfPosition(x,l) == bfPosn(x,l,0)
+bfPosn(x,l,n) ==
+ null l => -1
+ x=first l => n
+ bfPosn(x,rest l,n+1)
+
+--% IS
+
+bfISApplication(op,left,right)==
+ EQ(op ,"IS") => bfIS(left,right)
+ EQ(op ,"ISNT") => bfNOT bfIS(left,right)
+ [op ,left,right]
+
+bfIS(left,right)==
+ $isGenVarCounter:local :=1
+ $inDefIS :local :=true
+ bfIS1(left,right)
+
+bfISReverse(x,a) ==
+ x is ['CONS,:.] =>
+ NULL CADDR x => ['CONS,CADR x, a]
+ y := bfISReverse(CADDR x, NIL)
+ RPLACA(CDDR y,['CONS,CADR x,a])
+ y
+ bpSpecificErrorHere '"Error in bfISReverse"
+ bpTrap()
+
+bfIS1(lhs,rhs) ==
+ NULL rhs =>
+ ['NULL,lhs]
+ STRINGP rhs =>
+ ['EQ,lhs,['QUOTE,INTERN rhs]]
+ NUMBERP rhs =>
+ ["EQUAL",lhs,rhs]
+ ATOM rhs =>
+ ['PROGN,bfLetForm(rhs,lhs),''T]
+ rhs is ['QUOTE,a] =>
+ IDENTP a => ['EQ,lhs,rhs]
+ ["EQUAL",lhs,rhs]
+ rhs is ['L%T,c,d] =>
+ l :=
+ bfLET(c,lhs)
+-- $inbfLet => bfLET1(c,lhs)
+-- bfLET(c,lhs)
+ bfAND [bfIS1(lhs,d),bfMKPROGN [l,''T]]
+ rhs is ["EQUAL",a] =>
+ ["EQUAL",lhs,a]
+ CONSP lhs =>
+ g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+ $isGenVarCounter := $isGenVarCounter + 1
+ bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)]
+ rhs is ['CONS,a,b] =>
+ a = "DOT" =>
+ NULL b =>
+ bfAND [['CONSP,lhs],
+ ['EQ,['CDR,lhs],'NIL]]
+ bfAND [['CONSP,lhs],
+ bfIS1(['CDR,lhs],b)]
+ NULL b =>
+ bfAND [['CONSP,lhs],
+ ['EQ,['CDR,lhs],'NIL],_
+ bfIS1(['CAR,lhs],a)]
+ b = "DOT" =>
+ bfAND [['CONSP,lhs],bfIS1(['CAR,lhs],a)]
+ a1 := bfIS1(['CAR,lhs],a)
+ b1 := bfIS1(['CDR,lhs],b)
+ a1 is ['PROGN,c,''T] and b1 is ['PROGN,:cls] =>
+ bfAND [['CONSP,lhs],bfMKPROGN [c,:cls]]
+ bfAND [['CONSP,lhs],a1,b1]
+ rhs is ['APPEND,a,b] =>
+ patrev := bfISReverse(b,a)
+ g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter)
+ $isGenVarCounter := $isGenVarCounter + 1
+ rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],''T]]
+ l2 := bfIS1(g,patrev)
+ if CONSP l2 and ATOM CAR l2 then l2 := cons(l2,nil)
+ a = "DOT" => bfAND [rev,:l2]
+ bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),''T]]
+ bpSpecificErrorHere '"bad IS code is generated"
+ bpTrap()
+
+bfApplication(bfop, bfarg) ==
+ if bfTupleP bfarg
+ then cons(bfop,CDR bfarg)
+ else cons(bfop,[bfarg])
+
+
+bfReName x==
+ a:=GET(x,"SHOERENAME")
+ if a
+ then car a
+ else x
+
+bfInfApplication(op,left,right)==
+ 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 [left,right]
+ EQ(op,"AND") => bfAND [left,right]
+ [op,left,right]
+
+bfNOT x==
+ x is ["NOT",a]=> a
+ x is ["NULL",a]=> a
+ ["NOT",x]
+
+bfFlatten(op, x) ==
+ EQCAR(x,op) => CDR x
+ [x]
+
+bfOR l ==
+ null l => NIL
+ null cdr l => CAR l
+ ["OR",:[:bfFlatten("OR",c) for c in l]]
+
+bfAND l ==
+ null l=> 'T
+ null cdr l => CAR l
+ ["AND",:[:bfFlatten("AND",c) for c in l]]
+
+
+defQuoteId x== EQCAR(x,"QUOTE") and IDENTP CADR x
+
+bfSmintable x==
+ INTEGERP x or CONSP x and
+ MEMQ(CAR x, '(SIZE LENGTH))
+
+bfQ(l,r)==
+ if bfSmintable l or bfSmintable r
+ then ["EQL",l,r]
+ else if defQuoteId l or defQuoteId r
+ then ["EQ",l,r]
+ else
+ if null l
+ then ["NULL",r]
+ else if null r
+ then ["NULL",l]
+ else ["EQUAL",l,r]
+
+bfLessp(l,r)==
+ if r=0
+ then ["MINUSP", l]
+ else ["<",l,r]
+
+bfMDef (defOp,op,args,body) ==
+ argl:=if bfTupleP args then cdr args else [args]
+ [gargl,sgargl,nargl,largl]:=bfGargl argl
+ sb:=[cons(i,j) for i in nargl for j in sgargl]
+ body:= SUBLIS(sb,body)
+ sb2 := [["CONS",["QUOTE",i],j] for i in sgargl for j in largl]
+ body := ["SUBLIS",["LIST",:sb2],["QUOTE",body]]
+ lamex:= ["MLAMBDA",gargl,body]
+ def:= [op,lamex]
+ bfTuple
+ cons(shoeComp def,[:shoeComps bfDef1 d for d in $wheredefs])
+
+bfGargl argl==
+ if null argl
+ then [[],[],[],[]]
+ else
+ [a,b,c,d]:=bfGargl cdr argl
+ if car argl="&REST"
+ then [cons(car argl,b),b,c,
+ cons(["CONS",["QUOTE","LIST"],car d],cdr d)]
+ else
+ f:=bfGenSymbol()
+ [cons(f,a),cons(f,b),cons(car argl,c),cons(f,d)]
+
+bfDef1 [defOp,op,args,body] ==
+ argl:=if bfTupleP args then cdr args else [args]
+ [quotes,control,arglp,body]:=bfInsertLet (argl,body)
+ quotes=>shoeLAM(op,arglp,control,body)
+ [[op,["LAMBDA",arglp,body]]]
+
+shoeLAM (op,args,control,body)==
+ margs :=bfGenSymbol()
+ innerfunc:=INTERN(CONCAT(PNAME op,",LAM"))
+ [[innerfunc,["LAMBDA",args,body]],
+ [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc],
+ ["WRAP",margs, ["QUOTE", control]]]]]]
+
+bfDef(defOp,op,args,body) ==
+ $bfClamming =>
+ [.,op1,arg1,:body1]:=shoeComp first bfDef1 [defOp,op,args,body]
+ bfCompHash(op1,arg1,body1)
+ bfTuple
+ [:shoeComps bfDef1 d for d in cons([defOp,op,args,body],$wheredefs)]
+
+shoeComps x==[shoeComp def for def in x]
+shoeComp x==
+ a:=shoeCompTran CADR x
+ if EQCAR(a,"LAMBDA")
+ then ["DEFUN",CAR x,CADR a,:CDDR a]
+ else ["DEFMACRO",CAR x,CADR a,:CDDR a]
+
+bfInsertLet(x,body)==
+ if null x
+ then [false,nil,x,body]
+ else
+ if x is ["&REST",a]
+ then if a is ["QUOTE",b]
+ then [true,"QUOTE",["&REST",b],body]
+ else [false,nil,x,body]
+ else
+ [b,norq,name1,body1]:= bfInsertLet1 (car x,body)
+ [b1,norq1,name2,body2]:= bfInsertLet (cdr x,body1)
+ [b or b1,cons(norq,norq1),cons(name1,name2),body2]
+
+bfInsertLet1(y,body)==
+ if y is ["L%T",l,r]
+ then [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
+ else if IDENTP y
+ then [false,nil,y,body]
+ else
+ if y is ["BVQUOTE",b]
+ then [true,"QUOTE",b,body]
+ else
+ g:=bfGenSymbol()
+ ATOM y => [false,nil,g,body]
+ [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]]
+
+shoeCompTran x==
+ lamtype:=CAR x
+ args :=CADR x
+ body :=CDDR x
+ $fluidVars:local:=nil
+ $locVars:local:=nil
+ $dollarVars:local:=nil
+ shoeCompTran1 body
+ $locVars:=SETDIFFERENCE(SETDIFFERENCE($locVars,
+ $fluidVars),shoeATOMs args)
+ body:=
+ if $fluidVars or $locVars or $dollarVars or $typings
+ then
+ lvars:=append($fluidVars,$locVars)
+ $fluidVars:=UNION($fluidVars,$dollarVars)
+ if null $fluidVars
+ then
+ null $typings=> shoePROG(lvars,body)
+ shoePROG(lvars,[["DECLARE",:$typings],:body])
+ else
+ fvars:=["DECLARE",["SPECIAL",:$fluidVars]]
+ null $typings => shoePROG(lvars,[fvars,:body])
+ shoePROG(lvars,[fvars,["DECLARE",:$typings],:body])
+ else shoePROG([], body)
+ fl:=shoeFluids args
+ body:=if fl
+ then
+ fvs:=["DECLARE",["SPECIAL",:fl]]
+ cons(fvs,body)
+ else body
+ [lamtype,args, :body]
+
+shoePROG(v,b)==
+ null b => [["PROG", v]]
+ [:blist,blast] := b
+ [["PROG",v,:blist,["RETURN", blast]]]
+
+shoeFluids x==
+ if null x
+ then nil
+ else if IDENTP x and bfBeginsDollar x
+ then [x]
+ else
+ if EQCAR(x,"QUOTE")
+ then []
+ else
+ if ATOM x
+ then nil
+ else append(shoeFluids car x,shoeFluids cdr x)
+shoeATOMs x==
+ if null x
+ then nil
+ else if ATOM x
+ then [x]
+ else append(shoeATOMs car x,shoeATOMs cdr x)
+
+shoeCompTran1 x==
+ ATOM x=>
+ IDENTP x and bfBeginsDollar x=>
+ $dollarVars:=
+ MEMQ(x,$dollarVars)=>$dollarVars
+ cons(x,$dollarVars)
+ nil
+ U:=car x
+ EQ(U,"QUOTE")=>nil
+ x is ["L%T",l,r]=>
+ RPLACA (x,"SETQ")
+ shoeCompTran1 r
+ IDENTP l =>
+ not bfBeginsDollar l=>
+ $locVars:=
+ MEMQ(l,$locVars)=>$locVars
+ cons(l,$locVars)
+ $dollarVars:=
+ MEMQ(l,$dollarVars)=>$dollarVars
+ cons(l,$dollarVars)
+ EQCAR(l,"FLUID")=>
+ $fluidVars:=
+ MEMQ(CADR l,$fluidVars)=>$fluidVars
+ cons(CADR l,$fluidVars)
+ RPLACA (CDR x,CADR l)
+ MEMQ(U,'(PROG LAMBDA))=>
+ newbindings:=nil
+ for y in CADR x repeat
+ not MEMQ(y,$locVars)=>
+ $locVars:=cons(y,$locVars)
+ newbindings:=cons(y,newbindings)
+ res:=shoeCompTran1 CDDR x
+ $locVars:=[y for y in $locVars | not MEMQ(y,newbindings)]
+ shoeCompTran1 car x
+ shoeCompTran1 cdr x
+
+bfTagged(a,b)==
+ IDENTP a =>
+ EQ(b,"FLUID") => bfLET(compFluid a,NIL)
+ EQ(b,"fluid") => bfLET(compFluid a,NIL)
+ EQ(b,"local") => bfLET(compFluid a,NIL)
+ $typings:=cons(["TYPE",b,a],$typings)
+ a
+ ["THE",b,a]
+
+bfAssign(l,r)==
+ if bfTupleP l then bfSetelt(CADR l,CDDR l ,r) else bfLET(l,r)
+
+bfSetelt(e,l,r)==
+ if null cdr l
+ then defSETELT(e,car l,r)
+ else bfSetelt(bfElt(e,car l),cdr l,r)
+
+bfElt(expr,sel)==
+ y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+ y=>
+ INTEGERP y => ["ELT",expr,y]
+ [y,expr]
+ ["ELT",expr,sel]
+
+defSETELT(var,sel,expr)==
+ y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+ y=>
+ INTEGERP y => ["SETF",["ELT",var,y],expr]
+ ["SETF",[y,var],expr]
+ ["SETF",["ELT",var,sel],expr]
+
+bfIfThenOnly(a,b)==
+ b1:=if EQCAR (b,"PROGN") then CDR b else [b]
+ ["COND",[a,:b1]]
+
+bfIf(a,b,c)==
+ b1:=if EQCAR (b,"PROGN") then CDR b else [b]
+ EQCAR (c,"COND") => ["COND",[a,:b1],:CDR c]
+ c1:=if EQCAR (c,"PROGN") then CDR c else [c]
+ ["COND",[a,:b1],['(QUOTE T),:c1]]
+
+bfExit(a,b)== ["COND",[a,["IDENTITY",b]]]
+
+bfMKPROGN l==
+ a:=[:bfFlattenSeq c for c in tails l]
+ null a=> nil
+ null CDR a=> CAR a
+ ["PROGN",:a]
+
+bfFlattenSeq x ==
+ null x=>NIL
+ f:=CAR x
+ ATOM f =>if CDR x then nil else [f]
+ EQCAR(f,"PROGN") =>
+ CDR x=> [i for i in CDR f| not ATOM i]
+ CDR f
+ [f]
+
+bfSequence l ==
+ null l=> NIL
+ transform:= [[a,b] for x in l while
+ x is ["COND",[a,["IDENTITY",b]]]]
+ no:=#transform
+ before:= bfTake(no,l)
+ aft := bfDrop(no,l)
+ null before =>
+ null rest l =>
+ f:=first l
+ if EQCAR(f,"PROGN")
+ then bfSequence CDR f
+ else f
+ bfMKPROGN [first l,bfSequence rest l]
+ null aft => ["COND",:transform]
+ ["COND",:transform,['(QUOTE T),bfSequence aft]]
+
+bfWhere (context,expr)==
+ [opassoc,defs,nondefs] := defSheepAndGoats context
+ a:=[[def,op,args,bfSUBLIS(opassoc,body)]
+ for d in defs |d is [def,op,args,body]]
+ $wheredefs:=append(a,$wheredefs)
+ bfMKPROGN bfSUBLIS(opassoc,NCONC(nondefs,[expr]))
+
+--shoeReadLispString(s,n)==
+-- n>= # s => nil
+-- [exp,ind]:=shoeReadLisp(s,n)
+-- null exp => nil
+-- cons(exp,shoeReadLispString(s,ind))
+
+bfReadLisp string==bfTuple shoeReadLispString (string,0)
+
+bfCompHash(op,argl,body) ==
+ auxfn:= INTERN CONCAT (PNAME op,'";")
+ computeFunction:= ["DEFUN",auxfn,argl,:body]
+ bfTuple [computeFunction,:bfMain(auxfn,op)]
+
+shoeCompileTimeEvaluation x ==
+ ["EVAL-WHEN", [KEYWORD::COMPILE_-TOPLEVEL], x]
+
+shoeEVALANDFILEACTQ x==
+ ["EVAL-WHEN", [KEYWORD::EXECUTE, KEYWORD::LOAD_-TOPLEVEL], x]
+
+bfMain(auxfn,op)==
+ g1:= bfGenSymbol()
+ arg:=["&REST",g1]
+ computeValue := ['APPLY,["FUNCTION",auxfn],g1]
+ cacheName:= INTERN CONCAT (PNAME op,'";AL")
+ g2:= bfGenSymbol()
+ getCode:= ['GETHASH,g1,cacheName]
+ secondPredPair:= [['SETQ,g2,getCode],g2]
+ putCode:= ['SETF ,getCode,computeValue]
+ thirdPredPair:= ['(QUOTE T),putCode]
+ codeBody:= ['PROG,[g2],
+ ['RETURN,['COND,secondPredPair,thirdPredPair]]]
+ mainFunction:= ["DEFUN",op,arg,codeBody]
+
+ cacheType:= 'hash_-table
+ cacheResetCode:= ['SETQ,cacheName,['MAKE_-HASHTABLE,
+ ["QUOTE","UEQUAL"]]]
+ cacheCountCode:= ['hashCount,cacheName]
+ cacheVector:=
+ [op,cacheName,cacheType,cacheResetCode,cacheCountCode]
+ [mainFunction,
+ shoeEVALANDFILEACTQ
+ ["SETF",["GET",
+ ["QUOTE", op],["QUOTE",'cacheInfo]],["QUOTE", cacheVector]],
+ shoeEVALANDFILEACTQ cacheResetCode ]
+
+bfNameOnly x==
+ if x="t"
+ then ["T"]
+ else [x]
+
+bfNameArgs (x,y)==
+ y:=if EQCAR(y,"TUPLE") then CDR y else [y]
+ cons(x,y)
+
+bfStruct(name,arglist)==
+ bfTuple [bfCreateDef i for i in arglist]
+
+bfCreateDef x==
+ if null cdr x
+ then
+ f:=car x
+ ["SETQ",f,["LIST",["QUOTE",f]]]
+ else
+ a:=[bfGenSymbol() for i in cdr x]
+ ["DEFUN",car x,a,["CONS",["QUOTE",car x],["LIST",:a]]]
+
+bfCaseItem(x,y)==[x,y]
+
+bfCase(x,y)==
+ g:=bfGenSymbol()
+ g1:=bfGenSymbol()
+ a:=bfLET(g,x)
+ b:=bfLET(g1,["CDR",g])
+ c:=bfCaseItems (g1,y)
+ bfMKPROGN [a,b,["CASE",["CAR", g],:c]]
+
+bfCaseItems(g,x)== [bfCI(g,i,j) for [i,j] in x]
+
+bfCI(g,x,y)==
+ a:=cdr x
+ if null a
+ then [car x,y]
+ else
+ b:=[[i,bfCARCDR(j,g)] for i in a for j in 0..]
+ [car x,["LET",b,y]]
+
+bfCARCDR (n,g)==[INTERN CONCAT ('"CA",bfDs n,'"R"),g]
+
+bfDs n== if n=0 then '"" else CONCAT('"D",bfDs(n-1))
+
+@
+
+<<ast.clisp>>=
+(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-ast"))
+
+(IMPORT-MODULE "includer")
+
+(IN-PACKAGE "BOOTTRAN")
+
+(DEFTYPE |String| () 'STRING)
+
+(DEFTYPE |Symbol| () 'SYMBOL)
+
+(DEFTYPE |Sequence| () 'SEQUENCE)
+
+(DEFTYPE |List| () '(OR NIL CONS))
+
+(DEFUN |Name| #0=(|bfVar#1|) (CONS '|Name| (LIST . #0#)))
+
+(DEFUN |Command| #0=(|bfVar#2|) (CONS '|Command| (LIST . #0#)))
+
+(DEFUN |Module| #0=(|bfVar#3|) (CONS '|Module| (LIST . #0#)))
+
+(DEFUN |Import| #0=(|bfVar#4|) (CONS '|Import| (LIST . #0#)))
+
+(DEFUN |TypeAlias| #0=(|bfVar#5| |bfVar#6| |bfVar#7|)
+ (CONS '|TypeAlias| (LIST . #0#)))
+
+(DEFUN |SuffixDot| #0=(|bfVar#8|) (CONS '|SuffixDot| (LIST . #0#)))
+
+(DEFUN |Quote| #0=(|bfVar#9|) (CONS '|Quote| (LIST . #0#)))
+
+(DEFUN |EqualName| #0=(|bfVar#10|) (CONS '|EqualName| (LIST . #0#)))
+
+(DEFUN |Colon| #0=(|bfVar#11|) (CONS '|Colon| (LIST . #0#)))
+
+(DEFUN |QualifiedName| #0=(|bfVar#12| |bfVar#13|)
+ (CONS '|QualifiedName| (LIST . #0#)))
+
+(DEFUN |Bracket| #0=(|bfVar#14|) (CONS '|Bracket| (LIST . #0#)))
+
+(DEFUN |UnboundedSegment| #0=(|bfVar#15|)
+ (CONS '|UnboundedSegment| (LIST . #0#)))
+
+(DEFUN |BoundedSgement| #0=(|bfVar#16| |bfVar#17|)
+ (CONS '|BoundedSgement| (LIST . #0#)))
+
+(DEFUN |Tuple| #0=(|bfVar#18|) (CONS '|Tuple| (LIST . #0#)))
+
+(DEFUN |ColonAppend| #0=(|bfVar#19| |bfVar#20|)
+ (CONS '|ColonAppend| (LIST . #0#)))
+
+(DEFUN |Is| #0=(|bfVar#21| |bfVar#22|) (CONS '|Is| (LIST . #0#)))
+
+(DEFUN |Isnt| #0=(|bfVar#23| |bfVar#24|) (CONS '|Isnt| (LIST . #0#)))
+
+(DEFUN |Reduce| #0=(|bfVar#25| |bfVar#26|)
+ (CONS '|Reduce| (LIST . #0#)))
+
+(DEFUN |PrefixExpr| #0=(|bfVar#27| |bfVar#28|)
+ (CONS '|PrefixExpr| (LIST . #0#)))
+
+(DEFUN |Call| #0=(|bfVar#29| |bfVar#30|) (CONS '|Call| (LIST . #0#)))
+
+(DEFUN |InfixExpr| #0=(|bfVar#31| |bfVar#32| |bfVar#33|)
+ (CONS '|InfixExpr| (LIST . #0#)))
+
+(DEFUN |Definition| #0=(|bfVar#34| |bfVar#35| |bfVar#36| |bfVar#37|)
+ (CONS '|Definition| (LIST . #0#)))
+
+(DEFUN |Macro| #0=(|bfVar#38| |bfVar#39| |bfVar#40|)
+ (CONS '|Macro| (LIST . #0#)))
+
+(DEFUN |SuchThat| #0=(|bfVar#41|) (CONS '|SuchThat| (LIST . #0#)))
+
+(DEFUN |Assignment| #0=(|bfVar#42| |bfVar#43|)
+ (CONS '|Assignment| (LIST . #0#)))
+
+(DEFUN |While| #0=(|bfVar#44|) (CONS '|While| (LIST . #0#)))
+
+(DEFUN |Until| #0=(|bfVar#45|) (CONS '|Until| (LIST . #0#)))
+
+(DEFUN |For| #0=(|bfVar#46| |bfVar#47| |bfVar#48|)
+ (CONS '|For| (LIST . #0#)))
+
+(DEFUN |Exit| #0=(|bfVar#49| |bfVar#50|) (CONS '|Exit| (LIST . #0#)))
+
+(DEFUN |Iterators| #0=(|bfVar#51|) (CONS '|Iterators| (LIST . #0#)))
+
+(DEFUN |Cross| #0=(|bfVar#52|) (CONS '|Cross| (LIST . #0#)))
+
+(DEFUN |Repeat| #0=(|bfVar#53| |bfVar#54|)
+ (CONS '|Repeat| (LIST . #0#)))
+
+(DEFUN |Pile| #0=(|bfVar#55|) (CONS '|Pile| (LIST . #0#)))
+
+(DEFUN |Append| #0=(|bfVar#56|) (CONS '|Append| (LIST . #0#)))
+
+(DEFUN |Case| #0=(|bfVar#57| |bfVar#58|) (CONS '|Case| (LIST . #0#)))
+
+(DEFUN |Return| #0=(|bfVar#59|) (CONS '|Return| (LIST . #0#)))
+
+(DEFUN |Where| #0=(|bfVar#60| |bfVar#61|)
+ (CONS '|Where| (LIST . #0#)))
+
+(DEFUN |Structure| #0=(|bfVar#62| |bfVar#63|)
+ (CONS '|Structure| (LIST . #0#)))
+
+(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) (DEFPARAMETER |$inDefIS| NIL))
+
+(DEFUN |bfGenSymbol| ()
+ (PROG ()
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (RETURN
+ (PROGN
+ (SETQ |$GenVarCounter| (+ |$GenVarCounter| 1))
+ (INTERN (CONCAT "bfVar#" (STRINGIMAGE |$GenVarCounter|)))))))
+
+(DEFUN |bfListOf| (|x|) (PROG () (RETURN |x|)))
+
+(DEFUN |bfColon| (|x|) (PROG () (RETURN (LIST 'COLON |x|))))
+
+(DEFUN |bfColonColon| (|package| |name|)
+ (PROG () (RETURN (INTERN (SYMBOL-NAME |name|) |package|))))
+
+(DEFUN |bfSymbol| (|x|)
+ (PROG () (RETURN (COND ((STRINGP |x|) |x|) ('T (LIST 'QUOTE |x|))))))
+
+(DEFUN |bfDot| () (PROG () (RETURN 'DOT)))
+
+(DEFUN |bfSuffixDot| (|x|) (PROG () (RETURN (LIST |x| 'DOT))))
+
+(DEFUN |bfEqual| (|name|) (PROG () (RETURN (LIST 'EQUAL |name|))))
+
+(DEFUN |bfBracket| (|part|) (PROG () (RETURN |part|)))
+
+(DEFUN |bfPile| (|part|) (PROG () (RETURN |part|)))
+
+(DEFUN |bfAppend| (|x|) (PROG () (RETURN (APPLY #'APPEND |x|))))
+
+(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|)))))))
+
+(DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|)
+ (PROG () (RETURN (LIST 'DEF |bflhsitems| |bfrhs| |body|))))
+
+(DEFUN |bfMDefinition| (|bflhsitems| |bfrhs| |body|)
+ (PROG () (RETURN (|bfMDef| 'MDEF |bflhsitems| |bfrhs| |body|))))
+
+(DEFUN |bfCompDef| (|bfVar#64|)
+ (PROG (|body| |args| |op| |def|)
+ (RETURN
+ (PROGN
+ (SETQ |def| (CAR |bfVar#64|))
+ (SETQ |op| (CADR . #0=(|bfVar#64|)))
+ (SETQ |args| (CADDR . #0#))
+ (SETQ |body| (CADDDR . #0#))
+ (|bfDef| |def| |op| |args| |body|)))))
+
+(DEFUN |bfBeginsDollar| (|x|)
+ (PROG () (RETURN (EQL (ELT "$" 0) (ELT (PNAME |x|) 0)))))
+
+(DEFUN |compFluid| (|id|) (PROG () (RETURN (LIST 'FLUID |id|))))
+
+(DEFUN |compFluidize| (|x|)
+ (PROG ()
+ (RETURN
+ (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|) (PROG () (RETURN (CONS 'TUPLE |x|))))
+
+(DEFUN |bfTupleP| (|x|) (PROG () (RETURN (EQCAR |x| 'TUPLE))))
+
+(DEFUN |bfTupleIf| (|x|)
+ (PROG ()
+ (RETURN (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
+ (((LAMBDA (|bfVar#66| |bfVar#65| |x|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#65|)
+ (PROGN (SETQ |x| (CAR |bfVar#65|)) NIL))
+ (RETURN |bfVar#66|))
+ ('T
+ (PROGN
+ (SETQ |bfVar#66|
+ (AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |x|))
+ (AND (CONSP |ISTMP#1|)
+ (EQ (CDR |ISTMP#1|) NIL)))))
+ (COND (|bfVar#66| (RETURN |bfVar#66|))))))
+ (SETQ |bfVar#65| (CDR |bfVar#65|))))
+ NIL |a| NIL)
+ (|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|)
+ (PROG ()
+ (RETURN
+ (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)
+ (PROG ()
+ (RETURN
+ (LIST (LIST (LIST |x|) (LIST E)
+ (LIST (LIST 'SETQ |x| (LIST 'CDR |x|))) NIL
+ (LIST (LIST 'ATOM |x|)) NIL)))))
+
+(DEFUN |bfSuchthat| (|p|)
+ (PROG () (RETURN (LIST (LIST NIL NIL NIL (LIST |p|) NIL NIL)))))
+
+(DEFUN |bfWhile| (|p|)
+ (PROG ()
+ (RETURN (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|) (PROG () (RETURN (CONS 'ITERATORS |x|))))
+
+(DEFUN |bfCross| (|x|) (PROG () (RETURN (CONS 'CROSS |x|))))
+
+(DEFUN |bfLp| (|iters| |body|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|))
+ ('T (|bfLpCross| (CDR |iters|) |body|))))))
+
+(DEFUN |bfLpCross| (|iters| |body|)
+ (PROG ()
+ (RETURN
+ (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|)))
+ ((LAMBDA (|bfVar#69| |bfVar#67| |i| |bfVar#68| |j|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#67|)
+ (PROGN (SETQ |i| (CAR |bfVar#67|)) NIL)
+ (ATOM |bfVar#68|)
+ (PROGN (SETQ |j| (CAR |bfVar#68|)) NIL))
+ (RETURN (NREVERSE |bfVar#69|)))
+ ('T
+ (SETQ |bfVar#69| (CONS (APPEND |i| |j|) |bfVar#69|))))
+ (SETQ |bfVar#67| (CDR |bfVar#67|))
+ (SETQ |bfVar#68| (CDR |bfVar#68|))))
+ NIL |f| NIL |r| NIL))))))
+
+(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| (GET |op| 'SHOETHETA))
+ (SETQ |g| (|bfGenSymbol|))
+ (SETQ |g1| (|bfGenSymbol|))
+ (SETQ |body| (LIST 'SETQ |g| (LIST |op| |g1| |g|)))
+ (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| (GET |op| 'SHOETHETA))
+ (|bfOpReduce| |op| |init| |body| |itl|))
+ (#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1)))
+ (|bfReduce| |op| |a|))))))
+
+(DEFUN |bfDCollect| (|y| |itl|)
+ (PROG () (RETURN (LIST 'COLLECT |y| |itl|))))
+
+(DEFUN |bfDTuple| (|x|) (PROG () (RETURN (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|)
+ (PROG () (RETURN (|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 (LIST 'LAMBDA |vars|
+ (CONS 'LOOP (CONS |exits| |sucs|)))
+ |inits|))
+ |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|)
+ (PROG () (RETURN (|bfLp| (|bfIterators| NIL) |body|))))
+
+(DEFUN |bfSegment1| (|lo|)
+ (PROG () (RETURN (LIST 'SEGMENT |lo| NIL))))
+
+(DEFUN |bfSegment2| (|lo| |hi|)
+ (PROG () (RETURN (LIST 'SEGMENT |lo| |hi|))))
+
+(DEFUN |bfForInBy| (|variable| |collection| |step|)
+ (PROG () (RETURN (|bfFor| |variable| |collection| |step|))))
+
+(DEFUN |bfForin| (|lhs| U) (PROG () (RETURN (|bfFor| |lhs| U 1))))
+
+(DEFUN |bfLocal| (|a| |b|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((EQ |b| 'FLUID) (|compFluid| |a|))
+ ((EQ |b| '|fluid|) (|compFluid| |a|))
+ ((EQ |b| '|local|) (|compFluid| |a|))
+ ('T |a|)))))
+
+(DEFUN |bfTake| (|n| |x|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |x|) |x|)
+ ((EQL |n| 0) NIL)
+ ('T (CONS (CAR |x|) (|bfTake| (- |n| 1) (CDR |x|))))))))
+
+(DEFUN |bfDrop| (|n| |x|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((OR (NULL |x|) (EQL |n| 0)) |x|)
+ ('T (|bfDrop| (- |n| 1) (CDR |x|)))))))
+
+(DEFUN |bfDefSequence| (|l|) (PROG () (RETURN (CONS 'SEQ |l|))))
+
+(DEFUN |bfReturnNoName| (|a|) (PROG () (RETURN (LIST 'RETURN |a|))))
+
+(DEFUN |bfSUBLIS| (|p| |e|)
+ (PROG ()
+ (RETURN
+ (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|) (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|)
+ (PROG () (RETURN (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|) (NULL (|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|)
+ (PROG ()
+ (RETURN
+ (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|) (PROG () (RETURN (|bfPosn| |x| |l| 0))))
+
+(DEFUN |bfPosn| (|x| |l| |n|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |l|) (- 1))
+ ((EQUAL |x| (CAR |l|)) |n|)
+ ('T (|bfPosn| |x| (CDR |l|) (+ |n| 1)))))))
+
+(DEFUN |bfISApplication| (|op| |left| |right|)
+ (PROG ()
+ (RETURN
+ (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|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
+ ('T (CONS |bfop| (LIST |bfarg|)))))))
+
+(DEFUN |bfReName| (|x|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (GET |x| 'SHOERENAME))
+ (COND (|a| (CAR |a|)) ('T |x|))))))
+
+(DEFUN |bfInfApplication| (|op| |left| |right|)
+ (PROG ()
+ (RETURN
+ (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|)
+ (PROG ()
+ (RETURN (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|))))))
+
+(DEFUN |bfOR| (|l|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |l|) NIL)
+ ((NULL (CDR |l|)) (CAR |l|))
+ ('T
+ (CONS 'OR
+ ((LAMBDA (|bfVar#71| |bfVar#70| |c|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#70|)
+ (PROGN (SETQ |c| (CAR |bfVar#70|)) NIL))
+ (RETURN (NREVERSE |bfVar#71|)))
+ ('T
+ (SETQ |bfVar#71|
+ (APPEND (REVERSE (|bfFlatten| 'OR |c|))
+ |bfVar#71|))))
+ (SETQ |bfVar#70| (CDR |bfVar#70|))))
+ NIL |l| NIL)))))))
+
+(DEFUN |bfAND| (|l|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |l|) 'T)
+ ((NULL (CDR |l|)) (CAR |l|))
+ ('T
+ (CONS 'AND
+ ((LAMBDA (|bfVar#73| |bfVar#72| |c|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#72|)
+ (PROGN (SETQ |c| (CAR |bfVar#72|)) NIL))
+ (RETURN (NREVERSE |bfVar#73|)))
+ ('T
+ (SETQ |bfVar#73|
+ (APPEND (REVERSE (|bfFlatten| 'AND |c|))
+ |bfVar#73|))))
+ (SETQ |bfVar#72| (CDR |bfVar#72|))))
+ NIL |l| NIL)))))))
+
+(DEFUN |defQuoteId| (|x|)
+ (PROG () (RETURN (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))))
+
+(DEFUN |bfSmintable| (|x|)
+ (PROG ()
+ (RETURN
+ (OR (INTEGERP |x|)
+ (AND (CONSP |x|) (MEMQ (CAR |x|) '(SIZE LENGTH)))))))
+
+(DEFUN |bfQ| (|l| |r|)
+ (PROG ()
+ (RETURN
+ (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|))
+ ('T (LIST 'EQUAL |l| |r|))))))
+
+(DEFUN |bfLessp| (|l| |r|)
+ (PROG ()
+ (RETURN
+ (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|
+ ((LAMBDA (|bfVar#76| |bfVar#74| |i| |bfVar#75| |j|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#74|)
+ (PROGN (SETQ |i| (CAR |bfVar#74|)) NIL)
+ (ATOM |bfVar#75|)
+ (PROGN (SETQ |j| (CAR |bfVar#75|)) NIL))
+ (RETURN (NREVERSE |bfVar#76|)))
+ (#1='T
+ (SETQ |bfVar#76|
+ (CONS (CONS |i| |j|) |bfVar#76|))))
+ (SETQ |bfVar#74| (CDR |bfVar#74|))
+ (SETQ |bfVar#75| (CDR |bfVar#75|))))
+ NIL |nargl| NIL |sgargl| NIL))
+ (SETQ |body| (SUBLIS |sb| |body|))
+ (SETQ |sb2|
+ ((LAMBDA (|bfVar#79| |bfVar#77| |i| |bfVar#78| |j|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#77|)
+ (PROGN (SETQ |i| (CAR |bfVar#77|)) NIL)
+ (ATOM |bfVar#78|)
+ (PROGN (SETQ |j| (CAR |bfVar#78|)) NIL))
+ (RETURN (NREVERSE |bfVar#79|)))
+ (#1#
+ (SETQ |bfVar#79|
+ (CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
+ |bfVar#79|))))
+ (SETQ |bfVar#77| (CDR |bfVar#77|))
+ (SETQ |bfVar#78| (CDR |bfVar#78|))))
+ NIL |sgargl| NIL |largl| NIL))
+ (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|)
+ ((LAMBDA (|bfVar#81| |bfVar#80| |d|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#80|)
+ (PROGN (SETQ |d| (CAR |bfVar#80|)) NIL))
+ (RETURN (NREVERSE |bfVar#81|)))
+ (#1#
+ (SETQ |bfVar#81|
+ (APPEND (REVERSE
+ (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#81|))))
+ (SETQ |bfVar#80| (CDR |bfVar#80|))))
+ NIL |$wheredefs| NIL)))))))
+
+(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#82|)
+ (PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
+ |op| |defOp|)
+ (RETURN
+ (PROGN
+ (SETQ |defOp| (CAR |bfVar#82|))
+ (SETQ |op| (CADR . #0=(|bfVar#82|)))
+ (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|
+ ((LAMBDA (|bfVar#84| |bfVar#83| |d|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#83|)
+ (PROGN (SETQ |d| (CAR |bfVar#83|)) NIL))
+ (RETURN (NREVERSE |bfVar#84|)))
+ ('T
+ (SETQ |bfVar#84|
+ (APPEND (REVERSE
+ (|shoeComps| (|bfDef1| |d|)))
+ |bfVar#84|))))
+ (SETQ |bfVar#83| (CDR |bfVar#83|))))
+ NIL (CONS (LIST |defOp| |op| |args| |body|) |$wheredefs|)
+ NIL)))))))
+
+(DEFUN |shoeComps| (|x|)
+ (PROG ()
+ (RETURN
+ ((LAMBDA (|bfVar#86| |bfVar#85| |def|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#85|)
+ (PROGN (SETQ |def| (CAR |bfVar#85|)) NIL))
+ (RETURN (NREVERSE |bfVar#86|)))
+ ('T
+ (SETQ |bfVar#86| (CONS (|shoeComp| |def|) |bfVar#86|))))
+ (SETQ |bfVar#85| (CDR |bfVar#85|))))
+ NIL |x| NIL))))
+
+(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 |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|)
+ (CONS |name1| |name2|) |body2|))))))
+
+(DEFUN |bfInsertLet1| (|y| |body|)
+ (PROG (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
+ (RETURN
+ (COND
+ ((AND (CONSP |y|) (EQ (CAR |y|) 'L%T)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |y|))
+ (AND (CONSP |ISTMP#1|)
+ (PROGN
+ (SETQ |l| (CAR |ISTMP#1|))
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (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|))
+ ('T (SETQ |g| (|bfGenSymbol|))
+ (COND
+ ((ATOM |y|) (LIST NIL NIL |g| |body|))
+ ('T
+ (LIST NIL NIL |g|
+ (|bfMKPROGN|
+ (LIST (|bfLET| (|compFluidize| |y|) |g|) |body|))))))))))
+
+(DEFUN |shoeCompTran| (|x|)
+ (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars|
+ |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|
+ (COND
+ ((OR |$fluidVars| |$locVars| |$dollarVars| |$typings|)
+ (SETQ |lvars| (APPEND |$fluidVars| |$locVars|))
+ (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|))
+ (COND
+ ((NULL |$fluidVars|)
+ (COND
+ ((NULL |$typings|) (|shoePROG| |lvars| |body|))
+ (#0='T
+ (|shoePROG| |lvars|
+ (CONS (CONS 'DECLARE |$typings|) |body|)))))
+ (#1='T
+ (SETQ |fvars|
+ (LIST 'DECLARE (CONS 'SPECIAL |$fluidVars|)))
+ (COND
+ ((NULL |$typings|)
+ (|shoePROG| |lvars| (CONS |fvars| |body|)))
+ (#0#
+ (|shoePROG| |lvars|
+ (CONS |fvars|
+ (CONS (CONS 'DECLARE |$typings|)
+ |body|))))))))
+ (#1# (|shoePROG| NIL |body|))))
+ (SETQ |fl| (|shoeFluids| |args|))
+ (SETQ |body|
+ (COND
+ (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|)))
+ (CONS |fvs| |body|))
+ (#1# |body|)))
+ (CONS |lamtype| (CONS |args| |body|))))))
+
+(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|)
+ (PROG ()
+ (RETURN
+ (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|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((NULL |x|) NIL)
+ ((ATOM |x|) (LIST |x|))
+ ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|))))))))
+
+(DEFUN |shoeCompTran1| (|x|)
+ (PROG (|res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U)
+ (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|))
+ (RETURN
+ (COND
+ ((ATOM |x|)
+ (COND
+ ((AND (IDENTP |x|) (|bfBeginsDollar| |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
+ ((NULL (|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)
+ ((LAMBDA (|bfVar#87| |y|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#87|)
+ (PROGN (SETQ |y| (CAR |bfVar#87|)) NIL))
+ (RETURN NIL))
+ (#1='T
+ (COND
+ ((NULL (MEMQ |y| |$locVars|))
+ (IDENTITY (PROGN
+ (SETQ |$locVars|
+ (CONS |y| |$locVars|))
+ (SETQ |newbindings|
+ (CONS |y| |newbindings|))))))))
+ (SETQ |bfVar#87| (CDR |bfVar#87|))))
+ (CADR |x|) NIL)
+ (SETQ |res| (|shoeCompTran1| (CDDR |x|)))
+ (SETQ |$locVars|
+ ((LAMBDA (|bfVar#89| |bfVar#88| |y|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#88|)
+ (PROGN
+ (SETQ |y| (CAR |bfVar#88|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#89|)))
+ (#1#
+ (AND (NULL (MEMQ |y| |newbindings|))
+ (SETQ |bfVar#89|
+ (CONS |y| |bfVar#89|)))))
+ (SETQ |bfVar#88| (CDR |bfVar#88|))))
+ NIL |$locVars| NIL))))
+ (#0#
+ (PROGN
+ (|shoeCompTran1| (CAR |x|))
+ (|shoeCompTran1| (CDR |x|)))))))))))
+
+(DEFUN |bfTagged| (|a| |b|)
+ (PROG ()
+ (DECLARE (SPECIAL |$typings|))
+ (RETURN
+ (COND
+ ((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|)
+ (PROG ()
+ (RETURN
+ (COND
+ ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
+ ('T (|bfLET| |l| |r|))))))
+
+(DEFUN |bfSetelt| (|e| |l| |r|)
+ (PROG ()
+ (RETURN
+ (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|)
+ (PROG () (RETURN (LIST 'COND (LIST |a| (LIST 'IDENTITY |b|))))))
+
+(DEFUN |bfMKPROGN| (|l|)
+ (PROG (|a|)
+ (RETURN
+ (PROGN
+ (SETQ |a|
+ ((LAMBDA (|bfVar#90| |c|)
+ (LOOP
+ (COND
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#90|)))
+ ('T
+ (SETQ |bfVar#90|
+ (APPEND (REVERSE (|bfFlattenSeq| |c|))
+ |bfVar#90|))))
+ (SETQ |c| (CDR |c|))))
+ NIL |l|))
+ (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|)
+ ((LAMBDA (|bfVar#92| |bfVar#91| |i|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#91|)
+ (PROGN (SETQ |i| (CAR |bfVar#91|)) NIL))
+ (RETURN (NREVERSE |bfVar#92|)))
+ ('T
+ (AND (NULL (ATOM |i|))
+ (SETQ |bfVar#92| (CONS |i| |bfVar#92|)))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|))))
+ NIL (CDR |f|) NIL))
+ (#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|
+ ((LAMBDA (|bfVar#94| |bfVar#93| |x|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#93|)
+ (PROGN (SETQ |x| (CAR |bfVar#93|)) 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#94|)))
+ ('T
+ (SETQ |bfVar#94|
+ (CONS (LIST |a| |b|) |bfVar#94|))))
+ (SETQ |bfVar#93| (CDR |bfVar#93|))))
+ NIL |l| NIL))
+ (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|
+ ((LAMBDA (|bfVar#96| |bfVar#95| |d|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#95|)
+ (PROGN (SETQ |d| (CAR |bfVar#95|)) NIL))
+ (RETURN (NREVERSE |bfVar#96|)))
+ ('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#96|
+ (CONS (LIST |def| |op| |args|
+ (|bfSUBLIS| |opassoc| |body|))
+ |bfVar#96|)))))
+ (SETQ |bfVar#95| (CDR |bfVar#95|))))
+ NIL |defs| NIL))
+ (SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
+ (|bfMKPROGN|
+ (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
+
+(DEFUN |bfReadLisp| (|string|)
+ (PROG () (RETURN (|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|)
+ (PROG () (RETURN (LIST 'EVAL-WHEN (LIST :COMPILE-TOPLEVEL) |x|))))
+
+(DEFUN |shoeEVALANDFILEACTQ| (|x|)
+ (PROG ()
+ (RETURN (LIST 'EVAL-WHEN (LIST :EXECUTE :LOAD-TOPLEVEL) |x|))))
+
+(DEFUN |bfMain| (|auxfn| |op|)
+ (PROG (|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|))
+ (LIST |mainFunction|
+ (|shoeEVALANDFILEACTQ|
+ (LIST 'SETF
+ (LIST 'GET (LIST 'QUOTE |op|)
+ (LIST 'QUOTE '|cacheInfo|))
+ (LIST 'QUOTE |cacheVector|)))
+ (|shoeEVALANDFILEACTQ| |cacheResetCode|))))))
+
+(DEFUN |bfNameOnly| (|x|)
+ (PROG () (RETURN (COND ((EQ |x| '|t|) (LIST 'T)) ('T (LIST |x|))))))
+
+(DEFUN |bfNameArgs| (|x| |y|)
+ (PROG ()
+ (RETURN
+ (PROGN
+ (SETQ |y|
+ (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|))))
+ (CONS |x| |y|)))))
+
+(DEFUN |bfStruct| (|name| |arglist|)
+ (PROG ()
+ (RETURN
+ (|bfTuple|
+ ((LAMBDA (|bfVar#98| |bfVar#97| |i|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#97|)
+ (PROGN (SETQ |i| (CAR |bfVar#97|)) NIL))
+ (RETURN (NREVERSE |bfVar#98|)))
+ ('T
+ (SETQ |bfVar#98|
+ (CONS (|bfCreateDef| |i|) |bfVar#98|))))
+ (SETQ |bfVar#97| (CDR |bfVar#97|))))
+ NIL |arglist| NIL)))))
+
+(DEFUN |bfCreateDef| (|x|)
+ (PROG (|a| |f|)
+ (RETURN
+ (COND
+ ((NULL (CDR |x|)) (SETQ |f| (CAR |x|))
+ (LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
+ ('T
+ (SETQ |a|
+ ((LAMBDA (|bfVar#100| |bfVar#99| |i|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#99|)
+ (PROGN (SETQ |i| (CAR |bfVar#99|)) NIL))
+ (RETURN (NREVERSE |bfVar#100|)))
+ ('T
+ (SETQ |bfVar#100|
+ (CONS (|bfGenSymbol|) |bfVar#100|))))
+ (SETQ |bfVar#99| (CDR |bfVar#99|))))
+ NIL (CDR |x|) NIL))
+ (LIST 'DEFUN (CAR |x|) |a|
+ (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
+
+(DEFUN |bfCaseItem| (|x| |y|) (PROG () (RETURN (LIST |x| |y|))))
+
+(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|))))))))
+
+(DEFUN |bfCaseItems| (|g| |x|)
+ (PROG (|j| |ISTMP#1| |i|)
+ (RETURN
+ ((LAMBDA (|bfVar#103| |bfVar#102| |bfVar#101|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#102|)
+ (PROGN (SETQ |bfVar#101| (CAR |bfVar#102|)) NIL))
+ (RETURN (NREVERSE |bfVar#103|)))
+ ('T
+ (AND (CONSP |bfVar#101|)
+ (PROGN
+ (SETQ |i| (CAR |bfVar#101|))
+ (SETQ |ISTMP#1| (CDR |bfVar#101|))
+ (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
+ (PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
+ (SETQ |bfVar#103|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#103|)))))
+ (SETQ |bfVar#102| (CDR |bfVar#102|))))
+ NIL |x| NIL))))
+
+(DEFUN |bfCI| (|g| |x| |y|)
+ (PROG (|b| |a|)
+ (RETURN
+ (PROGN
+ (SETQ |a| (CDR |x|))
+ (COND
+ ((NULL |a|) (LIST (CAR |x|) |y|))
+ ('T
+ (SETQ |b|
+ ((LAMBDA (|bfVar#105| |bfVar#104| |i| |j|)
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#104|)
+ (PROGN (SETQ |i| (CAR |bfVar#104|)) NIL))
+ (RETURN (NREVERSE |bfVar#105|)))
+ ('T
+ (SETQ |bfVar#105|
+ (CONS (LIST |i| (|bfCARCDR| |j| |g|))
+ |bfVar#105|))))
+ (SETQ |bfVar#104| (CDR |bfVar#104|))
+ (SETQ |j| (+ |j| 1))))
+ NIL |a| NIL 0))
+ (LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
+
+(DEFUN |bfCARCDR| (|n| |g|)
+ (PROG ()
+ (RETURN (LIST (INTERN (CONCAT "CA" (|bfDs| |n|) "R")) |g|))))
+
+(DEFUN |bfDs| (|n|)
+ (PROG ()
+ (RETURN
+ (COND ((EQL |n| 0) "") ('T (CONCAT "D" (|bfDs| (- |n| 1))))))))
+
+@
+
+\end{document}