summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/bytes.scm4
-rw-r--r--modules/language/python/compile.scm2
-rw-r--r--modules/language/python/module/decimal.scm270
-rw-r--r--modules/language/python/string.scm6
4 files changed, 150 insertions, 132 deletions
diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm
index 4ba7d2b..d9ccab2 100644
--- a/modules/language/python/bytes.scm
+++ b/modules/language/python/bytes.scm
@@ -607,6 +607,8 @@
(set! errors (cond
((equal? errors "strict")
'error)
+ ((equal? errors "escape")
+ 'escape)
((equal? errors "replace")
'substitute)
((equal? errors "ignore")
@@ -1335,7 +1337,7 @@
__repr__ __rmod__ __rmul__ __setattr__ __sizeof__
__bytes__ __subclasshook__
_formatter_field_name_split _formatter_parser
- capitalize center count decode encode endswith
+ capitalize center count decode endswith
expandtabs find format index isalnum isalpha
isdigit islower isspace istitle isupper join
ljust lower lbytesip partition replace rfind rindex
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 42da128..087d227 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -50,6 +50,8 @@
(warn "failed to load " x)
(raise (ImportError '(a ...))))))
+(define level (make-fluid 0))
+
(define s/d 'set!)
(define (pre) (warn "Patching guile will lead to way better experience use 'python.patch' on guile-2.2 e.g. (use-modules (language python guilemod))"))
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm
index bd309dd..ee7db1a 100644
--- a/modules/language/python/module/decimal.scm
+++ b/modules/language/python/module/decimal.scm
@@ -50,7 +50,9 @@
;; 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)))
+(define-syntax-rule (aif it p . l) (let ((it p)) (if (bool it) . l)))
+
+(define-syntax-rule (D x) (lambda () x))
#|
This is the copyright information of the file ported over to scheme
@@ -523,8 +525,8 @@ This is the copyright information of the file ported over to scheme
;; From an internal working value
((isinstance value _WorkRep)
- (set self '_exp (int (ref value '_exp)))
- (set self '_sign (ref value '_sign))
+ (set self '_exp (int (ref value 'exp)))
+ (set self '_sign (ref value 'sign))
(set self '_int (str (ref value 'int)))
(set self '_is_special #f))
@@ -691,7 +693,8 @@ This is the copyright information of the file ported over to scheme
((bool ((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))))
+ #f))
(define-python-class Decimal (object)
@@ -826,7 +829,7 @@ This is the copyright information of the file ported over to scheme
#f
((ref other '_isnan)))))
- (if (or self_is_nan other_is_nan)
+ (if (or (bool self_is_nan) (bool other_is_nan))
(let ((context (if (eq? context None)
(getcontext)
context)))
@@ -835,7 +838,7 @@ This is the copyright information of the file ported over to scheme
((cx-error context) InvalidOperation "sNaN" self))
((eq? other_is_nan 2)
((cx-error context) InvalidOperation "sNaN" other))
- (self_is_nan
+ ((bool self_is_nan)
((ref self '_fix_nan) context))
(else
((ref other '_fix_nan) context))))
@@ -973,15 +976,14 @@ This is the copyright information of the file ported over to scheme
;; <, >, <= and >= comparisons involving a (quiet or signaling)
;; NaN signal InvalidOperation, and return False if the
;; InvalidOperation is not trapped.
- ;;
- ;; This behavior is designed to conform as closely as possible to
+ ;; ;; This behavior is designed to conform as closely as possible to
;; that specified by IEEE 754.
(define __eq__
(lam (self other (= context None))
(let* ((so (_convert_for_comparison self other #:equality_op #t))
- (self (car so))
- (other (cadr so)))
+ (self (car so))
+ (other (cdr so)))
(cond
((eq? other NotImplemented)
@@ -994,8 +996,8 @@ This is the copyright information of the file ported over to scheme
(lambda (<)
(lam (self other (= context None))
(let* ((so (_convert_for_comparison self other #:equality_op #t))
- (self (car so))
- (other (cadr so)))
+ (self (car so))
+ (other (cdr so)))
(cond
((eq? other NotImplemented)
@@ -1023,9 +1025,10 @@ This is the copyright information of the file ported over to scheme
(if (or (ref self '_is_special)
(and (bool other)
(ref other '_is_special)))
- (aif it ((ref self '_check_nans) other context)
- it
- (Decimal ((ref self '_cmp) other)))))))
+ (let ((it ((ref self '_check_nans) other context)))
+ (if (bool it)
+ it
+ (Decimal ((ref self '_cmp) other))))))))
(define __hash__
(lambda (self)
@@ -1193,21 +1196,22 @@ This is the copyright information of the file ported over to scheme
Rounds, if it has reason.
"
+ (pk '__neg__)
(twix
- ((un-special self context) it it)
- (let* ((context (if (eq? context None)
- (getcontext)
- context))
- (ans (if (and (not (bool self))
- (not (eq? (cx-rounding context)
- ROUND_FLOOR)))
- ;; -Decimal('0') is Decimal('0'),
- ;; not Decimal('-0'), except
- ;; in ROUND_FLOOR rounding mode.
- ((ref self 'copy_abs))
- ((ref self 'copy_negate)))))
-
- ((ref ans '_fix) context)))))
+ ((un-special self context) it it)
+ (let () (pk 1))
+ (let* ((context (if (eq? context None)
+ (getcontext)
+ context))
+ (ans (if (pk (and (not (bool self))
+ (not (eq? (cx-rounding context)
+ ROUND_FLOOR))))
+ ;; -Decimal('0') is Decimal('0'),
+ ;; not Decimal('-0'), except
+ ;; in ROUND_FLOOR rounding mode.
+ ((pk (ref self 'copy_abs)))
+ ((pk (ref self 'copy_negate))))))
+ ((ref ans '_fix) context)))))
(define __pos__
(lam (self (= context None))
@@ -1258,15 +1262,11 @@ This is the copyright information of the file ported over to scheme
-INF + INF (or the reverse) cause InvalidOperation errors.
"
(twix
- (let () (pk 1 1 other))
((norm-op self other) it it)
- (let () (pk 1 2))
(let (get-context context))
- (let () (pk 1 3))
+
((add-special self other context) it it)
- (let () (pk 1 4))
-
(let* ((negativezero 0)
(self_sign (ref self '_sign))
(other_sign (ref other '_sign))
@@ -1282,7 +1282,7 @@ This is the copyright information of the file ported over to scheme
;; If the answer is 0, the sign should be negative,
;; in this case.
(set! negativezero 1)))
- (let () (pk 1 5))
+
((if (and (not (bool self)) (not (bool other)))
(begin
(set! sign ((@ (guile) min) self_sign other_sign))
@@ -1292,7 +1292,7 @@ This is the copyright information of the file ported over to scheme
(set! ans ((ref ans '_fix) context))
ans)
#f) it it)
- (let () (pk 1 6))
+
((if (not (bool self))
(begin
(set! exp ((@ (guile) max) exp (- other_exp prec 1)))
@@ -1301,7 +1301,7 @@ This is the copyright information of the file ported over to scheme
(set! ans ((ref ans '_fix) context))
ans)
#f) it it)
- (let () (pk 1 7))
+
((if (not (bool other))
(begin
(set! exp ((@ (guile) max) exp (- self_exp prec 1)))
@@ -1311,28 +1311,24 @@ This is the copyright information of the file ported over to scheme
ans)
#f) it it)
- (let () (pk 1 8))
-
(let* ((op1 (_WorkRep self))
(op2 (_WorkRep other))
(ab (_normalize op1 op2 prec))
- (op1_i (car ab))
- (op2_i (cdr ab))
+ (op1 (car ab))
+ (op2 (cdr ab))
(result (_WorkRep))))
- (let () (pk 1 9))
-
((cond
((not (= (ref op1 'sign) (ref op2 'sign)))
;; Equal and opposite
(twix
- ((= op1_i op2_i) it
+ ((equal? self other) it
(set! ans (_dec_from_triple negativezero "0" exp))
(set! ans ((ref ans '_fix) context))
ans)
(begin
- (if (< op1_i op2_i)
+ (if (< self other)
(let ((t op1))
(set! op1 op2)
(set! op2 t)))
@@ -1352,8 +1348,6 @@ This is the copyright information of the file ported over to scheme
(set result 'sign 0)
#f)) it it)
- (let () (pk 1 10))
-
(begin
(if (= (ref op2 'sign) 0)
(set result 'int (+ (ref op1 'int) (ref op2 'int)))
@@ -1376,10 +1370,10 @@ This is the copyright information of the file ported over to scheme
(define __rsub__
(lam (self other (= context None))
- "Return other - self"
+ "Return other - self"
(twix
((norm-op self other) it it)
- ((ref 'other '__sub__) self #:context context))))
+ ((ref other '__sub__) self #:context context))))
(define __mul__
(lam (self other (= context None))
@@ -1431,57 +1425,57 @@ This is the copyright information of the file ported over to scheme
(let ((sign (logxor (ref self '_sign)
(ref other '_sign)))))
- ((div-special self other context sign) it it)
+ ((div-special self other context sign) it it)
;; Special cases for zeroes
- ((if (not (bool other))
- (if (not (bool self))
- ((cx-error context) DivisionUndefined "0 / 0")
- ((cx-error context) DivisionByZero "x / 0" sign))
- #f) it it)
+ ((if (not (bool other))
+ (if (not (bool self))
+ ((cx-error context) DivisionUndefined "0 / 0")
+ ((cx-error context) DivisionByZero "x / 0" sign))
+ #f) it it)
- (let ((exp #f)
- (coeff #f)
- (prec (cx-prec context))
- (nself (len (ref self '_int)))
- (nother (len (ref other '_int))))
- (if (not (bool self))
- (begin
- (set! exp (- (ref self '_exp) (ref other '_exp)))
- (set! coeff 0))
- ;; OK, so neither = 0, INF or NaN
- (let ((shift (+ nother (- nself) prec 1))
- (op1 (_WorkRep self))
- (op2 (_WorkRep other)))
- (set! exp (- (ref self '_exp) (ref other '_exp) shift))
- (call-with-values
- (lambda ()
- (if (>= shift 0)
- (divmod (* (ref op1 'int) (expt 10 shift))
- (ref op2 'int))
- (divmod (ref op1 'int)
- (* (ref op2 'int) (expt 10 shift)))))
- (lambda (coeff- remainder)
- (set! coeff
- (if (not (= remainder 0))
- ;; result is not exact adjust to ensure
- ;; correct rounding
- (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- ideal_exp)
- (= (modulo coeff 10) 0))
- (lp (/ coeff 10) (+ exp- 1))
- (begin
- (set exp exp-)
- coeff))))))))))
+ (let ((exp #f)
+ (coeff #f)
+ (prec (cx-prec context))
+ (nself (len (ref self '_int)))
+ (nother (len (ref other '_int))))
+ (if (not (bool self))
+ (begin
+ (set! exp (- (ref self '_exp) (ref other '_exp)))
+ (set! coeff 0))
+ ;; OK, so neither = 0, INF or NaN
+ (let ((shift (+ nother (- nself) prec 1))
+ (op1 (_WorkRep self))
+ (op2 (_WorkRep other)))
+ (set! exp (- (ref self '_exp) (ref other '_exp) shift))
+ (call-with-values
+ (lambda ()
+ (if (>= shift 0)
+ (divmod (* (ref op1 'int) (expt 10 shift))
+ (ref op2 'int))
+ (divmod (ref op1 'int)
+ (* (ref op2 'int) (expt 10 shift)))))
+ (lambda (coeff- remainder)
+ (set! coeff
+ (if (not (= remainder 0))
+ ;; result is not exact adjust to ensure
+ ;; correct rounding
+ (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- ideal_exp)
+ (= (modulo coeff- 10) 0))
+ (lp (/ coeff- 10) (+ exp- 1))
+ (begin
+ (set! exp exp-)
+ coeff-))))))))))
-
- (let ((ans (_dec_from_triple sign (str coeff) exp)))
- ((ref ans '_fix) context))))))
+
+ (let ((ans (_dec_from_triple sign (str coeff) exp)))
+ ((ref ans '_fix) context))))))
(define _divide
(lambda (self other context)
@@ -1805,19 +1799,20 @@ This is the copyright information of the file ported over to scheme
"
(twix
- (((ref self '_is_special)) it
+ (let () (pk 3 1))
+ ((ref self '_is_special) it
(if ((ref self '_isnan))
;; decapitate payload if necessary
((ref self '_fix_nan) context)
;; self is +/-Infinity; return unaltered
(Decimal self)))
-
+ (let () (pk 3 2))
;; if self is zero then exponent should be between Etiny and
;; Emax if clamp==0, and between Etiny and Etop if clamp==1.
(let ((Etiny (cx-etiny context))
(Etop (cx-etop context))))
-
+ (let () (pk 3 3))
((not (bool self)) it
(let* ((exp_max (if (= (cx-clamp context) 0)
(cx-emax context)
@@ -1828,7 +1823,7 @@ This is the copyright information of the file ported over to scheme
((cx-error context) Clamped)
(_dec_from_triple (ref self '_sign) "0" new_exp))
(Decimal self))))
-
+ (let () (pk 3 4))
;; exp_min is the smallest allowable exponent of the result,
;; equal to max(self.adjusted()-context.prec+1, Etiny)
(let ((exp_min (+ (len (ref self '_int))
@@ -1841,27 +1836,33 @@ This is the copyright information of the file ported over to scheme
((cx-error context) Inexact)
((cx-error context) Rounded)
ans))
-
+ (let () (pk 3 5))
(let* ((self_is_subnormal (< exp_min Etiny))
(exp_min (if self_is_subnormal Etiny exp_min))))
-
+ (let () (pk 3 6))
;; round if self has too many digits
((< (ref self '_exp) exp_min) it
(let ((digits (+ (len (ref self '_int))
(ref self '_exp)
(- exp_min))))
+ (pk 3 7)
(if (< digits 0)
(set! self (_dec_from_triple (ref self '_sign)
"1" (- exp_min 1)))
(set! digits 0))
+ (for ((k v : (ref self '_pick_rounding_function))) ()
+ (pk k (v)))
+
+ (pk 3 8)
(let* ((ans #f)
- (rounding_method (pylist-ref
+ (rounding_method (pk 'me (pylist-ref
(ref self '_pick_rounding_function)
- (cx-rounding context)))
+ (pk 'r (cx-rounding context)))))
(changed (rounding_method self digits))
(coeff (or (bool (pylist-slice (ref self '_int)
None digits None)) "0")))
+ (pk 3 9)
(if (> changed 0)
(begin
(set! coeff (str (+ (int coeff) 1)))
@@ -1869,42 +1870,50 @@ This is the copyright information of the file ported over to scheme
(begin
(set! coeff (pylist-slice coeff None -1 None))
(set! exp_min (+ exp_min 1))))))
-
+ (pk 3 10)
;; check whether the rounding pushed the exponent out of range
(if (> exp_min Etop)
(set! ans
((cx-error context) Overflow "above Emax"
(ref self '_sign)))
(set! ans (_dec_from_triple (ref self '_sign) coeff exp_min)))
-
+ (pk 3 11)
;; raise the appropriate signals, taking care to respect
;; the precedence described in the specification
(if (and changed self_is_subnormal)
((cx-error context) Underflow))
+ (pk 3 12)
(if self_is_subnormal
((cx-error context) Subnormal))
+ (pk 3 13)
(if changed
((cx-error context) Inexact))
-
+ (pk 3 14)
((cx-error context) Rounded)
+ (pk 3 15)
(if (not (bool ans))
;; raise Clamped on underflow to 0
((cx-error context) Clamped))
ans)))
+
+ (let () (pk 3 7))
+
(begin
(if self_is_subnormal
((cx-error context) Subnormal))
-
+ (let () (pk 4))
;; fold down if clamp == 1 and self has too few digits
(if (and (= (cx-clamp context) 1) (> (ref self '_exp) Etop))
(begin
((cx-error context) Clamped)
+ (let () (pk 5))
(let ((self_padded (+ (ref self '_int)
(* "0"
(- (ref self '_exp) Etop)))))
+ (let () (pk 6))
(_dec_from_triple (ref self '_sign) self_padded Etop)))
;; here self was representable to begin with; return unchanged
@@ -1981,15 +1990,6 @@ This is the copyright information of the file ported over to scheme
(_round_down self prec)
(- (_round_down self prec)))))
- (define _pick_rounding_function
- (dict `((,ROUND_DOWN . ,_round_down )
- (,ROUND_UP . ,_round_up )
- (,ROUND_HALF_UP . ,_round_half_up)
- (,ROUND_HALF_DOWN . ,_round_half_down)
- (,ROUND_HALF_EVEN . ,_round_half_even)
- (,ROUND_CEILING . ,_round_ceiling)
- (,ROUND_FLOOR . ,_round_floor)
- (,ROUND_05UP . ,_round_05up))))
(define __round__
(lam (self (= n None))
@@ -2524,6 +2524,16 @@ This is the copyright information of the file ported over to scheme
0)))
(_dec_from_triple 0 (+ str_xc (* '0' zeros)) (- xe zeros)))))))
+ (define _pick_rounding_function
+ (dict `((,ROUND_DOWN . ,(D _round_down))
+ (,ROUND_UP . ,(D _round_up ))
+ (,ROUND_HALF_UP . ,(D _round_half_up))
+ (,ROUND_HALF_DOWN . ,(D _round_half_down))
+ (,ROUND_HALF_EVEN . ,(D _round_half_even))
+ (,ROUND_CEILING . ,(D _round_ceiling))
+ (,ROUND_FLOOR . ,(D _round_floor))
+ (,ROUND_05UP . ,(D _round_05up)))))
+
(define __pow__
(lam (self other (= modulo None) (= context None))
"Return self ** other [ % modulo].
@@ -2933,7 +2943,7 @@ This is the copyright information of the file ported over to scheme
(let* ((this_function (pylist-ref (ref self '_pick_rounding_function)
rounding))
- (changed (this_function self digits))
+ (changed ((this_function) self digits))
(coeff (or (bool
(pylist-slice _int None digits None))
"0")))
@@ -3593,34 +3603,36 @@ This is the copyright information of the file ported over to scheme
(twix
(let (get-context context))
-
+ (let () (pk 4 1))
;; ln(NaN) = NaN
(let ((ans ((ref self '_check_nans) #:context context))))
+ (let () (pk 4 1.2 ans))
(ans it it)
+ (let () (pk 4 2))
;; ln(0.0) == -Infinity
((not (bool self)) it
_NegativeInfinity)
-
+ (let () (pk 4))
;; ln(Infinity) = Infinity
((= ((ref self '_isinfinity)) 1) it
_Infinity)
-
+ (let () (pk 4 3))
;; ln(1.0) == 0.0
((equal? self _One) it
_Zero)
-
+ (let () (pk 4 4))
;; ln(negative) raises InvalidOperation
(if (= (ref self '_sign) 1)
((cx-error context) InvalidOperation
"ln of a negative value"))
-
+ (let () (pk 4 5))
;; result is irrational, so necessarily inexact
(let* ((op (_WorkRep self))
(c (ref op 'int))
(e (ref op 'exp))
(p (cx-prec context))))
-
+ (let () (pk 4 6))
;; correctly rounded result: repeatedly increase precision by 3
;; until we get an unambiguously roundable result
@@ -6629,7 +6641,7 @@ This is the copyright information of the file ported over to scheme
"
(cond
((isinstance other Decimal)
- (values self other))
+ (cons self other))
;; Comparison with a Rational instance (also includes integers):
;; self op n/d <=> self*d op n (for n and d integers, d positive).
@@ -6637,12 +6649,12 @@ This is the copyright information of the file ported over to scheme
;; comparison result.
((isinstance other int)
(if (not (bool (ref self '_is_special)))
- (values
+ (cons
(_dec_from_triple (ref self '_sign)
(* (str int (ref self '_int)) (ref other 'denominator))
(ref self '_exp))
(Decimal (ref other 'numerator)))
- (values NotImplemented NotImplemented)))
+ (cons NotImplemented NotImplemented)))
;; Comparisons with float and complex types. == and != comparisons
;; with complex numbers should succeed, returning either True or False
@@ -6659,8 +6671,8 @@ This is the copyright information of the file ported over to scheme
(pylist-set! (ref context 'flags) FloatOperation 1)
((cx-error context) FloatOperation
"strict semantics for mixing floats and Decimals are enabled"))
- (values self ((ref Decimal 'from_float) other)))
- (values NotImplemented NotImplemented)))))))
+ (cons self ((ref Decimal 'from_float) other)))
+ (cons NotImplemented NotImplemented)))))))
;;##### Setup Specific Contexts ############################################
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index c1d7d1b..7ed0193 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -381,8 +381,10 @@
(apply (lam ((= encoding "UTF-8") (= errors "strict"))
(set! errors (py-lower (scm-str errors)))
(set! errors (cond
- ((equal? errors "strict")
+ ((equal? errors "strict")
'error)
+ ((equal? errors "escape")
+ 'escape)
((equal? errors "replace")
'substitute)
((equal? errors "ignore")
@@ -660,7 +662,7 @@
__repr__ __rmod__ __rmul__ __setattr__ __sizeof__
__str__ __subclasshook__
_formatter_field_name_split _formatter_parser
- capitalize center count decode encode endswith
+ capitalize center count encode endswith
expandtabs find format index isalnum isalpha
isdigit islower isspace istitle isupper join
ljust lower lstrip partition replace rfind rindex
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 18:19:28 +0000