namespaces: removing make-assoc in favor of explicit get's.

slavapestov · Apr 24, 2014 · 01a4dbb · 01a4dbb
1 parent e9b237f
commit 01a4dbb
Show file tree

Hide file tree

Showing 5 changed files with 42 additions and 15 deletions.
diff --git a/basis/compiler/tree/propagation/branches/branches.factor b/basis/compiler/tree/propagation/branches/branches.factor
@@ -57,14 +57,17 @@ SYMBOL: infer-children-data
     value-infos off
     constraints off ;
 
+DEFER: collect-variables
+
 : infer-children ( node -- )
     [ live-children ] [ child-constraints ] bi [
         [
             over
             [ 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
@@ -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,14 +92,29 @@ 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
     [
         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
@@ -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> ( -- 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
@@ -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
@@ -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 <hashtable> swap with-variables ; inline
 : with-variable ( value key quot -- ) [ associate ] dip with-variables ; inline
 : with-global ( quot -- ) [ global ] dip with-variables ; inline