summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/module/decimal.scm824
-rw-r--r--modules/language/python/module/re.scm2
2 files changed, 422 insertions, 404 deletions
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm
index 31b8140..db65fb0 100644
--- a/modules/language/python/module/decimal.scm
+++ b/modules/language/python/module/decimal.scm
@@ -4,8 +4,10 @@
#:use-module ((language python module sys) #:select (maxsize hash_info))
#:use-module (language python module)
#:use-module ((language python module python) #:select
- (isinstance str float int tuple classmethod pow))
+ (isinstance str float int tuple classmethod pow property
+ complex range reversed (format . str-format)))
#:use-module (language python list)
+ #:use-module (language python number)
#:use-module (language python string)
#:use-module (language python for)
#:use-module (language python try)
@@ -14,10 +16,11 @@
#:use-module (language python def)
#:use-module (language python exceptions)
#:use-module (language python bool)
+ #:use-module (language python module)
#:use-module (oop pf-objects)
#:use-module (language python module re)
#:use-module (ice-9 control)
- #:use-module (ice-9 match)
+ #:use-module ((ice-9 match) #:select ((match . ice:match)))
#:export
( ;; Two major classes
Decimal Context
@@ -46,7 +49,7 @@
;; Limits for the C version for compatibility
MAX_PREC MAX_EMAX MIN_EMIN MIN_ETINY))
-
+(pk 0)
(define-syntax-rule (aif it p . l) (let ((it p)) (if it . l)))
#|
@@ -74,10 +77,10 @@ This is the copyright information of the file ported over to scheme
(define __version__ "1.70")
;; Highest version of the spec this complies with
;; See http://speleotrove.com/decimal/
+(pk 1)
-
-(define DecimalTuple (namedtuple "DecimalTuple" "sign digits exponent"))
-
+(define DecimalTuple (namedtuple "DecimalTuple" "sign,digits,exponent"))
+(pk 2)
;; Rounding
(define ROUND_DOWN 'ROUND_DOWN)
(define ROUND_HALF_UP 'ROUND_HALF_UP)
@@ -87,20 +90,20 @@ This is the copyright information of the file ported over to scheme
(define ROUND_UP 'ROUND_UP)
(define ROUND_HALF_DOWN 'ROUND_HALF_DOWN)
(define ROUND_05UP 'ROUND_05UP)
-
+(pk 3)
;; Compatibility with the C version
(define MAX_PREC 425000000)
(define MAX_EMAX 425000000)
(define MIN_EMIN -425000000)
-
+(pk 4)
(if (= maxsize (- (ash 1 63) 1))
(begin
(set! MAX_PREC 999999999999999999)
(set! MAX_EMAX 999999999999999999)
(set! MIN_EMIN -999999999999999999)))
-
+(pk 5)
(define MIN_ETINY (- MIN_EMIN (- MAX_PREC 1)))
-
+(pk 6)
;; Context
(define-inlinable (cx-prec x) (rawref x 'prec))
(define-inlinable (cx-emax x) (rawref x 'Emax))
@@ -312,7 +315,7 @@ This is the copyright information of the file ported over to scheme
(define handle
(let ((l (list ROUND_HALF_UP ROUND_HALF_EVEN
- ROUND_HALF_DOWN ROUND_U)))
+ ROUND_HALF_DOWN ROUND_UP)))
(lambda (self context sign . args)
(let/ec ret
(if (memq (ref context 'rounding) l)
@@ -364,24 +367,24 @@ This is the copyright information of the file ported over to scheme
Otherwise (the signal is trapped), only equality comparisons and explicit
conversions are silent. All other mixed operations raise FloatOperation.
")
-
+(pk 7)
;; List of public traps and flags
(define _signals
- (vector Clamped DivisionByZero Inexact Overflow Rounded,
+ (vector Clamped DivisionByZero Inexact Overflow Rounded
Underflow InvalidOperation Subnormal FloatOperation))
-
+(pk 8)
;; Map conditions (per the spec) to signals
(define _condition_map
`((,ConversionSyntax . ,InvalidOperation)
(,DivisionImpossible . ,InvalidOperation)
(,DivisionUndefined . ,InvalidOperation)
(,InvalidContext . ,InvalidOperation)))
-
+(pk 9)
;; Valid rounding modes
(define _rounding_modes
(list ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING
ROUND_FLOOR ROUND_UP ROUND_HALF_DOWN ROUND_05UP))
-
+(pk 10)
;; ##### Context Functions ##################################################
;; The getcontext() and setcontext() function manage access to a thread-local
@@ -391,7 +394,7 @@ This is the copyright information of the file ported over to scheme
(fluid-ref *context*))
(define (setcontext context)
(fluid-set! *context* context))
-
+(pk 11)
;; ##### Decimal class #######################################################
;; Do not subclass Decimal from numbers.Real and do not register it as such
@@ -579,7 +582,7 @@ This is the copyright information of the file ported over to scheme
(getcontext)
context)))
((cx-error context)
- FloatOperation,
+ FloatOperation
(+ "strict semantics for mixing floats and Decimals are "
"enabled"))
@@ -587,14 +590,17 @@ This is the copyright information of the file ported over to scheme
(else
(raise (TypeError
- (format #f "Cannot convert %r to Decimal" value))))))
-
+ (format #f "Cannot convert ~a to Decimal" value))))))
+(pk 12)
(define-inlinable (divmod x y)
(values (quotient x y) (modulo x y)))
(define-syntax twix
- (syntax-rules (let let* if)
+ (syntax-rules (when let let* if)
((_ a) a)
+ ((_ (let () a ...) . l)
+ (begin a ... (twix . l)))
+
((_ (let ((a aa) ...) b ...) . l)
(let ((a aa) ...) b ... (twix . l)))
((_ (let (a ...)) . l)
@@ -603,6 +609,8 @@ This is the copyright information of the file ported over to scheme
(let* (a ...) b ... (twix . l)))
((_ (if . u) . l)
(begin (if . u) (twix . l)))
+ ((_ (when . u) . l)
+ (begin (when . u) (twix . l)))
((_ (a it code ...) . l)
(aif it a (begin code ...) (twix . l)))))
@@ -663,22 +671,22 @@ This is the copyright information of the file ported over to scheme
#f))
#f))
- (define-syntax-rule (div-special self other context sign)
- (if (or (ref self '_is_special) (ref other '_is_special))
- (twix
- ((bin-special self other context) it it)
-
- ((and ((ref self '_isinfinity)) ((ref other '_isinfinity))) it
- ((cx-error context) InvalidOperation "(+-)INF/(+-)INF"))
+(define-syntax-rule (div-special self other context sign)
+ (if (or (ref self '_is_special) (ref other '_is_special))
+ (twix
+ ((bin-special self other context) it it)
+
+ ((and ((ref self '_isinfinity)) ((ref other '_isinfinity))) it
+ ((cx-error context) InvalidOperation "(+-)INF/(+-)INF"))
- (((ref self '_isinfinity)) it
- (pylist-ref _SignedInfinity sign))
+ (((ref self '_isinfinity)) it
+ (pylist-ref _SignedInfinity sign))
- (((ref other '_isinfinity)) it
- ((cx-error context) Clamped "Division by infinity")
- (_dec_from_triple sign "0" (cx-etiny context))))))
+ (((ref other '_isinfinity)) it
+ ((cx-error context) Clamped "Division by infinity")
+ (_dec_from_triple sign "0" (cx-etiny context))))))
-
+(pk 13)
(define-python-class Decimal (object)
"Floating point class for decimal arithmetic."
@@ -702,7 +710,7 @@ This is the copyright information of the file ported over to scheme
((self a b)
(_mk self __init__ a b))))
- (define from_float
+ (define from_float (pk 1
(classmethod
(lambda (cls f)
"Converts a float to a decimal number, exactly.
@@ -729,10 +737,10 @@ This is the copyright information of the file ported over to scheme
(if (< x 0) (set! x (- x)))
(let lp ((l (string->list (format #f "~e" x))) (r1 '()))
- (match l
+ (ice:match l
((#\. . l)
(let lp ((l l) (r2 '()))
- (match l
+ (ice:match l
((#\E . l)
(let* ((n (length r1))
(m (list->string (append (reverse r1) (reverse r2))))
@@ -763,7 +771,7 @@ This is the copyright information of the file ported over to scheme
(res (_dec_from_triple sign m e)))
(if (eq? cls Decimal)
res
- (cls res))))))))
+ (cls res)))))))))
(define _isnan
(lambda (self)
@@ -781,7 +789,7 @@ This is the copyright information of the file ported over to scheme
(else 0)))
0)))
- (define _isinfinity
+ (define _isinfinity (pk 1 1
(lambda (self)
"Returns whether the number is infinite
@@ -793,7 +801,7 @@ This is the copyright information of the file ported over to scheme
(if (eq? (ref self '_sign) 1)
-1
1)
- 0)))
+ 0))))
(define _check_nans
(lam (self (= other None) (= context None))
@@ -870,13 +878,13 @@ This is the copyright information of the file ported over to scheme
(else 0))
0))))
- (define __bool__
+ (define __bool__ (pk 1 2
(lambda (self)
"Return True if self is nonzero; otherwise return False.
NaNs and infinities are considered nonzero.
"
- (or (ref self '_is_special) (not (equal? (ref self '_int) "0")))))
+ (or (ref self '_is_special) (not (equal? (ref self '_int) "0"))))))
(define _cmp
(lambda (self other)
@@ -976,7 +984,7 @@ This is the copyright information of the file ported over to scheme
#f)
(else (= ((ref self '_cmp) other) 0))))))
- (define _xlt
+ (define _xlt (pk 1 3
(lambda (<)
(lam (self other (= context None))
(let* ((so (_convert_for_comparison self other #:equality_op #t))
@@ -988,14 +996,14 @@ This is the copyright information of the file ported over to scheme
other)
((bool ((ref self '_compare_check_nans) other context))
#f)
- (else (< ((ref self '_cmp) other) 0)))))))
+ (else (< ((ref self '_cmp) other) 0))))))))
- (define __lt__ (_xlt < ))
- (define __le__ (_xlt <=))
- (define __gt__ (_xlt > ))
- (define __ge__ (_xlt >=))
+ (define __lt__ (lambda x (apply (_xlt < ) x)))
+ (define __le__ (lambda x (apply (_xlt <= ) x)))
+ (define __gt__ (lambda x (apply (_xlt > ) x)))
+ (define __ge__ (lambda x (apply (_xlt >= ) x)))
- (define compare
+ (define compare (pk 1 4
(lam (self other (= context None))
"Compare self to other. Return a decimal value:
@@ -1011,7 +1019,7 @@ This is the copyright information of the file ported over to scheme
(ref other '_is_special)))
(aif it ((ref self '_check_nans) other context)
it
- (Decimal ((ref self '_cmp) other)))))))
+ (Decimal ((ref self '_cmp) other))))))))
(define __hash__
(lambda (self)
@@ -1091,11 +1099,11 @@ This is the copyright information of the file ported over to scheme
(values (numerator x)
(denominator x))))))
- (define __repr__
+ (define __repr__ (pk 1 5
(lambda (self)
"Represents the number as an instance of Decimal."
;# Invariant: eval(repr(d)) == d
- (format #f "Decimal('~a')" (str self))))
+ (format #f "Decimal('~a')" (str self)))))
(define __str__
(lam (self (= eng #f) (= context None))
@@ -1162,7 +1170,7 @@ This is the copyright information of the file ported over to scheme
context)))
(set! exp
(+ (pylist-ref '("e" "E") (cx-capitals context))
- (format #f "%@d" (- leftdigits dotplace)))))))
+ (format #f "~@d" (- leftdigits dotplace)))))))
(+ sign intpart fracpart exp))))))
(define to_eng_string
@@ -1196,7 +1204,7 @@ This is the copyright information of the file ported over to scheme
((ref ans '_fix) context)))))
- (define __pos__
+ (define __pos__ (pk 1 6
(lam (self (= context None))
"Returns a copy, unless it is a sNaN.
@@ -1217,7 +1225,7 @@ This is the copyright information of the file ported over to scheme
((ref self 'copy_abs))
(Decimal self))))
- ((ref ans '_fix) context)))))
+ ((ref ans '_fix) context))))))
(define __abs__
(lam (self (= round #t) (= context None))
@@ -1421,6 +1429,7 @@ This is the copyright information of the file ported over to scheme
(let ((exp #f)
(coeff #f)
+ (prec (cx-prec context))
(nself (len (ref self '_int)))
(nother (len (ref other '_int))))
(if (not (bool self))
@@ -1444,13 +1453,13 @@ This is the copyright information of the file ported over to scheme
(if (not (= remainder 0))
;; result is not exact adjust to ensure
;; correct rounding
- (if (= (modulus coeff- 5) 0)
+ (if (= (modulo coeff- 5) 0)
(+ coeff- 1)
coeff)
(let ((ideal_exp (- (ref self '_exp)
(ref other '_exp))))
(let lp ((coeff- coeff-) (exp- exp))
- (if (and (< exp- indeal_exp)
+ (if (and (< exp- ideal_exp)
(= (modulo coeff 10) 0))
(lp (/ coeff 10) (+ exp- 1))
(begin
@@ -1458,7 +1467,7 @@ This is the copyright information of the file ported over to scheme
coeff))))))))))
- (let ((ans (_dec_from_triple sign, (str coeff) exp)))
+ (let ((ans (_dec_from_triple sign (str coeff) exp)))
((ref ans '_fix) context))))))
(define _divide
@@ -1483,7 +1492,7 @@ This is the copyright information of the file ported over to scheme
((or (not (bool self))
((ref other '_isinfinity))
(<= expdiff -1)) it
- (list (_dec_from_tripple sign "0" 0)
+ (list (_dec_from_triple sign "0" 0)
((ref self '_rescale) ideal_exp (cx-rounding context))))
((if (<= expdiff (cx-prec context))
@@ -1511,10 +1520,10 @@ This is the copyright information of the file ported over to scheme
(let ((ans ((cx-raise context) DivisionImpossible
"quotient too large in //, % or divmod")))
(list ans ans)))))))
- #|
+
(define __rtruediv__
(lam (self other (= context None))
- ""Swaps self/other and returns __truediv__.""
+ "Swaps self/other and returns __truediv__."
(twix
((norm-op self other) it it)
((ref other '__truediv__) self #:context context))))
@@ -1530,7 +1539,7 @@ This is the copyright information of the file ported over to scheme
(let (get-context context))
- ((add-special o1 o2 context) it it)
+ ((add-special self other context) it it)
(((ref self '_check_nans) other context) it
(list it it))
@@ -1545,7 +1554,7 @@ This is the copyright information of the file ported over to scheme
"divmod(INF, INF)")))
(list ans ans))
(list (list-ref _SignedInfinity sign)
- ((cx-raise context) InvalidOperation, "INF % x"))))
+ ((cx-raise context) InvalidOperation "INF % x"))))
((not (bool other)) it
(if (not (bool self))
@@ -1577,12 +1586,12 @@ This is the copyright information of the file ported over to scheme
(let (get-context context))
- ((bin-special o1 o2 context) it it)
+ ((bin-special self other context) it it)
(((ref self '_isinfinity)) it
((cx-error context) InvalidOperation "INF % x"))
- ((not (bool other))
+ ((not (bool other)) it
(if (bool self)
((cx-error context) InvalidOperation "x % 0")
((cx-error context) DivisionUndefined "0 % 0")))
@@ -1597,8 +1606,8 @@ This is the copyright information of the file ported over to scheme
((norm-op self other) it it)
((ref other '__mod__) self #:context context))))
- (define remainder_near
- (lambda (self other (= context None))
+ (define remainder_near (pk 2
+ (lam (self other (= context None))
"
Remainder nearest to 0- abs(remainder-near) <= other/2
"
@@ -1620,7 +1629,7 @@ This is the copyright information of the file ported over to scheme
((cx-error context) DivisionUndefined "remainder_near(0, 0)")))
;; other = +/-infinity -> remainder = self
- (((ref other '_isinfinity())) it
+ (((ref other '_isinfinity)) it
(let ((ans (Decimal self)))
((ref ans '_fix) context)))
@@ -1633,7 +1642,7 @@ This is the copyright information of the file ported over to scheme
;; catch most cases of large or small quotient
(let (let ((expdiff
- (- ((ref self 'adjusted)) ((red other 'adjusted)))))))
+ (- ((ref self 'adjusted)) ((ref other 'adjusted)))))))
((>= expdiff (+ (cx-prec context) 1)) it
;; expdiff >= prec+1 => abs(self/other) > 10**prec
@@ -1672,10 +1681,10 @@ This is the copyright information of the file ported over to scheme
(set! sign (- 1 sign))
(set! r (- r)))
(let ((ans (_dec_from_triple sign (str r) ideal_exponent)))
- ((ref ans '_fix) context))))))))))
+ ((ref ans '_fix) context)))))))))))
(define __floordiv__
- (lambda (self other (= context None))
+ (lam (self other (= context None))
"self // other"
(twix
((norm-op self other) it it)
@@ -1717,8 +1726,8 @@ This is the copyright information of the file ported over to scheme
(if ((ref self '_isspecial))
(if (= (ref self '_sign))
(- (inf))
- (inf)))
- (float (str self)))))
+ (inf))
+ (float (str self))))))
(define __int__
(lambda (self)
@@ -1730,7 +1739,7 @@ This is the copyright information of the file ported over to scheme
(let ((s (if (= (ref self '_sign) 1) -1 1)))
(if (>= (ref self '_exp) 0)
(* s (int (ref self '_int)) (expt 10 (ref self '_exp)))
- (* s (int (or (bool (py-slice (ref self '_int)
+ (* s (int (or (bool (pylist-slice (ref self '_int)
None (ref self '_exp) None))
"0")))))))))
@@ -1797,10 +1806,10 @@ This is the copyright information of the file ported over to scheme
(Etop (cx-etop context))))
((not (bool self)) it
- (let ((exp_max (if (= (cx-clamp context) 0)
- (cx-emax context)
- Etop))
- (new_exp (min (max (ref self '_exp) Etiny) exp_max)))
+ (let* ((exp_max (if (= (cx-clamp context) 0)
+ (cx-emax context)
+ Etop))
+ (new_exp (min (max (ref self '_exp) Etiny) exp_max)))
(if (not (= new_exp (ref self '_exp)))
(begin
((cx-error context) Clamped)
@@ -1821,10 +1830,10 @@ This is the copyright information of the file ported over to scheme
ans))
(let* ((self_is_subnormal (< exp_min Etiny))
- (exp_min (if self_is_subnormal Eriny exp_min))))
+ (exp_min (if self_is_subnormal Etiny exp_min))))
;; round if self has too many digits
- ((< self._exp exp_min) it
+ ((< (ref self '_exp) exp_min) it
(let ((digits (+ (len (ref self '_int))
(ref self '_exp)
(- exp_min))))
@@ -1845,7 +1854,7 @@ This is the copyright information of the file ported over to scheme
(set! coeff (str (+ (int coeff) 1)))
(if (> (len coeff) (cx-prec context))
(begin
- (set! coeff (pylist-clice coeff None -1 None))
+ (set! coeff (pylist-slice coeff None -1 None))
(set! exp_min (+ exp_min 1))))))
;; check whether the rounding pushed the exponent out of range
@@ -2022,10 +2031,10 @@ This is the copyright information of the file ported over to scheme
(if (not (isinstance n int))
(raise (TypeError
"Second argument to round should be integral"))
- (let ((exp (_dec_from_triple 0, "1", (- n))))
+ (let ((exp (_dec_from_triple 0 "1" (- n))))
((ref self 'quantize) exp)))
- ;; one-argument form
+ ;; one-argument form§x
(if (ref self '_is_special)
(if ((ref self 'is_nan))
(raise (ValueError "cannot round a NaN"))
@@ -2083,21 +2092,21 @@ This is the copyright information of the file ported over to scheme
((if (or (ref self '_is_special) (ref other '_is_special))
(twix
(let (get-context context))
- ((equals? (ref self '_exp) "N") it
+ ((equal? (ref self '_exp) "N") it
((cx-error context) InvalidOperation "sNaN" self))
- ((equals? (ref other '_exp) "N") it
+ ((equal? (ref other '_exp) "N") it
((cx-error context) InvalidOperation "sNaN" other))
- ((equals? (ref self '_exp) "n") it
+ ((equal? (ref self '_exp) "n") it
(fin self))
- ((equals? (ref other '_exp) "n") it
+ ((equal? (ref other '_exp) "n") it
(fin other))
- ((equals? (ref self '_exp) "F") it
+ ((equal? (ref self '_exp) "F") it
(if (not (bool other))
((cx-error context) InvalidOperation "INF * 0 in fma")
(pylist-ref _SignedInfinity
(logxor (ref self '_sign)
(ref other '_sign)))))
- ((equals? (ref other '_exp) "F") it
+ ((equal? (ref other '_exp) "F") it
(if (not (bool self))
((cx-error context) InvalidOperation "0 * INF in fma")
(pylist-ref _SignedInfinity
@@ -2128,11 +2137,11 @@ This is the copyright information of the file ported over to scheme
((or (bool self_is_nan) (bool other_is_nan) (bool modulo_is_nan)) it
(cond
((= self_is_nan 2)
- ((cx-error context) InvalidOperation, "sNaN" self))
+ ((cx-error context) InvalidOperation "sNaN" self))
((= other_is_nan 2)
- ((cx-error context) InvalidOperation, "sNaN" other))
+ ((cx-error context) InvalidOperation "sNaN" other))
((modulo_is_nan 2)
- ((cx-error context) InvalidOperation, "sNaN" modulo))
+ ((cx-error context) InvalidOperation "sNaN" modulo))
((bool self_is_nan)
(_fix_nan self context))
((bool other_is_nan)
@@ -2167,7 +2176,7 @@ This is the copyright information of the file ported over to scheme
;; define 0**0 == NaN, for consistency with two-argument pow
;; (even though it hurts!)
- ((and (not (bool other)) (not (bool self)))
+ ((and (not (bool other)) (not (bool self))) it
((cx-error context) InvalidOperation
(+ "at least one of pow() 1st argument "
"and 2nd argument must be nonzero ;"
@@ -2201,7 +2210,7 @@ This is the copyright information of the file ported over to scheme
(_dec_from_triple sign (str base) 0)))))
- (define _power_exact
+ (define _power_exact (pk 3
(lambda (self other p)
"Attempt to compute self**other exactly.
@@ -2302,21 +2311,22 @@ This is the copyright information of the file ported over to scheme
(set! zeros (min (- exponent ideal_exponent) (- p 1)))))
(set! zeros 0))
- (_dec_from_triple 0 (+ "1" (* "0" zeros)) exponent-zeros))))
+ (_dec_from_triple 0 (+ "1" (* "0" zeros)) (- exponent zeros)))))
;; case where y is negative: xc must be either a power
;; of 2 or a power of 5.
((= (ref y 'sign) 1) it
(let ((last_digit (modulo xc 10)))
(twix
+ (let ((e #f)))
((cond
((= (modulo last_digit 2) 0)
;; quick test for power of 2
(twix
- ((not (= (logand xc (- xc)) xc))
+ ((not (= (logand xc (- xc)) xc)) it
None)
;; now xc is a power of 2; e is its exponent
- (let ((e (- (_nbits xc) 1))))
+ (let () (set! e (- (_nbits xc) 1)))
;; We now have:
;;
@@ -2357,7 +2367,7 @@ This is the copyright information of the file ported over to scheme
((or (eq? e None) (eq? xe None)) it
None)
- ((> e emax)
+ ((> e emax) it
None)
(begin
@@ -2366,34 +2376,35 @@ This is the copyright information of the file ported over to scheme
((= last_digit 5)
(twix
- ;; e >= log_5(xc) if xc is a power of 5; we have
- ;; equality all the way up to xc=5**2658
- (let* ((e (quotient (* (_nbits xc) 28) 65))
+ ;; e >= log_5(xc) if xc is a power of 5; we have
+ ;; equality all the way up to xc=5**2658
+ (let* ((e (quotient (* (_nbits xc) 28) 65))
(q (expt 5 e))
+ (xz xc)
(xc (quotient q xz))
- (remainder (modulo q xc))))
+ (remainder (modulo q xz))))
- ((not (= remainder 0)) it
+ ((not (= remainder 0)) it
None)
(let () (clean xc e 5 -))
- ;; Guard against large values of ye, using the same logic as in
- ;; the 'xc is a power of 2' branch. 10/3 is an upper bound for
- ;; log(10)/log(2).
- (let ((emax (quotient (* p 10) 3))))
+ ;; Guard against large values of ye, using the same logic as in
+ ;; the 'xc is a power of 2' branch. 10/3 is an upper bound for
+ ;; log(10)/log(2).
+ (let ((emax (quotient (* p 10) 3))))
- ((>= ye (len (str emax)))
+ ((>= ye (len (str emax))) it
None)
(let ()
(set! e (_decimal_lshift_exact (* e yc) ye))
(set! xe (_decimal_lshift_exact (* xe yc) ye)))
-
- ((or (eq? e None= (eq? xe None))) it
+
+ ((or (eq? e None) (eq? xe None)) it
None)
- ((> e emax)
+ ((> e emax) it
None)
(begin
@@ -2405,13 +2416,13 @@ This is the copyright information of the file ported over to scheme
((>= xc (expt 10 p)) it it)
- (begin
+ (begin
(set! xe (+ (- e) (- xe)))
(_dec_from_triple 0 (str xc) xe)))))
;; now y is positive; find m and n such that y = m/n
(let ((m #f) (n #f) (xc_bits (_nbits xc))))
- ((if (>= ye 0) it
+ ((if (>= ye 0)
(begin
(set! m (* yc (expt 10 ye)))
(set! n 1)
@@ -2498,7 +2509,7 @@ This is the copyright information of the file ported over to scheme
(min (- xe ideal_exponent)
(- p (len str_xc))))
0)))
- (_dec_from_triple 0 (+ str_xc (* '0' zeros)) (- xe zeros)))))))
+ (_dec_from_triple 0 (+ str_xc (* '0' zeros)) (- xe zeros))))))))
(define __pow__
(lam (self other (= modulo None) (= context None))
@@ -2521,22 +2532,22 @@ This is the copyright information of the file ported over to scheme
The result of pow(self, other, modulo) is identical to the
result that would be obtained by computing (self**other) %
- modulo with unbounded precision, but is computed more
+ modulo with unbounded precision but is computed more
efficiently. It is always exact.
"
(twix
- ((not (eq= modulo None)) it
+ ((not (eq? modulo None)) it
((ref self '_power_modulo) other modulo context))
((norm-op self other ) it it)
(let (get-context context))
;; either argument is a NaN => result is NaN
- (bin-special self other context)
+ ((bin-special self other context) it it)
;; 0**0 = NaN (!), x**0 = 1 for nonzero x (including +/-Infinity)
- ((not (bool other))
+ ((not (bool other)) it
(if (not (bool self))
((cx-error context) InvalidOperation "0 ** 0")
_One))
@@ -2614,7 +2625,7 @@ This is the copyright information of the file ported over to scheme
;; self ** infinity is infinity if self > 1, 0 if self < 1
;; self ** -infinity is infinity if self < 1, 0 if self > 1
- (((ref other '_isinfinity))
+ (((ref other '_isinfinity)) it
(if (eq? (= (ref other '_sign) 0)
(< self_adj 0))
(_dec_from_triple result_sign "0" 0)
@@ -2623,7 +2634,7 @@ This is the copyright information of the file ported over to scheme
;; from here on, the result always goes through the call
;; to _fix at the end of this function.
(let ((ans None)
- (exact False)
+ (exact #f)
(bound (+ ((ref self '_log10_exp_bound))
((ref other 'adjusted)))))
@@ -2684,7 +2695,7 @@ This is the copyright information of the file ported over to scheme
(values coeff exp)
(lp (+ extra 3)))))))
(lambda (coeff exp)
- (set! ans (_dec_from_triple result_sign (strcoeff) exp))))))
+ (set! ans (_dec_from_triple result_sign (str coeff) exp))))))
;; unlike exp, ln and log10, the power function respects the
;; rounding mode; no need to switch to ROUND_HALF_EVEN here
@@ -2712,38 +2723,38 @@ This is the copyright information of the file ported over to scheme
;; create a copy of the current context, with cleared flags/traps
(let ((newcontext (cx-copy context)))
- (cx-clear_flags newcontext))
-
- (for ((exception : _signals)) ()
- (pylist-set! (cx-traps newcontext) exception 0)
- (values))
-
- ;; round in the new context
- (set! ans ((ref ans '_fix) newcontext))
-
- ;; raise Inexact, and if necessary, Underflow
- ((cx-error newcontext) Inexact)
- (if (bool (pylist-ref (cx-flags newcontext) Subnormal))
- ((cx-error newcontext) Underflow))
-
- ;; propagate signals to the original context; _fix could
- ;; have raised any of Overflow, Underflow, Subnormal,
- ;; Inexact, Rounded, Clamped. Overflow needs the correct
- ;; arguments. Note that the order of the exceptions is
- ;; important here.
- (if (bool (pylist-ref (cx-flags newcontext) Overflow))
- ((cx-error newcontext)
- Overflow "above Emax" (ref ans '_sign)))
+ (cx-clear_flags newcontext)
+
+ (for ((exception : _signals)) ()
+ (pylist-set! (cx-traps newcontext) exception 0)
+ (values))
+
+ ;; round in the new context
+ (set! ans ((ref ans '_fix) newcontext))
+
+ ;; raise Inexact, and if necessary, Underflow
+ ((cx-error newcontext) Inexact)
+ (if (bool (pylist-ref (cx-flags newcontext) Subnormal))
+ ((cx-error newcontext) Underflow))
+
+ ;; propagate signals to the original context; _fix could
+ ;; have raised any of Overflow, Underflow, Subnormal,
+ ;; Inexact, Rounded, Clamped. Overflow needs the correct
+ ;; arguments. Note that the order of the exceptions is
+ ;; important here.
+ (if (bool (pylist-ref (cx-flags newcontext) Overflow))
+ ((cx-error newcontext)
+ Overflow "above Emax" (ref ans '_sign)))
- (for ((exception : (list Underflow Subnormal
- Inexact Rounded Clamped))) ()
- (if (bool (pylist-ref (cx-flags newcontext) exception))
- ((cx-error newcontext) exception)
- (values))))
+ (for ((exception : (list Underflow Subnormal
+ Inexact Rounded Clamped))) ()
+ (if (bool (pylist-ref (cx-flags newcontext) exception))
+ ((cx-error newcontext) exception)
+ (values))))
- (set! ans ((ref ans '_fix) context)))
+ (set! ans ((ref ans '_fix) context)))
- ans))))
+ ans)))))
(define __rpow__
(lam (self other (= context None))
@@ -2758,26 +2769,26 @@ This is the copyright information of the file ported over to scheme
(twix
(let (get-context context))
- (un-special self context)
+ ((un-special self context) it it)
(let ((dup ((ref self _fix) context))))
(((dup '_isinfinity)) it dup)
- ((not (bool dup))
- (_dec_from_triple (reg dup '_sign) "0" 0))
+ ((not (bool dup)) it
+ (_dec_from_triple (ref dup '_sign) "0" 0))
(let* ((_int (ref dup '_int))
(exp_max (let ((i (cx-clamp context)))
(if (= i 0)
(cx-emax context)
- (cx-etop context))))
- (let lp ((end (len _int)) (exp (ref dup '_exp)))
- (if (and (equal? (pylist-ref _int (- end-1))
- "0")
- (< exp exp_max))
- (lp (- end 1) (+ exp 1))
- (_dec_from_triple
- (ref dup '_sign)
- (pylist-slice _int None end None)
- exp))))))))
+ (cx-etop context)))))
+ (let lp ((end (len _int)) (exp (ref dup '_exp)))
+ (if (and (equal? (pylist-ref _int (- end 1))
+ "0")
+ (< exp exp_max))
+ (lp (- end 1) (+ exp 1))
+ (_dec_from_triple
+ (ref dup '_sign)
+ (pylist-slice _int None end None)
+ exp)))))))
(define quantize
(lam (self exp (= rounding None) (= context None))
@@ -2810,8 +2821,8 @@ This is the copyright information of the file ported over to scheme
(let ((_eexp (ref exp '_exp))
(Emax (cx-emax context))))
- ((not (and (<= (cx-etiny context) eexp) (<= eexp Emax))) it
- ((cx-error context) InvalidOperation,
+ ((not (and (<= (cx-etiny context) _eexp) (<= _eexp Emax))) it
+ ((cx-error context) InvalidOperation
"target exponent out of bounds in quantize"))
((not (bool self)) it
@@ -2822,21 +2833,21 @@ This is the copyright information of the file ported over to scheme
(prec (cx-prec context))))
((> self_adjusted (cx-emax context)) it
- ((cx-error context) InvalidOperation,
+ ((cx-error context) InvalidOperation
"exponent of quantize result too large for current context"))
((> (+ self_adjusted (- _eexp) 1) prec) it
- ((cx-error context) InvalidOperation,
+ ((cx-error context) InvalidOperation
"quantize result has too many digits for current context"))
(let ((ans ((ref self '_rescale) _eexp rounding))))
- (if (> ((ref ans 'adjusted)) Emax) it
- ((cx-error context) InvalidOperation,
+ (if (> ((ref ans 'adjusted)) Emax)
+ ((cx-error context) InvalidOperation
"exponent of quantize result too large for current context"))
- ((> (len (ref ans '_int)) prec)
- ((cx-error context) InvalidOperation,
+ (if (> (len (ref ans '_int)) prec)
+ ((cx-error context) InvalidOperation
"quantize result has too many digits for current context"))
@@ -2845,7 +2856,7 @@ This is the copyright information of the file ported over to scheme
(if (and (bool ans) (< ((ref ans 'adjusted)) (cx-emin context)))
((cx-error context) Subnormal))
- (when (> (reg ans '_exp) (ref self '_exp))
+ (when (> (ref ans '_exp) (ref self '_exp))
(if (not (equal? ans self))
((cx-error context) Inexact))
((cx-error context) Rounded))
@@ -2884,7 +2895,7 @@ This is the copyright information of the file ported over to scheme
rounding = rounding mode
"
- (cond
+ (twix
((ref self '_is_special) it
(Decimal self))
@@ -2895,7 +2906,7 @@ This is the copyright information of the file ported over to scheme
(_sign (ref self '_sign))
(_int (ref self '_int))))
- ((>= _exp exp)
+ ((>= _exp exp) it
;; pad answer with zeros if necessary
(_dec_from_triple _sign (+ _int (* "0" (- _exp exp))) exp))
@@ -2947,7 +2958,7 @@ This is the copyright information of the file ported over to scheme
rounding)))
ans)))))
- (define to_integral_exact
+ (define to_integral_exact (pk 4
(lam (self (= rounding None) (= context None))
"Rounds to a nearby integer.
@@ -2967,7 +2978,7 @@ This is the copyright information of the file ported over to scheme
((>= (ref self '_exp) 0)
(Decimal self))
- ((not (boool self))
+ ((not (bool self))
(_dec_from_triple (ref self '_sign) "0" 0))
(else
(let* ((context (if (eq? context None) (getcontext) context))
@@ -2981,7 +2992,7 @@ This is the copyright information of the file ported over to scheme
((cx-error context) Rounded)
- ans)))))
+ ans))))))
(define to_integral_value
(lam (self (= rounding None) (= context None))
@@ -3030,7 +3041,7 @@ This is the copyright information of the file ported over to scheme
(quotient (ref self '_exp) 2))))
((ref ans '_fix) context)))
- ((= (ref self '_sign) 1)
+ ((= (ref self '_sign) 1) it
((cx-error context) InvalidOperation "sqrt(-x), x > 0"))
;; At this point self represents a positive number. Let p be
@@ -3107,11 +3118,11 @@ This is the copyright information of the file ported over to scheme
(if (= (modulo n 5) 0)
(set! n (+ n 1))))
- (let ((ans (_dec_from_triple 0 (str n) e))
- ;; round, and fit to current context
- (context ((ref context '_shallow_copy)))
- (rounding ((ref context '_set_rounding) ROUND_HALF_EVEN))
- (ans ((ref ans '_fix) context)))
+ (let* ((ans (_dec_from_triple 0 (str n) e))
+ ;; round, and fit to current context
+ (context ((ref context '_shallow_copy)))
+ (rounding ((ref context '_set_rounding) ROUND_HALF_EVEN))
+ (ans ((ref ans '_fix) context)))
(set context 'rounding rounding)
ans))))))
@@ -3215,7 +3226,7 @@ This is the copyright information of the file ported over to scheme
#t)
(else
(let ((rest (pylist-ref (ref self '_int) (ref self '_exp))))
- (equal? rest "0"*(len rest)))))))
+ (equal? rest (* "0" (len rest))))))))
(define _iseven
(lambda (self)
@@ -3252,7 +3263,7 @@ This is the copyright information of the file ported over to scheme
(let* ((other (_convert_other other #:raiseit #t))
(ans ((ref self '_compare_check_nans) other context)))
(if (bool ans)
- and
+ ans
((ref self 'compare) other #:context context)))))
(define compare_total
@@ -3272,7 +3283,7 @@ This is the copyright information of the file ported over to scheme
_NegativeOne)
((and (not (bool (ref self '_sign))) (bool other '_sign)) it
- One)
+ _One)
(let ((sign (ref self '_sign))
;; let's handle both NaN types
@@ -3290,13 +3301,13 @@ This is the copyright information of the file ported over to scheme
((< self_key other_key)
(if (bool sign)
_One
- _NegativeOne)
- ((> self_key other_key)
- (if sign
- _NegativeOne
- _One))
- (else
- _Zero))))
+ _NegativeOne))
+ ((> self_key other_key)
+ (if sign
+ _NegativeOne
+ _One))
+ (else
+ _Zero)))
(if (bool sign)
(cond
@@ -3379,7 +3390,7 @@ This is the copyright information of the file ported over to scheme
"Returns e ** self."
(twix
- (let (get-context context code))
+ (let (get-context context))
;; exp(NaN) = NaN
(let ((ans ((ref self '_check_nans) #:context context))))
@@ -3387,32 +3398,32 @@ This is the copyright information of the file ported over to scheme
(ans it it)
;; exp(-Infinity) = 0
- ((= ((ref self '_isinfinity)) -1)
+ ((= ((ref self '_isinfinity)) -1) it
_Zero)
;; exp(0) = 1
- ((not (bool self))
+ ((not (bool self)) it
_One)
;; exp(Infinity) = Infinity
- ((= ((ref self '_isinfinity)) 1)
+ ((= ((ref self '_isinfinity)) 1) it
(Decimal self))
;; the result is now guaranteed to be inexact (the true
;; mathematical result is transcendental). There's no need to
;; raise Rounded and Inexact here---they'll always be raised as
;; a result of the call to _fix.
- (let ((p (ctx-prec context))
+ (let ((p (cx-prec context))
(adj ((ref self 'adjusted)))))
;; we only need to do any computation for quite a small range
;; of adjusted exponents---for example, -29 <= adj <= 10 for
;; the default context. For smaller exponent the result is
- ;; indistinguishable from 1 at the given precision, while for
+ ;; indistinguishable from 1 at the given precision while for
;; larger exponent the result either overflows or underflows.
(let* ((sign (ref self '_sign))
- (emax (ctx-emax context))
- (etiny (ctx-etiny context))
+ (emax (cx-emax context))
+ (etiny (cx-etiny context))
(ans
(cond
((and (= sign 0)
@@ -3452,7 +3463,7 @@ This is the copyright information of the file ported over to scheme
0))
(_dec_from_triple 0 (str coeff) exp)
- (lp (+ ex 3))))))))))))
+ (lp (+ extra 3))))))))))))
;; at this stage, ans should round correctly with *any*
;; rounding mode, not just with ROUND_HALF_EVEN
@@ -3464,14 +3475,14 @@ This is the copyright information of the file ported over to scheme
(set context 'rounding rounding)
ans))))
- (define is_canonical
+ (define is_canonical (pk 5
(lambda (self)
"Return True if self is canonical; otherwise return False.
Currently, the encoding of a Decimal instance is always
canonical, so this method returns True for any Decimal.
"
- #t))
+ #t)))
(define is_finite
(lambda (self)
@@ -3501,7 +3512,7 @@ This is the copyright information of the file ported over to scheme
(let ((context (if (eq? context None)
(getcontext)
context)))
- (<= (cttx-emin context) ((ref self 'adjusted)))))))
+ (<= (cx-emin context) ((ref self 'adjusted)))))))
(define is_qnan
(lambda (self)
@@ -3526,7 +3537,7 @@ This is the copyright information of the file ported over to scheme
(let ((context (if (eq? context None)
(getcontext)
context)))
- (> (cttx-emin context) ((ref self 'adjusted)))))))
+ (> (cx-emin context) ((ref self 'adjusted)))))))
(define is_zero
(lambda (self)
@@ -3546,10 +3557,10 @@ This is the copyright information of the file ported over to scheme
(cond
((>= adj 1)
;; argument >= 10; we use 23/10 = 2.3 as a lower bound for ln(10)
- (- (len (str (floordiv (* adj 23) 10))) 1))
+ (- (len (str (floor-quotient (* adj 23) 10))) 1))
((<= adj -2)
;; argument <= 0.1
- (- (len (str (floordiv (* (- (+ 1 adj)) 23) 10))) 1))
+ (- (len (str (floor-quotient (* (- (+ 1 adj)) 23) 10))) 1))
(else
(let* ((op (_WorkRep self))
(c (ref op 'int))
@@ -3568,34 +3579,34 @@ This is the copyright information of the file ported over to scheme
"Returns the natural (base e) logarithm of self."
(twix
- (let (get-context context code))
+ (let (get-context context))
;; ln(NaN) = NaN
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
;; ln(0.0) == -Infinity
- ((not (bool self))
+ ((not (bool self)) it
_NegativeInfinity)
;; ln(Infinity) = Infinity
- ((= ((ref self '_isinfinity)) 1)
+ ((= ((ref self '_isinfinity)) 1) it
_Infinity)
;; ln(1.0) == 0.0
- (if (equal? self _One)
+ ((equal? self _One) it
_Zero)
;; ln(negative) raises InvalidOperation
- ((= (ref self '_sign) 1)
- ((ctx-error context) InvalidOperation,
+ (if (= (ref self '_sign) 1)
+ ((cx-error context) InvalidOperation
"ln of a negative value"))
;; result is irrational, so necessarily inexact
(let* ((op (_WorkRep self))
(c (ref op 'int))
(e (ref op 'exp))
- (p (ctx-prec context))))
+ (p (cx-prec context))))
;; correctly rounded result: repeatedly increase precision by 3
@@ -3608,7 +3619,7 @@ This is the copyright information of the file ported over to scheme
(let ((coeff (_dlog c e places)))
;; assert len(str(abs(coeff)))-p >= 1
(if (not (= (modulo coeff
- (* 5 (expr 10 (- (len (str (abs coeff)))
+ (* 5 (expt 10 (- (len (str (abs coeff)))
p 1))))
0))
(set! ans (_dec_from_triple (int (< coeff 0))
@@ -3638,7 +3649,7 @@ This is the copyright information of the file ported over to scheme
(let ((adj (+ (ref self '_exp) (len (ref self '_int)) (- 1))))
(cond
- ((>=adj 1)
+ ((>= adj 1)
;; self >= 10
(- (len (str adj)) 1))
((<= adj -2)
@@ -3661,27 +3672,27 @@ This is the copyright information of the file ported over to scheme
(lam (self (= context None))
"Returns the base 10 logarithm of self."
(twix
- (let (get-context context code))
+ (let (get-context context))
;; log(NaN) = NaN
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
;; log10(0.0) == -Infinity
- ((not (bool self))
+ ((not (bool self)) it
_NegativeInfinity)
;; log10(Infinity) = Infinity
- ((= ((ref self '_isinfinity)) 1)
+ ((= ((ref self '_isinfinity)) 1) it
_Infinity)
;; log10(1.0) == 0.0
- (if (equal? self _One)
+ ((equal? self _One) it
_Zero)
;; ln(negative) raises InvalidOperation
- ((= (ref self '_sign) 1)
- ((ctx-error context) InvalidOperation,
+ (if (= (ref self '_sign) 1)
+ ((cx-error context) InvalidOperation
"log10 of a negative value"))
(let ((ans #f)))
@@ -3692,12 +3703,12 @@ This is the copyright information of the file ported over to scheme
(equal? (pylist-slice (ref self '_int) 1 None None)
(* "0" (- (len (ref self '_int)) 1))))
;;answer may need rounding
- (set! ans (Decimal (+ self._exp (len (ref self '_int)) (- 1))))
+ (set! ans (Decimal (+ (ref self '_exp) (len (ref self '_int)) (- 1))))
;; result is irrational, so necessarily inexact
(let* ((op (_WorkRep self))
(c (ref op 'int))
(e (ref op 'exp))
- (p (ctx-prec context)))
+ (p (cx-prec context)))
;; correctly rounded result: repeatedly increase precision
;; until result is unambiguously roundable
@@ -3731,25 +3742,25 @@ This is the copyright information of the file ported over to scheme
without limiting the resulting exponent).
"
(twix
- (let (get-context context code))
+ (let (get-context context))
;; logb(NaN) = NaN
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
- ;; logb(+/-Inf) = +Inf
- (((ref self '_isinfinity))
- _Infinity)
+ ;; logb(+/-Inf) = +Inf
+ (((ref self '_isinfinity)) it
+ _Infinity)
- ;; logb(0) = -Inf, DivisionByZero
- ((not (bool self))
- ((ctx-error context) DivisionByZero "logb(0)" 1))
+ ;; logb(0) = -Inf, DivisionByZero
+ ((not (bool self)) it
+ ((cx-error context) DivisionByZero "logb(0)" 1))
- ;; otherwise, simply return the adjusted exponent of self, as a
- ;; Decimal. Note that no attempt is made to fit the result
- ;; into the current context.
- (let ((ans (Decimal ((ref self 'adjusted)))))
- ((ref ans '_fix) context)))))
+ ;; otherwise, simply return the adjusted exponent of self, as a
+ ;; Decimal. Note that no attempt is made to fit the result
+ ;; into the current context.
+ (let ((ans (Decimal ((ref self 'adjusted)))))
+ ((ref ans '_fix) context)))))
(define _islogical
(lambda (self)
@@ -3774,14 +3785,14 @@ This is the copyright information of the file ported over to scheme
((> dif 0)
(* "0" dif) opa)
((< dif 0)
- (pylist-slice opa (- (ctx-prec context) None None)))
+ (pylist-slice opa (- (cx-prec context) None None)))
(else
opa)))
- (let* ((dif (- (ctx-prec context) (len opa)))
- (opa (o opa diff))
- (dif (- (ctx-prec context) (len opb)))
- (opb (o opb diff)))
+ (let* ((dif (- (cx-prec context) (len opa)))
+ (opa (o opa dif))
+ (dif (- (cx-prec context) (len opb)))
+ (opb (o opb dif)))
(values opa opb))))
(define logical_*
@@ -3790,11 +3801,11 @@ This is the copyright information of the file ported over to scheme
"Applies an 'and' operation between self and other's digits."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((other (_convert_other other #:raiseit #t))))
- ((or (not ((ref self '_islogical)) (not ((ref other '_islogical)))))
- ((ctx-error context) InvalidOperation))
+ (if (or (not ((ref self '_islogical))) (not ((ref other '_islogical))))
+ ((cx-error context) InvalidOperation))
;; fill to context.prec
(call-with-values
@@ -3802,7 +3813,7 @@ This is the copyright information of the file ported over to scheme
((ref self '_fill_logical)
context (ref self '_int) (ref other '_int)))
(lambda (opa opb)
- ;; make the operation, and clean starting zeroes
+ ;; make the operation and clean starting zeroes
(_dec_from_triple
0
(for ((a : opa) (b : opb)) ((l '()) (f #t))
@@ -3827,16 +3838,16 @@ This is the copyright information of the file ported over to scheme
(getcontext)
context)))
(logical_xor self
- (_dec_from_triple 0 (* "1" (ctx-prec context)) 0)
+ (_dec_from_triple 0 (* "1" (cx-prec context)) 0)
context))))
(define x_mag
(lambda (nott)
- (lambda (self other (= context None))
+ (lam (self other (= context None))
"Compares the values numerically with their sign ignored."
(twix
(let ((other (_convert_other other #:raiseit #t))))
- (let (get-context context code))
+ (let (get-context context))
((if (or (bool (ref self '_is_special)) (bool (other '_is_special)))
;; If one operand is a quiet NaN and the other is number, then the
@@ -3872,54 +3883,54 @@ This is the copyright information of the file ported over to scheme
"Returns the largest representable number smaller than itself."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
- ((= ((ref self '_isinfinity)) -1)
- _NegativeInfinity)
+ ((= ((ref self '_isinfinity)) -1) IT
+ _NegativeInfinity)
- ((= ((ref self '_isinfinity)) 1)
- (_dec_from_triple 0 (* '9' (ctx-prec context)) (ctx-etop context)))
+ ((= ((ref self '_isinfinity)) 1) IT
+ (_dec_from_triple 0 (* '9' (cx-prec context)) (cx-etop context)))
- (let* ((context ((ref context 'copy)))
- (rounding ((ref context '_set_rounding) ROUND_FLOOR)))
- ((context '_ignore_all_flags))
- (let ((new_self ((ref self '_fix) context)))
- (if (not (equal? self new_self))
- new_self
- ((ref self '__sub__)
- (_dec_from_triple 0 "1" (- (ctx-etiny context) 1))
- context)))))))
+ (let* ((context ((ref context 'copy)))
+ (rounding ((ref context '_set_rounding) ROUND_FLOOR)))
+ ((context '_ignore_all_flags))
+ (let ((new_self ((ref self '_fix) context)))
+ (if (not (equal? self new_self))
+ new_self
+ ((ref self '__sub__)
+ (_dec_from_triple 0 "1" (- (cx-etiny context) 1))
+ context)))))))
(define next_plus
(lam (self (= context None))
"Returns the largest representable number smaller than itself."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
- ((= ((ref self '_isinfinity)) 1)
- _Infinity)
+ ((= ((ref self '_isinfinity)) 1) it
+ _Infinity)
- ((= ((ref self '_isinfinity)) -1)
- (_dec_from_triple 1 (* '9' (ctx-prec context)) (ctx-etop context)))
+ ((= ((ref self '_isinfinity)) -1) it
+ (_dec_from_triple 1 (* '9' (cx-prec context)) (cx-etop context)))
- (let* ((context ((ref context 'copy)))
- (rounding ((ref context '_set_rounding) ROUND_CEILING)))
- ((context '_ignore_all_flags))
- (let ((new_self ((ref self '_fix) context)))
- (if (not (equal? self new_self))
- new_self
- ((ref self '__add__)
- (_dec_from_triple 0 "1" (- (ctx-etiny context) 1))
- context)))))))
+ (let* ((context ((ref context 'copy)))
+ (rounding ((ref context '_set_rounding) ROUND_CEILING)))
+ ((context '_ignore_all_flags))
+ (let ((new_self ((ref self '_fix) context)))
+ (if (not (equal? self new_self))
+ new_self
+ ((ref self '__add__)
+ (_dec_from_triple 0 "1" (- (cx-etiny context) 1))
+ context)))))))
(define next_toward
(lam (self other (= context None))
@@ -3934,43 +3945,43 @@ This is the copyright information of the file ported over to scheme
(twix
(let ((other (_convert_other other #:raiseit #t))))
- (let (get-context context code))
+ (let (get-context context))
(let ((ans ((ref self '_check_nans) #:context context))))
(ans it it)
(let ((comparison ((ref self '_cmp) other))))
- ((= comparison 0)
+ ((= comparison 0) it
((ref self 'copy_sign) other))
- (let ((ans (if (= comparison -1)
- ((ref self 'next_plus) context)
- ;; comparison == 1
- ((ref self 'next_minus) context))))
-
- ;; decide which flags to raise using value of ans
- (cond
- (((ref ans '_isinfinity))
- ((ctx-error context) Overflow "Infinite result from next_toward"
- (ref ans '_sign))
- ((ctx-error context) Inexact)
- ((ctx-error context) Rounded))
+ (let ((ans (if (= comparison -1)
+ ((ref self 'next_plus) context)
+ ;; comparison == 1
+ ((ref self 'next_minus) context))))
+
+ ;; decide which flags to raise using value of ans
+ (cond
+ (((ref ans '_isinfinity))
+ ((cx-error context) Overflow "Infinite result from next_toward"
+ (ref ans '_sign))
+ ((cx-error context) Inexact)
+ ((cx-error context) Rounded))
- ((< ((ref ans 'adjusted)) (ctx-emin context))
- ((ctx-error context) Underflow)
- ((ctx-error context) Subnormal)
- ((ctx-error context) Inexact)
- ((ctx-error context) Rounded)
+ ((< ((ref ans 'adjusted)) (cx-emin context))
+ ((cx-error context) Underflow)
+ ((cx-error context) Subnormal)
+ ((cx-error context) Inexact)
+ ((cx-error context) Rounded)
;; if precision == 1 then we don't raise Clamped for a
;; result 0E-Etiny.
(if (not (bool ans))
- ((ctx-error context) Clamped)))
+ ((cx-error context) Clamped)))
(else #f))
ans))))
- (define number_class
+ (define number_class (pk 6
(lam (self (= context None))
"Returns an indication of the class of self.
@@ -4001,9 +4012,9 @@ This is the copyright information of the file ported over to scheme
"-Zero"
"+Zero"))
- (let (get-context context code))
+ (let (get-context context))
- (((ref self 'is_subnormal) #:context context)
+ (((ref self 'is_subnormal) #:context context) it
(if (bool (ref self '_sign))
"-Subnormal"
"+Subnormal"))
@@ -4011,7 +4022,7 @@ This is the copyright information of the file ported over to scheme
;; just a normal, regular, boring number, :)
(if (bool (ref self '_sign))
"-Normal"
- "+Normal"))))
+ "+Normal")))))
(define radix
(lambda (self)
@@ -4022,28 +4033,28 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Returns a rotated copy of self, value-of-other times."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((other (_convert_other other #:raiseit #t))))
(let ((ans ((ref other '_check_nans) #:context context))))
(ans it it)
- ((not (= (ref other '_exp) 0))
- ((ctx-error context) InvalidOperation))
+ ((not (= (ref other '_exp) 0)) it
+ ((cx-error context) InvalidOperation))
(let ((o (int other))
- (p (ctx-prec context))))
+ (p (cx-prec context))))
- ((not (and (<= (- p) o) (<= o p)))
- ((ctx-error context) InvalidOperation))
+ ((not (and (<= (- p) o) (<= o p))) it
+ ((cx-error context) InvalidOperation))
- (((ref self '_isinfinity))
+ (((ref self '_isinfinity)) it
(Decimal self))
;; get values, pad if necessary
- (let ((torot (int other))
- (rotdig (ref self '_int))
- (topad (- p (len rotdig))))
+ (let* ((torot (int other))
+ (rotdig (ref self '_int))
+ (topad (- p (len rotdig))))
(cond
((> topad 0)
(set! rotdig (+ (* "0" topad) + rotdig)))
@@ -4061,24 +4072,24 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Returns self operand after adding the second value to its exp."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((other (_convert_other other #:raiseit #t))))
(let ((ans ((ref other '_check_nans) #:context context))))
(ans it it)
- ((not (= (ref other '_exp)))
- ((ctx-error context) InvalidOperation))
+ ((not (= (ref other '_exp))) it
+ ((cx-error context) InvalidOperation))
- (let ((liminf (* -2 (+ (ctx-emax context) (ctx-prec context))))
- (limsup (* 2 (+ (ctx-emax context) (ctx-prec context))))))
+ (let ((liminf (* -2 (+ (cx-emax context) (cx-prec context))))
+ (limsup (* 2 (+ (cx-emax context) (cx-prec context))))))
((not (let ((o (int other)))
(and (<= liminf o)
- (<= o limsup))))
- ((ctx-error context) InvalidOperation))
+ (<= o limsup)))) it
+ ((cx-error context) InvalidOperation))
- (((ref self '_isinfinity))
+ (((ref self '_isinfinity)) it
(Decimal self))
(let* ((d (_dec_from_triple (ref self '_sign)
@@ -4091,28 +4102,28 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Returns a rotated copy of self, value-of-other times."
(twix
- (let (get-context context code))
+ (let (get-context context))
(let ((other (_convert_other other #:raiseit #t))))
(let ((ans ((ref other '_check_nans) #:context context))))
(ans it it)
- ((not (= (ref other '_exp) 0))
- ((ctx-error context) InvalidOperation))
+ ((not (= (ref other '_exp) 0)) it
+ ((cx-error context) InvalidOperation))
(let ((o (int other))
- (p (ctx-prec context))))
+ (p (cx-prec context))))
- ((not (and (<= (- p) o) (<= o p)))
- ((ctx-error context) InvalidOperation))
+ ((not (and (<= (- p) o) (<= o p))) it
+ ((cx-error context) InvalidOperation))
- (((ref self '_isinfinity))
+ (((ref self '_isinfinity)) it
(Decimal self))
;; get values, pad if necessary
- (let ((torot (int other))
- (rotdig (ref self '_int))
- (topad (- p (len rotdig))))
+ (let* ((torot (int other))
+ (rotdig (ref self '_int))
+ (topad (- p (len rotdig))))
(cond
((> topad 0)
@@ -4145,7 +4156,7 @@ This is the copyright information of the file ported over to scheme
;; if type(self) is Decimal:
;; return self # My components are also immutable
;; return self.__class__(str(self))
- |#
+
;; PEP 3101 support. the _localeconv keyword argument should be
;; considered private: it's provided for ease of testing only.
(define __format__
@@ -4250,10 +4261,10 @@ This is the copyright information of the file ported over to scheme
;; done with the decimal-specific stuff; hand over the rest
;; of the formatting to the _format_number function
(_format_number (ref self '_sign) intpart fracpart exp spec)))))))))
-#|
+
(define _dec_from_triple
(lam (sign coefficient exponent (= special #f))
- "Create a decimal instance directly, without any validation,
+ "Create a decimal instance directly, without any validation
normalization (e.g. removal of leading zeros) or argument
conversion.
@@ -4267,13 +4278,12 @@ This is the copyright information of the file ported over to scheme
(set self '_is_special special)
self)))
-
+(pk 14)
;; Register Decimal as a kind of Number (an abstract base class).
;; However, do not register it as Real (because Decimals are not
;; interoperable with floats).
;; _numbers.Number.register(Decimal)
-
;; ##### Context class #######################################################
(define-python-class _ContextManager (object)
@@ -4297,7 +4307,7 @@ This is the copyright information of the file ported over to scheme
(setcontext (ref self 'saved_context)))))
(define DefaultContext #f)
-
+(pk 15)
(define-syntax-rule (setq s q m)
(set s 'q (if (eq? q None) (ref m 'q) q)))
@@ -4305,7 +4315,7 @@ This is the copyright information of the file ported over to scheme
"Contains the context for a Decimal instance.
Contains:
- prec - precision (for use in rounding, division, square roots..)
+ prec - precision (for use in rounding, division square roots..)
rounding - rounding type (how you round)
traps - If traps[exception] = 1, then the exception is
raised when it is caused. Otherwise, a value is
@@ -4490,7 +4500,7 @@ This is the copyright information of the file ported over to scheme
(ref self '_ignored_flags))))
(define __copy__ copy)
-
+
(define _raise_error
(lam (self condition (= explanation None) (* args))
"Handles an error
@@ -4517,7 +4527,7 @@ This is the copyright information of the file ported over to scheme
(define _ignore_all_flags
(lambda (self)
"Ignore all flags, if they are raised"
- (py-apply (ref self '_ignore_flags) (*_signals))))
+ (py-apply (ref self '_ignore_flags) (* _signals))))
(define _ignore_flags
(lambda (self . flags)
@@ -4531,7 +4541,7 @@ This is the copyright information of the file ported over to scheme
(lambda (self . flags)
"Stop ignoring the flags, if they are raised"
(let ((flags
- (if (and (pair? flags) (isinstance (car flags) (tuple,list)))
+ (if (and (pair? flags) (isinstance (car flags) (list tuple py-list)))
(car flags)
flags)))
(for ((flag : flags)) ()
@@ -4545,11 +4555,13 @@ This is the copyright information of the file ported over to scheme
"Returns Etiny (= Emin - prec + 1)"
(int (+ (- (ref self 'Emin) (ref self 'prec)) 1))))
- (define (Etop self)
+ (define Etop
+ (lambda (self)
"Returns maximum exponent (= Emax - prec + 1)"
- (int (+ (- (ref self 'Emax) (ref self 'prec)) 1)))
-
- (define (_set_rounding self type)
+ (int (+ (- (ref self 'Emax) (ref self 'prec)) 1))))
+
+ (define _set_rounding
+ (lambda (self type)
"Sets the rounding type.
Sets the rounding type, and returns the current (previous)
@@ -4566,7 +4578,7 @@ This is the copyright information of the file ported over to scheme
"
(let ((rounding (ref self 'rounding)))
(set self 'rounding type)
- rounding))
+ rounding)))
(define create_decimal
(lam (self (= num "0"))
@@ -4646,7 +4658,7 @@ This is the copyright information of the file ported over to scheme
(let* ((a (_convert_other a #:raiseit #t))
(r ((ref a '__add__) b #:context self)))
(if (equal? r NotImplemented)
- (raise (TypeError (fromat #f "Unable to convert ~a to Decimal" b)))
+ (raise (TypeError (format #f "Unable to convert ~a to Decimal" b)))
r))))
(define _apply
@@ -4669,7 +4681,7 @@ This is the copyright information of the file ported over to scheme
((ref a 'canonical))))
(define compare
- (lambda (self a b):
+ (lambda (self a b)
"Compares values numerically.
If the signs of the operands differ, a value representing each operand
@@ -4959,7 +4971,7 @@ This is the copyright information of the file ported over to scheme
The first two operands are multiplied together, using multiply,
the third operand is then added to the result of that
- multiplication, using add, all with only one final rounding.
+ multiplication using add, all with only one final rounding.
>>> ExtendedContext.fma(Decimal('3'), Decimal('5'), Decimal('7'))
Decimal('22')
@@ -5070,7 +5082,7 @@ This is the copyright information of the file ported over to scheme
"
(let* ((a (_convert_other a #:raiseit #t)))
((ref a 'is_normal) #:context self))))
-
+
(define is_qnan
(lambda (self a)
"Return True if the operand is a quiet NaN; otherwise return False.
@@ -5682,7 +5694,7 @@ This is the copyright information of the file ported over to scheme
The result of pow(a, b, modulo) is identical to the result
that would be obtained by computing (a**b) % modulo with
- unbounded precision, but is computed more efficiently. It is
+ unbounded precision but is computed more efficiently. It is
always exact.
>>> c = ExtendedContext.copy()
@@ -5755,7 +5767,7 @@ This is the copyright information of the file ported over to scheme
Unlike other operations, if the length of the coefficient after the
quantize operation would be greater than precision then an Invalid
operation condition is raised. This guarantees that, unless there is
- an error condition, the exponent of the result of a quantize is always
+ an error condition the exponent of the result of a quantize is always
equal to that of the right-hand operand.
Also unlike other operations, quantize will never raise Underflow, even
@@ -5851,7 +5863,7 @@ This is the copyright information of the file ported over to scheme
(define remainder_near
(lambda (self a b)
"Returns to be 'a - b * n', where n is the integer nearest the exact
- value of "x / b" (if two integers are equally near then the even one
+ value of 'x / b' (if two integers are equally near then the even one
is chosen). If the result is equal to 0 then its sign will be the
sign of a.
@@ -6113,7 +6125,7 @@ This is the copyright information of the file ported over to scheme
"
(let* ((a (_convert_other a #:raiseit #t)))
((ref a 'to_integral_exact) #:context self))))
-
+
(define to_integral_value
(lambda (self a)
"Rounds to an integer.
@@ -6167,12 +6179,11 @@ This is the copyright information of the file ported over to scheme
(define __repr__
(lambda (self)
- (format "(~a, ~a, ~a)" (ref self 'sign) (ref self 'int) (ref self 'exp))))
+ (format #f "(~a, ~a, ~a)" (ref self 'sign) (ref self 'int) (ref self 'exp))))
(define __str__ __repr__))
-
(define _normalize
(lam (op1 op2 (= prec 0))
"Normalizes op1, op2 to have the same exp and length of coefficient.
@@ -6204,7 +6215,7 @@ This is the copyright information of the file ported over to scheme
;;##### Integer arithmetic functions used by ln, log10, exp and __pow__ #####
-
+(pk 1)
(define _nbits (ref int 'bit_length))
(define _decimal_lshift_exact
@@ -6269,7 +6280,7 @@ This is the copyright information of the file ported over to scheme
(+ q (if (> (+ (* 2 r) (logand q 1)) b) 1 0))))))
(define _ilog
- (lambda (x M (= L 8))
+ (lam (x M (= L 8))
"Integer approximation to M*log(x/M), with absolute error boundable
in terms only of x/M.
@@ -6295,7 +6306,7 @@ This is the copyright information of the file ported over to scheme
;; truncating at T such that y**T is small enough. The whole
;; computation is carried out in a form of fixed-point arithmetic,
;; with a real number z being represented by an integer
- ;; approximation to z*M. To avoid loss of precision, the y below
+ ;; approximation to z*M. To avoid loss of precision the y below
;; is actually an integer approximation to 2**R*y*M, where R is the
;; number of reductions performed so far.
@@ -6315,7 +6326,7 @@ This is the copyright information of the file ported over to scheme
(yshift (_rshift_nearest y R))
(w (_div_nearest M T)))
(for ((k : (range (- T 1) 0 -1))) ((w w))
- (- (_div_nearest M k) (_div_nearest (* yshift w M)))
+ (- (_div_nearest M k) (_div_nearest (* yshift w) M))
#:final
(_div_nearest (* w y) M)))))))
@@ -6378,7 +6389,7 @@ This is the copyright information of the file ported over to scheme
(_div_nearest c (expt 10 (- k)))))) ; error of <= 0.5 in c
;; _ilog magnifies existing error in c by a factor of at most 10
- (_ilog c, (expt 10 p))) ; error < 5 + 22 = 27
+ (_ilog c (expt 10 p))) ; error < 5 + 22 = 27
;; p <= 0: just approximate the whole thing by 0; error < 2.31
0))
(lambda (log_d)
@@ -6389,7 +6400,7 @@ This is the copyright information of the file ported over to scheme
(let ((extra (- (len (str (abs f))) 1)))
(if (>= (+ p extra) 0)
;; error in f * _log10_digits(p+extra) < |f| * 1 = |f|
- ;; after division, error < |f|/10**extra + 0.5 < 10 + 0.5 < 11
+ ;; after division error < |f|/10**extra + 0.5 < 10 + 0.5 < 11
(_div_nearest (* f (_log10_digits (+ p extra))) (expt 10 extra))
0))
0))
@@ -6425,17 +6436,17 @@ This is the copyright information of the file ported over to scheme
(let lp ((extra 3))
;; compute p+extra digits, correct to within 1ulp
(let* ((M (expt 10 (+ p extra 2)))
- (digits (str (_div_nearest (_ilog (* 10 M), M) 100))))
- (if (not (equal? (pylist-slice digits (- extra) None None)
+ (digits (str (_div_nearest (_ilog (* 10 M) M) 100))))
+ (if (not (equal? (pylist-slice (ref self 'digits) (- extra) None None)
(* '0' extra)))
#t
(lp (+ extra 3))))))
;; keep all reliable digits so far; remove trailing zeros
;; and next nonzero digit
- (set self 'digits (pylist-slice ((ref digits 'rstrip) "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)))))
-
+(pk 2)
(define _log10_digits (ref (_Log10Memoize) 'getdigits))
(define _iexp
@@ -6462,9 +6473,9 @@ This is the copyright information of the file ported over to scheme
;; Find R such that x/2**R/M <= 2**-L
(let ((R (_nbits (floor-quotient (ash x L) M))))
;; Taylor series. (2**L)**T > M
- (let* ((T (- (int (floor-quotient (* -10 (len( strM))) (* 3 L)))))
+ (let* ((T (- (int (floor-quotient (* -10 (len (str M))) (* 3 L)))))
(y1 (let ((Mshift (ash M R)))
- (for ((i : (range (- T1) 0 -1))) ((y (_div_nearest x T)))
+ (for ((i : (range (- T 1) 0 -1))) ((y (_div_nearest x T)))
(_div_nearest (* x (+ Mshift y)) (* Mshift i))
#:final y)))
@@ -6488,7 +6499,7 @@ This is the copyright information of the file ported over to scheme
(d-1)*10**f < exp(c*10**e) < (d+1)*10**f
In other words, d*10**f is an approximation to exp(c*10**e) with p
- digits of precision, and with an error in d of at most 1. This is
+ digits of precision and with an error in d of at most 1. This is
almost, but not quite, the same as the error being < 1ulp: when d
= 10**(p-1) the error could be up to 10 ulp."
@@ -6525,7 +6536,7 @@ This is the copyright information of the file ported over to scheme
(c-1)*10**e < x**y < (c+1)*10**e
in other words, c*10**e is an approximation to x**y with p digits
- of precision, and with an error in c of at most 1. (This is
+ of precision and with an error in c of at most 1. (This is
almost, but not quite, the same as the error being < 1ulp: when c
== 10**(p-1) we can only guarantee error < 10ulp.)
@@ -6545,20 +6556,20 @@ This is the copyright information of the file ported over to scheme
(* lxc yc (expt 10 shift))
(_div_nearest (* lxc yc) (expt 10 (- shift))))))
- (if (= pc 0)
+ (if (= ps 0)
;; we prefer a result that isn't exactly 1; this makes it
;; easier to compute a correctly rounded result in __pow__
(if (eq? (>= (+ (len (str xc)) xe) 1)
(> yc 0)) ; if x**y > 1:
- (values (+ (expt 10 (- p1)) 1) (- 1 p))
+ (values (+ (expt 10 (- p 1)) 1) (- 1 p))
(values (- (expt 10 p) 1) (- p)))
(call-with-values
(lambda ()
- (_dexp pc (- (+ p1)) (+ p 1)))
+ (_dexp ps (- (+ p 1)) (+ p 1)))
(lambda (coeff exp)
(values (_div_nearest coeff 10)
(+ exp 1))))))))
-
+(pk 3)
(define _corr (dict '(("1" . 100) ("2" . 70) ("3" . 53) ("4" . 40) ("5" . 31)
("6" . 23 ) ("7" . 16) ("8" . 10) ("9" . 5))))
(define _log10_lb
@@ -6608,7 +6619,7 @@ This is the copyright information of the file ported over to scheme
;; self op n/d <=> self*d op n (for n and d integers, d positive).
;; A NaN or infinity can be left unchanged without affecting the
;; comparison result.
- ((isinstance other (ref _numbers Rational))
+ ((isinstance other int)
(if (not (bool (ref self '_is_special)))
(values
(_dec_from_triple (ref self '_sign)
@@ -6622,7 +6633,7 @@ This is the copyright information of the file ported over to scheme
;; as appropriate. Other comparisons return NotImplemented.
(else
(let ((other (if (and equality_op
- (isinstance other (ref_numbers 'Complex))
+ (isinstance other complex)
(= (ref other 'imag) 0))
(ref other 'real)
other)))
@@ -6630,8 +6641,8 @@ This is the copyright information of the file ported over to scheme
(let ((context (getcontext)))
(if equality_op
(pylist-set! (ref context 'flags) FloatOperation 1)
- (ctx-error context FloatOperation
- "strict semantics for mixing floats and Decimals are enabled"))
+ ((cx-error context) FloatOperation
+ "strict semantics for mixing floats and Decimals are enabled"))
(values self ((ref Decimal 'from_float) other)))
(values NotImplemented NotImplemented)))))))
@@ -6684,7 +6695,7 @@ This is the copyright information of the file ported over to scheme
;;# number between the optional sign and the optional exponent must have
;;# at least one decimal digit, possibly after the decimal point. The
;;# lookahead expression '(?=\d|\.\d)' checks this.
-
+(pk 5)
(define _parser
(ref
(compile " # A numeric string consists of:
@@ -6706,10 +6717,11 @@ This is the copyright information of the file ported over to scheme
\\Z
" (logior VERBOSE IGNORECASE))
'match))
-
+(pk 6)
(define _all_zeros (ref (compile "0*$" ) 'match))
+(pk 7)
(define _exact_half (ref (compile "50*$") 'match))
-
+(pk 8)
;;##### PEP3101 support functions ##############################################
;;# The functions in this section have little to do with the Decimal
;;# class, and could potentially be reused or adapted for other pure
@@ -6734,14 +6746,14 @@ This is the copyright information of the file ported over to scheme
(?P<type>[eEfFgGn%])?
\\Z
" (logior VERBOSE DOTALL)))
-
+(pk 9)
;; The locale module is only needed for the 'n' format specifier. The
;; rest of the PEP 3101 code functions quite happily without it, so we
;; don't care too much if locale isn't present.
-(define _locale (try-module "locale"))
-
+(define _locale (Module "locale"))
+(pk 10)
(define _parse_format_specifier
- (lam (format_spec (=_localeconv None))
+ (lam (format_spec (= _localeconv None))
"Parse and validate a format specifier.
Turns a standard numeric format specifier into a dict, with the
@@ -6756,7 +6768,7 @@ This is the copyright information of the file ported over to scheme
grouping: grouping for thousands separators, in format
used by localeconv
decimal_point: string to use for decimal point
- precision: nonnegative integer giving precision, or None
+ precision: nonnegative integer giving precision or None
type: one of the characters 'eEfFgG%', or None
"
@@ -6766,7 +6778,7 @@ This is the copyright information of the file ported over to scheme
m))
;; get the dictionary
- (format_dict = ((ref m 'groupdict)))
+ (format_dict ((ref m 'groupdict)))
;; zeropad; defaults for fill and alignment. If zero padding
;; is requested, the fill and align fields should be absent.
@@ -6815,7 +6827,7 @@ This is the copyright information of the file ported over to scheme
(begin
;; apart from separators, 'n' behaves just like 'g'
(pylist-set! format_dict "type" "g")
- (if _(eq? _localeconv None)
+ (if (eq? _localeconv None)
(set! _localeconv ((ref _locale 'localeconv))))
(if (not (eq? sepM None))
(raise (ValueError (+ "Explicit thousands separator conflicts with "
@@ -6840,10 +6852,10 @@ This is the copyright information of the file ported over to scheme
"
;; how much extra space do we have to play with?
- (let ((minimumwidth (pylist-ref spec "minimumwidth"))
- (fill (pylist-ref spec "fill"))
- (padding (* fill (- minimumwidth (len sign) (len body))))
- (align (pylist-ref spec "align")))
+ (let* ((minimumwidth (pylist-ref spec "minimumwidth"))
+ (fill (pylist-ref spec "fill"))
+ (padding (* fill (- minimumwidth (len sign) (len body))))
+ (align (pylist-ref spec "align")))
(cond
((equal? align "<")
(+ sign body padding))
@@ -6866,7 +6878,7 @@ This is the copyright information of the file ported over to scheme
"
;; The result from localeconv()['grouping'], and the input to this
- ;; function, should be a list of integers in one of the
+ ;; function should be a list of integers in one of the
;; following three forms:
;;
;; (1) an empty list, or
@@ -6905,7 +6917,7 @@ This is the copyright information of the file ported over to scheme
(grouping (pylist-ref spec "grouping"))
(groups (pylist)))
- (for ((l :: (_group_lengths grouping))) ()
+ (for ((l : (_group_lengths grouping))) ()
(if (<= l 0)
(raise (ValueError "group length should be positive")))
;; max(..., 1) forces at least 1 digit to the left of a separator
@@ -6934,9 +6946,9 @@ This is the copyright information of the file ported over to scheme
(pylist-ref spec "sign"))
(else
""))))
-
+(pk 11)
(define typed (dict '(("E" . "E") ("e" . "e") ("G" . "E") ("g" . "e"))))
-
+(pk 12)
(define _format_number
(lambda (is_negative intpart fracpart exp spec)
"Format a number, given the following data:
@@ -6962,14 +6974,14 @@ This is the copyright information of the file ported over to scheme
(set! fracpart (+ (pylist-ref spec "decimal_point") fracpart)))
(if (or (not (= exp 0)) (in (pylist-ref spec "type") "eEgG"))
- (let ((echar (pylist-ref typed /pylist-ref spec "type")))
+ (let ((echar (pylist-ref typed (pylist-ref spec "type"))))
(set! fracpart (+ fracpart (str-format "{0}{1:+}" echar exp)))))
(if (equal? (pylist-ref spec "type") "%")
(set! fracpart (+ fracpart "%")))
(let* ((min_width
- (if (bool (pylist.ref spec "zeropad"))
+ (if (bool (pylist-ref spec "zeropad"))
(- (pylist-ref spec "minimumwidth") (len fracpart) (len sign))
0))
(intpart (_insert_thousands_sep intpart spec min_width)))
@@ -6981,25 +6993,31 @@ This is the copyright information of the file ported over to scheme
;;##### Useful Constants (internal use only) ################################
;; Reusable defaults
+(pk 13 1)
(define _Infinity (Decimal "Inf"))
+(pk 13 2)
(define _NegativeInfinity (Decimal "-Inf"))
+(pk 13 3)
(define _NaN (Decimal "NaN"))
+(pk 13 4)
(define _Zero (Decimal 0))
+(pk 13 5)
(define _One (Decimal 1))
+(pk 13 6)
(define _NegativeOne (Decimal -1))
-
+(pk 13 7)
;; _SignedInfinity[sign] is infinity w/ that sign
(define _SignedInfinity (list _Infinity _NegativeInfinity))
-
+(pk 13 8)
;; Constants related to the hash implementation; hash(x) is based
;; on the reduction of x modulo _PyHASH_MODULUS
(define _PyHASH_MODULUS (ref hash_info 'modulus))
-
+(pk 13 9)
;; hash values to use for positive and negative infinities, and nans
(define _PyHASH_INF (ref hash_info 'inf))
+(pk 13 10)
(define _PyHASH_NAN (ref hash_info 'nan))
-
+(pk 13 11)
;; _PyHASH_10INV is the inverse of 10 modulo the prime _PyHASH_MODULUS
-(define _PyHASH_10INV (py-pow 10 (- _PyHASH_MODULUS 2) _PyHASH_MODULUS))
-
-|#
+(define _PyHASH_10INV (pow 10 (- _PyHASH_MODULUS 2) _PyHASH_MODULUS))
+(pk 13 12)
diff --git a/modules/language/python/module/re.scm b/modules/language/python/module/re.scm
index 751ff0c..f16b697 100644
--- a/modules/language/python/module/re.scm
+++ b/modules/language/python/module/re.scm
@@ -424,7 +424,7 @@
-(define (compile s) (Regexp s))
+(def (compile s (= flags 0)) (Regexp s flags))
(define (purge) (values))
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 22:29:26 +0000