io-sim-por: introduced InternalTypes module

Share
* `ThreadControl`
* `ControlStack`
between `IOSim` and `IOSimPOR`.

Author: coot

io-sim/io-sim.cabal

@@ -29,6 +29,7 @@ library
                        Control.Monad.IOSim,
                        Control.Monad.IOSim.Types
   other-modules:       Control.Monad.IOSim.Internal,
+                       Control.Monad.IOSim.InternalTypes,
                        Control.Monad.IOSimPOR.Internal,
                        Control.Monad.IOSimPOR.QuickCheckUtils,
                        Control.Monad.IOSimPOR.Timeout

io-sim/src/Control/Monad/IOSim/Internal.hs

@@ -78,6 +78,7 @@ import           Control.Monad.Class.MonadTime
 import           Control.Monad.Class.MonadTimer
 
 import           Control.Monad.IOSim.Types
+import           Control.Monad.IOSim.InternalTypes
 
 --
 -- Simulation interpreter
@@ -95,27 +96,6 @@ data Thread s a = Thread {
     threadNextTId :: !Int
   }
 
--- We hide the type @b@ here, so it's useful to bundle these two parts
--- together, rather than having Thread have an extential type, which
--- makes record updates awkward.
-data ThreadControl s a where
-  ThreadControl :: SimA s b
-                -> ControlStack s b a
-                -> ThreadControl s a
-
-data ControlStack s b a where
-  MainFrame  :: ControlStack s a  a
-  ForkFrame  :: ControlStack s () a
-  MaskFrame  :: (b -> SimA s c)         -- subsequent continuation
-             -> MaskingState            -- thread local state to restore
-             -> ControlStack s c a
-             -> ControlStack s b a
-  CatchFrame :: Exception e
-             => (e -> SimA s b)         -- exception continuation
-             -> (b -> SimA s c)         -- subsequent continuation
-             -> ControlStack s c a
-             -> ControlStack s b a
-
 labelledTVarId :: TVar s a -> ST s (Labelled TVarId)
 labelledTVarId TVar { tvarId, tvarLabel } = (Labelled tvarId) <$> readSTRef tvarLabel
 

io-sim/src/Control/Monad/IOSim/InternalTypes.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE GADTs              #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+-- | Internal types shared between `IOSim` and `IOSimPOR`.
+--
+module Control.Monad.IOSim.InternalTypes
+  ( ThreadControl (..)
+  , ControlStack (..)
+  ) where
+
+import           Control.Exception (Exception)
+import           Control.Monad.Class.MonadThrow (MaskingState (..))
+
+import           Control.Monad.IOSim.Types (SimA)
+
+
+-- We hide the type @b@ here, so it's useful to bundle these two parts
+-- together, rather than having Thread have an extential type, which
+-- makes record updates awkward.
+data ThreadControl s a where
+  ThreadControl :: SimA s b
+                -> ControlStack s b a
+                -> ThreadControl s a
+
+instance Show (ThreadControl s a) where
+  show _ = "..."
+
+data ControlStack s b a where
+  MainFrame  :: ControlStack s a  a
+  ForkFrame  :: ControlStack s () a
+  MaskFrame  :: (b -> SimA s c)         -- subsequent continuation
+             -> MaskingState            -- thread local state to restore
+             -> ControlStack s c a
+             -> ControlStack s b a
+  CatchFrame :: Exception e
+             => (e -> SimA s b)         -- exception continuation
+             -> (b -> SimA s c)         -- subsequent continuation
+             -> ControlStack s c a
+             -> ControlStack s b a
+
+instance Show (ControlStack s b a) where
+  show = show . dash
+    where dash :: ControlStack s' b' a' -> ControlStackDash
+          dash MainFrame = MainFrame'
+          dash ForkFrame = ForkFrame'
+          dash (MaskFrame _ m s) = MaskFrame' m (dash s)
+          dash (CatchFrame _ _ s) = CatchFrame' (dash s)
+
+data ControlStackDash =
+    MainFrame'
+  | ForkFrame'
+  | MaskFrame' MaskingState ControlStackDash
+  | CatchFrame' ControlStackDash
+  deriving Show

io-sim/src/Control/Monad/IOSimPOR/Internal.hs

@@ -80,6 +80,7 @@ import           Control.Monad.Class.MonadTime
 import           Control.Monad.Class.MonadTimer
 
 import           Control.Monad.IOSim.Types
+import           Control.Monad.IOSim.InternalTypes
 import           Control.Monad.IOSimPOR.Timeout(unsafeTimeout)
 
 --
@@ -104,45 +105,6 @@ data Thread s a = Thread {
   }
   deriving Show
 
--- We hide the type @b@ here, so it's useful to bundle these two parts
--- together, rather than having Thread have an extential type, which
--- makes record updates awkward.
-data ThreadControl s a where
-  ThreadControl :: SimA s b
-                -> ControlStack s b a
-                -> ThreadControl s a
-
-instance Show (ThreadControl s a) where
-  show _ = "..."
-
-data ControlStack s b a where
-  MainFrame  :: ControlStack s a  a
-  ForkFrame  :: ControlStack s () a
-  MaskFrame  :: (b -> SimA s c)         -- subsequent continuation
-             -> MaskingState            -- thread local state to restore
-             -> ControlStack s c a
-             -> ControlStack s b a
-  CatchFrame :: Exception e
-             => (e -> SimA s b)         -- exception continuation
-             -> (b -> SimA s c)         -- subsequent continuation
-             -> ControlStack s c a
-             -> ControlStack s b a
-
-instance Show (ControlStack s b a) where
-  show = show . dash
-    where dash :: ControlStack s' b' a' -> ControlStackDash
-          dash MainFrame = MainFrame'
-          dash ForkFrame = ForkFrame'
-          dash (MaskFrame _ m s) = MaskFrame' m (dash s)
-          dash (CatchFrame _ _ s) = CatchFrame' (dash s)
-
-data ControlStackDash =
-    MainFrame'
-  | ForkFrame'
-  | MaskFrame' MaskingState ControlStackDash
-  | CatchFrame' ControlStackDash
-  deriving Show
-
 isTestThreadId :: ThreadId -> Bool
 isTestThreadId (TestThreadId _) = True
 isTestThreadId _                = False