diff options
-rw-r--r-- | module/language/ecmascript/compile-ghil.scm | 241 |
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) |