diff options
Diffstat (limited to 'modules/language/python/module/python.scm')
| -rw-r--r-- | modules/language/python/module/python.scm | 98 |
1 files changed, 85 insertions, 13 deletions
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) - |