From 9bd339b34f09f5b582cb8b77a11841f5de9ab695 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Tue, 28 Aug 2018 20:22:54 +0200 Subject: random works --- modules/language/python/compile.scm | 18 ++++++++--------- modules/language/python/format2.scm | 15 ++++++++------- modules/language/python/module/_python.scm | 12 ++++++++++++ modules/language/python/module/_random.scm | 18 +++++++++++------ modules/language/python/module/math.scm | 20 ++++++++++++------- modules/language/python/module/random.py | 16 +++++++++++---- modules/language/python/module/time.scm | 2 +- modules/language/python/number.scm | 4 ++-- modules/oop/pf-objects.scm | 31 +++++++++++++++++++++++++++--- 9 files changed, 97 insertions(+), 39 deletions(-) diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 7afbc5b..354b39d 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -81,18 +81,18 @@ (eval-when (compile) (catch #t (lambda () - (if (not p) (reload-module (resolve-module l))) + (if (not p) (reload-module (resolve-module 'l))) (use-modules a ...)) (lambda x #f))) (eval-when (eval load) (catch #t (lambda () - (if (not p) (reload-module (resolve-module l))) + (if (not p) (reload-module (resolve-module 'l))) (use-modules a ...)) (lambda x (raise (ImportError ((@ (guile) format) - #f "failed to import ~a ~a" l x)))))))) + #f "failed to import ~a ~a" 'l x)))))))) (define level (make-fluid 0)) @@ -139,7 +139,7 @@ code ...)) (define (get-warns) - (list 'quote (fluid-ref (@@ (system base message) %dont-warn-list)))) + (list (G 'quote) (fluid-ref (@@ (system base message) %dont-warn-list)))) (define (dont-warn v) (catch #t @@ -699,7 +699,7 @@ ("&=" (G 'logand)) ("|=" (G 'logior)) ("^=" (G 'logxor)) - ("**=" (G 'expt)) + ("**=" (N 'expt)) ("<<=" (C '<<)) (">>=" (C '>>)) ("//=" (G 'floor-quotient)))) @@ -847,7 +847,7 @@ (fast? (not (eq? vf 'super)))) (define (pw x) (if ** - `(,(G expt) ,x ,(exp vs **)) + `(,(N 'expt) ,x ,(exp vs **)) x)) (pw (let ((trailer (get-addings vs trailer fast?))) @@ -1066,14 +1066,14 @@ (lambda () (Module (reverse l) (reverse xl)) #t) (lambda x #f)))) (if (eq? ? #t) (for-each dont-warn (get-exported-symbols l))) - `(,(C 'use) ,? ',l ,l)))) + `(,(C 'use) ,? ,l ,l)))) ((_ (#:from (() . nm) l)) ;; Make sure to load the module in (let* ((xl (map (lambda (nm) (exp vs nm)) nm)) (ll `(language python module ,@xl))) - `(,(C 'use) #t (,(G 'quote) ()) + `(,(C 'use) #t () (,ll #:select ,(map (lambda (x) @@ -1381,7 +1381,7 @@ (,(G 'let) ((,o (,(G 'if) (,(O 'pyclass?) ,c) (,c) ,c))) - (,(O 'set) ,o '__cause__ ,(exp vs from)) + (,(O 'set) ,o (,(G 'quote) __cause__) ,(exp vs from)) ,o)))))) diff --git a/modules/language/python/format2.scm b/modules/language/python/format2.scm index eb6b8d0..65ee545 100644 --- a/modules/language/python/format2.scm +++ b/modules/language/python/format2.scm @@ -127,11 +127,12 @@ (let ((pat1 (make-decimal)) (pat2 (make-exp (if (equal? tp "g") "e" "E")))) (lambda (x) - (if (or (< (log10 x) -4) (if prec (< (log10 x) (- prec)) #f)) + (if (or (< (log10 (abs x)) -4) + (if prec (< (log10 (abs x)) (- prec)) #f)) (scm-format #f pat2 x) (scm-format #f pat1 x)))))))) - + ((or "d" "i" "u" "o" "x" "X") (match c ("" @@ -149,8 +150,8 @@ (let ((c (string->list c))) (if (and (member #\# c) (match tp - ((or "x" "o" "X") #t) - (_ #f))) + ((or "x" "o" "X") #t) + (_ #f))) (set! c (cons #\0 c))) (let* ((kind (get-intkind tp)) (padchar (if (member #\0 c) "0" " ")) @@ -167,9 +168,9 @@ padchar))) (kpre (if (member #\# c) (match tp - ("o" "0o") - ((or "x" "X") "0x") - (_ "")) + ("o" "0o") + ((or "x" "X") "0x") + (_ "")) "")) (neg (if (or (member #\+ c) diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm index 6db3cf1..149946e 100644 --- a/modules/language/python/module/_python.scm +++ b/modules/language/python/module/_python.scm @@ -348,3 +348,15 @@ ((x) ((@ (guile) display) x ) (print)) (l ((@ (guile) display) l ) (print))) l))))) + +(define-syntax-rule (mk cl cls ? tp) + (begin + (set! (@@ (oop pf-objects) cl) cls) + (set! (@@ (oop pf-objects) ? ) (lambda (x) (isinstance x tp))))) + +(mk int-cls int int? int) +(mk tuple-cls tuple tuple? tuple) +(mk string-cls str str? str) +(mk bytes-cls bytes bytes? bytes) +(mk list-cls list list? list) +(mk float-cls float float? float) diff --git a/modules/language/python/module/_random.scm b/modules/language/python/module/_random.scm index 6e2660a..74b9492 100644 --- a/modules/language/python/module/_random.scm +++ b/modules/language/python/module/_random.scm @@ -1,11 +1,14 @@ -(define-module (langauge python module _random) +(define-module (language python module _random) #:use-module (oop pf-objects) - #:export ()) + #:use-module (language python string) + #:export (Random)) + +(define-syntax-rule (aif it p . l) (let ((it p)) (if p . l))) (define-python-class Random () (define seed (lambda (self s) - (rawset self '_state (seed->random-state s)))) + (rawset self '_state (seed->random-state (format #f "~a" s))))) (define setstate (lambda (self s) @@ -15,13 +18,16 @@ (lambda (self) (aif it (rawref self '_state) it - (let ((ret (copy-random-state))) + (let ((ret (random-state-from-platform))) (set self '_state ret) ret)))) + (define getrandbits '(no)) (define random (lambda (self) - (let ((x (random:uniform (getstate self)))) - (rawset self '_state (copy-random-state)))))) + (set! *random-state* (getstate self)) + (let ((x (random:uniform))) + (rawset self '_state *random-state*) + x)))) diff --git a/modules/language/python/module/math.scm b/modules/language/python/module/math.scm index 0dfae92..7b4093d 100644 --- a/modules/language/python/module/math.scm +++ b/modules/language/python/module/math.scm @@ -13,9 +13,11 @@ erf erfc gamma lgamma e tau inf nan)) (define (real! s x) - (if (= (imag-part x) 0) - (real-part x) - (raise ValueError "real math fkn result in complex number" s))) + (if (complex? x) + (if (= (imag-part x) 0) + (real-part x) + (raise ValueError "real math fkn result in complex number" s)) + x)) (define ceil (lambda (x) @@ -96,7 +98,11 @@ (list double)))) (lambda (x) (f x)))) -(define (log x) (real! 'log ((@ (guile) log) x))) +(define* (log x #:optional (base #f)) + (real! 'log + (if (not base) + ((@ (guile) log) x) + (/ ((@ (guile) log) x) ((@ (guile) log) base))))) (define log1p (let ((f (pointer->procedure double @@ -111,11 +117,11 @@ (list double)))) (lambda (x) (f x)))) -(define (log10 x) (real! 'log10 (@ (guile) log10))) - +(define (log10 x) (real! 'log10 ((@ (guile) log10) x))) + (define (pow x y) (real! 'pow ((@ (guile) expt) x y))) -(define (sqrt x) (real! 'sqrt (@ (guile) sqrt))) +(define (sqrt x) (real! 'sqrt ((@ (guile) sqrt) x))) ;; Trigs (define (acos x) (real! 'acos ((@ (guile) acos) x))) diff --git a/modules/language/python/module/random.py b/modules/language/python/module/random.py index 0c38aa0..31783cc 100644 --- a/modules/language/python/module/random.py +++ b/modules/language/python/module/random.py @@ -38,7 +38,6 @@ General notes on the underlying Mersenne Twister core generator: and is, therefore, threadsafe. """ - from warnings import warn as _warn from types import MethodType as _MethodType, BuiltinMethodType as _BuiltinMethodType from math import log as _log, exp as _exp, pi as _pi, e as _e, ceil as _ceil @@ -183,6 +182,7 @@ class Random(_random.Random): # This code is a bit messy to make it fast for the # common case while still doing adequate error checking. istart = _int(start) + if istart != start: raise ValueError("non-integer arg 1 for randrange()") if stop is None: @@ -192,9 +192,11 @@ class Random(_random.Random): # stop argument supplied. istop = _int(stop) + if istop != stop: raise ValueError("non-integer stop for randrange()") width = istop - istart + if step == 1 and width > 0: return istart + self._randbelow(width) if step == 1: @@ -228,6 +230,7 @@ class Random(_random.Random): random = self.random getrandbits = self.getrandbits + # Only call self.getrandbits if the original random() builtin method # has not been overridden or if a new getrandbits() was supplied. if type(random) is BuiltinMethod or type(getrandbits) is Method: @@ -236,6 +239,7 @@ class Random(_random.Random): while r >= n: r = getrandbits(k) return r + # There's an overridden random() method but no new getrandbits() method, # so we can only use random() from here. if n >= maxsize: @@ -243,11 +247,14 @@ class Random(_random.Random): "enough bits to choose from a population range this large.\n" "To remove the range limitation, add a getrandbits() method.") return int(random() * n) + rem = maxsize % n limit = (maxsize - rem) / maxsize # int(limit * maxsize) % n == 0 + r = random() while r >= limit: r = random() + return int(r*maxsize) % n ## -------------------- sequence methods ------------------- @@ -696,8 +703,9 @@ class SystemRandom(Random): ## -------------------- test program -------------------- +import time + def _test_generator(n, func, args): - import time print(n, 'times', func.__name__) total = 0.0 sqsum = 0.0 @@ -710,10 +718,12 @@ def _test_generator(n, func, args): sqsum = sqsum + x*x smallest = min(x, smallest) largest = max(x, largest) + t1 = time.time() print(round(t1-t0, 3), 'sec,', end=' ') avg = total/n stddev = _sqrt(sqsum/n - avg*avg) + print('avg %g, stddev %g, min %g, max %g\n' % \ (avg, stddev, smallest, largest)) @@ -766,5 +776,3 @@ getstate = _inst.getstate setstate = _inst.setstate getrandbits = _inst.getrandbits -if __name__ == '__main__': - _test() diff --git a/modules/language/python/module/time.scm b/modules/language/python/module/time.scm index fc43906..84d5d03 100644 --- a/modules/language/python/module/time.scm +++ b/modules/language/python/module/time.scm @@ -203,7 +203,7 @@ (rm (f clk_id vp)) (values))))) -(define (time) ((@ (guile) current-time))) +(define (time) (clock_gettime CLOCK_REALTIME)) (define* (ctime #:optional (sec None)) (define sec2 (if (eq? sec None) (time) sec)) diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm index a44707c..4976470 100644 --- a/modules/language/python/number.scm +++ b/modules/language/python/number.scm @@ -222,7 +222,7 @@ (define-method (py-floor (o1 )) o1) -(define-method (py-floor (o1 )) ) +(define-method (py-floor (o1 )) (inexact->exact (floor o1))) (define-method (py-trunc (o1 )) (exact->inexact o1)) (define-method (py-trunc (o1 )) (floor o1)) @@ -412,7 +412,7 @@ (let lp ((n n)) (cond ((and (number? n) (integer? n)) - n) + (inexact->exact n)) ((boolean? n) (if n 1 0)) ((number? n) diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index f5b6466..fd11182 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -171,6 +171,7 @@ explicitly tell it to not update etc. (hash-ref h key -fail)))) (define-method (find-in-class x key fail) fail) +(define-method (find-in-class-raw klass key fail) fail) (define-method (find-in-class-raw (klass ) key fail) (let ((r (vhash-assoc key (slot-ref klass 'h)))) @@ -519,6 +520,30 @@ explicitly tell it to not update etc. (apply it class x) (the-create-object class x)))))) +(define int-cls #f) +(define int? #f) +(define tuple-cls #f) +(define tuple? #f) +(define string-cls #f) +(define str? #f) +(define bytes-cls #f) +(define bytes? #f) +(define list-cls #f) +(define list? #f) +(define float-cls #f) +(define float? #f) + +(define (check-obj obj) + (cond + ((int? obj) int-cls) + ((tuple? obj) tuple-cls) + ((float? obj) float-cls) + ((str? obj) string-cls) + ((list? obj) list-cls) + ((bytes? obj) bytes-cls) + (else + object))) + (define type-call (lambda (class . l) (if (pytype? class) @@ -528,11 +553,11 @@ explicitly tell it to not update etc. (lambda () (aif it (find-in-class-raw obj '__class__ #f) it - type)) + (check-obj obj))) (lambda x (warn x) - type))) - + (check-obj obj)))) + ((meta name bases dict . keys) (type- meta name bases dict keys))) class l) -- cgit v1.2.3