diff options
Diffstat (limited to 'modules/language/python/module/_python.scm')
| -rw-r--r-- | modules/language/python/module/_python.scm | 328 |
1 files changed, 328 insertions, 0 deletions
diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm new file mode 100644 index 0000000..1dd9ff9 --- /dev/null +++ b/modules/language/python/module/_python.scm @@ -0,0 +1,328 @@ +(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 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 filter) + + #:re-export (StopIteration GeneratorExit RuntimeError + Exception ValueError TypeError + IndexError KeyError AttributeError + send sendException next + GeneratorExit sendClose RuntimeError + SyntaxError bool compile + len dir next dict None property range + tuple bytes bytearray eval locals globals + exec type object open + ) + + #:export (print repr complex float int str + set all any bin callable reversed + chr classmethod staticmethod objectmethod + divmod enumerate + 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 ()) + + |