compiler/utils/FastFunctions.lhs

   1 Z%
   2 % (c) The University of Glasgow, 2000-2006
   3 %
   4 \section{Fast functions}
   5
   6 \begin{code}
   7
   8 module FastFunctions (
   9     unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO,
  10     indexWord8OffFastPtr,
  11     indexWord8OffFastPtrAsFastChar, indexWord8OffFastPtrAsFastInt,
  12     global, Global
  13   ) where
  14
  15 #define COMPILING_FAST_STRING
  16 #include "HsVersions.h"
  17
  18 import FastTypes
  19 import Data.IORef
  20 import System.IO.Unsafe
  21
  22 #if defined(__GLASGOW_HASKELL__)
  23
  24 import GHC.Exts
  25 import GHC.Word
  26 import GHC.IOBase (IO(..))
  27 --why not import it at __GLASGOW_HASKELL__==606 ?
  28 #if __GLASGOW_HASKELL__ >= 607
  29 import GHC.IOBase (unsafeDupableInterleaveIO)
  30 #endif
  31 import GHC.Base (unsafeChr)
  32
  33 #if __GLASGOW_HASKELL__ < 607
  34 unsafeDupableInterleaveIO :: IO a -> IO a
  35 unsafeDupableInterleaveIO = unsafeInterleaveIO
  36 #endif
  37
  38 -- Just like unsafePerformIO, but we inline it.
  39 {-# INLINE inlinePerformIO #-}
  40 inlinePerformIO :: IO a -> a
  41 inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
  42
  43 indexWord8OffFastPtr p i = W8# (indexWord8OffAddr# p i)
  44 indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
  45 indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
  46 -- or ord# (indexCharOffAddr# p i)
  47
  48 #else /* ! __GLASGOW_HASKELL__ */
  49
  50 import Foreign.Ptr
  51 import Data.Word
  52
  53 -- hey, no harm inlining it, :-P
  54 {-# INLINE inlinePerformIO #-}
  55 inlinePerformIO :: IO a -> a
  56 inlinePerformIO = unsafePerformIO
  57
  58 unsafeDupableInterleaveIO :: IO a -> IO a
  59 unsafeDupableInterleaveIO = unsafeInterleaveIO
  60
  61 -- truly, these functions are unsafe: they assume
  62 -- a certain immutability of the pointer's target area.
  63 indexWord8OffFastPtr p i = inlinePerformIO (peekByteOff p n) :: Word8
  64 indexWord8OffFastPtrAsFastInt p i =
  65   iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8))
  66 indexWord8OffFastPtrAsFastChar p i =
  67   fastChr (iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8)))
  68
  69 #endif /* ! __GLASGOW_HASKELL__ */
  70
  71 --just so we can refer to the type clearly in a macro
  72 type Global a = IORef a
  73 global :: a -> Global a
  74 global a = unsafePerformIO (newIORef a)
  75
  76 indexWord8OffFastPtr :: FastPtr Word8 -> FastInt -> Word8
  77 indexWord8OffFastPtrAsFastChar :: FastPtr Word8 -> FastInt -> FastChar
  78 indexWord8OffFastPtrAsFastInt :: FastPtr Word8 -> FastInt -> FastInt
  79
  80 \end{code}