diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-02-07 00:39:58 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-02-07 00:39:58 +0000 |
| commit | 351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0 (patch) | |
| tree | 0b137b74a6663d6875e7f6d8862833f782032bd4 /src/algebra/strap/DFLOAT.lsp | |
| parent | 2eef476c721ed93b1acaaf1a77e20b5b7c73ed4f (diff) | |
| download | open-axiom-351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0.tar.gz | |
* interp/c-util.boot (matchingEXIT): New.
(simplifySEQ): Use it.
Diffstat (limited to 'src/algebra/strap/DFLOAT.lsp')
| -rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 130 |
1 files changed, 60 insertions, 70 deletions
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 3b21f1ba..f8825345 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -688,20 +688,20 @@ (DEFUN |DFLOAT;atan;3$;78| (|x| |y| $) (PROG (|theta|) (RETURN - (SEQ (COND - ((ZEROP |x|) - (COND - ((PLUSP |y|) (/ (COERCE PI '|%DoubleFloat|) 2)) - ((MINUSP |y|) (- (/ (COERCE PI '|%DoubleFloat|) 2))) - (T 0.0))) - (T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|))) - |DFLOAT;atan;3$;78|) - (COND - ((MINUSP |x|) - (SETQ |theta| - (- (COERCE PI '|%DoubleFloat|) |theta|)))) - (COND ((MINUSP |y|) (SETQ |theta| (- |theta|)))) - (EXIT |theta|)))))))) + (COND + ((ZEROP |x|) + (COND + ((PLUSP |y|) (/ (COERCE PI '|%DoubleFloat|) 2)) + ((MINUSP |y|) (- (/ (COERCE PI '|%DoubleFloat|) 2))) + (T 0.0))) + (T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|))) + |DFLOAT;atan;3$;78|) + (COND + ((MINUSP |x|) + (SETQ |theta| + (- (COERCE PI '|%DoubleFloat|) |theta|)))) + (COND ((MINUSP |y|) (SETQ |theta| (- |theta|)))) + (EXIT |theta|))))))) (DEFUN |DFLOAT;retract;$F;79| (|x| $) (|DFLOAT;rationalApproximation;$2NniF;86| |x| @@ -747,25 +747,23 @@ (DEFUN |DFLOAT;manexp| (|x| $) (PROG (|s| |me| |two53|) (RETURN - (SEQ (COND - ((ZEROP |x|) (CONS 0 0)) - (T (SEQ (LETT |s| (|DFLOAT;sign;$I;83| |x| $) - |DFLOAT;manexp|) - (SETQ |x| (ABS |x|)) - (COND - ((< |$DoubleFloatMaximum| |x|) - (RETURN-FROM |DFLOAT;manexp| - (CONS (+ (* |s| - (|DFLOAT;mantissa;$I;6| + (COND + ((ZEROP |x|) (CONS 0 0)) + (T (SEQ (LETT |s| (|DFLOAT;sign;$I;83| |x| $) |DFLOAT;manexp|) + (SETQ |x| (ABS |x|)) + (COND + ((< |$DoubleFloatMaximum| |x|) + (RETURN-FROM |DFLOAT;manexp| + (CONS (+ (* |s| + (|DFLOAT;mantissa;$I;6| |$DoubleFloatMaximum| $)) - 1) - (|DFLOAT;exponent;$I;7| - |$DoubleFloatMaximum| $))))) - (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) - (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|) - (EXIT (CONS (* |s| - (TRUNCATE (* |two53| (CAR |me|)))) - (- (CDR |me|) 53)))))))))) + 1) + (|DFLOAT;exponent;$I;7| + |$DoubleFloatMaximum| $))))) + (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) + (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|) + (EXIT (CONS (* |s| (TRUNCATE (* |two53| (CAR |me|)))) + (- (CDR |me|) 53))))))))) (DEFUN |DFLOAT;rationalApproximation;$2NniF;86| (|f| |d| |b| $) (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G106| |q| |r| @@ -871,44 +869,36 @@ (DEFUN |DFLOAT;**;$F$;87| (|x| |r| $) (PROG (|n| |d|) (RETURN - (SEQ (COND - ((ZEROP |x|) - (COND - ((SPADCALL |r| (|getShellEntry| $ 145)) - (|error| "0**0 is undefined")) - ((SPADCALL |r| (|getShellEntry| $ 146)) - (|error| "division by 0")) - (T 0.0))) - ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0)) - 1.0) - ((SPADCALL |r| (|getShellEntry| $ 147)) |x|) - (T (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148)) - |DFLOAT;**;$F$;87|) - (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149)) - |DFLOAT;**;$F$;87|) - (EXIT (COND - ((MINUSP |x|) - (COND - ((ODDP |d|) - (COND - ((ODDP |n|) - (RETURN-FROM |DFLOAT;**;$F$;87| - (- - (|DFLOAT;**;$F$;87| (- |x|) |r| - $)))) - (T - (RETURN-FROM |DFLOAT;**;$F$;87| - (|DFLOAT;**;$F$;87| (- |x|) |r| - $))))) - (T (|error| "negative root")))) - ((EQL |d| 2) - (EXPT (C-TO-R (SQRT |x|)) |n|)) - (T (C-TO-R (EXPT |x| - (/ - (FLOAT |n| - |$DoubleFloatMaximum|) - (FLOAT |d| - |$DoubleFloatMaximum|)))))))))))))) + (COND + ((ZEROP |x|) + (COND + ((SPADCALL |r| (|getShellEntry| $ 145)) + (|error| "0**0 is undefined")) + ((SPADCALL |r| (|getShellEntry| $ 146)) + (|error| "division by 0")) + (T 0.0))) + ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0)) 1.0) + ((SPADCALL |r| (|getShellEntry| $ 147)) |x|) + (T (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148)) + |DFLOAT;**;$F$;87|) + (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149)) + |DFLOAT;**;$F$;87|) + (EXIT (COND + ((MINUSP |x|) + (COND + ((ODDP |d|) + (COND + ((ODDP |n|) + (RETURN-FROM |DFLOAT;**;$F$;87| + (- (|DFLOAT;**;$F$;87| (- |x|) |r| $)))) + (T (RETURN-FROM |DFLOAT;**;$F$;87| + (|DFLOAT;**;$F$;87| (- |x|) |r| $))))) + (T (|error| "negative root")))) + ((EQL |d| 2) (EXPT (C-TO-R (SQRT |x|)) |n|)) + (T (C-TO-R (EXPT |x| + (/ + (FLOAT |n| |$DoubleFloatMaximum|) + (FLOAT |d| |$DoubleFloatMaximum|))))))))))))) (DEFUN |DoubleFloat| () (DECLARE (SPECIAL |$ConstructorCache|)) |