From d0d2eb24fd190bee7de2c94b29d00a5e96312f81 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Fri, 17 Aug 2018 15:04:12 +0200 Subject: arith bugg fixed plus etc lr --- modules/language/python/compile.scm | 70 +++++++++++++++++++++--------- modules/language/python/module.scm | 15 ++++--- modules/language/python/module/_python.scm | 29 +++++++------ modules/language/python/module/decimal.scm | 45 ++++++++----------- modules/language/python/module/python.scm | 7 +-- 5 files changed, 95 insertions(+), 71 deletions(-) (limited to 'modules/language') 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))) -- cgit v1.2.3