core/strings/strings.factor

   1 ! Copyright (C) 2003, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.accessors byte-arrays kernel
   4 kernel.private math math.private sequences sequences.private
   5 slots.private ;
   6 IN: strings
   7
   8 <PRIVATE
   9
  10 : string-hashcode ( str -- n ) 3 slot ; inline
  11
  12 : set-string-hashcode ( n str -- ) 3 set-slot ; inline
  13
  14 : reset-string-hashcode ( str -- )
  15     f swap set-string-hashcode ; inline
  16
  17 : rehash-string ( str -- )
  18     1 over sequence-hashcode swap set-string-hashcode ; inline
  19
  20 : (aux) ( n string -- byte-array m )
  21     aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
  22
  23 : small-char? ( ch -- ? )
  24     dup 0 fixnum>= [ 0x7f fixnum<= ] [ drop f ] if ; inline
  25
  26 : string-nth ( n string -- ch )
  27     2dup string-nth-fast dup small-char?
  28     [ 2nip ] [
  29         [ (aux) alien-unsigned-2 7 fixnum-shift-fast ] dip
  30         fixnum-bitxor
  31     ] if ; inline
  32
  33 : ensure-aux ( string -- string )
  34     dup aux>> [ dup length 2 * (byte-array) >>aux ] unless ; inline
  35
  36 : set-string-nth-slow ( ch n string -- )
  37     [ [ 0x80 fixnum-bitor ] 2dip set-string-nth-fast ]
  38     [
  39         ensure-aux
  40         [ -7 fixnum-shift-fast 1 fixnum-bitxor ] 2dip
  41         (aux) set-alien-unsigned-2
  42     ] 3bi ;
  43
  44 : set-string-nth ( ch n string -- )
  45     pick small-char?
  46     [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
  47
  48 PRIVATE>
  49
  50 M: string equal?
  51     over string? [
  52         2dup [ hashcode ] bi@ eq?
  53         [ sequence= ] [ 2drop f ] if
  54     ] [
  55         2drop f
  56     ] if ;
  57
  58 M: string hashcode*
  59     nip
  60     dup string-hashcode
  61     [ ] [ dup rehash-string string-hashcode ] ?if ;
  62
  63 M: string length
  64     length>> ; inline
  65
  66 M: string nth-unsafe
  67     [ integer>fixnum ] dip string-nth ; inline
  68
  69 M: string set-nth-unsafe
  70     dup reset-string-hashcode
  71     [ integer>fixnum ] [ integer>fixnum ] [ ] tri* set-string-nth ; inline
  72
  73 M: string clone
  74     (clone) [ clone ] change-aux ; inline
  75
  76 M: string resize resize-string ; inline
  77
  78 : 1string ( ch -- str ) 1 swap <string> ; inline
  79
  80 : >string ( seq -- str ) "" clone-like ; inline
  81
  82 M: string new-sequence drop 0 <string> ; inline
  83
  84 INSTANCE: string sequence