mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 14:21:10 +02:00
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.
This commit is contained in:
Andy Wingo
parent
45c10edb74
commit
b358fe6502
4 changed files with 122 additions and 13 deletions
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -317,7 +317,7 @@
|
|||
(AssignmentExpressionNoIn (ConditionalExpressionNoIn) -> $1
|
||||
(LeftHandSideExpression AssignmentOperator AssignmentExpressionNoIn) -> `(,$2 ,$1 ,$3))
|
||||
(AssignmentOperator (=) -> '=
|
||||
(*=) -> '=
|
||||
(*=) -> '*=
|
||||
(/=) -> '/=
|
||||
(%=) -> '%=
|
||||
(+=) -> '+=
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue