]> gitweb.factorcode.org Git - factor.git/commitdiff
namespaces: removing make-assoc in favor of explicit get's.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 24 Apr 2014 16:16:14 +0000 (09:16 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 24 Apr 2014 16:16:14 +0000 (09:16 -0700)
basis/compiler/tree/propagation/branches/branches.factor
basis/stack-checker/branches/branches.factor
basis/xml/xml.factor
core/namespaces/namespaces-docs.factor
core/namespaces/namespaces.factor

index aae41f9c2d908872f12b2bcaa6c0a9ce0c230bb4..29fb38005e00cfd6fbe6f1ac9f03d4d2b4e7a9b6 100644 (file)
@@ -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 ]
index 2c4e4d02ad2acd3fa19dbe9c11c88402fd8207d5..5eab8a11bc5a4cc7bfb8375e367358f2b5c977ea 100644 (file)
@@ -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
index 91a48f17bd4d3d64687c6f3d5525537171145237..14b017a207270d1099ec598e2f425a225de9cf61 100644 (file)
@@ -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 )
index 343a2f1741c53a03635309999794de01672eb2e0..590387d954765fdf6b48c30ddefd7ad48606519c 100644 (file)
@@ -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" } "." } ;
index 80be60c30b0d8e00b3537fe73e385f982f641d5a..6d20f1010f583b2d8d50eb37175ac0bf0be0d789 100644 (file)
@@ -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