diff options
author | Ian Price <ianprice90@googlemail.com> | 2015-06-21 01:56:01 +0100 |
---|---|---|
committer | Ian Price <ianprice90@googlemail.com> | 2015-06-22 16:18:18 +0100 |
commit | a680a4cb9d14c705a9248b1281614d1caded5881 (patch) | |
tree | 9882a39dcae00dc0c5a2ce1f58d6a9f27e47613c | |
parent | e9f37e6a311c0b9fa1ef78b24cbe901e160db2b5 (diff) | |
download | guile-a680a4cb9d14c705a9248b1281614d1caded5881.tar.gz |
Change local type representation and remove var type
-rw-r--r-- | module/language/cps/compile-js.scm | 38 | ||||
-rw-r--r-- | module/language/js-il.scm | 11 | ||||
-rw-r--r-- | module/language/js-il/compile-javascript.scm | 12 | ||||
-rw-r--r-- | module/language/js-il/inlining.scm | 20 |
4 files changed, 39 insertions, 42 deletions
diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm index e67652eed..34b1ffe56 100644 --- a/module/language/cps/compile-js.scm +++ b/module/language/cps/compile-js.scm @@ -74,36 +74,32 @@ (make-continuation (cons (make-id self) ids) (match body - (($ $cont k _) - (make-local (list (compile-cont body)) + (($ $cont k cont) + (make-local `((,(make-kid k) . ,(compile-cont cont))) (make-continue (make-kid k) ids))))))))) (define (compile-term term) (match term - (($ $letk conts body) - (make-local (map compile-cont conts) (compile-term body))) + (($ $letk (($ $cont ks conts) ...) body) + (make-local (map (lambda (k cont) + (cons (make-kid k) + (compile-cont cont))) + ks + conts) + (compile-term body))) (($ $continue k src exp) (compile-exp exp k)))) (define (compile-cont cont) (match cont - (($ $cont k ($ $kargs names syms body)) - ;; use the name part? - (make-var (make-kid k) - (make-continuation (map make-id syms) - (compile-term body)))) - (($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)) - (make-var - (make-kid k) - (make-continuation (append (map make-id req) (list (make-id rest))) - (make-continue (make-kid k2) - (append (map make-id req) - (list (make-id rest))))))) - (($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2)) - (make-var (make-kid k) - (make-continuation (map make-id req) - (make-continue (make-kid k2) - (map make-id req))))))) + (($ $kargs names syms body) + (make-continuation (map make-id syms) (compile-term body))) + (($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2) + (let ((ids (map make-id (append req (list rest))))) + (make-continuation ids (make-continue (make-kid k2) ids)))) + (($ $kreceive ($ $arity req _ #f _ _) k2) + (let ((ids (map make-id req))) + (make-continuation ids (make-continue (make-kid k2) ids)))))) (define (compile-exp exp k) (match exp diff --git a/module/language/js-il.scm b/module/language/js-il.scm index d83faf5cc..e5fe19683 100644 --- a/module/language/js-il.scm +++ b/module/language/js-il.scm @@ -7,7 +7,6 @@ make-params params make-continuation continuation make-local local - make-var var make-continue continue make-const const make-primcall primcall @@ -55,7 +54,6 @@ (define-js-type params self req opt rest kw allow-other-keys?) (define-js-type continuation params body) (define-js-type local bindings body) ; local scope -(define-js-type var id exp) (define-js-type continue cont args) (define-js-type const value) (define-js-type primcall name args) @@ -96,9 +94,12 @@ kws) ,allow-other-keys?)) (($ local bindings body) - `(local ,(map unparse-js bindings) ,(unparse-js body))) - (($ var id exp) - `(var ,id ,(unparse-js exp))) + `(local ,(map (match-lambda + ((a . d) + (cons (unparse-js a) + (unparse-js d)))) + bindings) + ,(unparse-js body))) (($ continue ($ kid k) args) `(continue ,k ,(map unparse-js args))) (($ branch test then else) diff --git a/module/language/js-il/compile-javascript.scm b/module/language/js-il/compile-javascript.scm index 3aa2e5b74..3ef9a950e 100644 --- a/module/language/js-il/compile-javascript.scm +++ b/module/language/js-il/compile-javascript.scm @@ -149,11 +149,13 @@ clauses) (list (compile-jump-table clauses))))) - (($ il:local bindings body) - (make-block (append (map compile-exp bindings) (list (compile-exp body))))) - - (($ il:var id exp) - (make-var (rename-id id) (compile-exp exp))) + (($ il:local ((ids . bindings) ...) body) + (make-block + (append (map (lambda (id binding) + (make-var (rename-id id) (compile-exp binding))) + ids + bindings) + (list (compile-exp body))))) (($ il:continue k exps) (make-return (make-call (compile-id k) (map compile-exp exps)))) diff --git a/module/language/js-il/inlining.scm b/module/language/js-il/inlining.scm index c2a33db9f..72df2226b 100644 --- a/module/language/js-il/inlining.scm +++ b/module/language/js-il/inlining.scm @@ -31,12 +31,11 @@ (analyse body)) (($ local bindings body) - (for-each analyse bindings) + (for-each (match-lambda + ((i . b) (analyse b))) + bindings) (analyse body)) - (($ var id exp) - (analyse exp)) - (($ continue ($ kid cont) args) (count-inc! cont) (for-each analyse args)) @@ -103,12 +102,12 @@ (define (split-inlinable bindings) (partition (match-lambda - (($ var ($ kid id) _) (inlinable? id))) + ((($ kid id) . _) (inlinable? id))) bindings)) (define (lookup kont substs) (match substs - ((($ var ($ kid id) exp) . rest) + (((($ kid id) . exp) . rest) (if (= id kont) exp (lookup kont rest))) @@ -140,7 +139,7 @@ (($ continuation kargs body) (if (not (= (length args) (length kargs))) (throw 'args-dont-match cont args kargs) - (make-local (map make-var kargs args) + (make-local (map cons kargs args) ;; gah, this doesn't work ;; identifiers need to be separated earlier ;; not just as part of compilation @@ -162,13 +161,12 @@ (split-inlinable bindings)) (lambda (new-substs uninlinable-bindings) (define substs* (append new-substs substs)) - (make-local (map (lambda (x) (inline x substs*)) + (make-local (map (match-lambda + ((id . val) + `(,id . ,(inline val substs*)))) uninlinable-bindings) (inline body substs*))))) - (($ var id exp) - (make-var id (inline exp substs))) - (($ seq body) (make-seq (map (lambda (x) (inline x substs)) body))) |