Merge branch 'master' of git://factorcode.org/git/factor

basis/cocoa/dialogs/dialogs.factor

@@ -26,7 +26,7 @@ IN: cocoa.dialogs
     [ -> filenames CF>string-array ] [ drop f ] if ;
 
 : split-path ( path -- dir file )
-    "/" last-split1 [ <NSString> ] bi@ ;
+    "/" split1-last [ <NSString> ] bi@ ;
 
 : save-panel ( path -- paths )
     <NSSavePanel> dup

basis/farkup/farkup.factor

@@ -36,7 +36,7 @@ TUPLE: line-break ;
     { "http://" "https://" "ftp://" } [ head? ] with contains? ;
 
 : simple-link-title ( string -- string' )
-    dup absolute-url? [ "/" last-split1 swap or ] unless ;
+    dup absolute-url? [ "/" split1-last swap or ] unless ;
 
 EBNF: parse-farkup
 nl               = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]

basis/regexp/regexp-tests.factor

@@ -1,5 +1,5 @@
 USING: regexp tools.test kernel sequences regexp.parser
-regexp.traversal eval ;
+regexp.traversal eval strings ;
 IN: regexp-tests
 
 \ <regexp> must-infer
@@ -350,3 +350,15 @@ IN: regexp-tests
 [ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
 
 [ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
+
+[ { "1" "2" "3" "4" } ]
+[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
+
+[ { "1" "2" "3" "4" } ]
+[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
+
+[ { "ABC" "DEF" "GHI" } ]
+[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matches [ >string ] map ] unit-test
+
+[ "1.2.3.4" ]
+[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test

basis/regexp/regexp.factor

@@ -3,7 +3,7 @@
 USING: accessors combinators kernel math sequences
 sets assocs prettyprint.backend make lexer namespaces parser
 arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
-regexp.dfa regexp.traversal regexp.transition-tables ;
+regexp.dfa regexp.traversal regexp.transition-tables splitting ;
 IN: regexp
 
 : default-regexp ( string -- regexp )
@@ -52,27 +52,25 @@ IN: regexp
         [ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
     ] if ;
 
-: first-match ( string regexp -- pair/f )
+: first-match ( string regexp -- slice/f )
     dupd 0 swap match-range rot over [ <slice> ] [ 3drop f ] if ;
 
 : re-cut ( string regexp -- end/f start )
     dupd first-match
-    [ [ second tail-slice ] [ first head ] 2bi ]
+    [ split1-slice swap ] [ "" like f swap ] if* ;
-    [ "" like f swap ]
-    if* ;
 
 : re-split ( string regexp -- seq )
-    [ dup ] swap '[ _ re-cut ] [ ] produce nip ;
+    [ dup length 0 > ] swap '[ _ re-cut ] [ ] produce nip ;
 
 : re-replace ( string regexp replacement -- result )
     [ re-split ] dip join ;
 
 : next-match ( string regexp -- end/f match/f )
     dupd first-match dup
-    [ [ length 1+ tail-slice ] keep ] [ 2drop f f ] if ;
+    [ [ split1-slice nip ] keep ] [ 2drop f f ] if ;
 
 : all-matches ( string regexp -- seq )
-    [ dup ] swap '[ _ next-match ] [ ] produce nip ;
+    [ dup ] swap '[ _ next-match ] [ ] produce nip harvest ;
 
 : count-matches ( string regexp -- n )
     all-matches length 1- ;

basis/smtp/smtp.factor

@@ -153,7 +153,7 @@ ERROR: invalid-header-string string ;
 
 : extract-email ( recepient -- email )
     ! This could be much smarter.
-    " " last-split1 swap or "<" ?head drop ">" ?tail drop ;
+    " " split1-last swap or "<" ?head drop ">" ?tail drop ;
 
 : email>headers ( email -- hashtable )
     [

basis/urls/urls.factor

@@ -132,7 +132,7 @@ M: url present
         { [ dup empty? ] [ drop ] }
         { [ over "/" tail? ] [ append ] }
         { [ "/" pick start not ] [ nip ] }
-        [ [ "/" last-split1 drop "/" ] dip 3append ]
+        [ [ "/" split1-last drop "/" ] dip 3append ]
     } cond ;
 
 PRIVATE>

core/io/files/files.factor

@@ -150,7 +150,7 @@ PRIVATE>
     ] unless ;
 
 : file-extension ( filename -- extension )
-    "." last-split1 nip ;
+    "." split1-last nip ;
 
 ! File info
 TUPLE: file-info type size permissions created modified

core/splitting/splitting-docs.factor

@@ -8,6 +8,9 @@ ARTICLE: "sequences-split" "Splitting sequences"
 { $subsection ?tail }
 { $subsection ?tail-slice }
 { $subsection split1 }
+{ $subsection split1-slice }
+{ $subsection split1-last }
+{ $subsection split1-last-slice }
 { $subsection split }
 "Splitting a string into lines:"
 { $subsection string-lines } ;
@@ -18,11 +21,19 @@ HELP: split1
 { $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
 { $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
 
-HELP: last-split1
+HELP: split1-slice
+{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
+{ $description "Splits " { $snippet "seq" } " at the first occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
+
+HELP: split1-last
 { $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before" "a new sequence" } { "after" "a new sequence" } }
 { $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
 
-{ split1 last-split1 } related-words
+HELP: split1-last-slice
+{ $values { "seq" "a sequence" } { "subseq" "a sequence" } { "before-slice" slice } { "after-slice" slice } }
+{ $description "Splits " { $snippet "seq" } " at the last occurrence of " { $snippet "subseq" } ", and outputs the pieces before and after the split as slices. If " { $snippet "subseq" } " does not occur in " { $snippet "seq" } ", then " { $snippet "before" } " is just " { $snippet "seq" } " and " { $snippet "after" } " is " { $link f } "." } ;
+
+{ split1 split1-slice split1-last split1-last-slice } related-words
 
 HELP: split
 { $values { "seq" "a sequence" } { "separators" "a sequence" } { "pieces" "a new array" } }

core/splitting/splitting-tests.factor

@@ -6,10 +6,15 @@ IN: splitting.tests
 [ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
 [ "" "" ] [ "great" "great" split1 ] unit-test
 
-[ "hello world" "." ] [ "hello world ." " " last-split1 ] unit-test
+[ "hello world" "." ] [ "hello world ." " " split1-last ] unit-test
-[ "hello-+world" "." ] [ "hello-+world-+." "-+" last-split1 ] unit-test
+[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last ] unit-test
-[ "goodbye" f ] [ "goodbye" " " last-split1 ] unit-test
+[ "goodbye" f ] [ "goodbye" " " split1-last ] unit-test
-[ "" "" ] [ "great" "great" last-split1 ] unit-test
+[ "" "" ] [ "great" "great" split1-last ] unit-test
+
+[ "hello world" "." ] [ "hello world ." " " split1-last-slice [ >string ] bi@ ] unit-test
+[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last-slice [ >string ] bi@ ] unit-test
+[ "goodbye" f ] [ "goodbye" " " split1-last-slice [ dup [ >string ] when ] bi@ ] unit-test
+[ "" "" ] [ "great" "great" split1-last-slice [ >string ] bi@ ] unit-test
 
 [ "and end" t ] [ "Beginning and end" "Beginning " ?head ] unit-test
 [ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?head ] unit-test

core/splitting/splitting.factor

@@ -23,10 +23,21 @@ IN: splitting
         2drop f
     ] if ;
 
-: last-split1 ( seq subseq -- before after )
+: split1-slice ( seq subseq -- before-slice after-slice )
+    dup pick start dup [
+        [ >r over r> head-slice -rot length ] keep + tail-slice
+    ] [
+        2drop f
+    ] if ;
+
+: split1-last ( seq subseq -- before after )
     [ <reversed> ] bi@ split1 [ reverse ] bi@
     dup [ swap ] when ;
 
+: split1-last-slice ( seq subseq -- before-slice after-slice )
+    [ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
+    [ f ] [ swap ] if-empty ;
+
 : (split) ( separators n seq -- )
     3dup rot [ member? ] curry find-from drop
     [ [ swap subseq , ] 2keep 1+ swap (split) ]

extra/bake/fry/fry.factor

@@ -44,7 +44,7 @@ DEFER: shallow-fry
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : deep-fry ( quot -- quot )
-  { _ } last-split1 dup
+  { _ } split1-last dup
     [
       shallow-fry [ >r ] rot
       deep-fry    [ [ dip ] curry r> compose ] 4array concat
@@ -77,4 +77,4 @@ DEFER: shallow-fry
 
 MACRO: fry ( seq -- quot ) [fry] ;
 
-: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing
+: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing