summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-19 16:09:00 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-19 16:09:00 +0100
commit10e1bd278fca5d65fba7fc977a14e4a37a572cc7 (patch)
tree22500a4c4d5dfc1ce4acf8fd9b65a1421b16a3db
parent131f7d6c71d0a0fe4f60b49a39efcd4f8ace6b0c (diff)
downloadguile-10e1bd278fca5d65fba7fc977a14e4a37a572cc7.tar.gz
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.
-rw-r--r--module/language/ecmascript/compile-ghil.scm10
-rw-r--r--module/language/ecmascript/impl.scm48
-rw-r--r--module/language/ecmascript/parse.scm10
3 files changed, 58 insertions, 10 deletions
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*
<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))))))
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))