Aggressive arithmetic inlining
parent
eb4ba47ef1
commit
fd3f37c8e3
|
@ -1,5 +1,5 @@
|
|||
! Copyright (C) 2005 Slava Pestov.
|
||||
! See http://factor.sf.net/license.txt for BSD license.
|
||||
! Copyright (C) 2005, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: optimizer
|
||||
USING: arrays errors generic hashtables inference kernel lists
|
||||
math math-internals sequences words ;
|
||||
|
@ -63,7 +63,7 @@ math math-internals sequences words ;
|
|||
} define-optimizers
|
||||
|
||||
: useless-coerce? ( node -- )
|
||||
dup node-in-d first over node-classes ?hash
|
||||
dup node-in-d first over node-class
|
||||
swap node-param "infer-effect" word-prop second first eq? ;
|
||||
|
||||
: call>no-op ( node -- node )
|
||||
|
@ -185,7 +185,6 @@ M: #call optimize-node* ( node -- node/t )
|
|||
{ [ dup partial-eval? ] [ partial-eval ] }
|
||||
{ [ dup find-identity nip ] [ apply-identities ] }
|
||||
{ [ dup optimizer-hooks ] [ optimize-hooks ] }
|
||||
{ [ dup inlining-class ] [ inline-method ] }
|
||||
{ [ dup optimize-predicate? ] [ optimize-predicate ] }
|
||||
{ [ t ] [ drop t ] }
|
||||
{ [ t ] [ inline-method ] }
|
||||
} cond ;
|
||||
|
|
|
@ -6,6 +6,9 @@ kernel-internals math namespaces sequences words ;
|
|||
|
||||
! Infer possible classes of values in a dataflow IR.
|
||||
|
||||
: node-class ( value node -- class )
|
||||
node-classes ?hash [ object ] unless* ;
|
||||
|
||||
! Variables used by the class inferencer
|
||||
|
||||
! Current value --> class mapping
|
||||
|
|
|
@ -5,55 +5,33 @@ USING: arrays generic hashtables inference kernel lists math
|
|||
namespaces sequences words ;
|
||||
|
||||
! Method inlining optimization
|
||||
: dispatch# ( #call -- n )
|
||||
node-param "combination" word-prop first ;
|
||||
|
||||
GENERIC: dispatching-values ( node word -- seq )
|
||||
|
||||
M: object dispatching-values 2drop { } ;
|
||||
|
||||
M: standard-generic dispatching-values
|
||||
"combination" word-prop first swap
|
||||
node-in-d reverse-slice nth 1array ;
|
||||
|
||||
M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
|
||||
|
||||
: node-classes* ( node seq -- seq )
|
||||
>r node-classes r>
|
||||
[ swap ?hash [ object ] unless* ] map-with ;
|
||||
|
||||
: dispatching-classes ( node -- seq )
|
||||
dup node-in-d empty? [
|
||||
drop { }
|
||||
] [
|
||||
dup dup node-param dispatching-values node-classes*
|
||||
] if ;
|
||||
: dispatching-class ( node -- seq )
|
||||
dup dispatch# over node-in-d reverse-slice nth
|
||||
swap node-class ;
|
||||
|
||||
: already-inlined? ( node -- ? )
|
||||
#! Was this node inlined from definition of 'word'?
|
||||
dup node-param swap node-history memq? ;
|
||||
|
||||
: specific-method ( word class -- ? ) swap order min-class ;
|
||||
|
||||
: inlining-class ( #call -- class )
|
||||
#! If the generic dispatch can be eliminated, return the
|
||||
#! class of the method that will always be invoked here.
|
||||
dup already-inlined? [
|
||||
drop f
|
||||
dup node-param swap dispatching-class
|
||||
specific-method ;
|
||||
|
||||
: will-inline-method ( node -- quot/t )
|
||||
#! t indicates failure
|
||||
dup inlining-class dup [
|
||||
swap node-param "methods" word-prop hash
|
||||
] [
|
||||
dup dispatching-classes dup empty? [
|
||||
2drop f
|
||||
] [
|
||||
dup all-eq? [
|
||||
first swap node-param order min-class
|
||||
] [
|
||||
2drop f
|
||||
] if
|
||||
] if
|
||||
2drop t
|
||||
] if ;
|
||||
|
||||
: will-inline ( node -- quot )
|
||||
dup inlining-class swap node-param "methods" word-prop hash ;
|
||||
|
||||
: method-dataflow ( node -- dataflow )
|
||||
dup will-inline swap node-in-d dataflow-with ;
|
||||
|
||||
: post-inline ( #return/#values #call/#merge -- )
|
||||
dup [
|
||||
[
|
||||
|
@ -70,10 +48,17 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
|
|||
#! last node of 'new' and the first node of 'old'.
|
||||
last-node 2dup swap post-inline set-node-successor ;
|
||||
|
||||
: inline-method ( node -- node )
|
||||
dup method-dataflow
|
||||
[ >r node-param r> remember-node ] 2keep
|
||||
[ subst-node ] keep ;
|
||||
: (inline-method) ( #call quot -- node )
|
||||
dup t eq? [
|
||||
2drop t
|
||||
] [
|
||||
over node-in-d dataflow-with
|
||||
[ >r node-param r> remember-node ] 2keep
|
||||
[ subst-node ] keep
|
||||
] if ;
|
||||
|
||||
: inline-standard-method ( node -- node )
|
||||
dup will-inline-method (inline-method) ;
|
||||
|
||||
: comparable? ( actual testing -- ? )
|
||||
#! If actual is a subset of testing or if the two classes
|
||||
|
@ -98,3 +83,40 @@ M: 2generic dispatching-values drop node-in-d 2 swap tail* ;
|
|||
dup node-param "predicating" word-prop >r
|
||||
dup dup node-in-d node-classes* first r> class<
|
||||
1array inline-literals ;
|
||||
|
||||
: math-both-known? ( word left right -- ? )
|
||||
math-class-max specific-method ;
|
||||
|
||||
: partial-math ( word class left/right -- vtable )
|
||||
dup \ dup \ over ? [
|
||||
( word class left/right class )
|
||||
>r 3dup r> swap [ swap ] unless math-method
|
||||
] math-vtable >r 3drop r> ;
|
||||
|
||||
: will-inline-math-method ( word left right -- quot/t )
|
||||
#! t indicates failure
|
||||
{
|
||||
{ [ 3dup math-both-known? ] [ math-method ] }
|
||||
{ [ 3dup drop specific-method ] [ drop t partial-math ] }
|
||||
{ [ 3dup nip specific-method ] [ nip f partial-math ] }
|
||||
{ [ t ] [ 3drop t ] }
|
||||
} cond ;
|
||||
|
||||
: inline-math-method ( #call -- node )
|
||||
dup node-param
|
||||
over dup node-in-d [ swap node-class ] map-with first2
|
||||
will-inline-math-method (inline-method) ;
|
||||
|
||||
: inline-standard-method? ( #call -- ? )
|
||||
dup already-inlined? not swap node-param standard-generic?
|
||||
and ;
|
||||
|
||||
: inline-math-method? ( #call -- ? )
|
||||
dup node-history empty? swap node-param 2generic? and ;
|
||||
|
||||
: inline-method ( #call -- node )
|
||||
{
|
||||
{ [ dup inline-standard-method? ] [ inline-standard-method ] }
|
||||
{ [ dup inline-math-method? ] [ inline-math-method ] }
|
||||
{ [ t ] [ drop t ] }
|
||||
} cond ;
|
||||
|
|
|
@ -7,7 +7,11 @@ math namespaces sequences words ;
|
|||
! Math combination for generic dyadic upgrading arithmetic.
|
||||
|
||||
: math-priority ( class -- n )
|
||||
"math-priority" word-prop [ 100 ] unless* ;
|
||||
dup "members" word-prop [
|
||||
0 [ math-priority max ] reduce
|
||||
] [
|
||||
"math-priority" word-prop [ 100 ] unless*
|
||||
] ?if ;
|
||||
|
||||
: math-class< ( class class -- ? )
|
||||
[ math-priority ] 2apply < ;
|
||||
|
@ -67,11 +71,5 @@ TUPLE: no-math-method left right generic ;
|
|||
] if nip
|
||||
] math-vtable nip ;
|
||||
|
||||
: partial-math-dispatch ( word class left/right -- vtable )
|
||||
dup \ dup \ over ? [
|
||||
( word class left/right class )
|
||||
>r 3dup r> swap [ swap ] unless math-method
|
||||
] math-vtable >r 3drop r> ;
|
||||
|
||||
PREDICATE: generic 2generic ( word -- ? )
|
||||
"combination" word-prop [ math-combination ] = ;
|
||||
|
|
|
@ -31,7 +31,7 @@ M: object summary
|
|||
|
||||
: slot-sheet ( obj -- sheet )
|
||||
dup class "slots" word-prop
|
||||
dup [ second ] map -rot
|
||||
dup [ third ] map -rot
|
||||
[ first slot ] map-with
|
||||
2array ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue