cmmTopCodeGen no longer takes DynFlags as an argument
[ghc-hetmet.git] / 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 #include "HsVersions.h"
16
17 import FastTypes
18 import Data.IORef
19 import System.IO.Unsafe
20
21 #if defined(__GLASGOW_HASKELL__)
22
23 import GHC.Exts
24 import GHC.Word
25 import GHC.IO (IO(..), unsafeDupableInterleaveIO)
26 import GHC.Base (unsafeChr)
27
28 -- Just like unsafePerformIO, but we inline it.
29 {-# INLINE inlinePerformIO #-}
30 inlinePerformIO :: IO a -> a
31 inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
32
33 indexWord8OffFastPtr p i = W8# (indexWord8OffAddr# p i)
34 indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
35 indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
36 -- or ord# (indexCharOffAddr# p i)
37
38 #else /* ! __GLASGOW_HASKELL__ */
39
40 import Foreign.Ptr
41 import Data.Word
42
43 -- hey, no harm inlining it, :-P
44 {-# INLINE inlinePerformIO #-}
45 inlinePerformIO :: IO a -> a
46 inlinePerformIO = unsafePerformIO
47
48 unsafeDupableInterleaveIO :: IO a -> IO a
49 unsafeDupableInterleaveIO = unsafeInterleaveIO
50
51 -- truly, these functions are unsafe: they assume
52 -- a certain immutability of the pointer's target area.
53 indexWord8OffFastPtr p i = inlinePerformIO (peekByteOff p n) :: Word8
54 indexWord8OffFastPtrAsFastInt p i =
55   iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8))
56 indexWord8OffFastPtrAsFastChar p i =
57   fastChr (iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8)))
58
59 #endif /* ! __GLASGOW_HASKELL__ */
60
61 --just so we can refer to the type clearly in a macro
62 type Global a = IORef a
63 global :: a -> Global a
64 global a = unsafePerformIO (newIORef a)
65
66 indexWord8OffFastPtr :: FastPtr Word8 -> FastInt -> Word8
67 indexWord8OffFastPtrAsFastChar :: FastPtr Word8 -> FastInt -> FastChar
68 indexWord8OffFastPtrAsFastInt :: FastPtr Word8 -> FastInt -> FastInt
69
70 \end{code}