steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

splitting: add split*-when-slice and change to not use make.

db4
John Benediktsson 2013-03-27 16:19:56 -07:00
parent 9341a660a2
commit f285d4db3f
1 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
core/splitting/splitting.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel make math sequences strings sbufs ; USING: arrays kernel math sequences strings sbufs ;
IN: splitting IN: splitting
<PRIVATE <PRIVATE
@ -97,22 +97,25 @@ PRIVATE>
<PRIVATE <PRIVATE
: (split*) ( n seq quot: ( ... elt -- ... ? ) -- ) : (split*) ( n seq quot: ( ... elt -- ... ? ) quot -- )
[ find-from ] pick [
[ [ [ 1 + ] 3dip [ 3dup swapd subseq , ] dip [ drop ] 2dip (split*) ] 3curry ] swap curry [ 1 + ] prepose [ keep 1 + swap ] curry
[ drop [ [ drop ] 2dip 2dup length < [ swap [ tail ] unless-zero , ] [ 2drop ] if ] 2curry ] [ [ find-from drop dup ] 2curry [ dup ] prepose ] dip
3tri if ; inline recursive produce nip
] keep rot over dupd length < [
: split*, ( ... seq quot: ( ... elt -- ... ? ) -- ... ) [ tail ] unless-zero suffix
[ 0 ] 2dip (split*) ; inline ] [ 2drop ] if ; inline
PRIVATE> PRIVATE>
: split* ( seq separators -- pieces )
[ [ member? ] curry split*, ] { } make ; inline
: split*-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces ) : split*-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
[ split*, ] { } make ; inline [ 0 ] 2dip [ subseq ] (split*) ; inline
: split*-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
[ 0 ] 2dip [ <slice> ] (split*) ; inline
: split* ( seq separators -- pieces )
[ member? ] curry split*-when ; inline
GENERIC: string-lines ( str -- seq ) GENERIC: string-lines ( str -- seq )