diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm index 3bd6aee13..8c1cfc877 100644 --- a/module/language/ecmascript/compile-ghil.scm +++ b/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))))) diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm index 7823ad119..c335af0b9 100644 --- a/module/language/ecmascript/impl.scm +++ b/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* 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 ) p v) (if (prop-has-attr? o p 'ReadOnly) (throw 'ReferenceError o p) @@ -182,3 +185,44 @@ ((number? x) (make #:prototype String #:value x)) ((string? x) (make #:prototype Number #:value x)) (else x))) + +(define-class () + (vector #:init-value #() #:accessor js-array-vector)) + +(define-method (pget (o ) 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 ) 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 ))) + (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)))))) diff --git a/module/language/ecmascript/parse.scm b/module/language/ecmascript/parse.scm index b11de0e1d..82e9f770a 100644 --- a/module/language/ecmascript/parse.scm +++ b/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))