Loop conversion work in progress
parent
5f19ec207f
commit
0064e69f9d
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue