From 0f66dc88c5cc95f1dee7e4698c079a5554ddc886 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Tue, 27 Feb 2018 13:46:43 +0100 Subject: abc compiles --- modules/oop/pf-objects.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'modules/oop/pf-objects.scm') diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 15aad1f..57289e0 100644 --- a/modules/oop/pf-objects.scm +++ b/modules/oop/pf-objects.scm @@ -609,8 +609,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) -- cgit v1.2.3 From dc79c0ac58f5bcc1f75a96307256dc4cce441f9f Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Fri, 2 Mar 2018 14:49:57 +0100 Subject: nnn --- modules/language/python/module/collections.scm | 417 ++++++++++++++++++++++++- modules/oop/pf-objects.scm | 43 +++ 2 files changed, 452 insertions(+), 8 deletions(-) (limited to 'modules/oop/pf-objects.scm') diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm index 6e004a3..601ce7e 100644 --- a/modules/language/python/module/collections.scm +++ b/modules/language/python/module/collections.scm @@ -1,19 +1,238 @@ (define-module (language python module collections) #:use-module (oop pf-objects) #:use-module (language python module collections abc) - #:export (abc 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) - (for ((k v : d)) - (set self k v))))) + (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 (cons '_)) +(define dict-set! (resolve-method-c pylist-set! )) +(define dict-ref (resolve-method-c pylist-ref )) +(define dict-del! (resolve-method-c pylist-delete! )) +(define dict-pop! (resolve-method-c pylist-pop! )) +(define dict-clear! (resolve-method-c pylist-clear! )) + +(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))) (apply (ref s 'union) (ref self 'maps))) @@ -143,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)) @@ -151,15 +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 ) + (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 ) + (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)) - + diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm index 57289e0..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 ) (name-object ) +(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) -- cgit v1.2.3