nnn

2 files changed, 452 insertions, 8 deletions

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 <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)))
     (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 <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))  
 
 
-  
 
+	        
   
   
 
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 <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)