Control flow analysis work in progress

db4
Slava Pestov 2008-02-14 20:27:18 -06:00
parent 15ba74aaf8
commit 2a0df14200
6 changed files with 110 additions and 13 deletions

View File

@ -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 } } }

View File

@ -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? ;

View File

@ -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

View File

@ -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

View File

@ -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? [

View File

@ -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 } } ] [