From 2a0df14200d11b3a3d568ec614f8af8fa4e909d3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 14 Feb 2008 20:27:18 -0600 Subject: [PATCH] Control flow analysis work in progress --- core/inference/dataflow/dataflow-docs.factor | 3 +- core/inference/dataflow/dataflow.factor | 6 +- core/inference/known-words/known-words.factor | 2 +- core/optimizer/control/control-tests.factor | 88 ++++++++++++++++++- core/optimizer/control/control.factor | 22 +++-- core/optimizer/optimizer-tests.factor | 2 +- 6 files changed, 110 insertions(+), 13 deletions(-) diff --git a/core/inference/dataflow/dataflow-docs.factor b/core/inference/dataflow/dataflow-docs.factor index 0f809fa2bd..66b3590253 100755 --- a/core/inference/dataflow/dataflow-docs.factor +++ b/core/inference/dataflow/dataflow-docs.factor @@ -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 } } } diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor index 9bca648b08..23b5343c9c 100755 --- a/core/inference/dataflow/dataflow.factor +++ b/core/inference/dataflow/dataflow.factor @@ -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? ; diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index e6479d0c6a..9d0f959b68 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -345,7 +345,7 @@ M: object infer-call \ { object object } { word } set-primitive-effect \ make-flushable -\ word-xt { word } { integer } set-primitive-effect +\ word-xt { word } { integer integer } set-primitive-effect \ word-xt make-flushable \ getenv { fixnum } { object } set-primitive-effect diff --git a/core/optimizer/control/control-tests.factor b/core/optimizer/control/control-tests.factor index 2d52e6f45a..ab5c055fbd 100644 --- a/core/optimizer/control/control-tests.factor +++ b/core/optimizer/control/control-tests.factor @@ -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 diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor index eed69f243b..c9b3458d2a 100755 --- a/core/optimizer/control/control.factor +++ b/core/optimizer/control/control.factor @@ -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? [ diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor index c997a6eb51..7092797acc 100755 --- a/core/optimizer/optimizer-tests.factor +++ b/core/optimizer/optimizer-tests.factor @@ -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 } } ] [