Loop conversion work in progress

db4
Slava Pestov 2008-02-12 20:35:25 -06:00
parent 5f19ec207f
commit 0064e69f9d
6 changed files with 128 additions and 5 deletions

View File

@ -62,7 +62,7 @@ GENERIC: generate-node ( node -- next )
%prologue-later
current-label-start define-label
current-label-start resolve-label ;
: generate ( word label node -- )
[
init-generate-nodes
@ -107,6 +107,20 @@ M: #label generate-node
dup #label-word over node-param rot node-child generate
r> ;
! #loop
SYMBOL: compiling-loop?
M: #loop generate-node
end-basic-block
[
dup node-param compiling-label set
current-label-start define-label
current-label-start resolve-label
compiling-loop? on
node-child generate-nodes
] with-scope
end-basic-block ;
! #if
: end-false-branch ( label -- )
tail-call? [ %return drop ] [ %jump-label ] if ;
@ -256,4 +270,6 @@ M: #r> generate-node
iterate-next ;
! #return
M: #return generate-node drop end-basic-block %return f ;
M: #return generate-node
node-param compiling-label get eq? compiling-loop? get and
[ end-basic-block %return ] unless f ;

View File

@ -97,11 +97,13 @@ M: object flatten-curry , ;
: node-child node-children first ;
TUPLE: #label word ;
TUPLE: #label word loop? ;
: #label ( word label -- node )
\ #label param-node [ set-#label-word ] keep ;
PREDICATE: #label #loop #label-loop? ;
TUPLE: #entry ;
: #entry ( -- node ) \ #entry all-out-node ;

View File

@ -367,6 +367,10 @@ DEFER: (flat-length)
dup node-param dup +inlined+ depends-on
word-def splice-quot ;
: method-body-inline? ( #call -- ? )
node-param dup method-body?
[ flat-length 8 <= ] [ drop f ] if ;
M: #call optimize-node*
{
{ [ dup flush-eval? ] [ flush-eval ] }
@ -375,5 +379,6 @@ M: #call optimize-node*
{ [ dup optimizer-hook ] [ optimize-hook ] }
{ [ dup optimize-predicate? ] [ optimize-predicate ] }
{ [ dup optimistic-inline? ] [ optimistic-inline ] }
{ [ dup method-body-inline? ] [ optimistic-inline ] }
{ [ t ] [ inline-method ] }
} cond dup not ;

View File

@ -0,0 +1,62 @@
IN: temporary
USING: tools.test optimizer.control combinators kernel
sequences inference.dataflow math inference ;
: label-is-loop? ( node word -- ? )
[
{
{ [ over #label? not ] [ 2drop f ] }
{ [ over #label-word over eq? not ] [ 2drop f ] }
{ [ over #label-loop? not ] [ 2drop f ] }
{ [ t ] [ 2drop t ] }
} cond
] curry node-exists? ;
: label-is-not-loop? ( node word -- ? )
[
{
{ [ over #label? not ] [ 2drop f ] }
{ [ over #label-word over eq? not ] [ 2drop f ] }
{ [ over #label-loop? ] [ 2drop f ] }
{ [ t ] [ 2drop t ] }
} cond
] curry node-exists? ;
: loop-test-1 ( a -- )
dup [ 1+ loop-test-1 ] [ drop ] if ; inline
[ t ] [
[ loop-test-1 ] dataflow dup detect-loops
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
[ loop-test-1 1 2 3 ] dataflow dup detect-loops
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
[ [ loop-test-1 ] each ] dataflow dup detect-loops
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
[ [ loop-test-1 ] each ] dataflow dup detect-loops
\ (each-integer) label-is-loop?
] unit-test
: loop-test-2 ( a -- )
dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline
[ t ] [
[ loop-test-2 ] dataflow dup detect-loops
\ loop-test-2 label-is-not-loop?
] unit-test
: loop-test-3 ( a -- )
dup [ [ loop-test-3 ] each ] [ drop ] if ; inline
[ t ] [
[ loop-test-3 ] dataflow dup detect-loops
\ loop-test-3 label-is-not-loop?
] unit-test

View File

@ -0,0 +1,36 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel inference.dataflow combinators sequences
namespaces math ;
IN: optimizer.control
GENERIC: detect-loops* ( node -- )
M: node detect-loops* drop ;
M: #label detect-loops* t swap set-#label-loop? ;
: not-a-loop ( #label -- )
f swap set-#label-loop? ;
: tail-call? ( -- ? )
node-stack get
dup [ #label? ] find-last drop [ 1+ ] [ 0 ] if* tail
[ node-successor #tail? ] all? ;
: detect-loop ( seen-other? label node -- seen-other? continue? )
#! seen-other?: have we seen another label?
{
{ [ dup #label? not ] [ 2drop t ] }
{ [ 2dup node-param eq? not ] [ 3drop t t ] }
{ [ tail-call? not ] [ not-a-loop drop f ] }
{ [ pick ] [ not-a-loop drop f ] }
{ [ t ] [ 2drop f ] }
} cond ;
M: #call-label detect-loops*
f swap node-param node-stack get <reversed>
[ detect-loop ] with all? 2drop ;
: detect-loops ( node -- )
[ detect-loops* ] each-node ;

View File

@ -1,7 +1,8 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces optimizer.backend optimizer.def-use
optimizer.known-words optimizer.math inference.class ;
optimizer.known-words optimizer.math optimizer.control
inference.class ;
IN: optimizer
: optimize-1 ( node -- newnode ? )
@ -11,6 +12,7 @@ IN: optimizer
H{ } clone value-substitutions set
dup compute-def-use
kill-values
"detect-loops" get [ dup detect-loops ] when
dup infer-classes
optimizer-changed off
optimize-nodes