4761b3ce5e0a546abbbc3626e90d958e84301dc7
[darcs-mirrors/primitive.git] / Control / Monad / Primitive.hs
1 {-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies #-}
2
3 -- |
4 -- Module : Control.Monad.Primitive
5 -- Copyright : (c) Roman Leshchinskiy 2009
6 -- License : BSD-style
7 --
8 -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>
9 -- Portability : non-portable
10 --
11 -- Primitive state-transformer monads
12 --
13
14 module Control.Monad.Primitive (
15 PrimMonad(..), RealWorld, primitive_,
16 primToPrim, primToIO, primToST,
17 unsafePrimToPrim, unsafePrimToIO, unsafePrimToST,
18 unsafeInlinePrim, unsafeInlineIO, unsafeInlineST,
19 touch
20 ) where
21
22 import GHC.Prim ( State#, RealWorld, touch# )
23 import GHC.Base ( unsafeCoerce#, realWorld# )
24 #if MIN_VERSION_base(4,2,0)
25 import GHC.IO ( IO(..) )
26 #else
27 import GHC.IOBase ( IO(..) )
28 #endif
29 import GHC.ST ( ST(..) )
30
31 -- | Class of primitive state-transformer monads
32 class Monad m => PrimMonad m where
33 -- | State token type
34 type PrimState m
35
36 -- | Execute a primitive operation
37 primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
38
39
40 -- | Expose the internal structure of the monad
41 internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
42
43 -- | Execute a primitive operation with no result
44 primitive_ :: PrimMonad m
45 => (State# (PrimState m) -> State# (PrimState m)) -> m ()
46 {-# INLINE primitive_ #-}
47 primitive_ f = primitive (\s# -> (# f s#, () #))
48
49 instance PrimMonad IO where
50 type PrimState IO = RealWorld
51 primitive = IO
52 internal (IO p) = p
53
54 instance PrimMonad (ST s) where
55 type PrimState (ST s) = s
56 primitive = ST
57 internal (ST p) = p
58
59 -- | Convert a 'PrimMonad' to another monad with the same state token.
60 primToPrim :: (PrimMonad m1, PrimMonad m2, PrimState m1 ~ PrimState m2)
61 => m1 a -> m2 a
62 primToPrim m = primitive (internal m)
63
64 -- | Convert a 'PrimMonad' with a 'RealWorld' state token to 'IO'
65 primToIO :: (PrimMonad m, PrimState m ~ RealWorld) => m a -> IO a
66 primToIO = primToPrim
67
68 -- | Convert a 'PrimMonad' to 'ST'
69 primToST :: PrimMonad m => m a -> ST (PrimState m) a
70 primToST = primToPrim
71
72 -- | Convert a 'PrimMonad' to another monad with a possibly different state
73 -- token. This operation is highly unsafe!
74 unsafePrimToPrim :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a
75 unsafePrimToPrim m = primitive (unsafeCoerce# (internal m))
76
77 -- | Convert any 'PrimMonad' to 'ST' with an arbitrary state token. This
78 -- operations is highly unsafe!
79 unsafePrimToST :: PrimMonad m => m a -> ST s a
80 unsafePrimToST = unsafePrimToPrim
81
82 -- | Convert any 'PrimMonad' to 'IO'. This operation is highly unsafe!
83 unsafePrimToIO :: PrimMonad m => m a -> IO a
84 unsafePrimToIO = unsafePrimToPrim
85
86 unsafeInlinePrim :: PrimMonad m => m a -> a
87 {-# INLINE unsafeInlinePrim #-}
88 unsafeInlinePrim m = unsafeInlineIO (unsafePrimToIO m)
89
90 unsafeInlineIO :: IO a -> a
91 {-# INLINE unsafeInlineIO #-}
92 unsafeInlineIO m = case internal m realWorld# of (# _, r #) -> r
93
94 unsafeInlineST :: ST s a -> a
95 {-# INLINE unsafeInlineST #-}
96 unsafeInlineST = unsafeInlinePrim
97
98 touch :: PrimMonad m => a -> m ()
99 touch x = unsafePrimToPrim
100 $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ())
101