* boot/initial-env.lisp (IDENTP): Remove.

	* boot/ast.boot: Replace IDENTP with symbol? where appropriate.
	* boot/parser.boot: Likewise.
	* boot/translator.boot: Likewise.

8 files changed, 49 insertions, 41 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 6c28c380..7912902e 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
 2010-12-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/initial-env.lisp (IDENTP): Remove.
+	* boot/ast.boot: Replace IDENTP with symbol? where appropriate.
+	* boot/parser.boot: Likewise.
+	* boot/translator.boot: Likewise.
+
+2010-12-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* boot/includer.boot (char): Move to token.boot.
 	* boot/tokens.boot (shoeStartsId): Move from initial-env.lisp
 	(shoeIdChar): Likewise.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index fde74059..bd4402e0 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -206,7 +206,8 @@ compFluid id ==
   ["FLUID",id]
  
 compFluidize x==
-  IDENTP x and bfBeginsDollar x=>compFluid x
+  x = nil => nil
+  symbol? x and bfBeginsDollar x=>compFluid x
   atom x => x
   x is ["QUOTE",:.] => x
   [compFluidize(first x),:compFluidize(rest x)]
@@ -515,27 +516,27 @@ bfLetForm(lhs,rhs) ==
   ['L%T,lhs,rhs]
  
 bfLET1(lhs,rhs) ==
-  IDENTP lhs        => bfLetForm(lhs,rhs)
+  symbol? lhs        => bfLetForm(lhs,rhs)
   lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
-  IDENTP rhs and not bfCONTAINED(rhs,lhs) =>
+  symbol? rhs and not bfCONTAINED(rhs,lhs) =>
     rhs1 := bfLET2(lhs,rhs)
     rhs1 is ["L%T",:.]   => bfMKPROGN [rhs1,rhs]
     rhs1 is ["PROGN",:.] => [:rhs1,:[rhs]]
-    if IDENTP first rhs1 then rhs1 := [rhs1,:nil]
+    if symbol? first rhs1 then rhs1 := [rhs1,:nil]
     bfMKPROGN [:rhs1,rhs]
-  rhs is ["L%T",:.] and IDENTP(name := second rhs) =>
+  rhs is ["L%T",:.] and symbol?(name := second rhs) =>
     -- handle things like [a] := x := foo
     l1 := bfLET1(name,third rhs)
     l2 := bfLET1(lhs,name)
     l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2]
