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