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 ;
9 : string-hashcode ( str -- n ) 3 slot ; inline
11 : set-string-hashcode ( n str -- ) 3 set-slot ; inline
13 : reset-string-hashcode ( str -- )
14 f swap set-string-hashcode ; inline
16 : string-hashcode-step ( oldhash newpart -- newhash )
18 [ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi
19 fixnum+fast fixnum+fast
20 ] keep fixnum-bitxor ; inline
22 : rehash-string ( str -- )
23 [ 0 [ string-hashcode-step ] reduce ] keep set-string-hashcode ; inline
25 : (aux) ( n string -- byte-array m )
26 aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
28 : small-char? ( ch -- ? )
29 dup 0 fixnum>= [ HEX: 7f fixnum<= ] [ drop f ] if ; inline
31 : string-nth ( n string -- ch )
32 2dup string-nth-fast dup small-char?
34 [ (aux) alien-unsigned-2 7 fixnum-shift-fast ] dip
38 : ensure-aux ( string -- string )
39 dup aux>> [ dup length 2 * (byte-array) >>aux ] unless ; inline
41 : set-string-nth-slow ( ch n string -- )
42 [ [ HEX: 80 fixnum-bitor ] 2dip set-string-nth-fast ]
45 [ -7 fixnum-shift-fast 1 fixnum-bitxor ] 2dip
46 (aux) set-alien-unsigned-2
49 : set-string-nth ( ch n string -- )
51 [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
57 2dup [ hashcode ] bi@ eq?
58 [ sequence= ] [ 2drop f ] if
66 [ ] [ dup rehash-string string-hashcode ] ?if ;
72 [ >fixnum ] dip string-nth ; inline
74 M: string set-nth-unsafe
75 dup reset-string-hashcode
76 [ >fixnum ] [ >fixnum ] [ ] tri* set-string-nth ; inline
79 (clone) [ clone ] change-aux ; inline
81 M: string resize resize-string ; inline
83 : 1string ( ch -- str ) 1 swap <string> ;
85 : >string ( seq -- str ) "" clone-like ;
87 M: string new-sequence drop 0 <string> ; inline
89 INSTANCE: string sequence