From 510c2f70ce377d60eed221e46294767f7f548f5d Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 22 Jul 2010 16:15:30 +0000
Subject: 	* interp/g-opt.boot (simplifyVMForm): New. 	(optRetract):
 Simplify the predicate when possible. 	(optNot): New transformer. 
 (optAnd): Likewise. 	(optOr): Likewise. 	(optIlt): Likewise. 
 (optIle): Likewise. 	(optIgt): Likewise. 	(optIge): Likewise.

---
 src/algebra/strap/DFLOAT.lsp | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

(limited to 'src/algebra/strap/DFLOAT.lsp')

diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 596307d8..6f32c302 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -446,8 +446,8 @@
                        (|DFLOAT;log2;2$;40|
                            (FLOAT 2 |$DoubleFloatMaximum|) $)
                        (|getShellEntry| $ 32)))))
-       (|check-subtype| (AND (>= #0# 0) (< 0 #0#)) '(|PositiveInteger|)
-           #0#))))) 
+       (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#))
+           '(|PositiveInteger|) #0#))))) 
 
 (DEFUN |DFLOAT;max;$;11| ($)
   (DECLARE (IGNORE $))
@@ -636,14 +636,16 @@
 (DEFUN |DFLOAT;retract;$F;80| (|x| $)
   (|DFLOAT;rationalApproximation;$2NniF;87| |x|
       (LET ((#0=#:G1506 (- 53 1)))
-        (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
+        (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|)
+            #0#))
       2 $)) 
 
 (DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $)
   (CONS 0
         (|DFLOAT;rationalApproximation;$2NniF;87| |x|
             (LET ((#0=#:G1514 (- 53 1)))
-              (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
+              (|check-subtype| (NOT (MINUSP #0#))
+                  '(|NonNegativeInteger|) #0#))
             2 $))) 
 
 (DEFUN |DFLOAT;retract;$I;82| (|x| $)
@@ -706,18 +708,19 @@
         (SEQ |#G109|
              (LETT BASE 2 |DFLOAT;rationalApproximation;$2NniF;87|)
              (EXIT (COND
-                     ((>= |ex| 0)
+                     ((NOT (MINUSP |ex|))
                       (SPADCALL
                           (* |nu|
                              (EXPT BASE
-                                   (|check-subtype| (>= |ex| 0)
+                                   (|check-subtype| (NOT (MINUSP |ex|))
                                     '(|NonNegativeInteger|) |ex|)))
                           (|getShellEntry| $ 134)))
                      ('T
                       (SEQ (LETT |de|
                                  (EXPT BASE
                                        (LET ((#0=#:G1542 (- |ex|)))
-                                         (|check-subtype| (>= #0# 0)
+                                         (|check-subtype|
+                                          (NOT (MINUSP #0#))
                                           '(|NonNegativeInteger|) #0#)))
                                  |DFLOAT;rationalApproximation;$2NniF;87|)
                            (EXIT (COND
-- 
cgit v1.2.3