summaryrefslogtreecommitdiff
path: root/modules/language/python
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-02 16:20:08 +0200
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-08-02 16:20:08 +0200
commitf5bc0e0dbf979bc65380fff29f5b5b9ddf363469 (patch)
tree4d2037ef57bd4f757a081968726028b4ba63aa2c /modules/language/python
parent6164d13cae1e1ab6f9f35cbf57cf215d25fd4672 (diff)
improving decimal
Diffstat (limited to 'modules/language/python')
-rw-r--r--modules/language/python/compile.scm5
-rw-r--r--modules/language/python/exceptions.scm7
-rw-r--r--modules/language/python/format2.scm53
-rw-r--r--modules/language/python/module/_python.scm7
-rw-r--r--modules/language/python/module/decimal.scm637
-rw-r--r--modules/language/python/module/sys.scm10
6 files changed, 390 insertions, 329 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index af9e137..c3e7142 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -18,7 +18,7 @@
#:use-module (language python dir)
#:use-module (language python procedure)
#:use-module (language python bool)
- #:use-module ((language python format2) #:select (perform-formatters init-formatters))
+ #:use-module ((language python format2) #:select (fnm))
#:use-module ((language python with) #:select ())
#:use-module (ice-9 pretty-print)
#:export (comp))
@@ -1499,10 +1499,9 @@
,@start
,(C 'clear-warning-data)
(fluid-set! (@@ (system base message) %dont-warn-list) '())
- (,(C 'init-formatters))
+ (define ,(C 'fnm) (make-hash-table))
,@(map (lambda (s) `(,(C 'var) ,s)) globs)
,@(map (g globs exp) x)
- (,(C 'perform-formatters))
(,(C 'export-all)))))
(begin
(if (fluid-ref (@@ (system base compile) %in-compile))
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 804ee76..25c565f 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -9,7 +9,9 @@
None NotImplemented NotImplementedError
RunTimeError AssertionError ImportError
ModuleNotFoundError BlockingIOError
- InterruptedError BaseException))
+ InterruptedError BaseException
+ ZeroDivisionError ArithmeticError
+ OverflowError))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
@@ -45,7 +47,10 @@
(define StopIteration 'StopIteration)
(define GeneratorExit 'GeneratorExit)
+(define-er OverflowError 'OverflowError)
+(define-er ArithmeticError 'ArithmeticError)
(define-er BaseException 'BaseException)
+(define-er ZeroDivisionError 'ZeroDivisionError)
(define-er SystemException 'SystemException)
(define-er RuntimeError 'RuntimeError)
(define-er IndexError 'IndexError)
diff --git a/modules/language/python/format2.scm b/modules/language/python/format2.scm
index 87f1fe7..f8c4c69 100644
--- a/modules/language/python/format2.scm
+++ b/modules/language/python/format2.scm
@@ -6,7 +6,9 @@
#:use-module ((language python module re) #:select (splitm splitmm))
#:use-module (language python exceptions)
#:use-module (language python number)
- #:export (format perform-formatters init-formatters))
+ #:export (format fnm))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define scm-format (@ (guile) format))
@@ -240,51 +242,38 @@
(lambda (x)
'())))))))
-(define (format-- c l) (string-join (c l) ""))
+(define (format-- s l ha)
+ (aif it (hashq-ref ha s #f)
+ (string-join (it l) "")
+ (begin
+ (hashq-set! ha s (compile s))
+ (format-- s l ha))))
+
(define (format- str l)
- (format-- (compile str) l))
+ (string-join ((compile str) l) ""))
(define formatters (make-hash-table))
+(define fnm 'formatter-map132)
(define-syntax format
(lambda (x)
(syntax-case x ()
((_ a b)
(let ((s (syntax->datum #'a)))
(if (string? s)
- (let* ((mod (module-name (current-module)))
- (f (gensym "str"))
- (l (hash-ref formatters mod '())))
- (hash-set! formatters mod (cons (cons f s) l))
- (with-syntax ((u (datum->syntax #'a (list '@@ mod f)))
- (f (datum->syntax #'a f))
- (s s))
- #'(catch #t
- (lambda () (format-- u b))
- (lambda x (format- a b)))))
+ (let* ((mod (datum->syntax #'a (module-name (current-module))))
+ (f (datum->syntax #'a fnm)))
+
+ (if (not (module-defined? (current-module) fnm))
+ (module-define! (current-module) fnm (make-hash-table)))
+
+ (with-syntax ((u (list #'@@ mod f)))
+ #'(format-- a b u)))
#'(format- a b))))
((_ . _)
(error "wrong number of arguments to format"))
(_
#'format-))))
-
-(define-syntax perform-formatters
- (lambda (x)
- (syntax-case x ()
- ((_)
- (let ((mod (module-name (current-module))))
- (with-syntax ((mod (datum->syntax x mod)))
- #'(let lp ((l (hash-ref formatters 'mod '())))
- (if (pair? l)
- (begin
- (define! (caar l) (compile (cdar l)))
- (lp (cdr l)))))))))))
-
-(define-syntax init-formatters
- (lambda (x)
- (hash-set! formatters (module-name (current-module)) '())
- #f))
-
-
+
(define-method (py-mod (s <string>) l)
(format s l))
diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm
index 1dd9ff9..2cbd54f 100644
--- a/modules/language/python/module/_python.scm
+++ b/modules/language/python/module/_python.scm
@@ -292,7 +292,12 @@
((x y)
(expt x y))
((x y z)
- (py-mod (expt x y) z))))
+ (if (and (number? y) (integer? y) (>= z 0))
+ (let lp ((s 1) (i 0))
+ (if (< i z)
+ (lp (py-mod (* s y) z) (+ i 1))
+ s))
+ (modulo (expt x y) z)))))
(define-syntax-rule (super . l) (py-super-mac . l))
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm
index 0dc207e..31b8140 100644
--- a/modules/language/python/module/decimal.scm
+++ b/modules/language/python/module/decimal.scm
@@ -2,11 +2,52 @@
#:use-module ((language python module collections) #:select (namedtuple))
#:use-module ((language python module itertools) #:select (chain repeat))
#:use-module ((language python module sys) #:select (maxsize hash_info))
- #:use-module (language python Module)
+ #:use-module (language python module)
+ #:use-module ((language python module python) #:select
+ (isinstance str float int tuple classmethod pow))
#:use-module (language python list)
+ #:use-module (language python string)
+ #:use-module (language python for)
+ #:use-module (language python try)
+ #:use-module (language python hash)
#:use-module (language python dict)
+ #:use-module (language python def)
+ #:use-module (language python exceptions)
+ #:use-module (language python bool)
+ #:use-module (oop pf-objects)
#:use-module (language python module re)
- #:export ())
+ #:use-module (ice-9 control)
+ #:use-module (ice-9 match)
+ #:export
+ ( ;; Two major classes
+ Decimal Context
+
+ ;; Named tuple representation
+ DecimalTuple
+
+ ;; Contexts
+ DefaultContext BasicContext ExtendedContext
+
+ ;; Exceptions
+ DecimalException Clamped InvalidOperation DivisionByZero
+ Inexact Rounded Subnormal Overflow Underflow
+ FloatOperation
+
+ ;; Exceptional conditions that trigger InvalidOperation
+ DivisionImpossible InvalidContext ConversionSyntax DivisionUndefined
+
+ ;; Constants for use in setting up contexts
+ ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING
+ ROUND_FLOOR ROUND_UP ROUND_HALF_DOWN ROUND_05UP
+
+ ;; Functions for manipulating contexts
+ setcontext getcontext localcontext
+
+ ;; Limits for the C version for compatibility
+ MAX_PREC MAX_EMAX MIN_EMIN MIN_ETINY))
+
+
+(define-syntax-rule (aif it p . l) (let ((it p)) (if it . l)))
#|
This is the copyright information of the file ported over to scheme
@@ -26,7 +67,7 @@ This is the copyright information of the file ported over to scheme
# and the updates are becoming fewer, smaller, and less significant.
|#
-(define guile:modulo (@ (guile) moduolo))
+(define guile:modulo (@ (guile) modulo))
(define __name__ "decimal")
(define __xname__ __name__)
@@ -71,6 +112,7 @@ This is the copyright information of the file ported over to scheme
(define-inlinable (cx-raise x) (ref x '_raise_error))
(define-inlinable (cx-error x) (ref x '_raise_error))
(define-inlinable (cx-capitals x) (rawref x 'capitals))
+(define-inlinable (cx-cap x) (rawref x 'capitals))
(define-inlinable (cx-rounding x) (rawref x 'rounding))
(define-inlinable (cx-clamp x) (rawref x 'clamp))
(define-inlinable (cx-traps x) (rawref x 'traps))
@@ -104,7 +146,7 @@ This is the copyright information of the file ported over to scheme
(define-python-class Clamped (DecimalException)
- """Exponent of a 0 changed to fit bounds.
+ "Exponent of a 0 changed to fit bounds.
This occurs and signals clamped if the exponent of a result has been
altered in order to fit the constraints of a specific concrete
@@ -112,8 +154,8 @@ This is the copyright information of the file ported over to scheme
be outside the bounds of a representation, or when a large normal
number would have an encoded exponent that cannot be represented. In
this latter case, the exponent is reduced to fit and the corresponding
- number of zero digits are appended to the coefficient ("fold-down").
- """)
+ number of zero digits are appended to the coefficient ('fold-down').
+ ")
(define-python-class InvalidOperation (DecimalException)
"An invalid operation was performed.
@@ -309,7 +351,7 @@ This is the copyright information of the file ported over to scheme
")
(define-python-class FloatOperation (DecimalException TypeError)
- """Enable stricter semantics for mixing floats and Decimals.
+ "Enable stricter semantics for mixing floats and Decimals.
If the signal is not trapped (default), mixing floats and Decimals is
permitted in the Decimal() constructor, context.create_decimal() and
@@ -321,7 +363,7 @@ 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.
- """)
+ ")
;; List of public traps and flags
(define _signals
@@ -337,7 +379,7 @@ This is the copyright information of the file ported over to scheme
;; Valid rounding modes
(define _rounding_modes
- (list ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING,
+ (list ROUND_DOWN ROUND_HALF_UP ROUND_HALF_EVEN ROUND_CEILING
ROUND_FLOOR ROUND_UP ROUND_HALF_DOWN ROUND_05UP))
;; ##### Context Functions ##################################################
@@ -364,9 +406,29 @@ This is the copyright information of the file ported over to scheme
This function is for *internal use only*.
"
- (Decimal sign coeficient exponent special)))
+ (Decimal sign coefficient exponent special)))
+
+(define (get-parsed-sign m)
+ (if (equal? ((ref m 'group) "sign") "-")
+ 1
+ 0))
+
+(define (get-parsed-int m)
+ ((ref m 'group) "int"))
+
+(define (get-parsed-frac m)
+ ((ref m 'group) "frac"))
+
+(define (get-parsed-exp m)
+ ((ref m 'group) "exp"))
-(def _mk (self (= value "0") (= context None))
+(define (get-parsed-diag m)
+ ((ref m 'group) "diag"))
+
+(define (get-parsed-sig m)
+ ((ref m 'group) "signal"))
+
+(def (_mk self __init__ (= value "0") (= context None))
"Create a decimal point instance.
>>> Decimal('3.14') # string input
@@ -393,7 +455,7 @@ This is the copyright information of the file ported over to scheme
;; REs insist on real strings, so we can too.
(cond
((isinstance value str)
- (let ((m (parser (scm-str str))))
+ (let ((m (_parser (scm-str str))))
(if (not m)
(let ((context (if (eq? context None)
(getcontext)
@@ -415,7 +477,7 @@ This is the copyright information of the file ported over to scheme
(begin
(set self '_int (str (int (+ intpart fracpart))))
(set self '_exp (- exp (len fracpart)))
- (set self '_is_special False))
+ (set self '_is_special #f))
(begin
(if (not (eq? diag None))
(begin
@@ -488,7 +550,7 @@ This is the copyright information of the file ported over to scheme
(<= digit 9))
;; skip leading zeros
(if (or (bool digits) (> digit 0))
- (pylist-append digits digit))
+ (pylist-append! digits digit))
(raise (ValueError
(+ "The second value in the tuple must "
"be composed of integers in the range "
@@ -531,18 +593,24 @@ This is the copyright information of the file ported over to scheme
(values (quotient x y) (modulo x y)))
(define-syntax twix
- (syntax-rules (let)
+ (syntax-rules (let let* if)
((_ a) a)
+ ((_ (let ((a aa) ...) b ...) . l)
+ (let ((a aa) ...) b ... (twix . l)))
((_ (let (a ...)) . l)
- (a ... (twix - l)))
+ (a ... (twix . l)))
+ ((_ (let* (a ...) b ...) . l)
+ (let* (a ...) b ... (twix . l)))
+ ((_ (if . u) . l)
+ (begin (if . u) (twix . l)))
((_ (a it code ...) . l)
- (aif it a (begin code ...) (twix - l)))))
+ (aif it a (begin code ...) (twix . l)))))
-(define-syntax-rule (norm-op op)
+(define-syntax-rule (norm-op self op)
(begin
(set! op ((ref self '_convert_other) op))
(if (eq? op NotImplemented)
- other
+ op
#f)))
(define-syntax-rule (get-context context code)
@@ -555,7 +623,7 @@ This is the copyright information of the file ported over to scheme
(if ((ref self '_is_special))
(let ((ans ((ref self '_check_nans) #:context context)))
(if (bool ans)
- (ret ans)
+ ans
#f))
#f))
@@ -574,10 +642,10 @@ This is the copyright information of the file ported over to scheme
((cx-error context) InvalidOperation "-INF + INF")
(Decimal self))
(if ((ref other '_isinfinity))
- (ret (Decimal other)) ; Can't both be infinity here
+ (Decimal other) ; Can't both be infinity here
#f))))
-(define-syntax-rule (mul-special self other context)
+(define-syntax-rule (mul-special self other context resultsign)
(if (or (ref self '_is_special) (ref other '_is_special))
(twix
((bin-special self other context) it it)
@@ -595,7 +663,7 @@ This is the copyright information of the file ported over to scheme
#f))
#f))
- (define-syntax-rule (div-special self other context)
+ (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)
@@ -608,7 +676,7 @@ This is the copyright information of the file ported over to scheme
(((ref other '_isinfinity)) it
((cx-error context) Clamped "Division by infinity")
- (_dec_from_triple sign "0", (cx-etiny context))))))
+ (_dec_from_triple sign "0" (cx-etiny context))))))
(define-python-class Decimal (object)
@@ -628,11 +696,11 @@ This is the copyright information of the file ported over to scheme
(set self '_is_special special))
((self)
- (_mk self))
+ (_mk self __init__))
((self a)
- (_mk self a))
+ (_mk self __init__ a))
((self a b)
- (_mk self a b))))
+ (_mk self __init__ a b))))
(define from_float
(classmethod
@@ -657,6 +725,26 @@ This is the copyright information of the file ported over to scheme
Decimal('-0')
"
+ (define (frexp x)
+ (if (< x 0) (set! x (- x)))
+
+ (let lp ((l (string->list (format #f "~e" x))) (r1 '()))
+ (match l
+ ((#\. . l)
+ (let lp ((l l) (r2 '()))
+ (match l
+ ((#\E . l)
+ (let* ((n (length r1))
+ (m (list->string (append (reverse r1) (reverse r2))))
+ (e (+ (- n 1) (string->number (list->string l)))))
+ (cons m e)))
+ ((x . l)
+ (lp l (cons x r2))))))
+
+ ((x . l)
+ (lp l (cons x r1))))))
+
+
(cond
((isinstance f int) ; handle integer inputs
(cls f))
@@ -664,15 +752,15 @@ This is the copyright information of the file ported over to scheme
(raise (TypeError "argument must be int or float.")))
((or (inf? f) (nan? f))
(cls (cond
- ((nan? f) "")
- ((eq? f (inf)) "")
- (eq? f (- (inf))) "")))
+ ((nan? f) "")
+ ((eq? f (inf)) "")
+ ((eq? f (- (inf))) ""))))
(else
(let* ((sign (if (>= f 0) 0 1))
(me (frexp f))
- (m (car me))
- (e (cadr me))
- (res (_dec_from_triple sign, str(m) e)))
+ (m (car me))
+ (e (cdr me))
+ (res (_dec_from_triple sign m e)))
(if (eq? cls Decimal)
res
(cls res))))))))
@@ -788,7 +876,7 @@ This is the copyright information of the file ported over to scheme
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)
@@ -806,57 +894,57 @@ This is the copyright information of the file ported over to scheme
(cond
((eq? self_inf other_inf) 0)
((< self_inf other_inf) -1)
- (else 1)))
+ (else 1))))
- ;; check for zeros; Decimal('0') == Decimal('-0')
- ((not (bool self))
- (if (not (bool other))
- 0
- (let ((s (ref other '_sign)))
- (if (= s 0)
- -1
- 1))))
- ((not (bool other))
- (let ((s (ref self '_sign)))
- (if (= s 0)
- 1
- -1)))
+ ;; check for zeros; Decimal('0') == Decimal('-0')
+ ((not (bool self))
+ (if (not (bool other))
+ 0
+ (let ((s (ref other '_sign)))
+ (if (= s 0)
+ -1
+ 1))))
+ ((not (bool other))
+ (let ((s (ref self '_sign)))
+ (if (= s 0)
+ 1
+ -1)))
- ((< other_sign self_sign)
- -1)
- ((< self_sign other_sign)
- 1)
-
- (else
- (let ((self_adjusted ((ref self 'adjusted)))
- (other_adjusted ((ref other 'adjusted)))
- (self_exp (ref self '_exp))
- (other_exp (ref other '_exp)))
- (cond
- ((= self_adjusted other_adjusted)
- (let ((self_padded (+ (ref self '_int)
- (* "0" (- self_exp other_exp))))
- (other_padded (+ (ref other '_int)
- (* "0" (- other_exp self_exp)))))
- (cond
- ((equal? self_padded other_padded)
- 0)
- ((< self_padded other_padded)
- (if (= self_sign 0)
- -1
- 1))
- (else
- (if (= self_sign 0)
- 1
- -1)))))
- ((> self_adjusted other_adjusted)
- (if (= self_sign 0)
- 1
- -1))
- (else
- (if (= self_sign 0)
- -1
- 1))))))))))
+ ((< other_sign self_sign)
+ -1)
+ ((< self_sign other_sign)
+ 1)
+
+ (else
+ (let ((self_adjusted ((ref self 'adjusted)))
+ (other_adjusted ((ref other 'adjusted)))
+ (self_exp (ref self '_exp))
+ (other_exp (ref other '_exp)))
+ (cond
+ ((= self_adjusted other_adjusted)
+ (let ((self_padded (+ (ref self '_int)
+ (* "0" (- self_exp other_exp))))
+ (other_padded (+ (ref other '_int)
+ (* "0" (- other_exp self_exp)))))
+ (cond
+ ((equal? self_padded other_padded)
+ 0)
+ ((< self_padded other_padded)
+ (if (= self_sign 0)
+ -1
+ 1))
+ (else
+ (if (= self_sign 0)
+ 1
+ -1)))))
+ ((> self_adjusted other_adjusted)
+ (if (= self_sign 0)
+ 1
+ -1))
+ (else
+ (if (= self_sign 0)
+ -1
+ 1)))))))))
;; Note: The Decimal standard doesn't cover rich comparisons for
;; Decimals. In particular, the specification is silent on the
@@ -877,9 +965,9 @@ This is the copyright information of the file ported over to scheme
(define __eq__
(lam (self other (= context None))
- (let ((so (_convert_for_comparisonc self other #:equality_op #t))
- (self (car so))
- (other (cadr so)))
+ (let* ((so (_convert_for_comparison self other #:equality_op #t))
+ (self (car so))
+ (other (cadr so)))
(cond
((eq? other NotImplemented)
@@ -891,9 +979,9 @@ This is the copyright information of the file ported over to scheme
(define _xlt
(lambda (<)
(lam (self other (= context None))
- (let ((so (_convert_for_comparisonc self other #:equality_op #t))
- (self (car so))
- (other (cadr so)))
+ (let* ((so (_convert_for_comparison self other #:equality_op #t))
+ (self (car so))
+ (other (cadr so)))
(cond
((eq? other NotImplemented)
@@ -939,21 +1027,21 @@ This is the copyright information of the file ported over to scheme
(((ref self 'is_snan))
(raise (TypeError "Cannot hash a signaling NaN value.")))
(((ref self 'is_snan))
- (hash (nan)))
+ (hash (nan) pyhash-N))
((= 1 (ref self '_sign))
- (hash (- (inf))))
+ (hash (- (inf)) pyhash-N))
(else
- (hash (inf)))))
+ (hash (inf) pyhash-N))))
(else
(let* ((exp (ref self '_exp))
(exp_hash
(if (>= exp 0)
- (expt 10 exp _ pyhash-N)
- (expt _PyHASH_10INV (- exp) pyhash-N)))
+ (pow 10 exp pyhash-N)
+ (pow _PyHASH_10INV (- exp) pyhash-N)))
(hash_
- (modulus (* (int (ref self '_int)) exp_hash)
+ (modulo (* (int (ref self '_int)) exp_hash)
pyhash-N))
(ans
@@ -966,7 +1054,7 @@ This is the copyright information of the file ported over to scheme
To show the internals exactly as they are.
"
- (DecimalTuple self._sign
+ (DecimalTuple (ref self '_sign)
(tuple (map int (ref self '_int)))
(ref self '_exp))))
@@ -993,15 +1081,15 @@ This is the copyright information of the file ported over to scheme
(if (not (bool self))
(values 0 1)
- (let ((s (ref self '_sign))
- (n (int (ref self '_int)))
- (e (ref self '_exp))
- (x
- (* n (if (> exp 0)
- (expt 10 exo)
- (/ 1 (expt 10 (- expt)))))))
+ (let* ((s (ref self '_sign))
+ (n (int (ref self '_int)))
+ (e (ref self '_exp))
+ (x
+ (* n (if (> exp 0)
+ (expt 10 exp)
+ (/ 1 (expt 10 (- expt)))))))
(values (numerator x)
- (denomerator x))))))
+ (denominator x))))))
(define __repr__
(lambda (self)
@@ -1015,7 +1103,7 @@ This is the copyright information of the file ported over to scheme
Captures all of the information in the underlying representation.
"
- (let* ((sign (if (= (reg self '_sign) 0) "" "-"))
+ (let* ((sign (if (= (ref self '_sign) 0) "" "-"))
(exp (ref self '_exp))
(i (ref self '_int))
(leftdigits (+ exp (len i)))
@@ -1073,7 +1161,7 @@ This is the copyright information of the file ported over to scheme
(getcontext)
context)))
(set! exp
- (+ (pylist-ref (lise "e" "E") (cx-capitals context))
+ (+ (pylist-ref '("e" "E") (cx-capitals context))
(format #f "%@d" (- leftdigits dotplace)))))))
(+ sign intpart fracpart exp))))))
@@ -1087,7 +1175,7 @@ This is the copyright information of the file ported over to scheme
((ref self '__str__) #:eng #t #:contect context)))
(define __neg__
- (lam (self (= contextNone))
+ (lam (self (= context None))
"Returns a copy with the sign switched.
Rounds, if it has reason.
@@ -1105,9 +1193,9 @@ This is the copyright information of the file ported over to scheme
;; in ROUND_FLOOR rounding mode.
((ref self 'copy_abs))
((ref self 'copy_negate)))))
-
+
((ref ans '_fix) context)))))
-
+
(define __pos__
(lam (self (= context None))
"Returns a copy, unless it is a sNaN.
@@ -1140,7 +1228,7 @@ This is the copyright information of the file ported over to scheme
self.copy_abs().
"
(twix
- ((not (bool round))
+ ((not (bool round)) it
((ref self 'copy_abs)))
((un-special self context) it it)
@@ -1149,6 +1237,7 @@ This is the copyright information of the file ported over to scheme
((ref self '__neg__) #:context context)
((ref self '__pos__) #:context context)))))
+
(define __add__
(lam (self other (= context None))
"Returns self + other.
@@ -1156,27 +1245,27 @@ This is the copyright information of the file ported over to scheme
-INF + INF (or the reverse) cause InvalidOperation errors.
"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
- ((add-special o1 o2 context) it it)
+ ((add-special self other context) it it)
- (let (let* ((negativezero 0)
- (self_sign (ref self '_sign))
- (other_sign (ref other '_sign))
- (self_exp (ref self '_sign))
- (other_exp (ref other '_sign))
- (prec (cx-prec context))
- (exp (min self_exp other_exp))
- (sign #f)
- (ans #f))
+ (let* ((negativezero 0)
+ (self_sign (ref self '_sign))
+ (other_sign (ref other '_sign))
+ (self_exp (ref self '_sign))
+ (other_exp (ref other '_sign))
+ (prec (cx-prec context))
+ (exp (min self_exp other_exp))
+ (sign #f)
+ (ans #f))
- (if (and (eq? (cx-rounding context) ROUND_FLOOR)
- (not (= self_sign other_sign)))
- ;; If the answer is 0, the sign should be negative,
- ;; in this case.
- (set! negativezero 1))))
+ (if (and (eq? (cx-rounding context) ROUND_FLOOR)
+ (not (= self_sign other_sign)))
+ ;; If the answer is 0, the sign should be negative,
+ ;; in this case.
+ (set! negativezero 1)))
((if (and (not (bool self)) (not (bool other)))
(begin
@@ -1192,7 +1281,7 @@ This is the copyright information of the file ported over to scheme
(begin
(set! exp (max exp (- other_exp prec 1)))
(set! ans ((ref other '_rescale) exp
- (cx-rounding rounding)))
+ (cx-rounding context)))
(set! ans ((ref ans '_fix) context))
ans)
#f) it it)
@@ -1201,18 +1290,18 @@ This is the copyright information of the file ported over to scheme
(begin
(set! exp (max exp (- self_exp prec 1)))
(set! ans ((ref self '_rescale) exp
- (cx-rounding rounding)))
+ (cx-rounding context)))
(set! ans ((ref ans '_fix) context))
ans)
#f) it it)
- (let (let* ((op1 (_WorkRep self))
- (op2 (_WorkRep other))
- (ab (_normalize op1 op2 prec))
- (op1 (car ab))
- (op2 (cadr ab))
- (result (_WorkRep)))))
+ (let* ((op1 (_WorkRep self))
+ (op2 (_WorkRep other))
+ (ab (_normalize op1 op2 prec))
+ (op1_i (car ab))
+ (op2_i (cadr ab))
+ (result (_WorkRep))))
((cond
((not (= (ref op1 'sign) (ref op2 'sign)))
@@ -1239,10 +1328,10 @@ This is the copyright information of the file ported over to scheme
((= (ref op1 'sign) 1)
(set result 'sign 1)
#f)
-
- (begin
- (set result 'sign 0)
- #f)) it it)
+
+ (else
+ (set result 'sign 0)
+ #f)) it it)
(begin
(if (= (ref op2 'sign) 0)
@@ -1259,8 +1348,8 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Return self - other"
(twix
- ((norm-op other) it it)
- ((bin-special o1 o2 context) it it)
+ ((norm-op self other) it it)
+ ((bin-special self other context) it it)
((ref self '__add__)
((ref other 'copy_negate)) #:context context))))
@@ -1268,7 +1357,7 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Return other - self"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref 'other '__sub__) self #:context context))))
(define __mul__
@@ -1278,50 +1367,50 @@ This is the copyright information of the file ported over to scheme
(+-) INF * 0 (or its reverse) raise InvalidOperation.
"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
- (let (let ((resultsign (logxor (ref self '_sign)
- (ref other '_sign))))))
+ (let ((resultsign (logxor (ref self '_sign)
+ (ref other '_sign)))))
- ((mul-special o1 o2 context) it it)
+ ((mul-special self other context resultsign) it it)
- (let (let ((resultexp (+ (ref self '_exp) (ref other '_exp))))))
+ (let ((resultexp (+ (ref self '_exp) (ref other '_exp)))))
;; Special case for multiplying by zero
- ((or (not (bool self)) (not (bool other)))
+ ((or (not (bool self)) (not (bool other))) it
(let ((ans (_dec_from_triple resultsign "0" resultexp)))
- ((ref and '_fix) context)))
+ ((ref ans '_fix) context)))
;; Special case for multiplying by power of 10
- ((equal? (ref self '_int) "1")
+ ((equal? (ref self '_int) "1") it
(let ((ans (_dec_from_triple resultsign (ref other '_int) resultexp)))
- ((ref and '_fix) context)))
+ ((ref ans '_fix) context)))
- ((equal? (ref other '_int) "1")
+ ((equal? (ref other '_int) "1") it
(let ((ans (_dec_from_triple resultsign (ref self '_int) resultexp)))
- ((ref and '_fix) context)))
+ ((ref ans '_fix) context)))
(let* ((op1 (_WorkRep self))
(op2 (_WorkRep other))
(ans (_dec_from_triple resultsign
- (str (* (ref op1 ') (ref op2 'int)))
+ (str (* (ref op1 'int) (ref op2 'int)))
resultexp)))
- ((ref and '_fix) context)))))
-
+ ((ref ans '_fix) context)))))
+
(define __rmul__ __mul__)
(define __truediv__
(lam (self other (= context None))
"Return self / other."
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
- (let (let ((sign (logxor (ref self '_sign)
- (ref other '_sign))))))
+ (let ((sign (logxor (ref self '_sign)
+ (ref other '_sign)))))
- ((div-special o1 o2 context) it it)
+ ((div-special self other context sign) it it)
;; Special cases for zeroes
((if (not (bool other))
@@ -1358,8 +1447,8 @@ This is the copyright information of the file ported over to scheme
(if (= (modulus coeff- 5) 0)
(+ coeff- 1)
coeff)
- (let (ideal_exp (- (ref self '_exp)
- (ref other '_exp)))
+ (let ((ideal_exp (- (ref self '_exp)
+ (ref other '_exp))))
(let lp ((coeff- coeff-) (exp- exp))
(if (and (< exp- indeal_exp)
(= (modulo coeff 10) 0))
@@ -1422,12 +1511,12 @@ 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__.""
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref other '__truediv__) self #:context context))))
(define __divmod__
@@ -1437,7 +1526,7 @@ This is the copyright information of the file ported over to scheme
"
(apply values
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
@@ -1475,7 +1564,7 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Swaps self/other and returns __divmod__."
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref other '__divmod__) self #:context context))))
(define __mod__
@@ -1484,7 +1573,7 @@ This is the copyright information of the file ported over to scheme
self % other
"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
@@ -1500,12 +1589,12 @@ This is the copyright information of the file ported over to scheme
(let* ((remainder ((ref self '_divide) other context)))
((ref remainder '_fix) context)))))
-
+
(define __rmod__
(lam (self other (= context None))
"Swaps self/other and returns __mod__."
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref other '__mod__) self #:context context))))
(define remainder_near
@@ -1514,7 +1603,7 @@ This is the copyright information of the file ported over to scheme
Remainder nearest to 0- abs(remainder-near) <= other/2
"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
@@ -1589,7 +1678,7 @@ This is the copyright information of the file ported over to scheme
(lambda (self other (= context None))
"self // other"
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
(let (get-context context))
@@ -1613,7 +1702,7 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Swaps self/other and returns __floordiv__."
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref other '__floordiv__) self #:context context))))
(define __float__
@@ -1661,7 +1750,7 @@ This is the copyright information of the file ported over to scheme
(define __complex__
(lambda (self)
(complex (float self))))
-
+
(define _fix_nan
(lambda (self context)
"Decapitate the payload of a NaN to fit the context"
@@ -1682,7 +1771,7 @@ This is the copyright information of the file ported over to scheme
#t))
(Decimal self)))))
- (define _fix
+ (define _fix
(lambda (self context)
"Round if it is necessary to keep self within prec precision.
@@ -1722,7 +1811,7 @@ This is the copyright information of the file ported over to scheme
;; equal to max(self.adjusted()-context.prec+1, Etiny)
(let ((exp_min (+ (len (ref self '_int))
(ref self '_exp)
- (- (cx-prec context)))))))
+ (- (cx-prec context))))))
((> exp_min Etop) it
;; overflow: exp_min > Etop iff self.adjusted() > Emax
(let ((ans ((cx-error context) Overflow "above Emax"
@@ -1732,7 +1821,7 @@ 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 Eriny exp_min))))
;; round if self has too many digits
((< self._exp exp_min) it
@@ -1797,8 +1886,9 @@ This is the copyright information of the file ported over to scheme
(_dec_from_triple (ref self '_sign) self_padded Etop)))
;; here self was representable to begin with; return unchanged
- (Decimal self))))
-
+ (Decimal self))))))
+
+
;; for each of the rounding functions below:
;; self is a finite, nonzero Decimal
@@ -2025,8 +2115,8 @@ This is the copyright information of the file ported over to scheme
(lam (self other modulo (= context None))
"Three argument version of __pow__"
(twix
- ((norm-op other ) it it)
- ((norm-op modulo) it it)
+ ((norm-op self other ) it it)
+ ((norm-op self modulo) it it)
(let (get-context context))
;; deal with NaNs: if there are any sNaNs then first one wins,
@@ -2439,7 +2529,7 @@ This is the copyright information of the file ported over to scheme
((not (eq= modulo None)) it
((ref self '_power_modulo) other modulo context))
- ((norm-op other ) it it)
+ ((norm-op self other ) it it)
(let (get-context context))
;; either argument is a NaN => result is NaN
@@ -2659,7 +2749,7 @@ This is the copyright information of the file ported over to scheme
(lam (self other (= context None))
"Swaps self/other and returns __pow__."
(twix
- ((norm-op other) it it)
+ ((norm-op self other) it it)
((ref 'other '__pow__) self #:context context))))
(define normalize
@@ -2774,7 +2864,7 @@ This is the copyright information of the file ported over to scheme
* return True if both operands are NaNs
* otherwise, return False.
"
- (let ((other (_convert_other other #raiseit #t)))
+ (let ((other (_convert_other other #:raiseit #t)))
(if (or (ref self '_is_special) (ref other '_is_special))
(or (and ((ref self 'is_nan)) ((ref other 'is_nan)))
(and ((ref self 'is_infinite)) ((ref other 'is_infinite))))))
@@ -3159,7 +3249,7 @@ This is the copyright information of the file ported over to scheme
It's pretty much like compare(), but all NaNs signal, with signaling
NaNs taking precedence over quiet NaNs.
"
- (let* ((other (_convert_other other #raiseit #t))
+ (let* ((other (_convert_other other #:raiseit #t))
(ans ((ref self '_compare_check_nans) other context)))
(if (bool ans)
and
@@ -3175,7 +3265,7 @@ This is the copyright information of the file ported over to scheme
"
(twix
- (let ((other (_convert_other other #raiseit #t))))
+ (let ((other (_convert_other other #:raiseit #t))))
;; if one is negative and the other is positive, it's easy
((and (bool (ref self '_sign)) (not (bool other '_sign))) it
@@ -3283,7 +3373,7 @@ This is the copyright information of the file ported over to scheme
(let ((other (_convert_other other #:raiseit #t)))
(_dec_from_triple (ref other 'sign) (ref self '_int)
(ref self '_exp) (ref self '_is_special)))))
-
+
(define exp
(lam (self (= context None))
"Returns e ** self."
@@ -3740,42 +3830,8 @@ This is the copyright information of the file ported over to scheme
(_dec_from_triple 0 (* "1" (ctx-prec context)) 0)
context))))
-
- (define max_mag
- (lambda (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))
-
- ((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
- ;; number is always returned
- (let ((sn ((ref self '_isnan)))
- (on ((ref other '_isnan))))
- (if (or (bool sn) (bool on))
- (cond
- ((and (= on 1) (= sn 0))
- ((ref self '_fix) context))
- ((and (= on 0) (= sn 1))
- ((ref other '_fix) context))
- (else
- ((ref self '_check_nans) other context)))
- #f))
- #f) it it)
-
- (let* ((s ((ref self 'copy_abs)))
- (o ((ref other 'copy_abs)))
- (c ((ref s '_cmp) o))
- (c (if (= c 0)
- ((self 'compare_total) other)
- c))
- (ans (if (= c -1) other self)))
-
- ((ref ans '_fix) context)))))
-
(define x_mag
- (lamnda (nott)
+ (lambda (nott)
(lambda (self other (= context None))
"Compares the values numerically with their sign ignored."
(twix
@@ -4068,9 +4124,9 @@ This is the copyright information of the file ported over to scheme
;; let's shift!
(let ((shifted (if (< torot 0)
- (pylist-splice rotdig None torot None)
- (pylist-splice (+ rotdig (* "0" torot))
- (- p) None None))))
+ (pylist-slice rotdig None torot None)
+ (pylist-slice (+ rotdig (* "0" torot))
+ (- p) None None))))
(_dec_from_triple (ref self '_sign)
(or (bool (py-lstrip shifted "0")) "0")
@@ -4089,9 +4145,9 @@ 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.
+ ;; considered private: it's provided for ease of testing only.
(define __format__
(lam (self specifier (= context None) (= _localeconv None))
"Format a Decimal instance according to the given specifier.
@@ -4125,45 +4181,45 @@ This is the copyright information of the file ported over to scheme
(set! body (+ body "%")))
(_format_align sign body spec)))
- ;; a type of None defaults to 'g' or 'G', depending on context
- (if (eq? type None)
- (pylist-set! spec "type"
- (if (= (ctx-cap context) 0) "g" "G")))
-
- (let ((type (pylist-ref spec "type"))))
- ;; if type is '%', adjust exponent of self accordingly
- (if (equal? type "%")
- (set! self
- (_dec_from_triple (ref self '_sign)
- (ref self '_int)
- (+ (ref self '_exp) 2))))
-
- ;; round if necessary, taking rounding mode from the context
- (let ((rounding (ctx-round context))
- (precision (pylist-ref spec "precision")))
- (if (not (eq? precision None))
- (cond
- ((in type "eE")
- (set! self ((ref self '_round) (+ precision 1) rounding)))
- ((in type "fF%")
- (set! self ((ref self '_rescale) (- precision) rounding)))
- ((and (in type "gG") (> (len (ref self '_int)) precision))
- (set! self ((ref self '_round) precision rounding)))
- (else #t)))
+ ;; a type of None defaults to 'g' or 'G', depending on context
+ (if (eq? type None)
+ (pylist-set! spec "type"
+ (if (= (cx-cap context) 0) "g" "G")))
+
+ (let ((type (pylist-ref spec "type"))))
+ ;; if type is '%', adjust exponent of self accordingly
+ (if (equal? type "%")
+ (set! self
+ (_dec_from_triple (ref self '_sign)
+ (ref self '_int)
+ (+ (ref self '_exp) 2))))
+
+ ;; round if necessary, taking rounding mode from the context
+ (let ((rounding (cx-rounding context))
+ (precision (pylist-ref spec "precision")))
+ (if (not (eq? precision None))
+ (cond
+ ((in type "eE")
+ (set! self ((ref self '_round) (+ precision 1) rounding)))
+ ((in type "fF%")
+ (set! self ((ref self '_rescale) (- precision) rounding)))
+ ((and (in type "gG") (> (len (ref self '_int)) precision))
+ (set! self ((ref self '_round) precision rounding)))
+ (else #t))))
- ;; special case: zeros with a positive exponent can't be
- ;; represented in fixed point; rescale them to 0e0.
- (if (and (not (bool self)) (> (ref self '_exp) 0) (in type "fF%"))
- (set! self ((ref self '_rescale) 0 rounding))))
-
- ;; figure out placement of the decimal point
- (let* ((leftdigits (+ (ref self '_exp) (len (ref self '_int))))
- (dotplace
- (cond
- ((in type "eE")
- (if (and (not (bool self)) (not (eq? precision None)))
- (- 1 precision)
- 1))
+ ;; special case: zeros with a positive exponent can't be
+ ;; represented in fixed point; rescale them to 0e0.
+ (if (and (not (bool self)) (> (ref self '_exp) 0) (in type "fF%"))
+ (set! self ((ref self '_rescale) 0 rounding)))
+
+ ;; figure out placement of the decimal point
+ (let* ((leftdigits (+ (ref self '_exp) (len (ref self '_int))))
+ (dotplace
+ (cond
+ ((in type "eE")
+ (if (and (not (bool self)) (not (eq? precision None)))
+ (- 1 precision)
+ 1))
((in type "fF%")
leftdigits)
((in type "gG")
@@ -4171,30 +4227,30 @@ This is the copyright information of the file ported over to scheme
leftdigits
1))
(else
- 1)))))
+ 1))))
- ;; find digits before and after decimal point, and get exponent
- (call-with-values
- (lambda ()
- (cond
- ((< dotplace 0)
- (values '0'
- (+ (* "0" (- dotplace)) (ref self '_int))))
- ((> dotplace (len (ref self '_int)))
- (values (+ (ref self '_int) (* "0" (- dotplace
- (len (ref self '_int)))))
- ""))
- (else
- (values
- (or (bool (pylist-splice (ref self '_int) None dotplace None))
- "0")
- (pylist-splice (ref self '_int) dotplace None None)))))
- (lambda (intpart fracpart)
- (let ((exp (- leftdigits dotplace)))
- ;; 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))))))))
-
+ ;; find digits before and after decimal point, and get exponent
+ (call-with-values
+ (lambda ()
+ (cond
+ ((< dotplace 0)
+ (values '0'
+ (+ (* "0" (- dotplace)) (ref self '_int))))
+ ((> dotplace (len (ref self '_int)))
+ (values (+ (ref self '_int) (* "0" (- dotplace
+ (len (ref self '_int)))))
+ ""))
+ (else
+ (values
+ (or (bool (pylist-slice (ref self '_int) None dotplace None))
+ "0")
+ (pylist-slice (ref self '_int) dotplace None None)))))
+ (lambda (intpart fracpart)
+ (let ((exp (- leftdigits dotplace)))
+ ;; 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,
@@ -6637,7 +6693,7 @@ This is the copyright information of the file ported over to scheme
(
(?=\\d|\\.\\d) # ...a number (with at least one digit)
(?P<int>\\d*) # having a (possibly empty) integer part
- (\.(?P<frac>\\d*))? # followed by an optional fractional part
+ (\\.(?P<frac>\\d*))? # followed by an optional fractional part
(E(?P<exp>[-+]?\\d+))? # followed by an optional exponent, or...
|
Inf(inity)? # ...an infinity, or...
@@ -6670,11 +6726,11 @@ This is the copyright information of the file ported over to scheme
(?P<align>[<>=^])
)?
(?P<sign>[-+ ])?
-(?P<alt>\#)?
+(?P<alt>\\#)?
(?P<zeropad>0)?
(?P<minimumwidth>(?!0)\\d+)?
(?P<thousands_sep>,)?
-(?:\.(?P<precision>0|(?!0)\\d+))?
+(?:\\.(?P<precision>0|(?!0)\\d+))?
(?P<type>[eEfFgGn%])?
\\Z
" (logior VERBOSE DOTALL)))
@@ -6860,7 +6916,7 @@ This is the copyright information of the file ported over to scheme
(set! min_width (- min_width l))
(if (and (= 0 digits) (<= min_width 0))
(break))
- (set! min_width (. min_width (len sep))))
+ (set! min_width (- min_width (len sep))))
#:final
(let ((l (max (len digits) min_width 1)))
((ref groups 'append) (+ (* "0" (- l (len digits)))
@@ -6946,3 +7002,4 @@ This is the copyright information of the file ported over to scheme
;; _PyHASH_10INV is the inverse of 10 modulo the prime _PyHASH_MODULUS
(define _PyHASH_10INV (py-pow 10 (- _PyHASH_MODULUS 2) _PyHASH_MODULUS))
+|#
diff --git a/modules/language/python/module/sys.scm b/modules/language/python/module/sys.scm
index 1c7d784..7108b45 100644
--- a/modules/language/python/module/sys.scm
+++ b/modules/language/python/module/sys.scm
@@ -1,6 +1,7 @@
(define-module (language python module sys)
#:use-module (rnrs bytevectors)
#:use-module (language python exceptions)
+ #:use-module (language python hash)
#:use-module (language python try)
#:use-module (language python module python)
#:export (argv byteorder copyright implementation
@@ -8,7 +9,7 @@
__stdin__ __stdout__ __stderr__
exit version_info version api_version
warnoptions winver _xoption
- tarcebacklimit platform))
+ tarcebacklimit platform maxsize hash_info))
(define-syntax stdin
(lambda (x)
@@ -61,6 +62,9 @@
(lambda () (values)))
(define dllhandle 0)
+
+(define _ #f)
+
(define displayhook
(lambda (value)
(when (not (eq? value None))
@@ -136,7 +140,7 @@
(define last_value #f)
(define last_traceback #f)
-(define maxsize #f)
+(define maxsize (- (ash 1 63) 2))
(define maxunicode #f)
(define meta_path '())
@@ -145,6 +149,8 @@
(define path_hooks '())
(define path_importer_cache (make-hash-table))
+(define hash_info pyhash-N)
+
(define platform "linux")
(define prefix "")