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

Working on method inlining optimization

slava 2006-05-02 18:16:59 +00:00
parent 5d7d205081
commit 1a86171a99
13 changed files with 120 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO.FACTOR.txt
View File

@ -1,6 +1,5 @@
should fix in 0.82:
- type inference busted for tuple constructors
- constant branch folding
- fast-slot stuff
- 3 >n fep

5
library/bootstrap/primitives.factor
View File

@ -258,12 +258,10 @@ num-types f <array> builtins set
"fixnum?" "math" create t "inline" set-word-prop
"fixnum" "math" create 0 "fixnum?" "math" create { } define-builtin
"fixnum" "math" create 0 "math-priority" set-word-prop
"fixnum" "math" create ">fixnum" "math" lookup unit "coercer" set-word-prop
"bignum?" "math" create t "inline" set-word-prop
"bignum" "math" create 1 "bignum?" "math" create { } define-builtin
"bignum" "math" create 1 "math-priority" set-word-prop
"bignum" "math" create ">bignum" "math" lookup unit "coercer" set-word-prop
"cons?" "lists" create t "inline" set-word-prop
@ -279,11 +277,9 @@ num-types f <array> builtins set
{ 0 integer { "numerator" "math" } f }
{ 1 integer { "denominator" "math" } f }
} define-builtin
"ratio" "math" create 2 "math-priority" set-word-prop
"float?" "math" create t "inline" set-word-prop
"float" "math" create 5 "float?" "math" create { } define-builtin
"float" "math" create 3 "math-priority" set-word-prop
"float" "math" create ">float" "math" lookup unit "coercer" set-word-prop
"complex?" "math" create t "inline" set-word-prop
@ -292,7 +288,6 @@ num-types f <array> builtins set
{ 0 real { "real" "math" } f }
{ 1 real { "imaginary" "math" } f }
} define-builtin
"complex" "math" create 4 "math-priority" set-word-prop
"alien" "alien" create 7 "alien?" "alien" create
{ { 1 object { "underlying-alien" "alien" } f } } define-builtin

3
library/cocoa/utilities.factor
View File

