aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog15
-rw-r--r--src/algebra/integer.spad.pamphlet25
-rw-r--r--src/algebra/sf.spad.pamphlet60
-rw-r--r--src/algebra/strap/ABELGRP-.lsp2
-rw-r--r--src/algebra/strap/CHAR.lsp2
-rw-r--r--src/algebra/strap/DFLOAT.lsp312
-rw-r--r--src/algebra/strap/DIVRING-.lsp4
-rw-r--r--src/algebra/strap/FFIELDC-.lsp2
-rw-r--r--src/algebra/strap/FPS-.lsp2
-rw-r--r--src/algebra/strap/GCDDOM-.lsp4
-rw-r--r--src/algebra/strap/INT.lsp86
-rw-r--r--src/algebra/strap/ISTRING.lsp43
-rw-r--r--src/algebra/strap/LNAGG-.lsp2
-rw-r--r--src/algebra/strap/NNI.lsp2
-rw-r--r--src/algebra/strap/OUTFORM.lsp10
-rw-r--r--src/algebra/strap/POLYCAT-.lsp2
-rw-r--r--src/algebra/strap/SINT.lsp16
-rw-r--r--src/algebra/strap/STAGG-.lsp8
-rw-r--r--src/algebra/strap/SYMBOL.lsp4
-rw-r--r--src/algebra/strap/URAGG-.lsp10
-rw-r--r--src/interp/c-util.boot4
-rw-r--r--src/interp/g-opt.boot15
-rw-r--r--src/interp/g-util.boot63
-rw-r--r--src/interp/nruncomp.boot4
24 files changed, 386 insertions, 311 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 209f8c98..b2dab14d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2010-06-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/nruncomp.boot (optDeltaEntry): Don't optimize current
+ domain modemap references here.
+ * interp/g-opt.boot ($VMsideEffectFreeOperators): Include more
+ floating point operators.
+ ($simpleVMoperators): Move FUNCALL here.
+ (isVMConstantForm): Tidy.
+ * interp/g-util.boot: Expand more floating point insns.
+ * interp/c-util.boot (replaceSimpleFunctions): Replace more
+ constants.
+ * algebra/integer.spad.pamphlet (Integer): More cleanup. Use
+ builtin functions.
+ * algebra/sf.spad.pamphlet: Likewise.
+
2010-06-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
Group sequence of LETT definitions into LET/LET* expressions where
diff --git a/src/algebra/integer.spad.pamphlet b/src/algebra/integer.spad.pamphlet
index 2ca80be3..ffcb0206 100644
--- a/src/algebra/integer.spad.pamphlet
+++ b/src/algebra/integer.spad.pamphlet
@@ -82,6 +82,12 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with
== add
ZP ==> SparseUnivariatePolynomial %
ZZP ==> SparseUnivariatePolynomial Integer
+ import %ineg: % -> % from Foreign Builtin
+ import %hash: % -> SingleInteger from Foreign Builtin
+ import %iadd: (%,%) -> % from Foreign Builtin
+ import %isub: (%,%) -> % from Foreign Builtin
+ import %imul: (%,%) -> % from Foreign Builtin
+
x,y: %
n: NonNegativeInteger
@@ -138,19 +144,19 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with
copy x == x
inc x == x + 1
dec x == x - 1
- hash x == SXHASH(x)$Lisp
+ hash x == %hash x
negative? x == MINUSP(x)$Lisp
coerce(x):OutputForm == outputForm(x pretend Integer)
coerce(m:Integer):% == m pretend %
convert(x:%):Integer == x pretend Integer
length a == INTEGER_-LENGTH(a)$Lisp
addmod(a, b, p) ==
- (c:=a + b) >= p => c - p
+ (c := %iadd(a,b)) >= p => c - p
c
submod(a, b, p) ==
- (c:=a - b) < 0 => c + p
+ (c := %isub(a,b)) < 0 => c + p
c
- mulmod(a, b, p) == (a * b) rem p
+ mulmod(a, b, p) == %imul(a,b) rem p
convert(x:%):Float == coerce(x pretend Integer)$Float
convert(x:%):DoubleFloat == coerce(x pretend Integer)$DoubleFloat
convert(x:%):InputForm == convert(x pretend Integer)$InputForm
@@ -182,12 +188,11 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with
x > y == %igt(x,y)$Foreign(Builtin)
x <= y == %ile(x,y)$Foreign(Builtin)
x >= y == %ige(x,y)$Foreign(Builtin)
- - x == (-x)$Lisp
- x + y == %iadd(x,y)$Foreign(Builtin)
- x - y == %isub(x,y)$Foreign(Builtin)
- x * y == %imul(x,y)$Foreign(Builtin)
- (m:Integer) * (y:%) ==
- %imul(m,y)$Foreign(Builtin) -- for subsumption problem
+ - x == %ineg x
+ x + y == %iadd(x,y)
+ x - y == %isub(x,y)
+ x * y == %imul(x,y)
+ (m:Integer) * (y:%) == %imul(m,y) -- for subsumption problem
x ** n == %ipow(x,n)$Foreign(Builtin)
odd? x == %iodd?(x)$Foreign(Builtin)
max(x,y) == %imax(x,y)$Foreign(Builtin)
diff --git a/src/algebra/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet
index c1a29b22..1b36780f 100644
--- a/src/algebra/sf.spad.pamphlet
+++ b/src/algebra/sf.spad.pamphlet
@@ -279,17 +279,25 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
== add
MER ==> Record(MANTISSA:Integer,EXPONENT:Integer)
- import %fmul: (%,%) -> % from Foreign Builtin
- import %fadd: (%,%) -> % from Foreign Builtin
- import %fsub: (%,%) -> % from Foreign Builtin
- import %fdiv: (%,%) -> % from Foreign Builtin
- import %fmin: (%,%) -> % from Foreign Builtin
- import %fmax: (%,%) -> % from Foreign Builtin
- import %feq: (%,%) -> Boolean from Foreign Builtin
- import %flt: (%,%) -> Boolean from Foreign Builtin
- import %fle: (%,%) -> Boolean from Foreign Builtin
- import %fgt: (%,%) -> Boolean from Foreign Builtin
- import %fge: (%,%) -> Boolean from Foreign Builtin
+ import %fminval: () -> % from Foreign Builtin
+ import %fmaxval: () -> % from Foreign Builtin
+ import %fbase: () -> PositiveInteger from Foreign Builtin
+ import %fprec: () -> PositiveInteger from Foreign Builtin
+ import %i2f: Integer -> % from Foreign Builtin
+ import %fabs: % -> % from Foreign Builtin
+ import %fneg: % -> % from Foreign Builtin
+ import %ftrunc: % -> Integer from Foreign Builtin
+ import %fmul: (%,%) -> % from Foreign Builtin
+ import %fadd: (%,%) -> % from Foreign Builtin
+ import %fsub: (%,%) -> % from Foreign Builtin
+ import %fdiv: (%,%) -> % from Foreign Builtin
+ import %fmin: (%,%) -> % from Foreign Builtin
+ import %fmax: (%,%) -> % from Foreign Builtin
+ import %feq: (%,%) -> Boolean from Foreign Builtin
+ import %flt: (%,%) -> Boolean from Foreign Builtin
+ import %fle: (%,%) -> Boolean from Foreign Builtin
+ import %fgt: (%,%) -> Boolean from Foreign Builtin
+ import %fge: (%,%) -> Boolean from Foreign Builtin
manexp: % -> MER
@@ -334,21 +342,21 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
-- complex to get the correct behaviour.
--makeComplex(x: %):% == COMPLEX(x, 0$%)$Lisp
- base() == FLOAT_-RADIX(0$%)$Lisp
+ base() == %fbase()
mantissa x == manexp(x).MANTISSA
exponent x == manexp(x).EXPONENT
- precision() == FLOAT_-DIGITS(0$%)$Lisp
+ precision() == %fprec()
bits() ==
base() = 2 => precision()
base() = 16 => 4*precision()
- wholePart(precision()*log2(base()::%))::PositiveInteger
- max() == _$DoubleFloatMaximum$Lisp
- min() == _$DoubleFloatMinimum$Lisp
+ wholePart(precision() * log2 %i2f base())::PositiveInteger
+ max() == %fmaxval()
+ min() == %fminval()
order(a) == precision() + exponent a - 1
- 0 == FLOAT(0$Lisp,_$DoubleFloatMaximum$Lisp)$Lisp
- 1 == FLOAT(1$Lisp,_$DoubleFloatMaximum$Lisp)$Lisp
+ 0 == %i2f(0@Integer)
+ 1 == %i2f(1@Integer)
-- rational approximation to e accurate to 23 digits
- exp1() == FLOAT(534625820200,_$DoubleFloatMaximum$Lisp)$Lisp / FLOAT(196677847971,_$DoubleFloatMaximum$Lisp)$Lisp
+ exp1() == %i2f(534625820200) / %i2f(196677847971)
pi() == PI$Lisp
coerce(x:%):OutputForm == outputForm x
convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm
@@ -356,7 +364,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
x > y == %fgt(x,y)
x <= y == %fle(x,y)
x >= y == %fge(x,y)
- - x == (-x)$Lisp
+ - x == %fneg x
x + y == %fadd(x,y)
x:% - y:% == %fsub(x,y)
x:% * y:% == %fmul(x,y)
@@ -369,7 +377,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
log10 x == checkComplex log(x)$Lisp
x:% ** i:Integer == EXPT(x,i)$Lisp
x:% ** y:% == checkComplex EXPT(x,y)$Lisp
- coerce(i:Integer):% == FLOAT(i,_$DoubleFloatMaximum$Lisp)$Lisp
+ coerce(i:Integer):% == %i2f i
exp x == EXP(x)$Lisp
log x == checkComplex LN(x)$Lisp
log2 x == checkComplex LOG2(x)$Lisp
@@ -411,8 +419,8 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
Gamma x == Gamma(sfx)$SFSFUN pretend %
Beta(x,y) == Beta(sfx,sfy)$SFSFUN pretend %
- wholePart x == FIX(x)$Lisp
- float(ma,ex,b) == ma*(b::%)**ex
+ wholePart x == %ftrunc x
+ float(ma,ex,b) == ma * %i2f(b)**ex
convert(x:%):DoubleFloat == x pretend DoubleFloat
convert(x:%):Float == convert(x pretend DoubleFloat)$Float
rationalApproximation(x, d) == rationalApproximation(x, d, 10)
@@ -435,15 +443,15 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base())
retract(x:%):Integer ==
- x = ((n := wholePart x)::%) => n
+ x = (%i2f(n := wholePart x)) => n
error "Not an integer"
retractIfCan(x:%):Union(Integer, "failed") ==
- x = ((n := wholePart x)::%) => n
+ x = (%i2f(n := wholePart x)) => n
"failed"
sign(x) == retract FLOAT_-SIGN(x,1)$Lisp
- abs x == FLOAT_-SIGN(1,x)$Lisp
+ abs x == %fabs x
diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp
index 65266dc4..47493f92 100644
--- a/src/algebra/strap/ABELGRP-.lsp
+++ b/src/algebra/strap/ABELGRP-.lsp
@@ -27,7 +27,7 @@
(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $)
(COND
((ZEROP |n|) (|spadConstant| $ 19))
- ((> |n| 0) (SPADCALL |n| |x| (|getShellEntry| $ 24)))
+ ((< 0 |n|) (SPADCALL |n| |x| (|getShellEntry| $ 24)))
('T
(SPADCALL (- |n|) (SPADCALL |x| (|getShellEntry| $ 7))
(|getShellEntry| $ 24)))))
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index 54208bca..f45315ba 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -129,7 +129,7 @@
(DEFUN |CHAR;lookup;$Pi;8| (|c| $)
(LET ((#0=#:G1407 (+ 1 (CHAR-CODE |c|))))
- (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))
+ (|check-subtype| (< 0 #0#) '(|PositiveInteger|) #0#)))
(DEFUN |CHAR;char;Nni$;9| (|n| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 2d6c6a81..9828f0bc 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -23,7 +23,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
|DFLOAT;base;Pi;6|))
-(PUT '|DFLOAT;base;Pi;6| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0)))
+(PUT '|DFLOAT;base;Pi;6| '|SPADreplace| '|%fbase|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
|DFLOAT;mantissa;$I;7|))
@@ -34,21 +34,18 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
|DFLOAT;precision;Pi;9|))
-(PUT '|DFLOAT;precision;Pi;9| '|SPADreplace|
- '(XLAM NIL (FLOAT-DIGITS 0.0)))
+(PUT '|DFLOAT;precision;Pi;9| '|SPADreplace| '|%fprec|)
(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
|DFLOAT;bits;Pi;10|))
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;max;$;11|))
-(PUT '|DFLOAT;max;$;11| '|SPADreplace|
- '(XLAM NIL |$DoubleFloatMaximum|))
+(PUT '|DFLOAT;max;$;11| '|SPADreplace| '|%fmaxval|)
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;min;$;12|))
-(PUT '|DFLOAT;min;$;12| '|SPADreplace|
- '(XLAM NIL |$DoubleFloatMinimum|))
+(PUT '|DFLOAT;min;$;12| '|SPADreplace| '|%fminval|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
|DFLOAT;order;$I;13|))
@@ -56,22 +53,15 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|)
|DFLOAT;Zero;$;14|))
-(PUT '|DFLOAT;Zero;$;14| '|SPADreplace|
- '(XLAM NIL (FLOAT 0 |$DoubleFloatMaximum|)))
+(PUT '|DFLOAT;Zero;$;14| '|SPADreplace| '(XLAM NIL (|%i2f| 0)))
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;One;$;15|))
-(PUT '|DFLOAT;One;$;15| '|SPADreplace|
- '(XLAM NIL (FLOAT 1 |$DoubleFloatMaximum|)))
+(PUT '|DFLOAT;One;$;15| '|SPADreplace| '(XLAM NIL (|%i2f| 1)))
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|)
|DFLOAT;exp1;$;16|))
-(PUT '|DFLOAT;exp1;$;16| '|SPADreplace|
- '(XLAM NIL
- (|%fdiv| (FLOAT 534625820200 |$DoubleFloatMaximum|)
- (FLOAT 196677847971 |$DoubleFloatMaximum|))))
-
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;pi;$;17|))
(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '(XLAM NIL PI))
@@ -109,7 +99,7 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
|DFLOAT;-;2$;24|))
-(PUT '|DFLOAT;-;2$;24| '|SPADreplace| '-)
+(PUT '|DFLOAT;-;2$;24| '|SPADreplace| '|%fneg|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
|%DoubleFloat|)
@@ -178,8 +168,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|)
|DFLOAT;coerce;I$;37|))
-(PUT '|DFLOAT;coerce;I$;37| '|SPADreplace|
- '(XLAM (|i|) (FLOAT |i| |$DoubleFloatMaximum|)))
+(PUT '|DFLOAT;coerce;I$;37| '|SPADreplace| '|%i2f|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
|DFLOAT;exp;2$;38|))
@@ -315,9 +304,6 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
|DFLOAT;one?;$B;68|))
-(PUT '|DFLOAT;one?;$B;68| '|SPADreplace|
- '(XLAM (|x|) (|%feq| |x| 1.0)))
-
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Short|)
|DFLOAT;hash;$Si;69|))
@@ -329,8 +315,6 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
|DFLOAT;differentiate;2$;71|))
-(PUT '|DFLOAT;differentiate;2$;71| '|SPADreplace| '(XLAM (|x|) 0.0))
-
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
|DFLOAT;Gamma;2$;72|))
@@ -341,7 +325,7 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
|DFLOAT;wholePart;$I;74|))
-(PUT '|DFLOAT;wholePart;$I;74| '|SPADreplace| 'FIX)
+(PUT '|DFLOAT;wholePart;$I;74| '|SPADreplace| '|%ftrunc|)
(DECLAIM (FTYPE (FUNCTION
(|%Integer| |%Integer| (|%IntegerSection| 1)
@@ -384,8 +368,7 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
|DFLOAT;abs;2$;85|))
-(PUT '|DFLOAT;abs;2$;85| '|SPADreplace|
- '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|)))
+(PUT '|DFLOAT;abs;2$;85| '|SPADreplace| '|%fabs|)
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|)
|DFLOAT;manexp|))
@@ -400,6 +383,15 @@
|%DoubleFloat|)
|DFLOAT;**;$F$;88|))
+(PUT '|DFLOAT;exp1;$;16| '|SPADreplace|
+ '(XLAM NIL (|%fdiv| (|%i2f| 534625820200) (|%i2f| 196677847971))))
+
+(PUT '|DFLOAT;one?;$B;68| '|SPADreplace|
+ '(XLAM (|x|) (|%feq| |x| (|%i2f| 1))))
+
+(PUT '|DFLOAT;differentiate;2$;71| '|SPADreplace|
+ '(XLAM (|x|) (|%i2f| 0)))
+
(DEFUN |DFLOAT;OMwrite;$S;1| (|x| $)
(LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|))
(|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 7))
@@ -435,29 +427,26 @@
(DECLARE (IGNORE $))
(C-TO-R |x|))
-(DEFUN |DFLOAT;base;Pi;6| ($) (DECLARE (IGNORE $)) (FLOAT-RADIX 0.0))
+(DEFUN |DFLOAT;base;Pi;6| ($) (DECLARE (IGNORE $)) 2)
(DEFUN |DFLOAT;mantissa;$I;7| (|x| $) (CAR (|DFLOAT;manexp| |x| $)))
(DEFUN |DFLOAT;exponent;$I;8| (|x| $) (CDR (|DFLOAT;manexp| |x| $)))
-(DEFUN |DFLOAT;precision;Pi;9| ($)
- (DECLARE (IGNORE $))
- (FLOAT-DIGITS 0.0))
+(DEFUN |DFLOAT;precision;Pi;9| ($) (DECLARE (IGNORE $)) 53)
(DEFUN |DFLOAT;bits;Pi;10| ($)
(COND
- ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0))
- ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0)))
+ ((EQL 2 2) 53)
+ ((EQL 2 16) (* 4 53))
('T
- (LET ((#0=#:G1425
- (FIX (SPADCALL (FLOAT-DIGITS 0.0)
- (|DFLOAT;log2;2$;40|
- (FLOAT (FLOAT-RADIX 0.0)
- |$DoubleFloatMaximum|)
- $)
- (|getShellEntry| $ 34)))))
- (|check-subtype| (AND (>= #0# 0) (> #0# 0)) '(|PositiveInteger|)
+ (LET ((#0=#:G1427
+ (TRUNCATE
+ (SPADCALL 53
+ (|DFLOAT;log2;2$;40|
+ (FLOAT 2 |$DoubleFloatMaximum|) $)
+ (|getShellEntry| $ 32)))))
+ (|check-subtype| (AND (>= #0# 0) (< 0 #0#)) '(|PositiveInteger|)
#0#)))))
(DEFUN |DFLOAT;max;$;11| ($)
@@ -469,15 +458,11 @@
|$DoubleFloatMinimum|)
(DEFUN |DFLOAT;order;$I;13| (|a| $)
- (- (+ (FLOAT-DIGITS 0.0) (|DFLOAT;exponent;$I;8| |a| $)) 1))
+ (- (+ 53 (|DFLOAT;exponent;$I;8| |a| $)) 1))
-(DEFUN |DFLOAT;Zero;$;14| ($)
- (DECLARE (IGNORE $))
- (FLOAT 0 |$DoubleFloatMaximum|))
+(DEFUN |DFLOAT;Zero;$;14| ($) (DECLARE (IGNORE $)) 0.0)
-(DEFUN |DFLOAT;One;$;15| ($)
- (DECLARE (IGNORE $))
- (FLOAT 1 |$DoubleFloatMaximum|))
+(DEFUN |DFLOAT;One;$;15| ($) (DECLARE (IGNORE $)) 1.0)
(DEFUN |DFLOAT;exp1;$;16| ($)
(DECLARE (IGNORE $))
@@ -494,7 +479,7 @@
(DEFUN |DFLOAT;<;2$B;20| (|x| |y| $) (DECLARE (IGNORE $)) (< |x| |y|))
-(DEFUN |DFLOAT;>;2$B;21| (|x| |y| $) (DECLARE (IGNORE $)) (> |x| |y|))
+(DEFUN |DFLOAT;>;2$B;21| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|))
(DEFUN |DFLOAT;<=;2$B;22| (|x| |y| $)
(DECLARE (IGNORE $))
@@ -619,7 +604,7 @@
(DEFUN |DFLOAT;wholePart;$I;74| (|x| $)
(DECLARE (IGNORE $))
- (FIX |x|))
+ (TRUNCATE |x|))
(DEFUN |DFLOAT;float;2IPi$;75| (|ma| |ex| |b| $)
(* |ma| (EXPT (FLOAT |b| |$DoubleFloatMaximum|) |ex|)))
@@ -638,47 +623,54 @@
(SEQ (COND
((= |x| 0.0)
(COND
- ((> |y| 0.0) (/ PI 2))
- ((< |y| 0.0) (- (/ PI 2)))
+ ((PLUSP |y|) (/ PI 2))
+ ((MINUSP |y|) (- (/ PI 2)))
('T 0.0)))
('T
- (SEQ (LETT |theta| (ATAN (FLOAT-SIGN 1.0 (/ |y| |x|)))
+ (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|)))
|DFLOAT;atan;3$;79|)
- (COND ((< |x| 0.0) (SETQ |theta| (- PI |theta|))))
- (COND ((< |y| 0.0) (SETQ |theta| (- |theta|))))
+ (COND ((MINUSP |x|) (SETQ |theta| (- PI |theta|))))
+ (COND ((MINUSP |y|) (SETQ |theta| (- |theta|))))
(EXIT |theta|))))))))
(DEFUN |DFLOAT;retract;$F;80| (|x| $)
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (LET ((#0=#:G1504 (- (FLOAT-DIGITS 0.0) 1)))
+ (LET ((#0=#:G1506 (- 53 1)))
(|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
- (FLOAT-RADIX 0.0) $))
+ 2 $))
(DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $)
(CONS 0
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (LET ((#0=#:G1512 (- (FLOAT-DIGITS 0.0) 1)))
+ (LET ((#0=#:G1514 (- 53 1)))
(|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
- (FLOAT-RADIX 0.0) $)))
+ 2 $)))
(DEFUN |DFLOAT;retract;$I;82| (|x| $)
- (LET ((|n| (FIX |x|)))
- (COND
- ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) |n|)
- ('T (|error| "Not an integer")))))
+ (PROG (|n|)
+ (RETURN
+ (COND
+ ((= |x|
+ (FLOAT (LETT |n| (TRUNCATE |x|) |DFLOAT;retract;$I;82|)
+ |$DoubleFloatMaximum|))
+ |n|)
+ ('T (|error| "Not an integer"))))))
(DEFUN |DFLOAT;retractIfCan;$U;83| (|x| $)
- (LET ((|n| (FIX |x|)))
- (COND
- ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) (CONS 0 |n|))
- ('T (CONS 1 "failed")))))
+ (PROG (|n|)
+ (RETURN
+ (COND
+ ((= |x|
+ (FLOAT (LETT |n| (TRUNCATE |x|)
+ |DFLOAT;retractIfCan;$U;83|)
+ |$DoubleFloatMaximum|))
+ (CONS 0 |n|))
+ ('T (CONS 1 "failed"))))))
(DEFUN |DFLOAT;sign;$I;84| (|x| $)
(|DFLOAT;retract;$I;82| (FLOAT-SIGN |x| 1.0) $))
-(DEFUN |DFLOAT;abs;2$;85| (|x| $)
- (DECLARE (IGNORE $))
- (FLOAT-SIGN 1.0 |x|))
+(DEFUN |DFLOAT;abs;2$;85| (|x| $) (DECLARE (IGNORE $)) (ABS |x|))
(DEFUN |DFLOAT;manexp| (|x| $)
(PROG (|s| |me| |two53|)
@@ -688,9 +680,9 @@
('T
(SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $)
|DFLOAT;manexp|)
- (SETQ |x| (FLOAT-SIGN 1.0 |x|))
+ (SETQ |x| (ABS |x|))
(COND
- ((> |x| |$DoubleFloatMaximum|)
+ ((< |$DoubleFloatMaximum| |x|)
(RETURN-FROM |DFLOAT;manexp|
(CONS (+ (* |s|
(|DFLOAT;mantissa;$I;7|
@@ -699,11 +691,10 @@
(|DFLOAT;exponent;$I;8|
|$DoubleFloatMaximum| $)))))
(LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
- (LETT |two53|
- (EXPT (FLOAT-RADIX 0.0) (FLOAT-DIGITS 0.0))
- |DFLOAT;manexp|)
- (EXIT (CONS (* |s| (FIX (* |two53| (CAR |me|))))
- (- (CDR |me|) (FLOAT-DIGITS 0.0)))))))))))
+ (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|)
+ (EXIT (CONS (* |s|
+ (TRUNCATE (* |two53| (CAR |me|))))
+ (- (CDR |me|) 53))))))))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $)
(PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G110| |q| |r|
@@ -713,8 +704,7 @@
(LET* ((|#G109| (|DFLOAT;manexp| |f| $)) (|nu| (CAR |#G109|))
(|ex| (CDR |#G109|)))
(SEQ |#G109|
- (LETT BASE (FLOAT-RADIX 0.0)
- |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT BASE 2 |DFLOAT;rationalApproximation;$2NniF;87|)
(EXIT (COND
((>= |ex| 0)
(SPADCALL
@@ -722,11 +712,11 @@
(EXPT BASE
(|check-subtype| (>= |ex| 0)
'(|NonNegativeInteger|) |ex|)))
- (|getShellEntry| $ 135)))
+ (|getShellEntry| $ 134)))
('T
(SEQ (LETT |de|
(EXPT BASE
- (LET ((#0=#:G1540 (- |ex|)))
+ (LET ((#0=#:G1542 (- |ex|)))
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#)))
|DFLOAT;rationalApproximation;$2NniF;87|)
@@ -777,13 +767,13 @@
(- (* |nu| |q2|)
(* |de| |p2|)))
(|getShellEntry| $
- 144))
+ 143))
(* |de| (ABS |p2|))))
(RETURN-FROM
|DFLOAT;rationalApproximation;$2NniF;87|
(SPADCALL |p2| |q2|
(|getShellEntry| $
- 142)))))
+ 141)))))
(LETT |#G111| |p1|
|DFLOAT;rationalApproximation;$2NniF;87|)
(LETT |#G112| |p2|
@@ -811,20 +801,20 @@
(SEQ (COND
((ZEROP |x|)
(COND
- ((SPADCALL |r| (|getShellEntry| $ 146))
+ ((SPADCALL |r| (|getShellEntry| $ 145))
(|error| "0**0 is undefined"))
- ((SPADCALL |r| (|getShellEntry| $ 147))
+ ((SPADCALL |r| (|getShellEntry| $ 146))
(|error| "division by 0"))
('T 0.0)))
- ((OR (SPADCALL |r| (|getShellEntry| $ 146)) (= |x| 1.0))
+ ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0))
1.0)
('T
(COND
- ((SPADCALL |r| (|getShellEntry| $ 148)) |x|)
+ ((SPADCALL |r| (|getShellEntry| $ 147)) |x|)
('T
- (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 149))
+ (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148))
|DFLOAT;**;$F$;88|)
- (LETT |d| (SPADCALL |r| (|getShellEntry| $ 150))
+ (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149))
|DFLOAT;**;$F$;88|)
(EXIT (COND
((MINUSP |x|)
@@ -851,7 +841,7 @@
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#0=#:G1562)
+ (PROG (#0=#:G1565)
(RETURN
(COND
((SETQ #0# (HGET |$ConstructorCache| '|DoubleFloat|))
@@ -883,25 +873,26 @@
(21 . |OMputEndObject|) (26 . |OMclose|)
|DFLOAT;OMwrite;$S;1| (|Boolean|) |DFLOAT;OMwrite;$BS;2|
|DFLOAT;OMwrite;Omd$V;3| |DFLOAT;OMwrite;Omd$BV;4|
- (CONS IDENTITY
- (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;14|) $))
(|PositiveInteger|) |DFLOAT;base;Pi;6| (|Integer|)
|DFLOAT;mantissa;$I;7| |DFLOAT;exponent;$I;8|
- |DFLOAT;precision;Pi;9| (31 . =) (37 . *) (43 . |coerce|)
- |DFLOAT;log2;2$;40| (48 . *) |DFLOAT;wholePart;$I;74|
+ |DFLOAT;precision;Pi;9| (31 . =) (37 . *)
+ |DFLOAT;log2;2$;40| (43 . *) |DFLOAT;wholePart;$I;74|
|DFLOAT;bits;Pi;10| |DFLOAT;max;$;11| |DFLOAT;min;$;12|
- (54 . +) (60 . |One|) (64 . -) |DFLOAT;order;$I;13|
+ (49 . +) (55 . |One|) (59 . -) |DFLOAT;order;$I;13|
+ (65 . |Zero|)
+ (CONS IDENTITY
+ (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;14|) $))
(CONS IDENTITY
(FUNCALL (|dispatchFunction| |DFLOAT;One;$;15|) $))
|DFLOAT;/;3$;65| |DFLOAT;exp1;$;16| |DFLOAT;pi;$;17|
- (|OutputForm|) (70 . |outputForm|) |DFLOAT;coerce;$Of;18|
- (|InputForm|) (75 . |convert|) |DFLOAT;convert;$If;19|
+ (|OutputForm|) (69 . |outputForm|) |DFLOAT;coerce;$Of;18|
+ (|InputForm|) (74 . |convert|) |DFLOAT;convert;$If;19|
|DFLOAT;<;2$B;20| |DFLOAT;>;2$B;21| |DFLOAT;<=;2$B;22|
|DFLOAT;>=;2$B;23| |DFLOAT;-;2$;24| |DFLOAT;+;3$;25|
|DFLOAT;-;3$;26| |DFLOAT;*;3$;27| |DFLOAT;*;I2$;28|
|DFLOAT;max;3$;29| |DFLOAT;min;3$;30| |DFLOAT;=;2$B;31|
|DFLOAT;/;$I$;32| |DFLOAT;sqrt;2$;33| |DFLOAT;log10;2$;34|
- |DFLOAT;**;$I$;35| |DFLOAT;**;3$;36| |DFLOAT;coerce;I$;37|
+ |DFLOAT;**;$I$;35| |DFLOAT;**;3$;36| (79 . |coerce|)
|DFLOAT;exp;2$;38| |DFLOAT;log;2$;39| |DFLOAT;sin;2$;41|
|DFLOAT;cos;2$;42| |DFLOAT;tan;2$;43| |DFLOAT;cot;2$;44|
|DFLOAT;sec;2$;45| |DFLOAT;csc;2$;46| |DFLOAT;asin;2$;47|
@@ -917,25 +908,24 @@
|DFLOAT;zero?;$B;67| |DFLOAT;one?;$B;68| (|SingleInteger|)
|DFLOAT;hash;$Si;69| (|Union| $ '"failed")
|DFLOAT;recip;$U;70| |DFLOAT;differentiate;2$;71|
- (|DoubleFloatSpecialFunctions|) (80 . |Gamma|)
- |DFLOAT;Gamma;2$;72| (85 . |Beta|) |DFLOAT;Beta;3$;73|
- |DFLOAT;float;2IPi$;75| (|Float|) (91 . |convert|)
- |DFLOAT;convert;$F;77| (|Fraction| 26)
+ (|DoubleFloatSpecialFunctions|) (84 . |Gamma|)
+ |DFLOAT;Gamma;2$;72| (89 . |Beta|) |DFLOAT;Beta;3$;73|
+ |DFLOAT;float;2IPi$;75| (|Float|) (95 . |convert|)
+ |DFLOAT;convert;$F;77| (|Fraction| 25)
(|NonNegativeInteger|)
|DFLOAT;rationalApproximation;$2NniF;87|
- |DFLOAT;rationalApproximation;$NniF;78| (96 . |Zero|)
- |DFLOAT;abs;2$;85| |DFLOAT;atan;3$;79| (100 . |One|)
- |DFLOAT;retract;$F;80| (|Union| 114 '"failed")
- |DFLOAT;retractIfCan;$U;81| |DFLOAT;retract;$I;82|
- (|Union| 26 '"failed") |DFLOAT;retractIfCan;$U;83|
- |DFLOAT;sign;$I;84| (104 . *) (110 . **) (116 . |Zero|)
- (120 . |Zero|) (124 . >=) (130 . **) (136 . |coerce|)
- (141 . -) (146 . <) (152 . **)
+ |DFLOAT;rationalApproximation;$NniF;78| |DFLOAT;abs;2$;85|
+ |DFLOAT;atan;3$;79| (100 . |One|) |DFLOAT;retract;$F;80|
+ (|Union| 114 '"failed") |DFLOAT;retractIfCan;$U;81|
+ |DFLOAT;retract;$I;82| (|Union| 25 '"failed")
+ |DFLOAT;retractIfCan;$U;83| |DFLOAT;sign;$I;84| (104 . *)
+ (110 . **) (116 . |Zero|) (120 . |Zero|) (124 . >=)
+ (130 . **) (136 . |coerce|) (141 . -) (146 . <) (152 . **)
(|Record| (|:| |quotient| $) (|:| |remainder| $))
(158 . |divide|) (164 . =) (170 . /) (176 . |abs|)
(181 . *) (187 . <) (193 . |zero?|) (198 . |negative?|)
(203 . |one?|) (208 . |numer|) (213 . |denom|)
- (218 . |odd?|) |DFLOAT;**;$F$;88|
+ (218 . |odd?|) |DFLOAT;**;$F$;88| |DFLOAT;coerce;I$;37|
(|PatternMatchResult| 111 $) (|Pattern| 111)
(|Factored| $) (|List| $) (|Union| 156 '"failed")
(|Record| (|:| |coef1| $) (|:| |coef2| $)
@@ -1028,11 +1018,11 @@
(|LeftLinearSet| $$)
(|RightLinearSet| $$)
(|AbelianSemiGroup|) (|SemiGroup|)
- (|LeftLinearSet| 26)
+ (|LeftLinearSet| 25)
(|TranscendentalFunctionCategory|)
(|DifferentialDomain| $$)
(|RetractableTo| 114)
- (|RetractableTo| 26) (|RealConstant|)
+ (|RetractableTo| 25) (|RealConstant|)
(|SetCategory|) (|ConvertibleTo| 50)
(|ElementaryFunctionCategory|)
(|ArcHyperbolicFunctionCategory|)
@@ -1046,73 +1036,73 @@
(|ConvertibleTo| 13)
(|CoercibleFrom| 114)
(|CoercibleFrom| $$)
- (|CoercibleFrom| 26) (|BasicType|)
+ (|CoercibleFrom| 25) (|BasicType|)
(|CoercibleTo| 47))
(|makeByteWordVec2| 163
'(0 6 0 7 2 9 0 8 6 10 1 9 11 0 12 2 9
11 0 13 15 1 9 11 0 16 1 9 11 0 17 2
- 24 19 0 0 30 2 24 0 24 0 31 1 0 0 26
- 32 2 0 0 24 0 34 2 26 0 0 0 39 0 26 0
- 40 2 26 0 0 0 41 1 47 0 13 48 1 50 0
- 13 51 1 105 13 13 106 2 105 13 13 13
- 108 1 111 0 13 112 0 26 0 118 0 24 0
- 121 2 26 0 26 0 129 2 26 0 0 115 130
- 0 114 0 131 0 115 0 132 2 26 19 0 0
- 133 2 24 0 0 115 134 1 114 0 26 135 1
- 26 0 0 136 2 115 19 0 0 137 2 115 0 0
- 115 138 2 26 139 0 0 140 2 26 19 0 0
- 141 2 114 0 26 26 142 1 26 0 0 143 2
- 26 0 115 0 144 2 26 19 0 0 145 1 114
- 19 0 146 1 114 19 0 147 1 114 19 0
- 148 1 114 26 0 149 1 114 26 0 150 1
- 26 19 0 151 2 0 19 0 0 1 1 0 19 0 98
- 1 0 26 0 35 1 0 163 0 1 1 0 0 0 1 1 0
+ 23 19 0 0 29 2 23 0 23 0 30 2 0 0 23
+ 0 32 2 25 0 0 0 37 0 25 0 38 2 25 0 0
+ 0 39 0 25 0 41 1 47 0 13 48 1 50 0 13
+ 51 1 0 0 25 70 1 105 13 13 106 2 105
+ 13 13 13 108 1 111 0 13 112 0 23 0
+ 120 2 25 0 25 0 128 2 25 0 0 115 129
+ 0 114 0 130 0 115 0 131 2 25 19 0 0
+ 132 2 23 0 0 115 133 1 114 0 25 134 1
+ 25 0 0 135 2 115 19 0 0 136 2 115 0 0
+ 115 137 2 25 138 0 0 139 2 25 19 0 0
+ 140 2 114 0 25 25 141 1 25 0 0 142 2
+ 25 0 115 0 143 2 25 19 0 0 144 1 114
+ 19 0 145 1 114 19 0 146 1 114 19 0
+ 147 1 114 25 0 148 1 114 25 0 149 1
+ 25 19 0 150 2 0 19 0 0 1 1 0 19 0 98
+ 1 0 25 0 33 1 0 163 0 1 1 0 0 0 1 1 0
19 0 1 1 0 0 0 1 1 0 0 0 87 1 0 0 0
75 2 0 102 0 0 1 1 0 0 0 1 1 0 155 0
1 1 0 0 0 66 2 0 19 0 0 1 1 0 0 0 85
- 1 0 0 0 73 1 0 26 0 128 1 0 0 0 90 1
- 0 0 0 77 0 0 0 1 1 0 0 0 1 1 0 123 0
- 124 1 0 126 0 127 1 0 114 0 122 1 0
- 26 0 125 2 0 0 0 0 1 1 0 102 0 103 2
+ 1 0 0 0 73 1 0 25 0 127 1 0 0 0 90 1
+ 0 0 0 77 0 0 0 1 1 0 0 0 1 1 0 122 0
+ 123 1 0 125 0 126 1 0 114 0 121 1 0
+ 25 0 124 2 0 0 0 0 1 1 0 102 0 103 2
0 114 0 115 117 3 0 114 0 115 115 116
2 0 0 0 0 1 1 0 161 156 1 1 0 19 0 1
- 0 0 24 29 1 0 19 0 1 0 0 0 46 3 0 153
- 0 154 153 1 1 0 26 0 42 1 0 19 0 99 2
- 0 0 0 26 1 1 0 0 0 1 1 0 19 0 97 2 0
- 157 156 0 1 0 0 0 38 2 0 0 0 0 63 0 0
- 0 37 2 0 0 0 0 62 1 0 26 0 27 1 0 0 0
- 33 1 0 0 0 67 1 0 0 0 72 1 0 0 156 1
+ 0 0 23 28 1 0 19 0 1 0 0 0 46 3 0 153
+ 0 154 153 1 1 0 25 0 40 1 0 19 0 99 2
+ 0 0 0 25 1 1 0 0 0 1 1 0 19 0 97 2 0
+ 157 156 0 1 0 0 0 36 2 0 0 0 0 63 0 0
+ 0 35 2 0 0 0 0 62 1 0 25 0 26 1 0 0 0
+ 31 1 0 0 0 67 1 0 0 0 72 1 0 0 156 1
2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 1 0
100 0 101 2 0 162 162 162 1 1 0 0 156
1 2 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 3 0
- 0 26 26 24 110 2 0 0 26 26 1 1 0 155
+ 0 25 25 23 110 2 0 0 25 25 1 1 0 155
0 1 2 0 158 0 0 1 3 0 160 0 0 0 1 2 0
- 102 0 0 1 2 0 157 156 0 1 1 0 26 0 28
+ 102 0 0 1 2 0 157 156 0 1 1 0 25 0 27
0 0 0 45 1 0 0 0 71 1 0 115 0 1 2 0
- 139 0 0 1 0 0 24 1 2 0 0 0 115 1 1 0
+ 138 0 0 1 0 0 23 1 2 0 0 0 115 1 1 0
0 0 104 1 0 0 0 88 1 0 0 0 78 1 0 0 0
89 1 0 0 0 76 1 0 0 0 86 1 0 0 0 74 1
0 50 0 52 1 0 154 0 1 1 0 111 0 113 1
- 0 13 0 14 1 0 0 114 1 1 0 0 26 70 1 0
- 0 114 1 1 0 0 0 1 1 0 0 26 70 1 0 47
- 0 49 0 0 115 1 1 0 0 0 1 0 0 24 36 2
- 0 19 0 0 1 0 0 24 25 1 0 0 0 93 2 0 0
- 0 0 120 1 0 0 0 81 2 0 19 0 0 1 1 0 0
- 0 91 1 0 0 0 79 1 0 0 0 96 1 0 0 0 84
- 1 0 0 0 94 1 0 0 0 82 1 0 0 0 95 1 0
- 0 0 83 1 0 0 0 92 1 0 0 0 80 1 0 0 0
- 119 0 0 0 23 0 0 0 43 2 0 11 9 0 21 3
- 0 11 9 0 19 22 1 0 8 0 18 2 0 8 0 19
- 20 1 0 0 0 107 2 0 0 0 115 1 1 0 0 0
- 1 2 0 0 0 0 109 2 0 19 0 0 56 2 0 19
- 0 0 54 2 0 19 0 0 64 2 0 19 0 0 55 2
- 0 19 0 0 53 2 0 0 0 26 65 2 0 0 0 0
+ 0 13 0 14 1 0 0 114 1 1 0 0 25 152 1
+ 0 0 114 1 1 0 0 0 1 1 0 0 25 152 1 0
+ 47 0 49 0 0 115 1 1 0 0 0 1 0 0 23 34
+ 2 0 19 0 0 1 0 0 23 24 1 0 0 0 93 2 0
+ 0 0 0 119 1 0 0 0 81 2 0 19 0 0 1 1 0
+ 0 0 91 1 0 0 0 79 1 0 0 0 96 1 0 0 0
+ 84 1 0 0 0 94 1 0 0 0 82 1 0 0 0 95 1
+ 0 0 0 83 1 0 0 0 92 1 0 0 0 80 1 0 0
+ 0 118 0 0 0 42 0 0 0 43 2 0 11 9 0 21
+ 3 0 11 9 0 19 22 1 0 8 0 18 2 0 8 0
+ 19 20 1 0 0 0 107 2 0 0 0 115 1 1 0 0
+ 0 1 2 0 0 0 0 109 2 0 19 0 0 56 2 0
+ 19 0 0 54 2 0 19 0 0 64 2 0 19 0 0 55
+ 2 0 19 0 0 53 2 0 0 0 25 65 2 0 0 0 0
44 2 0 0 0 0 59 1 0 0 0 57 2 0 0 0 0
- 58 2 0 0 0 0 69 2 0 0 0 114 152 2 0 0
- 0 26 68 2 0 0 0 115 1 2 0 0 0 24 1 2
+ 58 2 0 0 0 0 69 2 0 0 0 114 151 2 0 0
+ 0 25 68 2 0 0 0 115 1 2 0 0 0 23 1 2
0 0 114 0 1 2 0 0 0 114 1 2 0 0 0 0
- 60 2 0 0 26 0 61 2 0 0 115 0 1 2 0 0
- 24 0 34)))))
+ 60 2 0 0 25 0 61 2 0 0 115 0 1 2 0 0
+ 23 0 32)))))
'|lookupComplete|))
(MAKEPROP '|DoubleFloat| 'NILADIC T)
diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp
index 1f00bd68..af1162d4 100644
--- a/src/algebra/strap/DIVRING-.lsp
+++ b/src/algebra/strap/DIVRING-.lsp
@@ -11,8 +11,8 @@
(COND
((ZEROP |n|) (|spadConstant| $ 10))
((SPADCALL |x| (|getShellEntry| $ 11))
- (COND ((< |n| 0) (|error| "division by zero")) ('T |x|)))
- ((< |n| 0)
+ (COND ((MINUSP |n|) (|error| "division by zero")) ('T |x|)))
+ ((MINUSP |n|)
(SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) (- |n|)
(|getShellEntry| $ 19)))
('T (SPADCALL |x| |n| (|getShellEntry| $ 19)))))
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 26185c00..9ad8712c 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -104,7 +104,7 @@
(T (SEQ (LETT |e|
(SPADCALL
(|check-subtype|
- (AND (>= |i| 0) (> |i| 0))
+ (AND (>= |i| 0) (< 0 |i|))
'(|PositiveInteger|) |i|)
(|getShellEntry| $ 14))
|FFIELDC-;createPrimitiveElement;S;8|)
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index 50471189..562d295c 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -19,7 +19,7 @@
(- (SPADCALL (|getShellEntry| $ 14)) 1)
(|getShellEntry| $ 16))
13301))))
- (|check-subtype| (AND (>= #0# 0) (> #0# 0)) '(|PositiveInteger|)
+ (|check-subtype| (AND (>= #0# 0) (< 0 #0#)) '(|PositiveInteger|)
#0#)))
(DEFUN |FloatingPointSystem&| (|#1|)
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp
index 67277b94..92b58126 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -76,7 +76,7 @@
(SPADCALL |p1| (|getShellEntry| $ 29))
|GCDDOM-;gcdPolynomial;3Sup;4|)
(EXIT (COND
- ((> |e1| 0)
+ ((< 0 |e1|)
(SETQ |p1|
(LET
((#0#
@@ -95,7 +95,7 @@
(SPADCALL |p2| (|getShellEntry| $ 29))
|GCDDOM-;gcdPolynomial;3Sup;4|)
(EXIT (COND
- ((> |e2| 0)
+ ((< 0 |e2|)
(SETQ |p2|
(LET
((#0#
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index 6ebab972..d7368a63 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -25,8 +25,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
|INT;one?;$B;7|))
-(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1)))
-
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;Zero;$;8|))
(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0))
@@ -47,17 +45,13 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
|INT;inc;2$;12|))
-(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (|%iadd| |x| 1)))
-
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
|INT;dec;2$;13|))
-(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (|%isub| |x| 1)))
-
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Short|)
|INT;hash;$Si;14|))
-(PUT '|INT;hash;$Si;14| '|SPADreplace| 'SXHASH)
+(PUT '|INT;hash;$Si;14| '|SPADreplace| '|%hash|)
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
|INT;negative?;$B;15|))
@@ -100,8 +94,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|)
|INT;convert;$Df;24|))
-(PUT '|INT;convert;$Df;24| '|SPADreplace|
- '(XLAM (|x|) (FLOAT |x| |$DoubleFloatMaximum|)))
+(PUT '|INT;convert;$Df;24| '|SPADreplace| '|%i2f|)
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
|INT;convert;$If;25|))
@@ -170,7 +163,7 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
|INT;-;2$;39|))
-(PUT '|INT;-;2$;39| '|SPADreplace| '-)
+(PUT '|INT;-;2$;39| '|SPADreplace| '|%ineg|)
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
|INT;+;3$;40|))
@@ -247,8 +240,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
|INT;unitCanonical;2$;55|))
-(PUT '|INT;unitCanonical;2$;55| '|SPADreplace| '|%iabs|)
-
(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
|INT;solveLinearPolynomialEquation|))
@@ -264,9 +255,18 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
|INT;gcdPolynomial;3Sup;60|))
+(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1)))
+
+(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (|%iadd| |x| 1)))
+
+(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (|%isub| |x| 1)))
+
+(PUT '|INT;unitCanonical;2$;55| '|SPADreplace|
+ '(XLAM (|x|) (|%iabs| |x|)))
+
(DEFUN |INT;writeOMInt| (|dev| |x| $)
(SEQ (COND
- ((< |x| 0)
+ ((MINUSP |x|)
(SEQ (SPADCALL |dev| (|getShellEntry| $ 13))
(SPADCALL |dev| "arith1" "unary_minus"
(|getShellEntry| $ 15))
@@ -342,20 +342,20 @@
(LET ((|c| (+ |a| |b|))) (COND ((>= |c| |p|) (- |c| |p|)) ('T |c|))))
(DEFUN |INT;submod;4$;21| (|a| |b| |p| $)
- (LET ((|c| (- |a| |b|))) (COND ((< |c| 0) (+ |c| |p|)) ('T |c|))))
+ (LET ((|c| (- |a| |b|))) (COND ((MINUSP |c|) (+ |c| |p|)) ('T |c|))))
(DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $)
(REMAINDER2 (* |a| |b|) |p|))
(DEFUN |INT;convert;$F;23| (|x| $)
- (SPADCALL |x| (|getShellEntry| $ 57)))
+ (SPADCALL |x| (|getShellEntry| $ 56)))
(DEFUN |INT;convert;$Df;24| (|x| $)
(DECLARE (IGNORE $))
(FLOAT |x| |$DoubleFloatMaximum|))
(DEFUN |INT;convert;$If;25| (|x| $)
- (SPADCALL |x| (|getShellEntry| $ 63)))
+ (SPADCALL |x| (|getShellEntry| $ 62)))
(DEFUN |INT;convert;$S;26| (|x| $)
(DECLARE (IGNORE $))
@@ -391,7 +391,7 @@
(DEFUN |INT;<;2$B;35| (|x| |y| $) (DECLARE (IGNORE $)) (< |x| |y|))
-(DEFUN |INT;>;2$B;36| (|x| |y| $) (DECLARE (IGNORE $)) (> |x| |y|))
+(DEFUN |INT;>;2$B;36| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|))
(DEFUN |INT;<=;2$B;37| (|x| |y| $) (DECLARE (IGNORE $)) (<= |x| |y|))
@@ -441,7 +441,7 @@
(DEFUN |INT;gcd;3$;53| (|x| |y| $) (DECLARE (IGNORE $)) (GCD |x| |y|))
(DEFUN |INT;unitNormal;$R;54| (|x| $)
- (COND ((< |x| 0) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1))))
+ (COND ((MINUSP |x|) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1))))
(DEFUN |INT;unitCanonical;2$;55| (|x| $)
(DECLARE (IGNORE $))
@@ -492,7 +492,7 @@
(DEFUN |Integer| ()
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#0=#:G1524)
+ (PROG (#0=#:G1525)
(RETURN
(COND
((SETQ #0# (HGET |$ConstructorCache| '|Integer|))
@@ -513,7 +513,7 @@
(|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $))
(|stuffDomainSlots| $)
(|setShellEntry| $ 83
- (|setShellEntry| $ 53
+ (|setShellEntry| $ 82
(CONS (|dispatchFunction| |INT;*;3$;43|) $)))
$))
@@ -539,7 +539,7 @@
(|SingleInteger|) |INT;hash;$Si;14| |INT;negative?;$B;15|
(|OutputForm|) (56 . |outputForm|) |INT;coerce;$Of;16|
|INT;coerce;2$;17| |INT;convert;2$;18| |INT;length;2$;19|
- |INT;>=;2$B;38| |INT;addmod;4$;20| |INT;submod;4$;21| NIL
+ |INT;>=;2$B;38| |INT;addmod;4$;20| |INT;submod;4$;21|
|INT;rem;3$;50| |INT;mulmod;4$;22| (|Float|)
(61 . |coerce|) |INT;convert;$F;23| (|DoubleFloat|)
(66 . |coerce|) |INT;convert;$Df;24| (|InputForm|)
@@ -547,10 +547,10 @@
|INT;convert;$S;26| (81 . <) (87 . |concat|)
|INT;latex;$S;27| |INT;positiveRemainder;3$;28|
(|Matrix| 17) (|Matrix| $) |INT;reducedSystem;2M;29|
- (|Vector| 17) (|Record| (|:| |mat| 71) (|:| |vec| 74))
+ (|Vector| 17) (|Record| (|:| |mat| 70) (|:| |vec| 73))
(|Vector| $) |INT;reducedSystem;MVR;30| |INT;abs;2$;31|
|INT;random;$;32| |INT;random;2$;33| |INT;>;2$B;36|
- |INT;<=;2$B;37| NIL |INT;**;$Nni$;44| |INT;odd?;$B;45|
+ |INT;<=;2$B;37| NIL NIL |INT;**;$Nni$;44| |INT;odd?;$B;45|
|INT;max;3$;46| |INT;min;3$;47|
(|Record| (|:| |quotient| $) (|:| |remainder| $))
|INT;divide;2$R;48| |INT;quo;3$;49| |INT;shift;3$;51|
@@ -659,11 +659,11 @@
(|DifferentialDomain| $$)
(|SetCategory|) (|OpenMath|)
(|ConvertibleTo| 14)
- (|ConvertibleTo| 56)
- (|ConvertibleTo| 59)
+ (|ConvertibleTo| 55)
+ (|ConvertibleTo| 58)
(|CombinatorialFunctionCategory|)
(|ConvertibleTo| 131)
- (|ConvertibleTo| 62)
+ (|ConvertibleTo| 61)
(|ConvertibleTo| 17) (|Type|)
(|CoercibleFrom| $$)
(|CoercibleFrom| 17) (|BasicType|)
@@ -673,9 +673,9 @@
15 2 12 11 0 17 18 1 12 11 0 19 0 20
0 21 2 12 0 14 20 22 1 12 11 0 23 1
12 11 0 24 1 12 11 0 25 0 7 0 32 1 44
- 0 17 45 1 56 0 17 57 1 59 0 17 60 1
- 62 0 17 63 1 14 0 17 65 2 17 9 0 0 67
- 2 14 0 0 0 68 2 101 100 99 98 102 1
+ 0 17 45 1 55 0 17 56 1 58 0 17 59 1
+ 61 0 17 62 1 14 0 17 64 2 17 9 0 0 66
+ 2 14 0 0 0 67 2 101 100 99 98 102 1
105 104 103 106 1 103 0 0 107 1 103 2
0 108 1 109 104 103 110 1 103 0 2 111
2 0 92 0 0 112 1 0 113 0 114 2 117
@@ -686,37 +686,37 @@
9 0 1 2 0 0 0 0 1 2 0 92 0 0 1 3 0 0
0 0 0 52 1 0 0 0 1 1 0 113 0 1 2 0 9
0 0 1 1 0 17 0 1 2 0 0 0 0 91 0 0 0 1
- 1 0 133 0 1 1 0 17 0 1 2 0 0 0 0 54 2
- 0 75 76 0 1 1 0 71 76 1 1 0 71 72 73
- 2 0 75 72 76 77 1 0 92 0 93 1 0 130 0
- 1 1 0 9 0 1 1 0 129 0 1 0 0 0 79 1 0
- 0 0 80 2 0 0 0 0 90 1 0 135 134 1 1 0
- 9 0 1 3 0 0 0 0 0 1 2 0 0 0 0 70 1 0
+ 1 0 133 0 1 1 0 17 0 1 2 0 0 0 0 53 2
+ 0 74 75 0 1 1 0 70 75 1 1 0 70 71 72
+ 2 0 74 71 75 76 1 0 92 0 93 1 0 130 0
+ 1 1 0 9 0 1 1 0 129 0 1 0 0 0 78 1 0
+ 0 0 79 2 0 0 0 0 90 1 0 135 134 1 1 0
+ 9 0 1 3 0 0 0 0 0 1 2 0 0 0 0 69 1 0
9 0 1 2 0 0 0 0 1 3 0 132 0 131 132 1
1 0 9 0 34 1 0 9 0 85 1 0 92 0 1 1 0
- 9 0 43 2 0 136 134 0 1 3 0 0 0 0 0 55
+ 9 0 43 2 0 136 134 0 1 3 0 0 0 0 0 54
2 0 0 0 0 87 2 0 0 0 0 86 1 0 0 0 1 1
0 0 0 49 2 0 0 0 0 1 1 0 0 134 1 1 0
- 14 0 69 2 0 0 0 0 1 0 0 0 1 1 0 0 0
+ 14 0 68 2 0 0 0 0 1 0 0 0 1 1 0 0 0
38 1 0 41 0 42 2 0 127 127 127 128 2
0 0 0 0 94 1 0 0 134 1 1 0 0 0 1 1 0
113 0 114 2 0 137 0 0 1 3 0 139 0 0 0
1 2 0 92 0 0 112 2 0 136 134 0 1 1 0
9 0 1 1 0 7 0 1 2 0 88 0 0 89 2 0 0 0
7 1 1 0 0 0 1 1 0 0 0 40 1 0 0 0 36 1
- 0 14 0 66 1 0 59 0 61 1 0 56 0 58 1 0
- 131 0 1 1 0 62 0 64 1 0 17 0 48 1 0 0
+ 0 14 0 65 1 0 58 0 60 1 0 55 0 57 1 0
+ 131 0 1 1 0 61 0 63 1 0 17 0 48 1 0 0
17 47 1 0 0 0 1 1 0 0 17 47 1 0 44 0
46 0 0 7 1 2 0 9 0 0 1 2 0 0 0 0 1 2
0 9 0 0 1 0 0 0 35 2 0 9 0 0 1 3 0 0
- 0 0 0 51 1 0 0 0 78 0 0 0 6 0 0 0 31
+ 0 0 0 51 1 0 0 0 77 0 0 0 6 0 0 0 31
3 0 11 12 0 9 29 2 0 14 0 9 27 2 0 11
12 0 28 1 0 14 0 26 2 0 0 0 7 1 1 0 0
- 0 1 2 0 9 0 0 50 2 0 9 0 0 81 2 0 9 0
- 0 33 2 0 9 0 0 82 2 0 9 0 0 10 1 0 0
+ 0 1 2 0 9 0 0 50 2 0 9 0 0 80 2 0 9 0
+ 0 33 2 0 9 0 0 81 2 0 9 0 0 10 1 0 0
0 16 2 0 0 0 0 39 2 0 0 0 0 37 2 0 0
0 7 84 2 0 0 0 140 1 2 0 0 17 0 83 2
- 0 0 0 0 53 2 0 0 17 0 83 2 0 0 7 0 1
+ 0 0 0 0 82 2 0 0 17 0 83 2 0 0 7 0 1
2 0 0 140 0 1)))))
'|lookupComplete|))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 9340674d..b3224386 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -191,7 +191,7 @@
(- (SPADCALL |s| (|getShellEntry| $ 47))
(|getShellEntry| $ 6))))))
(SEQ (COND
- ((OR (OR (< |l| 0) (>= |h| |m|)) (< |h| (- |l| 1)))
+ ((OR (OR (MINUSP |l|) (>= |h| |m|)) (< |h| (- |l| 1)))
(EXIT (|error| "index out of range"))))
(LETT |r|
(MAKE-FULL-CVEC
@@ -228,7 +228,7 @@
(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $)
(SEQ (COND
((OR (< |i| (|getShellEntry| $ 6))
- (> |i| (SPADCALL |s| (|getShellEntry| $ 47))))
+ (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|))
(|error| "index out of range"))
('T
(SEQ (QESET |s| (- |i| (|getShellEntry| $ 6)) |c|)
@@ -238,8 +238,8 @@
(LET* ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
- ((< |startpos| 0) (|error| "index out of bounds"))
- ((> |np| (- |nw| |startpos|)) NIL)
+ ((MINUSP |startpos|) (|error| "index out of bounds"))
+ ((< (- |nw| |startpos|) |np|) NIL)
('T
(SEQ (LET ((|ip| 0) (#0=#:G1538 (- |np| 1))
(|iw| |startpos|))
@@ -262,7 +262,8 @@
(RETURN
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
- ((< |startpos| 0) (|error| "index out of bounds"))
+ ((MINUSP |startpos|)
+ (|error| "index out of bounds"))
((>= |startpos| (QCSIZE |t|))
(- (|getShellEntry| $ 6) 1))
('T
@@ -276,7 +277,7 @@
(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $)
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
- ((< |startpos| 0) (|error| "index out of bounds"))
+ ((MINUSP |startpos|) (|error| "index out of bounds"))
((>= |startpos| (QCSIZE |t|))
(- (|getShellEntry| $ 6) 1))
('T
@@ -296,7 +297,7 @@
(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $)
(SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
(EXIT (COND
- ((< |startpos| 0) (|error| "index out of bounds"))
+ ((MINUSP |startpos|) (|error| "index out of bounds"))
((>= |startpos| (QCSIZE |t|))
(- (|getShellEntry| $ 6) 1))
('T
@@ -318,7 +319,7 @@
(LET* ((|m| (SPADCALL |s| (|getShellEntry| $ 47)))
(|n| (SPADCALL |t| (|getShellEntry| $ 47))))
(COND
- ((> |m| |n|) NIL)
+ ((< |n| |m|) NIL)
('T
(|ISTRING;substring?;2$IB;17| |s| |t|
(- (+ (|getShellEntry| $ 6) |n|) |m|) $)))))
@@ -331,7 +332,7 @@
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|c| (|getShellEntry| $ 69)))))
@@ -341,7 +342,7 @@
(LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(>= (LETT |j|
(|ISTRING;position;C$2I;19| |c| |s|
@@ -361,7 +362,7 @@
(COND
((NOT
(COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL
(|ISTRING;elt;$IC;30| |s| |i|
@@ -370,7 +371,7 @@
(RETURN NIL))
(T (SETQ |i| (+ |i| 1))))))))))
(COND
- ((NOT (> |i| |n|))
+ ((NOT (< |n| |i|))
(SETQ |l|
(SPADCALL
(|ISTRING;elt;$Us$;31| |s|
@@ -387,7 +388,7 @@
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|cc| (|getShellEntry| $ 65)))))
@@ -397,7 +398,7 @@
(LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(>= (LETT |j|
(|ISTRING;position;Cc$2I;20| |cc|
@@ -417,7 +418,7 @@
(COND
((NOT
(COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL
(|ISTRING;elt;$IC;30| |s| |i|
@@ -426,7 +427,7 @@
(RETURN NIL))
(T (SETQ |i| (+ |i| 1))))))))))
(COND
- ((NOT (> |i| |n|))
+ ((NOT (< |n| |i|))
(SETQ |l|
(SPADCALL
(|ISTRING;elt;$Us$;31| |s|
@@ -441,7 +442,7 @@
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c|
(|getShellEntry| $ 69)))))
@@ -456,7 +457,7 @@
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| |n|) NIL)
+ ((< |n| |i|) NIL)
('T
(SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc|
(|getShellEntry| $ 65)))))
@@ -530,14 +531,14 @@
(|n| (QCSIZE |y|)))
(SEQ (SETQ |s| (- |s| (|getShellEntry| $ 6)))
(COND
- ((OR (< |s| 0) (> (+ |s| |m|) |n|))
+ ((OR (MINUSP |s|) (< |n| (+ |s| |m|)))
(EXIT (|error| "index out of range"))))
(RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))
(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $)
(COND
((OR (< |i| (|getShellEntry| $ 6))
- (> |i| (SPADCALL |s| (|getShellEntry| $ 47))))
+ (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|))
(|error| "index out of range"))
('T (CHAR |s| (- |i| (|getShellEntry| $ 6))))))
@@ -552,7 +553,7 @@
(- (SPADCALL |s| (|getShellEntry| $ 47))
(|getShellEntry| $ 6))))))
(SEQ (COND
- ((OR (< |l| 0) (>= |h| (QCSIZE |s|)))
+ ((OR (MINUSP |l|) (>= |h| (QCSIZE |s|)))
(EXIT (|error| "index out of bound"))))
(EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))
diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp
index 2dc153c6..71915a22 100644
--- a/src/algebra/strap/LNAGG-.lsp
+++ b/src/algebra/strap/LNAGG-.lsp
@@ -33,7 +33,7 @@
(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $)
(COND
((>= |i| (SPADCALL |a| (|getShellEntry| $ 9)))
- (NOT (> |i| (SPADCALL |a| (|getShellEntry| $ 10)))))
+ (NOT (< (SPADCALL |a| (|getShellEntry| $ 10)) |i|)))
('T NIL)))
(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $)
diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp
index 184b8ab6..eba910e6 100644
--- a/src/algebra/strap/NNI.lsp
+++ b/src/algebra/strap/NNI.lsp
@@ -33,7 +33,7 @@
(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| $)
(LET ((|c| (- |x| |y|)))
(COND
- ((< |c| 0) (CONS 1 "failed"))
+ ((MINUSP |c|) (CONS 1 "failed"))
('T
(CONS 0
(|check-subtype| (>= |c| 0) '(|NonNegativeInteger|) |c|))))))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 6244906c..dd5ede72 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -616,20 +616,20 @@
(DEFUN |OUTFORM;vspace;I$;28| (|n| $)
(COND
- ((> |n| 0)
+ ((< 0 |n|)
(|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $)
$))
('T (|OUTFORM;empty;$;73| $))))
(DEFUN |OUTFORM;hspace;I$;29| (|n| $)
(COND
- ((> |n| 0) (|fillerSpaces| |n|))
+ ((< 0 |n|) (|fillerSpaces| |n|))
('T (|OUTFORM;empty;$;73| $))))
(DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $)
(SEQ (COND
- ((> |n| 0)
- (COND ((NOT (> |m| 0)) (EXIT (|OUTFORM;empty;$;73| $)))))
+ ((< 0 |n|)
+ (COND ((NOT (< 0 |m|)) (EXIT (|OUTFORM;empty;$;73| $)))))
('T (EXIT (|OUTFORM;empty;$;73| $))))
(EXIT (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $)
(|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $))))
@@ -937,7 +937,7 @@
('T
(SEQ (LETT |r|
(SPADCALL
- (|check-subtype| (> |nn| 0)
+ (|check-subtype| (< 0 |nn|)
'(|PositiveInteger|) |nn|)
(|getShellEntry| $ 137))
|OUTFORM;differentiate;$Nni$;97|)
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index ca4bdc5f..46d17c73 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -936,7 +936,7 @@
|POLYCAT-;charthRootlv|)
(LOOP
(COND
- ((NOT (> |d| 0)) (RETURN NIL))
+ ((NOT (< 0 |d|)) (RETURN NIL))
(T (SEQ (LETT |dd|
(SPADCALL |d| |ch|
(|getShellEntry| $ 173))
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index ca473e7e..7aaa1956 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -92,8 +92,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;and;3$;22|))
-(PUT '|SINT;and;3$;22| '|SPADreplace| 'LOGAND)
-
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;Or;3$;23|))
@@ -102,8 +100,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;or;3$;24|))
-(PUT '|SINT;or;3$;24| '|SPADreplace| 'LOGIOR)
-
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;xor;3$;25|))
@@ -198,8 +194,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|)
|SINT;one?;$B;44|))
-(PUT '|SINT;one?;$B;44| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1)))
-
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
|SINT;max;3$;45|))
@@ -284,6 +278,14 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Shell|)
|SINT;unitNormal;$R;62|))
+(PUT '|SINT;and;3$;22| '|SPADreplace|
+ '(XLAM (|x| |y|) (LOGAND |x| |y|)))
+
+(PUT '|SINT;or;3$;24| '|SPADreplace|
+ '(XLAM (|x| |y|) (LOGIOR |x| |y|)))
+
+(PUT '|SINT;one?;$B;44| '|SPADreplace| '(XLAM (|x|) (|%ieq| |x| 1)))
+
(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $)
(SEQ (COND
((QSLESSP |x| 0)
@@ -509,7 +511,7 @@
(DEFUN |SINT;unitNormal;$R;62| (|x| $)
(COND
- ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1))
+ ((QSLESSP |x| 0) (VECTOR (QSMINUS 1) (QSMINUS |x|) (QSMINUS 1)))
('T (VECTOR 1 |x| 1))))
(DEFUN |SingleInteger| ()
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index 7bfb0d2d..53991265 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -74,7 +74,7 @@
(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $)
(SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))))
(COND
- ((OR (< |i| 0)
+ ((OR (MINUSP |i|)
(SPADCALL
(SETQ |x|
(SPADCALL |x|
@@ -91,7 +91,7 @@
(LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28))
(SPADCALL |x| (|getShellEntry| $ 21)))))
(COND
- ((< |l| 0) (|error| "index out of range"))
+ ((MINUSP |l|) (|error| "index out of range"))
((NOT (SPADCALL |i| (|getShellEntry| $ 29)))
(SPADCALL (SPADCALL |x|
(|check-subtype| (>= |l| 0)
@@ -156,7 +156,7 @@
(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $)
(SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))))
(COND
- ((OR (< |i| 0)
+ ((OR (MINUSP |i|)
(SPADCALL
(SETQ |x|
(SPADCALL |x|
@@ -173,7 +173,7 @@
(LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28))
(SPADCALL |x| (|getShellEntry| $ 21)))))
(COND
- ((< |l| 0) (|error| "index out of range"))
+ ((MINUSP |l|) (|error| "index out of range"))
('T
(SEQ (LETT |h|
(COND
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 7aca9e5f..e5372535 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -278,7 +278,7 @@
(RETURN
(LET ((|s| (PNAME (SPADCALL |e| (|getShellEntry| $ 100)))))
(SEQ (COND
- ((> (QCSIZE |s|) 1)
+ ((< 1 (QCSIZE |s|))
(COND
((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
(SPADCALL "\\" (|getShellEntry| $ 43))
@@ -607,7 +607,7 @@
(DEFUN |SYMBOL;istring| (|n| $)
(COND
- ((> |n| 9) (|error| "Can have at most 9 scripts of each kind"))
+ ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind"))
('T (|getSimpleArrayEntry| (|getShellEntry| $ 18) (+ |n| 0)))))
(DEFUN |SYMBOL;list;$L;34| (|sy| $)
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 6befa66f..6d2558bb 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -168,20 +168,20 @@
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| 0)
+ ((< 0 |i|)
(NOT (SPADCALL |l| (|getShellEntry| $ 20))))
('T NIL)))
(RETURN NIL))
(T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14)))
(EXIT (SETQ |i| (- |i| 1)))))))
- (EXIT (> |i| 0)))))
+ (EXIT (< 0 |i|)))))
(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $)
(LET ((|i| |n|))
(SEQ (LOOP
(COND
((NOT (COND
- ((> |i| 0)
+ ((< 0 |i|)
(NOT (SPADCALL |l| (|getShellEntry| $ 20))))
('T NIL)))
(RETURN NIL))
@@ -198,7 +198,7 @@
(COND
((NOT (COND
((SPADCALL |l| (|getShellEntry| $ 20)) NIL)
- ('T (> |i| 0))))
+ ('T (< 0 |i|))))
(RETURN NIL))
(T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14)))
(EXIT (SETQ |i| (- |i| 1)))))))
@@ -376,7 +376,7 @@
(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $)
(LET ((|m| (SPADCALL |x| (|getShellEntry| $ 60))))
(COND
- ((> |n| |m|) (|error| "index out of range"))
+ ((< |m| |n|) (|error| "index out of range"))
('T
(SPADCALL
(SPADCALL |x|
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 17d630b4..c2c55b14 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1148,10 +1148,10 @@ replaceSimpleFunctions form ==
optLET mutateLETFormWithUnaryFunction(form,"replaceSimpleFunctions")
form is ["spadConstant","$",n] =>
null(op := getCapsuleDirectoryEntry n) => form
- getFunctionReplacement op is ["XLAM",=nil,body]
- and isAtomicForm body => body
-- Conservatively preserve object identity and storage
-- consumption by not folding non-atomic constant forms.
+ getFunctionReplacement op isnt ['XLAM,=nil,body] => form
+ isAtomicForm body or isVMConstantForm body => body
form
-- 1. process argument first.
for args in tails rest form repeat
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index f8e28b42..a78abadd 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -471,18 +471,19 @@ $VMsideEffectFreeOperators ==
SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH
QEQCAR QCDR QCAR INTEGERP FLOATP STRINGP IDENTP SYMBOLP
MINUSP GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN FLOAT_-DIGITS
- CGREATERP GGREATERP CHAR BOOLE GET BVEC_-GREATER FUNCALL %false %true
+ CGREATERP GGREATERP CHAR BOOLE GET BVEC_-GREATER %false %true
%and %or %not %eq %ieq %ilt %ile %igt %ige %head %tail %integer?
%imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
%feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
- %fpow %fdiv %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
- %lreverse %lempty? %hash %ismall? %string?
- %ceq %clt %cle %cgt %cge %c2i %i2c)
+ %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
+ %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
+ %lreverse %lempty? %hash %ismall? %string?
+ %ceq %clt %cle %cgt %cge %c2i %i2c)
++ List of simple VM operators
$simpleVMoperators ==
append($VMsideEffectFreeOperators,
- ["CONS","LIST","VECTOR","STRINGIMAGE",'%gensym, '%lreverse_!,
+ ['CONS,'LIST,'VECTOR,'STRINGIMAGE,'FUNCALL,'%gensym, '%lreverse_!,
"MAKE-FULL-CVEC","BVEC-MAKE-FULL","COND"])
++ Return true if the `form' is semi-simple with respect to
@@ -513,10 +514,8 @@ isFloatableVMForm form ==
isVMConstantForm: %Code -> %Boolean
isVMConstantForm form ==
integer? form or string? form => true
- form=nil or form=true => true
form isnt [op,:args] => false
- op = "QUOTE" => true
- MEMQ(op,$simpleVMoperators) and
+ MEMQ(op,$VMsideEffectFreeOperators) and
"and"/[isVMConstantForm arg for arg in args]
++ Return the set of free variables in the VM form `form'.
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index bf4a02ee..af20fb51 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -226,6 +226,50 @@ expandReturn(x is ['%return,.,y]) ==
expandEq ["%eq",:args] ==
["EQ",:expandToVMForm args]
+
+expandIneg ['%ineg,x] ==
+ x := expandToVMForm x
+ integer? x => -x
+ ['_-,x]
+
+expandIlt ['%ilt,x,y] ==
+ integer? x and x = 0 => ['PLUSP,expandToVMForm y]
+ integer? y and y = 0 => ['MINUSP,expandToVMForm x]
+ ['_<,expandToVMForm x,expandToVMForm y]
+
+expandIgt ['%igt,x,y] ==
+ expandFlt ['%ilt,y,x]
+
+-- Floating point support
+
+expandFbase ['%fbase] ==
+ FLOAT_-RADIX $DoubleFloatMaximum
+
+expandFprec ['%fprec] ==
+ FLOAT_-DIGITS $DoubleFloatMaximum
+
+expandFminval ['%fminval] ==
+ '$DoubleFloatMinimum
+
+expandFmaxval ['%fmaxval] ==
+ '$DoubleFloatMaximum
+
+expandI2f ['%i2f,x] ==
+ x := expandToVMForm x
+ integer? x and (x = 0 or x = 1) => FLOAT(x,$DoubleFloatMaximum)
+ ['FLOAT,x,'$DoubleFloatMaximum]
+
+expandFneg ['%fneg,x] ==
+ ['_-,expandToVMForm x]
+
+expandFlt ['%flt,x,y] ==
+ x is ['%i2f,0] => ['PLUSP,expandToVMForm y]
+ y is ['%i2f,0] => ['MINUSP,expandToVMForm x]
+ ['_<,expandToVMForm x,expandToVMForm y]
+
+expandFgt ['%fgt,x,y] ==
+ expandFlt ['%flt,y,x]
+
-- Local variable bindings
expandBind ['%bind,inits,body] ==
body := expandToVMForm body
@@ -274,7 +318,6 @@ for x in [
-- unary integer operations.
['%iabs, :'ABS],
['%ieven?, :'EVENP],
- ['%ineg, :"-"],
['%integer?,:'INTEGERP],
['%iodd?, :'ODDP],
['%ismall?, :'FIXNUMP],
@@ -283,11 +326,9 @@ for x in [
['%ieq, :"EQL"],
['%igcd,:'GCD],
['%ige, :">="],
- ['%igt, :">"],
['%iinc,:"1+"],
['%ilcm,:'LCM],
['%ile, :"<="],
- ['%ilt, :"<"],
['%imax,:'MAX],
['%imin,:'MIN],
['%imul,:"*"],
@@ -297,14 +338,13 @@ for x in [
-- unary float operations.
['%fabs, :'ABS],
['%float?,:'FLOATP],
+ ['%ftrunc,:'TRUNCATE],
-- binary float operations.
['%fadd, :"+"],
['%fdiv, :"/"],
['%feq, :"="],
['%fge, :">="],
- ['%fgt, :">"],
['%fle, :"<="],
- ['%flt, :"<"],
['%fmax, :'MAX],
['%fmin, :'MIN],
['%fmul, :"*"],
@@ -348,6 +388,19 @@ for x in [
['%loop, :function expandLoop],
['%return, :function expandReturn],
+ ['%igt, :function expandIgt],
+ ['%ilt, :function expandIlt],
+ ['%ineg, :function expandIneg],
+
+ ['%i2f, :function expandI2f],
+ ['%fbase, :function expandFbase],
+ ['%fgt, :function expandFgt],
+ ['%flt, :function expandFlt],
+ ['%fmaxval, :function expandFmaxval],
+ ['%fminval, :function expandFminval],
+ ['%fneg, :function expandFneg],
+ ['%fprec, :function expandFprec],
+
["%eq",:function expandEq],
["%bind",:function expandBind],
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 71cd6a21..8981fd7e 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -164,8 +164,10 @@ needToQuoteFlags?(sig,env) ==
optDeltaEntry(op,sig,dc,eltOrConst) ==
$killOptimizeIfTrue = true => nil
+ -- references to modemaps from current domain are folded in a later
+ -- stage of the compilation process.
+ dc = '$ => nil
ndc :=
- dc = '$ => $functorForm
atom dc and (dcval := get(dc,'value,$e)) => dcval.expr
dc
sig := MSUBST(ndc,dc,sig)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 01:33:17 +0000