Remove code that isn't used now that we assume that GHC >= 6.4

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

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index c095d6f..ac79b5b 100644 (file)
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -2,23 +2,16 @@
 % (c) The University of Glasgow, 1997-2006
 %
 \begin{code}
 % (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.
 {-
 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
+                Generated by fsLit

                 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
                 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
+                Generated by sLit

                 Turn into SDoc with Outputable.ptext
 
 Use LitString unless you want the facilities of FastString
                 Turn into SDoc with Outputable.ptext
 
 Use LitString unless you want the facilities of FastString

@@ -69,37 +62,38 @@ module FastString
         LitString,
 #if defined(__GLASGOW_HASKELL__)
         mkLitString#,
         LitString,
 #if defined(__GLASGOW_HASKELL__)
         mkLitString#,

-#else
-        mkLitString,

 #endif
 #endif

+        mkLitString,

         unpackLitString,
         strLength,
 
         unpackLitString,
         strLength,
 

-        ptrStrLength
+        ptrStrLength,
+
+        sLit,
+        fsLit,

        ) where
 
        ) where
 

--- This #define suppresses the "import FastString" that
--- HsVersions otherwise produces
-#define COMPILING_FAST_STRING

 #include "HsVersions.h"
 
 import Encoding
 import FastTypes
 import FastFunctions
 #include "HsVersions.h"
 
 import Encoding
 import FastTypes
 import FastFunctions

+import Panic

 
 import Foreign
 import Foreign.C
 import GHC.Exts
 
 import Foreign
 import Foreign.C
 import GHC.Exts

+import System.IO

 import System.IO.Unsafe ( unsafePerformIO )
 import System.IO.Unsafe ( unsafePerformIO )

-import Control.Monad.ST ( stToIO )

 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )

-import System.IO        ( hPutBuf )

 import Data.Maybe       ( isJust )
 import Data.Char        ( ord )
 
 import Data.Maybe       ( isJust )
 import Data.Char        ( ord )
 

-import GHC.ST

 import GHC.IOBase       ( IO(..) )
 import GHC.Ptr          ( Ptr(..) )
 import GHC.IOBase       ( IO(..) )
 import GHC.Ptr          ( Ptr(..) )

