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 )
|
: mnmap ( m*seq quot m n -- result*n )
|
||||||
2dup '[ [ _ npick ] dip swap _ dupn ] 2dip mnmap-as ; inline
|
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 '[
|
5 dupn '[
|
||||||
[ [ length ] keep new-resizable ] _ napply
|
[ [ length ] keep new-resizable ] _ napply
|
||||||
[ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep
|
[ [ [ push ] _ apply-curry _ spread* ] _ ncurry compose ] _ nkeep
|
||||||
] call ; inline
|
] call ; inline
|
||||||
|
|
||||||
: ncollector ( quot n -- quot' vec... )
|
: 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... )
|
: nproduce-as ( pred quot exemplar... n -- seq... )
|
||||||
7 dupn '[
|
7 dupn '[
|
||||||
_ ndup
|
_ ndup
|
||||||
[ _ ncollector-for [ while ] _ ndip ]
|
[ _ ncollector-as [ while ] _ ndip ]
|
||||||
_ ncurry _ ndip
|
_ ncurry _ ndip
|
||||||
[ like ] _ apply-curry _ spread*
|
[ like ] _ apply-curry _ spread*
|
||||||
] call ; inline
|
] call ; inline
|
||||||
|
|
|
@ -1944,12 +1944,13 @@ ARTICLE: "sequences-combinator-implementation" "Implementing sequence combinator
|
||||||
"Creating a new sequence unconditionally:"
|
"Creating a new sequence unconditionally:"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
collector
|
collector
|
||||||
collector-for
|
collector-as
|
||||||
|
collector-for-as
|
||||||
}
|
}
|
||||||
"Creating a new sequence conditionally:"
|
"Creating a new sequence conditionally:"
|
||||||
{ $subsections
|
{ $subsections
|
||||||
selector
|
selector
|
||||||
selector-for
|
selector-as
|
||||||
2selector
|
2selector
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
|
|
|
@ -551,19 +551,19 @@ PRIVATE>
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (selector-for) ( quot length exemplar -- selector accum )
|
: (selector-as) ( quot length exemplar -- selector accum )
|
||||||
new-resizable [ [ push-if ] 2curry ] keep ; inline
|
new-resizable [ [ push-if ] 2curry ] keep ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: selector-for ( quot exemplar -- selector accum )
|
: selector-as ( quot exemplar -- selector accum )
|
||||||
[ length ] keep (selector-for) ; inline
|
[ length ] keep (selector-as) ; inline
|
||||||
|
|
||||||
: selector ( quot -- selector accum )
|
: selector ( quot -- selector accum )
|
||||||
V{ } selector-for ; inline
|
V{ } selector-as ; inline
|
||||||
|
|
||||||
: filter-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... subseq )
|
: 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 )
|
: filter ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
|
||||||
over filter-as ; inline
|
over filter-as ; inline
|
||||||
|
@ -583,14 +583,20 @@ PRIVATE>
|
||||||
: partition ( ... seq quot: ( ... elt -- ... ? ) -- ... trueseq falseseq )
|
: partition ( ... seq quot: ( ... elt -- ... ? ) -- ... trueseq falseseq )
|
||||||
over [ 2selector [ each ] 2dip ] dip [ like ] curry bi@ ; inline
|
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
|
[ 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 )
|
: 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 )
|
: 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 ( ..a pred: ( ..a -- ..b ? ) quot: ( ..b -- ..a obj ) -- ..b seq )
|
||||||
{ } produce-as ; inline
|
{ } produce-as ; inline
|
||||||
|
|
|
@ -297,11 +297,11 @@ T{ doc
|
||||||
|
|
||||||
<PRIVATE
|
<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
|
[ length ] keep new-resizable [ [ over [ push ] [ 2drop ] if ] curry compose ] keep ; inline
|
||||||
|
|
||||||
: collector-when ( quot -- quot' vec )
|
: collector-when ( quot -- quot' vec )
|
||||||
V{ } collector-for-when ; inline
|
V{ } collector-when-as ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -93,27 +93,27 @@ IN: sequences.extras
|
||||||
|
|
||||||
<PRIVATE
|
<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
|
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
|
new-resizable [ [ push-if* ] 2curry ] keep ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: index-selector-for ( quot exemplar -- selector accum )
|
: index-selector-as ( quot exemplar -- selector accum )
|
||||||
[ length ] keep (index-selector-for) ; inline
|
[ length ] keep (index-selector-as) ; inline
|
||||||
|
|
||||||
: index-selector ( quot -- selector accum )
|
: index-selector ( quot -- selector accum )
|
||||||
V{ } index-selector-for ; inline
|
V{ } index-selector-as ; inline
|
||||||
|
|
||||||
: selector-for* ( quot exemplar -- selector accum )
|
: selector-as* ( quot exemplar -- selector accum )
|
||||||
[ length ] keep (selector-for*) ; inline
|
[ 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' )
|
: 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' )
|
: filter-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... seq' )
|
||||||
over filter-index-as ; inline
|
over filter-index-as ; inline
|
||||||
|
@ -251,7 +251,7 @@ PRIVATE>
|
||||||
|
|
||||||
: map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq )
|
: map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq )
|
||||||
[ pick ] dip swap length over
|
[ 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 )
|
: map-filter ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) -- ... subseq )
|
||||||
pick map-filter-as ; inline
|
pick map-filter-as ; inline
|
||||||
|
@ -615,4 +615,4 @@ PRIVATE>
|
||||||
'[ _ dip ] assoc-map ; inline
|
'[ _ dip ] assoc-map ; inline
|
||||||
|
|
||||||
: map-values ( assoc quot: ( value -- value' ) -- assoc )
|
: map-values ( assoc quot: ( value -- value' ) -- assoc )
|
||||||
'[ swap _ dip swap ] assoc-map ; inline
|
'[ swap _ dip swap ] assoc-map ; inline
|
||||||
|
|
Loading…
Reference in New Issue