@ -119,9 +119,6 @@ H{
: class-methods ( classname -- seq )
objc-meta-class objc-methods ;
: make-dip ( quot n -- quot )
dup \ >r <array> -rot \ r> <array> append3 ;
: <super> ( receiver class -- super )
"objc-super" <c-object>
[ set-objc-super-class ] keep

5
library/collections/lists.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: lists USING: errors generic kernel math sequences ;
IN: lists USING: arrays errors generic kernel math sequences ;
M: f car ;
M: f cdr ;
@ -79,6 +79,9 @@ M: cons = ( obj cons -- ? )
: curry ( obj quot -- quot ) >r literalize r> cons ;
: make-dip ( quot n -- quot )
dup \ >r <array> -rot \ r> <array> append3 >list ;
: (>list) ( n i seq -- list )
pick pick <= [
3drop [ ]

2
library/collections/sequences.factor
View File

@ -26,7 +26,7 @@ GENERIC: reverse-slice ( seq -- seq ) flushable
[ 1 <vector> ] unless* [ push ] keep ;
: bounds-check? ( n seq -- ? )
over 0 >= [ length < ] [ 2drop f ] if ;
over 0 >= [ length < ] [ 2drop f ] if ; inline
: ?nth ( n seq/f -- elt/f )
2dup bounds-check? [ nth ] [ 2drop f ] if ;

2
library/compiler/optimizer/call-optimizers.factor
View File

@ -63,7 +63,7 @@ math math-internals sequences words ;
} define-optimizers
: useless-coerce? ( node -- )
dup node-in-d first over node-class
dup 0 node-class#
swap node-param "infer-effect" word-prop second first eq? ;
: call>no-op ( node -- node )

3
library/compiler/optimizer/class-infer.factor
View File

@ -9,6 +9,9 @@ kernel-internals math namespaces sequences words ;
: node-class ( value node -- class )
node-classes ?hash [ object ] unless* ;
: node-class# ( node n -- class )
swap [ node-in-d reverse-slice nth ] keep node-class ;
! Variables used by the class inferencer
! Current value --> class mapping

147
library/compiler/optimizer/inline-methods.factor
View File

@ -1,37 +1,10 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: optimizer
USING: arrays generic hashtables inference kernel lists math
namespaces sequences words ;
! Method inlining optimization
: dispatch# ( #call -- n )
node-param "combination" word-prop first ;
: 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 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
] [
2drop t
] if ;
USING: arrays generic hashtables inference kernel
kernel-internals lists math namespaces sequences words ;
! Some utilities for splicing in dataflow IR subtrees
: post-inline ( #return/#values #call/#merge -- )
dup [
[
@ -54,12 +27,82 @@ namespaces sequences words ;
] [
over node-in-d dataflow-with
[ >r node-param r> remember-node ] 2keep
[ subst-node ] keep
[ subst-node ] keep [ infer-classes ] keep
] if ;
! Single dispatch method inlining optimization
: dispatch# ( #call -- n )
node-param "combination" word-prop first ;
: dispatching-class ( node -- seq ) dup dispatch# 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 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
] [
2drop t
] if ;
: inline-standard-method ( node -- node )
dup will-inline-method (inline-method) ;
: inline-standard-method? ( #call -- ? )
dup already-inlined? not swap node-param standard-generic?
and ;
! Partial dispatch of 2generic words
: math-both-known? ( word left right -- ? )
math-class-max specific-method ;
: max-tag ( class -- n ) types peek 1+ num-tags min ;
: left-partial-math ( word left right -- quot/t )
#! The left type is known; dispatch on right
\ dup swap max-tag
[ >r 2dup r> math-method ] math-vtable* 2nip ;
: right-partial-math ( word left right -- quot/t )
#! The right type is known; dispatch on left
\ over rot max-tag
[ >r 2dup r> swap math-method ] math-vtable* 2nip ;
: will-inline-math-method ( word left right -- quot/t )
#! t indicates failure
{
{ [ 3dup math-both-known? ] [ math-method ] }
{ [ 3dup drop specific-method ] [ left-partial-math ] }
{ [ 3dup nip specific-method ] [ right-partial-math ] }
{ [ t ] [ 3drop t ] }
} cond ;
: inline-math-method ( #call -- node )
dup node-param over 1 node-class# pick 0 node-class#
will-inline-math-method (inline-method) ;
: 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 ;
! Resolve type checks at compile time where possible
: comparable? ( actual testing -- ? )
#! If actual is a subset of testing or if the two classes
#! are disjoint, return t.
@ -67,7 +110,7 @@ namespaces sequences words ;
: optimize-predicate? ( #call -- ? )
dup node-param "predicating" word-prop dup [
>r dup node-in-d node-classes* first r> comparable?
>r dup 0 node-class# r> comparable?
] [
2drop f
] if ;
@ -81,42 +124,4 @@ namespaces sequences words ;
: optimize-predicate ( #call -- node )
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 ;
dup 0 node-class# r> class< 1array inline-literals ;

4
library/compiler/ppc/intrinsics.factor
View File

@ -67,7 +67,7 @@ math-internals namespaces sequences words ;
] H{
{ +input { { f "val" } { f "obj" } { f "slot" } } }
{ +scratch { { f "x" } } }
{ +clobber { "obj" } }
{ +clobber { "obj" "slot" } }
} define-intrinsic
\ set-char-slot [
@ -77,7 +77,7 @@ math-internals namespaces sequences words ;
] H{
{ +input { { f "val" } { f "slot" } { f "obj" } } }
{ +scratch { { f "x" } } }
{ +clobber { "obj" } }
{ +clobber { "val" "slot" "obj" } }
} define-intrinsic
: define-binary-op ( word op -- )

2
library/generic/generic.factor
View File

@ -39,7 +39,7 @@ SYMBOL: builtins
] hash-each ;
: types ( class -- types )
[ (types) ] make-hash hash-keys ;
[ (types) ] make-hash hash-keys natural-sort ;
DEFER: class<

45
library/generic/math-combination.factor
View File

@ -1,35 +1,29 @@
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: generic
USING: errors generic hashtables kernel kernel-internals lists
math namespaces sequences words ;
USING: arrays errors generic hashtables kernel kernel-internals
lists math namespaces sequences words ;
! Math combination for generic dyadic upgrading arithmetic.
: math-priority ( class -- n )
dup "members" word-prop [
0 [ math-priority max ] reduce
] [
"math-priority" word-prop [ 100 ] unless*
] ?if ;
: first/last ( seq -- pair ) dup first swap peek 2array ;
: math-class< ( class class -- ? )
[ math-priority ] 2apply < ;
: math-class-compare ( class class -- n )
[
dup number class<
[ types first/last ] [ drop { 100 100 } ] if
] 2apply <=> ;
: math-class-max ( class class -- class )
[ swap math-class< ] 2keep ? ;
[ math-class-compare 0 > ] 2keep ? ;
: (math-upgrade) ( max class -- quot )
dupd = [ drop [ ] ] [ "coercer" word-prop ] if ;
: math-upgrade ( left right -- quot )
2dup math-class< [
nip "coercer" word-prop
dup [ [ >r ] swap [ r> ] append3 ] when
] [
2dup swap math-class< [
drop "coercer" word-prop
] [
2drop [ ]
] if
] if ;
[ math-class-max ] 2keep
>r over r> (math-upgrade)
>r (math-upgrade) dup [ 1 make-dip ] when r> append ;
TUPLE: no-math-method left right generic ;
@ -52,13 +46,16 @@ TUPLE: no-math-method left right generic ;
2drop object-method
] if ;
: math-vtable ( picker quot -- quot )
: math-vtable* ( picker max quot -- quot )
[
swap , \ tag ,
[ num-tags [ type>class ] map swap map % ] { } make ,
rot , \ tag ,
[ >r [ type>class ] map r> map % ] { } make ,
\ dispatch ,
] [ ] make ; inline
: math-vtable ( picker quot -- quot )
num-tags swap math-vtable* ; inline
: math-class? ( object -- ? )
dup word? [ "math-priority" word-prop ] [ drop f ] if ;

6
library/kernel.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
! See http://factorcode.org/license.txt for BSD license.
IN: kernel
USING: generic kernel-internals math-internals ;
USING: generic kernel-internals math math-internals ;
: 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
@ -81,7 +81,7 @@ IN: kernel-internals
! These words are unsafe. Don't use them.
: declare ( types -- ) drop ;
: array-capacity 1 slot ; inline
: array-capacity 1 slot { fixnum } declare ; inline
: array-nth swap 2 fixnum+fast slot ; inline
: set-array-nth swap 2 fixnum+fast set-slot ; inline

8
library/test/generic.factor
View File

@ -200,3 +200,11 @@ TUPLE: delegating ;
[ t ] [ \ + 2generic? ] unit-test
[ "SYMBOL: not-a-class C: not-a-class ;" parse ] unit-test-fails
! Test math-combination
[ [ >r >float r> ] ] [ \ real \ float math-upgrade ] unit-test
[ [ >float ] ] [ \ float \ real math-upgrade ] unit-test
[ [ >r >bignum r> ] ] [ \ fixnum \ bignum math-upgrade ] unit-test
[ [ >float ] ] [ \ float \ integer math-upgrade ] unit-test
[ number ] [ \ number \ float math-class-max ] unit-test
[ float ] [ \ real \ float math-class-max ] unit-test