summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-20 17:08:20 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-21 00:33:04 +0100
commit45c10edb74fa3348238a81205408de5853521428 (patch)
tree0cdb66b81bf65d2dce92d360cd7b8cb7b2a832aa
parenta2879878187c348e07dfa8975a1b8f71afb50e57 (diff)
downloadguile-45c10edb74fa3348238a81205408de5853521428.tar.gz
clean up ++ and -- a little bit
* module/language/ecmascript/compile-ghil.scm (comp): Define let1 and begin1 helpers. Use them in pre- and post- increment and decrement.
-rw-r--r--module/language/ecmascript/compile-ghil.scm241
1 files changed, 125 insertions, 116 deletions
diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm
index cc2107693..18746995e 100644
--- a/module/language/ecmascript/compile-ghil.scm
+++ b/module/language/ecmascript/compile-ghil.scm
@@ -48,6 +48,17 @@
(define (comp x e)
(let ((l (location x)))
+ (define (let1 what proc)
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin e l (list (make-ghil-set e l (car vars) what)
+ (proc (car vars)))))))
+ (define (begin1 what proc)
+ (call-with-ghil-bindings e '(%tmp)
+ (lambda (vars)
+ (make-ghil-begin e l (list (make-ghil-set e l (car vars) what)
+ (proc (car vars))
+ (make-ghil-ref e l (car vars)))))))
(pmatch x
(null
;; FIXME, null doesn't have much relation to EOL...
@@ -71,137 +82,135 @@
((* ,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)))))))
+ (begin1 (comp `(ref ,foo) e)
+ (lambda (var)
+ (make-ghil-set e l (ghil-var-for-set! e foo)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-ref e l var)
+ (make-ghil-quote e l 1)))))))
((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)))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (begin1 (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)))
+ (lambda (tmpvar)
+ (@impl e l pput
+ (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-ref e l tmpvar)
+ (make-ghil-quote e l 1))))))))))
((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)))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (let1 (comp prop e)
+ (lambda (propvar)
+ (begin1 (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)))
+ (lambda (tmpvar)
+ (@impl e l pput
+ (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)
+ (make-ghil-inline
+ e l 'add (list (make-ghil-ref e l tmpvar)
+ (make-ghil-quote e l 1))))))))))))
((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)))))))
+ (begin1 (comp `(ref ,foo) e)
+ (lambda (var)
+ (make-ghil-set e l (ghil-var-for-set! e foo)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l var)
+ (make-ghil-quote e l 1)))))))
((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)))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (begin1 (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)))
+ (lambda (tmpvar)
+ (@impl e l pput
+ (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l tmpvar)
+ (make-ghil-quote e l 1))))))))))
((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)))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (let1 (comp prop e)
+ (lambda (propvar)
+ (begin1 (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)))
+ (lambda (tmpvar)
+ (@impl e l pput
+ (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)
+ (make-ghil-inline
+ e l 'sub (list (make-ghil-ref e l tmpvar)
+ (make-ghil-quote e l 1))))))))))))
((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)))))
+ e l (list
+ (make-ghil-set e l v (make-ghil-inline
+ e l 'add (list (make-ghil-ref e l v)
+ (make-ghil-quote e l 1))))
+ (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))))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (begin1 (make-ghil-inline
+ e l 'add (list (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)))
+ (make-ghil-quote e l 1)))
+ (lambda (tmpvar)
+ (@impl e l pput (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)
+ (make-ghil-ref e l tmpvar))))))))
((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))))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (let1 (comp prop e)
+ (lambda (propvar)
+ (begin1 (make-ghil-inline
+ e l 'add (list (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)))
+ (make-ghil-quote e l 1)))
+ (lambda (tmpvar)
+ (@impl e l pput (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)
+ (make-ghil-ref e l tmpvar))))))))))
((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)))))
+ 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))))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (begin1 (make-ghil-inline
+ e l 'sub (list (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)))
+ (make-ghil-quote e l 1)))
+ (lambda (tmpvar)
+ (@impl e l pput (list (make-ghil-ref e l objvar)
+ (make-ghil-quote e l prop)
+ (make-ghil-ref e l tmpvar))))))))
((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))))))))
+ (let1 (comp obj e)
+ (lambda (objvar)
+ (let1 (comp prop e)
+ (lambda (propvar)
+ (begin1 (make-ghil-inline
+ e l 'sub (list (@impl e l pget (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)))
+ (make-ghil-quote e l 1)))
+ (lambda (tmpvar)
+ (@impl e l pput (list (make-ghil-ref e l objvar)
+ (make-ghil-ref e l propvar)
+ (make-ghil-ref e l tmpvar))))))))))
((ref ,id)
(make-ghil-ref e l (ghil-var-for-ref! e id)))
((var . ,forms)