summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-20 16:15:50 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-21 00:33:04 +0100
commita2879878187c348e07dfa8975a1b8f71afb50e57 (patch)
tree1fc8e96540304c45d015cdd3b6d74e7fe56db9c6
parent785fb107ef1df793182f59f00251f9f7e3959792 (diff)
downloadguile-a2879878187c348e07dfa8975a1b8f71afb50e57.tar.gz
implement ++, --, new, delete, void, typeof
* module/language/ecmascript/compile-ghil.scm (@impl): Implement with @implv. (comp): Implement ++ and -- (pre- and post-). Quite a pain. I'll be looking for ways to simplify this notation. Also implement new, delete, and void. * module/language/ecmascript/impl.scm: Implement typeof.
-rw-r--r--module/language/ecmascript/compile-ghil.scm153
-rw-r--r--module/language/ecmascript/impl.scm12
2 files changed, 158 insertions, 7 deletions
diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm
index 2f385643f..cc2107693 100644
--- a/module/language/ecmascript/compile-ghil.scm
+++ b/module/language/ecmascript/compile-ghil.scm
@@ -38,15 +38,13 @@
(and (not (null? props))
props))))
-(define-macro (@impl e l sym args)
- `(make-ghil-call ,e ,l
- (make-ghil-ref
- ,e ,l
- (ghil-var-at-module! ,e '(language ecmascript impl) ',sym #t))
- ,args))
(define-macro (@implv e l sym)
`(make-ghil-ref ,e ,l
(ghil-var-at-module! ,e '(language ecmascript impl) ',sym #t)))
+(define-macro (@impl e l sym args)
+ `(make-ghil-call ,e ,l
+ (@implv ,e ,l ,sym)
+ ,args))
(define (comp x e)
(let ((l (location x)))
@@ -72,6 +70,138 @@
(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))))
+ ((postinc (ref ,foo))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(ref ,foo) e))
+ (make-ghil-set e l (ghil-var-for-set! e foo)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (make-ghil-ref e l (car vars)))))
+ (make-ghil-ref e l (car vars)))))))
+ ((postinc (pref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(pref ,obj ,prop) e))
+ (@impl e l pput (list (comp obj e)
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (make-ghil-ref e l (car vars))))))
+ (make-ghil-ref e l (car vars)))))))
+ ((postinc (aref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(aref ,obj ,prop) e))
+ (@impl e l pput (list (comp obj e)
+ (comp prop e)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (make-ghil-ref e l (car vars))))))
+ (make-ghil-ref e l (car vars)))))))
+ ((postdec (ref ,foo))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(ref ,foo) e))
+ (make-ghil-set e l (ghil-var-for-set! e foo)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l 1))))
+ (make-ghil-ref e l (car vars)))))))
+ ((postdec (pref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(pref ,obj ,prop) e))
+ (@impl e l pput (list (comp obj e)
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l 1)))))
+ (make-ghil-ref e l (car vars)))))))
+ ((postdec (aref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp `(aref ,obj ,prop) e))
+ (@impl e l pput (list (comp obj e)
+ (comp prop e)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l 1)))))
+ (make-ghil-ref e l (car vars)))))))
+ ((preinc (ref ,foo))
+ (let ((v (ghil-var-for-set! e foo)))
+ (make-ghil-begin
+ e l (list (make-ghil-set e l v
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (make-ghil-ref e l v))))
+ (make-ghil-ref e l v)))))
+ ((preinc (pref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp obj e))
+ (@impl e l pput (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop)))))))
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop))))))))
+ ((preinc (aref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp obj e))
+ (@impl e l pput (list (make-ghil-ref e l (car vars))
+ (comp prop e)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-quote e l 1)
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (comp prop e)))))))
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (comp prop e))))))))
+ ((predec (ref ,foo))
+ (let ((v (ghil-var-for-set! e foo)))
+ (make-ghil-begin
+ e l (list (make-ghil-set e l v
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l v)
+ (make-ghil-quote e l 1))))
+ (make-ghil-ref e l v)))))
+ ((predec (pref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp obj e))
+ (@impl e l pput (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'sub (list (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop)))
+ (make-ghil-quote e l 1)))))
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (make-ghil-quote e l prop))))))))
+ ((predec (aref ,obj ,prop))
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin
+ e l (list (make-ghil-set e l (car vars) (comp obj e))
+ (@impl e l pput (list (make-ghil-ref e l (car vars))
+ (comp prop e)
+ (make-ghil-inline
+ e l 'sub (list (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (comp prop e)))
+ (make-ghil-quote e l 1)))))
+ (@impl e l pget (list (make-ghil-ref e l (car vars))
+ (comp prop e))))))))
((ref ,id)
(make-ghil-ref e l (ghil-var-for-ref! e id)))
((var . ,forms)
@@ -98,6 +228,7 @@
(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 '()
@@ -138,6 +269,16 @@
(@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))))
+ ((new ,what ,args)
+ (@impl e l new (map (lambda (x) (comp x e)) (cons what args))))
+ ((delete (pref ,obj ,prop))
+ (@impl e l pdel (list (comp obj e) (make-ghil-quote e l prop))))
+ ((delete (aref ,obj ,prop))
+ (@impl e l pdel (list (comp obj e) (comp prop e))))
+ ((void ,expr)
+ (make-ghil-begin e l (list (comp expr e) (@implv e l *undefined*))))
+ ((typeof ,expr)
+ (@impl e l typeof (list (comp expr e))))
(else
(error "compilation not yet implemented:" x)))))
diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm
index 2ab83a158..fd6ed8865 100644
--- a/module/language/ecmascript/impl.scm
+++ b/module/language/ecmascript/impl.scm
@@ -24,7 +24,7 @@
#:use-module (language ecmascript base)
#:use-module (language ecmascript function)
#:use-module (language ecmascript array)
- #:export (get-this)
+ #:export (get-this typeof)
#:re-export (*undefined* *this* call/this*
pget pput pdel
new-object
@@ -33,3 +33,13 @@
(define (get-this)
(fluid-ref *this*))
+
+(define (typeof x)
+ (cond ((eq? x *undefined*) "undefined")
+ ((null? x) "object")
+ ((boolean? x) "boolean")
+ ((number? x) "number")
+ ((string? x) "string")
+ ((procedure? x) "function")
+ ((is-a? x <js-object>) "object")
+ (else "scm")))