2005-01-29 14:18:28 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-04-02 02:39:33 -05:00
|
|
|
IN: strings
|
2005-05-02 00:18:34 -04:00
|
|
|
USING: generic kernel lists math namespaces sequences strings ;
|
2005-04-02 02:39:33 -05:00
|
|
|
|
|
|
|
|
M: sbuf length sbuf-length ;
|
|
|
|
|
M: sbuf set-length set-sbuf-length ;
|
|
|
|
|
M: sbuf nth sbuf-nth ;
|
|
|
|
|
M: sbuf set-nth set-sbuf-nth ;
|
2005-04-25 03:33:33 -04:00
|
|
|
M: sbuf clone sbuf-clone ;
|
|
|
|
|
M: sbuf = sbuf= ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-19 20:28:01 -04:00
|
|
|
: >sbuf ( seq -- sbuf ) 0 <sbuf> [ swap nappend ] keep ;
|
|
|
|
|
|
2005-05-02 00:18:34 -04:00
|
|
|
GENERIC: >string ( seq -- string )
|
|
|
|
|
M: string >string ;
|
|
|
|
|
M: object >string >sbuf sbuf>string ;
|
2005-04-19 20:28:01 -04:00
|
|
|
|
|
|
|
|
: fill ( count char -- string ) <repeated> >string ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-12-19 03:04:03 -05:00
|
|
|
: pad ( string count char -- string )
|
2005-04-19 20:28:01 -04:00
|
|
|
>r over length - dup 0 <= [
|
2004-12-19 03:04:03 -05:00
|
|
|
r> 2drop
|
|
|
|
|
] [
|
2005-04-25 19:54:21 -04:00
|
|
|
r> fill swap append
|
2004-12-19 03:04:03 -05:00
|
|
|
] ifte ;
|
|
|
|
|
|
2004-08-10 23:48:08 -04:00
|
|
|
: split-next ( index string split -- next )
|
|
|
|
|
3dup index-of* dup -1 = [
|
2005-03-05 16:33:40 -05:00
|
|
|
>r drop string-tail , r> ( end of string )
|
2004-08-10 23:48:08 -04:00
|
|
|
] [
|
2005-04-19 20:28:01 -04:00
|
|
|
swap length dupd + >r swap substring , r>
|
2004-08-10 23:48:08 -04:00
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
|
|
: (split) ( index string split -- )
|
|
|
|
|
2dup >r >r split-next dup -1 = [
|
|
|
|
|
drop r> drop r> drop
|
|
|
|
|
] [
|
|
|
|
|
r> r> (split)
|
|
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
|
|
: split ( string split -- list )
|
|
|
|
|
#! Split the string at each occurrence of split, and push a
|
|
|
|
|
#! list of the pieces.
|
2004-11-11 15:15:43 -05:00
|
|
|
[ 0 -rot (split) ] make-list ;
|
2004-09-04 01:05:50 -04:00
|
|
|
|
|
|
|
|
: split-n-advance substring , >r tuck + swap r> ;
|
2005-04-19 20:28:01 -04:00
|
|
|
: split-n-finish nip dup length swap substring , ;
|
2004-09-04 01:05:50 -04:00
|
|
|
|
|
|
|
|
: (split-n) ( start n str -- )
|
2005-04-19 20:28:01 -04:00
|
|
|
3dup >r dupd + r> 2dup length < [
|
2004-09-04 01:05:50 -04:00
|
|
|
split-n-advance (split-n)
|
|
|
|
|
] [
|
|
|
|
|
split-n-finish 3drop
|
|
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
|
|
: split-n ( n str -- list )
|
|
|
|
|
#! Split a string into n-character chunks.
|
2004-11-11 15:15:43 -05:00
|
|
|
[ 0 -rot (split-n) ] make-list ;
|
2005-01-03 02:55:54 -05:00
|
|
|
|
2005-04-19 20:28:01 -04:00
|
|
|
: ch>string ( ch -- str ) 1 <sbuf> [ push ] keep sbuf>string ;
|
2005-04-17 21:59:11 -04:00
|
|
|
|
2005-04-25 19:54:21 -04:00
|
|
|
M: string thaw >sbuf ;
|
2005-04-17 21:59:11 -04:00
|
|
|
M: string freeze drop sbuf>string ;
|