slice set and improvements

2 files changed, 159 insertions, 30 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 4aa67ec..46a9199 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -179,6 +179,60 @@
     ((sort)    (L 'pylist-sort!))
     (else #f)))
 
+(define (get-addings vs x)
+  (match x
+    (() '())
+    ((x . l)
+     (let ((is-fkn? (match l
+                      (((#:arglist . _) . _)
+                       #t)
+                      (_
+                       #f))))
+       
+       (cons
+        (match x
+          ((#:identifier . _)
+           (let* ((tag     (exp vs x))
+                  (xs      (gensym "xs"))
+                  (is-fkn? (aif it (and is-fkn? (fastfkn tag))
+                                `(#:call-obj (lambda (e)
+                                               `(lambda ,xs
+                                                  (apply ,it ,e ,xs))))
+                                #f)))
+             (if is-fkn?
+                 is-fkn?
+                 `(#:identifier ',tag))))
+          
+          ((#:arglist args apply  #f)
+           (if apply
+               `(#:apply ,@(map (g vs exp) args)
+                         ,`(,(L 'to-list) ,(exp vs apply)))
+               `(#:call  ,@(map (g vs exp) args))))
+        
+          ((#:subscripts (n #f #f))
+           `(#:vecref ,(exp vs n)))
+        
+          ((#:subscripts (n1 n2 n3))
+           (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+             `(#:vecsub            
+               ,(w (exp vs n1)) ,(w (exp vs n2)) ,(w (exp vs n3)))))
+        
+          ((#:subscripts (n #f #f) ...)
+           `(#:array-ref ,@ (map (lambda (n)
+                                   (exp vs n))
+                                 n)))
+        
+          ((#:subscripts (n1 n2 n3) ...)
+           (let ((w (lambda (x) (if (eq? x 'None) ''None x))))
+             `(#:arraysub
+               ,@(map (lambda (x y z)
+                        `(,(exp vs x) ,(exp vs y) ,(exp vs z)))
+                      n1 n2 n3))))
+        
+          (_ (error "unhandled addings")))
+        (get-addings vs l))))))
+  
+
 (define (make-set vs op x u)
   (define (tr-op op)
     (match op
@@ -197,7 +251,7 @@
   
   (match x
     ((#:test (#:power kind (#:identifier v . _) addings . _) . _)
-     (let ((addings (map (lambda (x) (exp vs x)) addings)))
+     (let ((addings (get-addings vs addings)))
        (define q (lambda (x) `',x))
        (if kind
            (let ((v (string->symbol v)))
@@ -218,18 +272,12 @@
                  (if op
                      `(,s/d ,v (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u))
                      `(,s/d ,v ,u))
-                 (let* ((rev (reverse addings))
-                        (las (car rev))
-                        (new (reverse (cdr rev))))
-                   `(,(O 'set) ,(let lp ((v v) (new new))
-                                  (match new
-                                    ((x . new)
-                                     (lp `(,(O 'refq) ,v 'x) ',new))
-                                    (() v)))
-                     ',(exp vs las)
-                     ,(if op
-                          `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)
-                          u))))))))))
+                 `(,(C 'set-x)
+                   ,v
+                   ,addings
+                   ,(if op
+                        `(,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)
+                        u)))))))))
   
 (define is-class? (make-fluid #f))
 (define (gen-yargs vs x)
@@ -357,6 +405,14 @@
   ((_ x)
    (list 'lognot (exp vs x))))
 
+ (#:u-
+  ((_ x)
+   (list '- (exp vs x))))
+
+ (#:u+
+  ((_ x)
+   (list '+ (exp vs x))))
+
  (#:band
   ((_ . l)
    (cons 'logand (map (g vs exp) l))))
@@ -694,8 +750,8 @@
   (#:list
    ((_ . l)
     (list (L 'to-pylist) (let lp ((l l))
-                           (match l
-                             (() ''())
+                           (match l                             
+                             ((or () #f) ''())                            
                              (((#:starexpr  #:power #f (#:list . l) . _) . _)
                               (lp l))
                              (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
@@ -1183,10 +1239,37 @@
            obj)))))
                       
 (define-syntax ref-x
-  (lambda (x)
-    (syntax-case x ()
-      ((_ v)
-       #'v)
-      ((_ v x . l)
-       #'(ref-x (refq v 'x) . l)))))
+  (syntax-rules ()
+    ((_ v)
+     v)
+    ((_ v (#:identifier x) . l)
+     (ref-x (refq v 'x) . l))
+    ((_ v (#:identifier x) . l)
+     (ref-x (refq v 'x) . l))
+    ((_ v (#:call-obj x) . l)
+     (ref-x (x v) . l))
+    ((_ v (#:call x ...) . l)
+     (ref-x (v x ...) . l))
+    ((_ v (#:apply x ...) . l)
+     (ref-x (apply v x ...) . l))
+    ((_ v (#:apply x ...) . l)
+     (ref-x (apply v x ...) . l))
+    ((_ v (#:vecref x) . l)
+     (ref-x (pylist-ref v x) . l))
+    ((_ v (#:vecsub . x) . l)
+     (ref-x (pylist-slice v . x) . l))))
+
+(define-syntax set-x
+  (syntax-rules ()
+    ((_ v (a ... b) val)
+     (set-x-2 (ref-x v a ...) b val))))
+
+(define-syntax set-x-2
+  (syntax-rules ()
+    ((_ v (#:identifier x) val)
+     (set v 'x val)) 
+    ((_ v (#:vecref n) val)
+     (pylist-set! v n val))
+    ((_ v (#:vecsub x ...) val)
+     (pylist-subset! v x ... val))))
 
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index b8f1860..8b25077 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -7,7 +7,7 @@
   #:use-module (language python try)
   #:use-module (language python exceptions)
   #:export (to-list pylist-ref pylist-set! pylist-append!
-                    pylist-slice))
+                    pylist-slice pylist-subset!))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -32,6 +32,9 @@
 
 (define-class <py-list> () vec n)
 
+(define-method (to-pylist (l <py-list>))
+  l)
+
 (define-method (to-pylist (l <pair>))
   (let* ((n   (length l))
          (vec (make-vector (* 2 n)))
@@ -57,14 +60,17 @@
         (slot-set! o 'n   0)
         o)
       (error "not able to make a pylist")))
-  
+
 ;;; REF
-(define-method (pylist-ref (o <py-list>) n)
-  (if (< n (slot-ref o 'n))
+(define-method (pylist-ref (o <py-list>) nin)
+  (define N (slot-ref o 'n))
+  (define n (if (< nin 0) (+ N nin) nin))
+  (if (and (>= n 0) (< n (slot-ref o 'n)))
       (vector-ref (slot-ref o 'vec) n)
       (raise IndexError)))
 
 (define-method (pylist-ref (o <pair>) n)
+  (define n (if (< n 0) (+ (length o) n)))
   (list-ref o n))
 
 (define-method (pylist-ref (o <vector>) n)
@@ -74,8 +80,11 @@
   ((ref o '__listref__) n))
 
 ;;; SET
-(define-method (pylist-set! (o <py-list>) n val)
-  (if (< n (slot-ref o 'n))
+(define-method (pylist-set! (o <py-list>) nin val)
+  (define N (slot-ref o 'n))
+  (define n (if (< nin 0) (+ N nin) nin))
+    
+  (if (and (>= n 0) (< n (slot-ref o 'n)))
       (vector-set! (slot-ref o 'vec) n val)
       (raise IndexError)))
 
@@ -90,9 +99,12 @@
 
 ;;SLICE
 (define-method (pylist-slice (o <py-list>) n1 n2 n3)
-  (let* ((n1   (if (eq? n1 'None) 0                n1))
-         (n2   (if (eq? n2 'None) (slot-ref o 'n)  n2))
-         (n3   (if (eq? n3 'None) 1                n3))
+  (define N (slot-ref o 'n))
+  (define (f n) (if (< n 0) (+ N n) n))
+    
+  (let* ((n1   (f (if (eq? n1 'None) 0                n1)))
+         (n2   (f (if (eq? n2 'None) (slot-ref o 'n)  n2)))
+         (n3   (f (if (eq? n3 'None) 1                n3)))
 
          (vec  (slot-ref o 'vec))
          (l    (let lp ((i n1))
@@ -104,6 +116,40 @@
 (define-method (pylist-slice o n1 n2 n3)
   (pylist-slice (to-pylist o) n1 n2 n3))
 
+;;SUBSET
+(define-method (pylist-subset! (o <py-list>) n1 n2 n3 val)
+  (define N (slot-ref o 'n))
+  (define (f n) (if (< n 0) (+ N n) n))
+  
+  (let* ((n1   (f (if (eq? n1 'None) 0                n1)))
+         (n2   (f (if (eq? n2 'None) (slot-ref o 'n)  n2)))
+         (n3   (f (if (eq? n3 'None) 1                n3)))         
+         (vec  (slot-ref o 'vec))
+         (o2   (to-pylist val))
+         (N2   (slot-ref o2 'n))
+         (vec2 (slot-ref o2 'vec)))
+    (if (<= n2 N)
+        (let lp ((i 0) (j n1))
+          (if (< j n2)
+              (if (< i N2)
+                  (begin
+                    (vector-set! vec j (vector-ref vec2 i))
+                    (lp (+ i 1) (+ j n3)))
+                  (let lp ((j2 j))
+                    (if (< j2 n2)
+                        (lp (+ j2 n3))
+                        (let lp ((k1 j) (k2 j2))
+                          (if (< k2 N)
+                              (begin
+                                (vector-set! vec k1 (vector-ref vec k2))
+                                (lp (+ k1 1) (+ k2 1)))
+                              (slot-set! o 'n k1))))))))
+                             
+              
+        (raise IndexError))
+    (values)))
+               
+
 ;;APPEND
 (define-method (pylist-append! (o <py-list>) val)
   (let* ((n   (slot-ref o 'n))