X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FFastString.lhs;h=ca7c2c71af80f0a4d8ca05094762de99262fbca6;hb=b23eb7d83a2434e6791b3ca8eeec7cfa74f63ffd;hp=637ef0cf72276b54ee38d49117734089a826e076;hpb=a5e533a6d23eed8a8f14314d54fd727b8023edf9;p=ghc-hetmet.git

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 637ef0c..ca7c2c7 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -2,6 +2,13 @@
 % (c) The University of Glasgow, 1997-2006
 %
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 {-
 FastString:	A compact, hash-consed, representation of character strings.
 		Comparison is O(1), and you can get a Unique from them.
@@ -78,11 +85,12 @@ import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
 import System.IO	( hPutBuf )
 import Data.Maybe	( isJust )
 
-import GHC.Arr		( STArray(..), newSTArray )
+import GHC.ST
 import GHC.IOBase	( IO(..) )
 import GHC.Ptr		( Ptr(..) )
 
-#define hASH_TBL_SIZE  4091
+#define hASH_TBL_SIZE          4091
+#define hASH_TBL_SIZE_UNBOXED  4091#
 
 
 {-|
@@ -129,15 +137,17 @@ instance Show FastString where
 cmpFS :: FastString -> FastString -> Ordering
 cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
   if u1 == u2 then EQ else
-  let l = if l1 <= l2 then l1 else l2 in
-  inlinePerformIO $
-    withForeignPtr buf1 $ \p1 ->
-    withForeignPtr buf2 $ \p2 -> do
-      res <- memcmp p1 p2 l
-      return $ case compare res 0 of
-                 LT -> LT
-                 EQ -> compare l1 l2
-                 GT -> GT
+  case unsafeMemcmp buf1 buf2 (min l1 l2) `compare` 0 of
+     LT -> LT
+     EQ -> compare l1 l2
+     GT -> GT
+
+unsafeMemcmp :: ForeignPtr a -> ForeignPtr b -> Int -> Int
+unsafeMemcmp buf1 buf2 l =
+      inlinePerformIO $
+        withForeignPtr buf1 $ \p1 ->
+        withForeignPtr buf2 $ \p2 ->
+          memcmp p1 p2 l
 
 #ifndef __HADDOCK__
 foreign import ccall unsafe "ghc_memcmp" 
@@ -163,8 +173,10 @@ data FastStringTable =
 string_table :: IORef FastStringTable
 string_table = 
  unsafePerformIO $ do
-   (STArray _ _ arr#) <- stToIO (newSTArray (0::Int,hASH_TBL_SIZE) [])
-   newIORef (FastStringTable 0 arr#)
+   tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
+                           (# s2#, arr# #) ->
+                               (# s2#, FastStringTable 0 arr# #)
+   newIORef tab
 
 lookupTbl :: FastStringTable -> Int -> IO [FastString]
 lookupTbl (FastStringTable _ arr#) (I# i#) =