More unboxing work
parent
7ed5db925f
commit
63bc32eda3
|
@ -3,7 +3,8 @@ USING: tools.test compiler.tree.tuple-unboxing
|
|||
compiler.tree compiler.tree.builder compiler.tree.normalization
|
||||
compiler.tree.propagation compiler.tree.cleanup
|
||||
compiler.tree.escape-analysis compiler.tree.tuple-unboxing
|
||||
compiler.tree.def-use kernel accessors sequences math ;
|
||||
compiler.tree.def-use kernel accessors sequences math
|
||||
sorting math.order binary-search ;
|
||||
|
||||
\ unbox-tuples must-infer
|
||||
|
||||
|
@ -24,8 +25,11 @@ TUPLE: cons { car read-only } { cdr read-only } ;
|
|||
TUPLE: empty-tuple ;
|
||||
|
||||
{
|
||||
[ 1 2 cons boa [ car>> ] [ cdr>> ] bi ]
|
||||
[ empty-tuple boa drop ]
|
||||
[ cons boa [ car>> ] [ cdr>> ] bi ]
|
||||
[ [ 1 cons boa ] [ 2 cons boa ] if car>> ]
|
||||
[ dup cons boa 10 [ nip dup cons boa ] each-integer car>> ]
|
||||
[ [ <=> ] sort ]
|
||||
[ [ <=> ] with search ]
|
||||
} [ [ ] swap [ test-unboxing ] curry unit-test ] each
|
||||
|
|
|
@ -72,6 +72,9 @@ M: #call unbox-tuples*
|
|||
[ drop ]
|
||||
} case ;
|
||||
|
||||
M: #declare unbox-tuples*
|
||||
[ unzip [ flatten-values ] dip zip ] change-declaration ;
|
||||
|
||||
M: #copy unbox-tuples*
|
||||
[ flatten-values ] change-in-d
|
||||
[ flatten-values ] change-out-d ;
|
||||
|
@ -92,9 +95,37 @@ M: #shuffle unbox-tuples*
|
|||
M: #terminate unbox-tuples*
|
||||
[ flatten-values ] change-in-d ;
|
||||
|
||||
! These nodes never participate in unboxing
|
||||
M: #return unbox-tuples* ;
|
||||
M: #phi unbox-tuples*
|
||||
[ flip [ flatten-values ] map flip ] change-phi-in-d
|
||||
[ flip [ flatten-values ] map flip ] change-phi-in-r
|
||||
[ flatten-values ] change-out-d
|
||||
[ flatten-values ] change-out-r ;
|
||||
|
||||
M: #introduce unbox-tuples* ;
|
||||
M: #recursive unbox-tuples*
|
||||
[ flatten-values ] change-in-d ;
|
||||
|
||||
M: #enter-recursive unbox-tuples*
|
||||
[ flatten-values ] change-in-d
|
||||
[ flatten-values ] change-out-d ;
|
||||
|
||||
M: #call-recursive unbox-tuples*
|
||||
[ flatten-values ] change-in-d
|
||||
[ flatten-values ] change-out-d ;
|
||||
|
||||
M: #return-recursive unbox-tuples*
|
||||
[ flatten-values ] change-in-d
|
||||
[ flatten-values ] change-out-d ;
|
||||
|
||||
! These nodes never participate in unboxing
|
||||
: assert-not-unboxed ( values -- )
|
||||
dup array?
|
||||
[ [ unboxed-allocation ] contains? ] [ unboxed-allocation ] if
|
||||
[ "Unboxing wrong value" throw ] when ;
|
||||
|
||||
M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ;
|
||||
|
||||
M: #return unbox-tuples* dup in-d>> assert-not-unboxed ;
|
||||
|
||||
M: #introduce unbox-tuples* dup value>> assert-not-unboxed ;
|
||||
|
||||
: unbox-tuples ( nodes -- nodes ) [ unbox-tuples* ] map-nodes ;
|
||||
|
|
Loading…
Reference in New Issue