implement more operations

* module/language/ecmascript/base.scm: Implement some more robust
  property getters that convert strings to symbols. Implement
  has-property?.

* module/language/ecmascript/compile-ghil.scm (comp): Implement lots more
  mathematical operators. We now do all expressions; on to statements.

* module/language/ecmascript/impl.scm: Define some math helpers. They
  probably need to call ->number on some things.

* module/language/ecmascript/parse.scm (parse-ecmascript): Fix a typo.

module/language/ecmascript/base.scm

@@ -48,15 +48,17 @@
   (constructor #:getter js-constructor #:init-value #f #:init-keyword #:constructor)
   (class #:getter js-class #:init-value "Object" #:init-keyword #:class))
 
+(define-method (pget (o <js-object>) (p <string>))
+  (pget o (string->symbol p)))
+
 (define-method (pget (o <js-object>) p)
-  (let ((p (if (string? p) (string->symbol p) p)))
+  (let ((h (hashq-get-handle (js-props o) p)))
-    (let ((h (hashq-get-handle (js-props o) p)))
+    (if h
-      (if h
+        (cdr h)
-          (cdr h)
+        (let ((proto (js-prototype o)))
-          (let ((proto (js-prototype o)))
+          (if proto
-            (if proto
+              (pget proto p)
-                (pget proto p)
+              *undefined*)))))
-                *undefined*))))))
 
 (define-method (prop-attrs (o <js-object>) p)
   (or (let ((attrs (js-prop-attrs o)))
@@ -75,6 +77,9 @@
         (throw 'ReferenceError o p)
         (hashq-set! (js-props o) p v))))
 
+(define-method (pput (o <js-object>) (p <string>) v)
+  (pput o (string->symbol p) v))
+
 (define-method (pdel (o <js-object>) p)
   (let ((p (if (string? p) (string->symbol p) p)))
     (if (prop-has-attr? o p 'DontDelete)
@@ -83,6 +88,17 @@
           (pput o p *undefined*)
           #t))))
 
+(define-method (pdel (o <js-object>) (p <string>) v)
+  (pdel o (string->symbol p)))
+
+(define-method (has-property? (o <js-object>) p)
+  (if (hashq-get-handle (js-props o) v)
+      #t
+      (let ((proto (js-prototype o)))
+        (if proto
+            (has-property? proto p)
+            #f))))
+
 (define (call/this* this f)
   (with-fluid* *this* this f))
 

module/language/ecmascript/compile-ghil.scm

@@ -73,6 +73,14 @@
        (make-ghil-quote e l str))
       (this
        (@impl e l get-this '()))
+      ((+ ,a)
+       (make-ghil-inline e l 'add (list (comp a e) (make-ghil-quote e l 0))))
+      ((- ,a)
+       (make-ghil-inline e l 'sub (list (make-ghil-quote e l 0) (comp a e))))
+      ((~ ,a)
+       (@impl e l bitwise-not (list (comp a e))))
+      ((! ,a)
+       (@impl e l logical-not (list (comp a e))))
       ((+ ,a ,b)
        (make-ghil-inline e l 'add (list (comp a e) (comp b e))))
       ((- ,a ,b)
@@ -81,6 +89,48 @@
        (make-ghil-inline e l 'div (list (comp a e) (comp b e))))
       ((* ,a ,b)
        (make-ghil-inline e l 'mul (list (comp a e) (comp b e))))
+      ((% ,a ,b)
+       (@impl e l mod (list (comp a e) (comp b e))))
+      ((<< ,a ,b)
+       (@impl e l shift (list (comp a e) (comp b e))))
+      ((>> ,a ,b)
+       (@impl e l shift (list (comp a e) (comp `(- ,b) e))))
+      ((< ,a ,b)
+       (make-ghil-inline e l 'lt? (list (comp a e) (comp b e))))
+      ((<= ,a ,b)
+       (make-ghil-inline e l 'le? (list (comp a e) (comp b e))))
+      ((> ,a ,b)
+       (make-ghil-inline e l 'gt? (list (comp a e) (comp b e))))
+      ((>= ,a ,b)
+       (make-ghil-inline e l 'ge? (list (comp a e) (comp b e))))
+      ((in ,a ,b)
+       (@impl e l has-property? (list (comp a e) (comp b e))))
+      ((== ,a ,b)
+       (make-ghil-inline e l 'equal? (list (comp a e) (comp b e))))
+      ((!= ,a ,b)
+       (make-ghil-inline e l 'not
+                         (list
+                          (make-ghil-inline e l 'equal?
+                                            (list (comp a e) (comp b e))))))
+      ((=== ,a ,b)
+       (make-ghil-inline e l 'eqv? (list (comp a e) (comp b e))))
+      ((!== ,a ,b)
+       (make-ghil-inline e l 'not
+                         (list
+                          (make-ghil-inline e l 'eqv?
+                                            (list (comp a e) (comp b e))))))
+      ((& ,a ,b)
+       (@impl e l band (list (comp a e) (comp b e))))
+      ((^ ,a ,b)
+       (@impl e l bxor (list (comp a e) (comp b e))))
+      ((bor ,a ,b)
+       (@impl e l bior (list (comp a e) (comp b e))))
+      ((and ,a ,b)
+       (make-ghil-and e l (list (comp a e) (comp b e))))
+      ((or ,a ,b)
+       (make-ghil-or e l (list (comp a e) (comp b e))))
+      ((if ,test ,then ,else)
+       (make-ghil-if e l (comp test e) (comp then e) (comp else e)))
       ((postinc (ref ,foo))
        (begin1 (comp `(ref ,foo) e)
                (lambda (var)
@@ -273,11 +323,36 @@
       ((aref ,obj ,index)
        (@impl e l pget (list (comp obj e) (comp index e))))
       ((= (ref ,name) ,val)
-       (make-ghil-set e l (ghil-var-for-set! e name) (comp val e)))
+       (let ((v (ghil-var-for-set! e name)))
+         (make-ghil-begin e l
+                          (list (make-ghil-set e l v (comp val e))
+                                (make-ghil-ref e l v)))))
       ((= (pref ,obj ,prop) ,val)
        (@impl e l pput (list (comp obj e) (make-ghil-quote e l prop) (comp val e))))
       ((= (aref ,obj ,prop) ,val)
        (@impl e l pput (list (comp obj e) (comp prop e) (comp val e))))
+      ((+= ,what ,val)
+       (comp `(= ,what (+ ,what ,val)) e))
+      ((-= ,what ,val)
+       (comp `(= ,what (- ,what ,val)) e))
+      ((/= ,what ,val)
+       (comp `(= ,what (/ ,what ,val)) e))
+      ((*= ,what ,val)
+       (comp `(= ,what (* ,what ,val)) e))
+      ((%= ,what ,val)
+       (comp `(= ,what (% ,what ,val)) e))
+      ((>>= ,what ,val)
+       (comp `(= ,what (>> ,what ,val)) e))
+      ((<<= ,what ,val)
+       (comp `(= ,what (<< ,what ,val)) e))
+      ((>>>= ,what ,val)
+       (comp `(= ,what (>>> ,what ,val)) e))
+      ((&= ,what ,val)
+       (comp `(= ,what (& ,what ,val)) e))
+      ((bor= ,what ,val)
+       (comp `(= ,what (bor ,what ,val)) e))
+      ((^= ,what ,val)
+       (comp `(= ,what (^ ,what ,val)) e))
       ((new ,what ,args)
        (@impl e l new (map (lambda (x) (comp x e)) (cons what args))))
       ((delete (pref ,obj ,prop))

module/language/ecmascript/impl.scm

@@ -24,12 +24,18 @@
   #:use-module (language ecmascript base)
   #:use-module (language ecmascript function)
   #:use-module (language ecmascript array)
-  #:export (get-this typeof)
   #:re-export (*undefined* *this* call/this*
-               pget pput pdel
+               pget pput pdel has-property?
                new-object
                new
-               new-array))
+               new-array)
+  #:export (get-this
+            typeof
+            bitwise-not logical-not
+            shift
+            mod
+            band bxor bior))
+
 
 (define (get-this)
   (fluid-ref *this*))
@@ -43,3 +49,15 @@
         ((procedure? x) "function")
         ((is-a? x <js-object>) "object")
         (else "scm")))
+
+(define bitwise-not lognot)
+(define (logical-not x)
+  (not (->boolean (->primitive x))))
+
+(define shift ash)
+
+(define band logand)
+(define bxor logxor)
+(define bior logior)
+
+(define mod modulo)

module/language/ecmascript/parse.scm

@@ -317,7 +317,7 @@
    (AssignmentExpressionNoIn (ConditionalExpressionNoIn) -> $1
                              (LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn) -> `(,$2 ,$1 ,$3))
    (AssignmentOperator (=) -> '=
-                       (*=) -> '=
+                       (*=) -> '*=
                        (/=) -> '/=
                        (%=) -> '%=
                        (+=) -> '+=