Tuple unboxing progress

db4
Slava Pestov 2008-08-08 13:14:36 -05:00
parent f9900202c8
commit 2d07fd6826
13 changed files with 248 additions and 162 deletions

View File

@ -66,6 +66,10 @@ M: disjoint-set add-atom
: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ;
GENERIC: disjoint-set-member? ( a disjoint-set -- ? )
M: disjoint-set disjoint-set-member? parents>> key? ;
GENERIC: equiv-set-size ( a disjoint-set -- n )
M: disjoint-set equiv-set-size [ representative ] keep count ;

View File

@ -2,8 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences sequences.deep combinators fry
classes.algebra namespaces assocs math math.private
math.partial-dispatch
math.partial-dispatch classes.tuple classes.tuple.private
compiler.tree
compiler.tree.intrinsics
compiler.tree.combinators
compiler.tree.propagation.info
compiler.tree.propagation.branches ;
@ -53,11 +54,21 @@ GENERIC: cleanup* ( node -- node/nodes )
: remove-overflow-check ( #call -- #call )
[ in-d>> ] [ out-d>> ] [ word>> no-overflow-variant ] tri #call cleanup* ;
: immutable-tuple-boa? ( #call -- ? )
dup word>> \ <tuple-boa> eq? [
dup in-d>> peek node-value-info
literal>> class>> immutable-tuple-class?
] [ drop f ] if ;
: immutable-tuple-boa ( #call -- #call )
\ <immutable-tuple-boa> >>word ;
M: #call cleanup*
{
{ [ dup body>> ] [ cleanup-inlining ] }
{ [ dup cleanup-folding? ] [ cleanup-folding ] }
{ [ dup remove-overflow-check? ] [ remove-overflow-check ] }
{ [ dup immutable-tuple-boa? ] [ immutable-tuple-boa ] }
[ ]
} cond ;

View File

@ -1,7 +1,7 @@
USING: namespaces assocs sequences compiler.tree.builder
compiler.tree.dead-code compiler.tree.def-use compiler.tree
compiler.tree.combinators tools.test kernel math
stack-checker.state accessors ;
stack-checker.state accessors combinators ;
IN: compiler.tree.dead-code.tests
\ remove-dead-code must-infer
@ -10,20 +10,27 @@ IN: compiler.tree.dead-code.tests
build-tree
compute-def-use
remove-dead-code
compute-def-use
0 swap [ dup #push? [ out-d>> length + ] [ drop ] if ] each-node ;
0 swap [
{
{ [ dup #push? ] [ out-d>> length + ] }
{ [ dup #introduce? ] [ drop 1 + ] }
[ drop ]
} cond
] each-node ;
[ 3 ] [ [ 1 2 3 ] count-live-values ] unit-test
[ 1 ] [ [ drop ] count-live-values ] unit-test
[ 0 ] [ [ 1 drop ] count-live-values ] unit-test
[ 1 ] [ [ 1 2 drop ] count-live-values ] unit-test
[ 2 ] [ [ [ 1 ] [ 2 ] if ] count-live-values ] unit-test
[ 3 ] [ [ [ 1 ] [ 2 ] if ] count-live-values ] unit-test
[ 0 ] [ [ [ 1 ] [ 2 ] if drop ] count-live-values ] unit-test
[ 1 ] [ [ [ 1 ] [ 2 ] if drop ] count-live-values ] unit-test
[ 0 ] [ [ [ 1 ] [ dup ] if drop ] count-live-values ] unit-test
[ 2 ] [ [ [ 1 ] [ dup ] if drop ] count-live-values ] unit-test
[ 2 ] [ [ 1 2 + ] count-live-values ] unit-test
@ -33,9 +40,9 @@ IN: compiler.tree.dead-code.tests
[ 0 ] [ [ 1 2 + 3 + drop ] count-live-values ] unit-test
[ 3 ] [ [ [ 1 ] [ 2 ] if 3 + ] count-live-values ] unit-test
[ 4 ] [ [ [ 1 ] [ 2 ] if 3 + ] count-live-values ] unit-test
[ 0 ] [ [ [ 1 ] [ 2 ] if 3 + drop ] count-live-values ] unit-test
[ 1 ] [ [ [ 1 ] [ 2 ] if 3 + drop ] count-live-values ] unit-test
[ 0 ] [ [ [ ] call ] count-live-values ] unit-test

View File

@ -3,15 +3,18 @@
USING: fry accessors namespaces assocs dequeues search-dequeues
kernel sequences words sets stack-checker.inlining
compiler.tree
compiler.tree.combinators
compiler.tree.dataflow-analysis
compiler.tree.dataflow-analysis.backward
compiler.tree.combinators ;
compiler.tree.dataflow-analysis.backward ;
IN: compiler.tree.dead-code
! Dead code elimination: remove #push and flushable #call whose
! outputs are unused using backward DFA.
GENERIC: mark-live-values ( node -- )
M: #introduce mark-live-values
value>> look-at-value ;
M: #if mark-live-values look-at-inputs ;
M: #dispatch mark-live-values look-at-inputs ;
@ -34,9 +37,6 @@ SYMBOL: live-values
GENERIC: remove-dead-values* ( node -- )
M: #introduce remove-dead-values*
[ [ live-value? ] filter ] change-values drop ;
M: #>r remove-dead-values*
dup out-r>> first live-value? [ { } >>out-r ] unless
dup in-d>> first live-value? [ { } >>in-d ] unless
@ -57,6 +57,30 @@ M: #push remove-dead-values*
: filter-live ( values -- values' )
[ live-value? ] filter ;
M: #call remove-dead-values*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
drop ;
M: #recursive remove-dead-values*
[ filter-live ] change-in-d
drop ;
M: #call-recursive remove-dead-values*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
drop ;
M: #enter-recursive remove-dead-values*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
drop ;
M: #return-recursive remove-dead-values*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
drop ;
M: #shuffle remove-dead-values*
[ filter-live ] change-in-d
[ filter-live ] change-out-d
@ -92,24 +116,19 @@ M: #phi remove-dead-values*
M: node remove-dead-values* drop ;
M: f remove-dead-values* drop ;
: remove-dead-values ( nodes -- )
[ remove-dead-values* ] each-node ;
GENERIC: remove-dead-nodes* ( node -- newnode/t )
GENERIC: remove-dead-nodes* ( node -- node/f )
: prune-if-empty ( node seq -- successor/t )
empty? [ successor>> ] [ drop t ] if ; inline
: prune-if-empty ( node seq -- node/f )
empty? [ drop f ] when ; inline
M: #introduce remove-dead-nodes* dup values>> prune-if-empty ;
: live-call? ( #call -- ? )
out-d>> [ live-value? ] contains? ;
: live-call? ( #call -- ? ) out-d>> [ live-value? ] contains? ;
M: #declare remove-dead-nodes* dup declaration>> prune-if-empty ;
M: #call remove-dead-nodes*
dup live-call? [ drop t ] [
[ in-d>> #drop ] [ successor>> ] bi >>successor
] if ;
M: #call remove-dead-nodes* dup live-call? [ in-d>> #drop ] unless ;
M: #shuffle remove-dead-nodes* dup in-d>> prune-if-empty ;
@ -121,25 +140,13 @@ M: #r> remove-dead-nodes* dup in-r>> prune-if-empty ;
M: #copy remove-dead-nodes* dup in-d>> prune-if-empty ;
: (remove-dead-code) ( node -- newnode )
[
dup remove-dead-values*
dup remove-dead-nodes* dup t eq?
[ drop ] [ nip (remove-dead-code) ] if
] transform-nodes ;
M: node remove-dead-nodes* ;
M: #if remove-dead-nodes*
[ (remove-dead-code) ] map-children t ;
M: #dispatch remove-dead-nodes*
[ (remove-dead-code) ] map-children t ;
M: #recursive remove-dead-nodes*
[ (remove-dead-code) ] change-child drop t ;
M: node remove-dead-nodes* drop t ;
M: f remove-dead-nodes* drop t ;
: remove-dead-nodes ( nodes -- nodes' )
[ remove-dead-nodes* ] map-nodes ;
: remove-dead-code ( node -- newnode )
[ [ compute-live-values ] [ (remove-dead-code) ] bi ] with-scope ;
[ compute-live-values ]
[ remove-dead-values ]
[ remove-dead-nodes ]
tri ;

View File

@ -9,21 +9,13 @@ IN: compiler.tree.escape-analysis.allocations
! may potentially become an allocation later
! - a sequence of values -- potentially unboxed tuple allocations
! - t -- not allocated in this procedure, can never be unboxed
SYMBOL: allocations
TUPLE: slot-access slot# value ;
C: <slot-access> slot-access
: (allocation) ( value -- value' allocations )
allocations get ; inline
: allocation ( value -- allocation )
(allocation) at dup slot-access? [
[ slot#>> ] [ value>> allocation ] bi nth
allocation
] when ;
(allocation) at ;
: record-allocation ( allocation value -- )
(allocation) set-at ;
@ -31,6 +23,17 @@ C: <slot-access> slot-access
: record-allocations ( allocations values -- )
[ record-allocation ] 2each ;
! We track slot access to connect constructor inputs with
! accessor outputs.
SYMBOL: slot-accesses
TUPLE: slot-access slot# value ;
C: <slot-access> slot-access
: record-slot-access ( out slot# in -- )
<slot-access> swap slot-accesses get set-at ;
! We track escaping values with a disjoint set.
SYMBOL: escaping-values
@ -43,18 +46,15 @@ SYMBOL: +escaping+
<escaping-values> escaping-values set ;
: introduce-value ( values -- )
escaping-values get add-atom ;
escaping-values get
2dup disjoint-set-member?
[ 2drop ] [ add-atom ] if ;
: introduce-values ( values -- )
escaping-values get add-atoms ;
[ introduce-value ] each ;
: <slot-value> ( -- value )
<value> dup escaping-values get add-atom ;
: record-slot-access ( out slot# in -- )
over zero? [ 3drop ] [
<slot-access> swap record-allocation
] if ;
<value> dup introduce-value ;
: merge-values ( in-values out-value -- )
escaping-values get '[ , , equate ] each ;
@ -66,11 +66,17 @@ SYMBOL: +escaping+
escaping-values get equate ;
: add-escaping-value ( value -- )
+escaping+ equate-values ;
[
allocation {
{ [ dup not ] [ drop ] }
{ [ dup t eq? ] [ drop ] }
[ [ add-escaping-value ] each ]
} cond
]
[ +escaping+ equate-values ] bi ;
: add-escaping-values ( values -- )
escaping-values get
'[ +escaping+ , equate ] each ;
[ add-escaping-value ] each ;
: unknown-allocation ( value -- )
[ add-escaping-value ]
@ -97,6 +103,14 @@ DEFER: copy-value
[ [ allocation copy-allocation ] dip record-allocation ]
2bi ;
: copy-slot-value ( out slot# in -- )
allocation {
{ [ dup not ] [ 3drop ] }
{ [ dup t eq? ] [ 3drop ] }
[ nth swap copy-value ]
} cond ;
! Compute which tuples escape
SYMBOL: escaping-allocations
: compute-escaping-allocations ( -- )
@ -111,6 +125,5 @@ SYMBOL: escaping-allocations
dup escaping-allocation? [ drop f ] [ allocation ] if ;
: unboxed-slot-access? ( value -- ? )
(allocation) at dup slot-access?
[ value>> unboxed-allocation >boolean ] [ drop f ] if ;
slot-accesses get at*
[ value>> unboxed-allocation >boolean ] when ;

View File

@ -217,6 +217,11 @@ C: <ro-box> ro-box
[ 3 ] [ [ <ro-box> tuple-fib ] count-unboxed-allocations ] unit-test
: tuple-fib' ( m -- n )
dup 1 <= [ 1- tuple-fib' i>> ] when <ro-box> ; inline recursive
[ 0 ] [ [ tuple-fib' ] count-unboxed-allocations ] unit-test
: bad-tuple-fib-1 ( m -- n )
dup i>> 1 <= [
drop 1 <ro-box>
@ -283,3 +288,9 @@ C: <ro-box> ro-box
[ 0 ] [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ <complex> >rect ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa 2 cons boa ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ 1 cons boa 2 cons boa car>> ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa 2 cons boa dup . car>> ] count-unboxed-allocations ] unit-test

View File

@ -16,5 +16,6 @@ IN: compiler.tree.escape-analysis
: escape-analysis ( node -- node )
init-escaping-values
H{ } clone allocations set
H{ } clone slot-accesses set
dup (escape-analysis)
compute-escaping-allocations ;

View File

@ -4,7 +4,7 @@ compiler.tree.escape-analysis.recursive
compiler.tree.escape-analysis.allocations ;
H{ } clone allocations set
H{ } clone copies set
<escaping-values> escaping-values set
[ ] [ 8 [ introduce-value ] each ] unit-test

View File

@ -29,10 +29,12 @@ IN: compiler.tree.escape-analysis.recursive
out-d>> [ allocation ] map ;
: recursive-stacks ( #enter-recursive -- stacks )
[ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
[ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix
escaping-values get '[ [ , disjoint-set-member? ] all? ] filter
flip ;
: analyze-recursive-phi ( #enter-recursive -- )
[ ] [ recursive-stacks flip ] [ out-d>> ] tri
[ ] [ recursive-stacks ] [ out-d>> ] tri
[ [ merge-values ] 2each ]
[
[ (merge-allocations) ] dip
@ -44,11 +46,16 @@ IN: compiler.tree.escape-analysis.recursive
M: #recursive escape-analysis* ( #recursive -- )
[
child>>
[ first out-d>> introduce-values ]
[ first analyze-recursive-phi ]
[ (escape-analysis) ]
bi
tri
] until-fixed-point ;
M: #enter-recursive escape-analysis* ( #enter-recursive -- )
#! Handled by #recursive
drop ;
: return-allocations ( node -- allocations )
label>> return>> node-input-allocations ;
@ -57,5 +64,8 @@ M: #call-recursive escape-analysis* ( #call-label -- )
[ check-fixed-point ] [ drop swap out-d>> record-allocations ] 3bi ;
M: #return-recursive escape-analysis* ( #return-recursive -- )
[ in-d>> ] [ label>> calls>> ] bi
[ out-d>> escaping-values get '[ , equate ] 2each ] with each ;
[ call-next-method ]
[
[ in-d>> ] [ label>> calls>> ] bi
[ out-d>> escaping-values get '[ , equate ] 2each ] with each
] bi ;

View File

@ -5,6 +5,7 @@ classes.tuple.private arrays math math.private slots.private
combinators dequeues search-dequeues namespaces fry classes
classes.algebra stack-checker.state
compiler.tree
compiler.tree.intrinsics
compiler.tree.propagation.info
compiler.tree.escape-analysis.nodes
compiler.tree.escape-analysis.allocations ;
@ -23,33 +24,24 @@ 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 ;
: object-slots ( object -- slots/f )
#! Delegation
{
{ [ dup class immutable-tuple-class? ] [ tuple-slots rest-slice ] }
{ [ dup complex? ] [ [ real-part ] [ imaginary-part ] bi 2array ] }
[ drop f ]
} cond ;
: record-literal-allocation ( value object -- )
{
{ [ dup class immutable-tuple-class? ] [ record-literal-tuple-allocation ] }
{ [ dup complex? ] [ record-literal-complex-allocation ] }
[ drop unknown-allocation ]
} cond ;
object-slots dup
[ make-literal-slots swap record-allocation ] [ 2drop ] if ;
M: #push escape-analysis*
#! Delegation.
[ out-d>> first ] [ literal>> ] bi record-literal-allocation ;
: record-tuple-allocation ( #call -- )
#! Delegation.
dup dup in-d>> peek node-value-info literal>>
class>> immutable-tuple-class? [
[ in-d>> but-last ] [ out-d>> first ] bi
record-allocation
] [ out-d>> unknown-allocations ] if ;
[ in-d>> but-last ] [ out-d>> first ] bi record-allocation ;
: record-complex-allocation ( #call -- )
[ in-d>> ] [ out-d>> first ] bi record-allocation ;
@ -68,11 +60,13 @@ M: #push escape-analysis*
: record-slot-call ( #call -- )
[ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri
over [ record-slot-access ] [ 2drop unknown-allocation ] if ;
over [
[ record-slot-access ] [ copy-slot-value ] 3bi
] [ 2drop unknown-allocation ] if ;
M: #call escape-analysis*
dup word>> {
{ \ <tuple-boa> [ record-tuple-allocation ] }
{ \ <immutable-tuple-boa> [ record-tuple-allocation ] }
{ \ <complex> [ record-complex-allocation ] }
{ \ slot [ record-slot-call ] }
[

View File

@ -0,0 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ;
IN: compiler.tree.intrinsics
: <immutable-tuple-boa> ( ... class -- tuple ) "Intrinsic" throw ;

View File

@ -0,0 +1,31 @@
IN: compiler.tree.tuple-unboxing.tests
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 ;
\ unbox-tuples must-infer
: test-unboxing ( quot -- )
#! Just make sure it doesn't throw errors; compute def use
#! for kicks.
build-tree
normalize
propagate
cleanup
escape-analysis
unbox-tuples
compute-def-use
drop ;
TUPLE: cons { car read-only } { cdr read-only } ;
TUPLE: empty-tuple ;
{
[ 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>> ]
} [ [ ] swap [ test-unboxing ] curry unit-test ] each

View File

@ -1,56 +1,41 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs accessors kernel combinators
classes.algebra sequences sequences.deep slots.private
classes.tuple.private math math.private arrays
compiler.tree
compiler.tree.intrinsics
compiler.tree.combinators
compiler.tree.escape-analysis.simple
compiler.tree.escape-analysis.allocations ;
IN: compiler.tree.tuple-unboxing
! This pass must run after escape analysis
! Mapping from values to sequences of values
SYMBOL: unboxed-tuples
GENERIC: unbox-tuples* ( node -- node/nodes )
: 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 )
: unbox-output? ( node -- 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) ( object value -- nodes )
dup unboxed-allocation dup [
[ object-slots ] [ drop ] [ ] tri*
[ (expand-#push) ] 2map
] [
drop #push
] if ;
: expand-#push ( #push infos values -- )
[ [ literal>> ] dip #push ] 2map >>body drop ;
: expand-#push ( #push -- nodes )
[ literal>> ] [ out-d>> first ] bi (expand-#push) ;
M: #push unbox-tuples* ( #push -- )
dup prepare-unboxed-info dup [ expand-#push ] [ 3drop ] if ;
M: #push unbox-tuples* ( #push -- nodes )
dup unbox-output? [ expand-#push ] when ;
: expand-<tuple-boa> ( #call values -- quot )
[ drop in-d>> peek #drop ]
[ [ in-d>> but-last ] dip #copy ]
2bi 2array ;
: unbox-<tuple-boa> ( #call -- nodes )
dup unbox-output? [ in-d>> 1 tail* #drop ] when ;
: 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 ;
: unbox-<complex> ( #call -- nodes )
dup unbox-output? [ drop { } ] when ;
: (flatten-values) ( values -- values' )
[ dup unboxed-allocation [ (flatten-values) ] [ ] ?if ] map ;
@ -59,51 +44,57 @@ M: #push unbox-tuples* ( #push -- )
(flatten-values) flatten ;
: flatten-value ( values -- values )
1array flatten-values ;
[ unboxed-allocation ] [ 1array ] bi or ;
: prepare-slot-access ( #call -- tuple-values slot-values outputs )
: prepare-slot-access ( #call -- tuple-values outputs slot-values )
[ 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 ;
[
out-d>> first slot-accesses get at
[ slot#>> ] [ value>> ] bi allocation nth flatten-value
] tri ;
: slot-access-shuffle ( tuple-values slot-values outputs -- #shuffle )
[ nip ] [ zip ] 2bi #shuffle ;
: slot-access-shuffle ( tuple-values outputs slot-values -- #shuffle )
[ drop ] [ zip ] 2bi #shuffle ;
: unbox-slot-access ( #call -- )
dup unboxed-slot-access? [
dup
: unbox-slot-access ( #call -- nodes )
dup out-d>> first unboxed-slot-access? [
[ in-d>> second 1array #drop ]
[ prepare-slot-access slot-access-shuffle ]
bi 2array unbox-tuples >>body
] when drop ;
bi 2array
] when ;
M: #call unbox-tuples* ( #call -- )
M: #call unbox-tuples*
dup word>> {
{ \ <tuple-boa> [ unbox-<tuple-boa> ] }
{ \ <immutable-tuple-boa> [ unbox-<tuple-boa> ] }
{ \ <complex> [ unbox-<complex> ] }
{ \ slot [ unbox-slot-access ] }
[ 2drop ]
[ drop ]
} case ;
M: #copy ... ;
M: #copy unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-d ;
M: #>r ... ;
M: #>r unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-r ;
M: #r> ... ;
M: #r> unbox-tuples*
[ flatten-values ] change-in-r
[ flatten-values ] change-out-d ;
M: #shuffle ... ;
M: #shuffle unbox-tuples*
[ flatten-values ] change-in-d
[ flatten-values ] change-out-d
[ unzip [ flatten-values ] bi@ zip ] change-mapping ;
M: #terrible ... ;
M: #terminate unbox-tuples*
[ flatten-values ] change-in-d ;
! These nodes never participate in unboxing
M: #return drop ;
M: #return unbox-tuples* ;
M: #introduce drop ;
M: #introduce unbox-tuples* ;
: unbox-tuples ( nodes -- nodes )
dup [ unbox-tuples* ] each-node ;
: unbox-tuples ( nodes -- nodes ) [ unbox-tuples* ] map-nodes ;