* doc/ref/compiler.texi (Tree-IL): Remove mention of <dynref>.
* module/language/scheme/decompile-tree-il.scm (do-decompile):
(choose-output-names): Remove dynref.
* module/language/tree-il.scm (<tree-il>, parse-tree-il):
(unparse-tree-il, make-tree-il-folder, pre-post-order): Remove
<dynref>.
* module/language/tree-il/analyze.scm (analyze-lexicals):
* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add
fluid-ref.
(flatten-lambda-case): Remove <dynref> case.
* module/language/tree-il/cse.scm (cse):
* module/language/tree-il/debug.scm (verify-tree-il): Remove <dynref>
cases.
* module/language/tree-il/effects.scm (make-effects-analyzer): Remove
<dynref> case. Add a primcall fluid-ref case.
* module/language/tree-il/peval.scm (peval): Remove dynref cases.
* module/language/tree-il/primitives.scm (*primitive-expand-table*):
Remove fluid-ref -> dynref transformation.
to bind to the fluids during the dynamic extent of the evaluation of
@var{body}.
@end deftp
-@deftp {Scheme Variable} <dynref> fluid
-@deftpx {External Representation} (dynref @var{fluid})
-A dynamic variable reference. @var{fluid} should be a Tree-IL
-expression evaluating to a fluid.
-@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
(map recurse vals))
,@(recurse-body body)))
- ((<dynref> fluid)
- `(fluid-ref ,(recurse fluid)))
-
((<dynset> fluid exp)
`(fluid-set! ,(recurse fluid) ,(recurse exp)))
(for-each recurse vals)
(recurse body))
- ((<dynref> fluid) (primitive 'fluid-ref) (recurse fluid))
((<dynset> fluid exp)
(primitive 'fluid-set!) (recurse fluid) (recurse exp))
<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
- <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 abort-tail
(define-type (<tree-il> #:common-slots (src) #:printer print-tree-il)
(<fix> names gensyms vals body)
(<let-values> exp body)
- (<dynref> fluid)
(<dynset> fluid exp)
(<prompt> tag body handler)
(<abort> tag args tail))
(('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)))
`(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals)
,(unparse-tree-il body)))
- (($ <dynref> src fluid)
- `(dynref ,(unparse-tree-il fluid)))
-
(($ <dynset> src fluid exp)
`(dynset ,(unparse-tree-il fluid) ,(unparse-tree-il exp)))
(let*-values (((seed ...) (fold-values foldts fluids seed ...))
((seed ...) (fold-values foldts vals seed ...)))
(foldts body seed ...)))
- (($ <dynref> src fluid)
- (foldts fluid seed ...))
(($ <dynset> src fluid exp)
(let*-values (((seed ...) (foldts fluid seed ...)))
(foldts exp seed ...)))
(($ <dynlet> src fluids vals body)
(make-dynlet src (map lp fluids) (map lp vals) (lp body)))
- (($ <dynref> src fluid)
- (make-dynref src (lp fluid)))
-
(($ <dynset> src fluid exp)
(make-dynset src (lp fluid) (lp exp)))
((<dynlet> fluids vals body)
(apply lset-union eq? (step body) (map step (append fluids vals))))
- ((<dynref> fluid)
- (step fluid))
-
((<dynset> fluid exp)
(lset-union eq? (step fluid) (step exp)))
((<dynlet> fluids vals body)
(apply max (recur body) (map recur (append fluids vals))))
- ((<dynref> fluid)
- (recur fluid))
-
((<dynset> fluid exp)
(max (recur fluid) (recur exp)))
(list . list)
(vector . vector)
((class-of . 1) . class-of)
+ ((fluid-ref . 1) . fluid-ref)
((@slot-ref . 2) . slot-ref)
((@slot-set! . 3) . slot-set)
((string-length . 1) . string-length)
(if RA
(emit-branch #f 'br RA)))))
- ((<dynref> src fluid)
- (case context
- ((drop)
- (comp-drop fluid))
- ((push vals tail)
- (comp-push fluid)
- (emit-code #f (make-glil-call 'fluid-ref 1))))
- (maybe-emit-return))
-
((<dynset> src fluid exp)
(comp-push fluid)
(comp-push exp)
env ctx)))
(return (make-dynlet src fluids vals body)
(concat db*** (concat db** db*)))))
- (($ <dynref> src fluid)
- (let*-values (((fluid db*) (visit fluid db env 'value)))
- (return (make-dynref src fluid)
- db*)))
(($ <dynset> src fluid exp)
(let*-values (((fluid db*) (visit fluid db env 'value))
((exp db**) (visit exp db env 'value)))
(for-each (cut visit <> env) fluids)
(for-each (cut visit <> env) vals)
(visit body env))))
- (($ <dynref> src fluid)
- (visit fluid env))
(($ <dynset> src fluid exp)
(visit fluid env)
(visit exp env))
(cause &type-check)
(cause &fluid)
(compute-effects body)))
- (($ <dynref> _ fluid)
- (logior (compute-effects fluid)
- (cause &type-check)
- &fluid))
(($ <dynset> _ fluid exp)
(logior (compute-effects fluid)
(compute-effects exp)
(($ <primcall> _ 'make-prompt-tag (arg))
(logior (compute-effects arg) &allocation))
+ (($ <primcall> _ 'fluid-ref (fluid))
+ (logior (compute-effects fluid) &fluid))
+
;; Primitives that are normally effect-free, but which might
;; cause type checks, allocate memory, or access mutable
;; memory. FIXME: expand, to be more precise.
($ <toplevel-ref>)
($ <module-ref>)
($ <primitive-ref>)
- ($ <dynref>)
($ <lexical-set>) ; FIXME: these set! expressions
($ <toplevel-set>) ; could return zero values in
($ <toplevel-define>) ; the future
(($ <dynlet> src fluids vals body)
(make-dynlet src (map for-value fluids) (map for-value vals)
(for-tail body)))
- (($ <dynref> src fluid)
- (make-dynref src (for-value fluid)))
(($ <dynset> src fluid exp)
(make-dynset src (for-value fluid) (for-value exp)))
(($ <toplevel-ref> src (? effect-free-primitive? name))
(hashq-set! *primitive-expand-table* 'eqv? maybe-simplify-to-eq)
(hashq-set! *primitive-expand-table* 'equal? maybe-simplify-to-eq)
-(hashq-set! *primitive-expand-table*
- 'fluid-ref
- (case-lambda
- ((src fluid) (make-dynref src fluid))
- (else #f)))
-
(hashq-set! *primitive-expand-table*
'fluid-set!
(case-lambda
HCoop / bpt / guile.git / commitdiff