diff options
| -rw-r--r-- | src/boot/ast.boot | 487 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 77 | ||||
| -rw-r--r-- | src/boot/strap/parser.clisp | 2 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 14 |
4 files changed, 294 insertions, 286 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index f455cc3b..e8973230 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -223,16 +223,16 @@ bfTupleIf x== bfTuple x bfTupleConstruct b == - a:= if bfTupleP b - then cdr b - else [b] + a := + bfTupleP b => rest b + [b] or/[x is ["COLON",.] for x in a] => bfMakeCons a ["LIST",:a] bfConstruct b == - a:= if bfTupleP b - then cdr b - else [b] + a := + bfTupleP b => rest b + [b] bfMakeCons a bfMakeCons l == @@ -248,9 +248,13 @@ bfFor(bflhs,U,step) == 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 second lhs else lhs + whole := + bfTupleP whole => bfMakeCons rest whole + whole + atom lhs => bfINON [OP,lhs,whole] + lhs := + bfTupleP lhs => second lhs + lhs lhs is ["L%T",:.] => G:=second lhs [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,third lhs)] @@ -259,46 +263,46 @@ bfForTree(OP,lhs,whole)== 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,[]]] + initvar := [id] + initval := [fst] + inc := + atom step => step + g1 := bfGenSymbol() + initvar := cons(g1,initvar) + initval := cons(step,initval) + g1 + final := + atom lst => lst + g2 := bfGenSymbol() + initvar := cons(g2,initvar) + initval := cons(lst,initval) + g2 + ex := + null lst=> [] + INTEGERP inc => + pred := + MINUSP inc => "<" + ">" + [[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 + [op,id,whole] := x op = "ON" => bfON(id,whole) 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]]],[]]] + 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]],[]]] + [[[x],[E],[['SETQ,x,['CDR, x]]],[], + [['ATOM,x]],[]]] bfSuchthat p== [[[],[],[],[p],[],[]]] @@ -327,7 +331,9 @@ bfSep(iters)== [append(i,j) for i in f for j in r] bfReduce(op,y)== - a :=if op is ["QUOTE",:.] then second op else op + a := + op is ["QUOTE",:.] => second op + op op := bfReName a init := GET(a,"SHOETHETA") or GET(op,"SHOETHETA") g := bfGenSymbol() @@ -347,7 +353,9 @@ bfReduceCollect(op,y)== y is ["COLLECT",:.] => body := y.1 itl := y.2 - a := if op is ["QUOTE",:.] then second op else op + a := + op is ["QUOTE",:.] => second op + op op := bfReName a init := GET(a, "SHOETHETA") or GET(op,"SHOETHETA") bfOpReduce(op,init,body,itl) @@ -386,8 +394,12 @@ 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 first value + nbody := + null filters => body + bfAND [:filters,body] + value := + null value => "NIL" + first value exits := ["COND",[bfOR exits,["RETURN",value]],['T,nbody]] loop := ["LOOP",exits,:sucs] if vars then loop := @@ -461,25 +473,23 @@ bfSUBLIS(p,e)== +++ We don't enforce that restriction though. bfSUBLIS1(p,e)== null p =>e - f:=first p - EQ(first f,e)=> bfSUBLIS(p, rest f) + f := first p + EQ(first f,e) => bfSUBLIS(p, rest f) bfSUBLIS1(cdr p,e) defSheepAndGoats(x)== case x of %Definition(op,args,body) => - argl:=if bfTupleP args - then rest args - else [args] - if null argl - then - opassoc:=[[op,:body]] + argl := + bfTupleP args => rest args + [args] + null argl => + opassoc := [[op,:body]] [opassoc,[],[]] - else - op1:=INTERN CONCAT(PNAME $op,'",",PNAME op) - opassoc:=[[op,:op1]] - defstack:=[[op1,args,body]] - [opassoc,defstack,[]] + op1 := INTERN CONCAT(PNAME $op,'",",PNAME op) + opassoc := [[op,:op1]] + defstack := [[op1,args,body]] + [opassoc,defstack,[]] %Pile defs => defSheepAndGoatsList defs otherwise => [[],[],[x]] @@ -495,11 +505,11 @@ bfLetForm(lhs,rhs) == ['L%T,lhs,rhs] bfLET1(lhs,rhs) == - IDENTP lhs => bfLetForm(lhs,rhs) + IDENTP lhs => bfLetForm(lhs,rhs) lhs is ['FLUID,.] => bfLetForm(lhs,rhs) IDENTP rhs and not bfCONTAINED(rhs,lhs) => rhs1 := bfLET2(lhs,rhs) - rhs1 is ["L%T",:.] => bfMKPROGN [rhs1,rhs] + rhs1 is ["L%T",:.] => bfMKPROGN [rhs1,rhs] rhs1 is ["PROGN",:.] => APPEND(rhs1,[rhs]) if IDENTP first rhs1 then rhs1 := CONS(rhs1,NIL) bfMKPROGN [:rhs1,rhs] @@ -556,8 +566,7 @@ bfLET2(lhs,rhs) == [['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] => - ['COND,[["EQUAL",var1,rhs],var1]] + lhs is ["EQUAL",var1] => ['COND,[bfQ(var1,rhs),var1]] -- The original expression may be one that involves literals as -- sub-patterns, e.g. -- ['SEQ, :l, ['exit, 1, x]] := item @@ -588,21 +597,21 @@ addCARorCDR(acc,expr) == 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,rest expr) - else CONS(funsR.p,rest expr) + acc = 'CAR => CONS(funsA.p,rest expr) + CONS(funsR.p,rest 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) + null l => -1 + x=first l => n + bfPosn(x,rest l,n+1) --% IS bfISApplication(op,left,right)== - op = "IS" => bfIS(left,right) - op = "ISNT" => bfNOT bfIS(left,right) - [op ,left,right] + op = "IS" => bfIS(left,right) + op = "ISNT" => bfNOT bfIS(left,right) + [op ,left,right] bfIS(left,right)== $isGenVarCounter:local :=1 @@ -636,17 +645,11 @@ bfIS1(lhs,rhs) == 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],['NULL,['CDR,lhs]]] + 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)] + bfAND [['CONSP,lhs],['NULL,['CDR,lhs]],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] => @@ -690,26 +693,25 @@ bfNOT x== ["NOT",x] bfFlatten(op, x) == - x is [=op,:.] => rest x - [x] + x is [=op,:.] => rest x + [x] bfOR l == - null l => NIL - null rest l => first l - ["OR",:[:bfFlatten("OR",c) for c in l]] + null l => NIL + null rest l => first l + ["OR",:[:bfFlatten("OR",c) for c in l]] bfAND l == - null l=> 'T - null rest l => first l - ["AND",:[:bfFlatten("AND",c) for c in l]] + null l=> 'T + null rest l => first l + ["AND",:[:bfFlatten("AND",c) for c in l]] defQuoteId x== x is ["QUOTE",:.] and IDENTP second x bfSmintable x== - INTEGERP x or CONSP x and - first x in '(SIZE LENGTH char) + INTEGERP x or CONSP x and first x in '(SIZE LENGTH char) bfQ(l,r)== bfSmintable l or bfSmintable r => ["EQL",l,r] @@ -725,7 +727,9 @@ bfLessp(l,r)== ["<",l,r] bfMDef (op,args,body) == - argl:=if bfTupleP args then cdr args else [args] + argl := + bfTupleP args => rest args + [args] [gargl,sgargl,nargl,largl]:=bfGargl argl sb:=[cons(i,j) for i in nargl for j in sgargl] body:= SUBLIS(sb,body) @@ -736,21 +740,20 @@ bfMDef (op,args,body) == [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]] bfGargl argl== - if null argl - then [[],[],[],[]] - else - [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(first argl,c),cons(f,d)] + null argl => [[],[],[],[]] + [a,b,c,d] := bfGargl rest argl + first argl="&REST" => + [cons(first argl,b),b,c, + cons(["CONS",["QUOTE","LIST"],first d],rest d)] + f := bfGenSymbol() + [cons(f,a),cons(f,b),cons(first argl,c),cons(f,d)] bfDef1 [op,args,body] == - argl:=if bfTupleP args then rest args else [args] + argl := + bfTupleP args => rest args + [args] [quotes,control,arglp,body]:=bfInsertLet (argl,body) - quotes=>shoeLAM(op,arglp,control,body) + quotes => shoeLAM(op,arglp,control,body) [[op,["LAMBDA",arglp,body]]] shoeLAM (op,args,control,body)== @@ -762,8 +765,8 @@ shoeLAM (op,args,control,body)== bfDef(op,args,body) == $bfClamming => - [.,op1,arg1,:body1]:=shoeComp first bfDef1 [op,args,body] - bfCompHash(op1,arg1,body1) + [.,op1,arg1,:body1] := shoeComp first bfDef1 [op,args,body] + bfCompHash(op1,arg1,body1) bfTuple [:shoeComps bfDef1 d for d in cons([op,args,body],$wheredefs)] @@ -771,9 +774,9 @@ shoeComps x== [shoeComp def for def in x] shoeComp x== - a:=shoeCompTran second x - a is ["LAMBDA",:.] => ["DEFUN",first x,second a,:CDDR a] - ["DEFMACRO",first x,second a,:CDDR a] + a:=shoeCompTran second x + a is ["LAMBDA",:.] => ["DEFUN",first x,second a,:CDDR a] + ["DEFMACRO",first x,second a,:CDDR a] ++ Translate function parameter list to Lisp. @@ -792,54 +795,51 @@ bfParameterList(p1,p2) == [p1,:p2] 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 (first x,body) - [b1,norq1,name2,body2]:= bfInsertLet (rest x,body1) - [b or b1,cons(norq,norq1),bfParameterList(name1,name2),body2] + null x => [false,nil,x,body] + x is ["&REST",a] => + a is ["QUOTE",b] => [true,"QUOTE",["&REST",b],body] + [false,nil,x,body] + [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)== - y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]] - IDENTP y => [false,nil,y,body] - y is ["BVQUOTE",b] => [true,"QUOTE",b,body] - g:=bfGenSymbol() - 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]] + y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]] + IDENTP y => [false,nil,y,body] + y is ["BVQUOTE",b] => [true,"QUOTE",b,body] + g:=bfGenSymbol() + 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:=first x - args :=second x - body :=CDDR x - $fluidVars:local:=nil - $locVars:local:=nil - $dollarVars:local:=nil - shoeCompTran1 body - $locVars:=SETDIFFERENCE(SETDIFFERENCE($locVars, - $fluidVars),shoeATOMs args) - body:= - lvars:=append($fluidVars,$locVars) - $fluidVars:=UNION($fluidVars,$dollarVars) - body' := body - if $typings then body' := [["DECLARE",:$typings],:body'] - if $fluidVars then - fvars:=["DECLARE",["SPECIAL",:$fluidVars]] - body' := [fvars,:body'] - if lvars or needsPROG body then shoePROG(lvars,body') else body' - fl:=shoeFluids args - body:=if fl - then - fvs:=["DECLARE",["SPECIAL",:fl]] - cons(fvs,body) - else body - [lamtype,args, :body] + lamtype:=first x + args :=second x + body :=CDDR x + $fluidVars:local:=nil + $locVars:local:=nil + $dollarVars:local:=nil + shoeCompTran1 body + $locVars:=SETDIFFERENCE(SETDIFFERENCE($locVars, + $fluidVars),shoeATOMs args) + body:= + lvars:=append($fluidVars,$locVars) + $fluidVars:=UNION($fluidVars,$dollarVars) + body' := body + if $typings then body' := [["DECLARE",:$typings],:body'] + if $fluidVars then + fvars:=["DECLARE",["SPECIAL",:$fluidVars]] + body' := [fvars,:body'] + lvars or needsPROG body => shoePROG(lvars,body') + body' + fl := shoeFluids args + body := + fl => + fvs:=["DECLARE",["SPECIAL",:fl]] + cons(fvs,body) + body + [lamtype,args, :body] needsPROG body == atom body => false @@ -850,9 +850,9 @@ needsPROG body == false shoePROG(v,b)== - null b => [["PROG", v]] - [:blist,blast] := b - [["PROG",v,:blist,["RETURN", blast]]] + null b => [["PROG", v]] + [:blist,blast] := b + [["PROG",v,:blist,["RETURN", blast]]] shoeFluids x== null x => nil @@ -878,40 +878,40 @@ isDynamicVariable x == false shoeCompTran1 x== - atom x=> - isDynamicVariable x => - $dollarVars:= - MEMQ(x,$dollarVars)=>$dollarVars - cons(x,$dollarVars) - nil - U:=car x - 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) - l is ["FLUID",:.] => - $fluidVars:= - MEMQ(second l,$fluidVars)=>$fluidVars - cons(second l,$fluidVars) - RPLACA (rest x,second l) - MEMQ(U,'(PROG LAMBDA))=> - newbindings:=nil - 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 first x - shoeCompTran1 rest x + atom x=> + isDynamicVariable x => + $dollarVars:= + MEMQ(x,$dollarVars)=>$dollarVars + cons(x,$dollarVars) + nil + U:=car x + 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) + l is ["FLUID",:.] => + $fluidVars:= + MEMQ(second l,$fluidVars)=>$fluidVars + cons(second l,$fluidVars) + RPLACA (rest x,second l) + MEMQ(U,'(PROG LAMBDA))=> + newbindings:=nil + 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 first x + shoeCompTran1 rest x bfTagged(a,b)== null $op => %Signature(a,b) -- surely a toplevel decl @@ -932,46 +932,54 @@ bfSetelt(e,l,r)== bfSetelt(bfElt(e,first l),rest l,r) bfElt(expr,sel)== - y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION") - y=> - INTEGERP y => ["ELT",expr,y] - [y,expr] - ["ELT",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] + 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 b is ["PROGN",:.] then rest b else [b] - ["COND",[a,:b1]] + b1 := + b is ["PROGN",:.] => rest b + [b] + ["COND",[a,:b1]] bfIf(a,b,c)== - b1:=if b is ["PROGN",:.] then rest b else [b] - c is ["COND",:.] => ["COND",[a,:b1],:rest c] - c1:=if c is ["PROGN",:.] then rest c else [c] - ["COND",[a,:b1],['T,:c1]] + b1 := + b is ["PROGN",:.] => rest b + [b] + c is ["COND",:.] => ["COND",[a,:b1],:rest c] + c1 := + c is ["PROGN",:.] => rest c + [c] + ["COND",[a,:b1],['T,:c1]] bfExit(a,b)== ["COND",[a,["IDENTITY",b]]] bfMKPROGN l== - a:=[:bfFlattenSeq c for c in tails l] - null a=> nil - null rest a=> first a - ["PROGN",:a] + a := [:bfFlattenSeq c for c in tails l] + null a => nil + null rest a => first a + ["PROGN",:a] bfFlattenSeq x == - null x=>NIL - f:=first x - atom f =>if rest x then nil else [f] - f is ["PROGN",:.] => - rest x=> [i for i in rest f| not atom i] - rest f - [f] + null x => NIL + f := first x + atom f => + rest x => nil + [f] + f is ["PROGN",:.] => + rest x => [i for i in rest f| not atom i] + rest f + [f] ++ The body of each branch of a COND form is an implicit PROGN. ++ For readability purpose, we want to refrain from including @@ -986,19 +994,19 @@ bfAlternative(a,b) == [a,:bfWashCONDBranchBody b] bfSequence l == - null l=> NIL - transform:= [bfAlternative(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 => - l is [f] => - f is ["PROGN",:.] => bfSequence rest f - f - bfMKPROGN [first l,bfSequence rest l] - null aft => ["COND",:transform] - ["COND",:transform,bfAlternative('T,bfSequence aft)] + null l => NIL + transform := [bfAlternative(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 => + l is [f] => + f is ["PROGN",:.] => bfSequence rest f + f + bfMKPROGN [first l,bfSequence rest l] + null aft => ["COND",:transform] + ["COND",:transform,bfAlternative('T,bfSequence aft)] bfWhere (context,expr)== [opassoc,defs,nondefs] := defSheepAndGoats context @@ -1059,8 +1067,10 @@ bfNameOnly x== bfNameArgs: (%Thing,%Thing) -> %List bfNameArgs (x,y)== - y:=if y is ["TUPLE",:.] then rest y else [y] - cons(x,y) + y := + y is ["TUPLE",:.] => rest y + [y] + cons(x,y) bfCreateDef: %Thing -> %List bfCreateDef x== @@ -1090,21 +1100,20 @@ bfCaseItems(g,x) == bfCI: (%Thing,%Thing,%Thing) -> %List bfCI(g,x,y)== - a:=rest x - if null a - then [first x,y] - else - b:=[[i,bfCARCDR(j,g)] for i in a for j in 1.. | i ~= "DOT"] - null b => [first x,y] - [first x,["LET",b,y]] + a := rest x + null a => [first x,y] + b := [[i,bfCARCDR(j,g)] for i in a for j in 1.. | i ~= "DOT"] + null b => [first x,y] + [first x,["LET",b,y]] bfCARCDR: (%Short,%Thing) -> %List bfCARCDR(n,g) == [INTERN CONCAT ('"CA",bfDs n,'"R"),g] bfDs: %Short -> %String -bfDs n== - if n=0 then '"" else CONCAT('"D",bfDs(n-1)) +bfDs n == + n = 0 => '"" + CONCAT('"D",bfDs(n-1)) ++ Generate code for try-catch expressions. diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index cf2067e7..0c52e92b 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -256,7 +256,7 @@ (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) - (EQ (CDR |ISTMP#1|) NIL))))) + (NULL (CDR |ISTMP#1|)))))) (COND (|bfVar#80| (RETURN |bfVar#80|)))))) (SETQ |bfVar#79| (CDR |bfVar#79|)))) (|bfMakeCons| |a|)) @@ -280,7 +280,7 @@ (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) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |a| (CAR |ISTMP#2|)) T)))))) (SETQ |l1| (CDR |l|)) (COND (|l1| (LIST 'APPEND |a| (|bfMakeCons| |l1|))) (T |a|))) @@ -482,7 +482,7 @@ ((AND (CONSP |y|) (EQ (CAR |y|) 'COLON) (PROGN (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) (|bf0APPEND| |a| |itl|)) ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) @@ -710,7 +710,7 @@ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)))) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) (|bfLetForm| |lhs| |rhs|)) ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) @@ -763,7 +763,7 @@ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)))) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) (|bfLetForm| |lhs| |rhs|)) ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T) (PROGN @@ -772,7 +772,7 @@ (PROGN (SETQ |a| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) (SETQ |a| (|bfLET2| |a| |rhs|)) (COND @@ -787,7 +787,7 @@ (PROGN (SETQ |var1| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) (COND ((OR (EQ |var1| 'DOT) @@ -819,7 +819,7 @@ (PROGN (SETQ |var1| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |var2| (CAR |ISTMP#2|)) T)))))) (SETQ |patrev| (|bfISReverse| |var2| |var1|)) (SETQ |rev| (LIST 'REVERSE |rhs|)) @@ -843,7 +843,7 @@ (PROGN (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) - (EQ (CDR |ISTMP#3|) NIL) + (NULL (CDR |ISTMP#3|)) (PROGN (SETQ |val1| (CAR |ISTMP#3|)) T))))))) @@ -860,9 +860,9 @@ ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'EQUAL) (PROGN (SETQ |ISTMP#1| (CDR |lhs|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |var1| (CAR |ISTMP#1|)) T)))) - (LIST 'COND (LIST (LIST 'EQUAL |var1| |rhs|) |var1|))) + (LIST 'COND (LIST (|bfQ| |var1| |rhs|) |var1|))) (T (SETQ |isPred| (COND (|$inDefIS| (|bfIS1| |rhs| |lhs|)) @@ -947,7 +947,7 @@ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'QUOTE) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) (COND ((IDENTP |a|) (LIST 'EQ |lhs| |rhs|)) @@ -959,7 +959,7 @@ (PROGN (SETQ |c| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |d| (CAR |ISTMP#2|)) T)))))) (SETQ |l| (|bfLET| |c| |lhs|)) (|bfAND| (LIST (|bfIS1| |lhs| |d|) @@ -967,7 +967,7 @@ ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'EQUAL) (PROGN (SETQ |ISTMP#1| (CDR |rhs|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) (|bfQ| |lhs| |a|)) ((CONSP |lhs|) @@ -983,19 +983,19 @@ (PROGN (SETQ |a| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) (COND ((EQ |a| 'DOT) (COND ((NULL |b|) (|bfAND| (LIST (LIST 'CONSP |lhs|) - (LIST 'EQ (LIST 'CDR |lhs|) 'NIL)))) + (LIST 'NULL (LIST 'CDR |lhs|))))) (T (|bfAND| (LIST (LIST 'CONSP |lhs|) (|bfIS1| (LIST 'CDR |lhs|) |b|)))))) ((NULL |b|) (|bfAND| (LIST (LIST 'CONSP |lhs|) - (LIST 'EQ (LIST 'CDR |lhs|) 'NIL) + (LIST 'NULL (LIST 'CDR |lhs|)) (|bfIS1| (LIST 'CAR |lhs|) |a|)))) ((EQ |b| 'DOT) (|bfAND| (LIST (LIST 'CONSP |lhs|) @@ -1011,7 +1011,7 @@ (SETQ |c| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (EQ (CAR |ISTMP#2|) 'T))))) (CONSP |b1|) (EQ (CAR |b1|) 'PROGN)) (SETQ |cls| (CDR |b1|)) @@ -1025,7 +1025,7 @@ (PROGN (SETQ |a| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |b| (CAR |ISTMP#2|)) T)))))) (SETQ |patrev| (|bfISReverse| |b| |a|)) (SETQ |g| @@ -1084,13 +1084,13 @@ ((AND (CONSP |x|) (EQ (CAR |x|) 'NOT) (PROGN (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) |a|) ((AND (CONSP |x|) (EQ (CAR |x|) 'NULL) (PROGN (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) |a|) (T (LIST 'NOT |x|)))))) @@ -1339,13 +1339,13 @@ ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) (PROGN (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |a| (CAR |ISTMP#1|)) T)))) (COND ((AND (CONSP |a|) (EQ (CAR |a|) 'QUOTE) (PROGN (SETQ |ISTMP#1| (CDR |a|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) (LIST T 'QUOTE (LIST '&REST |b|) |body|)) (T (LIST NIL NIL |x| |body|)))) @@ -1371,7 +1371,7 @@ (PROGN (SETQ |l| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) (LIST NIL NIL |l| (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|)))) @@ -1379,7 +1379,7 @@ ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE) (PROGN (SETQ |ISTMP#1| (CDR |y|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |b| (CAR |ISTMP#1|)) T)))) (LIST T 'QUOTE |b| |body|)) (T (SETQ |g| (|bfGenSymbol|)) @@ -1526,7 +1526,7 @@ (SETQ |l| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))) (RPLACA |x| 'SETQ) (|shoeCompTran1| |r|) (COND @@ -1729,7 +1729,7 @@ (SETQ |stmt| (CAR |ISTMP#4|)) (SETQ |ISTMP#5| (CDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) - (EQ (CDR |ISTMP#5|) NIL) + (NULL (CDR |ISTMP#5|)) (EQ (CAR |ISTMP#5|) 'T))))))) (PROGN (SETQ |conds| (CDR |ISTMP#2|)) T) (PROGN (SETQ |conds| (NREVERSE |conds|)) T)))) @@ -1753,7 +1753,7 @@ (PROGN (SETQ |ISTMP#1| (CDR |x|)) (AND (CONSP |ISTMP#1|) - (EQ (CDR |ISTMP#1|) NIL) + (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |ISTMP#2| (CAR |ISTMP#1|)) @@ -1764,7 +1764,7 @@ (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) - (EQ (CDR |ISTMP#3|) NIL) + (NULL (CDR |ISTMP#3|)) (PROGN (SETQ |ISTMP#4| (CAR |ISTMP#3|)) @@ -1776,9 +1776,8 @@ (CDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) - (EQ - (CDR |ISTMP#5|) - NIL) + (NULL + (CDR |ISTMP#5|)) (PROGN (SETQ |b| (CAR |ISTMP#5|)) @@ -1794,7 +1793,7 @@ (COND ((NULL |before|) (COND - ((AND (CONSP |l|) (EQ (CDR |l|) NIL)) + ((AND (CONSP |l|) (NULL (CDR |l|))) (SETQ |f| (CAR |l|)) (COND ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) @@ -1910,7 +1909,7 @@ (PROG (|a| |f|) (RETURN (COND - ((AND (CONSP |x|) (EQ (CDR |x|) NIL)) (SETQ |f| (CAR |x|)) + ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) (T (SETQ |a| (LET ((|bfVar#117| NIL) (|bfVar#116| (CDR |x|)) @@ -1959,7 +1958,7 @@ (PROGN (SETQ |i| (CAR |bfVar#118|)) (SETQ |ISTMP#1| (CDR |bfVar#118|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |j| (CAR |ISTMP#1|)) T))) (SETQ |bfVar#120| (CONS (|bfCI| |g| |i| |j|) |bfVar#120|))))) @@ -2352,7 +2351,7 @@ ((AND (CONSP |x|) (PROGN (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |ISTMP#2| (CAR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) @@ -2360,7 +2359,7 @@ (PROGN (SETQ |ISTMP#3| (CDR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) - (EQ (CDR |ISTMP#3|) NIL)))))))) + (NULL (CDR |ISTMP#3|))))))))) '|fixnum|) (T "object"))))) @@ -2779,7 +2778,7 @@ (SETQ |op'| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |m| (CAR |ISTMP#2|)) T))))))) (|coreError| "invalid signature")) ((NOT (AND (CONSP |m|) (EQ (CAR |m|) '|%Mapping|) @@ -2790,7 +2789,7 @@ (SETQ |t| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |s| (CAR |ISTMP#2|)) T))))))) (|coreError| "invalid function type")) (T (COND diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 39316f4e..716b86d1 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -1150,7 +1150,7 @@ (SETQ |l| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))) (IDENTP |l|)) (COND diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index bb464915..d7fb9f62 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -525,7 +525,7 @@ (PROGN (SETQ |valType| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) (EQ (CDR |ISTMP#2|) NIL) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |argTypes| (CAR |ISTMP#2|)) T)))))) @@ -637,7 +637,7 @@ (SETQ |n| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |t| (CAR |ISTMP#2|)) T)))))) @@ -660,7 +660,7 @@ (SETQ |n| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |t| (CAR |ISTMP#2|)) T)))))) @@ -849,7 +849,7 @@ (PROGN (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |ISTMP#3| (CAR |ISTMP#2|)) (AND (CONSP |ISTMP#3|) @@ -863,7 +863,7 @@ (SETQ |ISTMP#5| (CDR |ISTMP#4|)) (AND (CONSP |ISTMP#5|) - (EQ (CDR |ISTMP#5|) NIL) + (NULL (CDR |ISTMP#5|)) (PROGN (SETQ |exp| (CAR |ISTMP#5|)) @@ -877,7 +877,7 @@ (SETQ |id| (CAR |ISTMP#1|)) (SETQ |ISTMP#2| (CDR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) - (EQ (CDR |ISTMP#2|) NIL) + (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |exp| (CAR |ISTMP#2|)) T)))))) @@ -980,7 +980,7 @@ ((AND (CONSP |x|) (EQ (CAR |x|) '&REST) (PROGN (SETQ |ISTMP#1| (CDR |x|)) - (AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) (PROGN (SETQ |y| (CAR |ISTMP#1|)) T)))) (LIST |y|)) (T (CONS (CAR |x|) (|unfluidlist| (CDR |x|)))))))) |