]> gitweb.factorcode.org Git - factor.git/commitdiff
core: Better names for (each) etc
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 22 Jul 2022 14:56:48 +0000 (09:56 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 31 Jul 2022 18:24:58 +0000 (13:24 -0500)
basis/grouping/grouping.factor
basis/math/matrices/matrices.factor
core/growable/growable.factor
core/io/streams/sequence/sequence.factor
core/sequences/sequences.factor
extra/sequences/extras/extras.factor

index 43916ab8d9a4a2adc48e6763b03fdcbe42c2e5cf..5da027efd671c241a1140fe3b6a34f823921503c 100644 (file)
@@ -74,8 +74,10 @@ PRIVATE>
         2 = [
             [ first2-unsafe ] dip call
         ] [
-            [ [ first-unsafe 1 ] [ setup-each [ + ] 2dip ] bi ] dip
-            '[ @ _ keep swap ] all-integers-from? nip
+            [
+                [ first-unsafe ]
+                [ >range-iterator< [ nth-unsafe ] curry [ 1 + ] 2dip ] bi
+            ] dip '[ @ _ keep swap ] all-integers-from? nip
         ] if
     ] if ; inline
 
index cfbee2962cc5b7a92314ea57908036f80d6d72dc..68dbd7c97dffe5b8288872eb365fa2322771d58b 100644 (file)
@@ -122,7 +122,7 @@ ALIAS: transpose flip
 
 : unshaped-cols-iota ( matrix -- cols-iota )
   [ first-unsafe length ] keep
-  [ length min ] 1 (each-from) each-integer-from <iota> ; inline
+  [ length min ] 1 sequence-iterator-from each-integer-from <iota> ; inline
 
 : generic-anti-transpose-unsafe ( cols-iota matrix -- newmatrix )
     [ <reversed> [ nth-end-unsafe ] with { } map-as ] curry { } map-as ; inline
index f2662ddfe74db5a52b2143f491879729ccd39c90..c248aff20890a574dbd7ff96f7a9b4d009423099 100644 (file)
@@ -21,7 +21,7 @@ M: growable set-nth-unsafe underlying>> set-nth-unsafe ; inline
 
 : push-all-unsafe ( from to src dst -- )
     [ over - swap ] 2dip pickd [ length integer>fixnum-strict ] keep
-    [ [ fixnum+fast ] dip length<< ] 2keep <copy> (copy) drop ; inline
+    [ [ fixnum+fast ] dip length<< ] 2keep <copier> (copy) drop ; inline
 
 PRIVATE>
 
index 461df22cd90b43c20148c91851d2908d824353a2..8326e25a8ab9f56a88c32b920f9781dfd3fc5aba 100644 (file)
@@ -21,7 +21,7 @@ SLOT: i
     [ underlying>> length ] [ i>> ] bi - rot min ; inline
 
 : <sequence-copy> ( dst n src-i src dst-i -- n copy )
