Refactor dumping of register allocator statistics.

[ghc-hetmet.git] / compiler / utils / FastString.lhs

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 26f687c..ffe10c3 100644 (file)
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -129,17 +129,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
-      case () of
-       _ | res <  0  -> return LT
-        | res == 0  -> if l1 == l2 then return EQ 
-                                   else if l1 < l2 then return LT
-                                                   else return GT
-        | otherwise -> return 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" 
@@ -161,6 +161,7 @@ data FastStringTable =
     {-# UNPACK #-} !Int
     (MutableArray# RealWorld [FastString])
 
+{-# NOINLINE string_table #-}
 string_table :: IORef FastStringTable
 string_table = 
  unsafePerformIO $ do
@@ -489,21 +490,7 @@ pokeCAString ptr str =
   in
   go str 0
 
-#if __GLASGOW_HASKELL__ < 600
-
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
-  r <- mallocBytes n
-  newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free" 
-  finalizerFree :: Ptr a -> IO ()
-
+#if __GLASGOW_HASKELL__ <= 602
 peekCAStringLen = peekCStringLen
-
-#elif __GLASGOW_HASKELL__ <= 602
-
-peekCAStringLen = peekCStringLen
-
 #endif
 \end{code}