* boot/ast.boot: More cleanup.

	* boot/includer.boot: Likewise.
	* boot/parser.boot: Likewise.
	* boot/scanner.boot: Likewise.

11 files changed, 294 insertions, 284 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 13a813e0..ee531a0f 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -189,12 +189,10 @@ bfAppend x==
  
 bfColonAppend: (%List,%Thing) -> %List
 bfColonAppend(x,y) ==
-     if null x
-     then
-      if y is ["BVQUOTE",:a]
-      then ["&REST",["QUOTE",:a]]
-      else ["&REST",y]
-     else cons(first x,bfColonAppend(rest x,y))
+  null x => 
+    y is ["BVQUOTE",:a] => ["&REST",["QUOTE",:a]]
+    ["&REST",y]
+  cons(first x,bfColonAppend(rest x,y))
 
 bfBeginsDollar: %Thing -> %Boolean 
 bfBeginsDollar x ==  
@@ -205,23 +203,24 @@ compFluid id ==
  
 compFluidize x==
   IDENTP x and bfBeginsDollar x=>compFluid x
-  atom x =>x
-  EQCAR(x,"QUOTE")=>x
+  atom x => x
+  x is ["QUOTE",:.] => x
   cons(compFluidize(first x),compFluidize(rest x))
  
-bfTuple x== ["TUPLE",:x]
+bfTuple x == 
+  ["TUPLE",:x]
  
-bfTupleP x==EQCAR(x,"TUPLE")
+bfTupleP x ==
+  x is ["TUPLE",:.]
 
 ++ If `bf' is a tuple return its elements; otherwise `bf'.
 bfUntuple bf ==
-  bfTupleP bf => cdr bf
+  bfTupleP bf => rest bf
   bf
  
 bfTupleIf x==
-  if bfTupleP x
-  then x
-  else bfTuple x
+  bfTupleP x => x
+  bfTuple x
  
 bfTupleConstruct b ==
   a:= if bfTupleP b
