diff options
-rw-r--r-- | modules/language/python/for.scm | 4 | ||||
-rw-r--r-- | modules/language/python/list.scm | 45 | ||||
-rw-r--r-- | modules/language/python/module/collections.scm | 426 | ||||
-rw-r--r-- | modules/language/python/module/collections/abc.scm | 354 | ||||
-rw-r--r-- | modules/language/python/module/heapq.scm | 236 | ||||
-rw-r--r-- | modules/language/python/module/operator.scm | 56 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 32 | ||||
-rw-r--r-- | modules/language/python/try.scm | 13 | ||||
-rw-r--r-- | modules/oop/pf-objects.scm | 46 |
9 files changed, 1088 insertions, 124 deletions
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm index 8db5aa7..4541df2 100644 --- a/modules/language/python/for.scm +++ b/modules/language/python/for.scm @@ -77,7 +77,9 @@ (set! x x1) ... ... (call-with-values - #,(wrap-continue #'lp #'(code ...)) + #,(wrap-continue + #'lp + #'((let ((x x) ... ...) code ...))) (lambda (cc ... . q) (llp cc ...))))) (lambda q fin)))))))))) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 0cbd30a..b101da7 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -11,7 +11,7 @@ #:use-module (language python try) #:use-module (language python exceptions) #:use-module (language python persist) - #:export (to-list to-pylist <py-list> + #:export (to-list to-pylist <py-list> py-list pylist-append! pylist-slice pylist-subset! pylist-reverse! pylist-pop! pylist-count pylist-extend! len in @@ -252,9 +252,7 @@ (vec (slot-ref o 'vec)) (N (vector-length vec))) (if (< n N) - (begin - (vector-set! vec n val) - (slot-set! o 'n (+ n 1))) + (vector-set! vec n val) (let* ((N (* 2 N)) (vec2 (make-vector N))) (let lp ((i 0)) @@ -540,6 +538,14 @@ (slot-set! out 'd 1) out)) +(define-method (wrap-in (o <vector>)) + (let ((out (make <py-list-iter>))) + (slot-set! out 'n (vector-length o)) + (slot-set! out 'vec o) + (slot-set! out 'i 0) + (slot-set! out 'd 1) + out)) + (define-method (py-reversed (o <py-list>)) (let ((out (make <py-list-iter>))) (slot-set! out 'i (- (slot-ref o 'n) 1)) @@ -574,23 +580,9 @@ (next-method))))) -(define-method (wrap-in (o <py-list-iter>)) - (let ((out (make <py-list-iter>))) - (slot-set! out 'vec (slot-ref o 'vec)) - (slot-set! out 'i (slot-ref o 'i)) - (slot-set! out 'n (slot-ref o 'n)) - (slot-set! out 'd (slot-ref o 'd)) - out)) - -(define-method (wrap-in (o <py-seq-iter>)) - (let ((out (make <py-seq-iter>))) - (slot-set! out 'o (slot-ref o 'o)) - (slot-set! out 'i (slot-ref o 'i)) - (slot-set! out 'n (slot-ref o 'n)) - (slot-set! out 'd (slot-ref o 'd)) - out)) - +(define-method (wrap-in (o <py-list-iter>)) o) +(define-method (wrap-in (o <py-seq-iter>)) o) (define-method (wrap-in (o <py-seq-iter> )) o) @@ -832,6 +824,8 @@ (for ((x1 : o1) (x2 : o2)) () (if (< x1 x2) (break #t)) + (if (> x1 x2) + (break #f)) #:final (< n1 n2)))) @@ -841,6 +835,9 @@ (for ((x1 : o1) (x2 : o2)) () (if (< x1 x2) (break #t)) + (if (> x1 x2) + (break #f)) + #:final (<= n1 n2)))) @@ -850,6 +847,9 @@ (for ((x1 : o1) (x2 : o2)) () (if (> x1 x2) (break #t)) + (if (< x1 x2) + (break #f)) + #:final (> n1 n2)))) @@ -859,6 +859,9 @@ (for ((x1 : o1) (x2 : o2)) () (if (> x1 x2) (break #t)) + (if (< x1 x2) + (break #f)) + #:final (>= n1 n2)))) @@ -932,3 +935,5 @@ (break #t)) #:final #f)) + +(define py-list list) diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm index bfb75fa..601ce7e 100644 --- a/modules/language/python/module/collections.scm +++ b/modules/language/python/module/collections.scm @@ -1,7 +1,237 @@ (define-module (language python module collections) #:use-module (oop pf-objects) #:use-module (language python module collections abc) - #:export (ChainMap)) + #:use-module (language python module heapq) + #:use-module (language python for) + #:use-module (language python yield) + #:use-module (language python def) + #:use-module (language python list) + #:use-module (language python string) + #:use-module (language python dict) + #:use-module (language python exceptions) + #:use-module ((language python module python) + #:select ((map . pymap))) + + #:export (abc OrderedDict ChainMap Counter UserDict UserString UserList)) + +(define-python-class class-from-dict () + (define __init__ + (lambda (self d) + (set self '__dict__ d)))) + +(define abc + (class-from-dict + (resolve-module (module-public-interface + '(language python module collections abc))))) + +(define-python-class _OrderedDictKeysView (KeysView) + (define __reversed__ + (lambda (self) + ((make-generator () + (lambda (yield) + (for ((k v : (reversed (reg self '_mapping)))) + (yield k)))))))) + +(define-python-class _OrderedDictValuesView (ValuesView) + (define __reversed__ + (lambda (self) + ((make-generator () + (lambda (yield) + (for ((k v : (reversed (reg self '_mapping)))) + (yield v)))))))) + +(define-python-class _OrderedDictItemsView (ItemsView) + (define __reversed__ + (lambda (self) + ((make-generator () + (lambda (yield) + (for ((k v : (reversed (reg self '_mapping)))) + (yield (list k v))))))))) + +(define-inlinable (link) (vector 0 0 0)) +(define-inlinable (get-prev l) (vector-ref l 0)) +(define-inlinable (get-next l) (vector-ref l 1)) +(define-inlinable (get-key l) (vector-ref l 2)) +(define-inlinable (set-prev! l v) (vector-set! l 0 v)) +(define-inlinable (set-next! l v) (vector-set! l 1 v)) +(define-inlinable (set-key! l v) (vector-set! l 2 v)) + +(define proxy (list 'mu)) + +(define <dict> (cons <py-hashtable> '_)) +(define dict-set! (resolve-method-c pylist-set! <dict>)) +(define dict-ref (resolve-method-c pylist-ref <dict>)) +(define dict-del! (resolve-method-c pylist-delete! <dict>)) +(define dict-pop! (resolve-method-c pylist-pop! <dict>)) +(define dict-clear! (resolve-method-c pylist-clear! <dict>)) + +(define-python-class OrderedDict (dict) + (define __init__ + (lam (self (* args) (** kwds)) + (if (> (len args) 1) + (raise TypeError + (format #f + "expected at most 1 arguments, got %d" + (len args)))) + + (try + (lambda () (ref self '__root)) + (#:except AttributeError => + (lambda x + (let* ((l (link))) + (set self '__root l) + (set-next! l l) + (set-prev! l l))))) + + (set self '__map (dict)) + (py-apply py-update self (* args) (** kwds)))) + + (define __setitem__ + (lambda* (self key value #:key + (dict_setitem dict-set!) + (proxy #f) + (link link)) + (if (in key self) + (let* ((link (link)) + (root (ref self '__root)) + (last (get-last root))) + (pylist-set! (ref self '__map) key link) + (set-prev! link last) + (set-next! link root) + (set-key! link key) + (set-next! last link) + (set-prev! root link) + (dict_setitem self key value))))) + + (define __delitem__ + (lambda* (self key #:key + (dict_delitem dict-set!) + (dict_delitem dict-del!)) + (let ((link (pylist-pop! (ref self '__map) key)) + (link_prev (get-prev link)) + (link_next (get-next link))) + (set-next! link_prev link_next) + (set-prev! link_next link_prev) + (set-next! link None) + (set-prev! link None)))) + + (define __iter__ + (lambda* (self #:key (get-next get-next)) + ((make-generator () + (lambda (yield) + (let ((root (ref self '__root))) + (let lp ((curr (get-next root))) + (if ((not (eq? curr root))) + (let ((key (get-key curr))) + (yield key (pylist-ref self key)) + (lp (get-next curr))))))))))) + + (define __reversed__ + (lambda (self) + (__iter__ self #:get-next get-prev))) + + (define clear + (lambda (self) + (let ((root (ref self '__root))) + (set-prev! root root) + (set-next! root root) + + (py-clear (ref self '__map)) + (dict-clear! self)))) + + (define popitem + (lambda* (self #:key (last #t)) + (if (= (len self) 0) + (raise KeyError "dictionary is empty")) + (let ((root (ref self '__root))) + (let* ((link + (if last + (let* ((link (get-prev root)) + (prev (get-prev link))) + (set-next! prev root) + (set-prev! root prev) + link) + (let* ((link (get-next root)) + (prev (get-next link))) + (set-prev! prev root) + (set-next! root prev) + link))) + (key (get-key link))) + (dict-del! (ref self '__map) key) + (values key + (dict-pop! self key)))))) + + (define move_to_end + (lambda* (self key #:key (last #t)) + (let* ((link (pylist-ref (ref self '__map) key)) + (prev (get-prev link)) + (next (get-next link))) + (set-next! prev next) + (set-prev! next prev) + (let ((root (ref self '__root))) + (if last + (let ((last (get-prev root))) + (set-prev! link last) + (set-next! link root) + (set-prev! root link) + (set-next! last link)) + (let ((first (get-next root))) + (set-prev! link root) + (set-next! link first) + (set-prev! first link) + (set-next! root link))))))) + + (define update (ref MutableMapping 'update)) + (define __update update) + + (define keys + (lambda (self) _OrderedDictKeysView(self))) + (define items + (lambda (self) _OrderedDictItemsView(self))) + (define values + (lambda (self) _OrderedDictValuesView(self))) + + (define __ne__ (ref MutableMapping '__ne__)) + + (define __marker (object)) + + (define pop + (lambda* (self key #:key (default __marker)) + (if (in key self) + (let ((result (dict-ref self key))) + (__delitem__ self key) + result) + (if (eq? default __marker) + (raise KeyError key) + default)))) + + (define setdefault + (lambda* (self key #:key (default None)) + (if (in key self) + (dict-ref self key) + (begin + (__setitem__ self key default) + default)))) + + (define copy + (lambda (self) + ((ref self '__class__) self))) + + (define fromkeys + (classmethod + (lambda* (cls iterable #key (value None)) + (let ((self (cls))) + (for ((key : iterable)) () + (__setitem__ self key value)) + self)))) + + (define __eq__ + (lambda (self other) + (if (isinstance other OrderedDict) + (and ((dict-equal? self other) + (all (map _equal self other))) + ((ref dict '__eq__) self other)))) + (define (u self) (let ((s (set))) @@ -132,7 +362,7 @@ "expected at most 1 arguments, got ~ a" (length args)))) ((ref (super Counter self) '__init__)) - (py-apply (ref self 'update) (* args) (** kwds)))) + (py-apply py-update self (* args) (** kwds)))) (define __missing__ (lambda (self key) 0)) @@ -140,17 +370,197 @@ (define most_common (lambda* (self #:key (n None)): (if (eq? n None) - (sorted ((ref self 'items) #:key (_itemgetter 1) #:reverse #t) - _heapq.nlargest(n ((ref self 'items)) #:key (_itemgetter 1)) + (sorted ((ref self 'items) #:key (_itemgetter 1) #:reverse #t)) + (nlargest n (py-items self) #:key (_itemgetter 1))))) + (define elements + (lambda (self) + ((make-generator () + (for ((k v : self)) () + (if (and (number? v) (integer? v) (> v 0)) + (for ((i : range(v))) () + (yield k)))))))) - + (define fromkeys + (lambda x + (raise NotImplementedError))) + + + (define update + (lam (self (* args) (** kwds)) + (if (> (len args) 1) + (raise TypeError + (format #f "expected at most 1 arguments, got %d" + (len args)))) + + (let ((iterable (pylist-get args o None))) + (if (not (eq? iterable None)) + (if (is-a? iterable <py-dict>) + (for ((elem count : iterable)) () + (pylist-set! self elem + (+ count (pylist-get self elem 0)))) + (for ((k : iterable)) () + (pylist-set! self elem + (+ 1 (pylist-get self elem 0))))))) + + (for ((k v : kwds)) () + (pylist-set! self k + (+ count (pylist-get self k 0)))))) + (define subtracts + (lam (self (* args) (** kwds)) + (if (> (len args) 1) + (raise TypeError + (format #f "expected at most 1 arguments, got %d" + (len args)))) + + (let ((iterable (pylist-get args 0 None))) + (if (not (eq? iterable None)) + (if (is-a? iterable <py-dict>) + (for ((elem count : iterable)) () + (pylist-set! self elem + (- (pylist-get self elem 0) count))) + (for ((elem : iterable)) () + (pylist-set! self elem + (- (pylist-get self elem 0) 1)))))) + + (for ((k v : kwds)) () + (pylist-set! self k + (- (pylist-get self k 0) v))))) + + (define __delitem__ + (lambda (self k) + (if (in k self) + ((ref dict '__delitem__) k)))) + + + (define __add__ + (lambda (self other) + (if (not (isinstance other Counter)) + NotImplemented + (let ((result (Counter))) + (for ((elem count : self)) () + (let ((newcount (+ count (pylist-ref other elem)))) + (if (> newcount 0) + (pylist-set! result elem newcount)))) + + (for ((elem count : other)) + (if (and (not (in elem self)) + (> count 0)) + (pylist-set! result elem count))) + + return)))) + + (define __sub__ + (lambda (self other) + (if (not (isinstance other Counter)) + NotImplemented + (let ((result (Counter))) + (for ((elem count : self)) () + (let ((newcount (- count (pylist-ref other elem)))) + (if (> newcount 0) + (pylist-set! result elem newcount)))) + + (for ((elem count : other)) + (if (and (not (in elem self)) + (> count 0)) + (pylist-set! result elem (- count)))) + + return)))) + + (define __or__ + (lambda (self other) + (if (not (isinstance other Counter)) + NotImplemented + (let ((result (Counter))) + (for ((elem count : self)) () + (let ((newcount (max count (pylist-ref other elem)))) + (if (> newcount 0) + (pylist-set! result elem newcount)))) + + (for ((elem count : other)) () + (if (and (not (in elem self)) + (> count 0)) + (pylist-set! result elem count))) + + return)))) + + (define __and__ + (lambda (self other) + (if (not (isinstance other Counter)) + NotImplemented + (let ((result (Counter))) + (for ((elem count : self)) () + (let ((newcount (min count (pylist-ref other elem)))) + (if (> newcount 0) + (pylist-set! result elem newcount)))) + return)))) + + (define __pos__ + (lambda (self) + (let ((result (Counter))) + (for ((elem count : self)) + (if (> count 0) + (pylist-set! result elem count))) + result))) + + + (define __neg__ + (lambda (self) + (let ((result (Counter))) + (for ((elem count : self)) () + (if (< count 0) + (pylist-set! result elem (- count)))) + result))) + + (define _keep_positive + (lambda (self) + (define ks + (for ((k v : self)) (l '()) + (if (<= v 0) + (cons k l) + l))) + (let lp ((ks ks)) + (if (pair? ks) + (begin + (pylist-remove! self (car ks)) + (lp (cdr ks))))) + self)) + + (define __iadd__ + (lambda (self, other) + (for ((elem count : other)) + (pylist-set! self elem + (+ (pylist-get self elem 0) count))) + ((ref self '_keep_positive)))) + + (define __isub__ + (lambda (self, other) + (for ((elem count : other)) + (pylist-set! self elem + (- (pylist-get self elem 0) count))) + ((ref self '_keep_positive)))) + + (define __ior__ + (lambda (self, other) + (for ((elem count : other)) + (pylist-set! self elem + (max (pylist-get self elem 0) count))) + ((ref self '_keep_positive)))) + + (define __iand__ + (lambda (self, other) + (for ((elem count : other)) + (pylist-set! self elem + (min (pylist-get self elem 0) count))) + ((ref self '_keep_positive))))) + +(define-python-class UserDict (dict)) +(define-python-class UserString (py-string)) +(define-python-class UserList (py-list)) - -(define* (namedtuple typename field-names #key (verbose #f) (rename=#f) -(module None)) + diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm index c056834..d526e73 100644 --- a/modules/language/python/module/collections/abc.scm +++ b/modules/language/python/module/collections/abc.scm @@ -1,15 +1,29 @@ (define-module (language python module collections abc) #:use-module (oop pf-objects) + #:use-module (language python for) + #:use-module (language python try) + #:use-module (language python exceptions) + #:use-module (language python def) + #:use-module (language python set) + #:use-module (language python list) + #:use-module (language python range) + #:use-module (language python yield) + #:use-module (language python persist) #:export (Container Hashable Iterable Iterator Reversable Generator Sized Callable Collection Sequence MutableSequence ByteString Set MutableSet Mapping MutableMapping MappingView ItemsView KeysView ValuesView)) +(define s:set (@@ (language python set) set)) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + + (define-python-class Container () (define __containes__ (lambda x (error "not implemented")))) -(define-python.class Hashable () +(define-python-class Hashable () (define __hash__ (lambda x (error "not implemented")))) @@ -59,34 +73,34 @@ ;; Mixin (define __contains__ (lambda (self x) - (let ((f (ref self '__getitem))) - (for ((i : (range (len self)))) - (if (equal? x (f i)) + (let ((get (ref self '__getitem))) + (for ((i : (range (len self)))) () + (if (equal? x (get i)) (break #t)) #:final #f)))) (define __iter__ (lambda (self) - ((mk-iterator + ((make-generator (lambda (yield) (let ((f (ref self '__getitem))) - (for ((i : (range (len self)))) + (for ((i : (range (len self)))) () (yield (f i))))))))) (define __reversed__ (lambda (self) - ((mk-iterator + ((make-generator (lambda (yield) (let ((f (ref self '__getitem))) - (for ((i : (range (len self) 0 -1))) + (for ((i : (range (len self) 0 -1))) () (yield (f i))))))))) (define index (lambda (self x) (let ((f (ref self '__getitem__))) - (for ((i : (range (len self)))) + (for ((i : (range (len self)))) () (if (equal? x (f i)) - (break y)) + (break i)) (raise IndexError))))) (define count @@ -103,6 +117,7 @@ (define __getitem__ (lambda x (error "not implemented")))) + (define-python-class MutableSequence (Sequence) ;; Mixin (define append @@ -127,7 +142,7 @@ (define remove (lambda (self x) (let ((f (ref self '__getitem__))) - (for ((i : (range (len self)))) + (for ((i : (range (len self)))) () (if (equal? x (f i)) (begin ((ref self '__delitem__) i) @@ -152,14 +167,17 @@ (define insert (lambda x (error "not implemented")))) + (define-python-class ByteString (Sequence)) (define-python-class Set (Collection) ;; Mixins (define __le__ (lambda (self o) - (let ((f (ref o '__contains__))) - (for ((x : ((ref self '__iter__)))) + (let ((f (aif it (ref o '__contains__) + it + (lambda (x) (in x o))))) + (for ((x : self)) () (if (not (f x)) (break #f)))))) @@ -167,8 +185,10 @@ (lambda (self o) (if (equal? (len self) (len o)) #f - (let ((f (ref o '__contains__))) - (for ((x : ((ref self '__iter__)))) + (let ((f (aif it (ref o '__contains__) + it + (lambda (x) (in x o))))) + (for ((x : self)) () (if (not (f x)) (break #f))))))) @@ -176,8 +196,10 @@ (lambda (self o) (if (not (equal? (len self) (len o))) #f - (let ((f (ref o '__contains__))) - (for ((x : ((ref self '__iter__)))) + (let ((f (aif it (ref o '__contains__) + it + (lambda (x) (in x o))))) + (for ((x : self)) () (if (not (f x)) (break #f))))))) @@ -189,71 +211,75 @@ (if (equal? (len self) (len o)) #f (let ((f (ref self '__contains__))) - (for ((x : ((ref o '__iter__)))) + (for ((x : o)) () (if (not (f x)) (break #f))))))) (define __ge__ (lambda (self o) (let ((f (ref self '__contains__))) - (for ((x : ((ref o '__iter__)))) + (for ((x : o)) () (if (not (f x)) (break #f)))))) (define __and__ (lambda (self o) - (let ((f (ref o '__contains__)) - (s (set)) - (a (ref s 'add))) - (for ((x : ((ref self '__iter__)))) () + (let* ((f (aif it (ref o '__contains__) + it + (lambda (x) (in x o)))) + (s (s:set)) + (a (ref s 'add))) + (for ((x : self)) () (if (f x) (a x))) s))) (define __or__ (lambda (self o) - (let ((s (set)) - (a (ref s 'add))) - (for ((x : ((ref self '__iter__)))) () + (let* ((s (s:set)) + (a (ref s 'add))) + (for ((x : self)) () (a x)) - (for ((x : ((ref o '__iter__)))) () + (for ((x : o)) () (a x)) s))) (define __sub__ (lambda (self o) - (let ((f (ref o '__contains__)) - (s (set)) - (a (ref s 'add))) - (for ((x : ((ref self '__iter__)))) () + (let* ((f (ref o '__contains__)) + (s (s:set)) + (a (ref s 'add))) + (for ((x : self)) () (if (not (f x)) (a x))) s))) (define __xor__ (lambda (self o) - (let ((fo (ref o '__contains__)) - (fs (ref self '__contains__)) - (s (set)) - (a (ref s 'add))) - (for ((x : ((ref self '__iter__)))) () + (let* ((fo (aif it (ref o '__contains__) + it + (lambda (x) (in x o)))) + (fs (ref self '__contains__)) + (s (s:set)) + (a (ref s 'add))) + (for ((x : self)) () (if (not (fo x)) (a x))) - (for ((x : ((ref o '__iter__)))) () + (for ((x : o)) () (if (not (fs x)) (a x))) s))) (define disjoint (lambda (self o) - (let ((f (ref o '__contains__)) - (s (set)) - (a (ref s 'add))) - (for ((x : ((ref self '__iter__)))) () + (let ((f (aif it (ref o '__contains__) + it + (lambda (x) (in x o))))) + (for ((x : self)) () (if (f x) (break #f)) #:final #t))))) - + (define-python-class MutableSet (Set) ;; Abstract methods (define add @@ -262,35 +288,212 @@ (lambda x (error "not implemented"))) ;; Mixins - (define clear) - (define pop) - (define remove) - (define __ior__) - (define __iand__) - (define __ixor__) - (define __isub__)) + (define clear + (lambda (self) + (define discard (ref self 'discard)) + (for ((x : (for ((x : self)) ((l '())) + (cons x l) + #:final l))) () + (discard x)))) + + + + (define pop + (lambda (self) + (let ((x (for ((x : self)) () + (break x) + #:final + (raise KeyError)))) + ((ref self 'discard) x) + x))) + + (define remove + (lambda (self x) + (if (in x self) + ((ref self 'discard) x) + (raise KeyError)))) + + (define __ior__ + (lambda (self o) + (let ((add (ref self 'add))) + (for ((x : o)) () + (add x))))) + + (define __iand__ + (lambda (self o) + (define o-contains (aif it (ref o '__contains__) + it + (lambda (x) (in o x)))) + + (define s-discard (ref self 'discard)) + + (for ((x : (for ((x : self)) ((l '())) + (if (o-contains x) + l + (cons x l))))) () + + (s-discard x)))) + + + (define __ixor__ + (lambda (self o) + (define o-contains (aif it (ref o '__contains__) + it + (lambda (x) (in o x)))) + + (define s-contains (ref self '__contains__)) + (define s-add (ref self 'add)) + (define s-discard (ref self 'discard)) + + (let ((rems (for ((x : self)) ((l '())) + (if (o-contains x) + (cons x l) + l) + #:final l)) + (adds (for ((x : o)) ((l '())) + (if (s-contains x) + l + (cons x l))))) + (let lp ((rems rems)) + (if (pair? rems) + (begin + (s-discard (car rems)) + (lp (cdr rems))))) + (let lp ((adds adds)) + (if (pair? adds) + (begin + (s-add (car adds)) + (lp (cdr adds)))))))) + + + (define __isub__ + (lambda (self o) + (define o-contains (aif it (ref o '__contains__) + it + (lambda (x) (in o x)))) + + (define s-discard (ref self 'discard)) + + (let ((rems (for ((x : self)) ((l '())) + (if (o-contains x) + (cons x l) + l) + #:final l))) + + (let lp ((rems rems)) + (if (pair? rems) + (begin + (s-discard (car rems)) + (lp (cdr rems))))))))) (define-python-class Mapping (Collection) + ;; Abstract + (define __getitem__ + (lambda x (error "not implemented"))) + ;; Mixins - (define __contains__) - (define keys) - (define items) - (define values) - (define get) - (define __eq__) - (define __ne__)) + (define __contains__ + (lambda (self x) + (try + (lambda () (ref self '__getitem__ x) #t) + (#:except KeyError => (lambda x #f))))) + + (define keys + (lambda (self) + (for ((k v : self)) ((l '())) + (cons k l) + #:final (reverse l)))) + + (define items + (lambda (self) + (for ((k v : self)) ((l '())) + (cons (cons k v) l) + #:final (reverse l)))) + + (define values + (lambda (self) + (for ((k v : self)) ((l '())) + (cons v l) + #:final (reverse l)))) + + (define get + (lambda* (self x #:optional (d None)) + (try + (lambda () (ref self '__getitem__ x)) + (#:except KeyError => (lambda x d))))) + + (define __eq__ + (lambda (self o) + (define o-ref (aif it (ref o '__getitem__) + it + (lambda (x) (pylist-ref o x)))) + (try + (lambda () + (for ((k v : o)) () + (if (not (equal? v (o-ref k))) + (break #f)) + #:final #t)) + (#:except KeyError => (lambda x #f))))) + + (define __ne__ + (lambda (self o) + (not ((ref self '__eq__) o))))) (define-python-class MutableMapping (Mapping) ;; Abstracts - (define __setitem__) - (define __delitem__) + (define __setitem__ (lambda x (error "not implemented"))) + (define __delitem__ (lambda x (error "not implemented"))) ;; Mixins - (define pop) - (define popitem) - (define clear) - (define update) - (define setdefault)) + (define pop + (lambda* (self k #:optional (d None)) + (try + (lambda () + (define v (pylist-ref self k)) + ((ref self '__delitem__) k) + v) + (#:except KeyError => (lambda x d))))) + + (define popitem + (lambda (self) + (for ((k v : self)) () + (break k v) + #:final + (raise KeyError)))) + + (define clear + (lambda (self) + (define l (for ((k v : self)) ((l '())) + (cons k l) + #:final l)) + (define rem (ref self '__delitem__)) + (let lp ((l l)) + (if (pair? l) + (begin + (rem (car l)) + (lp (cdr l))))))) + + (define update + (lam (self (* e) (** f)) + (define add (ref self '__setitem__)) + (let lp ((e e)) + (if (pair? e) + (begin + (for ((k v : (car e))) () + (add k v)) + (lp (cdr e))))) + (for ((k v : f)) () + (add k v)))) + + (define setdefault + (lambda* (self k #:optional (d None)) + (try + (lambda () ((ref self '__getitem__) k)) + (#:except KeyError => + (lambda x + ((ref self '__setitem__) k d) + d)))))) + (define-python-class MappingView (Sized) ;; Mixins @@ -304,7 +507,13 @@ (define-python-class ItemsView (MappingView Set) ;; Mixins (define __contains__ - (lambda (self x))) + (lambda (self x) + (let ((m (ref self '_mapping)) + (k (car x)) + (v (cdr x))) + (and (in k m) + (equal? v (pylist-ref self k)))))) + (define __iter__ (lambda (self) ((ref (ref self '_mapping) 'items))))) @@ -312,8 +521,10 @@ (define-python-class KeysView (MappingView Set) ;; Mixins (define __contains__ - (lambda (self k))) - + (lambda (self k) + (let ((m (ref self '_mapping))) + (in k m)))) + (define __iter__ (lambda (self) ((ref (ref self '_mapping) 'keys))))) @@ -321,8 +532,13 @@ (define-python-class ValuesView (MappingView) ;; Mixins (define __contains__ - (lambda (self x))) - + (lambda (self x) + (let ((m (ref self '_mapping))) + (for ((k v : m)) () + (if (equal? v x) + (break #t)) + #:final #f)))) + (define __iter__ (lambda (self) ((ref (ref self '_mapping) 'values))))) @@ -332,3 +548,5 @@ Sized Callable Collection Sequence MutableSequence ByteString Set MutableSet Mapping MutableMapping MappingView ItemsView KeysView ValuesView) + + diff --git a/modules/language/python/module/heapq.scm b/modules/language/python/module/heapq.scm new file mode 100644 index 0000000..768aee2 --- /dev/null +++ b/modules/language/python/module/heapq.scm @@ -0,0 +1,236 @@ +(define-module (language python module heapq) + #:use-module (ice-9 control) + #:use-module (language python for) + #:use-module (language python yield) + #:use-module (language python try) + #:use-module (language python exceptions) + #:use-module (language python list) + #:use-module (language python def) + #:use-module (oop pf-objects) + #:use-module ((language python module python) + #:select (zip sorted range enumerate iter max min)) + #:export (heappush heappop heapify heapreplace merge nlargest nsmallest + heappushpop)) + +(define-syntax-rule (aif it p a b) (let ((it p)) (if it a b))) + +(define (heappush heap item) + (pylist-append! heap item) + (siftdown heap 0 (- (len heap) 1))) + +(define (heappop heap) + (let ((lastelt (pylist-pop! heap))) + (if (> (len heap) 0) + (let ((ret (pylist-ref heap 0))) + (pylist-set! heap 0 lastelt) + (siftup heap 0) + ret) + lastelt))) + +(define (heapreplace heap item) + (let ((ret (pylist-ref heap 0))) + (pylist-set! heap 0 item) + (siftup heap 0) + ret)) + +(define (heapify x) + (let lp ((i (- (floor-quotient (len x) 2) 1))) + (if (>= i 0) + (begin + (siftup x i) + (lp (- i 1)))))) + +(define (heappop_max heap) + (let ((lastelt (pylist-pop! heap))) + (if (> (len heap) 0) + (let ((ret (pylist-ref heap 0))) + (pylist-set! heap 0 lastelt) + (siftup_max heap 0) + ret) + lastelt))) + +(define (heapreplace_max heap item) + (let ((ret (pylist-ref heap 0))) + (pylist-set! heap 0 item) + (siftup_max heap 0) + ret)) + +(define (heapify_max x) + (let lp ((i (- (floor-quotient (len x) 2) 1))) + (if (>= i 0) + (begin + (siftup_max x i) + (lp (- i 1)))))) + +(define (siftdown heap startpos pos) + (define newitem (pylist-ref heap pos)) + + (let lp ((pos pos)) + (if (> pos startpos) + (let () + (define parentpos (ash (- pos 1) 1)) + (define parent (pylist-ref heap parentpos)) + (if (< newitem parent) + (begin + (pylist-set! heap pos parent) + (lp parentpos)) + (pylist-set! heap pos newitem))) + (pylist-set! heap pos newitem)))) + +(define (siftup heap pos) + (define endpos (len heap)) + (define startpos pos) + (define newitem (pylist-ref heap pos)) + (let lp ((pos pos) (childpos (+ (* 2 pos) 1))) + (if (< childpos endpos) + (let* ((rightpos (+ childpos 1)) + (childpos + (if (and (< rightpos endpos) + (not (< (pylist-ref heap childpos) + (pylist-ref heap rightpos)))) + rightpos + childpos))) + (pylist-set! heap pos (pylist-ref heap childpos)) + (lp childpos (+ (* 2 childpos) 1))) + (begin + (pylist-set! heap pos newitem) + (siftdown heap startpos pos))))) + +(define (siftdown_max heap startpos pos) + (define newitem (pylist-ref heap pos)) + + (let lp ((pos pos)) + (if (> pos startpos) + (let () + (define parentpos (ash (- pos 1) 1)) + (define parent (pylist-ref heap parentpos)) + (if (< parent newitem) + (begin + (pylist-set! heap pos parent) + (lp parentpos)) + (pylist-set! heap pos newitem))) + (pylist-set! heap pos newitem)))) + +(define (siftup_max heap pos) + (define endpos (len heap)) + (define startpos pos) + (define newitem (pylist-ref heap pos)) + (let lp ((pos pos) (childpos (+ (* 2 pos) 1))) + (if (< childpos endpos) + (let* ((rightpos (+ childpos 1)) + (childpos + (if (and (< rightpos endpos) + (not (< (pylist-ref heap rightpos) + (pylist-ref heap childpos)))) + rightpos + childpos))) + (pylist-set! heap pos (pylist-ref heap childpos)) + (lp childpos (+ (* 2 childpos) 1))) + (begin + (pylist-set! heap pos newitem) + (siftdown_max heap startpos pos))))) + +(def (merge (* iterables) (= key (lambda (x) x)) (= reverse #f)) + ((make-generator () + (lambda (yield) + (define h (py-list)) + (define (h_append x) (pylist-append! h x)) + (define-values (-heapify -heappop -heapreplace direction) + (if reverse + (values heapify_max + heappop_max + heapreplace_max + -1) + (values heapify + heappop + heapreplace + 1))) + + (for ((order it : (enumerate (map iter iterables)))) () + (define next- (aif x (ref it '__next__) + x + (lambda () (next it)))) + (try + (lambda () + (h_append (vector (key (next-)) + (* order direction) + next-))) + (#:except StopIteration => + (lambda x (-heappop h))))) + + (-heapify h) + (let lp () + (if (> (len h) 1) + (try + (lambda () + (let lp () + (let ((s (pylist-ref h 0))) + (yield (vector-ref s 0)) + (vector-set! s 0 (key ((vector-ref s 2)))) + (-heapreplace h s) + (lp)))) + (#:except StopIteration => + (lambda x (-heappop h) (lp)))))) + + (if (> (len h) 0) + (let* ((x (pylist-ref h 0)) + (n (pylist-ref x 2))) + (let lp ((i (vector-ref x 0))) + (yield i) + (lp (n))))))))) + + + + +(define-syntax-rule (mkn nsmallest heapify_max heapreplace_max q< ran o ++) + (define* (nsmallest n iterable #:key (key (lambda (x) x))) + (let/ec return + (if (equal? n 1) + (return + (let* ((sent (list 1)) + (res (min (iter iterable) #:default sent #:key key))) + (if (eq? sent res) + '() + (list res))))) + + (let ((size (try + (lambda () (len iterable)) + (#:except (or TypeError AttributeError) => + (lambda x #f))))) + (if (and size (>= n size)) + (return (pylist-slice (sorted iterable #:key key) 0 + ((@ (guile) min) n size) + 1)))) + + (let ((it (iter iterable)) + (result (py-list))) + + (for ((i elem : (zip (ran n) it))) () + (pylist-append! result (vector (key elem) i elem))) + + (if (= 0 (len result)) + (return result)) + + (heapify_max result) + + (for ((elem : it)) ((top (vector-ref (pylist-ref result 0) 0)) + (order (o n))) + (let ((k (key elem))) + (if (q< k top) + (begin + (heapreplace_max result (vector k order elem)) + (values (vector-ref (pylist-ref result 0) 0) + (++ order))) + (values top order)))) + (pylist-sort! result) + (return + (let ((r (py-list))) + (for ((x : result)) () + (pylist-append! r (vector-ref x 2))) + r)))))) + +(mkn nsmallest heapify_max heapreplace_max < (lambda (n) (range n)) + (lambda (n) n) (lambda (x) (+ x 1))) + +(mkn nlargest heapify heapreplace > (lambda (n) (range 0 (- n) -1)) + (lambda (n) (- n)) (lambda (x) (- x 1))) diff --git a/modules/language/python/module/operator.scm b/modules/language/python/module/operator.scm index 70a989d..a22fde4 100644 --- a/modules/language/python/module/operator.scm +++ b/modules/language/python/module/operator.scm @@ -29,6 +29,22 @@ __imod__ __imul__ __imatmul__ __ior__ __ipow__ __irshift__ __isub__ __itruediv__ __ixor__ )) +(define (hash->assoc h) + (for ((k v : h)) ((l '())) + (cons (cons k v) l) + #:final (reverse l))) + +(define (asssoc->hash a) + (let ((h (make-hash-table))) + (let lp ((a a)) + (if (pair? a) + (begin + (hash-set! h (caar a) (cdar a)) + (lp (cdr a))))) + h)) + + + ;; Comparison Operations (define-inlinable (lt a b) (< a b)) (define-inlinable (le a b) (<= a b)) @@ -89,26 +105,26 @@ (define* (length_hint obj #:optional (default 0)) (if (not (and (number? default) (integer? default))) (raise TypeError (format #f "default=~ a is not an integer" default))) - (let/ec ret (values) - #;(try + (let/ec ret + (try (lambda () (ret (len obj))) - #:except TypeError => - (lambda x (values))) + (#:except TypeError => + (lambda x (values)))) - #;(let ((hint + (let ((hint (try (lambda () (ref obj '__length_hint__)) - #:except AttributeError => - (lambda x (ret default))))) + (#:except AttributeError => + (lambda x (ret default)))))) (let ((val (try (lambda () (hint)) - #:except TypeError => - (lambda x (ret default))))) + (#:except TypeError => + (lambda x (ret default)))))) (cond ((eq? val NotImplemented) default) @@ -147,6 +163,12 @@ #:final (reverse l))) (set self '_call func)))))) + (define __reduce__ + (lambda (self) + (list (lambda (o data) + (apply (ref o '__init__) data)) + (list (ref self '_attrs))))) + (define __call__ (lambda (self obj) ((ref self '_call) obj))) @@ -178,6 +200,11 @@ (set self '_items (cons item items)) (set self '_call func))))) + (define __reduce__ + (lambda (self) + (list (lambda (o data) + (apply (ref o '__init__) data)) + (list (ref self '_items))))) (define __call__ (lambda (self obj) @@ -209,6 +236,17 @@ (set self '_args (cdr args)) (set self '_kwargs kwargs))) + (define __reduce__ + (lambda (self) + (list + (lambda (o name args a) + (let ((kwargs (assoc->hash kwargs))) + (py-apply (ref methodcaller '__init__) o name (* args) (** kwargs)))) + (list + (ref self '_name) + (ref self '_args) + (hash->assoc (ref self '_kwargs))))))) + (define __call__ (lambda (self obj) (py-apply (getattr obj (ref self '_name)) diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index 2ea57eb..8264fee 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -85,18 +85,18 @@ (define staticmethod static-method) (define (enumerate l) - (make-generator enumerate - (lambda (yield) + ((make-generator () + (lambda (yield) (for ((x : l)) ((i 0)) (yield i x) - (+ i 1))))) + (+ i 1)))))) (define (filter f l) - (make-generator enumerate - (lambda (yield) - (for ((x : l)) () - (if (f x) - (yield x)))))) + ((make-generator () + (lambda (yield) + (for ((x : l)) () + (if (f x) + (yield x))))))) (define miss ((@ (guile) list) 'miss)) @@ -174,7 +174,7 @@ (let lp ((l l)) (match l ((it) - (for ((x : it)) ((s default) (b default)) + (for ((x : it)) ((s miss) (b miss)) (if (eq? s miss) (values (key x) x) (let ((k (key x))) @@ -183,7 +183,10 @@ (values s b)))) #:final (if (eq? b miss) - (raise ValueError "min does not work for zero length list") + (if (eq? default miss) + (raise ValueError + "min does not work for zero length list") + default) b))) (_ (lp ((@ (guile) list) l)))))) @@ -191,8 +194,8 @@ (let lp ((l l)) (match l ((it) - (for ((x : it)) ((s default) (b default)) - (if (eq? default miss) + (for ((x : it)) ((s miss) (b miss)) + (if (eq? s miss) (values (key x) x) (let ((k (key x))) (if (> k s) @@ -200,7 +203,10 @@ (values s b)))) #:final (if (eq? b miss) - (raise ValueError "min does not work for zero length list") + (if (eq? default miss) + (raise ValueError + "min does not work for zero length list") + default) b))) (_ (lp ((@ (guile) list) l)))))) diff --git a/modules/language/python/try.scm b/modules/language/python/try.scm index a36263b..36d9b04 100644 --- a/modules/language/python/try.scm +++ b/modules/language/python/try.scm @@ -48,12 +48,19 @@ ((_ E tag l) (check E tag l)))) +(define (m code) + (let ((c code)) + (lambda (k . l) + (if (eq? k StopIteration) + (apply c 'python k l) + (apply c k l))))) + (define-syntax handler (syntax-rules (=>) - ((handler ecx) - (lambda (k tag . l) - (handler ecx tag l))) + (m + (lambda (k tag . l) + (handler ecx tag l)))) ((handler ((#:except E => lam) . ecx) tag l) (if (check-exception E tag l) diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 15aad1f..f80a2d2 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -13,7 +13,9 @@ py-super-mac py-super py-equal? *class* *self* pyobject? pytype? type object pylist-set! pylist-ref tr + resolve-method )) + #| Python object system is basically syntactic suger otop of a hashmap and one this project is inspired by the python object system and what it measn when @@ -62,6 +64,47 @@ explicitly tell it to not update etc. (name-object <pyf>) (name-object <property>) +(define (resolve-method-g g pattern) + (define (mmatch p pp) + (if (eq? pp '_) + '() + (match (cons p pp) + (((p . ps) . (pp . pps)) + (if (eq? pp '_) + (mmatch ps pps) + (if (is-a? p pp) + (cons p (mmatch ps pps)) + #f))) + ((() . ()) + '()) + (_ + #f)))) + + (define (q< x y) + (let lp ((x x) (y y)) + (match (cons x y) + (((x . xs) . (y . ys)) + (and (is-a? x y) + (lp xs ys))) + (_ #t)))) + + (let ((l + (let lp ((ms (generic-function-methods g))) + (if (pair? ms) + (let* ((m (car ms)) + (p (method-specializers m)) + (f (method-generic-function m))) + (aif it (mmatch p pattern) + (cons (cons it f) (lp (cdr ms))) + (lp (cdr ms)))) + '())))) + + + (cdr (car (sort l q<))))) + +(define (resolve-method-o o pattern) + (resolve-method-g (class-of o) pattern)) + (define (get-dict self name parents) (aif it (ref self '__prepare__) (it self name parents) @@ -609,8 +652,7 @@ explicitly tell it to not update etc. (define goopses (map (lambda (sups) (aif it (ref sups '__goops__ #f) it - sups) - sups) + sups)) supers)) (define parents (let ((p (filter-parents supers))) (if (null? p) |