summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-06-27 19:38:32 +0200
committerAndy Wingo <wingo@pobox.com>2013-06-27 22:02:43 +0200
commit5e0253f19ef146c46a08fead9d70866f4baa9ca1 (patch)
tree4bad5ced776026fba3438214b13f7f8c45f8cea8
parent86d0eb31df4b1a28df74ff3d91de66223291e351 (diff)
downloadguile-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.texi5
-rw-r--r--module/language/scheme/decompile-tree-il.scm6
-rw-r--r--module/language/tree-il.scm14
-rw-r--r--module/language/tree-il/analyze.scm6
-rw-r--r--module/language/tree-il/compile-glil.scm10
-rw-r--r--module/language/tree-il/cse.scm5
-rw-r--r--module/language/tree-il/debug.scm3
-rw-r--r--module/language/tree-il/effects.scm15
-rw-r--r--module/language/tree-il/peval.scm3
-rw-r--r--module/language/tree-il/primitives.scm6
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)