extra/splitting/extras/extras.factor

   1 USING: hints kernel math sequences sequences.private strings ;
   2 IN: splitting.extras
   3
   4 <PRIVATE
   5
   6 : (split*) ( seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
   7     [ 0 ] 3dip pick [
   8         swap curry [ [ 1 + ] when ] prepose [ 2keep ] curry
   9         [ 2dup = ] prepose [ [ 1 + ] when swap ] compose [
  10             [ find-from drop dup ] 2curry [ keep -rot ] curry
  11         ] dip produce nip
  12     ] 2keep swap [
  13         [ length [ swapd dupd < ] keep ] keep
  14     ] dip 2curry [ suffix ] compose [ drop ] if ; inline
  15
  16 PRIVATE>
  17
  18 : split*-when ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
  19     [ subseq ] (split*) ; inline
  20
  21 : split*-when-slice ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
  22     [ <slice> ] (split*) ; inline
  23
  24 : split* ( seq separators -- pieces )
  25     [ member? ] curry split*-when ; inline
  26
  27 : split*-slice ( seq separators -- pieces )
  28     [ member? ] curry split*-when-slice ; inline
  29
  30 : split-find ( seq quot: ( seq -- i ) -- pieces )
  31     [ dup empty? not ] swap [ [ dup ] ] dip
  32     [ [ [ 1 ] when-zero cut-slice swap ] [ f swap ] if* ] compose
  33     compose produce nip ; inline
  34
  35 : split-head ( seq quot -- before after )
  36     (trim-head) cut ; inline
  37
  38 : split-tail ( seq quot -- before after )
  39     (trim-tail) cut ; inline
  40
  41 : split-head-slice ( seq quot -- before after )
  42     (trim-head) cut-slice ; inline
  43
  44 : split-tail-slice ( seq quot -- before after )
  45     (trim-tail) cut-slice ; inline
  46
  47 <PRIVATE
  48
  49 :: (split-harvest) ( seq quot: ( ... elt -- ... ? ) slice-quot -- pieces )
  50     seq [ quot call not ] find drop [
  51         [
  52             [ seq quot find-from drop ] keep swap
  53             [ seq length ] unless* dup
  54         ] [ f f f ] if*
  55     ] [
  56         [ seq slice-quot call ] keep swap
  57         [ 1 + seq [ quot call not ] find-from drop ] dip
  58     ] produce 2nip ; inline
  59
  60 PRIVATE>
  61
  62 : split-when-harvest ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
  63     [ subseq ] (split-harvest) ; inline
  64
  65 : split-when-slice-harvest ( ... seq quot: ( ... elt -- ... ? ) -- ... pieces )
  66     [ <slice> ] (split-harvest) ; inline
  67
  68 : split-harvest ( seq separators -- pieces )
  69     [ member? ] curry split-when-harvest ; inline
  70
  71 { split* split*-slice split-harvest }
  72 [ { string string } set-specializer ] each