diff options
Diffstat (limited to 'module/language/ecmascript')
-rw-r--r-- | module/language/ecmascript/base.scm | 32 | ||||
-rw-r--r-- | module/language/ecmascript/compile-ghil.scm | 77 | ||||
-rw-r--r-- | module/language/ecmascript/impl.scm | 24 | ||||
-rw-r--r-- | module/language/ecmascript/parse.scm | 2 |
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 (=) -> '= - (*=) -> '= + (*=) -> '*= (/=) -> '/= (%=) -> '%= (+=) -> '+= |