-! Copyright (C) 2003, 2008 Slava Pestov.
+! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math.private sequences kernel.private
-math sequences.private slots.private byte-arrays
-alien.accessors ;
+USING: accessors alien.accessors byte-arrays kernel math.private
+sequences kernel.private math sequences.private slots.private ;
IN: strings
<PRIVATE
-: string-hashcode 3 slot ; inline
+: string-hashcode ( str -- n ) 3 slot ; inline
-: set-string-hashcode 3 set-slot ; inline
+: set-string-hashcode ( n str -- ) 3 set-slot ; inline
-: reset-string-hashcode f swap set-string-hashcode ; inline
+: reset-string-hashcode ( str -- )
+ f swap set-string-hashcode ; inline
: rehash-string ( str -- )
1 over sequence-hashcode swap set-string-hashcode ; inline
+: (aux) ( n string -- byte-array m )
+ aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
+
+: small-char? ( ch -- ? )
+ dup 0 fixnum>= [ 0x7f fixnum<= ] [ drop f ] if ; inline
+
+: string-nth ( n string -- ch )
+ 2dup string-nth-fast dup small-char?
+ [ 2nip ] [
+ [ (aux) alien-unsigned-2 7 fixnum-shift-fast ] dip
+ fixnum-bitxor
+ ] if ; inline
+
+: ensure-aux ( string -- string )
+ dup aux>> [ dup length 2 * (byte-array) >>aux ] unless ; inline
+
+: set-string-nth-slow ( ch n string -- )
+ [ [ 0x80 fixnum-bitor ] 2dip set-string-nth-fast ]
+ [
+ ensure-aux
+ [ -7 fixnum-shift-fast 1 fixnum-bitxor ] 2dip
+ (aux) set-alien-unsigned-2
+ ] 3bi ;
+
+: set-string-nth ( ch n string -- )
+ pick small-char?
+ [ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
+
PRIVATE>
M: string equal?
over string? [
- over hashcode over hashcode eq?
+ 2dup [ hashcode ] bi@ eq?
[ sequence= ] [ 2drop f ] if
] [
2drop f
] if ;
M: string hashcode*
- nip dup string-hashcode [ ]
- [ dup rehash-string string-hashcode ] ?if ;
+ nip
+ dup string-hashcode
+ [ ] [ dup rehash-string string-hashcode ] ?if ;
M: string length
- length>> ;
+ length>> ; inline
M: string nth-unsafe
- [ >fixnum ] dip string-nth ;
+ [ >fixnum ] dip string-nth ; inline
M: string set-nth-unsafe
dup reset-string-hashcode
- [ [ >fixnum ] dip >fixnum ] dip set-string-nth ;
+ [ >fixnum ] [ >fixnum ] [ ] tri* set-string-nth ; inline
M: string clone
- (clone) [ clone ] change-aux ;
+ (clone) [ clone ] change-aux ; inline
-M: string resize resize-string ;
+M: string resize resize-string ; inline
-: 1string ( ch -- str ) 1 swap <string> ;
+: 1string ( ch -- str ) 1 swap <string> ; inline
-: >string ( seq -- str ) "" clone-like ;
+: >string ( seq -- str ) "" clone-like ; inline
-M: string new-sequence drop 0 <string> ;
+M: string new-sequence drop 0 <string> ; inline
INSTANCE: string sequence