summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/list.scm19
-rw-r--r--modules/language/python/module/decimal.scm113
-rw-r--r--modules/language/python/module/re/parser.scm10
-rw-r--r--modules/language/python/number.scm25
-rw-r--r--modules/language/python/string.scm8
-rw-r--r--modules/oop/pf-objects.scm17
6 files changed, 112 insertions, 80 deletions
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 125a874..5bdf85a 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -24,6 +24,20 @@
(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)
@@ -773,8 +787,9 @@
(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))
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm
index db65fb0..6d0d21a 100644
--- a/modules/language/python/module/decimal.scm
+++ b/modules/language/python/module/decimal.scm
@@ -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
diff --git a/modules/language/python/module/re/parser.scm b/modules/language/python/module/re/parser.scm
index 89462ae..9ecc756 100644
--- a/modules/language/python/module/re/parser.scm
+++ b/modules/language/python/module/re/parser.scm
@@ -81,9 +81,13 @@
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)
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index 6e45fd2..eb0d0d5 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -306,29 +306,36 @@
(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)
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index ad47a20..81b5a06 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -536,9 +536,13 @@
((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)
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 25c4960..579a148 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -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))
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 18:26:19 +0000