summaryrefslogtreecommitdiff
path: root/module/language/ecmascript
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/ecmascript')
-rw-r--r--module/language/ecmascript/base.scm32
-rw-r--r--module/language/ecmascript/compile-ghil.scm77
-rw-r--r--module/language/ecmascript/impl.scm24
-rw-r--r--module/language/ecmascript/parse.scm2
4 files changed, 122 insertions, 13 deletions
diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm
index b7604a366..7e22bbec4 100644
--- a/module/language/ecmascript/base.scm
+++ b/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)))
- (if h
- (cdr h)
- (let ((proto (js-prototype o)))
- (if proto
- (pget proto p)
- *undefined*))))))
+ (let ((h (hashq-get-handle (js-props o) p)))
+ (if h
+ (cdr h)
+ (let ((proto (js-prototype o)))
+ (if proto
+ (pget proto p)
+ *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))
diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm
index 18746995e..5834771cd 100644
--- a/module/language/ecmascript/compile-ghil.scm
+++ b/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))
diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm
index fd6ed8865..9db92e3e4 100644
--- a/module/language/ecmascript/impl.scm
+++ b/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)
diff --git a/module/language/ecmascript/parse.scm b/module/language/ecmascript/parse.scm
index 2c5e10265..e088cbece 100644
--- a/module/language/ecmascript/parse.scm
+++ b/module/language/ecmascript/parse.scm
@@ -317,7 +317,7 @@
(AssignmentExpressionNoIn (ConditionalExpressionNoIn) -> $1
(LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn) -> `(,$2 ,$1 ,$3))
(AssignmentOperator (=) -> '=
- (*=) -> '=
+ (*=) -> '*=
(/=) -> '/=
(%=) -> '%=
(+=) -> '+=