aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/fortcall.boot4
-rw-r--r--src/interp/i-analy.boot4
-rw-r--r--src/interp/i-object.boot6
-rw-r--r--src/interp/i-special.boot4
-rw-r--r--src/interp/i-syscmd.boot6
-rw-r--r--src/interp/macros.lisp2
-rw-r--r--src/interp/newfort.boot4
-rw-r--r--src/interp/preparse.lisp4
-rw-r--r--src/interp/sfsfun.boot14
-rw-r--r--src/interp/slam.boot4
-rw-r--r--src/interp/sys-constants.boot7
-rw-r--r--src/interp/sys-driver.boot4
-rw-r--r--src/interp/sys-macros.lisp4
-rw-r--r--src/interp/vmlisp.lisp13
15 files changed, 31 insertions, 51 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 71b679bc..b125c48b 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -438,7 +438,7 @@ primitiveType x ==
x = 0 => $NonNegativeInteger
x > 0 => $PositiveInteger
$Integer
- FLOATP x => $DoubleFloat
+ float? x => $DoubleFloat
nil
compSymbol(s,m,e) ==
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index 849def4f..7f4a05ff 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -651,7 +651,7 @@ writeData(tmpFile,indata) ==
integer? v =>
xdrWrite(xstr,v)
-- floats
- FLOATP v =>
+ float? v =>
xdrWrite(xstr,v)
SHUT(str)
tmpFile
@@ -663,7 +663,7 @@ readData(tmpFile,results) ==
xstr := xdrOpen(str,false)
results := [xdrRead1(xstr,r) for r in results] where
xdrRead1(x,dummy) ==
- VECTORP(dummy) and ZEROP(# dummy) => dummy
+ VECTORP(dummy) and #dummy = 0 => dummy
xdrRead(x,dummy)
SHUT(str)
results
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 862f4212..4446d731 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -864,13 +864,13 @@ isEltable(op,argl,numArgs) ==
-- determines if the object might possible have an elt function
-- we exclude Mapping and Variable types explicitly
v := getValue op =>
- ZEROP numArgs => true
+ numArgs = 0 => true
not(m := objMode(v)) => nil
m is ['Mapping, :.] => nil
objVal(v) is ["%Map",:mapDef] and numMapArgs(mapDef) > 0 => nil
true
m := getMode op =>
- ZEROP numArgs => true
+ numArgs = 0 => true
m is ['Mapping, :.] => nil
true
numArgs ~= 1 => nil
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 2e739d1c..37c3b96a 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.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
@@ -177,7 +177,7 @@ getBasicMode0(x,useIntegerSubdomain) ==
x = 0 => $NonNegativeInteger
$Integer
$Integer
- FLOATP x => $DoubleFloat
+ float? x => $DoubleFloat
(x='%noBranch) or (x='noValue) => $NoValueMode
nil
@@ -192,7 +192,7 @@ getBasicObject x ==
$Integer
objNewWrap(x,t)
string? x => objNewWrap(x,$String)
- FLOATP x => objNewWrap(x,$DoubleFloat)
+ float? x => objNewWrap(x,$DoubleFloat)
nil
diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot
index 053f6b75..4be81980 100644
--- a/src/interp/i-special.boot
+++ b/src/interp/i-special.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
@@ -1705,7 +1705,7 @@ isPatMatch(l,pats) ==
n:=#restPats
m:=#l-n
m<0 => $subs:="failed"
- ZEROP n => $subs:=[[var,:l],:$subs]
+ n = 0 => $subs:=[[var,:l],:$subs]
$subs:=[[var,:[x for x in l for i in 1..m]],:$subs]
isPatMatch(drop(m,l),restPats)
isPatMatch(first l,pat) = "failed" => "failed"
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index e15c18fb..db0e0ffb 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.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
@@ -1808,7 +1808,7 @@ writify ob ==
sameObject?(ob, %nullStream) => ['WRITIFIED!!, 'NULLSTREAM]
sameObject?(ob, %nonNullStream) => ['WRITIFIED!!, 'NONNULLSTREAM]
ob
- FLOATP ob =>
+ float? ob =>
ob = READ_-FROM_-STRING STRINGIMAGE ob => ob
['WRITIFIED!!, 'FLOAT, ob,:
MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob]
@@ -1819,7 +1819,7 @@ unwritable? ob ==
cons? ob or vector? ob => false -- first for speed
COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true
PLACEP ob or READTABLEP ob => true
- FLOATP ob => true
+ float? ob => true
false
-- Create a full isomorphic object which can be saved in a lisplib.
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 4ab528df..8f59e445 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -441,7 +441,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size
((EQL |l| 0) NIL)
('T (SPADLET |n| 0) (SPADLET |word| '||)
(SPADLET |inWord| NIL)
- (DO ((|i| 0 (QSADD1 |i|))) ((QSGREATERP |i| |l|) NIL)
+ (DO ((|i| 0 (1+ |i|))) ((QSGREATERP |i| |l|) NIL)
(declare (fixnum |i|))
(SEQ (EXIT (COND
((eql (aref |str| |i|) #\space)
diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot
index b8ae40b6..b4d23b8a 100644
--- a/src/interp/newfort.boot
+++ b/src/interp/newfort.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
@@ -847,7 +847,7 @@ fix2FortranFloat e ==
strconc(STRINGIMAGE(e),'".")
isFloat e ==
- FLOATP(e) or string?(e) and FIND(char ".",e)
+ float?(e) or string?(e) and FIND(char ".",e)
removeCharFromString(c,s) ==
-- find c's position in s.
diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp
index 94187b94..8741a490 100644
--- a/src/interp/preparse.lisp
+++ b/src/interp/preparse.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2012, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -220,7 +220,7 @@
(format t "~%"))))
(DEFUN STOREBLANKS (LINE N)
- (DO ((I 0 (ADD1 I))) ((= I N) LINE) (SETF (CHAR LINE I) #\ )))
+ (DO ((I 0 (1+ I))) ((= I N) LINE) (SETF (CHAR LINE I) #\ )))
(DEFUN INITIAL-SUBSTRING (PATTERN LINE)
(let ((ind (mismatch PATTERN LINE)))
diff --git a/src/interp/sfsfun.boot b/src/interp/sfsfun.boot
index baacfff1..f1cba953 100644
--- a/src/interp/sfsfun.boot
+++ b/src/interp/sfsfun.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -726,15 +726,15 @@ BesselJ(v,z) ==
B2:= 10
n := 50 --- number of terms in Chebychev series.
--- tests for negative integer order
- (FLOATP(v) and ZEROP fracpart(v) and (v<0)) or (COMPLEXP(v) and ZEROP IMAGPART(v) and ZEROP fracpart(REALPART(v)) and REALPART(v)<0.0) =>
+ (float?(v) and ZEROP fracpart(v) and (v<0)) or (COMPLEXP(v) and ZEROP IMAGPART(v) and ZEROP fracpart(REALPART(v)) and REALPART(v)<0.0) =>
--- odd or even according to v (9.1.5 A&S)
--- $J_{-n}(z)=(-1)^{n} J_{n}(z)$
BesselJ(-v,z)*EXPT(-1.0,v)
- (FLOATP(z) and (z<0)) or (COMPLEXP(z) and REALPART(z)<0.0) =>
+ (float?(z) and (z<0)) or (COMPLEXP(z) and REALPART(z)<0.0) =>
--- negative argument (9.1.35 A&S)
--- $J_{\nu}(z e^{m \pi i}) = e^{m \nu \pi i} J_{\nu}(z)$
BesselJ(v,-z)*EXPT(-1.0,v)
- ZEROP z and ((FLOATP(v) and (v>=0.0)) or (COMPLEXP(v) and
+ ZEROP z and ((float?(v) and (v>=0.0)) or (COMPLEXP(v) and
ZEROP IMAGPART(v) and REALPART(v)>=0.0)) => --- zero arg, pos. real order
ZEROP v => 1.0 --- J(0,0)=1
0.0 --- J(v,0)=0 for real v>0
@@ -776,15 +776,15 @@ BesselJRecur(v,z) ==
BesselI(v,z) ==
B1 := 15.0
B2 := 10.0
- ZEROP(z) and FLOATP(v) and (v>=0.0) => --- zero arg, pos. real order
+ ZEROP(z) and float?(v) and (v>=0.0) => --- zero arg, pos. real order
ZEROP(v) => 1.0 --- I(0,0)=1
0.0 --- I(v,0)=0 for real v>0
--- Transformations for negative integer orders
- FLOATP(v) and ZEROP(fracpart(v)) and (v<0) => BesselI(-v,z)
+ float?(v) and ZEROP(fracpart(v)) and (v<0) => BesselI(-v,z)
--- Halfplane transformations for Re(z)<0
REALPART(z)<0.0 => BesselI(v,-z)*EXPT(-1.0,v)
--- Conjugation for complex order and real argument
- REALPART(v)<0.0 and not ZEROP IMAGPART(v) and FLOATP(z) =>
+ REALPART(v)<0.0 and not ZEROP IMAGPART(v) and float?(z) =>
CONJUGATE(BesselI(CONJUGATE(v),z))
---We now know that Re(z)>= 0.0
abs(z) > B1 => --- asymptotic argument case
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index b6fc6a86..28a74f08 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -239,7 +239,7 @@ reportFunctionCacheAll(op,nam,argl,body) ==
nam
hashCount table ==
- +/[ADD1 nodeCount val for [key,:val] in entries table]
+ +/[1 + nodeCount val for [key,:val] in entries table]
mkCircularAlist n ==
l:= [[$failed,:$failed] for i in 1..n]
@@ -281,7 +281,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
for g in gsList for i in 1..]]
gsRev:= reverse gsList
rotateCode:= [["%LET",p,q] for p in gsRev for q in [:rest gsRev,g]]
- advanceCode:= ["%LET",gIndex,['ADD1,gIndex]]
+ advanceCode:= ["%LET",gIndex,['%iinc,gIndex]]
newTripleCode := ['%list,sharpArg,:gsList]
newStateCode :=
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 3239d54d..017e5bb8 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -275,13 +275,6 @@ $AtVariables ==
$QueryVariables ==
[makeSymbol strconc('"?",toString i) for i in 1..50]
-++ List of basic predicates the system has a built-in optimization
-++ support for.
-$BasicPredicates ==
- '(INTEGERP STRINGP FLOATP SYMBOLP)
-
-
-
++ List of functions known to be free of side effects
++ FIXME: Check that the names on this list are not renamed.
$SideEffectFreeFunctionList ==
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 95a6b566..f708ca88 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -1,4 +1,4 @@
--- 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
@@ -154,7 +154,7 @@ restart() ==
)endif
if $openServerIfTrue and FBOUNDP "openServer" then
os := openServer $SpadServerName
- if ZEROP os then
+ if os = 0 then
$openServerIfTrue := false
$SpadServer := true
$IOindex := 1
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 95d4e898..60f71304 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -530,11 +530,11 @@
(defun MKQSADD1 (X)
(COND ((ATOM X)
- `(QSADD1 ,X))
+ `(1+ ,X))
((AND (member (CAR X) '(-DIFFERENCE QSDIFFERENCE -) :test #'eq)
(EQL 1 (CADDR X)))
(CADR X))
- (`(QSADD1 ,X))))
+ (`(1+ ,X))))
(defun SEQOPT (U)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 017b42ed..322ce4ae 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -66,10 +66,6 @@
;; DEFMACROS
-
-(defmacro add1 (x)
- `(1+ ,x))
-
(defmacro applx (&rest args)
`(apply ,@args))
@@ -221,9 +217,6 @@
`(,(rcqexp pattern) ,exp)
(macro-invalidargs 'qrplq form "form must be updateable.")))
-(defmacro qsadd1 (x)
- `(the fixnum (1+ (the fixnum ,x))))
-
(defmacro qsdifference (x y)
`(the fixnum (- (the fixnum ,x) (the fixnum ,y))))
@@ -257,12 +250,6 @@
(defmacro qsplus (x y)
`(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
-(defmacro qssub1 (x)
- `(the fixnum (1- (the fixnum ,x))))
-
-(defmacro qstimes (x y)
- `(the fixnum (* (the fixnum ,x) (the fixnum ,y))))
-
(defmacro qszerop (x)
`(zerop (the fixnum ,x)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 17:23:19 +0000