* interp/g-util.boot (expandFeq): New.

	* algebra/sf.spad.pamphlet (DoubleFloat): Tidy.

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],