% (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.
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#
{-|
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"
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#) =