about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/primitive/Control
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/primitive/Control')
-rw-r--r--third_party/bazel/rules_haskell/examples/primitive/Control/Monad/Primitive.hs298
1 files changed, 0 insertions, 298 deletions
diff --git a/third_party/bazel/rules_haskell/examples/primitive/Control/Monad/Primitive.hs b/third_party/bazel/rules_haskell/examples/primitive/Control/Monad/Primitive.hs
deleted file mode 100644
index f182c18b086b..000000000000
--- a/third_party/bazel/rules_haskell/examples/primitive/Control/Monad/Primitive.hs
+++ /dev/null
@@ -1,298 +0,0 @@
-{-# LANGUAGE CPP, MagicHash, UnboxedTuples, TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-
--- |
--- 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_,
-  PrimBase(..),
-  liftPrim, primToPrim, primToIO, primToST, ioToPrim, stToPrim,
-  unsafePrimToPrim, unsafePrimToIO, unsafePrimToST, unsafeIOToPrim,
-  unsafeSTToPrim, unsafeInlinePrim, unsafeInlineIO, unsafeInlineST,
-  touch, evalPrim
-) where
-
-import GHC.Prim   ( State#, RealWorld, touch# )
-import GHC.Base   ( unsafeCoerce#, realWorld# )
-#if MIN_VERSION_base(4,4,0)
-import GHC.Base   ( seq# )
-#else
-import Control.Exception (evaluate)
-#endif
-#if MIN_VERSION_base(4,2,0)
-import GHC.IO     ( IO(..) )
-#else
-import GHC.IOBase ( IO(..) )
-#endif
-import GHC.ST     ( ST(..) )
-
-import Control.Monad.Trans.Class (lift)
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid (Monoid)
-#endif
-
-import Control.Monad.Trans.Cont     ( ContT    )
-import Control.Monad.Trans.Identity ( IdentityT (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
-
-#if MIN_VERSION_transformers(0,5,3)
-import Control.Monad.Trans.Accum    ( AccumT   )
-import Control.Monad.Trans.Select   ( SelectT  )
-#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
-
-  -- | 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@.
---
--- @since 0.6.0.0
-class PrimMonad m => PrimBase m where
-  -- | 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# ->
-    case f s# of
-        s'# -> (# s'#, () #))
-
-instance PrimMonad IO where
-  type PrimState IO = RealWorld
-  primitive = IO
-  {-# INLINE primitive #-}
-instance PrimBase IO where
-  internal (IO p) = p
-  {-# INLINE internal #-}
-
--- | @since 0.6.3.0
-instance PrimMonad m => PrimMonad (ContT r m) where
-  type PrimState (ContT r m) = PrimState m
-  primitive = lift . primitive
-  {-# INLINE primitive #-}
-
-instance PrimMonad m => PrimMonad (IdentityT m) where
-  type PrimState (IdentityT m) = PrimState m
-  primitive = lift . primitive
-  {-# INLINE primitive #-}
-
--- | @since 0.6.2.0
-instance PrimBase m => PrimBase (IdentityT m) where
-  internal (IdentityT m) = internal m
-  {-# INLINE internal #-}
-
-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
-
-#if MIN_VERSION_transformers(0,5,3)
--- | @since 0.6.3.0
-instance ( Monoid w
-         , PrimMonad m
-# if !(MIN_VERSION_base(4,8,0))
-         , Functor m
-# endif
-         ) => PrimMonad (AccumT w m) where
-  type PrimState (AccumT w m) = PrimState m
-  primitive = lift . primitive
-  {-# INLINE primitive #-}
-instance PrimMonad m => PrimMonad (SelectT r m) where
-  type PrimState (SelectT r 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
-  {-# INLINE primitive #-}
-instance PrimBase (ST s) where
-  internal (ST p) = p
-  {-# INLINE internal #-}
-
--- | 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 'PrimBase' with a 'RealWorld' state token to 'IO'
-primToIO :: (PrimBase m, PrimState m ~ RealWorld) => m a -> IO a
-{-# INLINE primToIO #-}
-primToIO = primToPrim
-
--- | Convert a 'PrimBase' to 'ST'
-primToST :: PrimBase m => m a -> ST (PrimState m) a
-{-# INLINE primToST #-}
-primToST = primToPrim
-
--- | Convert an 'IO' action to a 'PrimMonad'.
--- 
--- @since 0.6.2.0
-ioToPrim :: (PrimMonad m, PrimState m ~ RealWorld) => IO a -> m a
-{-# INLINE ioToPrim #-}
-ioToPrim = primToPrim
-
--- | Convert an 'ST' action to a 'PrimMonad'.
---
--- @since 0.6.2.0
-stToPrim :: PrimMonad m => ST (PrimState m) a -> m a
-{-# INLINE stToPrim #-}
-stToPrim = primToPrim
-
--- | Convert a 'PrimBase' to another monad with a possibly different state
--- token. This operation is highly unsafe!
-unsafePrimToPrim :: (PrimBase m1, PrimMonad m2) => m1 a -> m2 a
-{-# INLINE unsafePrimToPrim #-}
-unsafePrimToPrim m = primitive (unsafeCoerce# (internal m))
-
--- | Convert any 'PrimBase' to 'ST' with an arbitrary state token. This
--- operation is highly unsafe!
-unsafePrimToST :: PrimBase m => m a -> ST s a
-{-# INLINE unsafePrimToST #-}
-unsafePrimToST = unsafePrimToPrim
-
--- | Convert any 'PrimBase' to 'IO'. This operation is highly unsafe!
-unsafePrimToIO :: PrimBase m => m a -> IO a
-{-# INLINE unsafePrimToIO #-}
-unsafePrimToIO = unsafePrimToPrim
-
--- | Convert an 'ST' action with an arbitraty state token to any 'PrimMonad'.
--- This operation is highly unsafe!
--- 
--- @since 0.6.2.0
-unsafeSTToPrim :: PrimMonad m => ST s a -> m a
-{-# INLINE unsafeSTToPrim #-}
-unsafeSTToPrim = unsafePrimToPrim
-
--- | Convert an 'IO' action to any 'PrimMonad'. This operation is highly
--- unsafe!
---
--- @since 0.6.2.0
-unsafeIOToPrim :: PrimMonad m => IO a -> m a
-{-# INLINE unsafeIOToPrim #-}
-unsafeIOToPrim = unsafePrimToPrim
-
-unsafeInlinePrim :: PrimBase 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 ())
-
--- | Create an action to force a value; generalizes 'Control.Exception.evaluate'
---
--- @since 0.6.2.0
-evalPrim :: forall a m . PrimMonad m => a -> m a
-#if MIN_VERSION_base(4,4,0)
-evalPrim a = primitive (\s -> seq# a s)
-#else
--- This may or may not work so well, but there's probably nothing better to do.
-{-# NOINLINE evalPrim #-}
-evalPrim a = unsafePrimToPrim (evaluate a :: IO a)
-#endif