-    [ ] curry 3curry dip <copy> ; inline
+    [ ] curry 3curry dip <copier> ; inline
 
 : sequence-copy-unsafe ( n buf stream offset -- count )
     [
index 1891149396dd92c96a934096078dda1e38272dd4..a7b77133794482d7d14a7489fe8b1543325de5ea 100644 (file)
@@ -218,6 +218,9 @@ TUPLE: slice
     { to integer read-only }
     { seq read-only } ;
 
+: >slice< ( slice -- from to seq )
+    [ from>> ] [ to>> ] [ seq>> ] tri ; inline
+
 : collapse-slice ( m n slice -- m' n' seq )
     [ from>> ] [ seq>> ] bi [ [ + ] curry bi@ ] dip ; inline
 
@@ -282,13 +285,22 @@ ERROR: integer-length-expected obj ;
 : check-length ( n -- n )
     dup integer? [ integer-length-expected ] unless ; inline
 
-TUPLE: copy-state
+: >sequence< ( seq -- i n seq )
+    [ drop 0 ] [ length check-length ] [ ] tri ; inline
+
+: length-sequence ( seq -- n seq )
+    [ length check-length ] [ ] bi ; inline
+
+: >range-iterator< ( slice/seq -- i n slice/seq )
+    dup slice? [ >slice< ] [ >sequence< ] if ; inline
+
+TUPLE: copier
     { src-i integer read-only }
     { src read-only }
     { dst-i integer read-only }
     { dst read-only } ;
 
-C: <copy> copy-state
+C: <copier> copier
 
 : copy-nth-unsafe ( n copy -- )
     [ [ src-i>> + ] [ src>> ] bi nth-unsafe ]
@@ -301,7 +313,7 @@ C: <copy> copy-state
 
 : subseq>copy ( from to seq -- n copy )
     [ over - check-length swap ] dip
-    3dup nip new-sequence 0 swap <copy> ; inline
+    3dup nip new-sequence 0 swap <copier> ; inline
 
 : bounds-check-head ( n seq -- n seq )
     over 0 < [ bounds-error ] when ; inline
@@ -311,7 +323,7 @@ C: <copy> copy-state
     [ swap length + ] dip lengthen ; inline
 
 : copy-unsafe ( src i dst -- )
-    [ [ length check-length 0 ] keep ] 2dip <copy> (copy) drop ; inline
+    [ [ length check-length 0 ] keep ] 2dip <copier> (copy) drop ; inline
 
 : subseq-unsafe-as ( from to seq exemplar -- subseq )
     [ subseq>copy (copy) ] dip like ; inline
@@ -397,36 +409,28 @@ PRIVATE>
 
 <PRIVATE
 
-: setup-each ( seq -- i n quot )
-    dup slice? [
-        [ from>> ] [ to>> ] [ seq>> ] tri
-    ] [
-        [ length check-length 0 swap ] keep
-    ] if [ nth-unsafe ] curry ; inline
+: sequence-iterator ( seq quot -- i n quot' )
+    [ >range-iterator< [ nth-unsafe ] curry ] dip compose ; inline
 
-: (each) ( seq quot -- i n quot' )
-    [ setup-each ] dip compose ; inline
+! setup-1each
+: length-iterator ( seq quot -- n quot' )
+    length-sequence [ nth-unsafe ] curry ; inline
 
-: (each-from) ( seq quot i -- i n quot' )
-    [ (each) ] dip [ + ] curry 2dip ; inline
+! (1each)
+: length-operator ( seq quot -- n quot' )
+    [ length-iterator ] dip compose ; inline
 
-: (collect) ( quot into -- quot' )
-    [ [ keep ] dip set-nth-unsafe ] 2curry ; inline
+: sequence-iterator-from ( seq quot i -- i n quot' )
+    -rot length-operator ; inline
 
 : collect ( n quot into -- )
-    (collect) each-integer ; inline
-
-: setup-1each ( seq -- n quot )
-    [ length check-length ] keep [ nth-unsafe ] curry ; inline
-
-: (1each) ( seq quot -- n quot' )
-    [ setup-1each ] dip compose ; inline
+    [ [ keep ] dip set-nth-unsafe ] 2curry each-integer ; inline
 
-: (each-index) ( seq quot -- n quot' )
-    [ setup-1each [ keep ] curry ] dip compose ; inline
+: sequence-index-iterator ( seq quot -- n quot' )
+    [ length-iterator [ keep ] curry ] dip compose ; inline
 
 : map-into ( seq quot into -- )
-    [ (1each) ] dip collect ; inline
+    [ length-operator ] dip collect ; inline
 
 : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
     [ nth-unsafe ] bi-curry@ bi ; inline
@@ -451,14 +455,14 @@ PRIVATE>
     over [ dupd nth-unsafe ] [ drop f ] if ; inline
 
 : (find) ( seq quot quot' -- i elt )
-    pick [ [ (1each) ] dip call ] dip finish-find ; inline
+    pick [ [ length-operator ] dip call ] dip finish-find ; inline
 
 : (find-from) ( n seq quot quot' -- i elt )
     [ 2dup bounds-check? ] 2dip
     '[ _ _ (find) ] [ 2drop f f ] if ; inline
 
 : (find-index) ( seq quot quot' -- i elt )
-    pick [ [ (each-index) ] dip call ] dip finish-find ; inline
+    pick [ [ sequence-index-iterator ] dip call ] dip finish-find ; inline
 
 : (find-index-from) ( n seq quot quot' -- i elt )
     [ 2dup bounds-check? ] 2dip
@@ -473,10 +477,10 @@ PRIVATE>
 PRIVATE>
 
 : each ( ... seq quot: ( ... x -- ... ) -- ... )
-    (each) each-integer-from ; inline
+    sequence-iterator each-integer-from ; inline
 
 : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-    (each-from) each-integer-from ; inline
+    sequence-iterator-from each-integer-from ; inline
 
 : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result )
     swapd each ; inline
@@ -485,7 +489,7 @@ PRIVATE>
     overd [ [ collect ] keep ] new-like ; inline
 
 : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
-    [ (1each) ] dip map-integers ; inline
+    [ length-operator ] dip map-integers ; inline
 
 : map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     over map-as ; inline
@@ -566,7 +570,7 @@ PRIVATE>
     [ find-integer ] (find-index) ; inline
 
 : all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? )
-    (each) all-integers-from? ; inline
+    sequence-iterator all-integers-from? ; inline
 
 : push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
@@ -627,7 +631,7 @@ PRIVATE>
     [ dup ] swap [ keep ] curry produce nip ; inline
 
 : each-index ( ... seq quot: ( ... elt index -- ... ) -- ... )
-    (each-index) each-integer ; inline
+    sequence-index-iterator each-integer ; inline
 
 : map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
     [ dup length <iota> ] 2dip 2map-as ; inline
index 334f352638b644641614146b6fba3c7d2eb40a82..830dedb9971cea5c9dbe0e2e8df9e0778f7caa7b 100644 (file)
@@ -384,7 +384,7 @@ PRIVATE>
     ] [ 3drop f ] if ; inline
 
 : map-index! ( ... seq quot: ( ... elt index -- ... newelt ) -- ... seq )
-    over [ [ (each-index) ] dip collect ] keep ; inline
+    over [ [ sequence-index-iterator ] dip collect ] keep ; inline
 
 <PRIVATE
 
@@ -598,7 +598,7 @@ PRIVATE>
     [ length 1 - swap - ] [ nth ] bi ; inline
 
 : each-index-from ( ... seq quot: ( ... elt index -- ... ) i -- ... )
-    -rot (each-index) each-integer-from ; inline
+    -rot sequence-index-iterator each-integer-from ; inline
 
 <PRIVATE