* interp/debug.lisp: ident? in lieu of IDENTP.

	* interp/macros.lisp: Likewise.
	* interp/parsing.lisp: Likewise.
	* interp/sys-macros.lisp: Likewise.
	* interp/vmlisp.lisp: Likewise.
	(IDENTP): Remove.

6 files changed, 46 insertions, 44 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index a64c9eba..dd81d8c0 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2012-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/debug.lisp: ident? in lieu of IDENTP.
+	* interp/macros.lisp: Likewise.
+	* interp/parsing.lisp: Likewise.
+	* interp/sys-macros.lisp: Likewise.
+	* interp/vmlisp.lisp: Likewise.
+	(IDENTP): Remove.
+
+2012-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* boot/ast.boot (bfNumber?): Rename from bfSmintable.  Check for
 	floating point literals too. Adjust callers.
 	(bfLessp): Check for integer or floating pointer numbers.
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 3a00fcdb..5c4abac9 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -704,7 +704,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
         ((OR (HAS_SHARP_VAR (CAR X)) (HAS_SHARP_VAR (CDR X))))))
  
 (DEFUN IS_SHARP_VAR (X)
-  (AND (IDENTP X)
+  (AND (|ident?| X)
        (EQL (ELT (PNAME X) 0) #\#)
        (INTEGERP (parse-integer (symbol-name X) :start 1))))
  
@@ -1043,7 +1043,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
  
 (defun BPITRACE (BPI ALIAS &optional OPTIONS)
   (let ((NEWNAME (GENSYM)))
-    (IF (identp bpi) (setq bpi (symbol-function bpi)))
+    (IF (|ident?| bpi) (setq bpi (symbol-function bpi)))
     (SETF (SYMBOL-VALUE NEWNAME) BPI)
     (SETF (symbol-function NEWNAME) BPI)
     (/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 33d031aa..4ab528df 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -81,8 +81,8 @@
          (if (ATOM V)
              (COND ((NUMBERP U) (if (NUMBERP V) (> V U) T))
                    ((NUMBERP V) NIL)
-                   ((IDENTP U) (AND (IDENTP V) (string> (SYMBOL-NAME V) (SYMBOL-NAME U))))
-                   ((IDENTP V) NIL)
+                   ((|ident?| U) (AND (|ident?| V) (string> (SYMBOL-NAME V) (SYMBOL-NAME U))))
+                   ((|ident?| V) NIL)
                    ((STRINGP U) (AND (STRINGP V) (string> V U)))
                    ((STRINGP V) NIL)
                    ((AND (simple-vector-p U) (simple-vector-p V))
@@ -128,12 +128,12 @@
 (DEFUN GENVAR () (INTERNL "$" (STRINGIMAGE (SETQ $GENNO (1+ $GENNO)))))
  
 (DEFUN IS_GENVAR (X)
-  (AND (IDENTP X)
+  (AND (|ident?| X)
        (let ((y (symbol-name x)))
          (and (char= #\$ (elt y 0)) (> (size y) 1) (digitp (elt y 1))))))
  
 (DEFUN IS_\#GENVAR (X)
-  (AND (IDENTP X)
+  (AND (|ident?| X)
        (let ((y (symbol-name x)))
          (and (char= #\# (ELT y 0)) (> (SIZE Y) 1) (DIGITP (ELT Y 1))))))
  
@@ -155,7 +155,7 @@
 ; 14.1 Simple Sequence Functions
  
 (defun GETCHARN (A M) "Return the code of the Mth character of A"
-  (let ((a (if (identp a) (symbol-name a) a))) (char-code (elt A M))))
+  (let ((a (if (|ident?| a) (symbol-name a) a))) (char-code (elt A M))))
  
 ; 14.2 Concatenating, Mapping, and Reducing Sequences
  
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index a8bf8ea3..5f52da48 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -500,7 +500,7 @@ the stack, then stack a NIL. Return the value of prod."
      a1  ;;(cond (ok (go b1)))               (princ "/ok= NIL")
      b1  ;;(cond ( (not stackx) (go c1)))   (princ "/stackx= ")
          ;;(prin1 stackx)
-     c1  (cond ( (not (identp tok)) (go d1)))
+     c1  (cond ( (not (|ident?| tok)) (go d1)))
          (princ "/isid= ")
         ;; (princ (cond (isid "T") (t "NIL")))
      d1  (princ "/stack= ")            (prin1 (|stackStore| |$reduceStack|))
@@ -515,7 +515,7 @@ the stack, then stack a NIL. Return the value of prod."
          (princ (if nonblank "T" "NIL"))
      a2  ;;(if ok (go b2))                   (princ "/ok= ")          (prin1 ok)
      b2  ;;(if (not stackx) (go c2))        (princ "/stackx1= ")     (prin1 stackx)
-     c2  (if (not (identp tok)) (go d2))
+     c2  (if (not (|ident?| tok)) (go d2))
          (princ "/isid= ")
         ;; (princ (if isid "T" "NIL"))
      d2  (princ "/stack= ")            (prin1 (|stackStore| |$reduceStack|))
@@ -590,7 +590,7 @@ the stack, then stack a NIL. Return the value of prod."
 ;; auxiliary functions needed by the parser
 
 (Defun FLOATEXPID (X &aux S)
-  (if (AND (IDENTP X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
+  (if (AND (|ident?| X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
            (> (LENGTH S) 1)
            (SPADREDUCE AND 0 (COLLECT (STEP I 1 1 (MAXINDEX S))
                                       (DIGITP (ELT S I)))))
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 966626d2..95d4e898 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2011, Gabriel Dos Reis.
+;; Copyright (C) 2007-2012, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -134,7 +134,7 @@
  #-:common-lisp (compile load eval)
  (defun IDENT-CHAR-LIT (x)
    (and (EQCAR x 'quote) 
-	(IDENTP (cadr x))
+	(|ident?| (cadr x))
 	(= (length (PNAME (cadr x))) 1)))) 
 
 (defmacro BOOT-EQUAL (a b)
@@ -690,7 +690,7 @@
 	   ((CONS (|reverse!| LP) (MKPF L 'PROGN)))))
    
    (defun MK_LEFORM (U)
-     (COND ((IDENTP U) 
+     (COND ((|ident?| U) 
 	    (PNAME U))
 	   ((STRINGP U)
 	    U)
@@ -956,7 +956,7 @@
 	(if (OR (ATOM L) (ATOM (CDR L)))
 	    (GO BADO))
 	(setq vl (POP L))
-	(COND ((IDENTP VL)
+	(COND ((|ident?| VL)
 	       (SETQ VARS (LIST VL))
 	       (AND (OR (ATOM L)
 			(ATOM (progn (setq inits (POP L)) L))
@@ -974,7 +974,7 @@
 		     G180   
 		     (AND (NOT (CONSP (SETQ V (CAR VL)))) 
 			  (SETQ V (LIST V)))
-		     (AND (NOT (IDENTP (CAR V)))
+		     (AND (NOT (|ident?| (CAR V)))
 			  (GO BADO))
 		     (PUSH (CAR V) VARS)
 		     (PUSH (COND ((CONSP (CDR V)) (CADR V))) INITS)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 6282e0d4..bb74f3cd 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -147,13 +147,6 @@
 (defmacro |idChar?| (x)
  `(or (alphanumericp ,x) (member ,x '(#\? #\% #\' #\!) :test #'char=)))
  
-(defmacro identp (x) 
- (if (atom x)
-  `(and ,x (symbolp ,x))
-   (let ((xx (gensym)))
-    `(let ((,xx ,x))
-      (and ,xx (symbolp ,xx))))))
-
 (defmacro ifcar (x)
   (if (atom x)
       `(and (consp ,x) (qcar ,x))
@@ -494,7 +487,7 @@
                (eq f 'fluid)
                (listp (cdr arglist))
                (setq v (cadr arglist))
-               (identp v)
+               (|ident?| v)
                (null (cddr arglist)))
           (push v *decl*)
           (push v *vars*)
@@ -564,7 +557,7 @@
 
 (defun upcase (l)
   (cond ((stringp l) (string-upcase l))
-        ((identp l) (intern (string-upcase (symbol-name l))))
+        ((|ident?| l) (intern (string-upcase (symbol-name l))))
         ((characterp l) (char-upcase l))
         ((atom l) l)
         (t (mapcar #'upcase l))))
@@ -574,7 +567,7 @@
 
 (defun downcase (l)
   (cond ((stringp l) (string-downcase l))
-        ((identp l) (intern (string-downcase (symbol-name l))))
+        ((|ident?| l) (intern (string-downcase (symbol-name l))))
         ((characterp l) (char-downcase L))
         ((atom l) l)
         (t (mapcar #'downcase l))))
@@ -701,7 +694,7 @@
 ; 17.0 Operations on Character and Bit Vectors
 
 (defun charp (a) (or (characterp a)
-                     (and (identp a) (= (length (symbol-name a)) 1))))
+                     (and (|ident?| a) (= (length (symbol-name a)) 1))))
 
 (defun NUM2CHAR (n) (code-char n))
 
@@ -876,7 +869,7 @@
   (PROG (D A I L C W)
         (declare (special pvl avl))
     (COND ((EQ FORM SV) (RETURN NIL))
-          ((IDENTP FORM) (RETURN `((setq ,form ,sv)) ))
+          ((|ident?| FORM) (RETURN `((setq ,form ,sv)) ))
           ((simple-vector-p FORM)
            (RETURN (SEQ
              (setq L (length FORM))
@@ -888,7 +881,7 @@
              (COND ((AND (NULL W) (OR (consp A) (simple-vector-p A)))
                     (COND ((consp AVL) (setq W (car (RESETQ AVL (cdr AVL)))))
                           ((setq PVL (CONS (setq W (GENSYM)) PVL))))))
-             (setq C (|append!| (COND ((IDENTP A) `((setq ,a (ELT ,sv ,i))))
+             (setq C (|append!| (COND ((|ident?| A) `((setq ,a (ELT ,sv ,i))))
                                   ((OR (consp A) (simple-vector-p A))
                                    `((setq ,w (ELT ,sv ,i))
                                      ,@(dcqgenexp w a eqtag qflag))))
@@ -906,24 +899,24 @@
           ((AND EQTAG (EQ (car FORM) EQTAG))
            (RETURN
              (COND
-               ((OR (NOT (EQ 3 (LENGTH FORM))) (NOT (IDENTP (car (setq FORM (cdr FORM))))))
+               ((OR (NOT (EQ 3 (LENGTH FORM))) (NOT (|ident?| (car (setq FORM (cdr FORM))))))
                 (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM (MAKESTRING "invalid pattern.")))
                (`((setq ,(car form) ,sv)  ,@(DCQGENEXP SV (CADR FORM) EQTAG QFLAG)))))))
     (setq A (car FORM))
     (setq D (cdr FORM))
-    (setq C (COND ((IDENTP A) `((setq ,a (CAR ,sv))))
+    (setq C (COND ((|ident?| A) `((setq ,a (CAR ,sv))))
                   ((OR (consp A) (simple-vector-p A))
-                   (COND ((AND (NULL D) (IDENTP SV)) )
+                   (COND ((AND (NULL D) (|ident?| SV)) )
                          ((COND ((consp AVL) (setq W (car (RESETQ AVL (cdr AVL)))))
                                 ((setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) ) )
                    (COND ((AND (consp A) EQTAG (EQ (car A) EQTAG))
                           (DCQGENEXP (LIST 'CAR SV) A EQTAG QFLAG) )
                          (`((setq ,(or w sv) (CAR ,sv))
                             ,@(DCQGENEXP (OR W SV) A EQTAG QFLAG)))))))
-    (setq C (|append!| C (COND ((IDENTP D) `((setq ,d (CDR ,sv))))
+    (setq C (|append!| C (COND ((|ident?| D) `((setq ,d (CDR ,sv))))
                            ((OR (consp D) (simple-vector-p D))
                             (COND
-                              ((OR W (IDENTP SV)) )
+                              ((OR W (|ident?| SV)) )
                               ((COND ((consp AVL)
                                       (setq W (car (RESETQ AVL (cdr AVL)))) )
                                      ((setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) ) )
@@ -967,7 +960,7 @@
         (COND
           ((EQ FORM SV) (RETURN NIL))
           ((OR
-              (IDENTP FORM)
+              (|ident?| FORM)
               (NUMP FORM)
               (AND (consp FORM) (EQ (qcar FORM) 'QUOTE)))
            (RETURN
@@ -988,7 +981,7 @@
                     (|append!|
                       (COND
                         ( (OR
-                            (IDENTP A)
+                            (|ident?| A)
                             (NUMP A)
                             (AND (consp A) (EQ (qcar A) 'QUOTE)))
                          `((COND ( (NOT (EQ ,a (ELT ,sv ,i)))
@@ -1017,7 +1010,7 @@
            (setq PVL (CONS (setq W (GENSYM)) PVL)))
         (setq C
               (COND
-                ( (OR (IDENTP A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+                ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
                  `((COND ((NOT (EQ ,a (CAR ,sv))) (GO BAD))) ))
                 ( (OR (consp A) (simple-vector-p A))
                  `((setq ,w (CAR ,sv))
@@ -1026,7 +1019,7 @@
               (|append!|
                 C
                 (COND
-                  ( (OR (IDENTP D) (NUMP D) (AND (consp D)
+                  ( (OR (|ident?| D) (NUMP D) (AND (consp D)
                                                  (EQ (car D) 'QUOTE)))
                    `((COND ((NOT (EQ ,d (CDR ,sv))) (GO BAD))) ))
                   ( (OR (consp D) (simple-vector-p D))
@@ -1089,7 +1082,7 @@
               (|append!|
                 (COND
                   ( (OR
-                      (IDENTP A)
+                      (|ident?| A)
                       (NUMP A)
                       (AND (consp A) (EQ (car A) 'QUOTE)))
                     `((SETF (ELT ,sv ,i) ,a)))
@@ -1121,7 +1114,7 @@
           (setq PVL (CONS (setq W (GENSYM)) PVL)) ) )
       (setq C
         (COND
-          ( (OR (IDENTP A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+          ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
             `((rplaca ,sv ,a)))
           ( (OR (consp A) (simple-vector-p A))
             `((setq ,w (CAR ,sv))
@@ -1130,7 +1123,7 @@
         (|append!|
           C
           (COND
-            ( (OR (IDENTP D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE)))
+            ( (OR (|ident?| D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE)))
               `((RPLACD ,sv ,d)))
             ( (OR (consp D) (simple-vector-p D))
               `((setq ,sv (CDR ,sv))
@@ -1237,7 +1230,7 @@
 (defun EMBED (CURRENT-BINDING NEW-DEFINITION)
   (PROG (OP BV BODY OLD-DEF)
       (COND
-        ( (NOT (IDENTP CURRENT-BINDING))
+        ( (NOT (|ident?| CURRENT-BINDING))
           (SETQ CURRENT-BINDING
                 (error (format nil "invalid argument ~s to EMBED" CURRENT-BINDING))) ) )
       (SETQ OLD-DEF (symbol-function CURRENT-BINDING))
@@ -1309,13 +1302,13 @@
 
 (defun VARP (TEST-ITEM)
     (COND
-      ( (IDENTP TEST-ITEM)
+      ( (|ident?| TEST-ITEM)
         TEST-ITEM )
       ( (AND
           (consp TEST-ITEM)
           (OR (EQ (QCAR TEST-ITEM) 'FLUID) (EQ (QCAR TEST-ITEM) 'LEX))
           (consp (QCDR TEST-ITEM))
-          (IDENTP (QCADR TEST-ITEM)))
+          (|ident?| (QCADR TEST-ITEM)))
         TEST-ITEM )
       ( 'T
         NIL ) ) )
@@ -1340,7 +1333,7 @@
 (defun doDSETQ (form pattern exp)
   (let (PVL AVL)
     (declare (special PVL AVL))
-    (COND ((IDENTP PATTERN)
+    (COND ((|ident?| PATTERN)
            (LIST 'SETQ PATTERN EXP))
           ((AND (NOT (consp PATTERN)) (NOT (simple-vector-p PATTERN)))
            (MACRO-INVALIDARGS 'DSETQ FORM "constant target."))