diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-27 19:38:32 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 22:02:43 +0200 |
commit | 5e0253f19ef146c46a08fead9d70866f4baa9ca1 (patch) | |
tree | 4bad5ced776026fba3438214b13f7f8c45f8cea8 | |
parent | 86d0eb31df4b1a28df74ff3d91de66223291e351 (diff) | |
download | guile-5e0253f19ef146c46a08fead9d70866f4baa9ca1.tar.gz |
replace <dynset> with primcalls to fluid-set!
* doc/ref/compiler.texi (Tree-IL): Remove mention of <dynset>.
* module/language/scheme/decompile-tree-il.scm (do-decompile):
(choose-output-names): Remove dynset.
* module/language/tree-il.scm (<tree-il>, parse-tree-il):
(unparse-tree-il, make-tree-il-folder, pre-post-order): Remove
<dynset>.
* module/language/tree-il/analyze.scm (analyze-lexicals):
* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add
fluid-set!.
(flatten-lambda-case): Remove <dynset> case.
* module/language/tree-il/cse.scm (cse):
* module/language/tree-il/debug.scm (verify-tree-il): Remove <dynset>
cases.
* module/language/tree-il/effects.scm (make-effects-analyzer): Remove
<dynset> case. Add a primcall fluid-set! case.
* module/language/tree-il/peval.scm (peval): Remove dynset cases.
* module/language/tree-il/primitives.scm (*primitive-expand-table*):
Remove fluid-set! -> dynset transformation.
-rw-r--r-- | doc/ref/compiler.texi | 5 | ||||
-rw-r--r-- | module/language/scheme/decompile-tree-il.scm | 6 | ||||
-rw-r--r-- | module/language/tree-il.scm | 14 | ||||
-rw-r--r-- | module/language/tree-il/analyze.scm | 6 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 10 | ||||
-rw-r--r-- | module/language/tree-il/cse.scm | 5 | ||||
-rw-r--r-- | module/language/tree-il/debug.scm | 3 | ||||
-rw-r--r-- | module/language/tree-il/effects.scm | 15 | ||||
-rw-r--r-- | module/language/tree-il/peval.scm | 3 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 6 |
10 files changed, 10 insertions, 63 deletions
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index 761ce17e9..408c10809 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -466,11 +466,6 @@ evaluate to fluids, and @var{vals} a corresponding list of expressions to bind to the fluids during the dynamic extent of the evaluation of @var{body}. @end deftp -@deftp {Scheme Variable} <dynset> fluid exp -@deftpx {External Representation} (dynset @var{fluid} @var{exp}) -A dynamic variable set. @var{fluid}, a Tree-IL expression evaluating -to a fluid, will be set to the result of evaluating @var{exp}. -@end deftp @deftp {Scheme Variable} <prompt> tag body handler @deftpx {External Representation} (prompt @var{tag} @var{body} @var{handler}) A dynamic prompt. Instates a prompt named @var{tag}, an expression, diff --git a/module/language/scheme/decompile-tree-il.scm b/module/language/scheme/decompile-tree-il.scm index 928ddb3d3..7dc55bfcb 100644 --- a/module/language/scheme/decompile-tree-il.scm +++ b/module/language/scheme/decompile-tree-il.scm @@ -438,9 +438,6 @@ (map recurse vals)) ,@(recurse-body body))) - ((<dynset> fluid exp) - `(fluid-set! ,(recurse fluid) ,(recurse exp))) - ((<prompt> tag body handler) `(call-with-prompt ,(recurse tag) @@ -759,9 +756,6 @@ (for-each recurse vals) (recurse body)) - ((<dynset> fluid exp) - (primitive 'fluid-set!) (recurse fluid) (recurse exp)) - ((<prompt> tag body handler) (primitive 'call-with-prompt) (primitive 'lambda) diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 989db28fa..1580142cd 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -47,7 +47,6 @@ <fix> fix? make-fix fix-src fix-names fix-gensyms fix-vals fix-body <let-values> let-values? make-let-values let-values-src let-values-exp let-values-body <dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body - <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 abort-tail @@ -134,7 +133,6 @@ (define-type (<tree-il> #:common-slots (src) #:printer print-tree-il) (<fix> names gensyms vals body) (<let-values> exp body) - (<dynset> fluid exp) (<prompt> tag body handler) (<abort> tag args tail)) @@ -248,9 +246,6 @@ (('dynlet fluids vals body) (make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body))) - (('dynset fluid exp) - (make-dynset loc (retrans fluid) (retrans exp))) - (('prompt tag body handler) (make-prompt loc (retrans tag) (retrans body) (retrans handler))) @@ -333,9 +328,6 @@ `(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals) ,(unparse-tree-il body))) - (($ <dynset> src fluid exp) - `(dynset ,(unparse-tree-il fluid) ,(unparse-tree-il exp))) - (($ <prompt> src tag body handler) `(prompt ,(unparse-tree-il tag) ,(unparse-tree-il body) @@ -410,9 +402,6 @@ (let*-values (((seed ...) (fold-values foldts fluids seed ...)) ((seed ...) (fold-values foldts vals seed ...))) (foldts body seed ...))) - (($ <dynset> src fluid exp) - (let*-values (((seed ...) (foldts fluid seed ...))) - (foldts exp seed ...))) (($ <prompt> src tag body handler) (let*-values (((seed ...) (foldts tag seed ...)) ((seed ...) (foldts body seed ...))) @@ -506,9 +495,6 @@ This is an implementation of `foldts' as described by Andy Wingo in (($ <dynlet> src fluids vals body) (make-dynlet src (map lp fluids) (map lp vals) (lp body))) - (($ <dynset> src fluid exp) - (make-dynset src (lp fluid) (lp exp))) - (($ <prompt> src tag body handler) (make-prompt src (lp tag) (lp body) (lp handler))) diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 224f0b751..673f68b2d 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -340,9 +340,6 @@ ((<dynlet> fluids vals body) (apply lset-union eq? (step body) (map step (append fluids vals)))) - ((<dynset> fluid exp) - (lset-union eq? (step fluid) (step exp))) - ((<prompt> tag body handler) (lset-union eq? (step tag) (step body) (step-tail handler))) @@ -508,9 +505,6 @@ ((<dynlet> fluids vals body) (apply max (recur body) (map recur (append fluids vals)))) - ((<dynset> fluid exp) - (max (recur fluid) (recur exp))) - ((<prompt> tag body handler) (let ((cont-var (and (lambda-case? handler) (pair? (lambda-case-gensyms handler)) diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index 67ea848ef..c2dba522f 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -115,6 +115,7 @@ (vector . vector) ((class-of . 1) . class-of) ((fluid-ref . 1) . fluid-ref) + ((fluid-set! . 2) . fluid-set) ((@slot-ref . 2) . slot-ref) ((@slot-set! . 3) . slot-set) ((string-length . 1) . string-length) @@ -990,15 +991,6 @@ (if RA (emit-branch #f 'br RA))))) - ((<dynset> src fluid exp) - (comp-push fluid) - (comp-push exp) - (emit-code #f (make-glil-call 'fluid-set 2)) - (case context - ((push vals tail) - (emit-code #f (make-glil-void)))) - (maybe-emit-return)) - ;; What's the deal here? The deal is that we are compiling the start of a ;; delimited continuation. We try to avoid heap allocation in the normal ;; case; so the body is an expression, not a thunk, and we try to render diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm index 5648e701c..ffddc1934 100644 --- a/module/language/tree-il/cse.scm +++ b/module/language/tree-il/cse.scm @@ -449,11 +449,6 @@ env ctx))) (return (make-dynlet src fluids vals body) (concat db*** (concat db** db*))))) - (($ <dynset> src fluid exp) - (let*-values (((fluid db*) (visit fluid db env 'value)) - ((exp db**) (visit exp db env 'value))) - (return (make-dynset src fluid exp) - (concat db** db*)))) (($ <toplevel-ref>) (return exp vlist-null)) (($ <module-ref>) diff --git a/module/language/tree-il/debug.scm b/module/language/tree-il/debug.scm index 99d70a787..d5dab80c5 100644 --- a/module/language/tree-il/debug.scm +++ b/module/language/tree-il/debug.scm @@ -216,9 +216,6 @@ (for-each (cut visit <> env) fluids) (for-each (cut visit <> env) vals) (visit body env)))) - (($ <dynset> src fluid exp) - (visit fluid env) - (visit exp env)) (($ <conditional> src condition subsequent alternate) (visit condition env) (visit subsequent env) diff --git a/module/language/tree-il/effects.scm b/module/language/tree-il/effects.scm index fe6d2c281..374ab2c8c 100644 --- a/module/language/tree-il/effects.scm +++ b/module/language/tree-il/effects.scm @@ -217,11 +217,6 @@ of an expression." (cause &type-check) (cause &fluid) (compute-effects body))) - (($ <dynset> _ fluid exp) - (logior (compute-effects fluid) - (compute-effects exp) - (cause &type-check) - (cause &fluid))) (($ <toplevel-ref>) (logior &toplevel (cause &type-check))) @@ -279,7 +274,15 @@ of an expression." (logior (compute-effects arg) &allocation)) (($ <primcall> _ 'fluid-ref (fluid)) - (logior (compute-effects fluid) &fluid)) + (logior (compute-effects fluid) + (cause &type-check) + &fluid)) + + (($ <primcall> _ 'fluid-set! (fluid exp)) + (logior (compute-effects fluid) + (compute-effects exp) + (cause &type-check) + (cause &fluid))) ;; Primitives that are normally effect-free, but which might ;; cause type checks, allocate memory, or access mutable diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 3fc487902..bfd338da9 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -519,7 +519,6 @@ top-level bindings from ENV and return the resulting expression." ($ <toplevel-set>) ; could return zero values in ($ <toplevel-define>) ; the future ($ <module-set>) ; - ($ <dynset>) ; ($ <primcall> src (? singly-valued-primitive?))) (and (<= nmin 1) (or (not nmax) (>= nmax 1)) (make-call src (make-lambda #f '() consumer) (list exp)))) @@ -998,8 +997,6 @@ top-level bindings from ENV and return the resulting expression." (($ <dynlet> src fluids vals body) (make-dynlet src (map for-value fluids) (map for-value vals) (for-tail body))) - (($ <dynset> src fluid exp) - (make-dynset src (for-value fluid) (for-value exp))) (($ <toplevel-ref> src (? effect-free-primitive? name)) exp) (($ <toplevel-ref>) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 5bd352914..cd950848b 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -535,12 +535,6 @@ (hashq-set! *primitive-expand-table* 'equal? maybe-simplify-to-eq) (hashq-set! *primitive-expand-table* - 'fluid-set! - (case-lambda - ((src fluid exp) (make-dynset src fluid exp)) - (else #f))) - -(hashq-set! *primitive-expand-table* 'call-with-prompt (case-lambda ((src tag thunk handler) |