M: end-of-stream cursor-stream-ended? drop t ; inline
!
-! basic iterator
+! basic iterators
!
: -each ( ... begin end quot: ( ... cursor -- ... ) -- ... )
[ '[ dup _ cursor>= ] ]
[ '[ _ keep inc-cursor ] ] bi* until drop ; inline
+: -in- ( quot -- quot' )
+ '[ cursor-value-unsafe @ ] ; inline
+
+: -out- ( quot -- quot' )
+ '[ _ keep set-cursor-value-unsafe ] ; inline
+
+: -out ( ... begin end quot: ( ... cursor -- ... value ) -- ... )
+ -out- -each ; inline
+
!
! numeric cursors
!
MIXIN: container
INSTANCE: container collection
-: -container- ( quot -- quot' )
- '[ cursor-value-unsafe @ ] ; inline
+: in- ( container quot -- begin end quot' )
+ all- -in- ; inline
-: container- ( container quot -- begin end quot' )
- all- -container- ; inline
-
-: each ( ... container quot: ( ... x -- ... ) -- ... ) container- -each ; inline
+: each ( ... container quot: ( ... x -- ... ) -- ... ) in- -each ; inline
INSTANCE: finite-stream-cursor container
M: sequence-cursor set-cursor-value [ n>> ] [ seq>> ] bi set-nth ; inline
!
-! pipe cursor
+! map cursor
!
-TUPLE: pipe-cursor
+TUPLE: map-cursor
{ from read-only }
{ to read-only } ;
-C: <pipe-cursor> pipe-cursor
+C: <map-cursor> map-cursor
+
+INSTANCE: map-cursor forward-cursor
-INSTANCE: pipe-cursor forward-cursor
+M: map-cursor cursor-compatible? [ from>> ] bi@ cursor-compatible? ; inline
+M: map-cursor cursor-valid? [ from>> ] [ to>> ] bi [ cursor-valid? ] both? ; inline
+M: map-cursor cursor= [ from>> ] bi@ cursor= ; inline
+M: map-cursor inc-cursor [ from>> inc-cursor ] [ to>> inc-cursor ] bi <map-cursor> ; inline
-M: pipe-cursor cursor-compatible? [ from>> ] bi@ cursor-compatible? ; inline
-M: pipe-cursor cursor-valid? [ from>> ] [ to>> ] bi [ cursor-valid? ] both? ; inline
-M: pipe-cursor cursor= [ from>> ] bi@ cursor= ; inline
-M: pipe-cursor inc-cursor [ from>> inc-cursor ] [ to>> inc-cursor ] bi <pipe-cursor> ; inline
+INSTANCE: map-cursor output-cursor
-INSTANCE: pipe-cursor output-cursor
+M: map-cursor set-cursor-value-unsafe to>> set-cursor-value-unsafe ; inline
+M: map-cursor set-cursor-value to>> set-cursor-value ; inline
-M: pipe-cursor set-cursor-value-unsafe to>> set-cursor-value-unsafe ; inline
-M: pipe-cursor set-cursor-value to>> set-cursor-value ; inline
+: -map- ( begin end quot to -- begin' end' quot' )
+ swap [ '[ _ <map-cursor> ] bi@ ] dip '[ from>> @ ] ; inline
-: -pipe- ( begin end quot to -- begin' end' quot' )
- swap [ '[ _ <pipe-cursor> ] bi@ ] dip '[ from>> @ ] ; inline
+: -map ( begin end quot to -- begin' end' quot' )
+ -map- -out ; inline
!
! pusher cursor
M: forward-cursor new-sequence-cursor
new-growable-cursor ; inline
-: -into-sequence- ( begin end quot exemplar -- begin' end' quot' result )
- swap [ [ 2dup ] dip new-sequence-cursor ] dip swap [ swap -pipe- ] dip ; inline
+: -into-sequence- ( begin end quot exemplar -- begin' end' quot' cursor result )
+ [ 2over ] dip new-sequence-cursor ; inline
-: -into-growable- ( begin end quot exemplar -- begin' end' quot' result )
- swap [ [ 2dup ] dip new-growable-cursor ] dip swap [ swap -pipe- ] dip ; inline
+: -into-growable- ( begin end quot exemplar -- begin' end' quot' cursor result )
+ [ 2over ] dip new-sequence-cursor ; inline
!
-! map
+! map combinators
!
-: -map- ( quot -- quot' )
- '[ _ keep set-cursor-value-unsafe ] ; inline
-
-: -map ( ... begin end quot: ( ... cursor -- ... value ) -- ... )
- -map- -each ; inline
-
! XXX generalize exemplar
: -map-as ( ... begin end quot: ( ... cursor -- ... value ) exemplar -- ... newseq )
[ -into-sequence- [ -map ] dip ] keep like ; inline
: map! ( ... container quot: ( ... x -- ... newx ) -- ... container )
- [ container- -map ] keep ; inline
+ [ in- -out ] keep ; inline
: map-as ( ... container quot: ( ... x -- ... newx ) exemplar -- ... newseq )
- [ container- ] dip -map-as ; inline
+ [ in- ] dip -map-as ; inline
: map ( ... container quot: ( ... x -- ... newx ) -- ... newcontainer )
over map-as ; inline
: 2all- ( a b quot -- begin end quot )
[ 2all ] dip ; inline
-ALIAS: -2container- -assoc-
+ALIAS: -2in- -assoc-
-: 2container- ( a b quot -- begin end quot' )
- 2all- -2container- ; inline
+: 2in- ( a b quot -- begin end quot' )
+ 2all- -2in- ; inline
: 2each ( ... a b quot: ( ... x y -- ... ) -- ... )
- 2container- -each ; inline
+ 2in- -each ; inline
: 2map-as ( ... a b quot: ( ... x y -- ... z ) exemplar -- ... c )
- [ 2container- ] dip -map-as ; inline
+ [ 2in- ] dip -map-as ; inline
: 2map ( ... a b quot: ( ... x y -- ... z ) -- ... c )
pick 2map-as ; inline
: nall- ( seqs... quot n -- begin end quot ) swap [ nall ] dip ; inline
-MACRO: -ncontainer- ( n -- )
- 1 - [ -unzip- ] n*quot [ -container- ] prepend ;
+MACRO: -nin- ( n -- )
+ 1 - [ -unzip- ] n*quot [ -in- ] prepend ;
-: ncontainer- ( seqs... quot n -- begin end quot ) [ nall- ] [ -ncontainer- ] bi ; inline
+: nin- ( seqs... quot n -- begin end quot ) [ nall- ] [ -nin- ] bi ; inline
-: neach ( seqs... quot n -- ) ncontainer- -each ; inline
+: neach ( seqs... quot n -- ) nin- -each ; inline
: nmap-as ( seqs... quot exemplar n -- newseq )
- swap [ ncontainer- ] dip -map-as ; inline
+ swap [ nin- ] dip -map-as ; inline
: nmap ( seqs... quot n -- newseq )
dup [ npick ] curry [ dip swap ] curry dip nmap-as ; inline