libs/sequences.factor

   1 USING: kernel math sequences strings ;
   2 IN: sequences-contrib
   3
   4 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   5
   6 : 3nth ( n seq -- slice ) >r dup 3 + r> <slice> ;
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 : map3-i ( seq -- i ) length 2 - ;
  11
  12 : map3-quot ( quot -- quot ) [ swap 3nth ] swap append ;
  13
  14 : map3 ( seq quot -- seq ) over map3-i swap map3-quot map-with ;
  15
  16 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  17
  18 : (rtrim*) ( seq quot -- newseq )
  19     over length 0 > [
  20         2dup >r peek r> call
  21         [ >r dup length 1- head-slice r> (rtrim*) ] [ drop ] if
  22     ] [
  23         drop
  24     ] if ;
  25 : rtrim* ( seq quot -- newseq ) [ (rtrim*) ] 2keep drop like ;
  26 : rtrim ( seq -- newseq ) [ blank? ] rtrim* ;
  27
  28 : (ltrim*) ( seq quot -- newseq )
  29     over length 0 > [
  30         2dup >r first r> call [ >r 1 tail-slice r> (ltrim*) ] [ drop ] if
  31     ] [
  32         drop
  33     ] if ;
  34 : ltrim* ( seq quot -- newseq ) [ (ltrim*) ] 2keep drop like ;
  35 : ltrim ( seq -- newseq ) [ blank? ] ltrim* ;
  36
  37 : trim* ( seq quot -- newseq ) [ (ltrim*) ] keep rtrim* ;
  38 : trim ( seq -- newseq ) [ blank? ] trim* ;
  39
  40 : ?head-slice ( seq begin -- newseq ? )
  41   2dup head? [ length tail-slice t ] [ drop f ] if ;
  42
  43 : ?tail-slice ( seq end -- newseq ? )
  44   2dup tail? [ length head-slice* t ] [ drop f ] if ;
  45
  46 : unclip-slice ( seq -- rest first )
  47   dup 1 tail-slice swap first ;
  48
  49 PROVIDE: libs/sequences ;