diff options
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/boot/ast.boot | 118 | ||||
| -rw-r--r-- | src/boot/includer.boot | 24 | ||||
| -rw-r--r-- | src/boot/parser.boot | 16 | ||||
| -rw-r--r-- | src/boot/pile.boot | 14 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 36 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 8 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 3 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 2 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 24 | ||||
| -rw-r--r-- | src/boot/translator.boot | 18 |
12 files changed, 142 insertions, 135 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 2add1045..c2f2568b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,15 @@ 2010-05-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot: Miscellaneous cleanup. + * boot/includer.boot: Likewise. + * boot/parser.boot: Likewise. + * boot/pile.boot: Likewise. + * boot/scanner.boot: Likewise. + * boot/tokens.boot: Likewise. + * boot/translator.boot: Likewise. + +2010-05-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot: Translate assignment to head and tail of a list. Remove explicit uses of RPLACA and RPLACD. * boot/includer.boot: Likewise. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 97bd8e92..03a98b03 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -189,7 +189,7 @@ bfAppend x== bfColonAppend: (%List,%Thing) -> %List bfColonAppend(x,y) == - null x => + x = nil => y is ["BVQUOTE",:a] => ["&REST",["QUOTE",:a]] ["&REST",y] cons(first x,bfColonAppend(rest x,y)) @@ -236,7 +236,7 @@ bfConstruct b == bfMakeCons a bfMakeCons l == - null l => NIL + l = nil => nil l is [["COLON",a],:l1] => l1 => ['APPEND,a,bfMakeCons l1] a @@ -278,7 +278,7 @@ bfSTEP(id,fst,step,lst)== initval := cons(lst,initval) g2 ex := - null lst=> [] + lst = nil => [] integer? inc => pred := MINUSP inc => "<" @@ -321,11 +321,11 @@ bfLp(iters,body)== bfLpCross(rest iters,body) bfLpCross(iters,body)== - null rest iters => bfLp(first iters,body) + rest iters = nil => bfLp(first iters,body) bfLp(first iters,bfLpCross(rest iters,body)) bfSep(iters)== - null iters => [[],[],[],[],[],[]] + iters = nil => [[],[],[],[],[],[]] f := first iters r := bfSep rest iters [append(i,j) for i in f for j in r] @@ -339,7 +339,7 @@ bfReduce(op,y)== g := bfGenSymbol() g1 := bfGenSymbol() body := ['SETQ,g,[op,g,g1]] - null init => + init = nil => g2 := bfGenSymbol() init := ['CAR,g2] ny := ['CDR,g2] @@ -395,10 +395,10 @@ bfListReduce(op,y,itl)== bfLp1(iters,body)== [vars,inits,sucs,filters,exits,value] := bfSep bfAppend iters nbody := - null filters => body + filters = nil => body bfAND [:filters,body] value := - null value => "NIL" + value = nil => "NIL" first value exits := ["COND",[bfOR exits,["RETURN",value]],['T,nbody]] loop := ["LOOP",exits,:sucs] @@ -418,7 +418,7 @@ bfOpReduce(op,init,y,itl)== bfMKPROGN [["SETQ",g,y], ['COND, [['NOT,g],['RETURN,'NIL]]]] op = "OR" => bfMKPROGN [["SETQ",g,y], ['COND, [g,['RETURN,g]]]] ['SETQ,g,[op,g,y]] - null init => + init = nil => g1 := bfGenSymbol() init := ['CAR,g1] y := ['CDR,g1] -- ??? bogus self-assignment/initialization @@ -450,12 +450,12 @@ bfLocal(a,b)== a bfTake(n,x)== - null x=>x + x = nil => x n=0 => nil cons(first x,bfTake(n-1,rest x)) bfDrop(n,x)== - null x or n=0 =>x + x = nil or n = 0 => x bfDrop(n-1,rest x) bfReturnNoName a == @@ -472,7 +472,7 @@ bfSUBLIS(p,e)== +++ are recursive -- which they are not supposed to be. +++ We don't enforce that restriction though. bfSUBLIS1(p,e)== - null p =>e + p = nil => e f := first p EQ(first f,e) => bfSUBLIS(p, rest f) bfSUBLIS1(cdr p,e) @@ -483,7 +483,7 @@ defSheepAndGoats(x)== argl := bfTupleP args => rest args [args] - null argl => + argl = nil => opassoc := [[op,:body]] [opassoc,[],[]] op1 := INTERN CONCAT(PNAME $op,'",",PNAME op) @@ -494,7 +494,7 @@ defSheepAndGoats(x)== otherwise => [[],[],[x]] defSheepAndGoatsList(x)== - null x => [[],[],[]] + x = nil => [[],[],[]] [opassoc,defs,nondefs] := defSheepAndGoats first x [opassoc1,defs1,nondefs1] := defSheepAndGoatsList rest x [append(opassoc,opassoc1),append(defs,defs1), append(nondefs,nondefs1)] @@ -511,7 +511,7 @@ bfLET1(lhs,rhs) == rhs1 := bfLET2(lhs,rhs) rhs1 is ["L%T",:.] => bfMKPROGN [rhs1,rhs] rhs1 is ["PROGN",:.] => APPEND(rhs1,[rhs]) - if IDENTP first rhs1 then rhs1 := CONS(rhs1,NIL) + if IDENTP first rhs1 then rhs1 := CONS(rhs1,nil) bfMKPROGN [:rhs1,rhs] rhs is ["L%T",:.] and IDENTP(name := second rhs) => -- handle things like [a] := x := foo @@ -525,7 +525,7 @@ bfLET1(lhs,rhs) == rhs1 := ['L%T,g,rhs] let1 := bfLET1(lhs,g) let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1] - if IDENTP first let1 then let1 := CONS(let1,NIL) + if IDENTP first let1 then let1 := CONS(let1,nil) bfMKPROGN [rhs1,:let1,g] bfCONTAINED(x,y)== @@ -535,11 +535,11 @@ bfCONTAINED(x,y)== bfLET2(lhs,rhs) == IDENTP lhs => bfLetForm(lhs,rhs) - NULL lhs => NIL + lhs = nil => nil lhs is ['FLUID,.] => bfLetForm(lhs,rhs) lhs is ['L%T,a,b] => a := bfLET2(a,rhs) - null (b := bfLET2(b,rhs)) => a + (b := bfLET2(b,rhs)) = nil => a atom b => [a,b] cons? first b => CONS(a,b) [a,b] @@ -547,7 +547,7 @@ bfLET2(lhs,rhs) == var1 = "DOT" or var1 is ["QUOTE",:.] => bfLET2(var2,addCARorCDR('CDR,rhs)) l1 := bfLET2(var1,addCARorCDR('CAR,rhs)) - null var2 or var2 = "DOT" =>l1 + var2 = nil or var2 = "DOT" =>l1 if cons? l1 and atom first l1 then l1 := cons(l1,nil) IDENTP var2 => [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))] @@ -585,7 +585,7 @@ bfLET(lhs,rhs) == bfLET1(lhs,rhs) addCARorCDR(acc,expr) == - NULL cons? expr => [acc,expr] + atom expr => [acc,expr] acc = 'CAR and expr is ["REVERSE",:.] => ["CAR",["LAST",:rest expr]] -- cons('last,rest expr) @@ -602,8 +602,8 @@ addCARorCDR(acc,expr) == bfPosition(x,l) == bfPosn(x,l,0) bfPosn(x,l,n) == - null l => -1 - x=first l => n + l = nil => -1 + x = first l => n bfPosn(x,rest l,n+1) --% IS @@ -620,15 +620,15 @@ bfIS(left,right)== bfISReverse(x,a) == x is ['CONS,:.] => - null third x => ['CONS,second x, a] - y := bfISReverse(third x, NIL) + third x = nil => ['CONS,second x, a] + y := bfISReverse(third x, nil) y.rest.rest.first := ['CONS,second x,a] y bpSpecificErrorHere '"Error in bfISReverse" bpTrap() bfIS1(lhs,rhs) == - null rhs => ['NULL,lhs] + rhs = nil => ['NULL,lhs] string? rhs => ['EQ,lhs,['QUOTE,INTERN rhs]] NUMBERP rhs => ["EQUAL",lhs,rhs] atom rhs => ['PROGN,bfLetForm(rhs,lhs),'T] @@ -645,9 +645,9 @@ bfIS1(lhs,rhs) == bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)] rhs is ['CONS,a,b] => a = "DOT" => - NULL b => bfAND [['CONSP,lhs],['NULL,['CDR,lhs]]] + b = nil => bfAND [['CONSP,lhs],['NULL,['CDR,lhs]]] bfAND [['CONSP,lhs],bfIS1(['CDR,lhs],b)] - NULL b => + b = nil => bfAND [['CONSP,lhs],['NULL,['CDR,lhs]],bfIS1(['CAR,lhs],a)] b = "DOT" => bfAND [['CONSP,lhs],bfIS1(['CAR,lhs],a)] a1 := bfIS1(['CAR,lhs],a) @@ -714,13 +714,13 @@ bfFlatten(op, x) == [x] bfOR l == - null l => NIL - null rest l => first l + l = nil => false + rest l = nil => first l ["OR",:[:bfFlatten("OR",c) for c in l]] bfAND l == - null l=> 'T - null rest l => first l + l = nil => true + rest l = nil => first l ["AND",:[:bfFlatten("AND",c) for c in l]] @@ -733,8 +733,8 @@ bfSmintable x== bfQ(l,r)== bfSmintable l or bfSmintable r => ["EQL",l,r] defQuoteId l or defQuoteId r => ["EQ",l,r] - null l => ["NULL",r] - null r => ["NULL",l] + l = nil => ["NULL",r] + r = nil => ["NULL",l] l = true or r = true => ["EQ",l,r] ["EQUAL",l,r] @@ -757,7 +757,7 @@ bfMDef (op,args,body) == [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]] bfGargl argl== - null argl => [[],[],[],[]] + argl = nil => [[],[],[],[]] [a,b,c,d] := bfGargl rest argl first argl="&REST" => [cons(first argl,b),b,c, @@ -812,7 +812,7 @@ bfParameterList(p1,p2) == [p1,:p2] bfInsertLet(x,body)== - null x => [false,nil,x,body] + x = nil => [false,nil,x,body] x is ["&REST",a] => a is ["QUOTE",b] => [true,"QUOTE",["&REST",b],body] [false,nil,x,body] @@ -867,19 +867,19 @@ needsPROG body == false shoePROG(v,b)== - null b => [["PROG", v]] + b = nil => [["PROG", v]] [:blist,blast] := b [["PROG",v,:blist,["RETURN", blast]]] shoeFluids x== - null x => nil + x = nil => nil IDENTP x and bfBeginsDollar x => [x] atom x => nil x is ["QUOTE",:.] => nil [:shoeFluids first x,:shoeFluids rest x] shoeATOMs x == - null x => nil + x = nil => nil atom x => [x] [:shoeATOMs first x,:shoeATOMs rest x] @@ -889,7 +889,7 @@ isDynamicVariable x == IDENTP x and bfBeginsDollar x => MEMQ(x,$constantIdentifiers) => false CONSTANTP x => false - BOUNDP x or null $activeNamespace => true + BOUNDP x or $activeNamespace = nil => true y := FIND_-SYMBOL(STRING x,$activeNamespace) => not CONSTANTP y true false @@ -931,11 +931,11 @@ shoeCompTran1 x== shoeCompTran1 rest x bfTagged(a,b)== - null $op => %Signature(a,b) -- surely a toplevel decl + $op = nil => %Signature(a,b) -- surely a toplevel decl IDENTP a => - b = "FLUID" => bfLET(compFluid a,NIL) - b = "fluid" => bfLET(compFluid a,NIL) - b = "local" => bfLET(compFluid a,NIL) + b = "FLUID" => bfLET(compFluid a,nil) + b = "fluid" => bfLET(compFluid a,nil) + b = "local" => bfLET(compFluid a,nil) $typings:=cons(["TYPE",b,a],$typings) a ["THE",b,a] @@ -945,7 +945,7 @@ bfAssign(l,r)== bfLET(l,r) bfSetelt(e,l,r)== - null rest l => defSETELT(e,first l,r) + rest l = nil => defSETELT(e,first l,r) bfSetelt(bfElt(e,first l),rest l,r) bfElt(expr,sel)== @@ -985,12 +985,12 @@ bfExit(a,b)== bfMKPROGN l== a := [:bfFlattenSeq c for c in tails l] - null a => nil - null rest a => first a + a = nil => nil + rest a = nil => first a ["PROGN",:a] bfFlattenSeq x == - null x => NIL + x = nil => nil f := first x atom f => rest x => nil @@ -1013,18 +1013,18 @@ bfAlternative(a,b) == [a,:bfWashCONDBranchBody b] bfSequence l == - null l => NIL + l = nil => 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 => + before = nil => l is [f] => f is ["PROGN",:.] => bfSequence rest f f bfMKPROGN [first l,bfSequence rest l] - null aft => ["COND",:transform] + aft = nil => ["COND",:transform] ["COND",:transform,bfAlternative('T,bfSequence aft)] bfWhere (context,expr)== @@ -1037,7 +1037,7 @@ bfWhere (context,expr)== --shoeReadLispString(s,n)== -- n>= # s => nil -- [exp,ind]:=shoeReadLisp(s,n) --- null exp => nil +-- exp = nil => nil -- cons(exp,shoeReadLispString(s,ind)) bfCompHash(op,argl,body) == @@ -1120,9 +1120,9 @@ bfCaseItems(g,x) == bfCI: (%Thing,%Thing,%Thing) -> %List bfCI(g,x,y)== a := rest x - null a => [first x,y] + a = nil => [first x,y] b := [[i,bfCARCDR(j,g)] for i in a for j in 1.. | i ~= "DOT"] - null b => [first x,y] + b = nil => [first x,y] [first x,["LET",b,y]] bfCARCDR: (%Short,%Thing) -> %List @@ -1138,7 +1138,7 @@ bfDs n == ++ Generate code for try-catch expressions. bfTry: (%Thing,%List) -> %Thing bfTry(e,cs) == - null cs => e + cs = nil => e case first cs of %Catch(tag) => atom tag => bfTry(["CATCH",["QUOTE",tag],e],rest cs) @@ -1154,7 +1154,7 @@ bfThrow e == --% Type alias definition backquote(form,params) == - null params => quote form + params = nil => quote form atom form => form in params => form quote form @@ -1512,7 +1512,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- simulate the reference semantics. Don't ever try to pass around -- gigantic buffer, you might find out that it is insanely inefficient. forwardingFun := - null unstableArgs => ["DEFUN",op,parms, [n,:parms]] + unstableArgs = nil => ["DEFUN",op,parms, [n,:parms]] localPairs := [[a,x,y,:GENSYM '"loc"] for [a,x,:y] in unstableArgs] call := [n,:[actualArg(p,localPairs) for p in parms]] where @@ -1525,7 +1525,7 @@ genCLISPnativeTranslation(op,s,t,op') == copyBack [p,x,y,:a] == x is ["readonly",:.] => nil ["SETF", p, [bfColonColon("FFI","FOREIGN-VALUE"), a]] - null fixups => [call] + fixups = nil => [call] [["PROG1",call, :fixups]] -- Set up local foreign variables to hold address of traveling data for [p,x,y,:a] in localPairs repeat @@ -1559,7 +1559,7 @@ genSBCLnativeTranslation(op,s,t,op') == %hasFeature KEYWORD::WIN32 => strconc('"__",SYMBOL_-NAME op') SYMBOL_-NAME op' - null unstableArgs => + unstableArgs = nil => [["DEFUN",op,args, [INTERN('"ALIEN-FUNCALL",'"SB-ALIEN"), [INTERN('"EXTERN-ALIEN",'"SB-ALIEN"), op', @@ -1628,7 +1628,7 @@ genCLOZUREnativeTranslation(op,s,t,op') == genImportDeclaration(op, sig) == sig isnt ["%Signature", op', m] => coreError '"invalid signature" m isnt ["%Mapping", t, s] => coreError '"invalid function type" - if not null s and symbol? s then s := [s] + if s ~= nil and symbol? s then s := [s] %hasFeature KEYWORD::GCL => genGCLnativeTranslation(op,s,t,op') %hasFeature KEYWORD::SBCL => genSBCLnativeTranslation(op,s,t,op') diff --git a/src/boot/includer.boot b/src/boot/includer.boot index 18b8a58d..655d2cb6 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -160,7 +160,7 @@ shoePackageStartsAt (lines,sz,name,stream)== shoePackageStartsAt(lines,sz,name,rest stream) shoeFindLines(fn,name,a)== - null a => + a = nil => shoeNotFound fn [] [lines,b]:=shoePackageStartsAt([],#name,name, shoeInclude @@ -169,7 +169,7 @@ shoeFindLines(fn,name,a)== bStreamNull b => shoeConsole strconc (name,'" not found in ",fn) [] - null lines => shoeConsole '")package not found" + lines = nil => shoeConsole '")package not found" append(reverse lines,first b) -- Lazy inclusion support. @@ -177,7 +177,7 @@ shoeFindLines(fn,name,a)== $bStreamNil:=["nullstream"] bStreamNull x== - null x or x is ["nullstream",:.] => true + x = nil or x is ["nullstream",:.] => true while x is ["nonnullstream",:.] repeat st:=apply(second x,CDDR x) x.first := first st @@ -195,7 +195,7 @@ bMap1(:z)== shoeFileMap(f, fn)== a:=shoeInputFile fn - null a => + a = nil => shoeConsole strconc(fn,'" NOT FOUND") $bStreamNil shoeConsole strconc('"READING ",fn) @@ -292,23 +292,23 @@ shoeIncludeFunction? s == shoePrefix?('")includefunction",s) shoeBiteOff x== n:=STRPOSL('" ",x,0,true) - null n => false + n = nil => false n1:=STRPOSL ('" ",x,n,nil) - null n1 => [SUBSTRING(x,n,nil),'""] + n1 = nil => [SUBSTRING(x,n,nil),'""] [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)] shoeFileName x== a:=shoeBiteOff x - null a => '"" + a = nil => '"" c:=shoeBiteOff second a - null c => first a + c = nil => first a strconc(first a,'".",first c) shoeFnFileName x== a:=shoeBiteOff x - null a => ['"",'""] + a = nil => ['"",'""] c:=shoeFileName second a - null c => [first a,'""] + c = nil => [first a,'""] [first a, c] shoeFunctionFileInput [fun,fn]== @@ -369,7 +369,7 @@ shoeThen1(keep,b,s)== keep1 and not b1=>shoeElse(cons(true,rest keep),cons(true,rest b),t) shoeElse(cons(false,rest keep),cons(false,rest b),t) command :=shoeEndIf? string=> - null rest b=> shoeInclude t + rest b = nil => shoeInclude t shoeThen(rest keep,rest b,t) keep1 and b1 => bAppend(shoeSimpleLine h,shoeThen(keep,b,t)) shoeThen(keep,b,t) @@ -388,7 +388,7 @@ shoeElse1(keep,b,s)== keep1 and b1=> shoeThen(cons(true,keep),cons(STTOMC command,b),t) shoeThen(cons(false,keep),cons(false,b),t) command :=shoeEndIf? string => - null rest b=> shoeInclude t + rest b = nil => shoeInclude t shoeThen(rest keep,rest b,t) keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t)) shoeElse(keep,b,t) diff --git a/src/boot/parser.boot b/src/boot/parser.boot index aa250b80..6e7a1efe 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -48,14 +48,14 @@ module parser bpFirstToken()== $stok:= - null $inputStream => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) + $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) first $inputStream $ttok := shoeTokPart $stok true bpFirstTok()== $stok:= - null $inputStream => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) + $inputStream = nil => shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok) first $inputStream $ttok:=shoeTokPart $stok $bpParenCount>0 and $stok is ["KEY",:.] => @@ -294,14 +294,14 @@ bpListAndRecover(f)== if bpEqKey "BACKSET" then c := $inputStream - else if bpEqPeek "BACKTAB" or null $inputStream + else if bpEqPeek "BACKTAB" or $inputStream = nil then done := true else $inputStream := c bpGeneralErrorHere() bpRecoverTrap() - if bpEqPeek "BACKTAB" or null $inputStream + if bpEqPeek "BACKTAB" or $inputStream = nil then done:=true else bpNext() @@ -311,7 +311,7 @@ bpListAndRecover(f)== bpPush NREVERSE b bpMoveTo n== - null $inputStream => true + $inputStream = nil => true bpEqPeek "BACKTAB" => n=0 => true bpNextToken() @@ -522,7 +522,7 @@ bpExceptions()== bpSexpKey()== $stok is ["KEY",:.] and not bpExceptions()=> a := $ttok has SHOEINF - null a=> bpPush $ttok and bpNext() + a = nil => bpPush $ttok and bpNext() bpPush a and bpNext() false @@ -1064,7 +1064,7 @@ bpAssignLHS()== or true) bpChecknull()== a := bpPop1() - null a => bpTrap() + a = nil => bpTrap() bpPush a bpStruct()== diff --git a/src/boot/pile.boot b/src/boot/pile.boot index 9f9fcd96..19c48923 100644 --- a/src/boot/pile.boot +++ b/src/boot/pile.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -94,15 +94,15 @@ shoePileCtree(x,y) == -- only enshoePiles forests with >=2 trees shoePileCforest x== - null x => [] - null rest x => first x + x = nil => [] + rest x = nil => first x a := first x b := shoePileCoagulate(a,rest x) - null rest b => first b + rest b = nil => first b shoeEnPile shoeSeparatePiles b shoePileCoagulate(a,b)== - null b => [a] + b = nil => [a] c := first b shoeTokPart CAAR c = "THEN" or shoeTokPart CAAR c = "ELSE" => shoePileCoagulate (dqAppend(a,c),rest b) @@ -114,8 +114,8 @@ shoePileCoagulate(a,b)== cons(a,shoePileCoagulate(c,rest b)) shoeSeparatePiles x== - null x => [] - null rest x => first x + x = nil => [] + rest x = nil => first x a := first x semicolon := dqUnit shoeTokConstruct("KEY", "BACKSET",shoeLastTokPosn a) dqConcat [a,semicolon,shoeSeparatePiles rest x] diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index eb164ba9..6f641469 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -47,19 +47,19 @@ dqUnit s== [a,:a] dqAppend(x,y)== - null x => y - null y => x + x = nil => y + y = nil => x x.rest.rest := first y x.rest := rest y x dqConcat ld== - null ld => nil - null rest ld => first ld + ld = nil => nil + rest ld = nil => first ld dqAppend(first ld,dqConcat rest ld) dqToList s == - null s => nil + s = nil => nil first s shoeConstructToken(ln,lp,b,n) == @@ -85,7 +85,7 @@ shoeNextLine(s)== $ln:=first $f $n:=STRPOSL('" ",$ln,0,true) $sz :=# $ln - null $n => true + $n = nil => true QENUM($ln,$n)=shoeTAB => a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ") $ln.$n:='" ".0 @@ -103,7 +103,7 @@ shoeLineToks(s)== $floatok:local:=true $linepos:local:=s not shoeNextLine s => CONS(nil,nil) - null $n => shoeLineToks $r + $n = nil => shoeLineToks $r fst:=QENUM($ln,0) EQL(fst,shoeCLOSEPAREN)=> command:=shoeLine? $ln=> @@ -119,7 +119,7 @@ shoeLineToks(s)== shoeLineToks $r toks:=[] while $n<$sz repeat toks:=dqAppend(toks,shoeToken()) - null toks => shoeLineToks $r + toks = nil => shoeLineToks $r cons([toks],$r) shoeLispToken(s,string)== @@ -134,7 +134,7 @@ shoeLispToken(s,string)== shoeAccumulateLines(s,string)== not shoeNextLine s => CONS(s,string) - null $n => shoeAccumulateLines($r,string) + $n = nil => shoeAccumulateLines($r,string) # $ln=0 => shoeAccumulateLines($r,string) fst:=QENUM($ln,0) EQL(fst,shoeCLOSEPAREN)=> @@ -181,7 +181,7 @@ shoeToken () == $n:=$n+1 [] shoeError () - null b => nil + b = nil => nil dqUnit shoeConstructToken(ln,linepos,b,n) -- to pair badge and badgee @@ -229,11 +229,11 @@ shoeLispEscape()== SoftShoeError(cons($linepos,$n),'"lisp escape error") shoeLeafError ($ln.$n) a:=shoeReadLispString($ln,$n) - null a => + a = nil => SoftShoeError(cons($linepos,$n),'"lisp escape error") shoeLeafError ($ln.$n) [exp,n]:=a - null n => + n = nil => $n:= $sz shoeLeafLispExp exp $n:=n @@ -247,14 +247,14 @@ shoeEscape()== shoeEsc()== $n >= $sz => shoeNextLine($r) => - while null $n repeat shoeNextLine($r) + while $n = nil repeat shoeNextLine($r) shoeEsc() false false n1:=STRPOSL('" ",$ln,$n,true) - null n1 => + n1 = nil => shoeNextLine($r) - while null $n repeat + while $n = nil repeat shoeNextLine($r) shoeEsc() false @@ -309,7 +309,7 @@ shoeSpace()== n := $n $n := STRPOSL('" ",$ln,$n,true) $floatok := true - null $n => + $n = nil => shoeLeafSpaces 0 $n:= # $ln shoeLeafSpaces ($n-n) @@ -464,7 +464,7 @@ shoeKeyWord st == GETHASH(st,shoeKeyTable) shoeKeyWordP st == - not null GETHASH(st,shoeKeyTable) + GETHASH(st,shoeKeyTable) ~= nil shoeMatch(l,i) == shoeSubStringMatch(l,shoeDict,i) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index f9a2ecec..485babb7 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -879,7 +879,7 @@ (PROG (|funsR| |funsA| |p| |funs|) (RETURN (COND - ((NULL (CONSP |expr|)) (LIST |acc| |expr|)) + ((ATOM |expr|) (LIST |acc| |expr|)) ((AND (EQ |acc| 'CAR) (CONSP |expr|) (EQ (CAR |expr|) 'REVERSE)) (LIST 'CAR (CONS 'LAST (CDR |expr|)))) @@ -1158,7 +1158,7 @@ (DEFUN |bfAND| (|l|) (COND - ((NULL |l|) 'T) + ((NULL |l|) T) ((NULL (CDR |l|)) (CAR |l|)) (T (CONS 'AND (LET ((|bfVar#92| NIL) (|bfVar#91| |l|) (|c| NIL)) @@ -2984,9 +2984,7 @@ (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |s| (CAR |ISTMP#2|)) T))))))) (|coreError| "invalid function type")) - (T (COND - ((AND (NOT (NULL |s|)) (SYMBOLP |s|)) - (SETQ |s| (LIST |s|)))) + (T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|)))) (COND ((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|)) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index b0d7dbf3..d0fb9800 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -534,8 +534,7 @@ (DEFUN |shoeKeyWord| (|st|) (GETHASH |st| |shoeKeyTable|)) -(DEFUN |shoeKeyWordP| (|st|) - (NOT (NULL (GETHASH |st| |shoeKeyTable|)))) +(DEFUN |shoeKeyWordP| (|st|) (GETHASH |st| |shoeKeyTable|)) (DEFUN |shoeMatch| (|l| |i|) (|shoeSubStringMatch| |l| |shoeDict| |i|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 21e9f7a0..f2853636 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -188,8 +188,8 @@ (LIST 'CONS NIL) (LIST 'APPEND NIL) (LIST '|append| NIL) (LIST 'UNION NIL) (LIST 'UNIONQ NIL) (LIST '|union| NIL) - (LIST 'NCONC NIL) (LIST '|and| 'T) (LIST '|or| NIL) - (LIST 'AND 'T) (LIST 'OR NIL))) + (LIST 'NCONC NIL) (LIST '|and| T) (LIST '|or| NIL) + (LIST 'AND T) (LIST 'OR NIL))) (|i| NIL)) (LOOP (COND diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 59251588..9a23effe 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -532,7 +532,7 @@ (COND ((|bfTupleP| |argTypes|) (SETQ |argTypes| (CDR |argTypes|)))) (COND - ((AND (NOT (NULL |argTypes|)) (SYMBOLP |argTypes|)) + ((AND |argTypes| (SYMBOLP |argTypes|)) (SETQ |argTypes| (LIST |argTypes|)))) (LIST 'DECLAIM (LIST 'FTYPE (LIST 'FUNCTION |argTypes| |valType|) |n|))) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 38310ce0..9d4f6274 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -216,18 +216,18 @@ for i in [ _ ["MAX", -999999] , _ ["MIN", 999999] , _ ["*", 1] , _ - ["times", 1] , _ - ["CONS", NIL] , _ - ["APPEND", NIL] , _ - ["append", NIL] , _ - ["UNION", NIL] , _ - ["UNIONQ", NIL] , _ - ["union", NIL] , _ - ["NCONC", NIL] , _ - ["and", 'T] , _ - ["or", NIL] , _ - ["AND", 'T] , _ - ["OR", NIL] _ + ["times", 1] , _ + ["CONS", nil] , _ + ["APPEND", nil] , _ + ["append", nil] , _ + ["UNION", nil] , _ + ["UNIONQ", nil] , _ + ["union", nil] , _ + ["NCONC", nil] , _ + ["and", true] , _ + ["or", false] , _ + ["AND", true] , _ + ["OR", false] _ ] repeat SETF (GET(first i,'SHOETHETA),CDR i) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 502c0c02..ebedbe56 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -49,7 +49,7 @@ $foreignsDefsForCLisp := [] genModuleFinalization(stream) == %hasFeature KEYWORD::CLISP => - null $foreignsDefsForCLisp => nil + $foreignsDefsForCLisp = nil => nil $currentModuleName = nil => coreError '"current module has no name" init := @@ -295,7 +295,7 @@ bFileNext1(fn,s)== shoeParseTrees dq== toklist := dqToList dq - null toklist => [] + toklist = nil => [] shoeOutParse toklist shoeTreeConstruct (str)== @@ -368,7 +368,7 @@ shoeOutParse stream == not bStreamNull $inputStream => bpGeneralErrorHere() nil - null $stack => + $stack = nil => bpGeneralErrorHere() nil first $stack @@ -377,7 +377,7 @@ shoeOutParse stream == genDeclaration(n,t) == t is ["%Mapping",valType,argTypes] => if bfTupleP argTypes then argTypes := rest argTypes - if not null argTypes and symbol? argTypes + if argTypes ~= nil and symbol? argTypes then argTypes := [argTypes] ["DECLAIM",["FTYPE",["FUNCTION",argTypes,valType],n]] ["DECLAIM",["TYPE",t,n]] @@ -559,15 +559,15 @@ defuse1(e,y)== for i in y repeat defuse1(e,i) defSeparate x== - null x => [[],[]] + x = nil => [[],[]] f := first x [x1,x2] := defSeparate rest x bfBeginsDollar f => [[f,:x1],x2] [x1,cons(f,x2)] unfluidlist x== - NULL x => [] - atom x=> [x] + x = nil => [] + atom x => [x] x is ["&REST",y]=> [y] cons(first x,unfluidlist rest x) @@ -584,7 +584,7 @@ SSORT l == SORT(l,function CLESSP) bootOutLines(l,outfn,s)== - null l => shoeFileLine(s,outfn) + l = nil => shoeFileLine(s,outfn) a := PNAME first l #s + #a > 70 => shoeFileLine(s,outfn) @@ -601,7 +601,7 @@ XREF fn== shoeOpenInputFile(a,infn,shoeXref(a,fn)) shoeXref(a,fn)== - null a => shoeNotFound fn + a = nil => shoeNotFound fn $lispWordTable :=MAKE_-HASHTABLE ("EQ") DO_-SYMBOLS(i(FIND_-PACKAGE "LISP"),HPUT($lispWordTable,i,true)) $bootDefined :=MAKE_-HASHTABLE "EQ" |