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

Working on tuple unboxing

db4
Slava Pestov 2008-08-07 06:34:28 -05:00
parent 44bd16ea4c
commit f9900202c8
18 changed files with 250 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
unfinished/compiler/tree/escape-analysis/allocations/allocations.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs namespaces sequences kernel math
combinators sets disjoint-sets fry stack-checker.state
compiler.tree.copy-equiv ;
combinators sets disjoint-sets fry stack-checker.state ;
IN: compiler.tree.escape-analysis.allocations
! A map from values to one of the following:
@ -18,7 +17,7 @@ TUPLE: slot-access slot# value ;
C: <slot-access> slot-access
: (allocation) ( value -- value' allocations )
resolve-copy allocations get ; inline
allocations get ; inline
: allocation ( value -- allocation )
(allocation) at dup slot-access? [
@ -26,7 +25,8 @@ C: <slot-access> slot-access
allocation
] when ;
: record-allocation ( allocation value -- ) (allocation) set-at ;
: record-allocation ( allocation value -- )
(allocation) set-at ;
: record-allocations ( allocations values -- )
[ record-allocation ] 2each ;
@ -40,15 +40,16 @@ SYMBOL: +escaping+
<disjoint-set> +escaping+ over add-atom ;
: init-escaping-values ( -- )
copies get assoc>disjoint-set +escaping+ over add-atom
escaping-values set ;
<escaping-values> escaping-values set ;
: introduce-value ( values -- )
escaping-values get add-atom ;
: introduce-values ( values -- )
escaping-values get add-atoms ;
: <slot-value> ( -- value )
<value>
[ introduce-value ]
[ escaping-values get add-atom ]
[ ]
tri ;
<value> dup escaping-values get add-atom ;
: record-slot-access ( out slot# in -- )
over zero? [ 3drop ] [
@ -61,8 +62,11 @@ SYMBOL: +escaping+
: merge-slots ( values -- value )
<slot-value> [ merge-values ] keep ;
: equate-values ( value1 value2 -- )
escaping-values get equate ;
: add-escaping-value ( value -- )
+escaping+ escaping-values get equate ;
+escaping+ equate-values ;
: add-escaping-values ( values -- )
escaping-values get
@ -79,6 +83,20 @@ SYMBOL: +escaping+
: escaping-value? ( value -- ? )
+escaping+ escaping-values get equiv? ;
DEFER: copy-value
: copy-allocation ( allocation -- allocation' )
{
{ [ dup not ] [ ] }
{ [ dup t eq? ] [ ] }
[ [ <value> [ introduce-value ] [ copy-value ] [ ] tri ] map ]
} cond ;
: copy-value ( from to -- )
[ equate-values ]
[ [ allocation copy-allocation ] dip record-allocation ]
2bi ;
SYMBOL: escaping-allocations
: compute-escaping-allocations ( -- )
@ -88,3 +106,11 @@ SYMBOL: escaping-allocations
: escaping-allocation? ( value -- ? )
escaping-allocations get key? ;
: unboxed-allocation ( value -- allocation/f )
dup escaping-allocation? [ drop f ] [ allocation ] if ;
: unboxed-slot-access? ( value -- ? )
(allocation) at dup slot-access?
[ value>> unboxed-allocation >boolean ] [ drop f ] if ;

10
unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor
View File

@ -1,9 +1,9 @@
IN: compiler.tree.escape-analysis.tests
USING: compiler.tree.escape-analysis
compiler.tree.escape-analysis.allocations compiler.tree.builder
compiler.tree.normalization compiler.tree.copy-equiv
compiler.tree.normalization math.functions
compiler.tree.propagation compiler.tree.cleanup
compiler.tree.combinators compiler.tree sequences math
compiler.tree.combinators compiler.tree sequences math math.private
kernel tools.test accessors slots.private quotations.private
prettyprint classes.tuple.private classes classes.tuple ;
@ -12,10 +12,10 @@ prettyprint classes.tuple.private classes classes.tuple ;
GENERIC: count-unboxed-allocations* ( m node -- n )
: (count-unboxed-allocations) ( m node -- n )
dup out-d>> first escaping-allocation? [ drop ] [ short. 1+ ] if ;
out-d>> first escaping-allocation? [ 1+ ] unless ;
M: #call count-unboxed-allocations*
dup word>> \ <tuple-boa> =
dup word>> { <tuple-boa> <complex> } memq?
[ (count-unboxed-allocations) ] [ drop ] if ;
M: #push count-unboxed-allocations*
@ -281,3 +281,5 @@ C: <ro-box> ro-box
] if ; inline recursive
[ 0 ] [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ <complex> >rect ] count-unboxed-allocations ] unit-test

2
unfinished/compiler/tree/escape-analysis/escape-analysis.factor
View File

@ -11,6 +11,8 @@ compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.simple ;
IN: compiler.tree.escape-analysis
! This pass must run after propagation
: escape-analysis ( node -- node )
init-escaping-values
H{ } clone allocations set

14
unfinished/compiler/tree/escape-analysis/nodes/nodes.factor
View File

@ -1,10 +1,16 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences compiler.tree ;
USING: kernel sequences
compiler.tree
compiler.tree.def-use
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.nodes
GENERIC: escape-analysis* ( node -- )
M: node escape-analysis* drop ;
: (escape-analysis) ( node -- ) [ escape-analysis* ] each ;
: (escape-analysis) ( node -- )
[
[ node-defs-values introduce-values ]
[ escape-analysis* ]
bi
] each ;

1
unfinished/compiler/tree/escape-analysis/recursive/recursive-tests.factor
View File

@ -1,6 +1,5 @@
IN: compiler.tree.escape-analysis.recursive.tests
USING: kernel tools.test namespaces sequences
compiler.tree.copy-equiv
compiler.tree.escape-analysis.recursive
compiler.tree.escape-analysis.allocations ;

65
unfinished/compiler/tree/escape-analysis/simple/simple.factor
View File

@ -1,26 +1,43 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences classes.tuple
classes.tuple.private math math.private slots.private
classes.tuple.private arrays math math.private slots.private
combinators dequeues search-dequeues namespaces fry classes
stack-checker.state
classes.algebra stack-checker.state
compiler.tree
compiler.tree.propagation.info
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.escape-analysis.simple
M: #introduce escape-analysis*
value>> unknown-allocation ;
M: #declare escape-analysis* drop ;
M: #terminate escape-analysis* drop ;
M: #renaming escape-analysis* inputs/outputs [ copy-value ] 2each ;
M: #introduce escape-analysis* value>> unknown-allocation ;
DEFER: record-literal-allocation
: make-literal-slots ( seq -- values )
[ <slot-value> [ swap record-literal-allocation ] keep ] map ;
: record-literal-tuple-allocation ( value object -- )
tuple-slots rest-slice
make-literal-slots
swap record-allocation ;
: record-literal-complex-allocation ( value object -- )
[ real-part ] [ imaginary-part ] bi 2array make-literal-slots
swap record-allocation ;
: record-literal-allocation ( value object -- )
dup class immutable-tuple-class? [
tuple-slots rest-slice
[ <slot-value> [ swap record-literal-allocation ] keep ] map
swap record-allocation
] [
drop unknown-allocation
] if ;
{
{ [ dup class immutable-tuple-class? ] [ record-literal-tuple-allocation ] }
{ [ dup complex? ] [ record-literal-complex-allocation ] }
[ drop unknown-allocation ]
} cond ;
M: #push escape-analysis*
#! Delegation.
@ -34,19 +51,29 @@ M: #push escape-analysis*
record-allocation
] [ out-d>> unknown-allocations ] if ;
: record-complex-allocation ( #call -- )
[ in-d>> ] [ out-d>> first ] bi record-allocation ;
: slot-offset ( #call -- n/f )
dup in-d>>
[ first node-value-info class>> ]
[ second node-value-info literal>> ] 2bi
dup fixnum? [
{
{ [ over tuple class<= ] [ 3 - ] }
{ [ over complex class<= ] [ 1 - ] }
[ drop f ]
} cond nip
] [ 2drop f ] if ;
: record-slot-call ( #call -- )
[ out-d>> first ]
[ dup in-d>> second node-value-info literal>> ]
[ in-d>> first ] tri
over fixnum? [
[ 3 - ] dip record-slot-access
] [
2drop unknown-allocation
] if ;
[ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri
over [ record-slot-access ] [ 2drop unknown-allocation ] if ;
M: #call escape-analysis*
dup word>> {
{ \ <tuple-boa> [ record-tuple-allocation ] }
{ \ <complex> [ record-complex-allocation ] }
{ \ slot [ record-slot-call ] }
[
drop

17
unfinished/compiler/tree/optimizer/optimizer.factor
View File

@ -1,17 +1,22 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: compiler.tree.normalization compiler.tree.copy-equiv
compiler.tree.propagation compiler.tree.cleanup
compiler.tree.def-use compiler.tree.untupling
compiler.tree.dead-code compiler.tree.strength-reduction
compiler.tree.loop-detection compiler.tree.branch-fusion ;
USING: compiler.tree.normalization
compiler.tree.propagation
compiler.tree.cleanup
compiler.tree.escape-analysis
compiler.tree.tuple-unboxing
compiler.tree.def-use
compiler.tree.dead-code
compiler.tree.strength-reduction
compiler.tree.loop-detection
compiler.tree.branch-fusion ;
IN: compiler.tree.optimizer
: optimize-tree ( nodes -- nodes' )
normalize
propagate
cleanup
compute-def-use
escape-analysis
unbox-tuples
compute-def-use
remove-dead-code

5
unfinished/compiler/tree/propagation/constraints/constraints.factor
View File

@ -3,8 +3,9 @@
USING: arrays assocs math math.intervals kernel accessors
sequences namespaces classes classes.algebra
combinators words
compiler.tree compiler.tree.propagation.info
compiler.tree.copy-equiv ;
compiler.tree
compiler.tree.propagation.info
compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.constraints
! A constraint is a statement about a value.

4
unfinished/compiler/tree/copy-equiv/copy-equiv-tests.factor → unfinished/compiler/tree/propagation/copy/copy-tests.factor
View File

@ -1,5 +1,5 @@
IN: compiler.tree.copy-equiv.tests
USING: compiler.tree.copy-equiv tools.test namespaces kernel
IN: compiler.tree.propagation.copy.tests
USING: compiler.tree.propagation.copy tools.test namespaces kernel
assocs ;
H{ } clone copies set

21
unfinished/compiler/tree/copy-equiv/copy-equiv.factor → unfinished/compiler/tree/propagation/copy/copy.factor
View File

@ -5,10 +5,7 @@ combinators sets locals
compiler.tree
compiler.tree.def-use
compiler.tree.combinators ;
IN: compiler.tree.copy-equiv
! This is not really a compiler pass; its invoked as part of
! propagation.
IN: compiler.tree.propagation.copy
! Two values are copy-equivalent if they are always identical
! at run-time ("DS" relation). This is just a weak form of
@ -39,21 +36,7 @@ SYMBOL: copies
GENERIC: compute-copy-equiv* ( node -- )
M: #shuffle compute-copy-equiv*
[ out-d>> dup ] [ mapping>> ] bi
'[ , at ] map swap are-copies-of ;
M: #>r compute-copy-equiv*
[ in-d>> ] [ out-r>> ] bi are-copies-of ;
M: #r> compute-copy-equiv*
[ in-r>> ] [ out-d>> ] bi are-copies-of ;
M: #copy compute-copy-equiv*
[ in-d>> ] [ out-d>> ] bi are-copies-of ;
M: #return-recursive compute-copy-equiv*
[ in-d>> ] [ out-d>> ] bi are-copies-of ;
M: #renaming compute-copy-equiv* inputs/outputs are-copies-of ;
: compute-phi-equiv ( inputs outputs -- )
#! An output is a copy of every input if all inputs are

2
unfinished/compiler/tree/propagation/info/info.factor
View File

@ -3,7 +3,7 @@
USING: assocs classes classes.algebra kernel
accessors math math.intervals namespaces sequences words
combinators combinators.short-circuit arrays
compiler.tree.copy-equiv ;
compiler.tree.propagation.copy ;
IN: compiler.tree.propagation.info
: false-class? ( class -- ? ) \ f class<= ;

2
unfinished/compiler/tree/propagation/nodes/nodes.factor
View File

@ -3,7 +3,7 @@
USING: sequences accessors kernel assocs sequences
compiler.tree
compiler.tree.def-use
compiler.tree.copy-equiv
compiler.tree.propagation.copy
compiler.tree.propagation.info ;
IN: compiler.tree.propagation.nodes

4
unfinished/compiler/tree/propagation/propagation.factor
View File

@ -3,7 +3,7 @@
USING: accessors kernel sequences namespaces hashtables
compiler.tree
compiler.tree.def-use
compiler.tree.copy-equiv
compiler.tree.propagation.copy
compiler.tree.propagation.info
compiler.tree.propagation.nodes
compiler.tree.propagation.simple
@ -13,6 +13,8 @@ compiler.tree.propagation.constraints
compiler.tree.propagation.known-words ;
IN: compiler.tree.propagation
! This pass must run after normalization
: propagate ( node -- node )
H{ } clone copies set
H{ } clone constraints set

2
unfinished/compiler/tree/propagation/recursive/recursive.factor
View File

@ -4,8 +4,8 @@ USING: kernel sequences accessors arrays fry math.intervals
combinators namespaces
stack-checker.inlining
compiler.tree
compiler.tree.copy-equiv
compiler.tree.combinators
compiler.tree.propagation.copy
compiler.tree.propagation.info
compiler.tree.propagation.nodes
compiler.tree.propagation.simple

20
unfinished/compiler/tree/tree.factor
View File

@ -39,7 +39,9 @@ TUPLE: #push < node literal out-d ;
swap 1array >>out-d
swap >>literal ;
TUPLE: #shuffle < node mapping in-d out-d ;
TUPLE: #renaming < node ;
TUPLE: #shuffle < #renaming mapping in-d out-d ;
: #shuffle ( inputs outputs mapping -- node )
\ #shuffle new
@ -50,14 +52,14 @@ TUPLE: #shuffle < node mapping in-d out-d ;
: #drop ( inputs -- node )
{ } { } #shuffle ;
TUPLE: #>r < node in-d out-r ;
TUPLE: #>r < #renaming in-d out-r ;
: #>r ( inputs outputs -- node )
\ #>r new
swap >>out-r
swap >>in-d ;
TUPLE: #r> < node in-r out-d ;
TUPLE: #r> < #renaming in-r out-d ;
: #r> ( inputs outputs -- node )
\ #r> new
@ -126,7 +128,7 @@ TUPLE: #enter-recursive < node in-d out-d label ;
swap >>in-d
swap >>label ;
TUPLE: #return-recursive < node in-d out-d label ;
TUPLE: #return-recursive < #renaming in-d out-d label ;
: #return-recursive ( label inputs outputs -- node )
\ #return-recursive new
@ -134,7 +136,7 @@ TUPLE: #return-recursive < node in-d out-d label ;
swap >>in-d
swap >>label ;
TUPLE: #copy < node in-d out-d ;
TUPLE: #copy < #renaming in-d out-d ;
: #copy ( inputs outputs -- node )
\ #copy new
@ -143,6 +145,14 @@ TUPLE: #copy < node in-d out-d ;
: node, ( node -- ) stack-visitor get push ;
GENERIC: inputs/outputs ( #renaming -- inputs outputs )
M: #shuffle inputs/outputs mapping>> unzip swap ;
M: #>r inputs/outputs [ in-d>> ] [ out-r>> ] bi ;
M: #r> inputs/outputs [ in-r>> ] [ out-d>> ] bi ;
M: #copy inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
M: #return-recursive inputs/outputs [ in-d>> ] [ out-d>> ] bi ;
M: vector child-visitor V{ } clone ;
M: vector #introduce, #introduce node, ;
M: vector #call, #call node, ;

109
unfinished/compiler/tree/tuple-unboxing/tuple-unboxing.factor Normal file
View File

@ -0,0 +1,109 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler.tree.tuple-unboxing
! This pass must run after escape analysis
! Mapping from values to sequences of values
SYMBOL: unboxed-tuples
: unboxed-tuple ( value -- unboxed-tuple )
unboxed-tuples get at ;
GENERIC: unbox-tuples* ( node -- )
: value-info-slots ( info -- slots )
#! Delegation.
[ info>> ] [ class>> ] bi {
{ [ dup tuple class<= ] [ drop 2 tail ] }
{ [ dup complex class<= ] [ drop ] }
} cond ;
: prepare-unboxed-values ( #push -- values )
out-d>> first unboxed-allocation ;
: prepare-unboxed-info ( #push -- infos values )
dup prepare-unboxed-values dup
[ [ node-output-infos first value-info-slots ] dip ]
[ 2drop f f ]
if ;
: expand-#push ( #push infos values -- )
[ [ literal>> ] dip #push ] 2map >>body drop ;
M: #push unbox-tuples* ( #push -- )
dup prepare-unboxed-info dup [ expand-#push ] [ 3drop ] if ;
: expand-<tuple-boa> ( #call values -- quot )
[ drop in-d>> peek #drop ]
[ [ in-d>> but-last ] dip #copy ]
2bi 2array ;
: expand-<complex> ( #call values -- quot )
[ in-d>> ] dip #copy 1array ;
: expand-constructor ( #call values -- )
[ drop ] [ ] [ drop word>> ] 2tri {
{ <tuple-boa> [ expand-<tuple-boa> ] }
{ <complex> [ expand-<complex> ] }
} case unbox-tuples >>body ;
: unbox-constructor ( #call -- )
dup prepare-unboxed-values dup
[ expand-constructor ] [ 2drop ] if ;
: (flatten-values) ( values -- values' )
[ dup unboxed-allocation [ (flatten-values) ] [ ] ?if ] map ;
: flatten-values ( values -- values' )
(flatten-values) flatten ;
: flatten-value ( values -- values )
1array flatten-values ;
: prepare-slot-access ( #call -- tuple-values slot-values outputs )
[ in-d>> first flatten-value ]
[
[ dup in-d>> second node-value-info literal>> ]
[ out-d>> first unboxed-allocation ]
bi nth flatten-value
]
[ out-d>> flatten-values ]
tri ;
: slot-access-shuffle ( tuple-values slot-values outputs -- #shuffle )
[ nip ] [ zip ] 2bi #shuffle ;
: unbox-slot-access ( #call -- )
dup unboxed-slot-access? [
dup
[ in-d>> second 1array #drop ]
[ prepare-slot-access slot-access-shuffle ]
bi 2array unbox-tuples >>body
] when drop ;
M: #call unbox-tuples* ( #call -- )
dup word>> {
{ \ <tuple-boa> [ unbox-<tuple-boa> ] }
{ \ <complex> [ unbox-<complex> ] }
{ \ slot [ unbox-slot-access ] }
[ 2drop ]
} case ;
M: #copy ... ;
M: #>r ... ;
M: #r> ... ;
M: #shuffle ... ;
M: #terrible ... ;
! These nodes never participate in unboxing
M: #return drop ;
M: #introduce drop ;
: unbox-tuples ( nodes -- nodes )
dup [ unbox-tuples* ] each-node ;

50
unfinished/compiler/tree/untupling/untupling-tests.factor
View File

@ -1,50 +0,0 @@
IN: compiler.tree.untupling.tests
USING: assocs math kernel quotations.private slots.private
compiler.tree.builder
compiler.tree.def-use
compiler.tree.copy-equiv
compiler.tree.untupling
tools.test ;
: check-untupling ( quot -- sizes )
build-tree
compute-copy-equiv
compute-def-use
compute-untupling
values ;
[ { } ] [ [ 1 [ + ] curry ] check-untupling ] unit-test
[ { 2 } ] [ [ 1 [ + ] curry drop ] check-untupling ] unit-test
[ { 2 } ] [ [ 1 [ + ] curry 3 slot ] check-untupling ] unit-test
[ { 2 } ] [ [ 1 [ + ] curry 3 slot drop ] check-untupling ] unit-test
[ { 2 } ] [ [ 1 [ + ] curry uncurry ] check-untupling ] unit-test
[ { 2 } ] [ [ 2 1 [ + ] curry call ] check-untupling ] unit-test
[ { 2 } ] [ [ 2 1 [ + ] curry call ] check-untupling ] unit-test
[ { } ] [ [ [ 1 [ + ] curry ] [ [ ] ] if ] check-untupling ] unit-test
[ { 2 2 } ] [
[ [ 1 [ + ] curry ] [ 2 [ * ] curry ] if uncurry ] check-untupling
] unit-test
[ { } ] [
[ [ 1 [ + ] curry ] [ 2 [ * ] curry ] if ] check-untupling
] unit-test
[ { 2 2 2 } ] [
[ [ 1 [ + ] curry ] [ dup [ 2 [ * ] curry ] [ 3 [ / ] curry ] if ] if uncurry ] check-untupling
] unit-test
[ { 2 2 } ] [
[ [ 1 [ + ] curry 4 ] [ dup [ 2 [ * ] curry ] [ 3 [ / ] curry ] if uncurry ] if ] check-untupling
] unit-test
[ { } ] [
[ [ 1 [ + ] curry ] [ dup [ 2 [ * ] curry ] [ 3 [ / ] curry ] if ] if ] check-untupling
] unit-test

59
unfinished/compiler/tree/untupling/untupling.factor
View File

@ -1,59 +0,0 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors slots.private kernel namespaces disjoint-sets
math sequences assocs classes.tuple.private combinators fry sets
compiler.tree compiler.tree.combinators compiler.tree.copy-equiv
compiler.tree.dataflow-analysis
compiler.tree.dataflow-analysis.backward ;
IN: compiler.tree.untupling
SYMBOL: escaping-values
: mark-escaping-values ( node -- )
in-d>> escaping-values get '[ resolve-copy , conjoin ] each ;
SYMBOL: untupling-candidates
: untupling-candidate ( #call class -- )
#! 1- for delegate
size>> 1- swap out-d>> first resolve-copy
untupling-candidates get set-at ;
GENERIC: compute-untupling* ( node -- )
M: #call compute-untupling*
dup word>> {
{ \ <tuple-boa> [ dup in-d>> peek untupling-candidate ] }
{ \ curry [ \ curry tuple-layout untupling-candidate ] }
{ \ compose [ \ compose tuple-layout untupling-candidate ] }
{ \ slot [ drop ] }
[ drop mark-escaping-values ]
} case ;
M: #return compute-untupling* mark-escaping-values ;
M: node compute-untupling* drop ;
GENERIC: check-consistency* ( node -- )
: check-value-consistency ( out-value in-values -- )
swap escaping-values get key? [
escaping-values get '[ , conjoin ] each
] [
untupling-candidates get 2dup '[ , at ] map all-equal?
[ 2drop ] [ '[ , delete-at ] each ] if
] if ;
M: #phi check-consistency*
[ [ out-d>> ] [ phi-in-d>> ] bi [ check-value-consistency ] 2each ]
[ [ out-r>> ] [ phi-in-r>> ] bi [ check-value-consistency ] 2each ]
bi ;
M: node check-consistency* drop ;
: compute-untupling ( node -- assoc )
H{ } clone escaping-values set
H{ } clone untupling-candidates set
[ [ compute-untupling* ] each-node ]
[ [ check-consistency* ] each-node ] bi
untupling-candidates get escaping-values get assoc-diff ;