{-# LANGUAGE CPP, MagicHash, UnboxedTuples, TypeFamilies #-} -- | -- Module : Control.Monad.Primitive -- Copyright : (c) Roman Leshchinskiy 2009 -- License : BSD-style -- -- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Portability : non-portable -- -- Primitive state-transformer monads -- module Control.Monad.Primitive ( PrimMonad(..), RealWorld, primitive_, primToPrim, primToIO, primToST, unsafePrimToPrim, unsafePrimToIO, unsafePrimToST, unsafeInlinePrim, unsafeInlineIO, unsafeInlineST, touch ) where import GHC.Prim ( State#, RealWorld, touch# ) import GHC.Base ( unsafeCoerce#, realWorld# ) #if MIN_VERSION_base(4,2,0) import GHC.IO ( IO(..) ) #else import GHC.IOBase ( IO(..) ) #endif import GHC.ST ( ST(..) ) -- | Class of primitive state-transformer monads class Monad m => PrimMonad m where -- | State token type type PrimState m -- | Execute a primitive operation primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a -- | Expose the internal structure of the monad internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #) -- | Execute a primitive operation with no result primitive_ :: PrimMonad m => (State# (PrimState m) -> State# (PrimState m)) -> m () {-# INLINE primitive_ #-} primitive_ f = primitive (\s# -> (# f s#, () #)) instance PrimMonad IO where type PrimState IO = RealWorld primitive = IO internal (IO p) = p {-# INLINE primitive #-} {-# INLINE internal #-} instance PrimMonad (ST s) where type PrimState (ST s) = s primitive = ST internal (ST p) = p {-# INLINE primitive #-} {-# INLINE internal #-} -- | Convert a 'PrimMonad' to another monad with the same state token. primToPrim :: (PrimMonad m1, PrimMonad m2, PrimState m1 ~ PrimState m2) => m1 a -> m2 a {-# INLINE primToPrim #-} primToPrim m = primitive (internal m) -- | Convert a 'PrimMonad' with a 'RealWorld' state token to 'IO' primToIO :: (PrimMonad m, PrimState m ~ RealWorld) => m a -> IO a {-# INLINE primToIO #-} primToIO = primToPrim -- | Convert a 'PrimMonad' to 'ST' primToST :: PrimMonad m => m a -> ST (PrimState m) a {-# INLINE primToST #-} primToST = primToPrim -- | Convert a 'PrimMonad' to another monad with a possibly different state -- token. This operation is highly unsafe! unsafePrimToPrim :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a {-# INLINE unsafePrimToPrim #-} unsafePrimToPrim m = primitive (unsafeCoerce# (internal m)) -- | Convert any 'PrimMonad' to 'ST' with an arbitrary state token. This -- operation is highly unsafe! unsafePrimToST :: PrimMonad m => m a -> ST s a {-# INLINE unsafePrimToST #-} unsafePrimToST = unsafePrimToPrim -- | Convert any 'PrimMonad' to 'IO'. This operation is highly unsafe! unsafePrimToIO :: PrimMonad m => m a -> IO a {-# INLINE unsafePrimToIO #-} unsafePrimToIO = unsafePrimToPrim unsafeInlinePrim :: PrimMonad m => m a -> a {-# INLINE unsafeInlinePrim #-} unsafeInlinePrim m = unsafeInlineIO (unsafePrimToIO m) unsafeInlineIO :: IO a -> a {-# INLINE unsafeInlineIO #-} unsafeInlineIO m = case internal m realWorld# of (# _, r #) -> r unsafeInlineST :: ST s a -> a {-# INLINE unsafeInlineST #-} unsafeInlineST = unsafeInlinePrim touch :: PrimMonad m => a -> m () {-# INLINE touch #-} touch x = unsafePrimToPrim $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ())