bisect module

5 files changed, 133 insertions, 17 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index b00f304..f97597c 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -181,7 +181,16 @@
 
     ((#:global . _)
      vs)
-    
+
+    ((#:import (#:name ((ids ...) . as)) ...)
+     (let lp ((ids ids) (as as) (vs vs))
+       (if (pair? as)
+	   (lp (cdr ids) (cdr as)
+	       (let ((as  (car as))
+		     (ids (car ids)))
+		 (union vs (list (exp '() (if as as (car ids)))))))
+	   vs)))
+
     ((#:expr-stmt l (#:assign u))
      (union (fold (lambda (x s)
                    (match x
@@ -209,8 +218,16 @@
      vs)
     ((#:class . _)
      vs)
-    ((#:global . _)
+    ((#:global . _)     
      vs)
+    ((#:import (#:name ((ids ...) . as)) ...)
+     (let lp ((ids ids) (as as) (vs vs))
+       (if (pair? as)
+	   (lp (cdr ids) (cdr as)
+	       (let ((as  (car as))
+		     (ids (car ids)))
+		 (union vs (list (exp '() (if as as (car ids)))))))
+	   vs)))
     ((x . y)
      (defs y (defs x vs)))
     (_ vs)))
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index b101da7..782b5a9 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -753,7 +753,7 @@
 (define-method (len x)
   (if (null? x)
       0
-      (error "not a suitable lengthof")))
+      (error "not a suitable lengthof" x)))
 (define-method (len (v <vector>))  (vector-length v))
 (define-method (len (s <string>))  (string-length s))
 (define-method (len (o <py-list>)) (slot-ref o 'n))
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index 9f40220..393877b 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -32,7 +32,7 @@
 			 MappingView ItemsView KeysView ValuesView)
 
   #:export (OrderedDict ChainMap Counter UserDict UserString UserList
-			namedtuple defaultdict dequeue))
+			namedtuple defaultdict deque))
 
 #|
 * namedtuple   factory function for creating tuple subclasses with named fields
@@ -710,7 +710,7 @@
 	    (raise KeyError (format #f "key ~a is missing" key))
 	    (pylist-ref d key))))))
 
-(define-python-class dequeue ()
+(define-python-class deque ()
   (define __init__
     (lambda* (self #:optional (iterable '()) (maxlen None))
       (let ((head (link)))
@@ -941,15 +941,102 @@
 		 (if (not (eq? p h))
 		     (begin
 		       (yield (get-key p))
-		       (lp (get-prev p))))))))))))
+		       (lp (get-prev p)))))))))))
 
+      (define __contains__
+	(lambda (self x)
+	  (try
+	   (lambda ()
+	     (if ((ref self 'index) x)
+		 #t
+		 #f))
+	   (#:except IndexError =>
+	     (lambda x #f)))))
 
-  
-  
 
+      (define __len__
+	(lambda (self)
+	  (ref self '_i)))
+
+      (define __getitem__
+	(lambda (self i)
+	  (let ((n (ref self '_i)))
+	    (if (or (>= i n) (< i 0))
+		(raise IndexError i))
+	    (let lp ((p (get-next (ref self '_head))) (j 0))
+	      (if (= i j)
+		  (get-key p)
+		  (lp (get-next p) (+ j 1)))))))
+
+      (define __setitem__
+	(lambda (self i v)
+	  (let ((n (ref self '_i)))
+	    (if (or (>= i n) (< i 0))
+		(raise IndexError i))
+	    (let lp ((p (get-next (ref self '_head))) (j 0))
+	      (if (= i j)
+		  (set-key! p v)
+		  (lp (get-next p) (+ j 1)))))))
+
+      (define __delitem__
+	(lambda (self i)
+	  (let ((n (ref self '_i)))
+	    (if (or (>= i n) (< i 0))
+		(raise IndexError i))
+	    (let lp ((p (get-next (ref self '_head))) (j 0))
+	      (if (= i j)
+		  (let ((prev (get-prev p))
+			(next (get-next p)))
+		    (set-next! prev next)
+		    (set-prev! next prev)
+		    (set self '_i (- n 1)))
+		  (lp (get-next p) (+ j 1)))))))
 
-	        
-  
-  
-
-  
+      (define __repr__
+	(lambda (self)
+	  (let ((l (to-list self)))
+	    (if (pair? l)
+		(format #f "deque([~a~{, ~a~}])" (car l) (cdr l))
+		"deque([])"))))
+      
+      (define __add__
+	(lambda (self iter)
+	  (let ((o ((ref self 'copy))))
+	    (let ((f (ref o 'append)))
+	      (for ((x : iter)) ()
+		   (f x)))
+	    o)))
+
+      (define __iadd__
+	(lambda (self iter)
+	  (let ((o self))
+	    (let ((f (ref o 'append)))
+	      (for ((x : iter)) ()
+		   (f x)))
+	    o)))
+
+      (define __mul__
+	(lambda (self n)
+	  (let ((o (dequeue)))
+	    (let ((f (ref o 'append)))
+	      (let lp ((i 0))
+		(if (< i n)
+		    (begin		   
+		      (for ((x : self)) ()
+			   (f x))
+		      (lp (+ i 1)))
+		    o))))))
+
+      (define __imul__
+	(lambda (self n)
+	  (if (= n 0)
+	      ((ref self 'clear))
+	      (let ((o self))
+		(let ((f (ref o 'append)))	      
+		  (let lp ((i 1))
+		    (if (< i n)
+			(begin		   
+			  (for ((x : self)) ()
+			       (f x))
+			  (lp (+ i 1)))
+			o))))))))
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index 91a78db..9563ad0 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -47,6 +47,14 @@
            (apply it l)
            (next-method)))))
 
+(define-syntax-rule (define-py0 (f o . u) code ...)
+  (begin
+    (define-method (f (o <string>)    . u) code ...)
+    (define-method (f (o <py-string>) . l) (apply f (slot-ref o 'str) l))))
+
+(define-py0 (pylist-ref s i)
+  (list->string (list (string-ref s i))))
+
 (define-py (py-capitalize capitalize s)
   (let* ((n (len s))
          (w (make-string n)))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 0418a5f..5de0168 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -303,7 +303,9 @@ explicitly tell it to not update etc.
        (if (or (not f) (eq? f not-implemented))
 	   (mrefx xx key l)
 	   (catch #t
-		  (lambda () ((f xx (fluid-ref *refkind*)) key))
+		  (lambda ()
+		    (make-variable
+		     ((f xx (fluid-ref *refkind*)) key)))
 		  (lambda x
 		    (mrefx xx key l))))))))
 
@@ -318,9 +320,11 @@ explicitly tell it to not update etc.
 (define-syntax-rule (mref-py x key l)
   (let ((xx x))
     (let ((res (mrefx-py xx key l)))
-      (if (and (not (struct? res)) (procedure? res))
-	  (res xx (fluid-ref *refkind*))
-	  res))))
+      (if (variable? res)
+	  (variable-ref res)
+	  (if (and (not (struct? res)) (procedure? res))
+	      (res xx (fluid-ref *refkind*))
+	      res)))))
 
 (define-method (ref x key . l) (if (pair? l) (car l) #f))
 (define-method (ref (x <pf> )  key . l) (mref     x key l))