Control flow analysis work in progress
parent
15ba74aaf8
commit
2a0df14200
|
@ -1,4 +1,5 @@
|
|||
USING: inference.dataflow help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ;
|
||||
IN: inference.dataflow
|
||||
|
||||
HELP: #return
|
||||
{ $values { "label" "a word or " { $link f } } { "node" "a new " { $link node } } }
|
||||
|
|
|
@ -317,4 +317,8 @@ UNION: #tail
|
|||
POSTPONE: f #return #tail-values #tail-merge #terminate ;
|
||||
|
||||
: tail-call? ( -- ? )
|
||||
node-stack get [ node-successor #tail? ] all? ;
|
||||
#! We don't consider calls which do non-local exits to be
|
||||
#! tail calls, because this gives better error traces.
|
||||
node-stack get [
|
||||
node-successor dup #tail? swap #terminate? not and
|
||||
] all? ;
|
||||
|
|
|
@ -345,7 +345,7 @@ M: object infer-call
|
|||
\ <word> { object object } { word } <effect> set-primitive-effect
|
||||
\ <word> make-flushable
|
||||
|
||||
\ word-xt { word } { integer } <effect> set-primitive-effect
|
||||
\ word-xt { word } { integer integer } <effect> set-primitive-effect
|
||||
\ word-xt make-flushable
|
||||
|
||||
\ getenv { fixnum } { object } <effect> set-primitive-effect
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
IN: temporary
|
||||
USING: tools.test optimizer.control combinators kernel
|
||||
sequences inference.dataflow math inference ;
|
||||
sequences inference.dataflow math inference classes strings
|
||||
optimizer ;
|
||||
|
||||
: label-is-loop? ( node word -- ? )
|
||||
[
|
||||
|
@ -60,3 +61,88 @@ sequences inference.dataflow math inference ;
|
|||
[ loop-test-3 ] dataflow dup detect-loops
|
||||
\ loop-test-3 label-is-not-loop?
|
||||
] unit-test
|
||||
|
||||
: loop-test-4 ( a -- )
|
||||
dup [
|
||||
loop-test-4
|
||||
] [
|
||||
drop
|
||||
] if ; inline
|
||||
|
||||
: find-label ( node -- label )
|
||||
dup #label? [ node-successor find-label ] unless ;
|
||||
|
||||
: test-loop-exits
|
||||
dataflow dup detect-loops find-label
|
||||
dup node-param swap
|
||||
[ node-child find-tail find-loop-exits [ class ] map ] keep
|
||||
#label-loop? ;
|
||||
|
||||
[ { #values } t ] [
|
||||
[ loop-test-4 ] test-loop-exits
|
||||
] unit-test
|
||||
|
||||
: loop-test-5 ( a -- )
|
||||
dup [
|
||||
dup string? [
|
||||
loop-test-5
|
||||
] [
|
||||
drop
|
||||
] if
|
||||
] [
|
||||
drop
|
||||
] if ; inline
|
||||
|
||||
[ { #values #values } t ] [
|
||||
[ loop-test-5 ] test-loop-exits
|
||||
] unit-test
|
||||
|
||||
: loop-test-6 ( a -- )
|
||||
dup [
|
||||
dup string? [
|
||||
loop-test-6
|
||||
] [
|
||||
3 throw
|
||||
] if
|
||||
] [
|
||||
drop
|
||||
] if ; inline
|
||||
|
||||
[ { #values } t ] [
|
||||
[ loop-test-6 ] test-loop-exits
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
[ [ [ ] map ] map ] dataflow optimize
|
||||
[ dup #label? swap #loop? not and ] node-exists?
|
||||
] unit-test
|
||||
|
||||
: blah f ;
|
||||
|
||||
DEFER: a
|
||||
|
||||
: b ( -- )
|
||||
blah [ b ] [ a ] if ; inline
|
||||
|
||||
: a ( -- )
|
||||
blah [ b ] [ a ] if ; inline
|
||||
|
||||
[ t ] [
|
||||
[ a ] dataflow dup detect-loops
|
||||
\ a label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ a ] dataflow dup detect-loops
|
||||
\ b label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ b ] dataflow dup detect-loops
|
||||
\ a label-is-loop?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ a ] dataflow dup detect-loops
|
||||
\ b label-is-loop?
|
||||
] unit-test
|
||||
|
|
|
@ -68,7 +68,7 @@ M: #label detect-loops* t swap set-#label-loop? ;
|
|||
node-stack get
|
||||
dup [ #label? ] find-last drop [ 1+ ] [ 0 ] if* tail
|
||||
[ node-successor #tail? ] all? ;
|
||||
|
||||
USE: io
|
||||
: detect-loop ( seen-other? label node -- seen-other? continue? )
|
||||
#! seen-other?: have we seen another label?
|
||||
{
|
||||
|
@ -234,9 +234,12 @@ M: #if optimize-node*
|
|||
! |
|
||||
! #return 1
|
||||
|
||||
: find-tail
|
||||
dup node-successor #tail?
|
||||
[ node-successor find-tail ] unless ;
|
||||
: find-tail ( node -- tail )
|
||||
dup #terminate? [
|
||||
dup node-successor #tail? [
|
||||
node-successor find-tail
|
||||
] unless
|
||||
] unless ;
|
||||
|
||||
: child-tails ( node -- seq )
|
||||
node-children [ find-tail ] map ;
|
||||
|
@ -246,15 +249,18 @@ GENERIC: add-loop-exit* ( label node -- )
|
|||
M: #branch add-loop-exit*
|
||||
child-tails [ add-loop-exit* ] with each ;
|
||||
|
||||
M: #call-label add-loop-exit* drop ;
|
||||
M: #call-label add-loop-exit*
|
||||
tuck node-param eq? [ drop ] [ node-successor , ] if ;
|
||||
|
||||
M: node add-loop-exit* node-successor add-loop-exit* , ;
|
||||
M: #terminate add-loop-exit*
|
||||
2drop ;
|
||||
|
||||
M: node add-loop-exit*
|
||||
nip node-successor dup #terminate? [ drop ] [ , ] if ;
|
||||
|
||||
: find-loop-exits ( label node -- seq )
|
||||
[ add-loop-exit* ] { } make ;
|
||||
|
||||
! ! ! !
|
||||
|
||||
: find-final-if ( node -- #if/f )
|
||||
dup [
|
||||
dup #if? [
|
||||
|
|
|
@ -2,7 +2,7 @@ USING: arrays compiler generic hashtables inference kernel
|
|||
kernel.private math optimizer prettyprint sequences sbufs
|
||||
strings tools.test vectors words sequences.private quotations
|
||||
optimizer.backend classes inference.dataflow tuples.private
|
||||
continuations growable optimizer.inlining ;
|
||||
continuations growable optimizer.inlining namespaces ;
|
||||
IN: temporary
|
||||
|
||||
[ H{ { 1 5 } { 3 4 } { 2 5 } } ] [
|
||||
|
|
Loading…
Reference in New Issue