add array support

* module/language/ecmascript/compile-ghil.scm (@impl): Whoops, fix this
  macro.
  (comp): Handle array literals.

* module/language/ecmascript/impl.scm: Add support for arrays.

module/language/ecmascript/compile-ghil.scm

@@ -38,10 +38,12 @@
 	 (and (not (null? props))
               props))))
 
-(define-macro (@impl e l sym . args)
+(define-macro (@impl e l sym args)
   `(make-ghil-call ,e ,l
-                   (ghil-var-at-module! ,e '(language ecmascript impl) ',sym #t)
-                   (list ,@(map (lambda (x) `(comp x ,e)) ,args))))
+                   (make-ghil-ref
+                    ,e ,l
+                    (ghil-var-at-module! ,e '(language ecmascript impl) ',sym #t))
+                   (map (lambda (x) (comp x ,e)) ,args)))
 
 (define (comp x e)
   (let ((l (location x)))
@@ -81,6 +83,8 @@
        (make-ghil-call e l (comp proc e) (map (lambda (x) (comp x e)) args)))
       ((return ,expr)
        (make-ghil-inline e l 'return (list (comp expr e))))
+      ((array . ,args)
+       (@impl e l new-array args))
       (else
        (error "compilation not yet implemented:" x)))))
 

module/language/ecmascript/impl.scm

@@ -20,7 +20,7 @@
 ;;; Code:
 
 (define-module (language ecmascript impl)
-  #:use-modules (oop goops)
+  #:use-module (oop goops)
   #:export (*undefined*
             <js-object>
             pget prop-attrs prop-has-attr? pput has-property? pdel
@@ -29,7 +29,9 @@
             object->value/number object->value
 
             ->primitive ->boolean ->number ->integer ->int32 ->uint32
-            ->uint16 ->string ->object))
+            ->uint16 ->string ->object
+
+            new-array))
 
 (define *undefined* ((@@ (oop goops) make-unbound)))
 
@@ -67,6 +69,7 @@
       (throw 'ReferenceError o p)
       (hashq-set! (js-props o) p v)))
 
+;; what the hell is this
 (define-method (has-property? (o <js-object>) p v)
   (if (prop-has-attr? o p 'ReadOnly)
       (throw 'ReferenceError o p)
@@ -182,3 +185,44 @@
         ((number? x) (make <js-object> #:prototype String #:value x))
         ((string? x) (make <js-object> #:prototype Number #:value x))
         (else x)))
+
+(define-class <js-array-object> (<js-object>)
+  (vector #:init-value #() #:accessor js-array-vector))
+
+(define-method (pget (o <js-array-object>) p)
+  (cond ((and (integer? p) (exact? p) (>= p 0))
+         (let ((v (js-array-vector o)))
+           (if (< p (vector-length v))
+               (vector-ref v p)
+               (next-method))))
+        ((eq? p 'length)
+         (vector-length (js-array-vector o)))
+        (else (next-method))))
+
+(define-method (pput (o <js-array-object>) p v)
+  (cond ((and (integer? p) (exact? p) (>= 0 p))
+         (let ((vect (js-array-vector o)))
+           (if (< p (vector-length vect))
+               (vector-set! vect p)
+               ;; Fixme: round up to powers of 2?
+               (let ((new (make-vector (1+ p) 0)))
+                 (vector-move-left! vect 0 (vector-length vect) new 0)
+                 (set! (js-array-vector o) new)
+                 (vector-set! new p)))))
+        ((eq? p 'length)
+         (let ((vect (js-array-vector o)))
+           (let ((new (make-vector (->uint32 v) 0)))
+             (vector-move-left! vect 0 (min (vector-length vect) (->uint32 v))
+                                new 0)
+             (set! (js-array-vector o) new))))
+        (else (next-method))))
+
+(define (new-array . vals)
+  (let ((o (make <js-array-object>)))
+    (pput o 'length (length vals))
+    (let ((vect (js-array-vector o)))
+      (let lp ((i 0) (vals vals))
+        (cond ((not (null? vals))
+               (vector-set! vect i (car vals))
+               (lp (1+ i) (cdr vals)))
+              (else o))))))

module/language/ecmascript/parse.scm

@@ -186,16 +186,16 @@
                       (lparen Expression rparen) -> $2)
 
    (ArrayLiteral (lbracket rbracket) -> '(array)
-                 (lbracket Elision rbracket) -> '(array)
+                 (lbracket Elision rbracket) -> '(array ,@$2)
                  (lbracket ElementList rbracket) -> `(array ,@$2)
                  (lbracket ElementList comma rbracket) -> `(array ,@$2)
                  (lbracket ElementList comma Elision rbracket) -> `(array ,@$2))
    (ElementList (AssignmentExpression) -> `(,$1)
-                (Elision AssignmentExpression) -> `(,$2)
+                (Elision AssignmentExpression) -> `(,@$1 ,$2)
                 (ElementList comma AssignmentExpression) -> `(,@$1 ,$3)
-                (ElementList comma Elision AssignmentExpression) -> `(,@$1 ,$4))
-   (Elision (comma) -> #f
-            (Elision comma) -> #f)
+                (ElementList comma Elision AssignmentExpression) -> `(,@$1 ,@$3 ,$4))
+   (Elision (comma) -> '((number 0))
+            (Elision comma) -> `(,@$1 (number 0)))
 
    (ObjectLiteral (lbrace rbrace) -> `(object)
                   (lbrace PropertyNameAndValueList rbrace) -> `(object ,@$2))