core/collections/strings.factor

   1 ! Copyright (C) 2003, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: strings
   4 USING: generic kernel kernel-internals math sequences
   5 sequences-internals ;
   6
   7 M: string equal?
   8     over string? [
   9         over hashcode over hashcode number=
  10         [ sequence= ] [ 2drop f ] if
  11     ] [
  12         2drop f
  13     ] if ;
  14
  15 M: string hashcode
  16     dup string-hashcode [ ] [
  17         dup rehash-string string-hashcode
  18     ] ?if ;
  19
  20 M: string nth bounds-check nth-unsafe ;
  21
  22 M: string nth-unsafe >r >fixnum r> char-slot ;
  23
  24 M: string set-nth bounds-check set-nth-unsafe ;
  25
  26 M: string set-nth-unsafe
  27     f over set-string-hashcode
  28     >r >fixnum >r >fixnum r> r> set-char-slot ;
  29
  30 M: string clone (clone) ;
  31
  32 M: string resize resize-string ;
  33
  34 ! Characters
  35 PREDICATE: integer blank " \t\n\r" member? ;
  36 PREDICATE: integer letter CHAR: a CHAR: z between? ;
  37 PREDICATE: integer LETTER CHAR: A CHAR: Z between? ;
  38 PREDICATE: integer digit CHAR: 0 CHAR: 9 between? ;
  39 PREDICATE: integer printable CHAR: \s CHAR: ~ between? ;
  40 PREDICATE: integer control "\0\e\r\n\t\u0008\u007f" member? ;
  41 PREDICATE: printable quotable "\"\\" member? not ;
  42
  43 UNION: Letter letter LETTER ;
  44 UNION: alpha Letter digit ;
  45
  46 : ch>lower ( ch -- lower ) dup LETTER? [ HEX: 20 + ] when ;
  47 : ch>upper ( ch -- lower ) dup letter? [ HEX: 20 - ] when ;
  48 : >lower ( str -- lower ) [ ch>lower ] map ;
  49 : >upper ( str -- upper ) [ ch>upper ] map ;
  50
  51 : ch>string ( ch -- str ) 1 swap <string> ;
  52
  53 : >string ( seq -- str )
  54     [ string? ] [ 0 <string> ] >sequence ; inline
  55
  56 M: string like
  57     drop dup string? [
  58         dup sbuf? [
  59             dup length over underlying length number=
  60             [ underlying ] [ >string ] if
  61         ] [
  62             >string
  63         ] if
  64     ] unless ;
  65
  66 M: string new drop 0 <string> ;