parent
7a615ae33b
commit
d979478bc4
|
@ -35,7 +35,7 @@ M: word (build-tree)
|
|||
[
|
||||
<recursive-state> recursive-state set
|
||||
V{ } clone stack-visitor set
|
||||
[ [ >vector \ meta-d set ] [ length input-count set ] bi ]
|
||||
[ [ >vector (meta-d) set ] [ length input-count set ] bi ]
|
||||
[ (build-tree) ]
|
||||
bi*
|
||||
] with-infer nip ;
|
||||
|
|
|
@ -3,9 +3,9 @@ stack-checker.state stack-checker.values sequences assocs ;
|
|||
IN: stack-checker.backend.tests
|
||||
|
||||
[ ] [
|
||||
V{ } clone \ meta-d set
|
||||
V{ } clone \ meta-r set
|
||||
V{ } clone \ literals set
|
||||
V{ } clone (meta-d) set
|
||||
V{ } clone (meta-r) set
|
||||
V{ } clone literals set
|
||||
H{ } clone known-values set
|
||||
0 input-count set
|
||||
0 inner-d-index set
|
||||
|
|
|
@ -99,10 +99,10 @@ M: object apply-object push-literal ;
|
|||
|
||||
: infer-quot-here ( quot -- )
|
||||
meta-r [
|
||||
V{ } clone \ meta-r set
|
||||
V{ } clone (meta-r) set
|
||||
[ apply-object terminated? get not ] all?
|
||||
[ commit-literals check->r ] [ literals get delete-all ] if
|
||||
] dip \ meta-r set ;
|
||||
] dip (meta-r) set ;
|
||||
|
||||
: infer-quot ( quot rstate -- )
|
||||
recursive-state get [
|
||||
|
|
|
@ -70,9 +70,9 @@ SYMBOLS: combinator quotations ;
|
|||
: datastack-phi ( seq -- phi-in phi-out )
|
||||
[ input-count branch-variable ]
|
||||
[ inner-d-index branch-variable infimum inner-d-index set ]
|
||||
[ \ meta-d active-variable ] tri
|
||||
[ (meta-d) active-variable ] tri
|
||||
unify-branches
|
||||
[ input-count set ] [ ] [ dup >vector \ meta-d set ] tri* ;
|
||||
[ input-count set ] [ ] [ dup >vector (meta-d) set ] tri* ;
|
||||
|
||||
: terminated-phi ( seq -- terminated )
|
||||
terminated? branch-variable ;
|
||||
|
@ -87,7 +87,7 @@ SYMBOLS: combinator quotations ;
|
|||
tri ;
|
||||
|
||||
: copy-inference ( -- )
|
||||
\ meta-d [ clone ] change
|
||||
(meta-d) [ clone ] change
|
||||
literals [ clone ] change
|
||||
input-count [ ] change
|
||||
inner-d-index [ ] change ;
|
||||
|
|
|
@ -58,7 +58,7 @@ SYMBOL: enter-out
|
|||
: emit-enter-recursive ( label -- )
|
||||
enter-out get >>enter-out
|
||||
enter-in get enter-out get #enter-recursive,
|
||||
enter-out get >vector \ meta-d set ;
|
||||
enter-out get >vector (meta-d) set ;
|
||||
|
||||
: entry-stack-height ( label -- stack )
|
||||
enter-out>> length ;
|
||||
|
@ -77,7 +77,7 @@ SYMBOL: enter-out
|
|||
|
||||
: end-recursive-word ( word label -- )
|
||||
[ check-return ]
|
||||
[ meta-d dup copy-values dup \ meta-d set #return-recursive, ]
|
||||
[ meta-d dup copy-values dup (meta-d) set #return-recursive, ]
|
||||
bi ;
|
||||
|
||||
: recursive-word-inputs ( label -- n )
|
||||
|
|
|
@ -15,11 +15,14 @@ SYMBOL: inner-d-index
|
|||
|
||||
DEFER: commit-literals
|
||||
|
||||
SYMBOL: (meta-d)
|
||||
SYMBOL: (meta-r)
|
||||
|
||||
! Compile-time data stack
|
||||
: meta-d ( -- stack ) commit-literals \ meta-d get ;
|
||||
: meta-d ( -- stack ) commit-literals (meta-d) get ;
|
||||
|
||||
! Compile-time retain stack
|
||||
: meta-r ( -- stack ) \ meta-r get ;
|
||||
: meta-r ( -- stack ) (meta-r) get ;
|
||||
|
||||
! Uncommitted literals. This is a form of local dead-code
|
||||
! elimination; the goal is to reduce the number of IR nodes
|
||||
|
@ -29,7 +32,7 @@ SYMBOL: literals
|
|||
|
||||
: (push-literal) ( obj -- )
|
||||
dup <literal> make-known
|
||||
[ nip \ meta-d get push ] [ #push, ] 2bi ;
|
||||
[ nip (meta-d) get push ] [ #push, ] 2bi ;
|
||||
|
||||
: commit-literals ( -- )
|
||||
literals get [
|
||||
|
@ -48,7 +51,7 @@ SYMBOL: literals
|
|||
|
||||
: init-inference ( -- )
|
||||
terminated? off
|
||||
V{ } clone \ meta-d set
|
||||
V{ } clone (meta-d) set
|
||||
V{ } clone literals set
|
||||
0 input-count set
|
||||
0 inner-d-index set ;
|
||||
|
|
Loading…
Reference in New Issue