compile for-in

* module/language/ecmascript/base.scm (prop-keys): New method, returns
  the list of keys of props of this instance.

* module/language/ecmascript/impl.scm: Refactor the global object into a
  special kind of module object. Provide a prop-keys implementation for
  module objects.

* module/language/ecmascript/compile-ghil.scm (comp): Compile for-in.

* module/language/ecmascript/impl.scm: Reshuffly things, and implement
  make-enumerator, a helper for use in for-in statements.

* module/language/ecmascript/parse.scm (parse-ecmascript): Fix parsing of
  for (var foo in bar) {}...

4 files changed, 65 insertions, 27 deletions

diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm
index b799067df..1463d358b 100644
--- a/module/language/ecmascript/base.scm
+++ b/module/language/ecmascript/base.scm
@@ -24,7 +24,7 @@
   #:export (*undefined* *this*
             <js-object> *object-prototype*
             js-prototype js-props js-prop-attrs js-value js-constructor js-class
-            pget prop-attrs prop-has-attr? pput has-property? pdel
+            pget prop-keys prop-attrs prop-has-attr? pput has-property? pdel
 
             object->string object->number object->value/string
             object->value/number object->value
@@ -48,6 +48,9 @@
   (constructor #:getter js-constructor #:init-value #f #:init-keyword #:constructor)
   (class #:getter js-class #:init-value "Object" #:init-keyword #:class))
 
+(define-method (prop-keys (o <js-object>))
+  (hash-map->list (lambda (k v) k) (js-props o)))
+
 (define-method (pget (o <js-object>) (p <string>))
   (pget o (string->symbol p)))
 
diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm
index d2c8385fb..47745e53d 100644
--- a/module/language/ecmascript/compile-ghil.scm
+++ b/module/language/ecmascript/compile-ghil.scm
@@ -307,7 +307,6 @@
            (make-ghil-lambda env l vars #t '()
                              (comp-body env l body formals '%args)))))
       ((call/this ,obj ,prop ,args)
-       ;; FIXME: only evaluate "obj" once
        (@impl e l call/this*
               (list obj (make-ghil-lambda
                          e l '() #f '()
@@ -449,6 +448,39 @@
                                                     '())))
                          (@implv e l *undefined*))))))
                   (make-ghil-call e l (make-ghil-ref e l (car vars)) '()))))))
+      ((for-in ,var ,object ,statement)
+       (call-with-ghil-bindings e '(%continue %enum)
+         (lambda (vars)
+           (make-ghil-begin
+            e l
+            (list
+             (make-ghil-set
+              e l (car vars)
+              (call-with-ghil-environment e '()
+                (lambda (e _)
+                  (make-ghil-lambda
+                   e l '() #f '()
+                   (make-ghil-if
+                    e l (@impl e l ->boolean
+                               (list (@impl e l pget
+                                            (list (make-ghil-ref
+                                                   e l (ghil-var-for-ref! e '%enum))
+                                                  (make-ghil-quote e l 'length)))))
+                    (make-ghil-begin
+                     e l (list (comp `(= ,var (call/this ,(make-ghil-ref
+                                                           e l (ghil-var-for-ref! e '%enum))
+                                                         ,(make-ghil-quote e l 'pop)
+                                                         ()))
+                                     e)
+                               (comp statement e)
+                               (make-ghil-call e l (make-ghil-ref
+                                                    e l (ghil-var-for-ref! e '%continue))
+                                               '())))
+                    (@implv e l *undefined*))))))
+             (make-ghil-set
+              e l (cadr vars)
+              (@impl e l make-enumerator (list (comp object e))))
+             (make-ghil-call e l (make-ghil-ref e l (car vars)) '()))))))
       ((break)
        (let ((var (ghil-var-for-ref! e '%continue)))
          (if (and (ghil-env? (ghil-var-env var))
diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm
index 1307a7f27..be4c751cb 100644
--- a/module/language/ecmascript/impl.scm
+++ b/module/language/ecmascript/impl.scm
@@ -33,32 +33,12 @@
             bitwise-not logical-not
             shift
             mod
-            band bxor bior))
+            band bxor bior
+            make-enumerator))
 
 
-(define-class <js-global-object> (<js-object>))
-(define-method (pget (o <js-global-object>) (p <string>))
-  (pget o (string->symbol p)))
-(define-method (pget (o <js-global-object>) (p <symbol>))
-  (let ((v (module-variable (current-module) p)))
-    (if v
-        (variable-ref v)
-        (next-method))))
-(define-method (pput (o <js-global-object>) (p <string>) v)
-  (pput o (string->symbol p) v))
-(define-method (pput (o <js-global-object>) (p <symbol>) v)
-  (module-define! (current-module) p v))
-(define-method (prop-attrs (o <js-global-object>) (p <symbol>))
-  (cond ((module-local-variable (current-module) p)
-         '())
-        ((module-variable (current-module) p)
-         '(DontDelete ReadOnly))
-        (else (next-method))))
-(define-method (prop-attrs (o <js-global-object>) (p <string>))
-  (prop-attrs o (string->symbol p)))
-
 (define-class <js-module-object> (<js-object>)
-  (module #:init-form (js-module o) #:init-keyword #:module
+  (module #:init-form (current-module) #:init-keyword #:module
           #:getter js-module))
 (define-method (pget (o <js-module-object>) (p <string>))
   (pget o (string->symbol p)))
@@ -72,16 +52,24 @@
 (define-method (pput (o <js-module-object>) (p <symbol>) v)
   (module-define! (js-module o) p v))
 (define-method (prop-attrs (o <js-module-object>) (p <symbol>))
-  (cond ((module-variable (js-module o) p) '())
+  (cond ((module-local-variable (js-module o) p) '())
+        ((module-variable (js-module o) p) '(DontDelete ReadOnly))
         (else (next-method))))
 (define-method (prop-attrs (o <js-module-object>) (p <string>))
   (prop-attrs o (string->symbol p)))
+(define-method (prop-keys (o <js-module-object>))
+  (append (hash-map->list (lambda (k v) k) (module-obarray (js-module o)))
+          (next-method)))
 
 ;; we could make a renamer, but having obj['foo-bar'] should be enough
 (define (js-require modstr)
   (make <js-module-object> #:module
         (resolve-interface (map string->symbol (string-split modstr #\.)))))
       
+(define-class <js-global-object> (<js-module-object>))
+(define-method (js-module (o <js-global-object>))
+  (current-module))
+
 (define (init-js-bindings! mod)
   (module-define! mod 'NaN +nan.0)
   (module-define! mod 'Infinity +inf.0)
@@ -165,3 +153,18 @@
   (> (->number a) (->number b)))
 (define-method (> (a <string>) (b <string>))
   (string> a b))
+
+(define (obj-and-prototypes o)
+  (if o
+      (cons o (obj-and-prototypes (js-prototype o)))
+      '()))
+              
+(define (make-enumerator obj)
+  (let ((props (make-hash-table 23)))
+    (for-each (lambda (o)
+                (for-each (lambda (k) (hashq-set! props k #t))
+                          (prop-keys o)))
+              (obj-and-prototypes obj))
+    (apply new-array (filter (lambda (p)
+                               (not (prop-has-attr? obj p 'DontEnum)))
+                             (hash-map->list (lambda (k v) k) props)))))
diff --git a/module/language/ecmascript/parse.scm b/module/language/ecmascript/parse.scm
index e96278ca2..169c992fd 100644
--- a/module/language/ecmascript/parse.scm
+++ b/module/language/ecmascript/parse.scm
@@ -135,7 +135,7 @@
                        (for lparen var VariableDeclarationListNoIn semicolon Expression semicolon Expression rparen Statement) -> `(for (var ,@$4) ,$6 ,$8 ,$10)
 
                        (for lparen LeftHandSideExpression in Expression rparen Statement) -> `(for-in ,$3 ,$5 ,$7)
-                       (for lparen var VariableDeclarationNoIn in Expression rparen Statement) -> `(for-in ,$4 ,$6 ,$8))
+                       (for lparen var VariableDeclarationNoIn in Expression rparen Statement) -> `(begin (var ,$4) (for-in (ref ,@$4) ,$6 ,$8)))
 
    (ContinueStatement (continue Identifier semicolon) -> `(continue ,$2)
                       (continue semicolon) -> `(continue))