diff --git a/basis/cocoa/dialogs/dialogs.factor b/basis/cocoa/dialogs/dialogs.factor index 606526a240..662b4a7bae 100644 --- a/basis/cocoa/dialogs/dialogs.factor +++ b/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 [ ] bi@ ; + "/" split1-last [ ] bi@ ; : save-panel ( path -- paths ) dup diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 21e3c05d04..77a9038cd9 100644 --- a/basis/farkup/farkup.factor +++ b/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" ]] diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index d01f0c5548..c0252b2ff4 100644 --- a/basis/regexp/regexp-tests.factor +++ b/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 \ must-infer @@ -350,3 +350,15 @@ IN: regexp-tests [ t ] [ "a:b" ".+:?" matches? ] unit-test [ 1 ] [ "hello" ".+?" 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 diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 32c3695f32..66bc39415b 100644 --- a/basis/regexp/regexp.factor +++ b/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 [ ] [ 3drop f ] if ; : re-cut ( string regexp -- end/f start ) dupd first-match - [ [ second tail-slice ] [ first head ] 2bi ] - [ "" like f swap ] - if* ; + [ split1-slice swap ] [ "" 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- ; diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index c17bccf064..3512b2e4d7 100644 --- a/basis/smtp/smtp.factor +++ b/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 ) [ diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 597cdfdb7f..c0fb1695c3 100644 --- a/basis/urls/urls.factor +++ b/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> diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 25f6f36e7c..17f06a2a50 100644 --- a/core/io/files/files.factor +++ b/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 diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor index 472b303059..354df832ca 100644 --- a/core/splitting/splitting-docs.factor +++ b/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" } } diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor index 0f3dbdea1b..848c570e10 100644 --- a/core/splitting/splitting-tests.factor +++ b/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-+." "-+" last-split1 ] unit-test -[ "goodbye" f ] [ "goodbye" " " last-split1 ] unit-test -[ "" "" ] [ "great" "great" last-split1 ] unit-test +[ "hello world" "." ] [ "hello world ." " " split1-last ] unit-test +[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last ] unit-test +[ "goodbye" f ] [ "goodbye" " " split1-last ] 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 diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index aac32784a1..f2d7593295 100644 --- a/core/splitting/splitting.factor +++ b/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 ) [ ] bi@ split1 [ reverse ] bi@ dup [ swap ] when ; +: split1-last-slice ( seq subseq -- before-slice after-slice ) + [ ] bi@ split1-slice [ ] bi@ + [ f ] [ swap ] if-empty ; + : (split) ( separators n seq -- ) 3dup rot [ member? ] curry find-from drop [ [ swap subseq , ] 2keep 1+ swap (split) ] diff --git a/extra/bake/fry/fry.factor b/extra/bake/fry/fry.factor index b9f9882e88..d82500edba 100644 --- a/extra/bake/fry/fry.factor +++ b/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 \ No newline at end of file +: '[ \ ] [ >quotation ] parse-literal \ fry parsed ; parsing