namespaces: removing make-assoc in favor of explicit get's.
parent
c9585b936b
commit
9d3a654443
|
@ -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 ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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" } "." } ;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue