diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/compile.scm | 90 | ||||
-rw-r--r-- | modules/language/python/dict.scm | 39 | ||||
-rw-r--r-- | modules/language/python/dir.scm | 41 | ||||
-rw-r--r-- | modules/language/python/list.scm | 17 | ||||
-rw-r--r-- | modules/language/python/string.scm | 72 | ||||
-rw-r--r-- | modules/oop/pf-objects.scm | 8 |
6 files changed, 185 insertions, 82 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index a338bf9..610546f 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -30,6 +30,7 @@ (define-inlinable (Di x) `(@@ (language python dict) ,x)) (define-inlinable (O x) `(@@ (oop pf-objects) ,x)) (define-inlinable (G x) `(@ (guile) ,x)) +(define-inlinable (H x) `(@ (language python hash) ,x)) @@ -215,6 +216,11 @@ ... h)) +(define (fast-ref x) + (aif it (assoc x `((__class__ . ,(O 'py-class)))) + (cdr it) + #f)) + (define fasthash (mkfast ;; General @@ -225,7 +231,7 @@ ((__ne__) (O 'ne)) ((__eq__) (O 'equal?)) ((__repr__) (O 'repr)) - + ;;iterators ((__iter__) (F 'wrap-in)) ((__next__) (F 'next)) @@ -309,7 +315,9 @@ ((popitem) (Di 'py-popitem)) ((setdefault) (Di 'py-setdefault)) ((update) (Di 'py-update)) - ((clear) (Di 'py-clear)))) + ((clear) (Di 'py-clear)) + ((__hash__) (H 'py-hash)))) + (define (fastfkn x) (hash-ref fasthash x)) @@ -357,14 +365,19 @@ ((#:identifier . _) (let* ((tag (exp vs x)) (xs (gensym "xs")) - (is-fkn? (aif it (and is-fkn? (fastfkn tag)) + (fast (fastfkn tag)) + (is-fkn? (aif it (and is-fkn? fast) `(#:call-obj (lambda (e) `(lambda ,xs (apply ,it ,e ,xs)))) #f))) (if is-fkn? is-fkn? - `(#:identifier ',tag)))) + (if fast + `(#:fastfkn-ref ,fast ',tag) + (aif it (fast-ref tag) + `(#:fast-id ,it ',tag) + `(#:identifier ',tag)))))) ((#:arglist args apply #f) (call-with-values (lambda () (get-kwarg vs args)) @@ -493,64 +506,9 @@ `(expt ,x ,(exp vs **)) x)) (pw - (let lp ((e vf) (trailer trailer)) - (match trailer - (() - e) - ((#f) - (list e)) - ((x . trailer) - (let ((is-fkn? (match trailer - ((#f) #t) - (((#:arglist . _) . _) - #t) - (_ - #f)))) - (match (pr x) - ((#:identifier . _) - (let* ((tag (exp vs x)) - (xs (gensym "xs")) - (is-fkn? (aif it (and is-fkn? (fastfkn tag)) - `(lambda ,xs (apply ,it ,e ,xs)) - #f))) - (lp (if is-fkn? - is-fkn? - `(,(O 'refq) ,e ',tag #f)) - trailer))) - - ((#:arglist args apply #f) - (call-with-values (lambda () (get-kwarg vs args)) - (lambda (args kwarg) - (if apply - (lp `(apply ,e - ,@args - ,@kwarg - ,`(,(L 'to-list) ,(exp vs apply))) - trailer) - (lp `(,e ,@args ,@kwarg) trailer))))) - - ((#:subscripts (n #f #f)) - `(,(L 'pylist-ref) ,e ,(exp vs n))) - - ((#:subscripts (n1 n2 n3)) - (let ((w (lambda (x) (if (eq? x None) (E 'None) x)))) - `(,(L 'pylist-slice) ,e - ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3))))) - - ((#:subscripts (n #f #f) ...) - `(,(A 'pyarray-ref) ,e (list ,@ (map (lambda (n) - (exp vs n)) - n)))) - - ((#:subscripts (n1 n2 n3) ...) - (let ((w (lambda (x) (if (eq? x None) (E 'None) x)))) - `(,(A 'pyarray-slice) ,e - (list ,@(map (lambda (x y z) - `(list ,(exp vs x) ,(exp vs y) ,(exp vs z))) - n1 n2 n3))))) - - (_ (error "unhandled trailer"))))))))))) - + (let ((trailer (get-addings vs trailer))) + `(,(C 'ref-x) ,vf ,@trailer)))))) + (#:identifier ((#:identifier x . _) (string->symbol x))) @@ -1594,6 +1552,10 @@ (syntax-rules () ((_ v) v) + ((_ v (#:fastfkn-ref f _) . l) + (ref-x (lambda x (if (py-class? v) (apply f x) (apply f v x))) . l)) + ((_ v (#:fast-id f _) . l) + (ref-x (f v) . l)) ((_ v (#:identifier x) . l) (ref-x (refq v 'x) . l)) ((_ v (#:identifier x) . l) @@ -1633,6 +1595,10 @@ (define-syntax set-x-2 (syntax-rules () + ((_ v (#:fastfkn-ref f id) val) + (set v id val)) + ((_ v (#:fastid-ref f id) val) + (set v id val)) ((_ v (#:identifier x) val) (set v x val)) ((_ v (#:vecref n) val) diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm index 6c88ee4..5b6567b 100644 --- a/modules/language/python/dict.scm +++ b/modules/language/python/dict.scm @@ -14,7 +14,7 @@ py-copy py-fromkeys py-get py-has_key py-items py-iteritems py-iterkeys py-itervalues py-keys py-values py-popitem py-setdefault py-update py-clear - py-hash-ref + py-hash-ref dict pyhash-listing )) (define (h x n) (modulo (py-hash x) n)) @@ -473,3 +473,40 @@ (define-method (in key (o <py-hashtable>)) (py-has_key o key)) +(define-python-class dict (<py-hashtable>) + (define __init__ + (case-lambda + ((self) + (let ((r (make-py-hashtable))) + (slot-set! self 't (slot-ref r 't)) + (slot-set! self 'h (slot-ref r 'h)) + (slot-set! self 'n (slot-ref r 'n)))) + ((self x) + (__init__ self) + (if (is-a? x <py-hashtable>) + (hash-for-each + (lambda (k v) + (pylist-set! self k v)) + (slot-ref x 't))))))) + +(define (pyhash-listing) + (let ((l (to-pylist + (map symbol->string + '(__class__ __cmp__ __contains__ __delattr__ + __delitem__ __doc__ __eq__ __format__ + __ge__ __getattribute__ __getitem__ + __gt__ __hash__ __init__ __iter__ + __le__ __len__ __lt__ __ne__ __new__ + __reduce__ __reduce_ex__ __repr__ + __setattr__ __setitem__ __sizeof__ + __str__ __subclasshook__ + clear copy fromkeys get has_key + items iteritems iterkeys itervalues + keys pop popitem setdefault update + values viewitems viewkeys viewvalues))))) + (pylist-sort! l) + l)) + + +(define-method (py-class (o <hashtable>)) dict) +(define-method (py-class (o <py-hashtable>)) dict) diff --git a/modules/language/python/dir.scm b/modules/language/python/dir.scm index 2f23e35..36b4f02 100644 --- a/modules/language/python/dir.scm +++ b/modules/language/python/dir.scm @@ -82,18 +82,45 @@ (hash-for-each (lambda (k v) (set! l (cons k l))) h) (to-pylist (map symbol->string (sort l <)))))) -(define-method (dir (o <py-list> )) +(define-method (dir (o <py-list>)) (let ((l1 (pylist-listing))) (if (is-a? o <p>) - (let* ((l2 (next-method)) + (let* ((l2 (pk (next-method))) (l (+ l1 l2))) (pylist-sort! l) - l)))) + l) + l1))) + +(define-method (dir (o <py-hashtable>)) + (let ((l1 (pyhash-listing))) + (if (is-a? o <p>) + (let* ((l2 (pk (next-method))) + (l (+ l1 l2))) + (pylist-sort! l) + l) + l1))) + +(define-method (dir (o <py-string>)) + (let ((l1 (pystring-listing))) + (if (is-a? o <p>) + (let* ((l2 (pk (next-method))) + (l (+ l1 l2))) + (pylist-sort! l) + l) + l1))) -(define-method (dir (o <hashtable> )) pyhash-listing) -(define-method (dir (o <py-hashtable>)) pyhash-listing) -(define-method (dir (o <string> )) string-listing) - +(define-method (dir (o <hashtable> )) (pyhash-listing)) +(define-method (dir (o <string> )) (pystring-listing)) + +(define-method (dir) + (let ((l '())) + (module-for-each (lambda (m . u) + (set! l (cons (symbol->string m) l))) + (current-module)) + (let ((ret (to-pylist l))) + (pylist-sort! ret) + ret))) + diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 779ed73..1afa56f 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -298,6 +298,13 @@ (define-method (+ (o1 <string>) (o2 <string>)) (string-append o1 o2)) +(define-method (+ (o1 <symbol>) (o2 <symbol>)) + (string->symbol + (string-append + (symbol->string o1) + (symbol->string o2)))) + +(define-method (* (x <integer>) (o1 <py-list>)) (* o1 x)) (define-method (* (o1 <py-list>) (x <integer>)) (let* ((vec (slot-ref o1 'vec)) (n (slot-ref o1 'n)) @@ -318,6 +325,7 @@ (slot-set! o 'vec vec2) o)) +(define-method (* (x <integer>) (vec <string>)) (* vec x)) (define-method (* (vec <string>) (x <integer>)) (let* ((n (string-length vec)) (n2 (* n x)) @@ -333,6 +341,7 @@ (lp1 (+ i 1) j))))) vec2)) +(define-method (* (x <integer>) (l <pair>)) (* l x)) (define-method (* (l <pair>) (x <integer>)) (let lp1 ((i 0)) (if (< i x) @@ -343,12 +352,6 @@ '()))) -(define-method (+ (o1 <pair>) (o2 <pair>)) - (append o1 o2)) - -(define-method (+ (o1 <string>) (o2 <string>)) - (string-append o1 o2)) - ;;REVERSE (define-method (pylist-reverse! (o <py-list>)) (let* ((N (slot-ref o 'n)) @@ -690,6 +693,8 @@ (define pylist list) +(define-method (py-class (o <py-list>) list)) + (define (pylist-listing) (let ((l (to-pylist diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 27dd8b8..4b22716 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -1,6 +1,7 @@ (define-module (language python string) #:use-module (oop goops) #:use-module (oop pf-objects) + #:use-module (language python hash) #:use-module (ice-9 match) #:use-module (language python list) #:use-module (language python exceptions) @@ -12,14 +13,19 @@ py-rljust py-lower py-upper py-lstrip py-rstrip py-partition py-replace py-strip py-title py-rpartitio py-rindex py-split py-rsplit py-splitlines - py-startswith py-swapcase py-translate py-zfill)) + py-startswith py-swapcase py-translate py-zfill + pystring-listing <py-string> pystring)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define-class <py-string> () str) + (define-syntax-rule (define-py (f n o . u) code ...) - (begin - (define-method (f (o <string>) . u) code ...) - (define-method (f (o <p>) . l) (apply (ref o 'n) l)))) + (begin + (define-method (f (o <string>) . u) code ...) + (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l)) + (define-method (f (o <p>) . l) ((ref o 'n) l)))) (define-py (py-capitalize capitalize s) (let* ((n (len s)) @@ -444,6 +450,20 @@ (define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y))) +(define-syntax-rule (mkop op) + (begin + (define-method (op (s1 <string>) (s2 <py-string>)) + (op s1 (slot-ref s2 'str))) + (define-method (op (s2 <py-string>) (s1 <string>)) + (op s1 (slot-ref s2 'str))))) + +(mkop <) +(mkop <=) +(mkop >) +(mkop >=) +(mkop +) +(mkop *) + (define-method (< (s1 <string>) (s2 <string>)) (string-ci< s1 s2)) (define-method (<= (s1 <string>) (s2 <string>)) (string-ci<= s1 s2)) (define-method (> (s1 <string>) (s2 <string>)) (string-ci> s1 s2)) @@ -471,3 +491,47 @@ w)) (lp (+ i 1)))) s)))) + +(define-python-class string (<py-string>) + (define __init__ + (case-lambda + ((self s) + (cond + ((is-a? s <py-string>) + (slot-set! self 'str (slot-ref s 'src))) + ((is-a? s <string>) + (slot-set! self 'str s))))))) + +(define pystring string) + +(define-method (py-class (o <string>)) string) +(define-method (py-class (o <py-string>)) string) + +(define-method (pyhash (o <py-string>)) (hash (slot-ref o 'str) pyhash-N)) + +(define-method (equal? (o <py-string>) x) + (equal? (slot-ref o 'str) x)) +(define-method (equal? x (o <py-string>)) + (equal? (slot-ref o 'str) x)) + +(define (pystring-listing) + (let ((l (to-pylist + (map symbol->string + '(__add__ __class__ __contains__ __delattr__ __doc__ + __eq__ __format__ __ge__ __getattribute__ + __getitem__ __getnewargs__ __getslice__ __gt__ + __hash__ __init__ __le__ __len__ __lt__ __mod__ + __mul__ __ne__ __new__ __reduce__ __reduce_ex__ + __repr__ __rmod__ __rmul__ __setattr__ __sizeof__ + __str__ __subclasshook__ + _formatter_field_name_split _formatter_parser + capitalize center count decode encode endswith + expandtabs find format index isalnum isalpha + isdigit islower isspace istitle isupper join + ljust lower lstrip partition replace rfind rindex + rjust rpartition rsplit rstrip split splitlines + startswith strip swapcase + title translate upper zfill))))) + (pylist-sort! l) + l)) + diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 6847524..62c522b 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -9,7 +9,7 @@ def-p-class mk-p-class make-p-class def-pyf-class mk-pyf-class make-pyf-class def-py-class mk-py-class make-py-class - define-python-class get-type + define-python-class get-type py-class )) #| Python object system is basically syntactic suger otop of a hashmap and one @@ -686,5 +686,9 @@ explicitly tell it to not update etc. (code ...)))) (define (pyclass? x) - (and (is-a? x <p>) (not (ref x '__class__)))) + (and (is-a? x <p>) + (not (ref x '__class__)))) + +(define-method (py-class (o <p>)) + (ref o '__class__ 'type)) |