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