diff options
Diffstat (limited to 'src/boot/ast.boot')
| -rw-r--r-- | src/boot/ast.boot | 246 |
1 files changed, 127 insertions, 119 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 2e62c119..b0ca0ec4 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -39,8 +39,8 @@ -- import includer -module ast namespace BOOTTRAN +module ast ++ True means that Boot functions should be translated to use ++ hash tables to remember values. By default, functions are @@ -138,10 +138,12 @@ bfGenSymbol()== INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter)) bfListOf: %List -> %List -bfListOf x==x +bfListOf x== + x bfColon: %Thing -> %List -bfColon x== ["COLON",x] +bfColon x== + ["COLON",x] bfColonColon: (%Symbol,%Symbol) -> %Symbol bfColonColon(package, name) == @@ -186,7 +188,7 @@ bfColonAppend(x,y) == if y is ["BVQUOTE",:a] then ["&REST",["QUOTE",:a]] else ["&REST",y] - else cons(CAR x,bfColonAppend(CDR x,y)) + else cons(first x,bfColonAppend(rest x,y)) bfDefinition: (%Thing,%Thing,%Thing) -> %List bfDefinition(bflhsitems, bfrhs,body) == @@ -214,9 +216,9 @@ compFluid id == compFluidize x== IDENTP x and bfBeginsDollar x=>compFluid x - ATOM x =>x + atom x =>x EQCAR(x,"QUOTE")=>x - cons(compFluidize(CAR x),compFluidize(CDR x)) + cons(compFluidize(first x),compFluidize(rest x)) bfTuple x== ["TUPLE",:x] @@ -254,19 +256,19 @@ bfMakeCons l == bfFor(bflhs,U,step) == if EQCAR (U,'tails) - then bfForTree('ON, bflhs, CADR U) + then bfForTree('ON, bflhs, second U) else if EQCAR(U,"SEGMENT") - then bfSTEP(bflhs,CADR U,step,CADDR U) + then bfSTEP(bflhs,second U,step,third 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 + atom lhs =>bfINON [OP,lhs,whole] + lhs:=if bfTupleP lhs then second lhs else lhs EQCAR(lhs,"L%T") => - G:=CADR lhs - [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,CADDR lhs)] + G:=second lhs + [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,third lhs)] G:=bfGenSymbol() [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,lhs)] @@ -274,14 +276,14 @@ bfForTree(OP,lhs,whole)== bfSTEP(id,fst,step,lst)== initvar:=[id] initval:=[fst] - inc:=if ATOM step + inc:=if atom step then step else g1:=bfGenSymbol() initvar:=cons(g1,initvar) initval:=cons(step,initval) g1 - final:=if ATOM lst + final:=if atom lst then lst else g2:=bfGenSymbol() @@ -327,13 +329,13 @@ bfIterators x==["ITERATORS",:x] bfCross x== ["CROSS",:x] bfLp(iters,body)== - EQCAR (iters,"ITERATORS")=>bfLp1(CDR iters,body) - bfLpCross(CDR iters,body) + EQCAR (iters,"ITERATORS")=>bfLp1(rest iters,body) + bfLpCross(rest iters,body) bfLpCross(iters,body)== if null cdr iters - then bfLp(car iters,body) - else bfLp(car iters,bfLpCross(cdr iters,body)) + then bfLp(first iters,body) + else bfLp(first iters,bfLpCross(rest iters,body)) bfSep(iters)== if null iters @@ -344,7 +346,7 @@ bfSep(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 + a:=if EQCAR(op,"QUOTE") then second op else op op:=bfReName a init:=GET(op,"SHOETHETA") g:=bfGenSymbol() @@ -367,7 +369,7 @@ bfReduceCollect(op,y)== then body:=y.1 itl:=y.2 - a:=if EQCAR(op,"QUOTE") then CADR op else op + a:=if EQCAR(op,"QUOTE") then second op else op op:=bfReName a init:=GET(op,"SHOETHETA") bfOpReduce(op,init,body,itl) @@ -406,7 +408,7 @@ bfListReduce(op,y,itl)== 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 + value:=if null value then "NIL" else first value exits:= ["COND",[bfOR exits,["RETURN",value]], ['(QUOTE T),nbody]] loop := ["LOOP",exits,:sucs] @@ -415,10 +417,10 @@ bfLp1(iters,body)== loop bfLp2(extrait,itl,body)== - EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,CDR itl),body) - iters:=cdr itl + EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,rest itl),body) + iters:=rest itl bfLpCross - ([["ITERATORS",extrait,:CDAR iters],:CDR iters],body) + ([["ITERATORS",extrait,:CDAR iters],:rest iters],body) bfOpReduce(op,init,y,itl)== g:=bfGenSymbol() @@ -438,7 +440,7 @@ bfOpReduce(op,init,y,itl)== extrait:= [[[g],[init],[],[],[],[g]]] bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)] else - init:=car init + init:=first init extrait:= [[[g],[init],[],[],[],[g]]] bfLp2(extrait,itl,body) @@ -463,21 +465,22 @@ bfLocal(a,b)== bfTake(n,x)== null x=>x n=0 => nil - cons(car x,bfTake(n-1,cdr x)) + cons(first x,bfTake(n-1,rest x)) bfDrop(n,x)== null x or n=0 =>x - bfDrop(n-1,cdr x) + bfDrop(n-1,rest x) -bfDefSequence l == ['SEQ,: l] +bfDefSequence l == + ['SEQ,: l] bfReturnNoName a == ["RETURN",a] bfSUBLIS(p,e)== - ATOM e=>bfSUBLIS1(p,e) + atom e=>bfSUBLIS1(p,e) EQCAR(e,"QUOTE")=>e - cons(bfSUBLIS(p,car e),bfSUBLIS(p,cdr e)) + cons(bfSUBLIS(p,first e),bfSUBLIS(p,rest e)) +++ Returns e/p, where e is an atom. We assume that the +++ DEFs form a system admitting a fix point; otherwise we may @@ -486,15 +489,15 @@ bfSUBLIS(p,e)== +++ We don't enforce that restriction though. bfSUBLIS1(p,e)== null p =>e - f:=CAR p - EQ(CAR f,e)=> bfSUBLIS(p, CDR f) + f:=first p + EQ(first f,e)=> bfSUBLIS(p, rest f) bfSUBLIS1(cdr p,e) defSheepAndGoats(x)== EQCAR (x,"DEF") => [def,op,args,body]:=x argl:=if bfTupleP args - then cdr args + then rest args else [args] if null argl then @@ -505,20 +508,21 @@ defSheepAndGoats(x)== opassoc:=[[op,:op1]] defstack:=[["DEF",op1,args,body]] [opassoc,defstack,[]] - EQCAR (x,"SEQ") => defSheepAndGoatsList(cdr x) + EQCAR (x,"SEQ") => defSheepAndGoatsList(rest x) [[],[],[x]] defSheepAndGoatsList(x)== if null x then [[],[],[]] else - [opassoc,defs,nondefs] := defSheepAndGoats car x - [opassoc1,defs1,nondefs1] := defSheepAndGoatsList cdr x + [opassoc,defs,nondefs] := defSheepAndGoats first x + [opassoc1,defs1,nondefs1] := defSheepAndGoatsList rest x [append(opassoc,opassoc1),append(defs,defs1), append(nondefs,nondefs1)] --% LET -bfLetForm(lhs,rhs) == ['L%T,lhs,rhs] +bfLetForm(lhs,rhs) == + ['L%T,lhs,rhs] bfLET1(lhs,rhs) == IDENTP lhs => bfLetForm(lhs,rhs) @@ -527,26 +531,26 @@ bfLET1(lhs,rhs) == 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) + if IDENTP first rhs1 then rhs1 := CONS(rhs1,NIL) bfMKPROGN [:rhs1,rhs] - CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := CADR rhs) => + CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := second rhs) => -- handle things like [a] := x := foo - l1 := bfLET1(name,CADDR rhs) + l1 := bfLET1(name,third rhs) l2 := bfLET1(lhs,name) - EQCAR(l2,'PROGN) => bfMKPROGN [l1,:CDR l2] - if IDENTP CAR l2 then l2 := cons(l2,nil) + EQCAR(l2,'PROGN) => bfMKPROGN [l1,:rest l2] + if IDENTP first 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) + EQCAR(let1,'PROGN) => bfMKPROGN [rhs1,:rest let1] + if IDENTP first let1 then let1 := CONS(let1,NIL) bfMKPROGN [rhs1,:let1,g] bfCONTAINED(x,y)== EQ(x,y) => true - ATOM y=> false + atom y=> false bfCONTAINED(x,car y) or bfCONTAINED(x,cdr y) bfLET2(lhs,rhs) == @@ -556,19 +560,19 @@ bfLET2(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) + atom b => [a,b] + CONSP first 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) + if CONSP l1 and atom first 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) + if CONSP l2 and atom first l2 then l2 := cons(l2,nil) APPEND(l1,l2) lhs is ['APPEND,var1,var2] => patrev := bfISReverse(var2,var1) @@ -576,10 +580,10 @@ bfLET2(lhs,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) + if CONSP l2 and atom first 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, + [['L%T,g,rev],:REVERSE rest REVERSE l2, bfLetForm(var1,['NREVERSE,val1])] [['L%T,g,rev],:l2,bfLetForm(var1,['NREVERSE,var1])] lhs is ["EQUAL",var1] => @@ -605,18 +609,18 @@ bfLET(lhs,rhs) == addCARorCDR(acc,expr) == NULL CONSP expr => [acc,expr] acc = 'CAR and EQCAR(expr,'REVERSE) => - ["CAR",["LAST",:CDR expr]] - -- cons('last,CDR expr) + ["CAR",["LAST",:rest expr]] + -- cons('last,rest expr) funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR CDAAR CDDAR CDADR CDDDR) - p := bfPosition(CAR expr,funs) + p := bfPosition(first 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) + if acc = 'CAR then CONS(funsA.p,rest expr) + else CONS(funsR.p,rest expr) bfPosition(x,l) == bfPosn(x,l,0) bfPosn(x,l,n) == @@ -638,21 +642,21 @@ bfIS(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]) + null third x => ['CONS,second x, a] + y := bfISReverse(third x, NIL) + RPLACA(CDDR y,['CONS,second x,a]) y bpSpecificErrorHere '"Error in bfISReverse" bpTrap() bfIS1(lhs,rhs) == - NULL rhs => + null rhs => ['NULL,lhs] STRINGP rhs => ['EQ,lhs,['QUOTE,INTERN rhs]] NUMBERP rhs => ["EQUAL",lhs,rhs] - ATOM rhs => + atom rhs => ['PROGN,bfLetForm(rhs,lhs),''T] rhs is ['QUOTE,a] => IDENTP a => ['EQ,lhs,rhs] @@ -693,7 +697,7 @@ bfIS1(lhs,rhs) == $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) + if CONSP l2 and atom first 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" @@ -701,7 +705,7 @@ bfIS1(lhs,rhs) == bfApplication(bfop, bfarg) == if bfTupleP bfarg - then cons(bfop,CDR bfarg) + then cons(bfop,rest bfarg) else cons(bfop,[bfarg]) @@ -720,7 +724,7 @@ bfApplication(bfop, bfarg) == -- return the meaning of the x in Old Boot. bfGetOldBootName x == - a := GET(x, "OLD-BOOT") => car a + a := GET(x, "OLD-BOOT") => first a x -- returns true if x has same meaning in both Old Boot and New Boot. @@ -730,7 +734,7 @@ bfSameMeaning x == -- returns the meaning of x in the appropriate Boot dialect. bfReName x== newName := - a := GET(x,"SHOERENAME") => car a + a := GET(x,"SHOERENAME") => first a x $translatingOldBoot and not bfSameMeaning x => oldName := bfGetOldBootName x @@ -759,25 +763,25 @@ bfNOT x== ["NOT",x] bfFlatten(op, x) == - EQCAR(x,op) => CDR x + EQCAR(x,op) => rest x [x] bfOR l == null l => NIL - null cdr l => CAR l + null rest l => first l ["OR",:[:bfFlatten("OR",c) for c in l]] bfAND l == null l=> 'T - null cdr l => CAR l + null rest l => first l ["AND",:[:bfFlatten("AND",c) for c in l]] -defQuoteId x== EQCAR(x,"QUOTE") and IDENTP CADR x +defQuoteId x== EQCAR(x,"QUOTE") and IDENTP second x bfSmintable x== INTEGERP x or CONSP x and - MEMQ(CAR x, '(SIZE LENGTH)) + MEMQ(first x, '(SIZE LENGTH)) bfQ(l,r)== if bfSmintable l or bfSmintable r @@ -812,16 +816,16 @@ 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)] + [a,b,c,d]:=bfGargl rest argl + if first argl="&REST" + then [cons(first argl,b),b,c, + cons(["CONS",["QUOTE","LIST"],first d],rest d)] else f:=bfGenSymbol() - [cons(f,a),cons(f,b),cons(car argl,c),cons(f,d)] + [cons(f,a),cons(f,b),cons(first argl,c),cons(f,d)] bfDef1 [defOp,op,args,body] == - argl:=if bfTupleP args then cdr args else [args] + argl:=if bfTupleP args then rest args else [args] [quotes,control,arglp,body]:=bfInsertLet (argl,body) quotes=>shoeLAM(op,arglp,control,body) [[op,["LAMBDA",arglp,body]]] @@ -840,12 +844,14 @@ bfDef(defOp,op,args,body) == bfTuple [:shoeComps bfDef1 d for d in cons([defOp,op,args,body],$wheredefs)] -shoeComps x==[shoeComp def for def in x] +shoeComps x== + [shoeComp def for def in x] + shoeComp x== - a:=shoeCompTran CADR x + a:=shoeCompTran second x if EQCAR(a,"LAMBDA") - then ["DEFUN",CAR x,CADR a,:CDDR a] - else ["DEFMACRO",CAR x,CADR a,:CDDR a] + then ["DEFUN",first x,second a,:CDDR a] + else ["DEFMACRO",first x,second a,:CDDR a] ++ Translate function parameter list to Lisp. @@ -872,8 +878,8 @@ bfInsertLet(x,body)== 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,norq,name1,body1]:= bfInsertLet1 (first x,body) + [b1,norq1,name2,body2]:= bfInsertLet (rest x,body1) [b or b1,cons(norq,norq1),bfParameterList(name1,name2),body2] bfInsertLet1(y,body)== @@ -881,14 +887,14 @@ bfInsertLet1(y,body)== IDENTP y => [false,nil,y,body] y is ["BVQUOTE",b] => [true,"QUOTE",b,body] g:=bfGenSymbol() - ATOM y => [false,nil,g,body] + atom y => [false,nil,g,body] case y of %DefaultValue(p,v) => [false,nil,["&OPTIONAL",[p,v]],body] otherwise => [false,nil,g,bfMKPROGN [bfLET(compFluidize y,g),body]] shoeCompTran x== - lamtype:=CAR x - args :=CADR x + lamtype:=first x + args :=second x body :=CDDR x $fluidVars:local:=nil $locVars:local:=nil @@ -935,18 +941,18 @@ shoeFluids x== if EQCAR(x,"QUOTE") then [] else - if ATOM x + if atom x then nil - else append(shoeFluids car x,shoeFluids cdr x) + else append(shoeFluids first x,shoeFluids rest x) shoeATOMs x== if null x then nil - else if ATOM x + else if atom x then [x] - else append(shoeATOMs car x,shoeATOMs cdr x) + else append(shoeATOMs first x,shoeATOMs rest x) shoeCompTran1 x== - ATOM x=> + atom x=> IDENTP x and bfBeginsDollar x=> $dollarVars:= MEMQ(x,$dollarVars)=>$dollarVars @@ -967,19 +973,19 @@ shoeCompTran1 x== cons(l,$dollarVars) EQCAR(l,"FLUID")=> $fluidVars:= - MEMQ(CADR l,$fluidVars)=>$fluidVars - cons(CADR l,$fluidVars) - RPLACA (CDR x,CADR l) + MEMQ(second l,$fluidVars)=>$fluidVars + cons(second l,$fluidVars) + RPLACA (rest x,second l) MEMQ(U,'(PROG LAMBDA))=> newbindings:=nil - for y in CADR x repeat + for y in second 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 + shoeCompTran1 first x + shoeCompTran1 rest x bfTagged(a,b)== null $op => Signature(a,b) -- surely a toplevel decl @@ -992,12 +998,12 @@ bfTagged(a,b)== ["THE",b,a] bfAssign(l,r)== - if bfTupleP l then bfSetelt(CADR l,CDDR l ,r) else bfLET(l,r) + if bfTupleP l then bfSetelt(second l,CDDR l ,r) else bfLET(l,r) bfSetelt(e,l,r)== - if null cdr l + if null rest l then defSETELT(e,car l,r) - else bfSetelt(bfElt(e,car l),cdr l,r) + else bfSetelt(bfElt(e,first l),rest l,r) bfElt(expr,sel)== y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION") @@ -1014,30 +1020,31 @@ defSETELT(var,sel,expr)== ["SETF",["ELT",var,sel],expr] bfIfThenOnly(a,b)== - b1:=if EQCAR (b,"PROGN") then CDR b else [b] + b1:=if EQCAR (b,"PROGN") then rest 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] + b1:=if EQCAR (b,"PROGN") then rest b else [b] + EQCAR (c,"COND") => ["COND",[a,:b1],:rest c] + c1:=if EQCAR (c,"PROGN") then rest c else [c] ["COND",[a,:b1],['(QUOTE T),:c1]] -bfExit(a,b)== ["COND",[a,["IDENTITY",b]]] +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 + null rest a=> first a ["PROGN",:a] bfFlattenSeq x == null x=>NIL - f:=CAR x - ATOM f =>if CDR x then nil else [f] + f:=first x + atom f =>if rest x then nil else [f] EQCAR(f,"PROGN") => - CDR x=> [i for i in CDR f| not ATOM i] - CDR f + rest x=> [i for i in rest f| not atom i] + rest f [f] bfSequence l == @@ -1051,7 +1058,7 @@ bfSequence l == null rest l => f:=first l if EQCAR(f,"PROGN") - then bfSequence CDR f + then bfSequence rest f else f bfMKPROGN [first l,bfSequence rest l] null aft => ["COND",:transform] @@ -1070,7 +1077,8 @@ bfWhere (context,expr)== -- null exp => nil -- cons(exp,shoeReadLispString(s,ind)) -bfReadLisp string==bfTuple shoeReadLispString (string,0) +bfReadLisp string == + bfTuple shoeReadLispString (string,0) bfCompHash(op,argl,body) == auxfn:= INTERN CONCAT (PNAME op,'";") @@ -1119,7 +1127,7 @@ bfNameOnly x== bfNameArgs: (%Thing,%Thing) -> %List bfNameArgs (x,y)== - y:=if EQCAR(y,"TUPLE") then CDR y else [y] + y:=if EQCAR(y,"TUPLE") then rest y else [y] cons(x,y) bfStruct: (%Thing,%List) -> %List @@ -1128,13 +1136,13 @@ bfStruct(name,arglist)== bfCreateDef: %Thing -> %List bfCreateDef x== - if null cdr x + if null rest x then - f:=car x + f:=first x ["DEFCONSTANT",f,["LIST",["QUOTE",f]]] else - a:=[bfGenSymbol() for i in cdr x] - ["DEFUN",car x,a,["CONS",["QUOTE",car x],["LIST",:a]]] + a:=[bfGenSymbol() for i in rest x] + ["DEFUN",first x,a,["CONS",["QUOTE",first x],["LIST",:a]]] bfCaseItem: (%Thing,%Thing) -> %List bfCaseItem(x,y) == @@ -1155,12 +1163,12 @@ bfCaseItems(g,x) == bfCI: (%Thing,%Thing,%Thing) -> %List bfCI(g,x,y)== - a:=cdr x + a:=rest x if null a - then [car x,y] + then [first x,y] else b:=[[i,bfCARCDR(j,g)] for i in a for j in 0..] - [car x,["LET",b,y]] + [first x,["LET",b,y]] bfCARCDR: (%Short,%Thing) -> %List bfCARCDR(n,g) == |