factor: trim some using lists

[factor.git] / extra / modern / slices / slices.factor

diff --git a/extra/modern/slices/slices.factor b/extra/modern/slices/slices.factor
index 93a3970ce9a897356989c1c38bb376ac4b49b39f..8d3d9da8d0b3f27b4b97efc634469738baddc1cc 100644 (file)
--- a/extra/modern/slices/slices.factor
+++ b/extra/modern/slices/slices.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2016 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math sequences sequences.deep
-sequences.extras strings unicode ;
+USING: accessors assocs combinators.extras kernel math sequences
+sequences.deep sequences.extras strings unicode ;
 IN: modern.slices
 
 : >strings ( seq -- str )
@@ -43,29 +43,14 @@ ERROR: unexpected-end n string ;
     over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
 
 ! Allow eof
-: next-char-from ( n/f string -- n'/f string ch/f )
+: take-char ( n/f string -- n'/f string ch/f )
     over [
         2dup ?nth [ [ 1 + ] 2dip ] [ f ] if*
     ] [
-        [ 2drop f ] [ nip ] 2bi f
+        f
     ] if ;
 
-: prev-char-from-slice-end ( slice -- ch/f )
-    [ to>> 2 - ] [ seq>> ] bi ?nth ;
-
-: prev-char-from-slice ( slice -- ch/f )
-    [ from>> 1 - ] [ seq>> ] bi ?nth ;
-
-: next-char-from-slice ( slice -- ch/f )
-    [ to>> ] [ seq>> ] bi ?nth ;
-
-: char-before-slice ( slice -- ch/f )
-    [ from>> 1 - ] [ seq>> ] bi ?nth ;
-
-: char-after-slice ( slice -- ch/f )
-    [ to>> ] [ seq>> ] bi ?nth ;
-
-: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
+: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f elt ? )
     [ find-from ] keepd
     pick [ drop t ] [ length -rot nip f ] if ; inline
 
@@ -93,12 +78,10 @@ ERROR: expected-sequence-error expected actual ;
     2dup [ >lower ] bi@ sequence= [ nip ] [ expected-sequence-error ] if ;
 
 : expect-and-span ( n string slice expected-string -- n' string slice' )
-    dup length '[ _ take-slice ] 2dip
-    rot check-sequence span-slices ;
+    dup length '[ _ take-slice ] 2dip-1up check-sequence span-slices ;
 
 : expect-and-span-insensitive ( n string slice expected-string -- n' string slice' )
-    dup length '[ _ take-slice ] 2dip
-    rot check-sequence-insensitive span-slices ;
+    dup length '[ _ take-slice ] 2dip-1up check-sequence-insensitive span-slices ;
 
 :: split-slice-back ( slice n -- slice1 slice2 )
     slice [ from>> ] [ to>> ] [ seq>> ] tri :> ( from to seq )
@@ -141,9 +124,6 @@ ERROR: expected-sequence-error expected actual ;
 : empty-slice-end ( seq -- slice )
     [ length dup ] [ ] bi <slice> ; inline
 
-: empty-slice-from ( n seq -- slice )
-    dupd <slice> ; inline
-
 :: slice-til-eol ( n string -- n' string slice/f ch/f )
     n [
         n string '[ "\r\n" member? ] find-from :> ( n' ch )
@@ -154,24 +134,11 @@ ERROR: expected-sequence-error expected actual ;
         n string string empty-slice-end f
     ] if ; inline
 
-:: merge-slice-til-eol-slash'' ( n string -- n' string slice/f ch/f )
-    n [
-        n string '[ "\r\n\\" member? ] find-from :> ( n' ch )
-        n' string
-        n n' string ?<slice>
-        ch
-    ] [
-        n string string empty-slice-end f
-    ] if ; inline
-
-: merge-slice-til-whitespace ( n string slice --  n' string slice' )
+: merge-slice-til-whitespace ( n/f string slice --  n'/f string slice' )
     pick [
         [ slice-til-whitespace drop ] dip merge-slices
     ] when ;
 
-: merge-slice-til-eol ( n string slice --  n' string slice' )
-    [ slice-til-eol drop ] dip merge-slices ;
-
 : slice-between ( slice1 slice2 -- slice )
     ! ensure-same-underlying
     slice-order-by-from
@@ -181,25 +148,6 @@ ERROR: expected-sequence-error expected actual ;
 : slice-before ( slice -- slice' )
     [ drop 0 ] [ from>> ] [ seq>> ] tri <slice> ;
 
-: (?nth) ( n/f string/f -- obj/f )
-    over [ (?nth) ] [ 2drop f ] if ;
-
-:: merge-slice-til-eol-slash' ( n string slice -- n' string slice/f ch/f )
-    n string merge-slice-til-eol-slash'' :> ( n' string' slice' ch' )
-    ch' CHAR: \\ = [
-        n' 1 + string' (?nth) "\r\n" member? [
-            n' 2 + string' slice slice' span-slices merge-slice-til-eol-slash'
-        ] [
-            "omg" throw
-        ] if
-    ] [
-        n' string' slice slice' span-slices ch'
-    ] if ;
-
-! Supports \ at eol (with no space after it)
-: slice-til-eol-slash ( n string -- n' string slice/f ch/f )
-    2dup empty-slice-from merge-slice-til-eol-slash' ;
-
 :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f )
     n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip  :> ( n' ch )
     n' string
@@ -233,9 +181,9 @@ ERROR: expected-sequence-error expected actual ;
 ERROR: subseq-expected-but-got-eof n string expected ;
 
 :: slice-til-string ( n string search --  n' string payload end-string )
-    search string n subseq-start-from :> n'
+    n string search subseq-index-from :> n'
     n' [ n string search subseq-expected-but-got-eof ] unless
-    n' search length +  string
+    n' search length + string
     n n' string ?<slice>
     n' dup search length + string ?<slice> ;
 
@@ -243,16 +191,47 @@ ERROR: subseq-expected-but-got-eof n string expected ;
     '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;
 
 : modify-to ( slice n -- slice' )
-    [ [ from>> ] [ to>> ] [ seq>> ] tri ] dip
-    swap [ + ] dip <slice> ;
+    [ from>> ] swap '[ to>> _ + ] [ seq>> ] tri <slice> ; inline
 
 ! { CHAR: \] [ read-closing ] }
 ! { CHAR: \} [ read-closing ] }
 ! { CHAR: \) [ read-closing ] }
-: read-closing ( n string tok -- n string tok )
+: read-closing ( n string tok -- n' string tok )
     dup length 1 = [
-        -1 modify-to [ 1 - ] 2dip
+        -1 modify-to
+        [ 1 - ] 2dip
     ] unless ;
 
 : rewind-slice ( n string slice -- n' string )
-    2nip [ from>> ] [ seq>> ] bi ; inline
\ No newline at end of file
+    2nip [ from>> ] [ seq>> ] bi ; inline
+
+:: take-from? ( n seq subseq -- n'/f seq ? )
+    n seq subseq subseq-starts-at? [
+        n subseq length +
+        seq
+        t
+    ] [
+        n seq f
+    ] if ;
+
+: check-slice? ( from to seq -- from to seq ? )
+    pick 0 < [
+        f
+    ] [
+        2dup length > [
+            f
+        ] [
+            t
+        ] if
+    ] if ; inline
+
+:: take-from-insensitive? ( n seq str -- n'/f seq ? )
+    n str length over + seq check-slice? [
+        subseq str [ >lower ] bi@ sequence= [
+            n str length + seq t
+        ] [
+            n seq f
+        ] if
+    ] [
+        3drop n seq f
+    ] if ;