1 ! Copyright (C) 2003, 2010 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.accessors byte-arrays kernel
4 kernel.private math math.private sequences sequences.private
8 BUILTIN: string { length array-capacity read-only initial: 0 } aux ;
10 PRIMITIVE: <string> ( n ch -- string )
11 PRIMITIVE: resize-string ( n str -- newstr )
14 PRIMITIVE: set-string-nth-fast ( ch n string -- )
15 PRIMITIVE: string-nth-fast ( n string -- ch )
17 : string-hashcode ( str -- n ) 3 slot ; inline
19 : set-string-hashcode ( n str -- ) 3 set-slot ; inline
21 : reset-string-hashcode ( str -- )
22 f swap set-string-hashcode ; inline
24 : rehash-string ( str -- )
27 [ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi
28 fixnum+fast fixnum+fast
30 ] each swap set-string-hashcode ; inline
32 : (aux) ( n string -- byte-array m )
33 aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
35 : small-char? ( ch -- ? )
36 dup 0 fixnum>= [ 0x7f fixnum<= ] [ drop f ] if ; inline
38 : string-nth ( n string -- ch )
39 2dup string-nth-fast dup small-char?
41 [ (aux) alien-unsigned-2 7 fixnum-shift-fast ] dip
45 : ensure-aux ( string -- string )
46 dup aux>> [ dup length 2 * (byte-array) >>aux ] unless ; inline
48 : set-string-nth-slow ( ch n string -- )
49 [ [ 0x80 fixnum-bitor ] 2dip set-string-nth-fast ]
52 [ -7 fixnum-shift-fast 1 fixnum-bitxor ] 2dip
53 (aux) set-alien-unsigned-2
56 : set-string-nth ( ch n string -- )
58 [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
64 ! faster during bootstrap than ``[ hashcode ] bi@``
65 over hashcode over hashcode eq?
66 [ sequence= ] [ 2drop f ] if
74 [ dup rehash-string string-hashcode ] ?unless ;
80 [ integer>fixnum ] dip string-nth ; inline
82 M: string set-nth-unsafe
83 dup reset-string-hashcode
84 [ integer>fixnum ] [ integer>fixnum ] [ ] tri* set-string-nth ; inline
87 (clone) [ clone ] change-aux ; inline
90 over string? [ drop clone ] [ call-next-method ] if ; inline
92 M: string resize resize-string ; inline
94 : 1string ( ch -- str ) 1 swap <string> ; inline
96 : >string ( seq -- str ) "" clone-like ; inline
98 M: string new-sequence drop 0 <string> ; inline
100 INSTANCE: string sequence