summaryrefslogtreecommitdiff
path: root/modules/language/python
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python')
-rw-r--r--modules/language/python/compile.scm70
-rw-r--r--modules/language/python/module.scm15
-rw-r--r--modules/language/python/module/_python.scm29
-rw-r--r--modules/language/python/module/decimal.scm45
-rw-r--r--modules/language/python/module/python.scm7
5 files changed, 95 insertions, 71 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index de4299d..bbeb069 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -716,6 +716,41 @@
(define inhibit-finally #f)
(define decorations (make-fluid '()))
(define tagis (make-hash-table))
+
+(define (lr as)
+ (lambda (vs x)
+ (define (eval p a b) ((cdr (assoc p as)) a b))
+ (define (expit x)
+ (match x
+ ((#:e e) e)
+ (x (exp vs x))))
+ (let lp ((x x))
+ (match x
+ ((p a b)
+ (if (assoc p as)
+ (match b
+ ((q c d)
+ (if (assoc q as)
+ (lp (list q (list #:e (lp (list p a c))) d))
+ (eval p (expit a) (expit b))))
+ (_ (eval p (expit a) (expit b))))
+ (expit x)))
+ (_ (expit x))))))
+
+(define (mklr x)
+ (lambda (a b)
+ (list x a b)))
+
+(define (f% s a)
+ (if (string? s)
+ (list (F2 'format) s a)
+ (list (N 'py-mod) s a)))
+
+(define lr+ (lr `((#:+ . ,(mklr (G '+))) (#:- . ,(mklr (G '-))))))
+(define lr* (lr `((#:* . ,(mklr (G '*))) (#:/ . ,(mklr (N 'py-/)))
+ (#:% . ,f%) (#:// . ,(mklr (N 'py-floordiv))))))
+
+
(define-syntax-rule (gen-table x vs (tag code ...) ...)
(begin
(hash-set! tagis tag
@@ -780,35 +815,28 @@
(#:+
- ((_ . l)
- (cons '+ (map (g vs exp) l))))
-
+ (x
+ (lr+ vs x)))
(#:-
- ((_ . l)
- (cons '- (map (g vs exp) l))))
+ (x
+ (lr+ vs x)))
(#:*
- ((_ . l)
- (cons '* (map (g vs exp) l))))
+ (x
+ (lr* vs x)))
(#:/
- ((_ . l)
- (cons (N 'py-/) (map (g vs exp) l))))
-
+ (x
+ (lr* vs x)))
+
(#:%
- ((_ s a)
- (let ((s (exp vs s))
- (a (exp vs a)))
- (if (string? s)
- (list (F2 'format) s a)
- (list (N 'py-mod) s a))))
- ((_ . l)
- (cons (N 'py-mod) (map (g vs exp) l))))
+ (x
+ (lr* vs x)))
(#://
- ((_ . l)
- (cons (N 'py-floordiv) (map (g vs exp) l))))
-
+ (x
+ (lr* vs x)))
+
(#:<<
((_ . l)
(cons (N 'py-lshift) (map (g vs exp) l))))
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 680cf15..51270c2 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -143,12 +143,14 @@
(lambda (self k)
(define (fail)
(raise (AttributeError "getattr in Module")))
- (let ((k (_k k))
- (m (_m self)))
- (let ((x (module-ref m k e)))
- (if (eq? e x)
- (fail)
- x)))))
+ (let ((k (_k k)))
+ (let ((x (module-ref (rawref self '_export) k e)))
+ (if (eq? e x)
+ (let ((x (module-ref (_m self) k e)))
+ (if (eq? e x)
+ (fail)
+ x))
+ x)))))
(define __setattr__
(lambda (self k v)
@@ -185,6 +187,7 @@
(set! l (cons (symbol->string k) l))))))
(hash-for-each add h)
(module-for-each add m)
+ (module-for-each add (rawref self '_export))
(py-list l))))
diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm
index d9cb1c9..46f840e 100644
--- a/modules/language/python/module/_python.scm
+++ b/modules/language/python/module/_python.scm
@@ -9,8 +9,6 @@
#:use-module (language python exceptions )
#:use-module ((language python module string ) #:select ())
#:use-module ((language python module io ) #:select (open))
- #:use-module ((language python module sys )
- #:select ((stdout . _stdout)))
#:use-module (language python def )
#:use-module (language python for )
#:use-module (language python try )
@@ -58,18 +56,6 @@
(define vars py-dict)
-(define print
- (lam ((= file _stdout) (* l))
- (if file (set! file (ref file '_port)))
- (with-output-to-port file
- (lambda ()
- (apply
- (case-lambda
- (() ((@ (guile) display) "\n"))
- ((x) ((@ (guile) display) x ) (print))
- (l ((@ (guile) display) l ) (print)))
- l)))))
-
(define (repr x) ((@ (guile) format) #f "~a" x))
(define abs py-abs)
(define str pystring)
@@ -338,3 +324,18 @@
(define-python-class Funcobj ())
+(define print
+ (lam ((= file #f) (* l))
+ (if file
+ (if (port? file)
+ #t
+ (set! file (ref file '_port)))
+ (set! file (current-output-port)))
+ (with-output-to-port file
+ (lambda ()
+ (apply
+ (case-lambda
+ (() ((@ (guile) display) "\n"))
+ ((x) ((@ (guile) display) x ) (print))
+ (l ((@ (guile) display) l ) (print)))
+ l)))))
diff --git a/modules/language/python/module/decimal.scm b/modules/language/python/module/decimal.scm
index 0778da1..e58ba34 100644
--- a/modules/language/python/module/decimal.scm
+++ b/modules/language/python/module/decimal.scm
@@ -607,7 +607,7 @@ This is the copyright information of the file ported over to scheme
(format #f "Cannot convert ~a to Decimal" value))))))
(define-inlinable (divmod x y)
- (values (quotient x y) (modulo x y)))
+ (values (floor-quotient x y) (floor-remainder x y)))
(define-syntax twix
(syntax-rules (when let let* if)
@@ -2125,13 +2125,11 @@ This is the copyright information of the file ported over to scheme
((norm-op self other ) it it)
((norm-op self modulo) it it)
(let (get-context context))
- (let () (pk 1))
;; deal with NaNs: if there are any sNaNs then first one wins,
;; (i.e. behaviour for NaNs is identical to that of fma)
(let ((self_is_nan (ref self '_isnan))
(other_is_nan (ref other '_isnan))
(modulo_is_nan (ref modulo '_isnan))))
- (let () (pk 2))
((or (bool self_is_nan) (bool other_is_nan) (bool modulo_is_nan)) it
(cond
((= self_is_nan 2)
@@ -2146,7 +2144,7 @@ This is the copyright information of the file ported over to scheme
(_fix_nan other context))
(else
(_fix_nan modulo context))))
- (let () (pk 3))
+
;;check inputs: we apply same restrictions as Python's pow()
((not (and ((ref self '_isinteger))
((ref other '_isinteger))
@@ -2154,16 +2152,14 @@ This is the copyright information of the file ported over to scheme
((cx-error context) InvalidOperation
(+ "pow() 3rd argument not allowed "
"unless all arguments are integers")))
- (let () (pk 4))
((< other 0) it
((cx-error context) InvalidOperation
(+ "pow() 2nd argument cannot be "
"negative when 3rd argument specified")))
- (let () (pk 5))
((not (bool modulo)) it
((cx-error context) InvalidOperation
"pow() 3rd argument cannot be 0"))
- (let () (pk 6))
+
;; additional restriction for decimal: the modulus must be less
;; than 10**prec in absolute value
((>= ((ref modulo 'adjusted)) (cx-prec context)) it
@@ -2171,7 +2167,7 @@ This is the copyright information of the file ported over to scheme
(+ "insufficient precision: pow() 3rd "
"argument must not have more than "
"precision digits")))
- (let () (pk 7))
+
;; define 0**0 == NaN, for consistency with two-argument pow
;; (even though it hurts!)
((and (not (bool other)) (not (bool self))) it
@@ -2179,7 +2175,7 @@ This is the copyright information of the file ported over to scheme
(+ "at least one of pow() 1st argument "
"and 2nd argument must be nonzero ;"
"0**0 is not defined")))
- (let () (pk 8))
+
;; compute sign of result
(let ((sign (if ((ref other '_iseven))
0
@@ -2187,23 +2183,23 @@ This is the copyright information of the file ported over to scheme
(base (_WorkRep ((ref self 'to_integral_value))))
(exponent (_WorkRep ((ref other 'to_integral_value)))))
- (let () (pk 9))
+
;; convert modulo to a Python integer, and self and other to
;; Decimal integers (i.e. force their exponents to be >= 0)
(set! modulo (abs (int modulo)))
- (let () (pk 10))
+
;; compute result using integer pow()
(set! base (guile:modulo
(* (guile:modulo (ref base 'int) modulo)
(modulo-expt 10 (ref base 'exp) modulo))
modulo))
- (let () (pk 11))
+
(let lp ((i (ref exponent 'exp)))
(if (> i 0)
(begin
(set! base (modulo-expt base 10 modulo))
(lp (- i 1)))))
- (let () (pk 12))
+
(set! base (modulo-expt base (ref exponent 'int) modulo))
(_dec_from_triple sign (str base) 0)))))
@@ -2665,7 +2661,6 @@ This is the copyright information of the file ported over to scheme
;; try for an exact result with precision +1
(when (eq? ans None)
(set! ans ((ref self '_power_exact) other (+ prec 1)))
- (let () (pk 2 0))
(when (not (eq? ans None))
(if (= result_sign 1)
(set! ans (_dec_from_triple 1 (ref ans '_int)
@@ -6314,7 +6309,7 @@ This is the copyright information of the file ported over to scheme
;; is actually an integer approximation to 2**R*y*M, where R is the
;; number of reductions performed so far.
- ;; argument reduction; R = number of reductions performed
+ ;; argument reduction; R = number of reductions performed
(call-with-values
(lambda ()
(let lp ((y (- x M)) (R 0))
@@ -6326,7 +6321,7 @@ This is the copyright information of the file ported over to scheme
(values y R))))
(lambda (y R)
;; Taylor series with T terms
- (let* ((T (- (int (* -10 (floor-quotient (len (str M)) (* 3 L))))))
+ (let* ((T (- (int (floor-quotient (* -10 (len (str M))) (* 3 L)))))
(yshift (_rshift_nearest y R))
(w (_div_nearest M T)))
(for ((k : (range (- T 1) 0 -1))) ((w w))
@@ -6399,7 +6394,6 @@ This is the copyright information of the file ported over to scheme
(call-with-values
(lambda ()
;; compute approximation to f*10**p*log(10), with error < 11.
- (pk 'log_d log_d)
(if (not (= f 0))
(let ((extra (- (len (str (abs f))) 1)))
(if (>= (+ p extra) 0)
@@ -6410,7 +6404,6 @@ This is the copyright information of the file ported over to scheme
0))
(lambda (f_log_ten)
;; error in sum < 11+27 = 38; error after division < 0.38 + 0.5 < 1
- (pk 'log_ten f_log_ten)
(_div_nearest (+ f_log_ten log_d) 100))))))))
(define-python-class _Log10Memoize ()
@@ -6482,7 +6475,6 @@ This is the copyright information of the file ported over to scheme
(let* ((T (- (int (floor-quotient (* -10 (len (str M))) (* 3 L)))))
(y1 (let ((Mshift (ash M R)))
(for ((i : (range (- T 1) 0 -1))) ((y (_div_nearest x T)))
- (pk 'y i y)
(_div_nearest (* x (+ Mshift y)) (* Mshift i))
#:final y)))
@@ -6492,7 +6484,6 @@ This is the copyright information of the file ported over to scheme
(let ((Mshift (ash M (+ k 2))))
(_div_nearest (* y (+ y Mshift)) Mshift))
#:final y)))
- (pk '_iexp x M (+ M y2) R T y1)
(+ M y2)))))
(define _dexp
@@ -6511,9 +6502,8 @@ This is the copyright information of the file ported over to scheme
= 10**(p-1) the error could be up to 10 ulp."
;; we'll call iexp with M = 10**(p+2), giving p+3 digits of precision
(set! p (+ p 2))
- (pk '_dexp c e p)
;; compute log(10) with extra precision = adjusted exponent of c*10**e
- (let* ((extra (max 0 (+ e (len (str c)) -1)))
+ (let* ((extra ((@ (guile) max) 0 (+ e (len (str c)) -1)))
(q (+ p extra)))
;; compute quotient c*10**e/(log(10)) = c*10**(e+q)/(log(10)*10**q),
@@ -6530,8 +6520,10 @@ This is the copyright information of the file ported over to scheme
(set! rem (_div_nearest rem (expt 10 extra)))
;; error in result of _iexp < 120; error after division < 0.62
- (values (_div_nearest (_iexp rem (expt 10 p)) 1000)
- (+ quot (- p) 3))))))))
+ (let ((a (_div_nearest (_iexp rem (expt 10 p)) 1000))
+ (b (+ quot (- p) 3)))
+ (values a b))))))))
+
(define _dpower
(lambda (xc xe yc ye p)
@@ -6548,7 +6540,6 @@ This is the copyright information of the file ported over to scheme
We assume that: x is positive and not equal to 1, and y is nonzero.
"
- (pk xc xe yc ye p)
(let*
;; Find b such that 10**(b-1) <= |y| <= 10**b
((b (+ (len (str (abs yc))) ye))
@@ -6573,8 +6564,8 @@ This is the copyright information of the file ported over to scheme
(lambda ()
(_dexp ps (- (+ p 1)) (+ p 1)))
(lambda (coeff exp)
- (values (pk 1 (_div_nearest coeff 10))
- (pk 2 (+ exp 1)))))))))
+ (values (_div_nearest coeff 10)
+ (+ exp 1))))))))
(define _corr (dict '(("1" . 100) ("2" . 70) ("3" . 53) ("4" . 40) ("5" . 31)
("6" . 23 ) ("7" . 16) ("8" . 10) ("9" . 5))))
(define _log10_lb
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 82c0cab..1c15d40 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -9,8 +9,9 @@
[(_ iface)
(module-for-each
(lambda (name . l)
- (module-re-export! (current-module) ((@ (guile) list) name)))
- (resolve-interface 'iface))]
+ (module-re-export! (current-module)
+ ((@ (guile) list) name)))
+ (module-public-interface (resolve-module 'iface)))]
[(_ iface _ li)
(let ((l 'li))
(module-for-each
@@ -18,7 +19,7 @@
(if (not (member name l))
(module-re-export! (current-module)
((@ (guile) list) (pk name)))))
- (resolve-interface 'iface)))]))
+ (module-public-interface (resolve-module 'iface))))]))
(set! (@ (language python module os) path)
(Module '(path os module python language) '(path os)))
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 18:17:29 +0000