aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog5
-rw-r--r--src/algebra/sf.spad.pamphlet12
-rw-r--r--src/algebra/strap/DFLOAT.lsp66
-rw-r--r--src/interp/g-util.boot7
4 files changed, 51 insertions, 39 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 78f7dc8e..96ba7fe2 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
2010-07-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/g-util.boot (expandFeq): New.
+ * algebra/sf.spad.pamphlet (DoubleFloat): Tidy.
+
+2010-07-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/g-util.boot (expandIeq): New expander for %ieq.
* interp/g-opt.boot (optIeq): New.
(optIadd): Likewise.
diff --git a/src/algebra/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet
index 1b36780f..1b51d3a0 100644
--- a/src/algebra/sf.spad.pamphlet
+++ b/src/algebra/sf.spad.pamphlet
@@ -406,8 +406,8 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
acoth x == checkComplex ACOTH(x)$Lisp
asech x == checkComplex ASECH(x)$Lisp
x:% / y:% == %fdiv(x,y)
- negative? x == MINUSP(x)$Lisp
- zero? x == ZEROP(x)$Lisp
+ negative? x == x < 0
+ zero? x == x = 0
one? x == x = 1
hash x == HASHEQ(x)$Lisp
recip(x) == (zero? x => "failed"; 1 / x)
@@ -426,14 +426,14 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
rationalApproximation(x, d) == rationalApproximation(x, d, 10)
atan(x,y) ==
- x = 0 =>
+ zero? x =>
y > 0 => pi()/2
- y < 0 => -pi()/2
+ negative? y => -pi()/2
0
-- Only count on first quadrant being on principal branch.
theta := atan abs(y/x)
- if x < 0 then theta := pi() - theta
- if y < 0 then theta := - theta
+ if negative? x then theta := pi() - theta
+ if negative? y then theta := - theta
theta
retract(x:%):Fraction(Integer) ==
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 8f162868..94b2fb12 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -294,13 +294,9 @@
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
|DFLOAT;negative?;$B;66|))
-(PUT '|DFLOAT;negative?;$B;66| '|SPADreplace| 'MINUSP)
-
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
|DFLOAT;zero?;$B;67|))
-(PUT '|DFLOAT;zero?;$B;67| '|SPADreplace| 'ZEROP)
-
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
|DFLOAT;one?;$B;68|))
@@ -386,6 +382,12 @@
(PUT '|DFLOAT;exp1;$;16| '|SPADreplace|
'(XLAM NIL (|%fdiv| (|%i2f| 534625820200) (|%i2f| 196677847971))))
+(PUT '|DFLOAT;negative?;$B;66| '|SPADreplace|
+ '(XLAM (|x|) (|%flt| |x| (|%i2f| 0))))
+
+(PUT '|DFLOAT;zero?;$B;67| '|SPADreplace|
+ '(XLAM (|x|) (|%feq| |x| (|%i2f| 0))))
+
(PUT '|DFLOAT;one?;$B;68| '|SPADreplace|
'(XLAM (|x|) (|%feq| |x| (|%i2f| 1))))
@@ -440,7 +442,7 @@
((EQL 2 2) 53)
((EQL 2 16) (* 4 53))
('T
- (LET ((#0=#:G1427
+ (LET ((#0=#:G1431
(TRUNCATE
(SPADCALL 53
(|DFLOAT;log2;2$;40|
@@ -621,7 +623,7 @@
(PROG (|theta|)
(RETURN
(SEQ (COND
- ((= |x| 0.0)
+ ((ZEROP |x|)
(COND
((PLUSP |y|) (/ PI 2))
((MINUSP |y|) (- (/ PI 2)))
@@ -635,7 +637,7 @@
(DEFUN |DFLOAT;retract;$F;80| (|x| $)
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (LET ((#0=#:G1506 (- 53 1)))
+ (LET ((#0=#:G1514 (- 53 1)))
(|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|)
#0#))
2 $))
@@ -643,7 +645,7 @@
(DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $)
(CONS 0
(|DFLOAT;rationalApproximation;$2NniF;87| |x|
- (LET ((#0=#:G1514 (- 53 1)))
+ (LET ((#0=#:G1522 (- 53 1)))
(|check-subtype| (NOT (MINUSP #0#))
'(|NonNegativeInteger|) #0#))
2 $)))
@@ -699,13 +701,13 @@
(- (CDR |me|) 53))))))))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $)
- (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G110| |q| |r|
- |p2| |q2| |#G111| |#G112| |#G113| |#G114| |#G115|
- |#G116|)
+ (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G107| |q| |r|
+ |p2| |q2| |#G108| |#G109| |#G110| |#G111| |#G112|
+ |#G113|)
(RETURN
- (LET* ((|#G109| (|DFLOAT;manexp| |f| $)) (|nu| (CAR |#G109|))
- (|ex| (CDR |#G109|)))
- (SEQ |#G109|
+ (LET* ((|#G106| (|DFLOAT;manexp| |f| $)) (|nu| (CAR |#G106|))
+ (|ex| (CDR |#G106|)))
+ (SEQ |#G106|
(LETT BASE 2 |DFLOAT;rationalApproximation;$2NniF;87|)
(EXIT (COND
((NOT (MINUSP |ex|))
@@ -718,7 +720,7 @@
('T
(SEQ (LETT |de|
(EXPT BASE
- (LET ((#0=#:G1542 (- |ex|)))
+ (LET ((#0=#:G1550 (- |ex|)))
(|check-subtype|
(NOT (MINUSP #0#))
'(|NonNegativeInteger|) #0#)))
@@ -748,14 +750,14 @@
(NIL (RETURN NIL))
(T
(SEQ
- (LETT |#G110|
+ (LETT |#G107|
(DIVIDE2 |s| |t|)
|DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |q| (CAR |#G110|)
+ (LETT |q| (CAR |#G107|)
|DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |r| (CDR |#G110|)
+ (LETT |r| (CDR |#G107|)
|DFLOAT;rationalApproximation;$2NniF;87|)
- |#G110|
+ |#G107|
(LETT |p2|
(+ (* |q| |p1|) |p0|)
|DFLOAT;rationalApproximation;$2NniF;87|)
@@ -777,26 +779,26 @@
(SPADCALL |p2| |q2|
(|getShellEntry| $
141)))))
- (LETT |#G111| |p1|
+ (LETT |#G108| |p1|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |#G112| |p2|
+ (LETT |#G109| |p2|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (SETQ |p0| |#G111|)
- (SETQ |p1| |#G112|)
- (LETT |#G113| |q1|
+ (SETQ |p0| |#G108|)
+ (SETQ |p1| |#G109|)
+ (LETT |#G110| |q1|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |#G114| |q2|
+ (LETT |#G111| |q2|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (SETQ |q0| |#G113|)
- (SETQ |q1| |#G114|)
+ (SETQ |q0| |#G110|)
+ (SETQ |q1| |#G111|)
(EXIT
(PROGN
- (LETT |#G115| |t|
+ (LETT |#G112| |t|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |#G116| |r|
+ (LETT |#G113| |r|
|DFLOAT;rationalApproximation;$2NniF;87|)
- (SETQ |s| |#G115|)
- (SETQ |t| |#G116|)))))))))))))))))))))
+ (SETQ |s| |#G112|)
+ (SETQ |t| |#G113|)))))))))))))))))))))
(DEFUN |DFLOAT;**;$F$;88| (|x| |r| $)
(PROG (|n| |d|)
@@ -844,7 +846,7 @@
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
- (PROG (#0=#:G1565)
+ (PROG (#0=#:G1581)
(RETURN
(COND
((SETQ #0# (HGET |$ConstructorCache| '|DoubleFloat|))
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 669998cd..4f840c3b 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -300,6 +300,11 @@ expandI2f ['%i2f,x] ==
expandFneg ['%fneg,x] ==
['_-,expandToVMForm x]
+expandFeq ['%feq,a,b] ==
+ a is ['%i2f,0] => ['ZEROP,expandToVMForm b]
+ b is ['%i2f,0] => ['ZEROP,expandToVMForm a]
+ ['_=,expandToVMForm a,expandToVMForm b]
+
expandFlt ['%flt,x,y] ==
x is ['%i2f,0] => ['PLUSP,expandToVMForm y]
y is ['%i2f,0] => ['MINUSP,expandToVMForm x]
@@ -383,7 +388,6 @@ for x in [
-- binary float operations.
['%fadd, :"+"],
['%fdiv, :"/"],
- ['%feq, :"="],
['%fge, :">="],
['%fle, :"<="],
['%fmax, :'MAX],
@@ -453,6 +457,7 @@ for x in [
['%i2f, :function expandI2f],
['%fbase, :function expandFbase],
+ ['%feq, :function expandFeq],
['%fgt, :function expandFgt],
['%flt, :function expandFlt],
['%fmaxval, :function expandFmaxval],
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-16 08:02:33 +0000