collections finished and compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Mar 2018 13:20:35 +0000 (14:20 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Wed, 21 Mar 2018 13:20:35 +0000 (14:20 +0100)
modules/language/python/compile.scm
modules/language/python/dict.scm
modules/language/python/module/collections.scm
modules/language/python/module/keyword.scm [new file with mode: 0644]
modules/language/python/module/python.scm
modules/language/python/string.scm

index dad7656749f33ac0f4cb8683ce708c423883fe08..b3cbf67a8e998b9715b551bd40cd9880049b9726 100644 (file)
    ((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 ))
index b9f6dd3ebb4ba74087c6492f0486a9b3f6132537..58d7cb74bae4ae7f211981f12ad1b8aec0e007ed 100644 (file)
@@ -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)
index 65c9159104e3e0321b1237d721d738fbe001a23a..9f402204a4c5430888890ecf7c094381385c2548 100644 (file)
@@ -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)
   #: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))
                         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__
                        (min (py-get self elem 0) count)))
       ((ref self '_keep_positive)))))
 
+(define mod (current-module))
+
 (def (namedtuple typename field_names
                 (= verbose #f)
                 (= rename  #f)
               (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))))
                (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)))
                             (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 (file)
index 0000000..c749ff5
--- /dev/null
@@ -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__))
+  
+    
index cfa0f3ebcdcf7ff0d379b9be7cdb84e677dc339f..8cb47fbcd9c4491d1df4908aa457b8e023d5de9e 100644 (file)
     (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))
index d4cb74b3c60464fbfde0cf24424402c379e2bf62..91a78dbe399a245e4dcef079ac21aa76293050cc 100644 (file)
                       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>)))
 (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))