diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor index aae41f9c2d..29fb38005e 100644 --- a/basis/compiler/tree/propagation/branches/branches.factor +++ b/basis/compiler/tree/propagation/branches/branches.factor @@ -57,6 +57,8 @@ SYMBOL: infer-children-data value-infos off constraints off ; +DEFER: collect-variables + : infer-children ( node -- ) [ live-children ] [ child-constraints ] bi [ [ @@ -64,7 +66,8 @@ SYMBOL: infer-children-data [ copy-value-info assume (propagate) ] [ 2drop no-value-info ] if - ] H{ } make-assoc + collect-variables + ] with-scope ] 2map infer-children-data set ; : compute-phi-input-infos ( phi-in -- phi-info ) @@ -86,6 +89,14 @@ SYMBOL: infer-children-data SYMBOL: condition-value +: collect-variables ( -- hash ) + { + condition-value + constraints + infer-children-data + value-infos + } [ dup get ] H{ } map>assoc ; + M: #phi propagate-before ( #phi -- ) [ annotate-phi-inputs ] [ [ phi-info-d>> flip ] [ out-d>> ] bi merge-value-infos ] diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 2c4e4d02ad..5eab8a11bc 100644 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -61,7 +61,7 @@ SYMBOLS: combinator quotations ; ] if-empty ; : branch-variable ( seq symbol -- seq ) - '[ [ _ ] dip at ] map ; + '[ _ of ] map ; : active-variable ( seq symbol -- seq ) [ [ terminated? over at [ drop f ] when ] map ] dip @@ -92,6 +92,20 @@ SYMBOLS: combinator quotations ; input-count [ ] change inner-d-index [ ] change ; +: collect-variables ( -- hash ) + { + (meta-d) + (meta-r) + current-word + inner-d-index + input-count + literals + quotation + recursive-state + stack-visitor + terminated? + } [ dup get ] H{ } map>assoc ; + GENERIC: infer-branch ( literal -- namespace ) M: literal-tuple infer-branch @@ -99,7 +113,8 @@ M: literal-tuple infer-branch copy-inference nest-visitor [ value>> quotation set ] [ infer-literal-quot ] bi - ] H{ } make-assoc ; + collect-variables + ] with-scope ; M: declared-effect infer-branch known>> infer-branch ; @@ -109,7 +124,8 @@ M: callable infer-branch copy-inference nest-visitor [ quotation set ] [ infer-quot-here ] bi - ] H{ } make-assoc ; + collect-variables + ] with-scope ; : infer-branches ( branches -- input children data ) [ pop-d ] dip diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index 91a48f17bd..14b017a207 100644 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -103,16 +103,22 @@ M: closer process SYMBOL: text-now? +: collect-variables ( -- hash ) + { + input-stream + extra-entities + spot + ns-stack + text-now? + } [ dup get ] H{ } map>assoc ; + PRIVATE> TUPLE: pull-xml scope ; : ( -- pull-xml ) [ - init-parser - input-stream [ ] change ! bring var in this scope - init-xml text-now? on - ] H{ } make-assoc - pull-xml boa ; + init-parser init-xml text-now? on collect-variables + ] with-scope pull-xml boa ; ! pull-xml needs to call start-document somewhere : pull-event ( pull -- xml-event/f ) diff --git a/core/namespaces/namespaces-docs.factor b/core/namespaces/namespaces-docs.factor index 343a2f1741..590387d954 100644 --- a/core/namespaces/namespaces-docs.factor +++ b/core/namespaces/namespaces-docs.factor @@ -5,7 +5,6 @@ IN: namespaces ARTICLE: "namespaces-combinators" "Namespace combinators" { $subsections - make-assoc with-scope with-variable with-variables @@ -146,10 +145,6 @@ HELP: with-variable { $code "3 x [ foo ] with-variable" } } ; -HELP: make-assoc -{ $values { "quot" quotation } { "exemplar" assoc } { "hash" "a new assoc" } } -{ $description "Calls the quotation in a new namespace of the same type as " { $snippet "exemplar" } ", and outputs this namespace when the quotation returns. Useful for quickly building assocs." } ; - HELP: with-variables { $values { "ns" assoc } { "quot" quotation } } { $description "Calls the quotation in the dynamic scope of " { $snippet "ns" } ". When variables are looked up by the quotation, " { $snippet "ns" } " is checked first, and setting variables in the quotation stores them in " { $snippet "ns" } "." } ; diff --git a/core/namespaces/namespaces.factor b/core/namespaces/namespaces.factor index 80be60c30b..6d20f1010f 100644 --- a/core/namespaces/namespaces.factor +++ b/core/namespaces/namespaces.factor @@ -61,7 +61,6 @@ PRIVATE> : dec ( variable -- ) -1 swap +@ ; inline : with-variables ( ns quot -- ) swap >n call ndrop ; inline : counter ( variable -- n ) [ 0 or 1 + dup ] change-global ; inline -: make-assoc ( quot exemplar -- hash ) 20 swap new-assoc [ swap with-variables ] keep ; inline : with-scope ( quot -- ) 5 swap with-variables ; inline : with-variable ( value key quot -- ) [ associate ] dip with-variables ; inline : with-global ( quot -- ) [ global ] dip with-variables ; inline