initial list support

4 files changed, 171 insertions, 19 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 0919f1b..332c22e 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -164,6 +164,20 @@
 (define-syntax-rule (<< x y) (ash x y))
 (define-syntax-rule (>> x y) (ash x (- y)))
 
+(define (fastfkn x)
+  (case x
+    ;; Lists
+    ((append)  (L 'pylist-apbpend!))
+    ((count)   (L 'pylist-count!))
+    ((extend)  (L 'pylist-extend!))
+    ((index)   (L 'pylist-index))
+    ((pop)     (L 'pylist-pop!))
+    ((insert)  (L 'pylist-insert!))
+    ((remove)  (L 'pylist-remove!))
+    ((reverse) (L 'pylist-reverse!))
+    ((sort)    (L 'pylist-sort!))
+    (else #f)))
+
 (define (make-set vs op x u)
   (define (tr-op op)
     (match op
@@ -192,11 +206,11 @@
                      `(,s/d ,v ,u))
                  (if op
                      `(,s/d ,(exp vs kind)
-                        (,(O 'fset-x) ,v (list ,@(map q addings))
-                         (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))
+                            (,(O 'fset-x) ,v (list ,@(map q addings))
+                             (,(tr-op op) (,(C 'ref-x) ,v ,@addings) ,u)))
                      
                      `(,s/d ,(exp vs kind)
-                        (,(O 'fset-x) ,v (list ,@(map q addings)) ,u)))))
+                            (,(O 'fset-x) ,v (list ,@(map q addings)) ,u)))))
            
            (let ((v (string->symbol v)))
              (if (null? addings)
@@ -234,11 +248,13 @@
 
 (gen-table x vs
  (#:power
-  ((#:power _ (x) () . #f)
+  ((_ _ (x) () . #f)
    (exp vs x))
-  ((#:power _ x () . #f)
+  
+  ((_ _ x () . #f)
    (exp vs x))
-  ((#:power #f vf trailer . **)
+  
+  ((_ #f vf trailer . **)
    (let ()
      (define (pw x)
        (if **
@@ -252,9 +268,22 @@
           ((#f)          
            (list e))
           ((x . trailer)
-           (match (pr x)
+           (let ((is-fkn? (match trailer
+                            (((#:arglist . _) . _)
+                             #t)
+                            (_
+                             #f))))
+             (match (pr x)
                ((#:identifier . _)
-                (lp `(,(O 'refq) ,e ',(exp vs x) #f) trailer))
+                (let* ((tag     (exp vs x))
+                       (xs      (gensym "xs"))
+                       (is-fkn? (aif it (and is-fkn? (fastfkn tag))
+                                     `(lambda ,xs (apply ,it ,e ,xs))
+                                     #f)))
+                  (lp (if is-fkn?
+                          is-fkn?
+                          `(,(O 'refq) ,e ',tag #f))
+                      trailer)))
                
                ((#:arglist args apply  #f)
                 (if apply
@@ -264,7 +293,7 @@
                         trailer)
                     (lp `(,e ,@(map (g vs exp) args)) trailer)))
                
-               (_ (error "unhandled trailer"))))))))))
+               (_ (error "unhandled trailer")))))))))))
 
  (#:identifier
   ((#:identifier x . _)
@@ -640,7 +669,19 @@
   (#:global
    ((_ . _)
     '(values)))
-  
+
+  (#:list
+   ((_ . l)
+    (list (L 'to-pylist) (let lp ((l l))
+                           (match l
+                             (() ''())
+                             (((#:starexpr  #:power #f (#:list . l) . _) . _)
+                              (lp l))
+                             (((#:starexpr . l) . _)
+                              `(,(L 'to-list) ,(exp vs l)))
+                             ((x . l)
+                              `(cons ,(exp vs x) ,(lp l))))))))
+
   (#:lambdef
    ((_ v e)
     (list `lambda v (exp vs e))))
@@ -1105,9 +1146,10 @@
            obj)))))
                       
 (define-syntax ref-x
-  (syntax-rules ()
-    ((_ v)
-     v)
-    ((_ v x . l)
-     (ref-x (ref v 'x) . l))))
+  (lambda (x)
+    (syntax-case x ()
+      ((_ v)
+       #'v)
+      ((_ v x . l)
+       #'(ref-x (refq v 'x) . l)))))
 
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 954f3b3..5b3b5ca 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -2,14 +2,16 @@
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
   #:export (StopIteration GeneratorExit RuntimeError
-                          Exception))
+                          Exception
+                          IndexError))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define StopIteration 'StopIteration)
 (define GeneratorExit 'GeneratorExit)
 (define RuntimeError  'RuntimeError)
-
+(define IndexError    'IndexError)
+  
 (define-python-class Exception ()
   (define __init__
     (case-lambda
diff --git a/modules/language/python/for.scm b/modules/language/python/for.scm
index bb0afa4..fade3f2 100644
--- a/modules/language/python/for.scm
+++ b/modules/language/python/for.scm
@@ -4,7 +4,7 @@
   #:use-module (language python exceptions)
   #:use-module (oop goops)
   #:use-module (ice-9 control)
-  #:export (for break next write))
+  #:export (for break next))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm
index 64ff6e4..1935f02 100644
--- a/modules/language/python/list.scm
+++ b/modules/language/python/list.scm
@@ -1,11 +1,13 @@
 (define-module (language python list)
   #:use-module (oop pf-objects)
   #:use-module (oop goops)
+  #:use-module (language python exceptions)
   #:use-module (language python yield)
   #:use-module (language python for)
   #:use-module (language python exceptions)
-  #:export (to-list))
+  #:export (to-list pylist-ref pylist-set! pylist-append!))
 
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define-method (to-list x)
   (if (vector? x)
@@ -15,6 +17,7 @@
 (define-method (to-list (x <p>))
   ((ref x '__tolist__ (lambda () (error "missing __tolist__ in object")))))
 
+
 (define-method (to-list (x <yield>))
   (define l '())
   (catch StopIteration
@@ -24,3 +27,108 @@
         (lp)))
     (lambda x
       (reverse l))))
+
+(define-class <py-list> () vec n)
+
+(define-method (to-pylist (l <pair>))
+  (let* ((n   (length l))
+         (vec (make-vector (* 2 n)))
+         (o   (make <py-list>)))
+    
+    (let lp ((l l) (i 0))
+      (if (pair? l)
+          (begin
+            (vector-set! vec i (car l))
+            (lp (cdr l) (+ i 1)))))
+    
+    (slot-set! o 'n   n)
+    (slot-set! o 'vec vec)
+    o))
+
+
+;;; REF
+(define-method (pylist-ref (o <py-list>) n)
+  (if (< n (slot-ref o 'n))
+      (vector-ref (slot-ref o 'vec) n)
+      (raise IndexError)))
+
+(define-method (pylist-ref (o <pair>) n)
+  (list-ref o n))
+
+(define-method (pylist-ref (o <vector>) n)
+  (vector-ref o n))
+
+(define-method (pylist-ref (o <p>) n)
+  ((ref o '__listref__) n))
+
+;;; SET
+(define-method (pylist-set! (o <py-list>) n val)
+  (if (< n (slot-ref o 'n))
+      (vector-set! (slot-ref o 'vec) n val)
+      (raise IndexError)))
+
+(define-method (pylist-set! (o <pair>) n val)
+  (list-set! o n val))
+
+(define-method (pylist-set! (o <vector>) n val)
+  (vector-set! o n val))
+
+(define-method (pylist-set! (o <p>) n val)
+  ((ref o '__listset__) n val))
+
+;;APPEND
+(define-method (pylist-append! (o <py-list>) n val)
+  (let* ((n   (slot-ref o 'n))
+         (vec (slot-ref o 'vec))
+         (N   (vector-length vec)))
+    (if (< n N)
+        (begin
+          (vector-set! vec n val)
+          (slot-set! o 'n (+ n 1)))
+        (let* ((N    (* 2 N))
+               (vec2 (make-vector N)))
+          (let lp ((i 0))
+            (if (< i n)
+                (begin
+                  (vector-set! vec2 i (vector-ref vec i))
+                  (lp (+ i 1)))))
+          (vector-set! vec2 n val)
+          (slot-set! o 'vec vec2)))
+    (slot-set! o 'n (+ n 1))))
+
+(define-method (pylist-append! o n)
+  (raise 'NotSupportedOP '__append__))
+
+(define-method (pylist-append! (o <p>) n . l)
+  (aif it (ref o '__append__)
+       (it n)
+       (aif it (ref o 'append)
+            (apply it n l)
+            (error "no append"))))
+       
+    
+(define-method (to-list (x <py-list>))
+  (let ((vec (slot-ref x 'vec))
+        (n   (slot-ref x 'n)))
+    (let lp ((i 0))
+      (if (< i n)
+          (cons (vector-ref vec i) (lp (+ i 1)))
+          '()))))
+    
+
+(define-method (write (o <py-list>) . l)
+  (define port (if (null? l) #t (car l)))
+
+    (let* ((l (to-list o)))      
+    (if (null? l)
+        (format port "[]")
+        (format port "[~a~{, ~a~}]" (car l) (cdr l)))))
+  
+(define-method (display (o <py-list>) . l)
+  (define port (if (null? l) #t (car l)))
+
+  (let* ((l (to-list o)))      
+    (if (null? l)
+        (format port "[]")
+        (format port "[~a~{, ~a~}]" (car l) (cdr l)))))
+