+#if defined(__GLASGOW_HASKELL__)
+import GHC.Base         ( unpackCString# )
+#endif

 
 #define hASH_TBL_SIZE          4091
 #define hASH_TBL_SIZE_UNBOXED  4091#
 
 #define hASH_TBL_SIZE          4091
 #define hASH_TBL_SIZE_UNBOXED  4091#

@@ -205,7 +199,7 @@ mkFastString# a# = mkFastStringBytes ptr (ptrStrLength ptr)
 
 mkFastStringBytes :: Ptr Word8 -> Int -> FastString
 mkFastStringBytes ptr len = unsafePerformIO $ do
 
 mkFastStringBytes :: Ptr Word8 -> Int -> FastString
 mkFastStringBytes ptr len = unsafePerformIO $ do

-  ft@(FastStringTable uid tbl#) <- readIORef string_table
+  ft@(FastStringTable uid _) <- readIORef string_table

   let
    h = hashStr ptr len
    add_it ls = do
   let
    h = hashStr ptr len
    add_it ls = do

@@ -225,7 +219,7 @@ mkFastStringBytes ptr len = unsafePerformIO $ do
 
 mkZFastStringBytes :: Ptr Word8 -> Int -> FastString
 mkZFastStringBytes ptr len = unsafePerformIO $ do
 
 mkZFastStringBytes :: Ptr Word8 -> Int -> FastString
 mkZFastStringBytes ptr len = unsafePerformIO $ do

-  ft@(FastStringTable uid tbl#) <- readIORef string_table
+  ft@(FastStringTable uid _) <- readIORef string_table

   let
    h = hashStr ptr len
    add_it ls = do
   let
    h = hashStr ptr len
    add_it ls = do

@@ -248,7 +242,7 @@ mkZFastStringBytes ptr len = unsafePerformIO $ do
 -- the bytes if the string is new to the table.
 mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 mkFastStringForeignPtr ptr fp len = do
 -- the bytes if the string is new to the table.
 mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 mkFastStringForeignPtr ptr fp len = do

-  ft@(FastStringTable uid tbl#) <- readIORef string_table
+  ft@(FastStringTable uid _) <- readIORef string_table

 --  _trace ("hashed: "++show (I# h)) $
   let
     h = hashStr ptr len
 --  _trace ("hashed: "++show (I# h)) $
   let
     h = hashStr ptr len

@@ -269,7 +263,7 @@ mkFastStringForeignPtr ptr fp len = do
 
 mkZFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 mkZFastStringForeignPtr ptr fp len = do
 
 mkZFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
 mkZFastStringForeignPtr ptr fp len = do

-  ft@(FastStringTable uid tbl#) <- readIORef string_table
+  ft@(FastStringTable uid _) <- readIORef string_table

 --  _trace ("hashed: "++show (I# h)) $
   let
     h = hashStr ptr len
 --  _trace ("hashed: "++show (I# h)) $
   let
     h = hashStr ptr len

@@ -319,6 +313,7 @@ mkZFastString str =
       pokeCAString (castPtr ptr) str
       mkZFastStringForeignPtr ptr buf l
 
       pokeCAString (castPtr ptr) str
       mkZFastStringForeignPtr ptr buf l
 

+bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)

 bucket_match [] _ _ = return Nothing
 bucket_match (v@(FastString _ l _ buf _):ls) len ptr
       | len == l  =  do
 bucket_match [] _ _ = return Nothing
 bucket_match (v@(FastString _ l _ buf _):ls) len ptr
       | len == l  =  do

@@ -328,26 +323,31 @@ bucket_match (v@(FastString _ l _ buf _):ls) len ptr
       | otherwise =
          bucket_match ls len ptr
 
       | otherwise =
          bucket_match ls len ptr
 

+mkNewFastString :: Int -> Ptr Word8 -> ForeignPtr Word8 -> Int
+                -> IO FastString

 mkNewFastString uid ptr fp len = do
   ref <- newIORef Nothing
   n_chars <- countUTF8Chars ptr len
   return (FastString uid len n_chars fp (UTF8Encoded ref))
 
 mkNewFastString uid ptr fp len = do
   ref <- newIORef Nothing
   n_chars <- countUTF8Chars ptr len
   return (FastString uid len n_chars fp (UTF8Encoded ref))
 

-mkNewZFastString uid ptr fp len = do
+mkNewZFastString :: Int -> Ptr Word8 -> ForeignPtr Word8 -> Int
+                 -> IO FastString
+mkNewZFastString uid _ fp len = do

   return (FastString uid len len fp ZEncoded)
 
   return (FastString uid len len fp ZEncoded)
 

-
+copyNewFastString :: Int -> Ptr Word8 -> Int -> IO FastString

 copyNewFastString uid ptr len = do
   fp <- copyBytesToForeignPtr ptr len
   ref <- newIORef Nothing
   n_chars <- countUTF8Chars ptr len
   return (FastString uid len n_chars fp (UTF8Encoded ref))
 
 copyNewFastString uid ptr len = do
   fp <- copyBytesToForeignPtr ptr len
   ref <- newIORef Nothing
   n_chars <- countUTF8Chars ptr len
   return (FastString uid len n_chars fp (UTF8Encoded ref))
 

+copyNewZFastString :: Int -> Ptr Word8 -> Int -> IO FastString

 copyNewZFastString uid ptr len = do
   fp <- copyBytesToForeignPtr ptr len
   return (FastString uid len len fp ZEncoded)
 
 copyNewZFastString uid ptr len = do
   fp <- copyBytesToForeignPtr ptr len
   return (FastString uid len len fp ZEncoded)
 

-
+copyBytesToForeignPtr :: Ptr Word8 -> Int -> IO (ForeignPtr Word8)

 copyBytesToForeignPtr ptr len = do
   fp <- mallocForeignPtrBytes len
   withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
 copyBytesToForeignPtr ptr len = do
   fp <- mallocForeignPtrBytes len
   withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len

@@ -385,7 +385,7 @@ isZEncoded fs | ZEncoded <- enc fs = True
 -- | Returns 'True' if this 'FastString' is not Z-encoded but already has
 -- a Z-encoding cached (used in producing stats).
 hasZEncoding :: FastString -> Bool
 -- | Returns 'True' if this 'FastString' is not Z-encoded but already has
 -- a Z-encoding cached (used in producing stats).
 hasZEncoding :: FastString -> Bool

-hasZEncoding fs@(FastString uid n_bytes _ fp enc) =
+hasZEncoding (FastString _ _ _ _ enc) =

   case enc of
     ZEncoded -> False
     UTF8Encoded ref ->
   case enc of
     ZEncoded -> False
     UTF8Encoded ref ->

@@ -406,7 +406,7 @@ unpackFS (FastString _ n_bytes _ buf enc) =
         UTF8Encoded _ -> utf8DecodeString ptr n_bytes
 
 bytesFS :: FastString -> [Word8]
         UTF8Encoded _ -> utf8DecodeString ptr n_bytes
 
 bytesFS :: FastString -> [Word8]

-bytesFS (FastString _ n_bytes _ buf enc) =
+bytesFS (FastString _ n_bytes _ buf _) =

   inlinePerformIO $ withForeignPtr buf $ \ptr ->
     peekArray n_bytes ptr
 
   inlinePerformIO $ withForeignPtr buf $ \ptr ->
     peekArray n_bytes ptr
 

@@ -416,7 +416,7 @@ bytesFS (FastString _ n_bytes _ buf enc) =
 -- memoized.
 --
 zEncodeFS :: FastString -> FastString
 -- memoized.
 --
 zEncodeFS :: FastString -> FastString

-zEncodeFS fs@(FastString uid n_bytes _ fp enc) =
+zEncodeFS fs@(FastString _ _ _ _ enc) =

   case enc of
     ZEncoded -> fs
     UTF8Encoded ref ->
   case enc of
     ZEncoded -> fs
     UTF8Encoded ref ->

@@ -436,7 +436,8 @@ concatFS :: [FastString] -> FastString
 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
 
 headFS :: FastString -> Char
 concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
 
 headFS :: FastString -> Char

-headFS (FastString _ n_bytes _ buf enc) =
+headFS (FastString _ 0 _ _ _) = panic "headFS: Empty FastString"
+headFS (FastString _ _ _ buf enc) =

   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
     case enc of
       ZEncoded -> do
   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
     case enc of
       ZEncoded -> do

@@ -446,6 +447,7 @@ headFS (FastString _ n_bytes _ buf enc) =
          return (fst (utf8DecodeChar ptr))
 
 tailFS :: FastString -> FastString
          return (fst (utf8DecodeChar ptr))
 
 tailFS :: FastString -> FastString

+tailFS (FastString _ 0 _ _ _) = panic "tailFS: Empty FastString"

 tailFS (FastString _ n_bytes _ buf enc) =
   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
     case enc of
 tailFS (FastString _ n_bytes _ buf enc) =
   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
     case enc of

@@ -462,6 +464,7 @@ consFS c fs = mkFastString (c : unpackFS fs)
 uniqueOfFS :: FastString -> FastInt
 uniqueOfFS (FastString u _ _ _ _) = iUnbox u
 
 uniqueOfFS :: FastString -> FastInt
 uniqueOfFS (FastString u _ _ _ _) = iUnbox u
 

+nilFS :: FastString

 nilFS = mkFastString ""
 
 -- -----------------------------------------------------------------------------
 nilFS = mkFastString ""
 
 -- -----------------------------------------------------------------------------

@@ -478,6 +481,7 @@ getFastStringTable = do
 
 -- |Outputs a 'FastString' with /no decoding at all/, that is, you
 -- get the actual bytes in the 'FastString' written to the 'Handle'.
 
 -- |Outputs a 'FastString' with /no decoding at all/, that is, you
 -- get the actual bytes in the 'FastString' written to the 'Handle'.

+hPutFS :: Handle -> FastString -> IO ()

 hPutFS handle (FastString _ len _ fp _)
   | len == 0  = return ()
   | otherwise = do withForeignPtr fp $ \ptr -> hPutBuf handle ptr len
 hPutFS handle (FastString _ len _ fp _)
   | len == 0  = return ()
   | otherwise = do withForeignPtr fp $ \ptr -> hPutBuf handle ptr len

@@ -500,7 +504,6 @@ type LitString = Ptr Word8
 mkLitString# :: Addr# -> LitString
 mkLitString# a# = Ptr a#
 #endif
 mkLitString# :: Addr# -> LitString
 mkLitString# a# = Ptr a#
 #endif

-

 --can/should we use FastTypes here?
 --Is this likely to be memory-preserving if only used on constant strings?
 --should we inline it? If lucky, that would make a CAF that wouldn't
 --can/should we use FastTypes here?
 --Is this likely to be memory-preserving if only used on constant strings?
 --should we inline it? If lucky, that would make a CAF that wouldn't

@@ -519,6 +522,9 @@ mkLitString s =
      loop n (c:cs) = do
         pokeByteOff p n (fromIntegral (ord c) :: Word8)
         loop (1+n) cs
      loop n (c:cs) = do
         pokeByteOff p n (fromIntegral (ord c) :: Word8)
         loop (1+n) cs

+     -- XXX GHC isn't smart enough to know that we have already covered
+     -- this case.
+     loop _ [] = panic "mkLitString"

    loop 0 s
    return p
  )
    loop 0 s
    return p
  )

@@ -562,12 +568,21 @@ foreign import ccall unsafe "ghc_strlen"
 pokeCAString :: Ptr CChar -> String -> IO ()
 pokeCAString ptr str =
   let
 pokeCAString :: Ptr CChar -> String -> IO ()
 pokeCAString ptr str =
   let

-        go [] n     = return ()
+        go [] _     = return ()

         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
   in
   go str 0
 
         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
   in
   go str 0
 

-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 602
-peekCAStringLen = peekCStringLen
-#endif
+{-# NOINLINE sLit #-}
+sLit :: String -> LitString
+sLit x  = mkLitString x
+
+{-# NOINLINE fsLit #-}
+fsLit :: String -> FastString
+fsLit x = mkFastString x
+
+{-# RULES "slit"
+    forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
+{-# RULES "fslit"
+    forall x . fsLit (unpackCString# x) = mkFastString# x #-}

 \end{code}
 \end{code}