diff options
Diffstat (limited to 'src/boot/ast.boot.pamphlet')
| -rw-r--r-- | src/boot/ast.boot.pamphlet | 3090 |
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} |