factor/basis/compiler/cfg/rpo/rpo.factor

54 lines
1.5 KiB
Factor
Raw Normal View History

! Copyright (C) 2008, 2009 Slava Pestov.
2008-09-11 03:05:22 -04:00
! See http://factorcode.org/license.txt for BSD license.
2008-10-22 19:39:41 -04:00
USING: kernel accessors namespaces make math sequences sets
2009-06-01 04:00:10 -04:00
assocs fry compiler.cfg compiler.cfg.instructions ;
2010-02-26 16:01:01 -05:00
FROM: namespaces => set ;
2008-09-11 03:05:22 -04:00
IN: compiler.cfg.rpo
: post-order-traversal ( visited bb -- visited )
2013-03-23 20:46:45 -04:00
dup pick ?adjoin [
[
successors>> <reversed>
[ post-order-traversal ] each
] [ , ] bi
2013-03-23 20:46:45 -04:00
] [ drop ] if ; inline recursive
2008-09-11 03:05:22 -04:00
: number-blocks ( blocks -- )
dup length iota <reversed>
[ >>number drop ] 2each ;
: post-order ( cfg -- blocks )
dup post-order>> [ ] [
[
HS{ } clone over entry>>
post-order-traversal drop
] { } make dup number-blocks
>>post-order post-order>>
] ?if ;
2008-09-11 03:05:22 -04:00
: reverse-post-order ( cfg -- blocks )
post-order <reversed> ; inline
2008-10-22 19:39:41 -04:00
: each-basic-block ( cfg quot -- )
[ reverse-post-order ] dip each ; inline
: optimize-basic-block ( bb quot -- )
over kill-block?>> [ 2drop ] [
over basic-block set
change-instructions drop
] if ; inline
2010-04-30 18:55:20 -04:00
: simple-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... )
'[ _ optimize-basic-block ] each-basic-block ; inline
2010-05-14 18:18:29 -04:00
: analyze-basic-block ( bb quot -- )
over kill-block?>> [ 2drop ] [
[ dup basic-block set instructions>> ] dip call
] if ; inline
: simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )
'[ _ analyze-basic-block ] each-basic-block ; inline
: needs-post-order ( cfg -- cfg' )
dup post-order drop ;