aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog4
-rw-r--r--src/algebra/strap/DFLOAT.lsp62
-rw-r--r--src/algebra/strap/POLYCAT-.lsp6
-rw-r--r--src/interp/g-opt.boot2
4 files changed, 35 insertions, 39 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 7c717a0e..1fb162dc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,9 @@
2010-07-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/g-opt.boot (optCond): Simplify newly built COND-expression.
+
+2010-07-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/g-opt.boot (optimize): Remove as no longer used.
* interp/define.boot (DomainSubstitutionFunction): Use
simplifyVMForm in lieu of optimize.
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index f1bc4f5c..defb150d 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -810,41 +810,33 @@
(T 0.0)))
((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0))
1.0)
- (T (COND
- ((SPADCALL |r| (|getShellEntry| $ 147)) |x|)
- (T (SEQ (LETT |n|
- (SPADCALL |r| (|getShellEntry| $ 148))
- |DFLOAT;**;$F$;88|)
- (LETT |d|
- (SPADCALL |r| (|getShellEntry| $ 149))
- |DFLOAT;**;$F$;88|)
- (EXIT (COND
- ((MINUSP |x|)
- (COND
- ((ODDP |d|)
- (COND
- ((ODDP |n|)
- (RETURN-FROM
- |DFLOAT;**;$F$;88|
- (-
- (|DFLOAT;**;$F$;88| (- |x|)
- |r| $))))
- (T
- (RETURN-FROM
- |DFLOAT;**;$F$;88|
- (|DFLOAT;**;$F$;88| (- |x|)
- |r| $)))))
- (T (|error| "negative root"))))
- ((EQL |d| 2)
- (EXPT (|DFLOAT;sqrt;2$;33| |x| $)
- |n|))
- (T (|DFLOAT;**;3$;36| |x|
- (/
- (FLOAT |n|
- |$DoubleFloatMaximum|)
- (FLOAT |d|
- |$DoubleFloatMaximum|))
- $)))))))))))))
+ ((SPADCALL |r| (|getShellEntry| $ 147)) |x|)
+ (T (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148))
+ |DFLOAT;**;$F$;88|)
+ (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149))
+ |DFLOAT;**;$F$;88|)
+ (EXIT (COND
+ ((MINUSP |x|)
+ (COND
+ ((ODDP |d|)
+ (COND
+ ((ODDP |n|)
+ (RETURN-FROM |DFLOAT;**;$F$;88|
+ (-
+ (|DFLOAT;**;$F$;88| (- |x|) |r|
+ $))))
+ (T
+ (RETURN-FROM |DFLOAT;**;$F$;88|
+ (|DFLOAT;**;$F$;88| (- |x|) |r|
+ $)))))
+ (T (|error| "negative root"))))
+ ((EQL |d| 2)
+ (EXPT (|DFLOAT;sqrt;2$;33| |x| $) |n|))
+ (T (|DFLOAT;**;3$;36| |x|
+ (/
+ (FLOAT |n| |$DoubleFloatMaximum|)
+ (FLOAT |d| |$DoubleFloatMaximum|))
+ $)))))))))))
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 13c315ef..6430677d 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -745,7 +745,7 @@
"failed")))
(T
(LET
- ((#10=#:G1612
+ ((#10=#:G1610
(CDR |nd|)))
(|check-subtype|
(NOT
@@ -809,14 +809,14 @@
(T (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|)
(EXIT (CONS 0
(LET
- ((#14=#:G1611
+ ((#14=#:G1612
(|makeSimpleArray|
(|getVMType|
(|getShellEntry| $ 6))
(SIZE |monslist|))))
(LET
((#15=#:G1728 |monslist|)
- (#16=#:G1610 0))
+ (#16=#:G1611 0))
(LOOP
(COND
((ATOM #15#) (RETURN #14#))
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index fceb3a2d..85bee73c 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -393,7 +393,7 @@ optSEQ ["SEQ",:l] ==
aft:= after(l,before)
null before => ["SEQ",:aft]
null aft => ["COND",:transform,'(%true (conderr))]
- ["COND",:transform,['%true,optSEQ ["SEQ",:aft]]]
+ optCond ["COND",:transform,['%true,optSEQ ["SEQ",:aft]]]
tryToRemoveSEQ l ==
l is ["SEQ",[op,a]] and op in '(EXIT RETURN THROW) => a
l