diff options
| -rw-r--r-- | compiler/HsVersions.h | 8 | ||||
| -rw-r--r-- | compiler/utils/FastString.lhs | 32 |
2 files changed, 25 insertions, 15 deletions
diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h index 1ba8a01022..14f14233ff 100644 --- a/compiler/HsVersions.h +++ b/compiler/HsVersions.h @@ -60,14 +60,6 @@ name = Util.global (value); #define WARN(e,msg) if False && (e) then pprPanic "WARN" (msg) else #endif -#if defined(__GLASGOW_HASKELL__) -#define SLIT(x) (FastString.mkLitString# (x#)) -#define FSLIT(x) (FastString.mkFastString# (x#)) -#else -#define SLIT(x) (FastString.mkLitString (x)) -#define FSLIT(x) (FastString.mkFastString (x)) -#endif - -- Useful for declaring arguments to be strict #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs index 4417c0850f..5651cec3f4 100644 --- a/compiler/utils/FastString.lhs +++ b/compiler/utils/FastString.lhs @@ -62,13 +62,15 @@ module FastString LitString, #if defined(__GLASGOW_HASKELL__) mkLitString#, -#else - mkLitString, #endif + mkLitString, unpackLitString, strLength, - ptrStrLength + ptrStrLength, + + sLit, + fsLit, ) where #include "HsVersions.h" @@ -85,12 +87,13 @@ import System.IO import System.IO.Unsafe ( unsafePerformIO ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Data.Maybe ( isJust ) -#if !defined(__GLASGOW_HASKELL__) import Data.Char ( ord ) -#endif 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# @@ -500,7 +503,7 @@ type LitString = Ptr Word8 #if defined(__GLASGOW_HASKELL__) mkLitString# :: Addr# -> LitString mkLitString# a# = Ptr a# -#else +#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 @@ -519,10 +522,12 @@ mkLitString s = 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 ) -#endif unpackLitString :: LitString -> String unpackLitString p_ = case pUnbox p_ of @@ -571,4 +576,17 @@ pokeCAString ptr str = #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} |