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
parent
3307876cc2
commit
21461a1b75
|
@ -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
|
||||
|
|
|
@ -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
|
||||
} ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue