dicts now works almost entirely
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 23 Sep 2017 18:57:50 +0000 (20:57 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sat, 23 Sep 2017 18:57:50 +0000 (20:57 +0200)
modules/language/python/compile.scm
modules/language/python/def.scm
modules/language/python/exceptions.scm
modules/language/python/list.scm
modules/language/python/string.scm
modules/language/python/yield.scm

index 34cc4df37901b013f0b9d8212f74de44f8d99af8..dc608a4023ab4f71b97b652e48f3a64fc946b987 100644 (file)
@@ -3,6 +3,7 @@
   #:use-module (ice-9 control)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
+  #:use-module (language python dict)
   #:use-module (language python exceptions)
   #:use-module (language python yield)
   #:use-module (language python for)
   x)
 
 
-(define-inlinable (C x) `(@@ (language python compile) ,x))
-(define-inlinable (Y x) `(@@ (language python yield)   ,x))
-(define-inlinable (T x) `(@@ (language python try)     ,x))
-(define-inlinable (F x) `(@@ (language python for)     ,x))
-(define-inlinable (L x) `(@@ (language python list)    ,x))
-(define-inlinable (A x) `(@@ (language python array)   ,x))
-(define-inlinable (S x) `(@@ (language python string)  ,x))
-(define-inlinable (D x) `(@@ (language python def)     ,x))
-(define-inlinable (O x) `(@@ (oop pf-objects)          ,x))
-(define-inlinable (G x) `(@  (guile)                   ,x))
+(define-inlinable (C  x) `(@@ (language python compile) ,x))
+(define-inlinable (Y  x) `(@@ (language python yield)   ,x))
+(define-inlinable (T  x) `(@@ (language python try)     ,x))
+(define-inlinable (F  x) `(@@ (language python for)     ,x))
+(define-inlinable (E  x) `(@@ (language python exceptions) ,x))
+(define-inlinable (L  x) `(@@ (language python list)    ,x))
+(define-inlinable (A  x) `(@@ (language python array)   ,x))
+(define-inlinable (S  x) `(@@ (language python string)  ,x))
+(define-inlinable (D  x) `(@@ (language python def)     ,x))
+(define-inlinable (Di x) `(@@ (language python dict)    ,x))
+(define-inlinable (O  x) `(@@ (oop pf-objects)          ,x))
+(define-inlinable (G  x) `(@  (guile)                   ,x))
 
 (define (union as vs)
   (let lp ((as as) (vs vs))
    ((startswith) (S 'py-startswith))
    ((swapcase)   (S 'py-swapcase))
    ((translate)  (S 'py-translate))
-   ((zfill)      (S 'py-zfill))))
+   ((zfill)      (S 'py-zfill))
+
+   ;;DICTS
+   ((copy)       (Di 'py-copy))
+   ((fromkeys)   (Di 'py-fromkeys))
+   ((get)        (Di 'py-get))
+   ((has_key)    (Di 'py-has_key))
+   ((items)      (Di 'py-items))
+   ((iteritems)  (Di 'py-iteritems))
+   ((iterkeys)   (Di 'py-iterkeys))
+   ((itervalues) (Di 'py-itervalues))
+   ((keys)       (Di 'py-keys))
+   ((values)     (Di 'py-values))
+   ((popitem)    (Di 'py-popitem))
+   ((setdefault) (Di 'py-setdefault))
+   ((update)     (Di 'py-update))))
    
+
 (define (fastfkn x) (hash-ref fasthash x))
     
 (define (get-kwarg vs arg)
            `(#:vecref ,(exp vs n)))
         
           ((#:subscripts (n1 n2 n3))
-           (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+           (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
              `(#:vecsub            
                ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
         
                                  n)))
         
           ((#:subscripts (n1 n2 n3) ...)
-           (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+           (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
              `(#:arraysub
                ,@(map (lambda (x y z)
                         `(,(exp vs x) ,(exp vs y) ,(exp vs z)))
                 `(,(L 'pylist-ref) ,e ,(exp vs n)))
                
                ((#:subscripts (n1 n2 n3))
-                (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+                (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
                   `(,(L 'pylist-slice) ,e
                     ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
 
                                                      n))))
 
                ((#:subscripts (n1 n2 n3) ...)
-                (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+                (let ((w (lambda (x) (if (eq? x None) (E 'None) x))))
                   `(,(A 'pyarray-slice) ,e
                     (list ,@(map (lambda (x y z)
                                    `(list ,(exp vs x) ,(exp vs y) ,(exp vs z)))
   (#:return
    ((_ . x)
     `(,(fluid-ref return) ,@(map (g vs exp) x))))
-    
+
+  (#:dict
+   ((_ . #f)
+    `(,(Di 'make-py-hashtable)))
+   
+   ((_  (k . v) ...)
+    (let ((dict (gensym "dict")))
+      `(let ((,dict (,(Di 'make-py-hashtable))))
+         ,@(map (lambda (k v)
+                  `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
+                k v)
+         ,dict))))
+                  
                            
   (#:comp
    ((_ x #f)
      ((hash-ref tagis tag (lambda y (warn "not tag in tagis") x)) x vs))
 
     (#:True  #t)
+    (#:None  (E 'None))
     (#:null  ''())
     (#:False #f)
     (#:pass  `(values))
 
 (define-inlinable (non? x) (eq? x #:nil))
 
+(define (gentemp stx) (datum->syntax stx (gensym "x")))
+
 (define-syntax for
   (syntax-rules ()
     ((_ (x) (a) code #f #f)
 (define-syntax for/adv1
   (lambda (x)
     (syntax-case x ()
+      ((_ (x ...) (in) code #f #f)
+       (with-syntax ((inv (gentemp #'in)))
+         #'(let ((inv (wrap-in in)))
+             (catch StopIteration
+               (lambda ()
+                 (let lp ()
+                   (call-with-values (lambda () (next inv))
+                     (lambda (x ...)
+                       (with-sp ((break    (values))
+                                 (continue (values)))
+                                code
+                                (lp))))))
+               (lambda z (values))))))
+
       ((_ (x ...) (in ...) code #f #f)
        (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
          #'(let ((inv (wrap-in in)) ...)
                           (lp))))))
                (lambda z (values))))))
 
+      ((_ (x ...) (in) code #f #t)
+       (with-syntax ((inv (gentemp #'in)))          
+          #'(let ((inv (wrap-in in)))
+              (let lp ()
+                (let/ec break-ret
+                  (catch StopIteration
+                    (lambda ()
+                      (call-with-values (lambda () (next inv))
+                        (lambda (x ...)
+                          (let/ec continue-ret
+                            (with-sp ((break     (break-ret))
+                                      (continue  (continue-ret)))
+                                     code))
+                          (lp))))
+                    (lambda z (values))))))))
+
       ((_ (x ...) (in ...) code #f #t)
        (with-syntax (((inv ...) (generate-temporaries #'(in ...))))          
           #'(let ((inv (wrap-in in)) ...)
             ((x)  #'(next x)))))
     
     (syntax-case x ()
+      ((_ (x ...) (in) code else p)
+       (with-syntax ((inv (gentemp #'in)))
+         (with-syntax (((xx ...) (generate-temporaries #'(x ...))))
+           (if (syntax->datum #'p)
+               #'(let ((inv (wrap-in in)))               
+                   (let/ec break-ret
+                     (let ((x #f) ...)
+                       (catch StopIteration
+                         (lambda ()
+                           (let lp ()
+                             (call-with-values (lambda () (next inv))
+                               (lambda (xx ...)
+                                 (set! x xx) ...
+                                 (let/ec continue-ret
+                                   (with-sp ((break     (break-ret))
+                                             (continue  (continue-ret)))
+                                            code))
+                                 (lp)))))
+                         (lambda q else)))))
+             
+               #'(let ((inv (wrap-in in)))
+                   (let ((x #f) ...)
+                     (let/ec break-ret
+                       (catch StopIteration
+                         (lambda ()
+                           (let lp ()
+                             (call-with-values (lambda () (next inv))
+                               (lambda (xx ...)
+                                 (set! x xx) ...
+                                 (with-sp ((break     (break-ret))
+                                           (continue  (values)))
+                                          code)
+                                 (lp)))))
+                         (lambda e else)))))))))
+      
       ((_ (x ...) (in ...) code else p)
        (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
        (with-syntax ((get      (gen #'(inv ...) #'(x ...)))
index a9aa69249344dcd08573786c3467664fd0cb582d..bc745f0f75b5035602d9d9b667b485c0fad821f2 100644 (file)
       (()
        (values (reverse args) kw)))))
 
+(define hset! hash-set!)
+
+(define (pytonize kw)
+  (hash-fold
+   (lambda (k v h)
+     (hset! h (symbol->string (keyword->symbol k)) v)
+     h)
+   (make-hash-table)
+   kw))
+
 (define-syntax lam
   (lambda (x)
     (define-syntax-rule (mk get-as (k v s) x y z w)
@@ -76,7 +86,8 @@
                      (lambda (ww* kw)
                        (let*-values (((ww* k) (take-1 ww* kw s v))
                                      ...)
-                         (let ((ww ww*))
+                         (let ((ww ww*)
+                               (kw (pytonize kw)))
                            code ...))))))))))))
 
 (define-syntax-rule (def (f . args) code ...) (define f (lam args code ...)))
index 00e7074539c06243c4d7c7912e955baba39e8a68..a9b2c14c6460973b302d8017b6feba44691f2bb7 100644 (file)
@@ -3,7 +3,8 @@
   #:use-module (oop goops)
   #:export (StopIteration GeneratorExit RuntimeError
                           Exception ValueError
-                          IndexError))
+                          IndexError KeyError
+                          None))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -12,6 +13,8 @@
 (define RuntimeError  'RuntimeError)
 (define IndexError    'IndexError)
 (define ValueError    'ValueError)
+(define None          'None)
+(define KeyError      'KeyError)
 
 (define-python-class Exception ()
   (define __init__
index 498934fbf7cce0b895f822a9b6343f6ab3cf41e1..094c7860b2deb801905844da622717bab988e74f 100644 (file)
@@ -2,21 +2,32 @@
   #:use-module (ice-9 match)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
+  #:use-module (language python hash)
   #:use-module (language python exceptions)
   #:use-module (language python yield)
   #:use-module (language python for)
   #:use-module (language python try)
   #:use-module (language python exceptions)
-  #:export (to-list pylist-ref pylist-set! pylist-append!
-                    pylist-slice pylist-subset! pylist-reverse!
-                    pylist-pop! pylist-count pylist-extend! len in
-                    pylist-insert! pylist-remove! pylist-sort!
-                    pylist-index))
+  #:export (to-list to-pylist
+            pylist-ref pylist-set! pylist-append!
+            pylist-slice pylist-subset! pylist-reverse!
+            pylist-pop! pylist-count pylist-extend! len in
+            pylist-insert! pylist-remove! pylist-sort!
+            pylist-index))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-class <py-list> () vec n)
 
+(define-method (py-hash (o <py-list>))
+  (let ((n (min complexity (slot-ref o 'n)))
+        (v (slot-ref o 'vec)))
+    (let lp ((i 0) (s 0))
+      (if (< i n)
+          (lp (+ i 1)
+              (xy (py-hash (vector-ref v i)) s))
+          s))))
+
 (define-method (to-list x)
   (if (vector? x)
       (vector->list x)
             (vector-set! vec i (vector-ref vec k))
             (vector-set! vec k swap))))))
 
+
 (define-method (pylist-reverse! (o <p>) . l)
   (apply (ref o 'reverse) l))
 
index 15dbe43550ea8efffe4beb79ec743890df099ce2..22c8b8815ed343740f4ec2291cce510366b4767e 100644 (file)
@@ -3,6 +3,7 @@
   #:use-module (oop pf-objects)
   #:use-module (ice-9 match)
   #:use-module (language python list)
+  #:use-module (language python exceptions)
   #:use-module (parser stis-parser)
   #:export (py-format py-capitalize py-center py-endswith
                       py-expandtabs py-find py-rfind
@@ -13,8 +14,6 @@
                       py-rpartitio py-rindex py-split py-rsplit py-splitlines
                       py-startswith py-swapcase py-translate py-zfill))
 
-(define None 'None)
-
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-syntax-rule (define-py (f n o . u) code ...)
index 569775d2b327faf01e2461c416ded73a43d47339..d32ff4b7b3e7d7b658683eacef19a1f7e62610d3 100644 (file)
@@ -5,7 +5,7 @@
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
   #:replace (send)
-  #:export (<yield>
+  #:export (<yield> 
             in-yield define-generator
             make-generator
             sendException sendClose))
            (fluid-set! in-yield #t)
            ((apply abort-to-prompt YIELD x)))))))
 
-(define (make-generator closure)
-  (lambda args
-    (let ()
-      (define obj   (make <yield>))
-      (define ab (make-prompt-tag))
-      (syntax-parameterize ((YIELD (lambda x #'ab)))
-        (slot-set! obj 'k #f)
-        (slot-set! obj 'closed #f)
-        (slot-set! obj 's
-                   (lambda ()
-                     (call-with-prompt
-                      ab
+(define-syntax make-generator
+  (syntax-rules ()
+    ((_ (args ...) closure)
+     (lambda (args ...)
+       (let ()
+         (define obj   (make <yield>))
+         (define ab (make-prompt-tag))
+         (syntax-parameterize ((YIELD (lambda x #'ab)))
+           (slot-set! obj 'k #f)
+           (slot-set! obj 'closed #f)
+           (slot-set! obj 's
                       (lambda ()
-                        (apply closure yield args)
-                        (slot-set! obj 'closed #t)
-                        (throw StopIteration))
-                      (letrec ((lam
-                                (lambda (k . l)
-                                  (fluid-set! in-yield #f)
-                                  (slot-set! obj 'k
-                                             (lambda (a)
-                                               (call-with-prompt
-                                                ab
-                                                (lambda ()
-                                                  (k a))
-                                                lam)))
-                                  (apply values l))))
-                        lam))))
-        obj))))
+                        (call-with-prompt
+                         ab
+                         (lambda ()
+                           (closure yield args ...)
+                           (slot-set! obj 'closed #t)
+                           (throw StopIteration))
+                         (letrec ((lam
+                                   (lambda (k . l)
+                                     (fluid-set! in-yield #f)
+                                     (slot-set! obj 'k
+                                                (lambda (a)
+                                                  (call-with-prompt
+                                                   ab
+                                                   (lambda ()
+                                                     (k a))
+                                                   lam)))
+                                     (apply values l))))
+                           lam))))
+           obj))))
 
-(define-syntax-rule (define-generator (f . args) code ...)
-  (define f (make-generator args (lambda args code ...))))
+    ((_ (args ... . ***) closure)
+     (lambda (args ... . ***)
+       (let ()
+         (define obj   (make <yield>))
+         (define ab (make-prompt-tag))
+         (syntax-parameterize ((YIELD (lambda x #'ab)))
+           (slot-set! obj 'k #f)
+           (slot-set! obj 'closed #f)
+           (slot-set! obj 's
+                      (lambda ()
+                        (call-with-prompt
+                         ab
+                         (lambda ()
+                           (apply closure yield args ... ***)
+                           (slot-set! obj 'closed #t)
+                           (throw StopIteration))
+                         (letrec ((lam
+                                   (lambda (k . l)
+                                     (fluid-set! in-yield #f)
+                                     (slot-set! obj 'k
+                                                (lambda (a)
+                                                  (call-with-prompt
+                                                   ab
+                                                   (lambda ()
+                                                     (k a))
+                                                   lam)))
+                                     (apply values l))))
+                           lam))))
+           obj))))))
+
+(define-syntax define-generator
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (f y . args) code ...)
+       #'(define f (make-generator args  (lambda (y . args) code ...)))))))
 
 (define-class <yield>      () s k closed)