-    if IDENTP first l2 then l2 := [l2,:nil]
+    if symbol? first l2 then l2 := [l2,:nil]
     bfMKPROGN [l1,:l2,name]
   g := INTERN strconc('"LETTMP#",toString $letGenVarCounter)
   $letGenVarCounter := $letGenVarCounter + 1
   rhs1 := ['L%T,g,rhs]
   let1 := bfLET1(lhs,g)
   let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1]
-  if IDENTP first let1 then let1 := [let1,:nil]
+  if symbol? first let1 then let1 := [let1,:nil]
   bfMKPROGN [rhs1,:let1,g]
  
 bfCONTAINED(x,y)==
@@ -544,8 +545,8 @@ bfCONTAINED(x,y)==
     bfCONTAINED(x,first y) or bfCONTAINED(x,rest y)
  
 bfLET2(lhs,rhs) ==
-  IDENTP lhs => bfLetForm(lhs,rhs)
   lhs = nil => nil
+  symbol? lhs => bfLetForm(lhs,rhs)
   lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
   lhs is ['L%T,a,b] =>
     a := bfLET2(a,rhs)
@@ -559,7 +560,7 @@ bfLET2(lhs,rhs) ==
     l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
     var2 = nil or var2 = "DOT" =>l1
     if cons? l1 and atom first l1 then l1 := [l1,:nil]
-    IDENTP var2 =>
+    symbol? var2 =>
       [:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
     l2 := bfLET2(var2,addCARorCDR('CDR,rhs))
     if cons? l2 and atom first l2 then l2 := [l2,:nil]
@@ -680,7 +681,7 @@ bfIS1(lhs,rhs) ==
 
 
 bfHas(expr,prop) ==
-  IDENTP prop => ["GET",expr,["QUOTE",prop]]
+  symbol? prop => ["GET",expr,["QUOTE",prop]]
   bpSpecificErrorHere('"expected identifier as property name")
   
 bfApplication(bfop, bfarg) ==
@@ -740,7 +741,7 @@ bfAND l ==
  
  
 defQuoteId x==  
-  x is ["QUOTE",:.] and IDENTP second x
+  x is ["QUOTE",:.] and symbol? second x
  
 bfSmintable x==
   integer? x or cons? x and first x in '(SIZE LENGTH char QENUM)
@@ -844,7 +845,7 @@ bfInsertLet(x,body)==
  
 bfInsertLet1(y,body)==
   y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
-  IDENTP y => [false,nil,y,body]
+  symbol? y => [false,nil,y,body]
   y is ["BVQUOTE",b] => [true,"QUOTE",b,body]
   g:=bfGenSymbol()
   atom y => [false,nil,g,body]
@@ -895,7 +896,7 @@ shoePROG(v,b)==
 
 shoeFluids x==
   x = nil => nil
-  IDENTP x and bfBeginsDollar x => [x]
+  symbol? x and bfBeginsDollar x => [x]
   atom x => nil
   x is ["QUOTE",:.] => nil
   [:shoeFluids first x,:shoeFluids rest x]
@@ -908,7 +909,7 @@ shoeATOMs x ==
 ++ Return true if `x' is an identifier name that designates a
 ++ dynamic (e.g. Lisp special) variable.  
 isDynamicVariable x ==
-  IDENTP x and bfBeginsDollar x =>
+  symbol? x and bfBeginsDollar x =>
     MEMQ(x,$constantIdentifiers) => false
     CONSTANTP x => false
     BOUNDP x or $activeNamespace = nil => true
@@ -928,7 +929,7 @@ shoeCompTran1 x==
   x is ["L%T",l,r] =>
     x.first := "SETQ"
     shoeCompTran1 r
-    IDENTP l =>
+    symbol? l =>
       not bfBeginsDollar l=>
 	$locVars:=
 	   MEMQ(l,$locVars)=>$locVars
@@ -955,7 +956,7 @@ shoeCompTran1 x==
  
 bfTagged(a,b)==
   $op = nil => %Signature(a,b)        -- surely a toplevel decl
-  IDENTP a =>
+  symbol? a =>
     b = "FLUID" =>  bfLET(compFluid a,nil)
     b = "fluid" =>  bfLET(compFluid a,nil)
     b = "local" =>  bfLET(compFluid a,nil)
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index a4b45b76..b5e9d869 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -178,9 +178,6 @@
 (defun bvec-setelt (bv i x)
   (setf (sbit bv i) x))
 
-(defun identp (a) 
-  (and (symbolp a) a))
-
 (defun |shoeReadLisp| (s n)
   (multiple-value-list (read-from-string s nil nil :start n)))
 
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 4d475238..14cbd4a0 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -1159,7 +1159,7 @@ bpOutItem()==
   b:=bpPop1()
   bpPush 
     b is ["+LINE",:.] => [ b ]
-    b is ["L%T",l,r] and IDENTP l => 
+    b is ["L%T",l,r] and symbol? l => 
       $InteractiveMode => [["SETQ",l,r]]
       [["DEFPARAMETER",l,r]]
     translateToplevel(b,false)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index ba658ba5..e491f548 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -234,7 +234,8 @@
 
 (DEFUN |compFluidize| (|x|)
   (COND
-    ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
+    ((NULL |x|) NIL)
+    ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
     ((ATOM |x|) |x|)
     ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|)
     (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
@@ -721,13 +722,13 @@
     (DECLARE (SPECIAL |$letGenVarCounter|))
     (RETURN
       (COND
-        ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
+        ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
         ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
               (PROGN
                 (SETQ |ISTMP#1| (CDR |lhs|))
                 (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
          (|bfLetForm| |lhs| |rhs|))
-        ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
+        ((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
          (SETQ |rhs1| (|bfLET2| |lhs| |rhs|))
          (COND
            ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T))
@@ -735,16 +736,18 @@
            ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN))
             (APPEND |rhs1| (LIST |rhs|)))
            (T (COND
-                ((IDENTP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL))))
+                ((SYMBOLP (CAR |rhs1|))
+                 (SETQ |rhs1| (CONS |rhs1| NIL))))
               (|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL))))))
         ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T)
-              (IDENTP (SETQ |name| (CADR |rhs|))))
+              (SYMBOLP (SETQ |name| (CADR |rhs|))))
          (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|)))
          (SETQ |l2| (|bfLET1| |lhs| |name|))
          (COND
            ((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN))
             (|bfMKPROGN| (CONS |l1| (CDR |l2|))))
-           (T (COND ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
+           (T (COND
+                ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
               (|bfMKPROGN| (CONS |l1| (APPEND |l2| (CONS |name| NIL)))))))
         (T (SETQ |g|
                  (INTERN (CONCAT "LETTMP#"
@@ -756,7 +759,7 @@
              ((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN))
               (|bfMKPROGN| (CONS |rhs1| (CDR |let1|))))
              (T (COND
-                  ((IDENTP (CAR |let1|))
+                  ((SYMBOLP (CAR |let1|))
                    (SETQ |let1| (CONS |let1| NIL))))
                 (|bfMKPROGN|
                     (CONS |rhs1| (APPEND |let1| (CONS |g| NIL)))))))))))
@@ -773,8 +776,8 @@
     (DECLARE (SPECIAL |$inDefIS| |$letGenVarCounter|))
     (RETURN
       (COND
-        ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
         ((NULL |lhs|) NIL)
+        ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
         ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
               (PROGN
                 (SETQ |ISTMP#1| (CDR |lhs|))
@@ -815,7 +818,7 @@
                      ((AND (CONSP |l1|) (ATOM (CAR |l1|)))
                       (SETQ |l1| (CONS |l1| NIL))))
                    (COND
-                     ((IDENTP |var2|)
+                     ((SYMBOLP |var2|)
                       (APPEND |l1|
                               (CONS (|bfLetForm| |var2|
                                      (|addCARorCDR| 'CDR |rhs|))
@@ -1077,7 +1080,7 @@
 
 (DEFUN |bfHas| (|expr| |prop|)
   (COND
-    ((IDENTP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|)))
+    ((SYMBOLP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|)))
     (T (|bpSpecificErrorHere| "expected identifier as property name"))))
 
 (DEFUN |bfApplication| (|bfop| |bfarg|)
@@ -1196,7 +1199,7 @@
                  (SETQ |bfVar#98| (CDR |bfVar#98|))))))))
 
 (DEFUN |defQuoteId| (|x|)
-  (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|))))
+  (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|))))
 
 (DEFUN |bfSmintable| (|x|)
   (OR (INTEGERP |x|)
@@ -1445,7 +1448,7 @@
                             (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
          (LIST NIL NIL |l|
                (|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|))))
-        ((IDENTP |y|) (LIST NIL NIL |y| |body|))
+        ((SYMBOLP |y|) (LIST NIL NIL |y| |body|))
         ((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)
               (PROGN
                 (SETQ |ISTMP#1| (CDR |y|))
@@ -1546,7 +1549,7 @@
 (DEFUN |shoeFluids| (|x|)
   (COND
     ((NULL |x|) NIL)
-    ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
+    ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
     ((ATOM |x|) NIL)
     ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) NIL)
     (T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|))))))
@@ -1562,7 +1565,7 @@
     (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|))
     (RETURN
       (COND
-        ((AND (IDENTP |x|) (|bfBeginsDollar| |x|))
+        ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|))
          (COND
            ((MEMQ |x| |$constantIdentifiers|) NIL)
            ((CONSTANTP |x|) NIL)
@@ -1600,7 +1603,7 @@
                                  (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
               (RPLACA |x| 'SETQ) (|shoeCompTran1| |r|)
               (COND
-                ((IDENTP |l|)
+                ((SYMBOLP |l|)
                  (COND
                    ((NOT (|bfBeginsDollar| |l|))
                     (SETQ |$locVars|
@@ -1655,7 +1658,7 @@
   (DECLARE (SPECIAL |$typings| |$op|))
   (COND
     ((NULL |$op|) (|%Signature| |a| |b|))
-    ((IDENTP |a|)
+    ((SYMBOLP |a|)
      (COND
        ((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL))
        ((EQ |b| '|fluid|) (|bfLET| (|compFluid| |a|) NIL))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 77744484..7b978080 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -1221,7 +1221,7 @@
                              (AND (CONSP |ISTMP#2|)
                                   (NULL (CDR |ISTMP#2|))
                                   (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
-                    (IDENTP |l|))
+                    (SYMBOLP |l|))
                (COND
                  (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
                  (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index e96bf98a..c941265d 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -920,7 +920,7 @@
       (COND
         ((ATOM |y|)
          (COND
-           ((IDENTP |y|)
+           ((SYMBOLP |y|)
             (SETQ |$used|
                   (COND
                     ((MEMQ |y| |e|) |$used|)
@@ -1148,7 +1148,7 @@
   (COND
     ((ATOM |x|)
      (COND
-       ((IDENTP |x|)
+       ((SYMBOLP |x|)
         (COND
           ((EQUAL (SYMBOL-PACKAGE |x|) |bt|) (INTERN (PNAME |x|) |pk|))
           (T |x|)))
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 84f3c9ec..5d2e0a71 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -543,7 +543,7 @@ defuse(e,x)==
  
 defuse1(e,y)==
   atom y =>
-      IDENTP y =>
+      symbol? y =>
 	 $used:=
 	      MEMQ(y,e)=>$used
 	      MEMQ(y,$used)=>$used
@@ -659,7 +659,7 @@ shoeItem (str)==
  
 stripm (x,pk,bt)==
   atom x =>
-    IDENTP x =>
+    symbol? x =>
       SYMBOL_-PACKAGE x = bt => INTERN(PNAME x,pk)
       x
     x