cursors2: Different implementation and add filter

I'm going to delete this vocab for now because it's not done and I did not mean to commit it to master.

diff --git a/extra/cursors2/cursors2.factor b/extra/cursors2/cursors2.factor
index c557879b1e84dece93d74a8dc172bc6cc178f06b..88b9bbb5a8a0f16bec7dea4ebe47a3d943ecc65b 100644 (file)
--- a/extra/cursors2/cursors2.factor
+++ b/extra/cursors2/cursors2.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2021 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays constructors growable kernel math
-sequences vectors ;
+multiline sequences vectors ;
 IN: cursors2
 
 TUPLE: cursor ;
@@ -11,8 +11,8 @@ CONSTRUCTOR: <sequence-input-cursor> sequence-input-cursor ( seq n -- obj ) ;
 TUPLE: sequence-output-cursor < cursor seq n ;
 CONSTRUCTOR: <sequence-output-cursor> sequence-output-cursor ( seq n -- obj ) ;
 
-TUPLE: mapping-cursor < cursor input output ;
-CONSTRUCTOR: <mapping-cursor> mapping-cursor ( input output -- obj ) ;
+TUPLE: mapping-cursor < cursor output input ;
+CONSTRUCTOR: <mapping-cursor> mapping-cursor ( output input -- obj ) ;
 
 TUPLE: alist-cusor < cursor alist n ;
 
@@ -48,7 +48,7 @@ M: vector >input-cursor 0 <sequence-input-cursor> ;
 
 
 : input>mapping-cursor ( input-cursor -- mapping-cursor )
-    >input-cursor dup input>output-cursor <mapping-cursor> ;
+    >input-cursor [ input>output-cursor ] keep <mapping-cursor> ;
 
 
 : (find2) ( cursor quot: ( cursor obj -- ? ) -- cursor/f elt/f ? )
@@ -63,10 +63,28 @@ M: vector >input-cursor 0 <sequence-input-cursor> ;
     [ >input-cursor ] dip (find2) ; inline
 
 
+
+: each-cursor-advance ( cursor elt quot: ( cursor elt -- ) -- )
+    [ call ] 3keep nip
+    [ cursor-inc-input ] dip ; inline
+
+: mapping-cursor-advance ( cursor elt quot: ( cursor elt -- out ) -- mapping-cursor' quot )
+    [ call ] 3keep nip
+    [
+        [ output>> cursor-put ] [ input>> cursor-inc-input ] bi <mapping-cursor>
+    ] dip ; inline
+
+: filter-cursor-advance ( cursor elt quot: ( cursor elt -- ? ) -- mapping-cursor' quot )
+    [ call ] 3keep
+    [
+        swapd
+        '[ _ [ _ swap output>> cursor-put ] [ output>> ] if ]
+        [ input>> cursor-inc-input ] bi <mapping-cursor>
+    ] dip ; inline
+
 : (each2) ( cursor quot: ( cursor obj -- ) -- )
     over cursor-at [
-        [ swap call ] 3keep drop
-        [ cursor-inc-input ] dip (each2)
+        swap each-cursor-advance (each2)
     ] [
         3drop
     ] if ; inline recursive
@@ -77,11 +95,21 @@ M: vector >input-cursor 0 <sequence-input-cursor> ;
 
 : (map2) ( cursor quot: ( cursor obj -- obj' ) -- out )
     over input>> cursor-at [
-        [ swap call ] 3keep drop
-        [ [ cursor-put ] change-output [ cursor-inc-input ] change-input ] dip (map2)
+        swap mapping-cursor-advance (map2)
     ] [
         2drop output>>
     ] if ; inline recursive
 
 : map2 ( obj quot -- obj' )
     [ input>mapping-cursor ] dip (map2) ; inline
+
+
+: (filter2) ( cursor quot: ( cursor obj -- obj' ) -- out )
+    over input>> cursor-at [
+        swap filter-cursor-advance (filter2)
+    ] [
+        2drop output>>
+    ] if ; inline recursive
+
+: filter2 ( obj quot -- obj' )
+    [ input>mapping-cursor ] dip (filter2) ; inline