* lisp/core.lisp.in (fixnum?): New.

	* algebra/sex.spad.pamphlet: Use %float? instead of RNUM.
	Use %integer? instead of INTP.
	* interp/g-timer.boot: Use float? instead of RNUMP.
	* interp/i-coerce.boot: Use fixnum? instead of SINTP or SMINTP.
	* interp/i-intern.boot: Likewise.
	* interp/lisp-backend.boot: Likewise.
	* interp/slam.boot: Likewise.
	* interp/trace.boot: Likewise.
	* interp/vmlisp.lisp: Likewise.
	(INTP): Remove.
	(BINTP): Likewise.
	(LESSP): Likewise.
	(LINTP): Likewise.
	(MAKESTRING): Likewise.
	(MAPELT): Likewise.
	(NUMP): Likewise.
	(RNUMP): Likewise.
	(SINTP): Likewise.
	(SMINTP): Likewise.

11 files changed, 57 insertions, 75 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index dd81d8c0..bedb47dd 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,28 @@
 2012-04-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* lisp/core.lisp.in (fixnum?): New.
+	* algebra/sex.spad.pamphlet: Use %float? instead of RNUM.
+	Use %integer? instead of INTP.
+	* interp/g-timer.boot: Use float? instead of RNUMP.
+	* interp/i-coerce.boot: Use fixnum? instead of SINTP or SMINTP.
+	* interp/i-intern.boot: Likewise.
+	* interp/lisp-backend.boot: Likewise.
+	* interp/slam.boot: Likewise.
+	* interp/trace.boot: Likewise.
+	* interp/vmlisp.lisp: Likewise.
+	(INTP): Remove.
+	(BINTP): Likewise.
+	(LESSP): Likewise.
+	(LINTP): Likewise.
+	(MAKESTRING): Likewise.
+	(MAPELT): Likewise.
+	(NUMP): Likewise.
+	(RNUMP): Likewise.
+	(SINTP): Likewise.
+	(SMINTP): Likewise.
+
+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.
diff --git a/src/algebra/sex.spad.pamphlet b/src/algebra/sex.spad.pamphlet
index cf7d13fb..7348c933 100644
--- a/src/algebra/sex.spad.pamphlet
+++ b/src/algebra/sex.spad.pamphlet
@@ -95,6 +95,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
 
     Body ==> add
         import %integer?: % -> Boolean  from Foreign Builtin
+        import %float?: % -> Boolean    from Foreign Builtin
         import %string?: % -> Boolean   from Foreign Builtin
         import %ident?: % -> Boolean    from Foreign Builtin
         import %pair?: % -> Boolean     from Foreign Builtin
@@ -133,13 +134,13 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
         string?  b   == %string? b
         symbol?  b   == %ident? b
         integer? b   == %integer? b
-        float?   b   == RNUMP(b)$Lisp
+        float?   b   == %float? b
 
         destruct b == (list? b    => b pretend List %; error "Non-list")
         string b == (%string? b => b pretend Str; error "Non-string")
         symbol b == (%ident? b => b pretend Sym;error "Non-symbol")
-        float   b == (RNUMP(b)$Lisp  => b pretend Flt;error "Non-float")
-        integer b == (INTP(b)$Lisp => b pretend Int;error "Non-integer")
+        float   b == (%float? b  => b pretend Flt;error "Non-float")
+        integer b == (%integer? b => b pretend Int;error "Non-integer")
         expr    b == b pretend Expr
 
         convert(l:  List %) == l  pretend %
diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot
index f3d9a4a0..a93d01e1 100644
--- a/src/interp/g-timer.boot
+++ b/src/interp/g-timer.boot
@@ -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
@@ -95,7 +95,7 @@ makeLongStatStringByProperty _
   strconc(str, '" = ", total)
  
 normalizeStatAndStringify t ==
-  RNUMP t =>
+  float? t =>
       t := roundStat t
       t = 0.0 => '"0"
       FORMAT(nil,'"~,2F",t)
@@ -108,12 +108,12 @@ normalizeStatAndStringify t ==
   STRINGIMAGE t
  
 significantStat t ==
-   RNUMP t => (t > 0.01)
+   float? t => (t > 0.01)
    integer?  t => (t > 100)
    true
  
 roundStat t ==
-  not RNUMP t => t
+  not float? t => t
   QUOTIENT(FIX (0.5 + t * 1000.0), 1000.0)
  
 makeStatString(oldstr,time,abb,flag) ==
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index dc951db6..43bf5694 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -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
@@ -107,7 +107,7 @@ retract1 object ==
   val := objVal object
   type = $PositiveInteger =>    objNew(val,$NonNegativeInteger)
   type = $NonNegativeInteger => objNew(val,$Integer)
-  type = $Integer and SINTP unwrap val => objNew(val, $SingleInteger)
+  type = $Integer and fixnum? unwrap val => objNew(val, $SingleInteger)
   type' := equiType(type)
   if not sameObject?(type,type') then object := objNew(val,type')
   (1 = #type') or (type' is ['Union,:.]) or
@@ -261,7 +261,7 @@ coerceRetract(object,t2) ==
   (val := objValUnwrap(object)) = "$fromCoerceable$" => nil
   t1 := objMode object
   t2 = $OutputForm => nil
-  isEqualOrSubDomain(t1,$Integer) and typeIsASmallInteger(t2) and SMINTP(val) =>
+  isEqualOrSubDomain(t1,$Integer) and typeIsASmallInteger(t2) and fixnum?(val) =>
     objNewWrap(val,t2)
   t1 = $Integer    => nil
   t1 = $Symbol     => nil
@@ -820,12 +820,12 @@ coerceInt1(triple,t2) ==
 
   if typeIsASmallInteger(t1) then
     (t2 = $Integer) or typeIsASmallInteger(t2) => return objNew(val,t2)
-    sintp := SINTP val
+    sintp := fixnum? val
     sintp and (t2 = $PositiveInteger) and val > 0 => return objNew(val,t2)
     sintp and (t2 = $NonNegativeInteger) and val >= 0 => return objNew(val,t2)
 
-  typeIsASmallInteger(t2) and isEqualOrSubDomain(t1, $Integer) and INTP val =>
-    SINTP val => objNew(val,t2)
+  typeIsASmallInteger(t2) and isEqualOrSubDomain(t1, $Integer) and integer? val =>
+    fixnum? val => objNew(val,t2)
     nil
 
   t2 = $Void => objNew(voidValue(),$Void)
diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot
index bf42e2cf..407b0717 100644
--- a/src/interp/i-coerfn.boot
+++ b/src/interp/i-coerfn.boot
@@ -1157,23 +1157,6 @@ Qf2F(u,source is [.,D,:.],target) ==
 Rn2F(rnum, source, target) ==
   float QUOTIENT(first rnum, rest rnum)
 
--- next function is needed in RN algebra code
---Rn2F([a,:b],source,target) ==
---  al:=if LINTP a then QLENGTHCODE a else 4
---  bl:=if LINTP b then QLENGTHCODE b else 4
---  MAX(al,bl) < 36 => FLOAT a / FLOAT b
---  sl:=0
---  if al>32 then
---     sl:=35*(al-32)/4
---     a:=a/2**sl
---  if bl>32 then
---     sbl:=35*(bl-32)/4
---     b:=b/2**sbl
---     sl:=sl-sbl
---  ans:=FLOAT a /FLOAT b
---  sl=0 => ans
---  ans*2**sl
-
 Qf2domain(u,source is [.,D],target) ==
   -- tests whether it is an element of the underlying domain
   useUnder := (ut := underDomainOf target) and canCoerce(source,ut)
diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot
index 2dc3e34a..82309cc5 100644
--- a/src/interp/i-intern.boot
+++ b/src/interp/i-intern.boot
@@ -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
@@ -176,7 +176,7 @@ mkAtree2(x,op,argl) ==
       integer? a =>
         a >= 0 => mkAtree1 [['_$elt,D,internalName a]]
         t := evaluateType unabbrev [D]
-        typeIsASmallInteger(t) and SINTP a =>
+        typeIsASmallInteger(t) and fixnum? a =>
             v := mkAtreeNode $immediateDataSymbol
             putValue(v,objNewWrap(a, t))
             v
diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot
index b23d1bf6..684810ca 100644
--- a/src/interp/lisp-backend.boot
+++ b/src/interp/lisp-backend.boot
@@ -517,7 +517,7 @@ for x in [
     ['%ieven?,  :'EVENP],
     ['%integer?,:'INTEGERP],
     ['%iodd?,   :'ODDP],
-    ['%ismall?, :'SMINTP],
+    ['%ismall?, :'fixnum?],
     ['%i2s,   :'WRITE_-TO_-STRING],
     ['%ilength, :'INTEGER_-LENGTH],
     ['%ibit,    :'INTEGER_-BIT],
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 13768228..b6fc6a86 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -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
@@ -130,7 +130,7 @@ mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) ==
   body is [fn,:argl] =>
     (fn = op) and argl.(sharpPosition-1) is
       ['SPADCALL,=sharpArg,n,["ELT",["%dynval",=MKQ vecname],=diffSlot]] =>
-          NUMP n and n > 0 and n <= k =>
+          integer? n and n > 0 and n <= k =>
             [[body,:$TriangleVariableList.n]]
           ['$failed]
     "union"/[mkDiffAssoc(op,x,k,sharpPosition,sharpArg,diffSlot,vecname) for x in argl]
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 8e09eeff..9b4d051b 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -678,7 +678,7 @@ orderBySlotNumber l ==
   ASSOCRIGHT orderList [[n,:x] for (x:= [.,.,n,:.]) in l]
 
 _/TRACEREPLY() ==
-  null _/TRACENAMES => MAKESTRING '"   Nothing is traced."
+  null _/TRACENAMES => '"   Nothing is traced."
   for x in _/TRACENAMES repeat
     x is [d,:.] and isDomainOrPackage d =>
       domainList:= [devaluate d,:domainList]
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index bb74f3cd..059994da 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -73,9 +73,6 @@
 (defmacro applx (&rest args)
  `(apply ,@args))
 
-(defmacro bintp (n)
- `(typep ,n 'bignum))
-
 (defmacro closedfn (form)
  `(function ,form))
 
@@ -161,23 +158,9 @@
       `(let ((,xx ,x))
          (and (consp ,xx) (qcdr ,xx))))))
 
-(defmacro intp (x)
- `(integerp ,x))
-
 (defmacro lam (&rest body)
  (list 'quote (*lam (copy-tree body))))
 
-(defmacro lessp (&rest args)
- `(< ,@args))
-
-(defmacro lintp (n)
- `(typep ,n 'bignum))
-
-(defmacro makestring (a) a)
-
-(defmacro mapelt (f vec)
- `(map 'vector ,f ,vec))
-
 (defmacro maxindex (x)
  `(the fixnum (1- (the fixnum (length ,x)))))
 
@@ -186,9 +169,6 @@
 
 (defmacro ne (a b) `(not (equal ,a ,b)))
 
-(defmacro nump (n)
- `(numberp ,n))
-
 (defmacro plus (&rest args)
  `(+ ,@ args))
 
@@ -295,9 +275,6 @@
 (defmacro resetq (a b)
  `(prog1 ,a (setq ,a ,b)))
 
-(defmacro rnump (n)
- `(floatp ,n))
-
 (defmacro rplq (&whole form exp pattern)
  (if (or (consp pattern) (simple-vector-p pattern))
   `(,(rcqexp pattern) ,exp)
@@ -322,12 +299,6 @@
     (|substitute!| '(progn) nil body) ;don't treat NIL as a label
     `(block seq (tagbody ,@(|reverse!| body) ,val))))
 
-(defmacro sintp (n)
- `(typep ,n 'fixnum))
-
-(defmacro smintp (n)
- `(typep ,n 'fixnum))
-
 (defmacro subrp (x)
  `(compiled-function-p ,x))
 
@@ -900,7 +871,7 @@
            (RETURN
              (COND
                ((OR (NOT (EQ 3 (LENGTH FORM))) (NOT (|ident?| (car (setq FORM (cdr FORM))))))
-                (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM (MAKESTRING "invalid pattern.")))
+                (MACRO-INVALIDARGS 'DCQ\/QDCQ FORM "invalid pattern."))
                (`((setq ,(car form) ,sv)  ,@(DCQGENEXP SV (CADR FORM) EQTAG QFLAG)))))))
     (setq A (car FORM))
     (setq D (cdr FORM))
@@ -961,7 +932,7 @@
           ((EQ FORM SV) (RETURN NIL))
           ((OR
               (|ident?| FORM)
-              (NUMP FORM)
+              (INTEGERP FORM)
               (AND (consp FORM) (EQ (qcar FORM) 'QUOTE)))
            (RETURN
              `((COND ((NOT (EQ ,form ,sv)) (GO BAD))) )))
@@ -982,7 +953,7 @@
                       (COND
                         ( (OR
                             (|ident?| A)
-                            (NUMP A)
+                            (INTEGERP A)
                             (AND (consp A) (EQ (qcar A) 'QUOTE)))
                          `((COND ( (NOT (EQ ,a (ELT ,sv ,i)))
                                   (GO BAD) ) ) ) )
@@ -1010,7 +981,7 @@
            (setq PVL (CONS (setq W (GENSYM)) PVL)))
         (setq C
               (COND
-                ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+                ( (OR (|ident?| A) (INTEGERP 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))
@@ -1019,7 +990,7 @@
               (|append!|
                 C
                 (COND
-                  ( (OR (|ident?| D) (NUMP D) (AND (consp D)
+                  ( (OR (|ident?| D) (INTEGERP D) (AND (consp D)
                                                  (EQ (car D) 'QUOTE)))
                    `((COND ((NOT (EQ ,d (CDR ,sv))) (GO BAD))) ))
                   ( (OR (consp D) (simple-vector-p D))
@@ -1083,7 +1054,7 @@
                 (COND
                   ( (OR
                       (|ident?| A)
-                      (NUMP A)
+                      (INTEGERP A)
                       (AND (consp A) (EQ (car A) 'QUOTE)))
                     `((SETF (ELT ,sv ,i) ,a)))
                   ( (OR (consp A) (simple-vector-p A))
@@ -1114,7 +1085,7 @@
           (setq PVL (CONS (setq W (GENSYM)) PVL)) ) )
       (setq C
         (COND
-          ( (OR (|ident?| A) (NUMP A) (AND (consp A) (EQ (car A) 'QUOTE)))
+          ( (OR (|ident?| A) (INTEGERP A) (AND (consp A) (EQ (car A) 'QUOTE)))
             `((rplaca ,sv ,a)))
           ( (OR (consp A) (simple-vector-p A))
             `((setq ,w (CAR ,sv))
@@ -1123,7 +1094,7 @@
         (|append!|
           C
           (COND
-            ( (OR (|ident?| D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE)))
+            ( (OR (|ident?| D) (INTEGERP D) (AND (consp D) (EQ (car D) 'QUOTE)))
               `((RPLACD ,sv ,d)))
             ( (OR (consp D) (simple-vector-p D))
               `((setq ,sv (CDR ,sv))
@@ -1288,7 +1259,7 @@
           ( (VARP BV-LIST)
             (LIST BV-LIST) )
           ( (simple-vector-p BV-LIST)
-            (FLAT-BV-LIST (VEC2LIST (MAPELT #'FLAT-BV-LIST BV-LIST))) )
+            (FLAT-BV-LIST (VEC2LIST (MAP 'VECTOR #'FLAT-BV-LIST BV-LIST))) )
           ( (NOT (consp BV-LIST))
             NIL )
           ( (EQ '= (SETQ TMP1 (QCAR BV-LIST)))
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 5fc563c9..27808ad2 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -3,7 +3,7 @@
 ;; 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
@@ -204,6 +204,7 @@
 
 	   "ident?"
 	   ;; numeric support
+	   "fixnum?"
 	   "double"
 	   "%fNaN?"
            ))
@@ -1379,6 +1380,9 @@
 ;; 
 ;; -*-* Numerics support -*-
 ;; 
+(defmacro |fixnum?| (x)
+  `(typep ,x 'fixnum))
+
 (defmacro |%fNaN?| (x)
   #+:sbcl `(sb-ext:float-nan-p ,x)
   #+:ecl `(ext:float-nan-p ,x)