functools feature complete

4 files changed, 504 insertions, 12 deletions

diff --git a/modules/language/python/module/functools.scm b/modules/language/python/module/functools.scm
index 0d0311a..484411b 100644
--- a/modules/language/python/module/functools.scm
+++ b/modules/language/python/module/functools.scm
@@ -1,5 +1,26 @@
+(define-module (language python module functools)
+  #:use-module (oop pf-objects)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python def)
+  #:use-module (language python module threading)
+  #:use-module (language python module weakref)
+  #:export (WRAPPER_ASSIGNMENTS WRAPPER_UPDATES
+				update_wrapper wraps total_ordering
+				cmp_to_key partial partialmethod lru_cache
+				reduce singledispatch))
 
+  
 
+(def (reduce f it (= initializer None))
+     (let ((it    (iter it))
+	   (value (if (eq? initializer None)
+		      (next it)
+		      initializer)))
+       (for ((e : it)) ((value value))
+	    (f value e)
+	    #:final value)))
+	   
 
 (define WRAPPER_ASSIGNMENTS '("__module__" "__name__" "__qualname__" "__doc__"
 			      "__annotations__"))
@@ -304,7 +325,7 @@ def cmp_to_key(mycmp):
 		    (aif it (ref new_func '__self__)
 			 (set! result '__self__ it))))))
 	(if (not result)
-            ((ref (ref self '_make_unbound_method) '__get__) obj cls)
+            ((ref ((ref self '_make_unbound_method)) '__get__) obj cls)
 	    result))))
   
   (define __isabstractmethod__
@@ -312,3 +333,429 @@ def cmp_to_key(mycmp):
      (lambda (self)
        (ref (ref self 'func) '__isabstractmethod__ #f)))))
 
+
+(define _CacheInfo (namedtuple "CacheInfo"
+			       '("hits", "misses", "maxsize", "currsize")))
+
+(define-python-class _HashedSeq (py-list)
+  (define __init__
+    (lam (self tup (= hash hash))
+      ((ref py-list '__init__) self tup)
+      (set self 'hashvalue (hash tup))))
+
+  (define __hash__
+    (lambda (self)
+      (ref self 'hashvalue)))
+
+(def (_make_key args kwds typed
+		(= kwd_mark  (list (object)))
+		(= fasttypes (py-set (list int str frozenset type(None))))
+		(= tuple     tuple)
+		(= type      type)
+		(= len       len))
+
+     (let ((key (py-list args)))
+       (if (> (len kwds) 0)
+	   (begin
+	     (set! key (+ key kwd_mark))
+	     (for ((item : (py-items kwds))) ()
+		  (set! key (+ key item)))))
+       
+       (if typed
+	   (begin
+	     (set! key
+		   (+ key
+		      (for ((a : args)) (l '())
+			   (cons (type a) l)
+			   #:final (reverse l))))
+	     (if (bool kwds)
+		 (set! key
+		       (+ key
+			  (for ((v : (py-values kwds))) ((l '()))
+			       (cons (type v) l)
+			       #:final (reverse l))))))
+       
+	   (if (and (= (len key) 1)
+		    (in (type (pylist-ref key 0)) fasttypes))
+	       (pylist-ref key 0)
+	       (_HashedSeq key)))))
+
+(def (lru_cache (= maxsize 128) (= typed #f))
+    "Least-recently-used cache decorator.
+
+    If *maxsize* is set to None, the LRU features are disabled and the cache
+    can grow without bound.
+
+    If *typed* is True, arguments of different types will be cached separately.
+    For example, f(3.0) and f(3) will be treated as distinct calls with
+    distinct results.
+
+    Arguments to the cached function must be hashable.
+
+    View the cache statistics named tuple (hits, misses, maxsize, currsize)
+    with f.cache_info().  Clear the cache and statistics with f.cache_clear().
+    Access the underlying function with f.__wrapped__.
+
+    See:  http://en.wikipedia.org/wiki/Cache_algorithms#Least_Recently_Used
+
+    "
+
+    (if (not (or (number? maxsize) (eq? maxsize None)))
+        (raise TypeError "Expected maxsize to be an integer or None"))
+
+    (lambda (user_function)
+      (let ((wrapper (_lru_cache_wrapper
+		      user_function maxsize typed _CacheInfo)))
+	(update_wrapper wrapper user_function))))
+
+(define (_lru_cache_wrapper user_function maxsize typed _CacheInfo)
+  (define sentinel (object))
+  (define make_key _make_key)
+  (define-values (PREV NEXT KEY RESULT)
+    (values 0 1 2 3))
+  (define cache (dict))
+  (define-values (hits misses) (values 0 0))
+  (define full #f)
+  (define cache_get cache.get)
+  (define cache_len cache.__len__)
+  (define lock      (RLock))
+  (define root      (list 0 0 0 0))
+  (list-set! root 0 root)
+  (list-set! root 1 root)
+  (list-set! root 2 none)
+  (list-set! root 3 none)
+
+  (let ((wrapper
+	 (cond
+	     ((eq? maxsize None)
+	      (lam ((* args) (** kwds))
+		   (let* ((key     (make_key args kwds typed))
+			  (result  (cache_get key sentinel)))
+		     (if (not (eq? result sentinel))
+			 (begin
+			   (set! hits (+ hits 1))
+			   result)
+			 (let ((result (py-apply user_function
+						 (* args) (** kwds))))
+			   (pylist-set! cache key result)
+			   (set! misses (+ misses 1))
+			   result)))))
+
+	  ((= maxsize 0)
+	   (lam ((* args) (** kwds))
+		(let ((result (py-apply user_function (* args) (** kwds))))
+		  (set! misses (+ misses 1))
+		  result)))
+
+
+	  (else
+	   (lam ((* args) (** kwds))
+	     (let/ec return
+		(let* ((key     (make_key args kwds typed)))
+		  (with (lock)
+			(let ((link (cache_get key)))
+			  (when (not (eq? link None))
+			    (let ((link_prev (list-ref link 0))
+				  (link_next (list-ref link 1))
+				  (_key      (list-ref link 2))
+				  (result    (list-ref link 3)))
+			      (list-set! link_prev NEXT link_next)
+			      (list-set! link_next PREV link_prev)
+			      (let ((last (list-ref root PREV)))
+				(list-set! last NEXT link)
+				(list-set! root PREV link)
+				(list-set! link PREV last)
+				(list-set! link NEXT root)
+				(set! hits (+ hits 1))
+				(return result))))))
+
+		  (let ((result (py-apply user_function (* args) (** kwds))))
+		    (with (lock)
+			  (cond
+			   ((in key cache) (values))
+			   (full
+			    (let ((oldroot root))
+			      (list-set! oldroot KEY key)
+			      (list-set! oldroot RESULT result)
+			      (set! root (list-ref oldroot NEXT))
+			      (let ((oldkey    (list-ref root KEY))
+				    (oldresult (list-ref root RESULT)))
+				(list-set! root KEY    None)
+				(list-set! root RESULT None)
+				(pylist-delte! cache oldkey)
+				(pylist-set! cache key oldroot))))
+			   (else
+			    (let ((last (list-ref root PREV))
+				  (link (list last root key result)))
+			      (list-set!   last  NEXT link)
+			      (list-set!   root  PREV link)
+			      (pylist-set! cache key  link)
+			      (set! full (>= (cache_len) maxsize)))))
+			  (set! misses (+ misses 1)))
+		    result))))))))
+
+    (define (cache_info)
+      (with lock
+	    (_CacheInfo hits misses maxsize (cache_len))))
+
+    (define (cache_clear)
+      (with lock
+            (pylist-clear! cache)
+            (set! root (list #f #f None None))
+	    (list-set! root 0 root)
+	    (list-set! root 1 root)
+            (set! hits   0)
+	    (set! misses 0)
+            (set! full   #f)))
+
+    (set wrapper  'cache_info  cache_info)
+    (set! wrapper 'cache_clear cache_clear)
+    wrapper))
+
+;; single dispatch
+(define (_c3_merge sequences)
+  (let lp ((result '()))
+    (set! sequences (for ((s : sequences)) ((l '()))
+			 (if (bool s)
+			     (cond s l)
+			     l)
+			 #:final (reverse l)))
+    (if (bool sequences)
+	(let ((cand
+	       (let lp2 ((s1 sequences))
+		 (if (pair? s1)
+		     (let ((cand (pylist-ref (car s1) 0)))
+		       (let lp3 ((s2 sequences))
+			 (if (pair? s2)
+			     (if (in cand (pylist-slice! (car s2) 1 None None))
+				 (lp2 (cdr s1))
+				 (lp3 (cdr s2)))
+			     cand)))
+		     (raise RunTimeError "Inconsistant hierarky")))))
+	  
+	  (let lp ((s sequences))
+	    (if (pair? s)
+		(begin
+		  (if (equal? (pylist-ref (car s) +) cand)
+		      (pylist-delete! (car s) 0))
+		  (lp (cdr s)))))
+		    
+	  (lp (cons cand result)))
+
+	(py-list (reverse result)))))
+
+(def (_c3_mro cls (= abcs None))
+    "Computes the method resolution order using extended C3 linearization.
+
+    If no *abcs* are given, the algorithm works exactly like the built-in C3
+    linearization used for method resolution.
+
+    If given, *abcs* is a list of abstract base classes that should be inserted
+    into the resulting MRO. Unrelated ABCs are ignored and don't end up in the
+    result. The algorithm inserts ABCs where their functionality is introduced,
+    i.e. issubclass(cls, abc) returns True for the class itself but returns
+    False for all its direct base classes. Implicit ABCs for a given class
+    (either registered or inferred from the presence of a special method like
+    __len__) are inserted directly after the last ABC explicitly listed in the
+    MRO of said class. If two implicit ABCs end up next to each other in the
+    resulting MRO, their ordering depends on the order of types in *abcs*.
+
+    "
+    (define bases (ref cls '__bases__ '()))
+    (define boundary
+      (for ((i base : (enumerate (reversed bases)))) ()
+	 (if (hasattr base '__abstractmethods__)
+	     (break (- (len bases) i)))
+	 #:final 0))
+
+    (define abcs             (if (bool abcs) (py-list abcs) (py-list)))
+    (define explicit_bases   (py-list (pylist-slice bases None boundary None)))
+    (define abstract_bases   (py-list))
+    (define other_bases      (py-list (pylist-slice bases boundary None None)))
+    
+    (for ((base : abcs)) ()
+	 (if (and (issubclass cls base)
+		  (not (any (map (lambda (b) (issubclass b base)) bases))))
+	     (pylist-append! abstract_bases base)))
+
+    (for ((base : abstract_bases))
+	 (pylist-remove! abcs base))
+    
+    (let* ((f (lambda (bases)
+		(for ((base : bases)) ((l '()))
+		     (cons (_c3_mro base #:abcs abcs) l)
+		     #:final (reverse l))))
+
+	   (explicit_c3_mros (f explicit_bases))	  
+	   (abstract_c3_mros (f abstract_bases))	  
+	   (other_c3_mros    (f other_bases)))
+
+      (_c3_merge
+       (+ (py-list (py-list cls))
+	  explicit_c3_mros
+	  abstract_c3_mros
+	  other_c3_mros
+	  (py-list explicit_bases)
+	  (py-lit abstract_bases)
+	  (py-list other_bases)))))
+
+(define (_compose_mro cls types)
+    "Calculates the method resolution order for a given class *cls*.
+
+    Includes relevant abstract base classes (with their respective bases) from
+    the *types* iterable. Uses a modified C3 linearization algorithm.
+
+    "
+    (define bases (py-set (ref cls '__mro__)))
+
+    ;; Remove entries which are already present in the __mro__ or unrelated.
+    (define (is_related typ)
+      (and (not (in typ bases))
+	   (ref typ  '__mro__)
+	   (issubclass cls typ)))
+    
+    (define types (for ((n : types)) ((l '()))
+		       (if (is_related n)
+			   (cons n l)
+			   l)
+		       #final (reverse l)))
+    
+    ;; Remove entries which are strict bases of other entries (they will end up
+    ;; in the MRO anyway.
+    (define (is_strict_base typ)
+      (for ((other : types)) ()
+	   (if (and (not (equal? typ other))
+		    (in typ (ref other '__mro__ '())))
+	       (break #t))
+	   #:final #f))
+    
+    (define types2 (for ((n : types)) ((l '()))
+			(if (is_strict_base n)
+			   (cons n l)
+			   l)
+		       #final (reverse l)))
+    
+    ; Subclasses of the ABCs in *types* which are also implemented by
+    ; *cls* can be used to stabilize ABC ordering.
+    (define type_set (py-set types))
+    (define mro      (py-list))
+    
+    (for ((typ : types)) ()
+	 (let ((found (py-list)))
+	   (for ((sub in ((ref typ '__subclasses__ (lambda () '()))))) ()
+		(if (and (not (in sub bases))
+			 (issubclass cls sub))
+		    (pylist-append found
+				   (for ((s in (ref sub '__mro__ '())))
+					((l '()))
+				      (if (in s type_set)
+					  (cons s l)
+					  l)
+				      #:final (py-list (reverse l))))))
+	   (f (not (bool found))
+	      (begin
+		(pylist-append! mro typ)
+		(pylist-sort! found #:key len #:reverse #t)
+		(for ((sub : found)) ()
+		     (for ((subcls : sub)) ()
+			  (if (not (in subcls mro))
+			      (pylist-append! mro subcls))))))))
+
+    (_c3_mro cls #:abcs mro))
+
+(define (_find_impl cls registry)
+    "Returns the best matching implementation from *registry* for type *cls*.
+
+    Where there is no registered implementation for a specific type, its method
+    resolution order is used to find a more generic implementation.
+
+    Note: if *registry* does not contain an implementation for the base
+    *object* type, this function may return None.
+
+    "
+    (define mro   (_compose_mro cls (py-keys registry)))
+    (define match None)
+    (define clsmro (ref cls '__mro__ '()))
+    (for ((t : mro)) ()
+	 (if (not (eq? match None))
+	     (begin
+	       ;; If *match* is an implicit ABC but there is another unrelated,
+	       ;; equally matching implicit ABC, refuse the temptation to guess.
+	       (if (and (in t registry)
+			(not (in t    clsmro))
+			(not (in match clsmro))
+			(not (issubclass match t)))
+		   (raise RuntimeError
+			  (format #f "Ambiguous dispatch: ~a or ~a"
+				  match t)))
+	       (break)))
+	 (if (in t registry)
+	     (set! match t)))
+    
+    (py-get registry match))
+
+(define (singledispatch func)
+    "Single-dispatch generic function decorator.
+
+    Transforms a function into a generic function, which can have different
+    behaviours depending upon the type of its first argument. The decorated
+    function acts as the default implementation, and additional
+    implementations can be registered using the register() attribute of the
+    generic function.
+
+    "
+    (define registry         (py-set))
+    (define dispatch_cache   (weak-key-dict))
+    (define cache_token      None)
+
+    (define (dispatch cls)
+        "generic_func.dispatch(cls) -> <function implementation>
+
+        Runs the dispatch algorithm to return the best available implementation
+        for the given *cls* registered on *generic_func*.
+
+        "
+	
+        (if (not (eq? cache_token None))
+            (let ((current_token (get_cache_token)))
+	      (if (not (equal? cache_token current_token))
+		  (begin
+		    (pylist-clear! dispatch_cache)
+		    (set! cache_token current_token)))))
+
+	(let ((impl (try
+		     (lambda () (pylist-ref dispatch_cache cls))
+		     (#:except KeyError =>
+			       (lambda x
+				 (_find_impl cls registry))))))
+	  (pylist-set! dispatch_cache cls impl)
+	  impl))
+    
+    (def (register cls (= func None))
+        "generic_func.register(cls, func) -> func
+
+        Registers a new implementation for the given *cls* on a *generic_func*.
+
+        "
+        (if (eq? func None)
+            (lambda (f) (register cls f))
+	    (begin
+	      (pylist-set! registry cls func)
+	      (if (and (eq? cache_token None)
+		       (ref cls '__abstractmethods__))
+		  (set! cache_token (get_cache_token)))
+	      (pylist-clear! dispatch_cache)
+	      func)))
+
+    (def (wrapper (* args) (** kw))
+	 (py-apply (dispatch (ref (pylist-ref args 0) '__class__))
+		   (* args) (** kw)))
+
+    (pylist-set! registry object func)
+    (set wrapper 'register register)
+    (set wrapper 'dispatch dispatch)
+    (set wrapper 'registry  registry)
+    (set wrapper '_clear_cache (ref dispatch_cache 'clear))
+    (update_wrapper wrapper func)
+
+    wrapper)
diff --git a/modules/language/python/module/threading.scm b/modules/language/python/module/threading.scm
new file mode 100644
index 0000000..b4d43c2
--- /dev/null
+++ b/modules/language/python/module/threading.scm
@@ -0,0 +1,36 @@
+(define-module (language python module threading)
+  #:use-module (ice-9 threads)
+  #:use-module (oop pf-objects)
+  #:use-module (language python def)  
+  #:export (RLock))
+
+(define-python-class RLock
+  (define __init__
+    (lambda (self)
+      (set self '_lock (make-mutex 'recursive))))
+
+  (define __enter__
+    (lambda (self)
+      (lock-mutex (ref self '_lock))))
+
+  (define __leave__
+    (lambda (self)
+      (unlock-mutex (ref self '_lock))))
+
+
+  (define acquire
+    (lam (self (= blocking #t) (timeout -1))
+	 (if blocking
+	     (if (< timeout 0)
+		 (lock-mutex (ref self '_lock))
+		 (let* ((cur (gettimeofday))
+			(x   (+ (car cur) (/ (cdr cur) 1000000.0)))
+			(y   (+ x timeout))
+			(s   (floor y))
+			(us  (floor (* (- y s) 1000000))))
+		   (lock-mutex (ref self '_lock) (cons s us))))
+	     (try-lock (ref self '_lock)))))
+
+  (define release __leave__))
+    
+
diff --git a/modules/language/python/module/weakref.scm b/modules/language/python/module/weakref.scm
new file mode 100644
index 0000000..61f845a
--- /dev/null
+++ b/modules/language/python/module/weakref.scm
@@ -0,0 +1,10 @@
+(define-module (language python module weakref)
+  #:use-module (language python dict)
+  #:export (WeakKeyDictionary WeakValueDictionary))
+
+(define WeakKeyDictionary   weak-key-dict)
+(define WeakValueDictionary weak-value-dict)
+
+  
+
+  
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 655f49c..15bbd2f 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -96,9 +96,7 @@ explicitly tell it to not update etc.
 
 (define (mk-getter-class f)				       
   (lambda (obj cls)
-    (if (eq? obj cls)
-	(lambda x (apply f x))
-	(lambda x (apply f cls x)))))
+    (lambda x (apply f cls x))))
 
 (define (class-method f)
   (set f '__get__ (mk-getter-class f)))
@@ -298,28 +296,29 @@ explicitly tell it to not update etc.
 
 (define-syntax-rule (find-in-class-and-parents klass key fail)
   (kif r (find-in-class klass key fail)
-       (begin (fluid-set! *location* klass) r)
+       r
        (aif parents (find-in-class klass '__mro__ #f)
 	    (let lp ((parents parents))
 	      (if (pair? parents)
 		  (kif r (find-in-class (car parents) key fail)
-		       (begin (fluid-set! *location* (car parents)) r)
+		       r
 		       (lp (cdr parents)))
 		  fail))
 	    fail)))
 
 (define-syntax-rule (mrefx klass key l)
   (let ()
-    (define (end) (if (pair? l) (car l) #f))
+    (define (end) (if (pair? l) (car l) #f))    
     (fluid-set! *location* klass)
-    (kif it (find-in-class klass key fail)
+    (kif it (find-in-class-and-parents klass key fail)
 	 it
-	 (begin
-	   (aif klass (find-in-class klass '__class__ #f)
+	 (aif klass (find-in-class klass '__class__ #f)
+	      (begin
+		(fluid-set! *location* klass)
 		(kif it (find-in-class-and-parents klass key fail)
 		     it
-		     (end))
-		(end))))))
+		     (end)))
+	      (end)))))
 
 (define not-implemented (cons 'not 'implemeneted))