2006-10-05 23:45:00 -04:00
|
|
|
USING: kernel math sequences strings ;
|
2006-09-11 06:49:12 -04:00
|
|
|
IN: sequences-contrib
|
|
|
|
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
|
|
: 3nth ( n seq -- slice ) >r dup 3 + r> <slice> ;
|
|
|
|
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
|
|
: map3-i ( seq -- i ) length 2 - ;
|
|
|
|
|
|
|
|
: map3-quot ( quot -- quot ) [ swap 3nth ] swap append ;
|
|
|
|
|
|
|
|
: map3 ( seq quot -- seq ) over map3-i swap map3-quot map-with ;
|
|
|
|
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
2006-10-06 01:03:30 -04:00
|
|
|
: (rtrim*) ( seq quot -- newseq )
|
|
|
|
over length 0 > [
|
2006-10-09 18:51:47 -04:00
|
|
|
2dup >r peek r> call
|
2006-10-06 01:03:30 -04:00
|
|
|
[ >r dup length 1- head-slice r> (rtrim*) ] [ drop ] if
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] if ;
|
|
|
|
: rtrim* ( seq quot -- newseq ) [ (rtrim*) ] 2keep drop like ;
|
2006-10-05 23:45:00 -04:00
|
|
|
: rtrim ( seq -- newseq ) [ blank? ] rtrim* ;
|
|
|
|
|
2006-10-06 01:03:30 -04:00
|
|
|
: (ltrim*) ( seq quot -- newseq )
|
|
|
|
over length 0 > [
|
|
|
|
2dup >r first r> call [ >r 1 tail-slice r> (ltrim*) ] [ drop ] if
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] if ;
|
|
|
|
: ltrim* ( seq quot -- newseq ) [ (ltrim*) ] 2keep drop like ;
|
2006-10-05 23:45:00 -04:00
|
|
|
: ltrim ( seq -- newseq ) [ blank? ] ltrim* ;
|
|
|
|
|
2006-10-06 01:03:30 -04:00
|
|
|
: trim* ( seq quot -- newseq ) [ (ltrim*) ] keep rtrim* ;
|
2006-10-05 23:45:00 -04:00
|
|
|
: trim ( seq -- newseq ) [ blank? ] trim* ;
|
|
|
|
|
2006-10-08 06:44:34 -04:00
|
|
|
: ?head-slice ( seq begin -- newseq ? )
|
|
|
|
2dup head? [ length tail-slice t ] [ drop f ] if ;
|
|
|
|
|
|
|
|
: ?tail-slice ( seq end -- newseq ? )
|
|
|
|
2dup tail? [ length head-slice* t ] [ drop f ] if ;
|
|
|
|
|
|
|
|
: unclip-slice ( seq -- rest first )
|
|
|
|
dup 1 tail-slice swap first ;
|
|
|
|
|
2006-10-05 23:45:00 -04:00
|
|
|
PROVIDE: contrib/sequences ;
|