summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/compile.scm18
-rw-r--r--modules/language/python/format2.scm15
-rw-r--r--modules/language/python/module/_python.scm12
-rw-r--r--modules/language/python/module/_random.scm18
-rw-r--r--modules/language/python/module/math.scm20
-rw-r--r--modules/language/python/module/random.py16
-rw-r--r--modules/language/python/module/time.scm2
-rw-r--r--modules/language/python/number.scm4
-rw-r--r--modules/oop/pf-objects.scm31
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 <integer>)) o1)
-(define-method (py-floor (o1 <number> )) )
+(define-method (py-floor (o1 <number> )) (inexact->exact (floor o1)))
(define-method (py-trunc (o1 <integer>)) (exact->inexact o1))
(define-method (py-trunc (o1 <number> ))
(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 <pf>) 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)
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-20 04:32:46 +0000