diff options
author | Andy Wingo <wingo@pobox.com> | 2010-02-19 11:42:00 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-02-19 12:10:12 +0100 |
commit | 706a705eca032f84562ec84ac439b3d4a7ca8c66 (patch) | |
tree | 910f12a608d822bf351248855475dca0cbb10f9b /module/language/tree-il.scm | |
parent | 1e7a0337f1180343ca2f81557bfdeb78e23cd532 (diff) | |
download | guile-706a705eca032f84562ec84ac439b3d4a7ca8c66.tar.gz |
add <dynref> and <dynset> to tree-il
* module/language/tree-il.scm (<dynref>, <dynset>): New tree-il language
elements, corresponding to fluid-ref and fluid-set.
* module/language/tree-il/analyze.scm:
* module/language/tree-il/compile-glil.scm: Wire them up in the usual
manner.
Diffstat (limited to 'module/language/tree-il.scm')
-rw-r--r-- | module/language/tree-il.scm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 1ae39e874..cfd26bfc6 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -47,6 +47,8 @@ <let-values> let-values? make-let-values let-values-src let-values-exp let-values-body <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder <dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body + <dynref> dynref? make-dynref dynref-src dynref-fluid + <dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp <prompt> prompt? make-prompt prompt-src prompt-tag prompt-body prompt-handler <abort> abort? make-abort abort-src abort-tag abort-args @@ -81,6 +83,8 @@ (<let-values> exp body) (<dynwind> winder body unwinder) (<dynlet> fluids vals body) + (<dynref> fluid) + (<dynset> fluid exp) (<prompt> tag body handler) (<abort> tag args)) @@ -179,6 +183,12 @@ ((dynlet ,fluids ,vals ,body) (make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body))) + ((dynref ,fluid) + (make-dynref loc (retrans fluid))) + + ((dynset ,fluid ,exp) + (make-dynset loc (retrans fluid) (retrans exp))) + ((prompt ,tag ,body ,handler) (make-prompt loc (retrans tag) (retrans body) (retrans handler))) @@ -257,6 +267,12 @@ `(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals) ,(unparse-tree-il body))) + ((<dynref> fluid) + `(dynref ,(unparse-tree-il fluid))) + + ((<dynset> fluid exp) + `(dynref ,(unparse-tree-il fluid) ,(unparse-tree-il exp))) + ((<prompt> tag body handler) `(prompt ,tag ,(unparse-tree-il body) ,(unparse-tree-il handler))) @@ -346,6 +362,12 @@ (map tree-il->scheme vals)) ,(tree-il->scheme body))) + ((<dynref> fluid) + `(fluid-ref ,(tree-il->scheme fluid))) + + ((<dynset> fluid exp) + `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp))) + ((<prompt> tag body handler) `((@ (ice-9 control) prompt) ,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body)) @@ -414,6 +436,10 @@ This is an implementation of `foldts' as described by Andy Wingo in (up tree (loop body (loop vals (loop fluids (down tree result)))))) + ((<dynref> fluid) + (up tree (loop fluid (down tree result)))) + ((<dynset> fluid exp) + (up tree (loop exp (loop fluid (down tree result))))) ((<prompt> tag body handler) (up tree (loop tag (loop body (loop handler @@ -483,6 +509,11 @@ This is an implementation of `foldts' as described by Andy Wingo in (let*-values (((seed ...) (fold-values foldts fluids seed ...)) ((seed ...) (fold-values foldts vals seed ...))) (foldts body seed ...))) + ((<dynref> fluid) + (foldts fluid seed ...)) + ((<dynset> fluid exp) + (let*-values (((seed ...) (foldts fluid seed ...))) + (foldts exp seed ...))) ((<prompt> tag body handler) (let*-values (((seed ...) (foldts tag seed ...)) ((seed ...) (foldts body seed ...))) @@ -556,6 +587,13 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (dynlet-vals x) (map lp vals)) (set! (dynlet-body x) (lp body))) + ((<dynref> fluid) + (set! (dynref-fluid x) (lp fluid))) + + ((<dynset> fluid exp) + (set! (dynset-fluid x) (lp fluid)) + (set! (dynset-exp x) (lp exp))) + ((<prompt> tag body handler) (set! (prompt-tag x) (lp tag)) (set! (prompt-body x) (lp body)) @@ -631,6 +669,13 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (dynlet-vals x) (map lp vals)) (set! (dynlet-body x) (lp body))) + ((<dynref> fluid) + (set! (dynref-fluid x) (lp fluid))) + + ((<dynset> fluid exp) + (set! (dynset-fluid x) (lp fluid)) + (set! (dynset-exp x) (lp exp))) + ((<prompt> tag body handler) (set! (prompt-tag x) (lp tag)) (set! (prompt-body x) (lp body)) |