68 lines
1.7 KiB
Factor
68 lines
1.7 KiB
Factor
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
||
|
! See http://factor.sf.net/license.txt for BSD license.
|
||
|
IN: inference
|
||
|
USING: generic hashtables kernel sequences words ;
|
||
|
|
||
|
! Method inlining optimization
|
||
|
: min-class? ( class seq -- ? )
|
||
|
#! Is this class the smallest class in the sequence?
|
||
|
2dup member? [
|
||
|
[ dupd class-and ] map
|
||
|
[ null = not ] subset
|
||
|
[ class< ] all-with?
|
||
|
] [
|
||
|
2drop f
|
||
|
] ifte ;
|
||
|
|
||
|
: node-dispatching-class ( node -- class )
|
||
|
dup node-in-d peek dup value-safe? [
|
||
|
swap node-classes ?hash
|
||
|
] [
|
||
|
2drop object
|
||
|
] ifte ;
|
||
|
|
||
|
: inline-method? ( #call -- ? )
|
||
|
dup node-param "picker" word-prop [ dup ] = [
|
||
|
dup node-dispatching-class dup [
|
||
|
swap node-param order min-class?
|
||
|
] [
|
||
|
2drop f
|
||
|
] ifte
|
||
|
] [
|
||
|
drop f
|
||
|
] ifte ;
|
||
|
|
||
|
: subst-node ( old new -- )
|
||
|
last-node set-node-successor ;
|
||
|
|
||
|
: inline-method ( node -- node )
|
||
|
dup node-dispatching-class
|
||
|
over node-param "methods" word-prop hash
|
||
|
over node-in-d dataflow-with
|
||
|
[ subst-node ] keep ;
|
||
|
|
||
|
M: #call optimize-node* ( node -- node/t )
|
||
|
dup node-param [
|
||
|
dup inline-method? [
|
||
|
inline-method
|
||
|
] [
|
||
|
dup optimize-not? [
|
||
|
node-successor dup flip-branches
|
||
|
] [
|
||
|
drop t
|
||
|
] ifte
|
||
|
] ifte
|
||
|
] [
|
||
|
node-successor
|
||
|
] ifte ;
|
||
|
|
||
|
: post-inline ( #return #call -- node )
|
||
|
[ >r node-in-d r> node-out-d ] keep
|
||
|
node-successor [ subst-values ] keep ;
|
||
|
|
||
|
M: #return optimize-node* ( node -- node/t )
|
||
|
#! A #return followed by another node is a result of
|
||
|
#! method inlining. Do a value substitution and drop both
|
||
|
#! nodes.
|
||
|
dup node-successor dup [ post-inline ] [ 2drop t ] ifte ;
|