@@ -244,18 +243,15 @@ bfMakeCons l ==
   ['CONS,first l,bfMakeCons rest l]
  
 bfFor(bflhs,U,step) ==
-     if EQCAR (U,'tails)
-     then  bfForTree('ON, bflhs, second U)
-     else
-       if EQCAR(U,"SEGMENT")
-       then  bfSTEP(bflhs,second U,step,third U)
-       else  bfForTree('IN, bflhs, U)
+  U is ["tails",:.] => bfForTree('ON, bflhs, second U)
+  U is ["SEGMENT",:.] => bfSTEP(bflhs,second U,step,third U)
+  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
-         EQCAR(lhs,"L%T") =>
+         lhs is ["L%T",:.] =>
              G:=second lhs
              [:bfINON [OP,G,whole],:bfSuchthat bfIS(G,third lhs)]
          G:=bfGenSymbol()
@@ -291,10 +287,9 @@ bfSTEP(id,fst,step,lst)==
  
  
 bfINON x==
-    [op,id,whole]:=x
-    if EQ(op,"ON")
-    then bfON(id,whole)
-    else bfIN(id,whole)
+  [op,id,whole]:=x
+  op = "ON" => bfON(id,whole)
+  bfIN(id,whole)
  
 bfIN(x,E)==
     g:=bfGenSymbol()
@@ -318,154 +313,146 @@ bfIterators x==["ITERATORS",:x]
 bfCross x== ["CROSS",:x]
  
 bfLp(iters,body)==
-     EQCAR (iters,"ITERATORS")=>bfLp1(rest iters,body)
-     bfLpCross(rest iters,body)
+  iters is ["ITERATORS",:.] => bfLp1(rest iters,body)
+  bfLpCross(rest iters,body)
  
 bfLpCross(iters,body)==
-     if null cdr iters
-     then bfLp(first iters,body)
-     else bfLp(first iters,bfLpCross(rest iters,body))
+  null rest iters => bfLp(first iters,body)
+  bfLp(first iters,bfLpCross(rest 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]
+  null iters => [[],[],[],[],[],[]]
+  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 second op else op
-     op:=bfReName a
-     init := GET(a,"SHOETHETA") or GET(op,"SHOETHETA")
-     g:=bfGenSymbol()
-     g1:=bfGenSymbol()
-     body:=['SETQ,g,[op,g,g1]]
-     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)
+  a :=if op is ["QUOTE",:.] then second op else op
+  op := bfReName a
+  init := GET(a,"SHOETHETA") or GET(op,"SHOETHETA")
+  g := bfGenSymbol()
+  g1 := bfGenSymbol()
+  body := ['SETQ,g,[op,g,g1]]
+  null init =>
+    g2 := bfGenSymbol()
+    init := ['CAR,g2]
+    ny := ['CDR,g2]
+    it := ["ITERATORS",:[[[[g],[init],[],[],[],[g]]],bfIN(g1,ny)]]
+    bfMKPROGN [['L%T,g2,y],bfLp(it,body)]
+  init := first 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 second op else op
-     op:=bfReName a
-     init := GET(a, "SHOETHETA") or GET(op,"SHOETHETA")
-     bfOpReduce(op,init,body,itl)
-   else
-     a:=bfTupleConstruct (y.1)
-     bfReduce(op,a)
+  y is ["COLLECT",:.] => 
+    body := y.1
+    itl := y.2
+    a := if op is ["QUOTE",:.] then second op else op
+    op := bfReName a
+    init := GET(a, "SHOETHETA") or GET(op,"SHOETHETA")
+    bfOpReduce(op,init,body,itl)
+  bfReduce(op,bfTupleConstruct (y.1))
  
 -- delayed collect
  
-bfDCollect(y,itl)== ["COLLECT",y,itl]
+bfDCollect(y,itl) == 
+  ["COLLECT",y,itl]
  
-bfDTuple x== ["DTUPLE",x]
+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)
+  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)
+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)
+  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)
+  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 first value
-      exits:= ["COND",[bfOR exits,["RETURN",value]],
-                  ['(QUOTE T),nbody]]
-      loop := ["LOOP",exits,:sucs]
-      if vars then loop := 
-        ["LET",[[v, i] for v in vars for i in inits], loop]
-      loop
+  [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
+  exits := ["COND",[bfOR exits,["RETURN",value]],
+	      ['(QUOTE T),nbody]]
+  loop := ["LOOP",exits,:sucs]
+  if vars then loop := 
+    ["LET",[[v, i] for v in vars for i in inits], loop]
+  loop
  
 bfLp2(extrait,itl,body)==
-     EQCAR (itl,"ITERATORS")=>bfLp1(cons(extrait,rest itl),body)
-     iters:=rest itl
-     bfLpCross
-          ([["ITERATORS",extrait,:CDAR iters],:rest iters],body)
+  itl is ["ITERATORS",:.] => bfLp1(cons(extrait,rest itl),body)
+  iters := rest itl
+  bfLpCross([["ITERATORS",extrait,:CDAR iters],:rest 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]          -- ??? bogus self-assignment/initialization
-        extrait:= [[[g],[init],[],[],[],[g]]]
-        bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)]
-     else
-        init:=first 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]
+  g := bfGenSymbol()
+  body:=
+    op = "AND" =>
+      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 =>
+    g1 := bfGenSymbol()
+    init := ['CAR,g1]
+    y := ['CDR,g1]          -- ??? bogus self-assignment/initialization
+    extrait := [[[g],[init],[],[],[],[g]]]
+    bfMKPROGN [['L%T,g1,y],bfLp2(extrait,itl,body)]
+  init := first 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)
+  bfFor(variable,collection,step)
  
-bfForin(lhs,U)==bfFor(lhs,U,1)
+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
+  b = "FLUID" =>  compFluid a
+  b = "fluid" =>  compFluid a
+  b = "local" =>  compFluid a
+  a
  
 bfTake(n,x)==
-     null x=>x
-     n=0 => nil
-     cons(first x,bfTake(n-1,rest x))
+  null x=>x
+  n=0 => nil
+  cons(first x,bfTake(n-1,rest x))
  
 bfDrop(n,x)==
-     null x or n=0 =>x
-     bfDrop(n-1,rest x)
+  null x or n=0 =>x
+  bfDrop(n-1,rest x)
  
 bfReturnNoName a ==
-      ["RETURN",a]
+  ["RETURN",a]
  
 bfSUBLIS(p,e)==
   atom e=>bfSUBLIS1(p,e)
-  EQCAR(e,"QUOTE")=>e
+  e is ["QUOTE",:.] => e
   cons(bfSUBLIS(p,first e),bfSUBLIS(p,rest e))
  
 +++ Returns e/p, where e is an atom.  We assume that the
@@ -498,13 +485,10 @@ defSheepAndGoats(x)==
     otherwise => [[],[],[x]]
  
 defSheepAndGoatsList(x)==
-     if null x
-     then [[],[],[]]
-     else
-       [opassoc,defs,nondefs]    := defSheepAndGoats first x
-       [opassoc1,defs1,nondefs1] := defSheepAndGoatsList rest x
-       [append(opassoc,opassoc1),append(defs,defs1),
-            append(nondefs,nondefs1)]
+  null x => [[],[],[]]
+  [opassoc,defs,nondefs]    := defSheepAndGoats first x
+  [opassoc1,defs1,nondefs1] := defSheepAndGoatsList rest x
+  [append(opassoc,opassoc1),append(defs,defs1), append(nondefs,nondefs1)]
 
 --% LET
  
@@ -516,22 +500,22 @@ bfLET1(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])
+    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]
-  CONSP(rhs) and EQCAR(rhs,'L%T) and IDENTP(name := second rhs) =>
+  rhs is ["L%T",:.] and IDENTP(name := second rhs) =>
     -- handle things like [a] := x := foo
     l1 := bfLET1(name,third rhs)
     l2 := bfLET1(lhs,name)
-    EQCAR(l2,'PROGN) => bfMKPROGN [l1,:rest l2]
+    l2 is ["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,:rest let1]
+  let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1]
   if IDENTP first let1 then let1 := CONS(let1,NIL)
   bfMKPROGN [rhs1,:let1,g]
  
@@ -551,10 +535,10 @@ bfLET2(lhs,rhs) ==
     CONSP first b => CONS(a,b)
     [a,b]
   lhs is ['CONS,var1,var2] =>
-    var1 = "DOT" or (CONSP(var1) and EQCAR(var1,'QUOTE)) =>
+    var1 = "DOT" or var1 is ["QUOTE",:.] =>
       bfLET2(var2,addCARorCDR('CDR,rhs))
     l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
-    null var2 or EQ(var2,"DOT") =>l1
+    null var2 or var2 = "DOT" =>l1
     if CONSP l1 and atom first l1 then l1 := cons(l1,nil)
     IDENTP var2 =>
       [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
@@ -594,7 +578,7 @@ bfLET(lhs,rhs) ==
  
 addCARorCDR(acc,expr) ==
   NULL CONSP expr => [acc,expr]
-  acc = 'CAR and EQCAR(expr,'REVERSE) =>
+  acc = 'CAR and expr is ["REVERSE",:.] =>
       ["CAR",["LAST",:rest expr]]
  --   cons('last,rest expr)
   funs := '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR
@@ -617,8 +601,8 @@ bfPosn(x,l,n) ==
 --% IS
  
 bfISApplication(op,left,right)==
-   EQ(op ,"IS")      => bfIS(left,right)
-   EQ(op ,"ISNT")    => bfNOT bfIS(left,right)
+   op = "IS"      => bfIS(left,right)
+   op = "ISNT"    => bfNOT bfIS(left,right)
    [op ,left,right]
  
 bfIS(left,right)==
@@ -696,14 +680,14 @@ bfReName x==
   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 = "EQUAL" => bfQ(left,right)
+   op = "/="    => bfNOT bfQ(left,right)
+   op = ">"     => bfLessp(right,left)
+   op = "<"     => bfLessp(left,right)
+   op = "<="    => bfNOT bfLessp(right,left)
+   op = ">="    => bfNOT bfLessp(left,right)
+   op = "OR"    => bfOR [left,right]
+   op = "AND"   => bfAND [left,right]
    [op,left,right]
  
 bfNOT x==
@@ -712,7 +696,7 @@ bfNOT x==
    ["NOT",x]
  
 bfFlatten(op, x) ==
-      EQCAR(x,op) => rest x
+      x is [=op,:.] => rest x
       [x]
  
 bfOR l  ==
@@ -726,7 +710,8 @@ bfAND l ==
        ["AND",:[:bfFlatten("AND",c) for c in l]]
  
  
-defQuoteId x==  EQCAR(x,"QUOTE") and IDENTP second x
+defQuoteId x==  
+  x is ["QUOTE",:.] and IDENTP second x
  
 bfSmintable x==
   INTEGERP x or CONSP x and
@@ -737,13 +722,12 @@ bfQ(l,r)==
   defQuoteId l or defQuoteId r => ["EQ",l,r]
   null l => ["NULL",r]
   null r => ["NULL",l]
-  EQ(l,true) or EQ(r,true) => ["EQ",l,r]
+  l = true or r = true => ["EQ",l,r]
   ["EQUAL",l,r]
  
 bfLessp(l,r)==
-      if r=0
-      then ["MINUSP", l]
-      else ["<",l,r]
+  r=0 => ["MINUSP", l]
+  ["<",l,r]
  
 bfMDef (op,args,body) ==
   argl:=if bfTupleP args then cdr args else [args]
@@ -793,9 +777,8 @@ shoeComps  x==
 
 shoeComp x==
      a:=shoeCompTran second x
-     if EQCAR(a,"LAMBDA")
-     then ["DEFUN",first x,second a,:CDDR a]
-     else ["DEFMACRO",first x,second a,:CDDR a]
+     a is ["LAMBDA",:.] => ["DEFUN",first x,second a,:CDDR a]
+     ["DEFMACRO",first x,second a,:CDDR a]
 
 
 ++ Translate function parameter list to Lisp.
@@ -880,7 +863,7 @@ shoeFluids x==
   null x => nil
   IDENTP x and bfBeginsDollar x => [x]
   atom x => nil
-  EQCAR(x,"QUOTE") => nil
+  x is ["QUOTE",:.] => nil
   [:shoeFluids first x,:shoeFluids rest x]
 
 shoeATOMs x ==
@@ -907,7 +890,7 @@ shoeCompTran1 x==
 	   cons(x,$dollarVars)
       nil
     U:=car x
-    EQ(U,"QUOTE")=>nil
+    U = "QUOTE" => nil
     x is ["L%T",l,r]=>
                 RPLACA (x,"SETQ")
                 shoeCompTran1 r
@@ -919,7 +902,7 @@ shoeCompTran1 x==
                   $dollarVars:=
                           MEMQ(l,$dollarVars)=>$dollarVars
                           cons(l,$dollarVars)
-                EQCAR(l,"FLUID")=>
+                l is ["FLUID",:.] =>
                     $fluidVars:=
                          MEMQ(second l,$fluidVars)=>$fluidVars
                          cons(second l,$fluidVars)
@@ -938,9 +921,9 @@ shoeCompTran1 x==
 bfTagged(a,b)==
   null $op => %Signature(a,b)        -- surely a toplevel decl
   IDENTP a =>
-    EQ(b,"FLUID") =>  bfLET(compFluid a,NIL)
-    EQ(b,"fluid") =>  bfLET(compFluid a,NIL)
-    EQ(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]
@@ -968,13 +951,13 @@ defSETELT(var,sel,expr)==
       ["SETF",["ELT",var,sel],expr]
  
 bfIfThenOnly(a,b)==
-    b1:=if EQCAR (b,"PROGN") then rest b else [b]
+    b1:=if b is ["PROGN",:.] then rest b else [b]
     ["COND",[a,:b1]]
  
 bfIf(a,b,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]
+    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],['(QUOTE T),:c1]]
  
 bfExit(a,b)==  
@@ -990,7 +973,7 @@ bfFlattenSeq x ==
       null x=>NIL
       f:=first x
       atom f =>if rest x then nil else [f]
-      EQCAR(f,"PROGN") =>
+      f is ["PROGN",:.] =>
               rest x=>  [i for i in rest f| not atom i]
               rest f
       [f]
@@ -1076,18 +1059,14 @@ bfNameOnly x==
 
 bfNameArgs: (%Thing,%Thing) -> %List 
 bfNameArgs (x,y)==
-    y:=if EQCAR(y,"TUPLE") then rest y else [y]
+    y:=if y is ["TUPLE",:.] then rest y else [y]
     cons(x,y)
  
 bfCreateDef: %Thing -> %List
 bfCreateDef x==
-     if null rest x
-     then
-       f:=first x
-       ["DEFCONSTANT",f,["LIST",["QUOTE",f]]]
-     else
-       a:=[bfGenSymbol() for i in rest x]
-       ["DEFUN",first x,a,["CONS",["QUOTE",first x],["LIST",:a]]]
+  x is [f] => ["DEFCONSTANT",f,["LIST",["QUOTE",f]]]
+  a := [bfGenSymbol() for i in rest x]
+  ["DEFUN",first x,a,["CONS",["QUOTE",first x],["LIST",:a]]]
 
 bfCaseItem: (%Thing,%Thing) -> %List 
 bfCaseItem(x,y) ==
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index 86f3a648..554b6b36 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -77,9 +77,6 @@ PNAME x ==
 char x ==
   CHAR(PNAME x, 0)
 
-EQCAR(x,y)== 
-  CONSP x and EQ(first x,y)
-
 -- returns the string representation of object X.
 STRINGIMAGE x ==
   WRITE_-TO_-STRING x
@@ -186,12 +183,12 @@ shoeFindLines(fn,name,a)==
 $bStreamNil:=["nullstream"]
  
 bStreamNull x==
-  null x or EQCAR (x,"nullstream") => true
-  while EQCAR(x,"nonnullstream") repeat
+  null x or x is ["nullstream",:.] => true
+  while x is ["nonnullstream",:.] repeat
           st:=apply(second x,CDDR x)
           RPLACA(x,first st)
           RPLACD(x,rest st)
-  EQCAR(x,"nullstream")
+  x is ["nullstream",:.]
  
 bMap(f,x) == 
   bDelay(function bMap1, [f,x])
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index eb070e8a..68ec4ea0 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -60,14 +60,14 @@ bpFirstTok()==
           then shoeTokConstruct("ERROR","NOMORE",shoeTokPosn $stok)
           else first $inputStream
       $ttok:=shoeTokPart $stok
-      $bpParenCount>0 and EQCAR($stok,"KEY") =>
-             EQ($ttok,"SETTAB")=>
+      $bpParenCount>0 and $stok is ["KEY",:.] =>
+             $ttok = "SETTAB" =>
                 $bpCount:=$bpCount+1
                 bpNext()
-             EQ($ttok,"BACKTAB")=>
+             $ttok = "BACKTAB" =>
                 $bpCount:=$bpCount-1
                 bpNext()
-             EQ($ttok,"BACKSET")=>
+             $ttok = "BACKSET" =>
                 bpNext()
              true
       true
@@ -265,11 +265,14 @@ bpBacksetElse()==
     then bpEqKey "ELSE"
     else bpEqKey "ELSE"
  
-bpEqPeek s ==  EQCAR($stok,"KEY") and EQ(s,$ttok)
+bpEqPeek s == 
+  $stok is ["KEY",:.] and EQ(s,$ttok)
  
-bpEqKey s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and bpNext()
-bpEqKeyNextTok s ==   EQCAR($stok,"KEY") and EQ(s,$ttok) and
-                  bpNextToken()
+bpEqKey s ==
+  $stok is ["KEY",:.] and EQ(s,$ttok) and bpNext()
+
+bpEqKeyNextTok s ==   
+  $stok is ["KEY",:.] and EQ(s,$ttok) and bpNextToken()
  
 bpPileTrap()   == bpMissing  "BACKTAB"
 bpBrackTrap(x) == bpMissingMate("]",x)
@@ -370,7 +373,7 @@ bpMoveTo n==
 bpQualifiedName() ==
   bpEqPeek "COLON-COLON" =>
     bpNext()
-    EQCAR($stok, "ID") and bpPushId() and bpNext()
+    $stok is ["ID",:.] and bpPushId() and bpNext()
       and bpPush bfColonColon(bpPop2(), bpPop1())
   false
 
@@ -378,7 +381,7 @@ bpQualifiedName() ==
 ++   ID
 ++   Name :: ID
 bpName() ==
-  EQCAR( $stok,"ID") =>
+  $stok is ["ID",:.] =>
     bpPushId()
     bpNext()
     bpAnyNo function bpQualifiedName
@@ -397,9 +400,9 @@ bpConstTok() ==
      MEMQ(shoeTokType $stok, '(INTEGER FLOAT)) =>
           bpPush $ttok
           bpNext()
-     EQCAR($stok,"LISP")=> bpPush %Lisp $ttok and bpNext()
-     EQCAR($stok,"LISPEXP")=> bpPush $ttok and bpNext()
-     EQCAR($stok,"LINE")=> bpPush ["+LINE", $ttok] and bpNext()
+     $stok is ["LISP",:.] => bpPush %Lisp $ttok and bpNext()
+     $stok is ["LISPEXP",:.] => bpPush $ttok and bpNext()
+     $stok is ["LINE",:.] => bpPush ["+LINE", $ttok] and bpNext()
      bpEqPeek "QUOTE" =>
           bpNext()
           (bpSexp() or bpTrap()) and
@@ -548,14 +551,14 @@ bpExceptions()==
  
  
 bpSexpKey()==
-      EQCAR( $stok,"KEY") and not bpExceptions()=>
+      $stok is ["KEY",:.] and not bpExceptions()=>
                a:=GET($ttok,"SHOEINF")
                null a=>  bpPush $ttok and bpNext()
                bpPush a and bpNext()
       false
  
 bpAnyId()==
-  bpEqKey "MINUS"  and (EQCAR($stok,"INTEGER") or bpTrap()) and
+  bpEqKey "MINUS"  and ($stok is ["INTEGER",:.] or bpTrap()) and
           bpPush MINUS $ttok and bpNext() or
              bpSexpKey() or
                    MEMQ(shoeTokType $stok, '(ID INTEGER STRING FLOAT))
@@ -588,11 +591,11 @@ bpPrimary()==  bpFirstTok() and (bpPrimary1() or bpPrefixOperator())
 bpDot()== bpEqKey "DOT" and bpPush bfDot ()
  
 bpPrefixOperator()==
-   EQCAR( $stok,"KEY") and
+   $stok is ["KEY",:.] and
      GET($ttok,"SHOEPRE") and bpPushId() and  bpNext()
  
 bpInfixOperator()==
-  EQCAR( $stok,"KEY") and
+  $stok is ["KEY",:.] and
     GET($ttok,"SHOEINF") and bpPushId() and  bpNext()
  
 bpSelector()==
@@ -625,7 +628,7 @@ bpTagged()==
 bpExpt()== bpRightAssoc('(POWER),function bpTagged)
  
 bpInfKey s==
- EQCAR( $stok,"KEY") and
+ $stok is ["KEY",:.] and
    MEMBER($ttok,s) and bpPushId() and bpNext()
  
 bpInfGeneric s== bpInfKey s and  (bpEqKey "BACKSET" or true)
@@ -652,11 +655,11 @@ bpLeftAssoc(operations,parser)==
     else false
  
 bpString()==
-     EQ(shoeTokType $stok,"STRING") and
+     shoeTokType $stok = "STRING" and
          bpPush(["QUOTE",INTERN $ttok]) and bpNext()
  
 bpThetaName() ==
-        if EQCAR( $stok,"ID") and GET($ttok,"SHOETHETA")
+        if $stok is ["ID",:.] and GET($ttok,"SHOETHETA")
         then
            bpPushId()
            bpNext()
@@ -1047,7 +1050,7 @@ bpRegularBVItem() ==
         or bpBracketConstruct function bpPatternL
  
 bpBVString()==
-     EQ(shoeTokType $stok,"STRING") and
+     shoeTokType $stok = "STRING" and
          bpPush(["BVQUOTE",INTERN $ttok]) and bpNext()
  
 bpRegularBVItemL() ==
@@ -1148,7 +1151,7 @@ bpOutItem()==
   bpComma() or bpTrap()
   b:=bpPop1()
   bpPush 
-    EQCAR(b,"+LINE")=> [ b ]
+    b is ["+LINE",:.] => [ b ]
     b is ["L%T",l,r] and IDENTP l => 
       $InteractiveMode => [["SETQ",l,r]]
       [["DEFPARAMETER",l,r]]
diff --git a/src/boot/pile.boot b/src/boot/pile.boot
index df1b0ecb..f9c667ee 100644
--- a/src/boot/pile.boot
+++ b/src/boot/pile.boot
@@ -123,13 +123,13 @@ shoePileCoagulate(a,b)==
     then [a]
     else
       c:=first b
-      if EQ(shoeTokPart CAAR c,"THEN") or EQ(shoeTokPart CAAR c,"ELSE")
+      if shoeTokPart CAAR c = "THEN" or shoeTokPart CAAR c = "ELSE"
       then shoePileCoagulate (dqAppend(a,c),rest b)
       else
          d:=second a
          e:=shoeTokPart d
-         if EQCAR(d,"KEY") and
-               (GET(e,"SHOEINF") or EQ(e,"COMMA") or EQ(e,"SEMICOLON"))
+         if d is ["KEY",:.] and
+               (GET(e,"SHOEINF") or e = "COMMA" or e = "SEMICOLON")
          then shoePileCoagulate(dqAppend(a,c),rest b)
          else cons(a,shoePileCoagulate(c,rest b))
  
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 8872c9df..aed1df0e 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -310,7 +310,7 @@ shoePunct()==
             shoeKeyTr sss
  
 shoeKeyTr w==
-       if EQ(shoeKeyWord w,"DOT")
+       if shoeKeyWord w = "DOT"
        then if $floatok
             then shoePossFloat(w)
             else shoeLeafKey w
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 64b6779a..79e71325 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -226,12 +226,12 @@
   (COND
     ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
     ((ATOM |x|) |x|)
-    ((EQCAR |x| 'QUOTE) |x|)
+    ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|)
     ('T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
 
 (DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|))
 
-(DEFUN |bfTupleP| (|x|) (EQCAR |x| 'TUPLE))
+(DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE)))
 
 (DEFUN |bfUntuple| (|bf|)
   (COND ((|bfTupleP| |bf|) (CDR |bf|)) ('T |bf|)))
@@ -292,8 +292,10 @@
 
 (DEFUN |bfFor| (|bflhs| U |step|)
   (COND
-    ((EQCAR U '|tails|) (|bfForTree| 'ON |bflhs| (CADR U)))
-    ((EQCAR U 'SEGMENT) (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U)))
+    ((AND (CONSP U) (EQ (CAR U) '|tails|))
+     (|bfForTree| 'ON |bflhs| (CADR U)))
+    ((AND (CONSP U) (EQ (CAR U) 'SEGMENT))
+     (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U)))
     ('T (|bfForTree| 'IN |bflhs| U))))
 
 (DEFUN |bfForTree| (OP |lhs| |whole|)
@@ -310,7 +312,8 @@
            (SETQ |lhs|
                  (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (#0# |lhs|)))
            (COND
-             ((EQCAR |lhs| 'L%T) (SETQ G (CADR |lhs|))
+             ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T))
+              (SETQ G (CADR |lhs|))
               (APPEND (|bfINON| (LIST OP G |whole|))
                       (|bfSuchthat| (|bfIS| G (CADDR |lhs|)))))
              (#1# (SETQ G (|bfGenSymbol|))
@@ -398,7 +401,8 @@
 
 (DEFUN |bfLp| (|iters| |body|)
   (COND
-    ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|))
+    ((AND (CONSP |iters|) (EQ (CAR |iters|) 'ITERATORS))
+     (|bfLp1| (CDR |iters|) |body|))
     ('T (|bfLpCross| (CDR |iters|) |body|))))
 
 (DEFUN |bfLpCross| (|iters| |body|)
@@ -431,7 +435,9 @@
     (RETURN
       (PROGN
         (SETQ |a|
-              (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
+              (COND
+                ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) (CADR |op|))
+                ('T |op|)))
         (SETQ |op| (|bfReName| |a|))
         (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
         (SETQ |g| (|bfGenSymbol|))
@@ -447,7 +453,7 @@
                              (|bfIN| |g1| |ny|))))
            (|bfMKPROGN|
                (LIST (LIST 'L%T |g2| |y|) (|bfLp| |it| |body|))))
-          (#0# (SETQ |init| (CAR |init|))
+          ('T (SETQ |init| (CAR |init|))
            (SETQ |it|
                  (CONS 'ITERATORS
                        (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL
@@ -459,15 +465,17 @@
   (PROG (|init| |a| |itl| |body|)
     (RETURN
       (COND
-        ((EQCAR |y| 'COLLECT) (SETQ |body| (ELT |y| 1))
-         (SETQ |itl| (ELT |y| 2))
+        ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT))
+         (SETQ |body| (ELT |y| 1)) (SETQ |itl| (ELT |y| 2))
          (SETQ |a|
-               (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|)))
+               (COND
+                 ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE))
+                  (CADR |op|))
+                 ('T |op|)))
          (SETQ |op| (|bfReName| |a|))
          (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA)))
          (|bfOpReduce| |op| |init| |body| |itl|))
-        (#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1)))
-         (|bfReduce| |op| |a|))))))
+        ('T (|bfReduce| |op| (|bfTupleConstruct| (ELT |y| 1))))))))
 
 (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|))
 
@@ -564,7 +572,7 @@
   (PROG (|iters|)
     (RETURN
       (COND
-        ((EQCAR |itl| 'ITERATORS)
+        ((AND (CONSP |itl|) (EQ (CAR |itl|) 'ITERATORS))
          (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|))
         ('T (SETQ |iters| (CDR |itl|))
          (|bfLpCross|
@@ -589,7 +597,7 @@
                  (|bfMKPROGN|
                      (LIST (LIST 'SETQ |g| |y|)
                            (LIST 'COND (LIST |g| (LIST 'RETURN |g|))))))
-                ('T (LIST 'SETQ |g| (LIST |op| |g| |y|)))))
+                (#0='T (LIST 'SETQ |g| (LIST |op| |g| |y|)))))
         (COND
           ((NULL |init|) (SETQ |g1| (|bfGenSymbol|))
            (SETQ |init| (LIST 'CAR |g1|)) (SETQ |y| (LIST 'CDR |g1|))
@@ -599,7 +607,7 @@
            (|bfMKPROGN|
                (LIST (LIST 'L%T |g1| |y|)
                      (|bfLp2| |extrait| |itl| |body|))))
-          ('T (SETQ |init| (CAR |init|))
+          (#0# (SETQ |init| (CAR |init|))
            (SETQ |extrait|
                  (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL
                              (LIST |g|))))
@@ -639,7 +647,7 @@
 (DEFUN |bfSUBLIS| (|p| |e|)
   (COND
     ((ATOM |e|) (|bfSUBLIS1| |p| |e|))
-    ((EQCAR |e| 'QUOTE) |e|)
+    ((AND (CONSP |e|) (EQ (CAR |e|) 'QUOTE)) |e|)
     ('T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|))))))
 
 (DEFUN |bfSUBLIS1| (|p| |e|)
@@ -713,18 +721,21 @@
         ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
          (SETQ |rhs1| (|bfLET2| |lhs| |rhs|))
          (COND
-           ((EQCAR |rhs1| 'L%T) (|bfMKPROGN| (LIST |rhs1| |rhs|)))
-           ((EQCAR |rhs1| 'PROGN) (APPEND |rhs1| (LIST |rhs|)))
+           ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T))
+            (|bfMKPROGN| (LIST |rhs1| |rhs|)))
+           ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN))
+            (APPEND |rhs1| (LIST |rhs|)))
            (#0='T
             (COND
               ((IDENTP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL))))
             (|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL))))))
-        ((AND (CONSP |rhs|) (EQCAR |rhs| 'L%T)
+        ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T)
               (IDENTP (SETQ |name| (CADR |rhs|))))
          (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|)))
          (SETQ |l2| (|bfLET1| |lhs| |name|))
          (COND
-           ((EQCAR |l2| 'PROGN) (|bfMKPROGN| (CONS |l1| (CDR |l2|))))
+           ((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN))
+            (|bfMKPROGN| (CONS |l1| (CDR |l2|))))
            (#0#
             (COND ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
             (|bfMKPROGN| (CONS |l1| (APPEND |l2| (CONS |name| NIL)))))))
@@ -736,7 +747,7 @@
          (SETQ |rhs1| (LIST 'L%T |g| |rhs|))
          (SETQ |let1| (|bfLET1| |lhs| |g|))
          (COND
-           ((EQCAR |let1| 'PROGN)
+           ((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN))
             (|bfMKPROGN| (CONS |rhs1| (CDR |let1|))))
            (#0#
             (COND
@@ -789,7 +800,7 @@
                             (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#))))))
          (COND
            ((OR (EQ |var1| 'DOT)
-                (AND (CONSP |var1|) (EQCAR |var1| 'QUOTE)))
+                (AND (CONSP |var1|) (EQ (CAR |var1|) 'QUOTE)))
             (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|)))
            (#1#
             (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|)))
@@ -882,7 +893,8 @@
     (RETURN
       (COND
         ((NULL (CONSP |expr|)) (LIST |acc| |expr|))
-        ((AND (EQ |acc| 'CAR) (EQCAR |expr| 'REVERSE))
+        ((AND (EQ |acc| 'CAR) (CONSP |expr|)
+              (EQ (CAR |expr|) 'REVERSE))
          (LIST 'CAR (CONS 'LAST (CDR |expr|))))
         (#0='T
          (SETQ |funs|
@@ -1100,7 +1112,9 @@
         ('T (LIST 'NOT |x|))))))
 
 (DEFUN |bfFlatten| (|op| |x|)
-  (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|))))
+  (COND
+    ((AND (CONSP |x|) (EQUAL (CAR |x|) |op|)) (CDR |x|))
+    ('T (LIST |x|))))
 
 (DEFUN |bfOR| (|l|)
   (COND
@@ -1139,7 +1153,7 @@
                (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
 
 (DEFUN |defQuoteId| (|x|)
-  (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))
+  (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|))))
 
 (DEFUN |bfSmintable| (|x|)
   (OR (INTEGERP |x|)
@@ -1319,7 +1333,7 @@
       (PROGN
         (SETQ |a| (|shoeCompTran| (CADR |x|)))
         (COND
-          ((EQCAR |a| 'LAMBDA)
+          ((AND (CONSP |a|) (EQ (CAR |a|) 'LAMBDA))
            (CONS 'DEFUN (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|)))))
           ('T
            (CONS 'DEFMACRO
@@ -1487,7 +1501,7 @@
     ((NULL |x|) NIL)
     ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
     ((ATOM |x|) NIL)
-    ((EQCAR |x| 'QUOTE) NIL)
+    ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) NIL)
     ('T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|))))))
 
 (DEFUN |shoeATOMs| (|x|)
@@ -1551,7 +1565,7 @@
                         (COND
                           ((MEMQ |l| |$dollarVars|) |$dollarVars|)
                           (#0# (CONS |l| |$dollarVars|)))))))
-              ((EQCAR |l| 'FLUID)
+              ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID))
                (SETQ |$fluidVars|
                      (COND
                        ((MEMQ (CADR |l|) |$fluidVars|) |$fluidVars|)
@@ -1640,7 +1654,9 @@
     (RETURN
       (PROGN
         (SETQ |b1|
-              (COND ((EQCAR |b| 'PROGN) (CDR |b|)) ('T (LIST |b|))))
+              (COND
+                ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|))
+                ('T (LIST |b|))))
         (LIST 'COND (CONS |a| |b1|))))))
 
 (DEFUN |bfIf| (|a| |b| |c|)
@@ -1648,14 +1664,16 @@
     (RETURN
       (PROGN
         (SETQ |b1|
-              (COND ((EQCAR |b| 'PROGN) (CDR |b|)) (#0='T (LIST |b|))))
+              (COND
+                ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|))
+                (#0='T (LIST |b|))))
         (COND
-          ((EQCAR |c| 'COND)
+          ((AND (CONSP |c|) (EQ (CAR |c|) 'COND))
            (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|))))
           ('T
            (SETQ |c1|
                  (COND
-                   ((EQCAR |c| 'PROGN) (CDR |c|))
+                   ((AND (CONSP |c|) (EQ (CAR |c|) 'PROGN)) (CDR |c|))
                    (#0# (LIST |c|))))
            (LIST 'COND (CONS |a| |b1|) (CONS ''T |c1|))))))))
 
@@ -1689,7 +1707,7 @@
         (#0='T (SETQ |f| (CAR |x|))
          (COND
            ((ATOM |f|) (COND ((CDR |x|) NIL) ('T (LIST |f|))))
-           ((EQCAR |f| 'PROGN)
+           ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN))
             (COND
               ((CDR |x|)
                (LET ((|bfVar#111| NIL) (|bfVar#110| (CDR |f|))
@@ -1881,7 +1899,10 @@
 
 (DEFUN |bfNameArgs| (|x| |y|)
   (PROGN
-    (SETQ |y| (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|))))
+    (SETQ |y|
+          (COND
+            ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (CDR |y|))
+            ('T (LIST |y|))))
     (CONS |x| |y|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|))
@@ -1890,7 +1911,8 @@
   (PROG (|a| |f|)
     (RETURN
       (COND
-        ((NULL (CDR |x|)) (SETQ |f| (CAR |x|))
+        ((AND (CONSP |x|) (EQ (CDR |x|) NIL)
+              (PROGN (SETQ |f| (CAR |x|)) 'T))
          (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|))))
         ('T
          (SETQ |a|
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 6146ddc7..94aee881 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -13,8 +13,6 @@
 
 (DEFUN |char| (|x|) (CHAR (PNAME |x|) 0))
 
-(DEFUN EQCAR (|x| |y|) (AND (CONSP |x|) (EQ (CAR |x|) |y|)))
-
 (DEFUN STRINGIMAGE (|x|) (WRITE-TO-STRING |x|))
 
 (DEFUN |shoeCLOSE| (|stream|) (CLOSE |stream|))
@@ -134,17 +132,19 @@
   (PROG (|st|)
     (RETURN
       (COND
-        ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
+        ((OR (NULL |x|) (AND (CONSP |x|) (EQ (CAR |x|) '|nullstream|)))
+         T)
         ('T
          (LOOP
            (COND
-             ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+             ((NOT (AND (CONSP |x|) (EQ (CAR |x|) '|nonnullstream|)))
+              (RETURN NIL))
              ('T
               (PROGN
                 (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
                 (RPLACA |x| (CAR |st|))
                 (RPLACD |x| (CDR |st|))))))
-         (EQCAR |x| '|nullstream|))))))
+         (AND (CONSP |x|) (EQ (CAR |x|) '|nullstream|)))))))
 
 (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|)))
 
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 15e77276..44e1a285 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -33,7 +33,8 @@
             ('T (CAR |$inputStream|))))
     (SETQ |$ttok| (|shoeTokPart| |$stok|))
     (COND
-      ((AND (< 0 |$bpParenCount|) (EQCAR |$stok| 'KEY))
+      ((AND (< 0 |$bpParenCount|) (CONSP |$stok|)
+            (EQ (CAR |$stok|) 'KEY))
        (COND
          ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1))
           (|bpNext|))
@@ -291,15 +292,17 @@
 
 (DEFUN |bpEqPeek| (|s|)
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|)))
 
 (DEFUN |bpEqKey| (|s|)
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNext|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|)
+       (|bpNext|)))
 
 (DEFUN |bpEqKeyNextTok| (|s|)
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNextToken|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|)
+       (|bpNextToken|)))
 
 (DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB))
 
@@ -391,15 +394,15 @@
   (DECLARE (SPECIAL |$stok|))
   (COND
     ((|bpEqPeek| 'COLON-COLON) (|bpNext|)
-     (AND (EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|)
-          (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
+     (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (|bpPushId|)
+          (|bpNext|) (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|)))))
     ('T NIL)))
 
 (DEFUN |bpName| ()
   (DECLARE (SPECIAL |$stok|))
   (COND
-    ((EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|)
-     (|bpAnyNo| #'|bpQualifiedName|))
+    ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID)) (|bpPushId|)
+     (|bpNext|) (|bpAnyNo| #'|bpQualifiedName|))
     ('T NIL)))
 
 (DEFUN |bpConstTok| ()
@@ -407,10 +410,11 @@
   (COND
     ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT)) (|bpPush| |$ttok|)
      (|bpNext|))
-    ((EQCAR |$stok| 'LISP)
+    ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISP))
      (AND (|bpPush| (|%Lisp| |$ttok|)) (|bpNext|)))
-    ((EQCAR |$stok| 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|)))
-    ((EQCAR |$stok| 'LINE)
+    ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISPEXP))
+     (AND (|bpPush| |$ttok|) (|bpNext|)))
+    ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LINE))
      (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|)))
     ((|bpEqPeek| 'QUOTE) (|bpNext|)
      (AND (OR (|bpSexp|) (|bpTrap|))
@@ -533,7 +537,8 @@
     (DECLARE (SPECIAL |$ttok| |$stok|))
     (RETURN
       (COND
-        ((AND (EQCAR |$stok| 'KEY) (NOT (|bpExceptions|)))
+        ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY)
+              (NOT (|bpExceptions|)))
          (SETQ |a| (GET |$ttok| 'SHOEINF))
          (COND
            ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|)))
@@ -542,7 +547,9 @@
 
 (DEFUN |bpAnyId| ()
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (OR (AND (|bpEqKey| 'MINUS) (OR (EQCAR |$stok| 'INTEGER) (|bpTrap|))
+  (OR (AND (|bpEqKey| 'MINUS)
+           (OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER))
+               (|bpTrap|))
            (|bpPush| (- |$ttok|)) (|bpNext|))
       (|bpSexpKey|)
       (AND (MEMQ (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT))
@@ -573,13 +580,13 @@
 
 (DEFUN |bpPrefixOperator| ()
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|)
-       (|bpNext|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE)
+       (|bpPushId|) (|bpNext|)))
 
 (DEFUN |bpInfixOperator| ()
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|)
-       (|bpNext|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEINF)
+       (|bpPushId|) (|bpNext|)))
 
 (DEFUN |bpSelector| ()
   (AND (|bpEqKey| 'DOT)
@@ -615,8 +622,8 @@
 
 (DEFUN |bpInfKey| (|s|)
   (DECLARE (SPECIAL |$ttok| |$stok|))
-  (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|)
-       (|bpNext|)))
+  (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (MEMBER |$ttok| |s|)
+       (|bpPushId|) (|bpNext|)))
 
 (DEFUN |bpInfGeneric| (|s|)
   (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T)))
@@ -662,8 +669,9 @@
 (DEFUN |bpThetaName| ()
   (DECLARE (SPECIAL |$ttok| |$stok|))
   (COND
-    ((AND (EQCAR |$stok| 'ID) (GET |$ttok| 'SHOETHETA)) (|bpPushId|)
-     (|bpNext|))
+    ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID)
+          (GET |$ttok| 'SHOETHETA))
+     (|bpPushId|) (|bpNext|))
     ('T NIL)))
 
 (DEFUN |bpReduceOperator| ()
@@ -1138,7 +1146,7 @@
         (SETQ |b| (|bpPop1|))
         (|bpPush|
             (COND
-              ((EQCAR |b| '+LINE) (LIST |b|))
+              ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
               ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
                     (PROGN
                       (SETQ |ISTMP#1| (CDR |b|))
diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp
index 4b624e7e..79b45cc0 100644
--- a/src/boot/strap/pile.clisp
+++ b/src/boot/strap/pile.clisp
@@ -119,7 +119,7 @@
             (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
            (#0# (SETQ |d| (CADR |a|)) (SETQ |e| (|shoeTokPart| |d|))
             (COND
-              ((AND (EQCAR |d| 'KEY)
+              ((AND (CONSP |d|) (EQ (CAR |d|) 'KEY)
                     (OR (GET |e| 'SHOEINF) (EQ |e| 'COMMA)
                         (EQ |e| 'SEMICOLON)))
                (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index dfb850cb..341c0200 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -470,7 +470,8 @@
            (PROGN
              (SETQ |a| (CAR |s|))
              (COND
-               ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|))
+               ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE))
+                (|shoeFileLine| (CADR |a|) |st|))
                ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
              (SETQ |s| (CDR |s|)))))))))
 
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index ff7f2840..679bfafd 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -330,7 +330,7 @@ shoeFileLine(x, stream) ==
 shoeFileTrees(s,st)==
   while not bStreamNull s repeat
     a:= first s
-    if EQCAR (a,"+LINE")
+    if a is ["+LINE",:.]
     then shoeFileLine(second a,st)
     else 
       REALLYPRETTYPRINT(a,st)