core: selector-for and collector-for are the wrong naming convention--they should be selector-as and collector-as because they take exemplars.

The exemplar is the starting length of the output sequence in collector-as, so add another collector-for-as that takes a seq that we are making a collector for.
locals-and-roots
Doug Coleman 2016-05-26 14:36:11 -07:00
parent 3307876cc2
commit 21461a1b75
5 changed files with 33 additions and 26 deletions

View File

@ -95,19 +95,19 @@ MACRO: (ncollect) ( n -- quot )
: mnmap ( m*seq quot m n -- result*n )
2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
: ncollector-for ( quot exemplar... n -- quot' vec... )
: ncollector-as ( quot exemplar... n -- quot' vec... )
5 dupn '[
[ [ length ] keep new-resizable ] _ napply
[ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep
] call ; inline
: ncollector ( quot n -- quot' vec... )
[ V{ } swap dupn ] keep ncollector-for ; inline
[ V{ } swap dupn ] keep ncollector-as ; inline
: nproduce-as ( pred quot exemplar... n -- seq... )
7 dupn '[
_ ndup
[ _ ncollector-for [ while ] _ ndip ]
[ _ ncollector-as [ while ] _ ndip ]
_ ncurry _ ndip
[ like ] _ apply-curry _ spread*
] call ; inline

View File

@ -1944,12 +1944,13 @@ ARTICLE: "sequences-combinator-implementation" "Implementing sequence combinator
"Creating a new sequence unconditionally:"
{ $subsections
collector
collector-for
collector-as
collector-for-as
}
"Creating a new sequence conditionally:"
{ $subsections
selector
selector-for
selector-as
2selector
} ;

View File

@ -551,19 +551,19 @@ PRIVATE>
<PRIVATE
: (selector-for) ( quot length exemplar -- selector accum )
: (selector-as) ( quot length exemplar -- selector accum )
new-resizable [ [ push-if ] 2curry ] keep ; inline
PRIVATE>
: selector-for ( quot exemplar -- selector accum )
[ length ] keep (selector-for) ; inline
: selector-as ( quot exemplar -- selector accum )
[ length ] keep (selector-as) ; inline
: selector ( quot -- selector accum )
V{ } selector-for ; inline
V{ } selector-as ; inline
: filter-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... subseq )
pick length over [ (selector-for) [ each ] dip ] 2curry dip like ; inline
pick length over [ (selector-as) [ each ] dip ] 2curry dip like ; inline
: filter ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
over filter-as ; inline
@ -583,14 +583,20 @@ PRIVATE>
: partition ( ... seq quot: ( ... elt -- ... ? ) -- ... trueseq falseseq )
over [ 2selector [ each ] 2dip ] dip [ like ] curry bi@ ; inline
: collector-for ( quot exemplar -- quot' vec )
: collector-for-as ( seq quot exemplar -- seq quot' vec )
[ over length ] dip new-resizable [ [ push ] curry compose ] keep ; inline
: collector-as ( quot exemplar -- quot' vec )
[ length ] keep new-resizable [ [ push ] curry compose ] keep ; inline
: collector-for ( seq quot -- seq quot' vec )
V{ } collector-for-as ; inline
: collector ( quot -- quot' vec )
V{ } collector-for ; inline
V{ } collector-as ; inline
: produce-as ( ..a pred: ( ..a -- ..b ? ) quot: ( ..b -- ..a obj ) exemplar -- ..b seq )
dup [ collector-for [ while ] dip ] curry dip like ; inline
dup [ collector-as [ while ] dip ] curry dip like ; inline
: produce ( ..a pred: ( ..a -- ..b ? ) quot: ( ..b -- ..a obj ) -- ..b seq )
{ } produce-as ; inline

View File

@ -297,11 +297,11 @@ T{ doc
<PRIVATE
: collector-for-when ( quot exemplar -- quot' vec )
: collector-when-as ( quot exemplar -- quot' vec )
[ length ] keep new-resizable [ [ over [ push ] [ 2drop ] if ] curry compose ] keep ; inline
: collector-when ( quot -- quot' vec )
V{ } collector-for-when ; inline
V{ } collector-when-as ; inline
PRIVATE>

View File

@ -93,27 +93,27 @@ IN: sequences.extras
<PRIVATE
: (index-selector-for) ( quot length exampler -- selector accum )
: (index-selector-as) ( quot length exampler -- selector accum )
new-resizable [ [ push-if-index ] 2curry ] keep ; inline
: (selector-for*) ( quot length exemplar -- selector accum )
: (selector-as*) ( quot length exemplar -- selector accum )
new-resizable [ [ push-if* ] 2curry ] keep ; inline
PRIVATE>
: index-selector-for ( quot exemplar -- selector accum )
[ length ] keep (index-selector-for) ; inline
: index-selector-as ( quot exemplar -- selector accum )
[ length ] keep (index-selector-as) ; inline
: index-selector ( quot -- selector accum )
V{ } index-selector-for ; inline
V{ } index-selector-as ; inline
: selector-for* ( quot exemplar -- selector accum )
[ length ] keep (selector-for*) ; inline
: selector-as* ( quot exemplar -- selector accum )
[ length ] keep (selector-as*) ; inline
: selector* ( quot -- selector accum ) V{ } selector-for* ; inline
: selector* ( quot -- selector accum ) V{ } selector-as* ; inline
: filter-index-as ( ... seq quot: ( ... elt i -- ... ? ) exemplar -- ... seq' )
pick length over [ (index-selector-for) [ each-index ] dip ] 2curry dip like ; inline
pick length over [ (index-selector-as) [ each-index ] dip ] 2curry dip like ; inline
: filter-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... seq' )
over filter-index-as ; inline
@ -251,7 +251,7 @@ PRIVATE>
: map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq )
[ pick ] dip swap length over
[ (selector-for) [ compose each ] dip ] 2curry dip like ; inline
[ (selector-as) [ compose each ] dip ] 2curry dip like ; inline
: map-filter ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) -- ... subseq )
pick map-filter-as ; inline
@ -615,4 +615,4 @@ PRIVATE>
'[ _ dip ] assoc-map ; inline
: map-values ( assoc quot: ( value -- value' ) -- assoc )
'[ swap _ dip swap ] assoc-map ; inline
'[ swap _ dip swap ] assoc-map ; inline