More unboxing work

db4
Slava Pestov 2008-08-08 16:04:33 -05:00
parent 7ed5db925f
commit 63bc32eda3
2 changed files with 39 additions and 4 deletions

View File

@ -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

View File

@ -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 ;