summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/language/python/compile.scm1
-rw-r--r--modules/language/python/def.scm14
-rw-r--r--modules/language/python/exceptions.scm20
-rw-r--r--modules/language/python/list.scm27
-rw-r--r--modules/language/python/module/python.scm98
-rw-r--r--modules/language/python/number.scm20
-rw-r--r--modules/oop/pf-objects.scm51
7 files changed, 162 insertions, 69 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 275c635..c9acea1 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -239,6 +239,7 @@
((__close__) (Y 'sendClose))
;; Numerics
+ ((__index__) (N 'py-index))
((__add__ ) (N '+))
((__mul__ ) (N '*))
((__sub__ ) (N '-))
diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
index bc745f0..c65cd07 100644
--- a/modules/language/python/def.scm
+++ b/modules/language/python/def.scm
@@ -9,8 +9,8 @@
(lam (car l) (fold lam s (cdr l)))
s))
-(define-syntax-rule (take-1 ww* kw s v)
- (if (null? ww*)
+(define-syntax-rule (take-1 pww ww* kw s v)
+ (if (not pww)
(values ww*
(aif it (hash-ref kw s #f)
(begin
@@ -68,23 +68,23 @@
((_ (arg ...) code ...)
(let* ((as (fold get-as '() #'(arg ...)))
(kw (fold get-kw '() #'(arg ...)))
- (ww (fold get-ww '() #'(arg ...)))
+ (ww- (fold get-ww '() #'(arg ...)))
(kv (fold get-kv '() #'(arg ...))))
- (if (and-map null? (list kw ww kv))
+ (if (and-map null? (list kw ww- kv))
#`(lambda #,as code ...)
(with-syntax ((kw (if (null? kw)
(datum->syntax x (gensym "kw"))
(car kw)))
- (ww (if (null? ww)
+ (ww (if (null? ww-)
(datum->syntax x (gensym "ww"))
- (car ww)))
+ (car ww-)))
((k ...) (map car kv))
((s ...) (map ->kw (map car kv)))
((v ...) (map cdr kv)))
#`(lambda* (#,@as . l)
(call-with-values (lambda () (get-akw l))
(lambda (ww* kw)
- (let*-values (((ww* k) (take-1 ww* kw s v))
+ (let*-values (((ww* k) (take-1 #,(null? ww-) ww* kw s v))
...)
(let ((ww ww*)
(kw (pytonize kw)))
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 4fffdab..ce96f16 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -3,20 +3,20 @@
#:use-module (oop goops)
#:export (StopIteration GeneratorExit RuntimeError
Exception ValueError TypeError
- IndexError KeyError
+ IndexError KeyError AttributeError
None))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-(define StopIteration 'StopIteration)
-(define GeneratorExit 'GeneratorExit)
-(define RuntimeError 'RuntimeError)
-(define IndexError 'IndexError)
-(define ValueError 'ValueError)
-(define None 'None)
-(define KeyError 'KeyError)
-(define TypeError 'TypeError)
-
+(define StopIteration 'StopIteration)
+(define GeneratorExit 'GeneratorExit)
+(define RuntimeError 'RuntimeError)
+(define IndexError 'IndexError)
+(define ValueError 'ValueError)
+(define None 'None)
+(define KeyError 'KeyError)
+(define TypeError 'TypeError)
+(define AttributeError 'AttributeError)
(define-python-class Exception ()
(define __init__
(case-lambda
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 7f0d7e4..1a3e7c5 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -515,12 +515,16 @@
(define-method (pylist-remove! (o <p>) . l) (apply (ref o 'remove) l))
;; SORT!
-(define-method (pylist-sort! (o <py-list>) )
- (let lp ((l (sort (to-list o) <)) (i 0))
- (if (pair? l)
- (begin
- (pylist-set! o i (car l))
- (lp (cdr l) (+ i 1))))))
+(define (id x) id)
+(define-method (pylist-sort! (o <py-list>) . l)
+ (apply
+ (lambda* (#:key (key id) (reverse #f))
+ (let lp ((l (sort (map key (to-list o)) (if reverse > <))) (i 0))
+ (if (pair? l)
+ (begin
+ (pylist-set! o i (car l))
+ (lp (cdr l) (+ i 1))))))
+ l))
(define-method (pylist-sort! (o <p>) . l) (apply (ref o 'sort) l))
@@ -686,10 +690,13 @@
(define-python-class list (<py-list>)
(define __init__
- (lambda (self . x)
- (slot-set! self 'vec (make-vector 30))
- (slot-set! self 'n 0)
- (for-each (lambda (x) (pylist-append! self x)) x))))
+ (case-lambda
+ ((self)
+ (slot-set! self 'vec (make-vector 30))
+ (slot-set! self 'n 0))
+ ((self it)
+ (__init__ self)
+ (for ((i : it)) () (pylist-append self i))))))
(define pylist list)
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index 4159d91..110ae6b 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -1,8 +1,11 @@
(define-module (language python module python)
#:use-module (oop goops)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 readline)
#:use-module ((oop pf-objects) #:select
- (<p> class-method static-method refq))
+ (<p> <property> class-method static-method refq))
#:use-module (language python exceptions )
+ #:use-module (language python def )
#:use-module (language python for )
#:use-module (language python try )
#:use-module (language python yield )
@@ -16,16 +19,19 @@
#:use-module (language python dir )
#:use-module (language python hash )
- #:replace (list abs)
+ #:replace (list abs min max)
#:re-export (Exception StopIteration send sendException next
GeneratorExit sendClose RuntimeError
- len dir next dict)
+ len dir next dict None)
#:export (print repr complex float int round
set all any bin callable
chr classmethod staticmethod
divmod enumerate filter format
getattr hasattr hash hex isinstance
- iter map))
+ iter map sum id input oct ord pow
+ property))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define print
(case-lambda
@@ -35,7 +41,6 @@
(define (repr x) (format #f "~a" x))
(define abs py-abs)
-(define list pylist)
(define string pystring)
(define complex py-complex)
(define float py-float)
@@ -56,7 +61,7 @@
(define-method (callable (x <applicable> )) #t)
(define-method (callable (x <primitive-generic>)) #t)
(define-method (callable (x <p>))
- (ref x '__call__))
+ (refq x '__call__))
(define chr integer->char)
@@ -77,16 +82,16 @@
(if (f x)
(yield x))))))
-(define miss (list 'miss))
+(define miss ((@ (guile) list) 'miss))
(define* (getattr a b #:optional (k miss))
- (let ((r (ref a (symbol->string b) k)))
+ (let ((r (refq a (symbol->string b) k)))
(if (eq? r miss)
(raise AttributeError "object/class ~a is missing attribute ~a" a b)
r)))
(define (hasattr a b)
- (let ((r (ref a (symbol->string b) k)))
+ (let ((r (refq a (symbol->string b) miss)))
(not (eq? r miss))))
(define (isinstance o cl)
@@ -100,10 +105,10 @@
(case-lambda
((o) (aif it (wrap-in o)
it
- (aif get (ref o '__getitem__)
+ (aif get (refq o '__getitem__)
(make-generator iter
(lambda (yield)
- (for () (i 0)
+ (for () ((i 0))
(yield (get i))
(+ i 1))))
(raise TypeError "not iterable" o))))
@@ -117,7 +122,7 @@
(yield r)))))))))
-
+
(define-syntax map
(lambda (x)
(syntax-case x ()
@@ -127,7 +132,74 @@
(lambda (yield)
(for ((x : a) ...) () (yield (f x ...))))))))))
+(define* (sum i #:optional (start 0))
+ (for ((x : i)) ((s start))
+ (+ s x)
+ #:final
+ s))
+
+
+(define (id x) (object-address x))
+
+(define (input str)
+ (format #t str)
+ (readline))
+
+(define (idx x) x)
+(def (py-min (* l) (= key idx) (= default miss))
+ (let lp ((l l))
+ (match l
+ ((it)
+ (for ((x : it)) ((s default) (b default))
+ (if (eq? s miss)
+ (values (key x) x)
+ (let ((k (key x)))
+ (if (< k s)
+ (values k x)
+ (values s b))))
+ #:final
+ (if (eq? b miss)
+ (raise ValueError "min does not work for zero length list")
+ b)))
+ (_ (lp ((@ (guile) list) l))))))
+
+(def (py-max (* l) (= key idx) (= default miss))
+ (let lp ((l l))
+ (match l
+ ((it)
+ (for ((x : it)) ((s default) (b default))
+ (if (eq? default miss)
+ (values (key x) x)
+ (let ((k (key x)))
+ (if (> k s)
+ (values k x)
+ (values s b))))
+ #:final
+ (if (eq? b miss)
+ (raise ValueError "min does not work for zero length list")
+ b)))
+ (_ (lp ((@ (guile) list) l))))))
+
+(define (oct x) (+ "0o" (number->string (py-index x) 8)))
+(define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
+
+(define pow
+ (case-lambda
+ ((x y)
+ (expt x y))
+ ((x y z)
+ (py-mod (expt x y) z))))
+
+(def (property (= getx None) (= setx None) (= delx None))
+ (let ((o (make <property>)))
+ (slot-set! o 'get getx)
+ (slot-set! o 'set setx)
+ (slot-set! o 'del delx)
+ o))
+
+(define min py-min)
+(define max py-max)
+(define list pylist)
-
diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm
index 56a50cf..efab4e4 100644
--- a/modules/language/python/number.scm
+++ b/modules/language/python/number.scm
@@ -8,10 +8,10 @@
#:export (py-int py-float py-complex
py-/ py-logand py-logior py-logxor py-abs py-trunc
py-lshift py-rshift py-mod py-floordiv py-round
- <py-int> <py-float> <py-complex>
+ <py-int> <py-float> <py-complex>
py-divmod pyfloat-listing pyint-listing pycomplex-listing
py-as-integer-ratio py-conjugate py-fromhex py-hex py-imag
- py-is-integer py-real hex py-bin))
+ py-is-integer py-real hex py-bin py-index))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
@@ -177,8 +177,8 @@
(define-method (py-fromhex (o <real>))
(error "1.2.fromhex('0x1.ap4') is not implemented"))
-(define-method (py-hex (o <real>))
- (error "1.2.hex() is not implemented"))
+(define (py-hex x)
+ (+ "0x" (number->string (py-index x) 16)))
(define-method (py-is-integer (o <real>))
(= 1 (denominator (inexact->exact o))))
@@ -191,7 +191,7 @@
(magnitude o))
(define-method (py-abs (o <number>))
(abs o))
-
+(define-method (py-index (o <integer>)) o)
(mk-unop u0 py-abs __abs__)
(mk-unop u0 py-conjugate conjugate)
(mk-unop u0 py-imag imag)
@@ -200,10 +200,9 @@
(mk-unop u0 py-numerator numerator)
(mk-unop u0 py-as-integer-ratio as_integer_ratio)
(mk-unop u0 py-fromhex fromhex)
-(mk-unop u0 py-hex hex)
(mk-unop i0 hex __hex__)
(mk-unop u0 py-is-integer is_integer)
-
+(mk-unop u0 py-index __index__)
(define-method (write (o <py-float>) . l)
(apply write (slot-ref o 'x) l))
@@ -271,7 +270,6 @@
(aif it (slot-ref n '__float__)
(slot-set! self 'x it)
(raise ValueError "could not make float from " n)))))))))
-
(define-python-class py-complex (<py-complex>)
(define __init__
@@ -378,9 +376,7 @@
(number->string o 2))
(define-method (py-bin (o <py-int>))
(number->string (slot-ref o 'x) 2))
-(define-method (py-bin (o <p>))
- (let ((r (ref o '__index__)))
- (number->string (r) 2)
- (raise TypeError "object cannot be interpretted as an index")))
+(define (py-bin o)
+ (+ "0b" (number->string (py-index o) 2)))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index d916fe8..05f65be 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -2,7 +2,7 @@
#:use-module (oop goops)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
- #:export (set ref make-pf <p> <py> <pf> <pyf>
+ #:export (set ref make-pf <p> <py> <pf> <pyf> <property>
call with copy fset fcall make-p put put!
pcall pcall! get fset-x pyclass? refq
def-pf-class mk-pf-class make-pf-class
@@ -34,6 +34,8 @@ explicitly tell it to not update etc.
(define-class <py> (<p>))
(define-class <pyf> (<pf>))
+(define-class <property> () get set del)
+
(define (mk x)
(letrec ((o (make (ref x '__goops__))))
(slot-set! o 'procedure
@@ -162,17 +164,29 @@ explicitly tell it to not update etc.
(define not-implemented (cons 'not 'implemeneted))
+(define-syntax-rule (prop-ref xx x)
+ (let ((r x))
+ (if (is-a? r <property>)
+ ((slot-ref r 'get) xx)
+ r)))
+
(define-syntax-rule (mrefx-py- x key l)
- (let ((f (mrefx- x '__getattribute__ '())))
- (if (or (not f) (eq? f not-implemented))
- (mrefx- x key l)
- (apply f x key l))))
+ (let ((xx x))
+ (prop-ref
+ xx
+ (let ((f (mrefx- xx '__getattribute__ '())))
+ (if (or (not f) (eq? f not-implemented))
+ (mrefx- xx key l)
+ (apply f xx key l))))))
(define-syntax-rule (mrefx-py x key l)
- (let ((f (mrefx x '__getattribute__ '())))
- (if (or (not f) (eq? f not-implemented))
- (mrefx x key l)
- (apply f x key l))))
+ (let ((xx x))
+ (prop-ref
+ xx
+ (let ((f (mrefx xx '__getattribute__ '())))
+ (if (or (not f) (eq? f not-implemented))
+ (mrefx xx key l)
+ (apply f xx key l))))))
(define-syntax-rule (unx mrefx- mref-)
(define-syntax-rule (mref- x key l)
@@ -285,10 +299,13 @@ explicitly tell it to not update etc.
(values))))
(define-syntax-rule (mset-py- x key val)
- (let ((f (mref-py- x '__setattr__ '())))
- (if (or (eq? f not-implemented) (not f))
- (mset- x key val)
- (f key val))))
+ (let ((v (mref- x key fail)))
+ (if (or (eq? v fail) (not (is-a? v <property>)))
+ (let ((f (mref-py- x '__setattr__ '())))
+ (if (or (eq? f not-implemented) (not f))
+ (mset- x key val)
+ (f key val)))
+ ((slot-ref v 'set) x val))))
(define-syntax-rule (mklam (mset a ...) val)
(if (procedure? val)
@@ -297,10 +314,10 @@ explicitly tell it to not update etc.
(mset a ... (object-method val)))
(mset a ... val)))
-(define-method (set (x <pf>) key val) (mset x key val))
-(define-method (set (x <p>) key val) (mset- x key val))
-(define-method (set (x <pyf>) key val) (mset-py x key val))
-(define-method (set (x <py>) key val) (mset-py- x key val))
+(define-method (set (x <pf>) key val) (mklam (mset x key) val))
+(define-method (set (x <p>) key val) (mklam (mset- x key) val))
+(define-method (set (x <pyf>) key val) (mklam (mset-py x key) val))
+(define-method (set (x <py>) key val) (mklam (mset-py- x key) val))
;; mref will reference the value of the key in the object x, an extra default
;; parameter will tell what the fail object is else #f if fail
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-18 20:31:37 +0000