primitive 0.5.4.0 → 0.6
raw patch · 5 files changed
+122/−21 lines, 5 filesdep +transformers
Dependencies added: transformers
Files
- Control/Monad/Primitive.hs +107/−18
- Data/Primitive/Array.hs +2/−0
- changelog.md +8/−0
- primitive.cabal +4/−2
- test/main.hs +1/−1
Control/Monad/Primitive.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP, MagicHash, UnboxedTuples, TypeFamilies #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} -- | -- Module : Control.Monad.Primitive@@ -13,7 +14,8 @@ module Control.Monad.Primitive ( PrimMonad(..), RealWorld, primitive_,- primToPrim, primToIO, primToST,+ PrimBase(..),+ liftPrim, primToPrim, primToIO, primToST, unsafePrimToPrim, unsafePrimToIO, unsafePrimToST, unsafeInlinePrim, unsafeInlineIO, unsafeInlineST, touch@@ -28,7 +30,27 @@ #endif import GHC.ST ( ST(..) ) --- | Class of primitive state-transformer monads+import Control.Monad.Trans.Class (lift)+import Data.Monoid (Monoid)++import Control.Monad.Trans.Identity ( IdentityT)+import Control.Monad.Trans.List ( ListT )+import Control.Monad.Trans.Maybe ( MaybeT )+import Control.Monad.Trans.Error ( ErrorT, Error)+import Control.Monad.Trans.Reader ( ReaderT )+import Control.Monad.Trans.State ( StateT )+import Control.Monad.Trans.Writer ( WriterT )+import Control.Monad.Trans.RWS ( RWST )++#if MIN_VERSION_transformers(0,4,0)+import Control.Monad.Trans.Except ( ExceptT )+#endif++import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST )+import qualified Control.Monad.Trans.State.Strict as Strict ( StateT )+import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )++-- | Class of monads which can perform primitive state-transformer actions class Monad m => PrimMonad m where -- | State token type type PrimState m@@ -36,7 +58,12 @@ -- | Execute a primitive operation primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a -+-- | Class of primitive monads for state-transformer actions.+--+-- Unlike 'PrimMonad', this typeclass requires that the @Monad@ be fully+-- expressed as a state transformer, therefore disallowing other monad+-- transformers on top of the base @IO@ or @ST@.+class PrimMonad m => PrimBase m where -- | Expose the internal structure of the monad internal :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #) @@ -51,51 +78,113 @@ instance PrimMonad IO where type PrimState IO = RealWorld primitive = IO- internal (IO p) = p {-# INLINE primitive #-}+instance PrimBase IO where+ internal (IO p) = p {-# INLINE internal #-} +instance PrimMonad m => PrimMonad (IdentityT m) where+ type PrimState (IdentityT m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance PrimMonad m => PrimMonad (ListT m) where+ type PrimState (ListT m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance PrimMonad m => PrimMonad (MaybeT m) where+ type PrimState (MaybeT m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance (Error e, PrimMonad m) => PrimMonad (ErrorT e m) where+ type PrimState (ErrorT e m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance PrimMonad m => PrimMonad (ReaderT r m) where+ type PrimState (ReaderT r m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance PrimMonad m => PrimMonad (StateT s m) where+ type PrimState (StateT s m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance (Monoid w, PrimMonad m) => PrimMonad (WriterT w m) where+ type PrimState (WriterT w m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance (Monoid w, PrimMonad m) => PrimMonad (RWST r w s m) where+ type PrimState (RWST r w s m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}++#if MIN_VERSION_transformers(0,4,0)+instance PrimMonad m => PrimMonad (ExceptT e m) where+ type PrimState (ExceptT e m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+#endif++instance PrimMonad m => PrimMonad (Strict.StateT s m) where+ type PrimState (Strict.StateT s m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance (Monoid w, PrimMonad m) => PrimMonad (Strict.WriterT w m) where+ type PrimState (Strict.WriterT w m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+instance (Monoid w, PrimMonad m) => PrimMonad (Strict.RWST r w s m) where+ type PrimState (Strict.RWST r w s m) = PrimState m+ primitive = lift . primitive+ {-# INLINE primitive #-}+ instance PrimMonad (ST s) where type PrimState (ST s) = s primitive = ST- internal (ST p) = p {-# INLINE primitive #-}+instance PrimBase (ST s) where+ internal (ST p) = p {-# INLINE internal #-} --- | Convert a 'PrimMonad' to another monad with the same state token.-primToPrim :: (PrimMonad m1, PrimMonad m2, PrimState m1 ~ PrimState m2)+-- | Lifts a 'PrimBase' into another 'PrimMonad' with the same underlying state+-- token type.+liftPrim+ :: (PrimBase m1, PrimMonad m2, PrimState m1 ~ PrimState m2) => m1 a -> m2 a+{-# INLINE liftPrim #-}+liftPrim = primToPrim++-- | Convert a 'PrimBase' to another monad with the same state token.+primToPrim :: (PrimBase 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+-- | Convert a 'PrimBase' with a 'RealWorld' state token to 'IO'+primToIO :: (PrimBase 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+-- | Convert a 'PrimBase' to 'ST'+primToST :: PrimBase m => m a -> ST (PrimState m) a {-# INLINE primToST #-} primToST = primToPrim --- | Convert a 'PrimMonad' to another monad with a possibly different state+-- | Convert a 'PrimBase' to another monad with a possibly different state -- token. This operation is highly unsafe!-unsafePrimToPrim :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a+unsafePrimToPrim :: (PrimBase 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+-- | Convert any 'PrimBase' to 'ST' with an arbitrary state token. This -- operation is highly unsafe!-unsafePrimToST :: PrimMonad m => m a -> ST s a+unsafePrimToST :: PrimBase 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+-- | Convert any 'PrimBase' to 'IO'. This operation is highly unsafe!+unsafePrimToIO :: PrimBase m => m a -> IO a {-# INLINE unsafePrimToIO #-} unsafePrimToIO = unsafePrimToPrim -unsafeInlinePrim :: PrimMonad m => m a -> a+unsafeInlinePrim :: PrimBase m => m a -> a {-# INLINE unsafeInlinePrim #-} unsafeInlinePrim m = unsafeInlineIO (unsafePrimToIO m)
Data/Primitive/Array.hs view
@@ -29,7 +29,9 @@ import Data.Data ( Data(..) ) import Data.Primitive.Internal.Compat ( isTrue#, mkNoRepType ) +#if !(__GLASGOW_HASKELL__ >= 702) import Control.Monad.ST(runST)+#endif -- | Boxed arrays data Array a = Array (Array# a) deriving ( Typeable )
changelog.md view
@@ -1,3 +1,11 @@+## Changes in version 0.6++ * Split PrimMonad into two classes to allow automatic lifting of primitive+ operations into monad transformers. The `internal` operation has moved to the+ `PrimBase` class.++ * Fixed the test suite on older GHCs+ ## Changes in version 0.5.4.0 * Changed primitive_ to work around an oddity with GHC's code generation
primitive.cabal view
@@ -1,5 +1,5 @@ Name: primitive-Version: 0.5.4.0+Version: 0.6 License: BSD3 License-File: LICENSE @@ -36,7 +36,9 @@ Data.Primitive.Internal.Compat Data.Primitive.Internal.Operations - Build-Depends: base >= 4.3 && < 4.9, ghc-prim >= 0.2 && < 0.4+ Build-Depends: base >= 4.3 && < 4.9+ , ghc-prim >= 0.2 && < 0.5+ , transformers >= 0.2 && < 0.5 Ghc-Options: -O2 -Wall
test/main.hs view
@@ -15,7 +15,7 @@ case writeArray arr 0 'B' of IO f -> case f realWorld# of- _ -> ()+ (# _, _ #) -> () c1 <- readArray arr 0 return $! unit c2 <- readArray arr 0