decimals division
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 14 Aug 2018 14:17:27 +0000 (16:17 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 14 Aug 2018 14:17:27 +0000 (16:17 +0200)
modules/language/python/bytes.scm
modules/language/python/compile.scm
modules/language/python/module/decimal.scm
modules/language/python/string.scm

index 4ba7d2beb65315e4db241b132223f1cfbd4a0649..d9ccab26cc9dc5551f0dc3f41113752cb1d284cb 100644 (file)
        (set! errors   (cond
                        ((equal? errors "strict")
                         'error)
+                       ((equal? errors "escape")
+                        'escape)
                        ((equal? errors "replace")
                         'substitute)
                        ((equal? errors "ignore")
                            __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
index 42da12829c188714341c1483caf8bb99268358cc..087d22799607c74c74bab09091e86f54ec72bd85 100644 (file)
@@ -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))"))
index bd309ddbe82945be9681333b17d45546bf4dafca..ee7db1afdb7e098f69809578df8d0bc21b9883e1 100644 (file)
@@ -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 ############################################
index c1d7d1b47b5b77197123b3d697b53db8e9007753..7ed0193024ccd7803f784777a680f03bfdb3b384 100644 (file)
   (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")
                            __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