diff options
Diffstat (limited to 'modules/language/python/module/python.scm')
-rw-r--r-- | modules/language/python/module/python.scm | 359 |
1 files changed, 21 insertions, 338 deletions
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index 3601c2f..3ae04e7 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -1,338 +1,21 @@ -(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> <property> class-method static-method ref (set . pf-set) - py-super-mac type object pylist-ref define-python-class - object-method py-dict)) - #:use-module (language python exceptions ) - #:use-module ((language python module string ) #:select ()) - #:use-module ((language python module io ) #:select (open)) - #:use-module (language python def ) - #:use-module (language python for ) - #:use-module (language python try ) - #:use-module (language python yield ) - #:use-module (language python list ) - #:use-module (language python dict ) - #:use-module (language python set ) - #:use-module (language python compile ) - #:use-module (language python string ) - #:use-module (language python bytes ) - #:use-module (language python set ) - #:use-module (language python number ) - #:use-module (language python dir ) - #:use-module (language python hash ) - #:use-module (language python property ) - #:use-module (language python range ) - #:use-module (language python tuple ) - #:use-module (language python eval ) - #:use-module (language python bool ) - - #:replace (list abs min max hash round format map) - - #:re-export (StopIteration GeneratorExit RuntimeError - Exception ValueError TypeError - IndexError KeyError AttributeError - send sendException next - GeneratorExit sendClose RuntimeError - SyntaxError bool - len dir next dict None property range - tuple bytes bytearray eval locals globals - compile exec type object open - ) - - #:export (print repr complex float int str - set all any bin callable reversed - chr classmethod staticmethod objectmethod - divmod enumerate filter - getattr hasattr setattr hex isinstance issubclass - iter sum id input oct ord pow super - sorted zip vars - ClassMethod StaticMethod Funcobj)) - -(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) - -(define vars py-dict) - -(define print - (case-lambda - (() ((@ (guile) format) #t "~%")) - ((x) ((@ (guile) format) #t "~s~%" x)) - (l ((@ (guile) format) #t "~s~%" l)))) - -(define (repr x) ((@ (guile) format) #f "~a" x)) -(define abs py-abs) -(define str pystring) -(define complex py-complex) -(define float py-float) -(define int py-int) -(define round py-round) -(define set py-set) -(define all py-all) -(define any py-any) -(define bin py-bin) -(define divmod py-divmod) -(define format py-format) -(define hash py-hash) -(define hex py-hex) - -(define-method (callable x ) #f) -(define-method (callable (x <procedure> )) #t) -(define-method (callable (x <procedure-class> )) #t) -(define-method (callable (x <applicable> )) #t) -(define-method (callable (x <primitive-generic>)) #t) -(define-method (callable (x <p>)) - (ref x '__call__)) - -(define chr integer->char) - -(define objectmethod object-method) -(define classmethod class-method) -(define staticmethod static-method) - -(define (enumerate l) - ((make-generator () - (lambda (yield) - (for ((x : l)) ((i 0)) - (yield i x) - (+ i 1)))))) - -(define (filter f l) - ((make-generator () - (lambda (yield) - (for ((x : l)) () - (if (f x) - (yield x))))))) - -(define miss ((@ (guile) list) 'miss)) - -(define* (getattr a b #:optional (k miss)) - (let ((r (ref a (if (string? b) (string->symbol b) b) k))) - (if (eq? r miss) - (raise AttributeError "object/class ~a is missing attribute ~a" a b) - r))) - -(define (setattr a k v) - (pf-set a (if (string? k) (string->symbol k) k) v)) - -(define (hasattr a b) - (let ((r (ref a (if (string? b) (string->symbol b) b) miss))) - (not (eq? r miss)))) - -(define-method (issubclass x y) #f) -(define-method (issubclass (sub <p>) (cls <p>)) - (aif it (ref cls '__subclasscheck__) - (it cls sub) - (if (eq? sub cls) - #t - (if (memq cls (ref sub '__mro__)) - #t - #f)))) - -(define-method (isinstance x y) - (if (null? y) - #f - (if (pair? y) - (or (isinstance x (car y)) - (isinstance x (cdr y))) - (is-a? x y)))) - -(define-method (isinstance (i <integer>) y) - (if (issubclass y int) - #t - (if (pair? y) - (or (isinstance i (car y)) - (isinstance i (cdr y))) - (is-a? i y)))) - -(define-method (isinstance (i <real>) y) - (if (issubclass y float) - #t - (if (pair? y) - (or (isinstance i (car y)) - (isinstance i (cdr y))) - (is-a? i y)))) - -(define-method (isinstance (i <pair>) y) - (if (issubclass y tuple) - #t - (if (pair? y) - (or (isinstance i (car y)) - (isinstance i (cdr y))) - (is-a? i y)))) - -(define-method (isinstance (i <string>) y) - (if (issubclass y str) - #t - (if (pair? y) - (or (isinstance i (car y)) - (isinstance i (cdr y))) - (is-a? i y)))) - -(define-method (isinstance (i <bytevector>) y) - (if (issubclass y bytes) - #t - (if (pair? y) - (or (isinstance i (car y)) - (isinstance i (cdr y))) - (is-a? i y)))) - - -(define-method (isinstance o (cl <p>)) - (cond - ((eq? cl py-list) - (is-a? o <py-list>)) - (else #f))) - -(define-method (isinstance (o <p>) (cl <p>)) - (cond - ((ref cl '__instancecheck__) => - (lambda (it) - (it o))) - ((pair? cl) - (or - (isinstance o (car cl)) - (isinstance o (cdr cl)))) - (else - (is-a? o (ref cl '__goops__))))) - - - -(define iter - (case-lambda - ((o) (aif it (wrap-in o) - it - (aif get (ref o '__getitem__) - (make-generator iter - (lambda (yield) - (for () ((i 0)) - (yield (get i)) - (+ i 1)))) - (raise TypeError "not iterable" o)))) - ((f sent) - (make-generator iter - (lambda (yield) - (for () () - (let ((r (f))) - (if (equal? r sent) - (break) - (yield r))))))))) - - - -(define-syntax map - (lambda (x) - (syntax-case x () - ((map f a ...) - (with-syntax (((x ...) (generate-temporaries #'(a ...)))) - #'(for ((x : a) ...) ((l '())) - (cons (f x ...) l) - #:final (py-list (reverse l)))))))) - -(define* (sum i #:optional (start 0)) - (for ((x : i)) ((s start)) - (+ s x) - #:final - s)) - - -(define (id x) (object-address x)) - -(define (input str) - ((@ (guile) 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 miss) (b miss)) - (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) - (if (eq? default miss) - (raise ValueError - "min does not work for zero length list") - default) - b))) - (_ (lp ((@ (guile) list) l)))))) - -(def (py-max (* l) (= key idx) (= default miss)) - (let lp ((l l)) - (match l - ((it) - (for ((x : it)) ((s miss) (b miss)) - (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) - (if (eq? default miss) - (raise ValueError - "min does not work for zero length list") - default) - 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)))) - -(define-syntax-rule (super . l) (py-super-mac . l)) - -(define min py-min) -(define max py-max) -(define list pylist) -(define reversed py-reversed) -(define (key-id x) x) -(define* (sorted it #:key (key key-id) (reverse #f)) - (define l (to-pylist '())) - (for ((x : it)) () (pylist-append! l x)) - (pylist-sort! l #:key key #:reverse reverse) - l) - -(define (zip . l) - (let ((l ((@ (guile) map) wrap-in l))) - ((make-generator () - (lambda (yield) - (let lp () - (let lp2 ((l l) (r '())) - (if (pair? l) - (call-with-values (lambda () (next (car l))) - (lambda z - (lp2 (cdr l) (append (reverse z) r)))) - (begin - (yield (reverse r)) - (lp)))))))))) - -(define-python-class ClassMethod ()) -(define-python-class StaticMethod ()) -(define-python-class Funcobj ()) - -(define-method (py-mod (s <string>) l) - (let* ((s (py-replace s "%s" "~a")) - (s (py-replace s "%r" "~a")) - (l (for ((x : l)) ((r '())) - (cons x r) - #:final (reverse r)))) - (apply (@ (guile) format) #f s l))) - - - +(define-module (language python module python ) + #:use-module (language python module _python) + #:use-module (language python compile ) + #:use-module ((language python format2) #:select ())) + +(define-syntax re-export-all + (syntax-rules () + [(_ iface) + (module-for-each + (lambda (name . l) + (module-re-export! (current-module) ((@ (guile) list) name))) + (resolve-interface 'iface))] + [(_ iface _ li) + (let ((l 'li)) + (module-for-each + (lambda (name . l) + (if (not (member name l)) + (module-re-export! (current-module) ((@ (guile) list) name)))) + (resolve-interface 'iface)))])) + +(re-export-all (language python module _python)) |