debuggings
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 3 Aug 2018 15:20:07 +0000 (17:20 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Fri, 3 Aug 2018 15:20:07 +0000 (17:20 +0200)
modules/language/python/list.scm
modules/language/python/module/decimal.scm
modules/language/python/module/re/parser.scm
modules/language/python/number.scm
modules/language/python/string.scm
modules/oop/pf-objects.scm

index 125a874841e03c092a6d82c14b02f89f29768fbe..5bdf85a3d0a347686f200d7427eb80f43ed5c25f 100644 (file)
 
 (define scm-list list)
 
+(define-method (+ (x <null>) (y <pair>))
+  (let lp ((l y))
+    (if (pair? l)
+       (cons (car l) (lp (cdr l)))
+       '())))
+
+(define-method (+ (x <pair>) (y <null>))
+  (let lp ((l x))
+    (if (pair? l)
+       (cons (car l) (lp (cdr l)))
+       '())))
+
+(define-method (in x (y <null>)) #f)
+
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-class <py-list>  () vec n)
        (it)
        (next-method)))
 
-(define-method (in x (l <py-tuple>)) (member x (slot-ref l 'l)))
-(define-method (in x (l <pair>))     (member x l))
+(define (bo x) (if x #t #f))
+(define-method (in x (l <py-tuple>)) (bo (member x (slot-ref l 'l))))
+(define-method (in x (l <pair>))     (bo  (member x l)))
 (define-method (in x (l <vector>))
   (define n (vector-length l))
   (let lp ((i 0))
index db65fb0ac450b740cc2875ed3a337aee4655d002..6d0d21a7664a969ca30206c04f0ab3b8dbdd3b36 100644 (file)
@@ -49,7 +49,6 @@
           ;; 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)))
 
 #|
@@ -77,10 +76,9 @@ 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"))
-(pk 2)
+
 ;; Rounding
 (define ROUND_DOWN      'ROUND_DOWN)
 (define ROUND_HALF_UP   'ROUND_HALF_UP)
@@ -90,20 +88,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))
@@ -367,24 +365,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
-            Underflow InvalidOperation Subnormal FloatOperation))
-(pk 8)
+  (list Clamped DivisionByZero Inexact Overflow Rounded
+       Underflow InvalidOperation Subnormal FloatOperation))
+
 ;; 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
@@ -394,7 +392,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
@@ -591,7 +589,7 @@ This is the copyright information of the file ported over to scheme
        (else
         (raise (TypeError
                 (format #f "Cannot convert ~a to Decimal" value))))))
-(pk 12)
+
 (define-inlinable (divmod x y)
   (values (quotient x y) (modulo x y)))
 
@@ -686,7 +684,7 @@ This is the copyright information of the file ported over to scheme
        ((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."
     
@@ -710,7 +708,7 @@ This is the copyright information of the file ported over to scheme
        ((self a b)
        (_mk self __init__ a b))))
 
-    (define from_float (pk 1
+    (define from_float
       (classmethod
        (lambda (cls f)
         "Converts a float to a decimal number, exactly.
@@ -771,7 +769,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)
@@ -789,7 +787,7 @@ This is the copyright information of the file ported over to scheme
               (else         0)))
            0)))
     
-    (define _isinfinity (pk 1 1
+    (define _isinfinity 
       (lambda (self)
         "Returns whether the number is infinite
 
@@ -801,7 +799,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))
@@ -878,13 +876,13 @@ This is the copyright information of the file ported over to scheme
               (else 0))
              0))))
 
-    (define __bool__ (pk 1 2
+    (define __bool__
       (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)
@@ -984,7 +982,7 @@ This is the copyright information of the file ported over to scheme
               #f)
              (else (= ((ref self '_cmp) other) 0))))))
 
-    (define _xlt (pk 1 3
+    (define _xlt 
       (lambda (<)
        (lam (self other (= context None))
             (let* ((so (_convert_for_comparison self other #:equality_op #t))
@@ -996,14 +994,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__ (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 (pk 1 4
+    (define compare 
       (lam (self other (= context None))
         "Compare self to other.  Return a decimal value:
 
@@ -1019,7 +1017,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)
@@ -1099,11 +1097,11 @@ This is the copyright information of the file ported over to scheme
              (values (numerator x)
                      (denominator x))))))
     
-    (define __repr__ (pk 1 5
+    (define __repr__
       (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))
@@ -1204,7 +1202,7 @@ This is the copyright information of the file ported over to scheme
            
            ((ref ans '_fix) context)))))
 
-    (define __pos__ (pk 1 6
+    (define __pos__
       (lam (self (= context None))
         "Returns a copy, unless it is a sNaN.
 
@@ -1225,7 +1223,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))
@@ -1350,7 +1348,7 @@ This is the copyright information of the file ported over to scheme
           (set! ans (Decimal result))
           ((ref ans '_fix) context)))))
 
-    (define __radd__ __add__)
+    (define __radd__ (lambda x (apply __add__ x)))
 
     (define __sub__
       (lam (self other (= context None))
@@ -1606,7 +1604,7 @@ 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 (pk 2
+    (define remainder_near
       (lam (self other (= context None))
         "
         Remainder nearest to 0-  abs(remainder-near) <= other/2
@@ -1681,7 +1679,7 @@ 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__
       (lam (self other (= context None))
@@ -2210,7 +2208,7 @@ This is the copyright information of the file ported over to scheme
           
           (_dec_from_triple sign (str base) 0)))))
 
-    (define _power_exact (pk 3
+    (define _power_exact 
       (lambda (self other p)
         "Attempt to compute self**other exactly.
 
@@ -2509,7 +2507,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))
@@ -2958,7 +2956,7 @@ This is the copyright information of the file ported over to scheme
                           rounding)))
            ans)))))
 
-    (define to_integral_exact (pk 4
+    (define to_integral_exact
       (lam (self (= rounding None) (= context None))
         "Rounds to a nearby integer.
 
@@ -2992,7 +2990,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))
@@ -3475,14 +3473,14 @@ This is the copyright information of the file ported over to scheme
           (set context 'rounding rounding)
           ans))))
     
-    (define is_canonical (pk 5
+    (define is_canonical
       (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)
@@ -3827,9 +3825,9 @@ This is the copyright information of the file ported over to scheme
                       (list->string (reverse l))))
              0)))))))
 
-    (define logical_and (logical_* logand))
-    (define logical_or  (logical_* logior))
-    (define logical_xor (logical_* logxor))
+    (define logical_and (lambda x (apply (logical_* logand) x)))
+    (define logical_or  (lambda x (apply (logical_* logior) x)))
+    (define logical_xor (lambda x (apply (logical_* logxor) x)))
     
     (define logical_invert
       (lam (self (= context None))
@@ -3875,8 +3873,8 @@ This is the copyright information of the file ported over to scheme
                 
           ((ref ans '_fix) context))))))
 
-    (define max_mag (x_mag (lambda (x) x)))
-    (define min_mag (x_mag not))
+    (define max_mag (lambda y (apply (x_mag (lambda (x) x)) y)))
+    (define min_mag (lambda y (apply (x_mag not) y)))
       
     (define next_minus
       (lam (self (= context None))
@@ -3981,7 +3979,7 @@ This is the copyright information of the file ported over to scheme
 
          ans))))
 
-    (define number_class (pk 6
+    (define number_class
       (lam (self (= context None))
         "Returns an indication of the class of self.
 
@@ -4022,7 +4020,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)
@@ -4278,7 +4276,7 @@ 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).
@@ -4307,9 +4305,12 @@ 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)))
+  (if (eq? q None)
+      (if (bool m)
+         (set s 'q  (ref m 'q)))
+      (set s 'q q)))
 
 (define-python-class Context (object)
     "Contains the context for a Decimal instance.
@@ -4343,7 +4344,7 @@ This is the copyright information of the file ported over to scheme
          (setq self Emax     dc)
          (setq self capitals dc)
          (setq self clamp    dc)
-
+         
          (set self '_ignored_flags
               (if (eq? _ignored_flags None)
                   (py-list)
@@ -4417,11 +4418,11 @@ This is the copyright information of the file ported over to scheme
         ((equal? name "clamp")
          ((ref self '_set_integer_check) name value 0 1))
         ((equal? name "rounding")
-         (if (not (member (string->symbol value) _rounding_modes))
+         (if (not (member value _rounding_modes))
              ;; raise TypeError even for strings to have consistency
              ;; among various implementations.
              (raise (TypeError (format #f "~a: invalid rounding mode" value))))
-         (rawset self (string->symbol name) (string->symbol value)))
+         (rawset self (string->symbol name) value))
         ((or (equal? name "flags") (equal? name "traps"))
          ((ref self '_set_signal_dict) name value))
         ((equal? name "_ignored_flags")
@@ -6215,7 +6216,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
@@ -6446,7 +6447,7 @@ This is the copyright information of the file ported over to scheme
            (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
@@ -6662,7 +6663,7 @@ This is the copyright information of the file ported over to scheme
    #:Emin    -999999
    #:capitals 1
    #:clamp    0))
-
+(pk 3 1)
 ;; Pre-made alternate contexts offered by the specification
 ;; Don't change these; the user should be able to select these
 ;; contexts and be able to reproduce results from other implementations
@@ -6674,7 +6675,7 @@ This is the copyright information of the file ported over to scheme
    #:rounding ROUND_HALF_UP
    #:traps    (list DivisionByZero Overflow InvalidOperation Clamped Underflow)
    #:flags    '()))
-
+(pk 3 2)
 (define ExtendedContext
   (Context
    #:prec     9
index 89462ae5732bfbc2905f95b96a9b14f5dc90824b..9ecc75644ab33b5ff9eef5d55219128d5c14a7a1 100644 (file)
                     lookh lookh! rev rev! f-^ f-$ flags))
 (define spec   (f-list #:op atom (f-or! q+? q?? q*? q* q? q+ repn? repnm? repn repnm)))
 (define aatom  (f-or! spec atom))
-(define line   (f-cons* #:seq aatom (ff* aatom )))
+(define f-com  (f-seq (f-tag "#") (f* (f-not (f-or! f-eof f-nl)))))
+(define ws     (f* (f-or! f-com f-nl (f-reg "[ \t\r]"))))
+(define line   (f-cons* #:seq ws aatom ws (ff* (f-seq ws aatom ws) )))
 (define ee     (f-cons* #:or line (ff* (f-seq f-bar line))))
-
-(define (parse-reg str) (pk (parse str (f-seq ee f-eof))))
+(define (parse-reg str)
+  (pk
+   (with-fluids ((*whitespace* ws))
+     (parse str (f-seq ee f-eof)))))
 
 (define e-matcher ee)
index 6e45fd21e22c4b4d85631bee4c2ef6835da4244a..eb0d0d5f8a7c7dc7adfff3007a736d1c33f4ec41 100644 (file)
   (apply write (slot-ref o 'x) l))
 
 (define-python-class int (<py> <py-int>)
-  (define __init__
-    (letrec ((__init__
+  (define __new__
+    (letrec ((__new__
               (case-lambda
                 ((self)
-                 (__init__ self 0))
+                 0)
                 
                 ((self n)
                  (let lp ((n n))
                    (cond
                     ((and (number? n) (integer? n))
-                     (slot-set! self 'x n))
+                     n)
+                   ((boolean? n)
+                    (if n 1 0))
                     ((number? n)
                      (lp (py-floor n)))
                     ((string? n)
                      (lp (string->number n)))
                     (else
-                     (aif it (slot-ref n '__int__)
-                          (slot-set! self 'x it)
-                          (raise ValueError "could not make int from " n))))))
+                    (catch #t
+                      (lambda ()
+                        (aif it (slot-ref n '__int__)
+                             it
+                             (raise (ValueError (py-mod "could not make int from %r"
+                                                        (list n))))))
+                      (lambda z (raise (ValueError (py-mod "could not make int from %r"
+                                                           (list n))))))))))
       
                 ((self n k)
-                 (__init__ self (string->number n k))))))
-      __init__)))
+                 (__new__ self (string->number n k))))))
+      __new__)))
 
 (name-object int)
 
index ad47a20ee198628afbde2eb5d744a8839e1ae445..81b5a063382ec32df2eeac5a58058e862eb0fcd3 100644 (file)
       ((self s)
        (cond
         ((is-a? s <py-string>)
-         (slot-set! self 'str (slot-ref s 'src)))
+         (slot-ref s 'src))
         ((is-a? s <string>)
-         (slot-set! self 'str s))))))
+         s)
+       (else
+        (__init__ self ((@ (guile) format) #f "~a" s)))))))
+  
+  (define __new__ (lambda x (apply __init__ x)))
 
   (define __repr__
     (lambda (self)
index 25c49603ce16f902e5250f452797ca8df752c790..579a148b817919fef8ac148f9286c888498e5d8a 100644 (file)
@@ -372,15 +372,16 @@ explicitly tell it to not update etc.
                      (apply it class x)
                      (make-object class meta goops))))
 
-    (aif it (ficap class '__init__ #f)
-         (apply it obj x)
-         #f)
+    (when (struct? obj)
+      (aif it (ficap class '__init__ #f)
+          (apply it obj x)
+          #f)
 
-    (slot-set! obj 'procedure
-               (lambda x
-                 (aif it (ref obj '__call__)
-                      (apply it x)
-                      (error "not a callable object"))))
+      (slot-set! obj 'procedure
+                (lambda x
+                  (aif it (ref obj '__call__)
+                       (apply it x)
+                       (error "not a callable object")))))
     
     obj))