X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FFastString.lhs;h=8dbfefaa0b7690aae3b1a43b8814205c079e841e;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=d29ce9fd880827a75cef780cca25a230096339e5;hpb=a26bee653e99308ef935adca83002d8f94acac18;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index d29ce9f..8dbfefa 100644
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -3,8 +3,18 @@
 %
 \section{Fast strings}
 
-Compact representations of character strings with
-unique identifiers (hash-cons'ish).
+FastString:	A compact, hash-consed, representation of character strings.
+		Comparison is O(1), and you can get a Unique from them.
+		Generated by the FSLIT macro
+		Turn into SDoc with Outputable.ftext
+
+LitString:	Just a wrapper for the Addr# of a C string (Ptr CChar).
+		Practically no operations
+		Outputing them is fast
+		Generated by the SLIT macro
+		Turn into SDoc with Outputable.ptext
+
+Use LitString unless you want the facilities of FastString
 
 \begin{code}
 module FastString
@@ -55,7 +65,7 @@ import GHC.IOBase	( IO(..) )
 import PrimPacked
 import GLAEXTS
 import UNSAFE_IO	( unsafePerformIO )
-import ST		( stToIO )
+import MONAD_ST		( stToIO )
 import DATA_IOREF	( IORef, newIORef, readIORef, writeIORef )
 
 #if __GLASGOW_HASKELL__ < 503
@@ -106,6 +116,7 @@ instance Eq FastString where
   a /= b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> True  }
 
 instance Ord FastString where
+	-- Compares lexicographically, not by unique
     a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
     a <	 b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
     a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
@@ -126,7 +137,7 @@ nullFastString (UnicodeStr _ []) = True
 nullFastString (UnicodeStr _ (_:_)) = False
 
 unpackFS :: FastString -> String
-unpackFS (FastString _ l# ba#) = unpackCStringBA (BA ba#) (I# l#)
+unpackFS (FastString _ l# ba#) = unpackNBytesBA (BA ba#) (I# l#)
 unpackFS (UnicodeStr _ s) = map chr s
 
 unpackIntFS :: FastString -> [Int]
@@ -391,9 +402,9 @@ hashSubStrBA ba# start# len# =
    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
   where
-    c0 = indexCharArray# ba# 0#
-    c1 = indexCharArray# ba# (len# `quotInt#` 2# -# 1#)
-    c2 = indexCharArray# ba# (len# -# 1#)
+    c0 = indexCharArray# ba# (start# +# 0#)
+    c1 = indexCharArray# ba# (start# +# (len# `quotInt#` 2# -# 1#))
+    c2 = indexCharArray# ba# (start# +# (len# -# 1#))
 
 --    c1 = indexCharArray# ba# 1#
 --    c2 = indexCharArray# ba# 2#
@@ -418,20 +429,21 @@ cmpFS (UnicodeStr u1# s1) (UnicodeStr u2# s2) = if u1# ==# u2# then EQ
     else compare s1 s2
 cmpFS (UnicodeStr _ s1) s2 = compare s1 (unpackIntFS s2)
 cmpFS s1 (UnicodeStr _ s2) = compare (unpackIntFS s1) s2
-cmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
-  if u1# ==# u2# then
-     EQ
-  else
-   unsafePerformIO (
-    strcmp b1# b2# >>= \ (I# res) ->
+cmpFS (FastString u1# l1# b1#) (FastString u2# l2# b2#) =
+  if u1# ==# u2# then EQ else
+  let l# = if l1# <=# l2# then l1# else l2# in
+  unsafePerformIO (
+    memcmp b1# b2# l# >>= \ (I# res) ->
     return (
     if      res <#  0# then LT
-    else if res ==# 0# then EQ
+    else if res ==# 0# then 
+	if l1# ==# l2# then EQ
+	else if l1# <# l2# then LT else GT
     else		    GT
     ))
 
-foreign import ccall "strcmp" unsafe 
-  strcmp :: ByteArray# -> ByteArray# -> IO Int
+foreign import ccall "ghc_memcmp" unsafe 
+  memcmp :: ByteArray# -> ByteArray# -> Int# -> IO Int
 
 -- -----------------------------------------------------------------------------
 -- Outputting 'FastString's
@@ -496,7 +508,6 @@ hPutFS handle (UnicodeStr _ is)
 -- LitStrings, here for convenience only.
 
 type LitString = Ptr ()
--- ToDo: make it a Ptr when we don't have to support 4.08 any more
 
 mkLitString# :: Addr# -> LitString
 mkLitString# a# = Ptr a#