]> gitweb.factorcode.org Git - factor.git/commitdiff
cursors: some refactoring:
authorJoe Groff <arcata@gmail.com>
Thu, 25 Mar 2010 01:05:41 +0000 (18:05 -0700)
committerJoe Groff <arcata@gmail.com>
Thu, 25 Mar 2010 01:05:41 +0000 (18:05 -0700)
- rename -container- to -in-
- rename current -map- to -out-
- rename "pipe-cursor" to "map-cursor"
- have -map- and -map take the "to" cursor

extra/cursors/cursors.factor

index 750540844a8085264752ca97ca603f72c8272a81..a82f0e28a08d8680eb5e98ae9acbb46bdc2b4ebd 100644 (file)
@@ -118,13 +118,22 @@ M: end-of-stream inc-cursor ; inline
 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
 !
@@ -217,13 +226,10 @@ GENERIC: end-cursor ( collection -- cursor )
 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
 
@@ -278,28 +284,31 @@ M: sequence-cursor set-cursor-value-unsafe [ n>> ] [ seq>> ] bi set-nth-unsafe ;
 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
@@ -328,30 +337,24 @@ M: random-access-cursor new-sequence-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
 
@@ -480,16 +483,16 @@ M: zip-cursor cursor-key-value
 : 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 
@@ -507,14 +510,14 @@ MACRO: nzip-cursors ( n -- ) 1 - [ zip-cursors ] n*quot ;
 
 : 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