use radix literals

[factor.git] / core / strings / strings.factor

diff --git a/core/strings/strings.factor b/core/strings/strings.factor
index 7e4c80d4aeb2198681819be450310fbc6609313e..1f266e2e473076ef4b9e59c59c66aaee0cc685dc 100644 (file)
--- a/core/strings/strings.factor
+++ b/core/strings/strings.factor
@@ -1,8 +1,7 @@
-! 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
@@ -17,15 +16,39 @@ IN: strings
 : rehash-string ( str -- )
     1 over sequence-hashcode swap set-string-hashcode ; inline
 
-: set-string-nth ( ch n str -- )
-    pick HEX: 7f fixnum<=
+: (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
@@ -37,24 +60,24 @@ M: 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 ] [ >fixnum ] [ ] tri* 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