diff options
Diffstat (limited to 'modules/language/python/module/decimal.scm')
-rw-r--r-- | modules/language/python/module/decimal.scm | 89 |
1 files changed, 37 insertions, 52 deletions
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm index ee7db1a..4f2f6fe 100644 --- a/modules/language/python/module/decimal.scm +++ b/modules/language/python/module/decimal.scm @@ -1473,7 +1473,7 @@ This is the copyright information of the file ported over to scheme (set! exp exp-) coeff-)))))))))) - + (pk 'div sign coeff exp) (let ((ans (_dec_from_triple sign (str coeff) exp))) ((ref ans '_fix) context)))))) @@ -1677,7 +1677,7 @@ This is the copyright information of the file ported over to scheme ;; remainder is r*10**ideal_exponent; other is +/-op2.int * ;; 10**ideal_exponent. Apply correction to ensure that ;; abs(remainder) <= abs(other)/2 - (if (> (+ (* 2 r) + (logand q 1)) (ref op2 'int)) + (if (> (+ (* 2 r) (logand q 1)) (ref op2 'int)) (set! r (- r (ref op2 'int))) (set! q (+ q 1))) @@ -1799,7 +1799,6 @@ This is the copyright information of the file ported over to scheme " (twix - (let () (pk 3 1)) ((ref self '_is_special) it (if ((ref self '_isnan)) ;; decapitate payload if necessary @@ -1807,12 +1806,10 @@ This is the copyright information of the file ported over to scheme ;; self is +/-Infinity; return unaltered (Decimal self))) - (let () (pk 3 2)) ;; if self is zero then exponent should be between Etiny and ;; Emax if clamp==0, and between Etiny and Etop if clamp==1. (let ((Etiny (cx-etiny context)) (Etop (cx-etop context)))) - (let () (pk 3 3)) ((not (bool self)) it (let* ((exp_max (if (= (cx-clamp context) 0) (cx-emax context) @@ -1823,7 +1820,6 @@ This is the copyright information of the file ported over to scheme ((cx-error context) Clamped) (_dec_from_triple (ref self '_sign) "0" new_exp)) (Decimal self)))) - (let () (pk 3 4)) ;; exp_min is the smallest allowable exponent of the result, ;; equal to max(self.adjusted()-context.prec+1, Etiny) (let ((exp_min (+ (len (ref self '_int)) @@ -1836,33 +1832,26 @@ This is the copyright information of the file ported over to scheme ((cx-error context) Inexact) ((cx-error context) Rounded) ans)) - (let () (pk 3 5)) (let* ((self_is_subnormal (< exp_min Etiny)) (exp_min (if self_is_subnormal Etiny exp_min)))) - (let () (pk 3 6)) ;; round if self has too many digits ((< (ref self '_exp) exp_min) it (let ((digits (+ (len (ref self '_int)) (ref self '_exp) (- exp_min)))) - (pk 3 7) (if (< digits 0) - (set! self (_dec_from_triple (ref self '_sign) - "1" (- exp_min 1))) - (set! digits 0)) - - (for ((k v : (ref self '_pick_rounding_function))) () - (pk k (v))) + (begin + (set! self (_dec_from_triple (ref self '_sign) + "1" (- exp_min 1))) + (set! digits 0))) - (pk 3 8) (let* ((ans #f) - (rounding_method (pk 'me (pylist-ref - (ref self '_pick_rounding_function) - (pk 'r (cx-rounding context))))) - (changed (rounding_method self digits)) + (rounding_method (pylist-ref + (ref self '_pick_rounding_function) + (cx-rounding context))) + (changed ((rounding_method) self digits)) (coeff (or (bool (pylist-slice (ref self '_int) None digits None)) "0"))) - (pk 3 9) (if (> changed 0) (begin (set! coeff (str (+ (int coeff) 1))) @@ -1870,50 +1859,43 @@ This is the copyright information of the file ported over to scheme (begin (set! coeff (pylist-slice coeff None -1 None)) (set! exp_min (+ exp_min 1)))))) - (pk 3 10) ;; check whether the rounding pushed the exponent out of range (if (> exp_min Etop) (set! ans ((cx-error context) Overflow "above Emax" (ref self '_sign))) - (set! ans (_dec_from_triple (ref self '_sign) coeff exp_min))) - (pk 3 11) + (set! ans (_dec_from_triple (ref self '_sign) (pk 'c coeff) (pk 'e exp_min)))) ;; raise the appropriate signals, taking care to respect ;; the precedence described in the specification (if (and changed self_is_subnormal) ((cx-error context) Underflow)) - (pk 3 12) + (if self_is_subnormal ((cx-error context) Subnormal)) - (pk 3 13) + (if changed ((cx-error context) Inexact)) - (pk 3 14) + ((cx-error context) Rounded) - (pk 3 15) + (if (not (bool ans)) ;; raise Clamped on underflow to 0 ((cx-error context) Clamped)) ans))) - (let () (pk 3 7)) - (begin (if self_is_subnormal ((cx-error context) Subnormal)) - (let () (pk 4)) ;; fold down if clamp == 1 and self has too few digits (if (and (= (cx-clamp context) 1) (> (ref self '_exp) Etop)) (begin ((cx-error context) Clamped) - (let () (pk 5)) (let ((self_padded (+ (ref self '_int) (* "0" (- (ref self '_exp) Etop))))) - (let () (pk 6)) (_dec_from_triple (ref self '_sign) self_padded Etop))) ;; here self was representable to begin with; return unchanged @@ -3263,7 +3245,7 @@ This is the copyright information of the file ported over to scheme (lambda (self) "Return the adjusted exponent of self" (try - (lambda () (+ (ref self '_exp) + (len (ref self '_int)) -1)) + (lambda () (+ (ref self '_exp) (len (ref self '_int)) -1)) ;; If NaN or Infinity, self._exp is string (#:except TypeError (lambda z 0))))) @@ -3640,18 +3622,20 @@ This is the copyright information of the file ported over to scheme (- ((ref self '_ln_exp_bound))) 2)) ;; at least p+3 places (ans #f)) - (let lp ((places places)) - (let ((coeff (_dlog c e places))) - ;; assert len(str(abs(coeff)))-p >= 1 - (if (not (= (modulo coeff - (* 5 (expt 10 (- (len (str (abs coeff))) - p 1)))) - 0)) - (set! ans (_dec_from_triple (int (< coeff 0)) - (str (abs coeff)) - (- places))) - - (lp (+ places 3))))) + (let lp ((places places)) + (pk 'places places) + (let ((coeff (_dlog c e places))) + ;; assert len(str(abs(coeff)))-p >= 1 + (pk 'coeff coeff) + (if (not (= (modulo coeff + (* 5 (expt 10 (- (len (str (abs coeff))) + p 1)))) + 0)) + (set! ans (_dec_from_triple (int (< coeff 0)) + (str (abs coeff)) + (- places))) + + (lp (+ places 3))))) (let* ((context ((ref context '_shallow_copy))) (rounding ((ref context '_set_rounding) ROUND_HALF_EVEN)) @@ -4082,7 +4066,7 @@ This is the copyright information of the file ported over to scheme (topad (- p (len rotdig)))) (cond ((> topad 0) - (set! rotdig (+ (* "0" topad) + rotdig))) + (set! rotdig (+ (* "0" topad) rotdig))) ((< topad 0) (set! rotdig (pylist-slice rotdig (- topad) None None))) (else #f)) @@ -4152,7 +4136,7 @@ This is the copyright information of the file ported over to scheme (cond ((> topad 0) - (set! rotdig (+ (* "0" topad) + rotdig))) + (set! rotdig (+ (* "0" topad) rotdig))) ((< topad 0) (set! rotdig (pylist-slice rotdig (- topad) None None))) (else #f)) @@ -6343,7 +6327,7 @@ This is the copyright information of the file ported over to scheme (lambda () (let lp ((y (- x M)) (R 0)) (if (>= (ash (abs y) (- L R)) M) - (values + (lp (_div_nearest (ash (* M y) 1) (+ M (_sqrt_nearest (* M (+ M (_rshift_nearest y R))) M))) (+ R 1)) @@ -6396,7 +6380,7 @@ This is the copyright information of the file ported over to scheme "Given integers c, e and p with c > 0, compute an integer approximation to 10**p * log(c*10**e), with an absolute error of at most 1. Assumes that c*10**e is not exactly 1." - + (pk '_dlog) ;; Increase precision by 2. The precision increase is compensated ;; for at the end with a division by 100. (set! p (+ p 2)) @@ -6421,6 +6405,7 @@ This is the copyright information of the file ported over to scheme ;; p <= 0: just approximate the whole thing by 0; error < 2.31 0)) (lambda (log_d) + (pk 'log_d) (call-with-values (lambda () ;; compute approximation to f*10**p*log(10), with error < 11. @@ -6467,11 +6452,11 @@ This is the copyright information of the file ported over to scheme (digits (str (_div_nearest (_ilog (* 10 M) M) 100)))) (if (not (equal? (pylist-slice (ref self 'digits) (- extra) None None) (* '0' extra))) - #t + (set self 'digits digits) (lp (+ extra 3)))))) ;; keep all reliable digits so far; remove trailing zeros ;; and next nonzero digit - (set self 'digits (pylist-slice (py-rstrip (ref self 'digits)) "0") None -1 None)) + (set self 'digits (pylist-slice (py-rstrip (ref self 'digits) "0") None -1 None))) (int (pylist-slice (ref self 'digits) None (+ p 1) None))))) |