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

db4
John Benediktsson 2014-04-24 09:16:14 -07:00
parent c9585b936b
commit 9d3a654443
5 changed files with 42 additions and 15 deletions

View 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 ]

View 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

View 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 )

View 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" } "." } ;

View 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