Working on stricter retain stack usage

db4
Slava Pestov 2008-08-18 20:08:45 -05:00
parent 1f89f9bd86
commit 705054b567
3 changed files with 16 additions and 10 deletions

View File

@ -61,10 +61,10 @@ SYMBOL: quotations
unify-branches
[ d-in set ] [ ] [ dup >vector meta-d set ] tri* ;
: retainstack-phi ( seq -- phi-in phi-out )
[ length 0 <repetition> ] [ meta-r active-variable ] bi
unify-branches
[ drop ] [ ] [ dup >vector meta-r set ] tri* ;
! : retainstack-phi ( seq -- phi-in phi-out )
! [ length 0 <repetition> ] [ meta-r active-variable ] bi
! unify-branches
! [ drop ] [ ] [ dup >vector meta-r set ] tri* ;
: terminated-phi ( seq -- terminated )
terminated? branch-variable ;
@ -73,18 +73,25 @@ SYMBOL: quotations
[ quotation active-variable sift quotations set ]
[
[ datastack-phi ]
[ retainstack-phi ]
! [ retainstack-phi ]
[ drop f f ]
[ terminated-phi ]
tri #phi,
]
[ [ terminated? swap at ] all? terminated? set ]
tri ;
: copy-inference ( -- )
meta-d [ clone ] change
V{ } clone meta-r set
d-in [ ] change ;
: infer-branch ( literal -- namespace )
[
copy-inference
nest-visitor
[ value>> quotation set ] [ infer-literal-quot ] bi
check->r
] H{ } make-assoc ; inline
: infer-branches ( branches -- input children data )

View File

@ -21,3 +21,7 @@ M: callable infer ( quot -- effect )
dup subwords [ f +cannot-infer+ set-word-prop ] each
f +cannot-infer+ set-word-prop
] each ;
: forget-effects ( -- )
forget-errors
all-words [ f +inferred-effect+ set-word-prop ] each ;

View File

@ -70,11 +70,6 @@ SYMBOL: meta-r
: init-known-values ( -- )
H{ } clone known-values set ;
: copy-inference ( -- )
meta-d [ clone ] change
meta-r [ clone ] change
d-in [ ] change ;
: recursive-label ( word -- label/f )
recursive-state get at ;