collections finished and compiles

6 files changed, 400 insertions, 38 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index dad7656..b3cbf67 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -338,6 +338,7 @@
    ((isspace)    (S 'py-isspace))
    ((isupper)    (S 'py-isupper))
    ((istitle)    (S 'py-istitle))
+   ((isidentifier) (S 'py-identifier))
    ((join)       (S 'py-join   ))
    ((ljust)      (S 'py-join   ))
    ((rljust)     (S 'py-rljust ))
diff --git a/modules/language/python/dict.scm b/modules/language/python/dict.scm
index b9f6dd3..58d7cb7 100644
--- a/modules/language/python/dict.scm
+++ b/modules/language/python/dict.scm
@@ -99,7 +99,9 @@
 (define-method (pylist-ref (o <py-hashtable>) x)
   (let ((r (py-hash-ref (slot-ref o 't) x miss)))
     (if (eq? r miss)
-        (raise KeyError x)
+	(aif it (ref o '__missing__)
+	     (it x)
+	     (raise KeyError x))
         r)))
 
 (define-method (pylist-delete! (o <hashtable>) k)
diff --git a/modules/language/python/module/collections.scm b/modules/language/python/module/collections.scm
index 65c9159..9f40220 100644
--- a/modules/language/python/module/collections.scm
+++ b/modules/language/python/module/collections.scm
@@ -1,5 +1,6 @@
 (define-module (language python module collections)
   #:use-module (ice-9 control)
+  #:use-module (ice-9 pretty-print)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
   #:use-module (language python module collections abc)
@@ -14,10 +15,13 @@
   #:use-module (language python def)
   #:use-module (language python set)
   #:use-module (language python range)
+  #:use-module (language python module)
   #:use-module (language python exceptions)
+  #:use-module (language python module keyword)
   #:use-module ((language python module python)
 		#:select ((map . pymap) isinstance reversed classmethod iter
-			  any repr property super sorted))
+			  any repr property super sorted
+			  enumerate (map . py-map)))
 
   #:use-module ((language python module operator)
 		#:select (itemgetter))
@@ -27,7 +31,24 @@
 			 ByteString Set MutableSet Mapping MutableMapping
 			 MappingView ItemsView KeysView ValuesView)
 
-  #:export (OrderedDict ChainMap Counter UserDict UserString UserList))
+  #:export (OrderedDict ChainMap Counter UserDict UserString UserList
+			namedtuple defaultdict dequeue))
+
+#|
+* namedtuple   factory function for creating tuple subclasses with named fields
+* deque        list-like container with fast appends and pops on either end
+* ChainMap     dict-like class for creating a single view of multiple mappings
+* Counter      dict subclass for counting hashable objects
+* OrderedDict  dict subclass that remembers the order entries were added
+* defaultdict  dict subclass that calls a factory function to supply missing values
+* UserDict     wrapper around dictionary objects for easier dict subclassing
+* UserList     wrapper around list objects for easier list subclassing
+* UserString   wrapper around string objects for easier string subclassing
+|#
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define (py-add! o k) ((ref o 'add) k))
 
 (define-python-class _OrderedDictKeysView (KeysView)
   (define __reversed__
@@ -565,6 +586,8 @@
 			(min (py-get self elem 0) count)))
       ((ref self '_keep_positive)))))
 
+(define mod (current-module))
+
 (def (namedtuple typename field_names
 		 (= verbose #f)
 		 (= rename  #f)
@@ -577,25 +600,27 @@
 	       (set! verbose xx)
 	       xx)
 	     xx)))
-     
+
      (let ((seen (py-set)))
        (if (string? field_names)
-	   (set! field_names = (string-split field_names #\,)))
+	   (set! field_names (string-split field_names #\,)))
+       
        (set! field_names (py-list (py-map scm-str field_names)))
        (set! typename (scm-str typename))
+       
        (if rename
 	   (for ((index name : (enumerate field_names))) ()
 		(if (or (not (py-identifier? name))
 			(iskeyword name)
 			(py-startswith name "_")
 			(in name seen))
-		    (py-set! field_names index (format #f "_~a"index)))
-		(py-add seen name)))
+		    (pylist-set! field_names index (format #f "_~a"index)))
+		(py-add! seen name)))
 
        (for ((name : (+ (pylist (list typename)) field_names))) ()
 	    (if (not (string? name))
 		(raise TypeError "Type names and field names must be strings"))
-	    (if (not (py-isidentifier name))
+	    (if (not (py-identifier? name))
 		(raise ValueError
 		       (+ "Type names and field names must be valid "
 			  (format #f "identifiers: ~a" name))))
@@ -614,33 +639,47 @@
 		(raise ValueError
 		       (+ "Encountered duplicate field name: "
 			  name)))
-	    (py-add seen name))
+	    (py-add! seen name))
 
-       (set! field_names (map string->symbol (to-list field-names)))
+       (set! field_names (map string->symbol (to-list field_names)))
        
-       (make-p-class (string->symbol typename) (list)
+       (make-p-class (string->symbol typename) '(())
 	 (lambda (dict)
-	    (py-add! dict '__init__
-		     (eval (v `(lam
-				(self
-				 ,@(map (lambda (key) `(= ,key #f))
-					field_names))
-			    
-				,@(map (lambda (key) `(set self ',key ,key))
-				       field_names))
-			      mod)))
+	    (pylist-set! dict '__init__
+	      (eval (v `(lam
+			 (self
+			  ,@(map (lambda (key) `(= ,key #f))
+				 field_names))
+			 
+			 ,@(map (lambda (key) `(set self ',key ,key))
+				field_names)))
+		    mod))
 	    
-	    (py_add! dict '__getitem__
-		     (lambda (self i)
-		       (if (number? i)
-			   (ref self (list-ref field_names i))
-			   (ref self (scm-sym i)))))
+	    (pylist-set! dict '__getitem__
+	      (lambda (self i)
+		(if (number? i)
+		    (ref self (list-ref field_names i))
+		    (ref self (scm-sym i)))))
 	    
-	    (py_add! dict '__setitem__
-		     (lambda (self i val)
-		       (if (number? i)
-			   (set self (list-ref field_names i) val)
-			   (set self (scm-sym i) val))))
+	    (pylist-set! dict '__setitem__
+	      (lambda (self i val)
+		(if (number? i)
+		    (set self (list-ref field_names i) val)
+		    (set self (scm-sym i) val))))
+
+	    (pylist-set! dict '__repr__			 
+	       (lambda (self)
+		 (let ((l (map (lambda (x)
+				 (format #f "~a=~a"
+					 x
+					 (ref self x)))
+			       field_names)))
+
+		  (format #f "~a(~a~{,~a~})"
+			  typename
+			  (car l)
+			  (cdr l)))))
+	       
 	    
 	    (if (eq? module None)
 		(set! module (module-name (current-module)))
@@ -650,14 +689,263 @@
 			     (map scm-sym
 				  (string-split module #\.))))))	    
 	    
-	    (py-add! dict '__module__ module)
+	    (pylist-set! dict '__module__ module)
 
 	    (if verbose (pretty-print verbose))))))
 
-(define-python-class UserDict   (dict))
-(define-python-class UserString (pystring))
-(define-python-class UserList   (py-list))  
+(define UserDict   dict)
+(define UserString pystring)
+(define UserList   py-list)
+
+(define-python-class defaultdict (dict)
+  (define __init__
+    (lambda (self default_factory . l)
+      (apply (ref dict '__init__) self l)
+      (set self 'default_factory default_factory)))
+
+  (define __missing__
+    (lambda (self key)
+      (let ((d (ref self 'default_factory)))
+	(if (eq? d None)
+	    (raise KeyError (format #f "key ~a is missing" key))
+	    (pylist-ref d key))))))
+
+(define-python-class dequeue ()
+  (define __init__
+    (lambda* (self #:optional (iterable '()) (maxlen None))
+      (let ((head (link)))
+	(set-prev! head    head)
+	(set-next! head    head)
+	(set self '_head   head)
+	(set self 'maxlen maxlen)	
+	(for ((x : iterable)) ((i 0))
+	     (if (eq? i maxlen)
+		 (begin
+		   (set self '_i i)		   
+		   (break))
+		 (begin
+		   (pylist-append! self x)
+		   (+ i 1)))
+	     #:final
+	     (set self '_i i)))))
+
+  (define append
+    (lambda (self x)
+      (let ((m (ref self 'maxlen))
+	    (i (ref self '_i)))
+	(if (= m (+ i 1))
+	    (raise ValueError "deque reached its limit"))
+	(let ((head (ref self '_head))
+	      (link (link)))
+	  (set-key!  link x)
+	  (set-prev! link (get-last head))
+	  (set-next! link head)
+	  (set-prev! head link)
+	  (set self '_i (+ i 1))))))
+
+  (define appendleft
+    (lambda (self x)
+      (let ((m (ref self 'maxlen))
+	    (i (ref self '_i)))
+	(if (= m (+ i 1))
+	    (raise ValueError "deque reached its limit"))
+	(let ((head (ref self '_head))
+	      (link (link)))
+	  (set-key!  link x)
+	  (set-next! link (get-first head))
+	  (set-prev! link head)
+	  (set-next! head link)
+	  (set self '_i (+ i 1))))))
+
+  (define clear
+    (lambda (self)
+      (let ((head (ref self '_head)))
+	(set-prev! head head)
+	(set-next! head head)
+	(set self '_i 0))))
+
+  (define copy
+    (lambda (self)
+      (defaultdict self (ref self 'maxlen))))
+
+  (define count
+    (lambda (self x)
+      (for ((y : self)) ((i 0))
+	 (if (equal? x y)
+	     (+ i 1)
+	     i)
+	 #:final i)))
+
+  (define extend
+    (lambda (self iterable)
+      (let ((f (ref self 'append)))
+	(for ((x : iterable)) ()
+	   (f x)))))
+
+  (define extendleft
+    (lambda (self iterable)
+      (let ((f (ref self 'appendleft)))
+	(for ((x : iterable)) ()
+	   (f x)))))
+
+  (define index
+    (lambda* (self x #:optional (start 0) (stop -1))
+      (for ((y : self)) ((i 0))
+	   (if (< i start)
+	       (+ i 1)
+	       (if (= i stop)
+		   (raise ValueError "index is not found")
+		   (if (equal? x y)
+		       (break i)
+		       (+ i 1))))
+	   #:final
+	   (raise ValueError "index is not found"))))
+
+  (define insert
+    (lambda (self n x)
+      (let ((m (ref self 'maxlen))
+	    (j (ref self '_i)))
+	
+	(if (= m (+ j 1))
+	    (raise IndexError "deque reached its limit"))
 
+	(if (or (< n 0) (> n j))
+	    (raise IndexError "index in insert out of bound"))
+	
+	(let lp ((p (ref self '_head)) (i 0))
+	  (if (<= i j)
+	      (if (= i n)
+		  (let ((link (link))
+			(pp   (get-next p)))
+		    (set-key!  link x)
+		    (set-next! p    link)
+		    (set-prev! pp   link)
+		    (set-prev! link p   )
+		    (set-next! link pp)
+		    (set self '_i (+ j 1)))
+		  (lp (get-next p) (+ i 1))))))))
+
+  (define pop
+    (lambda (self)
+      (let* ((i (ref self '_i))
+	     (h (ref self '_head))
+	     (n (get-prev h))
+	     (p (get-prev n)))
+	
+	(if (eq? i 0)
+	    (raise IndexError "pop of empty dequeue"))
+
+	(set-prev! h p)
+	(set-next! p h)
+	(set self '_i (- i 1))
+	(get-key n))))
+
+  (define popleft
+    (lambda (self)
+      (let* ((i (ref self '_i))
+	     (h (ref self '_head))
+	     (n (get-next h))
+	     (p (get-next n)))
+	
+	(if (eq? i 0)
+	    (raise IndexError "pop of empty dequeue"))
+
+	(set-next! h p)
+	(set-prev! p h)
+	(set self '_i (- i 1))
+	(get-key n))))
+	
+ (define remove
+    (lambda (self value)
+      (let ((j (ref self '_i)))
+	
+	(if (= j 0)
+	    (raise ValueError "can'r remove deque which is empty"))
+	
+	(let lp ((p (get-next (ref self '_head))) (i 0))
+	  (if (< i j)
+	      (if (equal? value (get-key p))
+		  (let ((prev (get-prev p))
+			(next (get-next p)))
+		    (set-next! prev next)
+		    (set-prev! next prev)
+		    (set self '_i (- j 1)))
+		  (lp (get-next p) (+ i 1)))
+	      (raise ValueError "remove: element is not in deque"))))))
+  
+  (define reverse
+    (lambda (self)
+      (let ((h (ref self '_head))
+	    (n (ref self '_i)))
+	(let lp ((h h) (i 0))
+	  (if (<= i n)
+	      (let ((n (get-next h))
+		    (l (get-prev h))
+		    (r (get-next h)))
+		(set-next! h l)
+		(set-prev! h r)
+		(lp n (+ i 1))))))))
+  
+  (define rotate
+    (lambda (self n)
+      (define h (ref self '_head))
+      
+      (define (rotate+)
+	(let* ((n  (get-next h))
+	       (nn (get-next h))
+	       (p  (get-prev h)))
+	  (set-next! p n)
+	  (set-prev! n p)
+	  (set-next! h nn)
+	  (set-prev! h n)
+	  (set-prev! nn h)
+	  (set-next! n  h)))
+      
+      (define (rotate-)
+	(let* ((n  (get-prev h))
+	       (nn (get-prev h))
+	       (p  (get-next h)))
+	  (set-prev! p n)
+	  (set-next! n p)
+	  (set-prev! h nn)
+	  (set-next! h n)
+	  (set-next! nn h)
+	  (set-prev! n  h)))
+      
+      (define rotate (if (> n 0) rotate+ rotate-))
+      (define d      (if (> n 0) 1       -1     ))
+
+      (let lp ((i 0))
+	(if (not (= i n))
+	    (begin
+	      (rotate)
+	      (lp (+ i d)))))))
+
+      (define __inter__
+	(lambda (self)
+	  (let ((h (ref self '_head)))
+	  ((make-generator ()
+	     (lambda (yield)
+	       (let lp ((p (get-next h)))
+		 (if (not (eq? p h))
+		     (begin
+		       (yield (get-key p))
+		       (lp (get-next p)))))))))))
+
+      (define __reversed__
+	(lambda (self)
+	  (let ((h (ref self '_head)))
+	  ((make-generator ()
+	     (lambda (yield)
+	       (let lp ((p (get-prev h)))
+		 (if (not (eq? p h))
+		     (begin
+		       (yield (get-key p))
+		       (lp (get-prev p))))))))))))
+
+
+  
+  
 
 
 	        
diff --git a/modules/language/python/module/keyword.scm b/modules/language/python/module/keyword.scm
new file mode 100644
index 0000000..c749ff5
--- /dev/null
+++ b/modules/language/python/module/keyword.scm
@@ -0,0 +1,46 @@
+(define-module (language python module keyword)
+  #:use-module (language python string)
+  #:use-module (language python set)
+  #:use-module (oop pf-objects)
+  
+  #:export (kwlist iskeyword))
+
+(define kwlist
+  '("False"
+    "None"
+    "True"
+    "and"
+    "as"
+    "assert"
+    "break"
+    "class"
+    "continue"
+    "def"
+    "del"
+    "elif"
+    "else"
+    "except"
+    "finally"
+    "for"
+    "from"
+    "global"
+    "if"
+    "import"
+    "in"
+    "is"
+    "lambda"
+    "nonlocal"
+    "not"
+    "or"
+    "pass"
+    "raise"
+    "return"
+    "try"
+    "while"
+    "with"
+    "yield"))
+
+
+(define iskeyword (ref (py-set kwlist) '__contains__))
+  
+    
diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm
index cfa0f3e..8cb47fb 100644
--- a/modules/language/python/module/python.scm
+++ b/modules/language/python/module/python.scm
@@ -156,9 +156,9 @@
     (syntax-case x ()
       ((map f a ...)
        (with-syntax (((x ...) (generate-temporaries #'(a ...))))
-         #'(make-generator map
-             (lambda (yield)
-               (for ((x : a) ...) () (yield (f x ...))))))))))
+	 #'(for ((x : a) ...) ((l '()))
+	    (cons (f x ...) l)
+	    #:final (py-list (reverse l))))))))
                     
 (define* (sum i #:optional (start 0))
   (for ((x : i)) ((s start))
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
index d4cb74b..91a78db 100644
--- a/modules/language/python/string.scm
+++ b/modules/language/python/string.scm
@@ -17,10 +17,17 @@
                       py-partition py-replace py-strip py-title
                       py-rpartitio py-rindex py-split py-rsplit py-splitlines
                       py-startswith py-swapcase py-translate py-zfill
-                      pystring-listing <py-string> pystring py-string?))
+                      pystring-listing <py-string> pystring py-string?
+		      scm-str scm-sym py-identifier?))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
+(define (scm-str x) (slot-ref (pystring x) 'str))
+(define (scm-sym x)
+  (if (symbol? x)
+      x
+      (string->symbol (scm-str x))))
+
 (define (py-string? x)
   (or (string? x)
       (is-a? x <py-string>)))
@@ -169,6 +176,24 @@
 (mk-is py-isspace isspace char-whitespace?)
 (mk-is py-isupper isupper char-upper-case?)
 
+(define-py (py-identifier? isidentifier s)
+  (let lp ((l (string->list s)) (first? #t))
+    (if (pair? l)
+	(let ((x (car l)))
+	  (if first? 
+	      (if (or (char-alphabetic? x)
+		      (eq? x #\_))
+		  (lp (cdr l) #f)
+		  #f)
+	      (if (or (char-alphabetic? x)
+		      (char-numeric? x)
+		      (eq? x #\_))
+		  (lp (cdr l) #f)
+		  #f)))
+	(if ((@ (language python module keyword) iskeyword) s)
+	    #f
+	    #t))))
+	      
 (define-py (py-istitle istitle s)
   (let ((n (len s)))
     (if ((> n 0))