2009-01-20 16:27:14 -05:00
|
|
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2016-03-13 19:56:23 -04:00
|
|
|
USING: arrays kernel math sbufs sequences sequences.private
|
|
|
|
strings ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: splitting
|
|
|
|
|
2009-02-02 14:43:54 -05:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
: ?chomp ( seq begin tester chopper -- newseq ? )
|
|
|
|
[ [ 2dup ] dip call ] dip
|
|
|
|
[ [ length ] dip call t ] curry
|
|
|
|
[ drop f ] if ; inline
|
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: ?head ( seq begin -- newseq ? )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ head? ] [ tail ] ?chomp ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: ?head-slice ( seq begin -- newseq ? )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ head? ] [ tail-slice ] ?chomp ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: ?tail ( seq end -- newseq ? )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ tail? ] [ head* ] ?chomp ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: ?tail-slice ( seq end -- newseq ? )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ tail? ] [ head-slice* ] ?chomp ;
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
2013-03-31 19:05:30 -04:00
|
|
|
: (split1) ( seq subseq snip-quot -- before after )
|
2009-02-02 14:43:54 -05:00
|
|
|
[
|
|
|
|
swap [
|
2017-06-01 15:45:54 -04:00
|
|
|
[ drop length ] [ subseq-start dup ] 2bi
|
2009-02-02 14:43:54 -05:00
|
|
|
[ [ nip ] [ + ] 2bi t ]
|
|
|
|
[ 2drop f f f ]
|
|
|
|
if
|
|
|
|
] keep swap
|
|
|
|
] dip [ 2nip f ] if ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-02-02 14:43:54 -05:00
|
|
|
PRIVATE>
|
2009-01-20 16:27:14 -05:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: split1 ( seq subseq -- before after )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ snip ] (split1) ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-11-22 20:59:43 -05:00
|
|
|
: split1-slice ( seq subseq -- before-slice after-slice )
|
2009-02-02 14:43:54 -05:00
|
|
|
[ snip-slice ] (split1) ;
|
2008-11-22 20:59:43 -05:00
|
|
|
|
2013-01-03 19:42:34 -05:00
|
|
|
: split-subseq ( seq subseq -- seqs )
|
2013-10-12 19:41:12 -04:00
|
|
|
[
|
|
|
|
1array
|
2013-01-03 19:42:34 -05:00
|
|
|
] [
|
|
|
|
[ dup ] swap [ split1-slice swap ] curry produce nip
|
2013-10-12 19:41:12 -04:00
|
|
|
] if-empty ;
|
2013-01-03 19:42:34 -05:00
|
|
|
|
2013-03-27 19:00:16 -04:00
|
|
|
: replace ( seq old new -- new-seq )
|
|
|
|
pick [ [ split-subseq ] dip ] dip join-as ;
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
2013-03-31 19:05:30 -04:00
|
|
|
: (split1-when) ( ... seq quot: ( ... elt -- ... ? ) snip-quot -- ... before-slice after-slice )
|
2013-03-27 19:00:16 -04:00
|
|
|
[ dupd find drop ] dip [ swap [ dup 1 + ] dip ] prepose [ f ] if* ; inline
|
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2012-04-18 18:55:15 -04:00
|
|
|
: split1-when ( ... seq quot: ( ... elt -- ... ? ) -- ... before after )
|
2013-03-27 19:00:16 -04:00
|
|
|
[ snip ] (split1-when) ; inline
|
|
|
|
|
|
|
|
: split1-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... before-slice after-slice )
|
|
|
|
[ snip-slice ] (split1-when) ; inline
|
2012-04-18 18:55:15 -04:00
|
|
|
|
2008-11-22 20:59:43 -05:00
|
|
|
: split1-last ( seq subseq -- before after )
|
2012-04-27 11:48:57 -04:00
|
|
|
[ <reversed> ] bi@ split1 [ reverse ] bi@
|
2007-09-20 18:09:08 -04:00
|
|
|
dup [ swap ] when ;
|
|
|
|
|
2008-11-22 20:59:43 -05:00
|
|
|
: split1-last-slice ( seq subseq -- before-slice after-slice )
|
|
|
|
[ <reversed> ] bi@ split1-slice [ <reversed> ] bi@
|
|
|
|
[ f ] [ swap ] if-empty ;
|
|
|
|
|
2009-05-25 16:35:50 -04:00
|
|
|
<PRIVATE
|
|
|
|
|
2013-06-25 18:17:00 -04:00
|
|
|
: (split) ( seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
|
|
|
|
[ 0 ] 3dip pick [
|
2013-03-31 19:05:30 -04:00
|
|
|
swap curry [ keep 1 + swap ] curry [
|
|
|
|
[ find-from drop dup ] 2curry [ keep -rot ] curry
|
|
|
|
] dip produce nip
|
|
|
|
] 2keep swap [
|
|
|
|
[ length swapd ] keep
|
|
|
|
] dip 2curry call suffix ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-05-25 16:35:50 -04:00
|
|
|
PRIVATE>
|
|
|
|
|
2011-09-22 20:19:51 -04:00
|
|
|
: split-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
|
2015-07-17 11:00:24 -04:00
|
|
|
[ subseq-unsafe ] (split) ; inline
|
2013-03-27 19:00:16 -04:00
|
|
|
|
|
|
|
: split-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
|
2015-07-17 11:00:24 -04:00
|
|
|
[ <slice-unsafe> ] (split) ; inline
|
2013-03-27 19:00:16 -04:00
|
|
|
|
|
|
|
: split ( seq separators -- pieces )
|
|
|
|
[ member? ] curry split-when ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2013-03-27 19:29:13 -04:00
|
|
|
: split-slice ( seq separators -- pieces )
|
|
|
|
[ member? ] curry split-when-slice ; inline
|
|
|
|
|
2014-11-07 18:34:53 -05:00
|
|
|
: split-indices ( seq indices -- pieces )
|
2015-07-17 11:00:24 -04:00
|
|
|
over length suffix 0 swap [
|
|
|
|
[ pick subseq ] keep swap
|
|
|
|
] map 2nip ;
|
2014-11-07 18:34:53 -05:00
|
|
|
|
2016-04-06 00:16:27 -04:00
|
|
|
! string-lines uses string-nth-fast which is 50% faster over
|
|
|
|
! nth-unsafe. be careful when changing the definition so that
|
|
|
|
! you don't unoptimize it.
|
|
|
|
GENERIC: string-lines ( seq -- seq' )
|
|
|
|
|
|
|
|
M: string string-lines
|
2016-03-13 18:46:04 -04:00
|
|
|
[ V{ } clone 0 ] dip [ 2dup bounds-check? ] [
|
|
|
|
2dup [ "\r\n" member? ] find-from swapd [
|
|
|
|
over [ [ nip length ] keep ] unless
|
2016-04-05 15:21:52 -04:00
|
|
|
[ "" subseq-as suffix! ] 2keep [ 1 + ] dip
|
2016-03-13 18:46:04 -04:00
|
|
|
] dip CHAR: \r eq? [
|
|
|
|
2dup ?nth CHAR: \n eq? [ [ 1 + ] dip ] when
|
|
|
|
] when
|
2016-04-06 00:16:27 -04:00
|
|
|
] while 2drop { } like ;
|
|
|
|
|
|
|
|
M: sbuf string-lines "" like string-lines ;
|