2005-05-05 22:30:58 -04:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
|
|
|
|
IN: strings
|
2005-05-18 16:26:22 -04:00
|
|
|
USING: generic kernel kernel-internals lists math namespaces
|
|
|
|
|
sequences strings ;
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-08-07 00:00:57 -04:00
|
|
|
: empty-sbuf ( len -- sbuf )
|
|
|
|
|
dup <sbuf> [ set-length ] keep ; inline
|
2005-06-19 18:31:02 -04:00
|
|
|
|
2005-08-07 00:00:57 -04:00
|
|
|
: fill ( count char -- string )
|
|
|
|
|
<repeated> >string ; inline
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-06-15 23:27:28 -04:00
|
|
|
: padding ( string count char -- string )
|
2005-09-24 15:21:17 -04:00
|
|
|
>r swap length - dup 0 <= [ r> 2drop "" ] [ r> fill ] if ;
|
2005-08-19 22:22:15 -04:00
|
|
|
flushable
|
2005-06-15 23:27:28 -04:00
|
|
|
|
|
|
|
|
: pad-left ( string count char -- string )
|
2005-08-19 22:22:15 -04:00
|
|
|
pick >r padding r> append ; flushable
|
2005-06-15 23:27:28 -04:00
|
|
|
|
|
|
|
|
: pad-right ( string count char -- string )
|
2005-08-19 22:22:15 -04:00
|
|
|
pick >r padding r> swap append ; flushable
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-08-19 22:22:15 -04:00
|
|
|
: ch>string ( ch -- str )
|
|
|
|
|
1 <sbuf> [ push ] keep (sbuf>string) ; flushable
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-08-07 00:00:57 -04:00
|
|
|
: >sbuf ( seq -- sbuf )
|
|
|
|
|
dup length <sbuf> [ swap nappend ] keep ; inline
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-05-19 15:16:25 -04:00
|
|
|
M: object >string >sbuf (sbuf>string) ;
|
2005-05-05 22:30:58 -04:00
|
|
|
|
|
|
|
|
M: string thaw >sbuf ;
|
2005-06-12 03:38:57 -04:00
|
|
|
|
|
|
|
|
M: string like ( seq sbuf -- string ) drop >string ;
|
2005-05-05 22:30:58 -04:00
|
|
|
|
2005-09-07 17:21:11 -04:00
|
|
|
M: sbuf like ( seq sbuf -- sbuf )
|
|
|
|
|
drop dup sbuf? [ >sbuf ] unless ;
|