steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix optimizer bugs

cvs
Slava Pestov 2005-07-28 17:07:30 +00:00
parent 03168a86e5
commit ac6ad36ae4
1 changed files with 12 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
library/inference/optimizer.factor
View File

@ -4,12 +4,6 @@ IN: inference
USING: generic hashtables inference kernel lists matrices USING: generic hashtables inference kernel lists matrices
namespaces sequences vectors ; namespaces sequences vectors ;
! The optimizer transforms dataflow IR to dataflow IR. Currently
! it removes literals that are eventually dropped, and never
! arise as inputs to any other type of function. Such 'dead'
! literals arise when combinators are inlined and quotations are
! lifted to their call sites.
GENERIC: literals* ( node -- ) GENERIC: literals* ( node -- )
: literals, ( node -- ) : literals, ( node -- )
@ -24,11 +18,8 @@ GENERIC: can-kill* ( literal node -- ? )
#! Return false if the literal appears in any node in the #! Return false if the literal appears in any node in the
#! list. #! list.
dup [ dup [
2dup can-kill* [ 2dup can-kill*
node-successor can-kill? [ node-successor can-kill? ] [ 2drop f ] ifte
] [
2drop f
] ifte
] [ ] [
2drop t 2drop t
] ifte ; ] ifte ;
@ -37,12 +28,16 @@ GENERIC: can-kill* ( literal node -- ? )
#! Push a list of literals that may be killed in the IR. #! Push a list of literals that may be killed in the IR.
dup literals [ swap can-kill? ] subset-with ; dup literals [ swap can-kill? ] subset-with ;
: kill-in-d [ node-in-d seq-diffq ] keep set-node-in-d ; : remove-value ( value node -- )
2dup [ node-in-d seq-diffq ] keep set-node-in-d
: kill-out-d [ node-out-d seq-diffq ] keep set-node-out-d ; 2dup [ node-out-d seq-diffq ] keep set-node-out-d
2dup [ node-in-r seq-diffq ] keep set-node-in-r
[ node-out-r seq-diffq ] keep set-node-out-r ;
GENERIC: kill-node* ( literals node -- ) GENERIC: kill-node* ( literals node -- )
M: node kill-node* ( literals node -- ) 2drop ;
DEFER: kill-node DEFER: kill-node
: kill-children ( literals node -- ) : kill-children ( literals node -- )
@ -51,7 +46,9 @@ DEFER: kill-node
: kill-node ( literals node -- ) : kill-node ( literals node -- )
dup [ dup [
2dup kill-children 2dup kill-children
2dup kill-node* node-successor kill-node 2dup kill-node*
2dup remove-value
node-successor kill-node
] [ ] [
2drop 2drop
] ifte ; ] ifte ;
@ -122,9 +119,6 @@ M: #push optimize-node* ( node -- node/t )
M: #drop can-kill* ( literal node -- ? ) M: #drop can-kill* ( literal node -- ? )
2drop t ; 2drop t ;
M: #drop kill-node* ( literals node -- )
kill-in-d ;
M: #drop optimize-node* ( node -- node/t ) M: #drop optimize-node* ( node -- node/t )
[ node-in-d empty? ] prune-if ; [ node-in-d empty? ] prune-if ;
@ -267,9 +261,5 @@ M: #values can-kill* ( literal node -- ? )
M: #values optimize-node* ( node -- node ) M: #values optimize-node* ( node -- node )
dup node-successor #merge? [ post-split ] [ drop t ] ifte ; dup node-successor #merge? [ post-split ] [ drop t ] ifte ;
M: #values kill-node* ( literals node -- ) kill-in-d ;
! #merge ! #merge
M: #merge can-kill* ( literal node -- ? ) 2drop t ; M: #merge can-kill* ( literal node -- ? ) 2drop t ;
M: #merge kill-node* ( literals node -- ) kill-in-d ;