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

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index ea30779..637ef0c 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -24,6 +24,7 @@ module FastString
 	-- ** Construction
         mkFastString,
 	mkFastStringBytes,
+        mkFastStringByteList,
 	mkFastStringForeignPtr,
 	mkFastString#,
 	mkZFastString,
@@ -133,12 +134,10 @@ cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
     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
+      return $ case compare res 0 of
+                 LT -> LT
+                 EQ -> compare l1 l2
+                 GT -> GT
 
 #ifndef __HADDOCK__
 foreign import ccall unsafe "ghc_memcmp" 
@@ -160,6 +159,7 @@ data FastStringTable =
     {-# UNPACK #-} !Int
     (MutableArray# RealWorld [FastString])
 
+{-# NOINLINE string_table #-}
 string_table :: IORef FastStringTable
 string_table = 
  unsafePerformIO $ do
@@ -275,6 +275,15 @@ mkFastString str =
       utf8EncodeString ptr str
       mkFastStringForeignPtr ptr buf l 
 
+-- | Creates a 'FastString' from a UTF-8 encoded @[Word8]@
+mkFastStringByteList :: [Word8] -> FastString
+mkFastStringByteList str = 
+  inlinePerformIO $ do
+    let l = Prelude.length str
+    buf <- mallocForeignPtrBytes l
+    withForeignPtr buf $ \ptr -> do
+      pokeArray (castPtr ptr) str
+      mkFastStringForeignPtr ptr buf l 
 
 -- | Creates a Z-encoded 'FastString' from a 'String'
 mkZFastString :: String -> FastString
@@ -479,21 +488,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 ()
-
-peekCAStringLen = peekCStringLen
-
-#elif __GLASGOW_HASKELL__ <= 602
-
+#if __GLASGOW_HASKELL__ <= 602
 peekCAStringLen = peekCStringLen
-
 #endif
 \end{code}