factor/library/collections/strings.factor

59 lines
1.7 KiB
Factor
Raw Normal View History

! Copyright (C) 2003, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
2005-05-05 16:51:38 -04:00
IN: strings
USING: generic kernel kernel-internals lists math sequences
sequences-internals ;
2004-07-16 02:26:21 -04:00
2006-01-02 00:51:03 -05:00
M: string hashcode
dup string-hashcode [ ] [
dup rehash-string string-hashcode
] ?if ;
2006-01-02 00:51:03 -05:00
M: string nth bounds-check char-slot ;
2005-04-02 02:39:33 -05:00
2006-01-02 00:51:03 -05:00
M: string nth-unsafe >r >fixnum r> char-slot ;
2006-01-02 00:51:03 -05:00
M: string set-nth bounds-check set-nth-unsafe ;
2006-01-02 00:51:03 -05:00
M: string set-nth-unsafe
f over set-string-hashcode
>r >fixnum >r >fixnum r> r> set-char-slot ;
2005-05-05 16:51:38 -04:00
2006-01-02 00:51:03 -05:00
M: string clone (clone) ;
2005-05-05 16:51:38 -04:00
! Characters
2005-07-16 22:16:18 -04:00
PREDICATE: integer blank " \t\n\r" member? ;
PREDICATE: integer letter CHAR: a CHAR: z between? ;
PREDICATE: integer LETTER CHAR: A CHAR: Z between? ;
PREDICATE: integer digit CHAR: 0 CHAR: 9 between? ;
PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
2005-10-07 20:26:21 -04:00
PREDICATE: integer control "\0\e\r\n\t\u0008\u007f" member? ;
: ch>lower ( n -- n ) dup LETTER? [ HEX: 20 + ] when ;
: ch>upper ( n -- n ) dup letter? [ HEX: 20 - ] when ;
: >lower ( str -- str ) [ ch>lower ] map ;
: >upper ( str -- str ) [ ch>upper ] map ;
: quotable? ( ch -- ? )
#! In a string literal, can this character be used without
#! escaping?
dup printable? swap "\"\\" member? not and ; foldable
2006-01-02 00:51:03 -05:00
: padding ( string count char -- string )
>r swap length - 0 max r> <string> ; flushable
: pad-left ( string count char -- string )
pick >r padding r> append ; flushable
: pad-right ( string count char -- string )
pick >r padding r> swap append ; flushable
: ch>string ( ch -- str ) 1 swap <string> ; flushable
: >string ( seq -- array ) [ 0 <string> ] >sequence ; inline
M: string thaw drop SBUF" " clone ;
M: string like ( seq sbuf -- string )
drop dup string? [ >string ] unless ;