aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog23
-rw-r--r--src/algebra/sex.spad.pamphlet7
-rw-r--r--src/interp/g-timer.boot8
-rw-r--r--src/interp/i-coerce.boot12
-rw-r--r--src/interp/i-coerfn.boot17
-rw-r--r--src/interp/i-intern.boot4
-rw-r--r--src/interp/lisp-backend.boot2
-rw-r--r--src/interp/slam.boot4
-rw-r--r--src/interp/trace.boot2
-rw-r--r--src/interp/vmlisp.lisp47
-rw-r--r--src/lisp/core.lisp.in6
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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 14:34:17 +0000