hasim-0.1: Process-Based Discrete Event Simulation librarySource codeContentsIndex
Control.Hasim.Process
Portabilityunportable
Stabilityexperimental
Maintainerjochem@functor.nl
Description
This module takes care of defining processes and their actions.
Synopsis
data Proc pkt st = Proc {
acceptor :: IORef [(Acceptor pkt st, Maybe Runnable)]
wakeup :: IORef (Maybe Runnable)
action :: IORef (Maybe Runnable)
identifier :: Id
name :: String
currentState :: IORef st
}
type Acceptor pkt st = pkt -> AcceptResult pkt st
data Process = forall pkt st . Process (Proc pkt st)
data PrimAction where
Ret :: a -> PrimAction pkt st a
Wait :: Time -> PrimAction pkt st ()
Send :: snd -> Proc snd st2 -> Time -> PrimAction pkt st Bool
Unwatch :: Proc rcv st2 -> PrimAction pkt st ()
WithAcceptor :: Acceptor pkt st -> Action pkt st () -> PrimAction pkt st ()
PopAcceptor :: PrimAction pkt st ()
PerformIO :: IO a -> PrimAction pkt st a
ObserveTime :: PrimAction pkt st Time
GetState :: PrimAction pkt st st
PutState :: st -> PrimAction pkt st ()
WaitForever :: PrimAction pkt st ()
data Action where
Prim :: PrimAction pkt st a -> Action pkt st a
data Atom = forall a st pkt . Atom (PrimAction pkt st a)
data Runnable = forall a pkt st . Run (Proc pkt st) (PrimAction pkt st a) (Maybe (a -> Runnable))
runnable2process :: Runnable -> Process
toRunnable :: Proc pkt st -> Action pkt st () -> Runnable
data AcceptResult pkt st
= Refuse
| Parallel (st -> st)
| Interrupt (Action pkt st ())
Documentation
data Proc pkt st Source
A Proc st pkt is a process that potentially accepts packets of type pkt while maintaining state st.
Constructors
Proc
acceptor :: IORef [(Acceptor pkt st, Maybe Runnable)]The list of acceptors with the continuations after the WithAcceptor.
wakeup :: IORef (Maybe Runnable)The current wakeup function, if any.
action :: IORef (Maybe Runnable)The starting action. Loses its relevance after startup of the simulation.
identifier :: IdThe identifier of this process. Must be unique or hell will ensue. Guaranteed to be unique by the creator of the process.
name :: StringThe name of the process. Determined by the user, may be any string. Used for displaying information to the user.
currentState :: IORef stThe state of the process.
show/hide Instances
Eq (Proc pkt st)
Ord (Proc pkt st)
Show (Proc pkt st)
type Acceptor pkt st = pkt -> AcceptResult pkt stSource
An acceptor of a pkt is an AcceptResult, which is either * Refuse if the packet is to be delivered at a later time, or never, of course * Parallel act if a current computation should not be suspended, but the state should be changed. * Interrupt act if the current computation should be suspended.
data Process Source
Existential type for a Proc. A Process is a Proc pkt for some pkt.
Constructors
forall pkt st . Process (Proc pkt st)
show/hide Instances
data PrimAction whereSource

GADT for the primitive actions. These are the primitives Hasim supports.

A PrimAction pkt st a is a primitive action where * pkt is the packet type the associated Proc supports. * st is the state of the associated Proc. * a is the return type of the PrimAction. (this is why we need a GADT; the return type varies for each primitive action).

Constructors
Ret :: a -> PrimAction pkt st a
Wait :: Time -> PrimAction pkt st ()
Send :: snd -> Proc snd st2 -> Time -> PrimAction pkt st Bool
Unwatch :: Proc rcv st2 -> PrimAction pkt st ()
WithAcceptor :: Acceptor pkt st -> Action pkt st () -> PrimAction pkt st ()
PopAcceptor :: PrimAction pkt st ()
PerformIO :: IO a -> PrimAction pkt st a
ObserveTime :: PrimAction pkt st Time
GetState :: PrimAction pkt st st
PutState :: st -> PrimAction pkt st ()
WaitForever :: PrimAction pkt st ()
show/hide Instances
Show (PrimAction pkt st a)
data Action whereSource
The Action GADT. This is a GADT with three parameters; an Action pkt st a is a action where * pkt denotes the packet type of incoming packets * st denotes the state that can be modified and inspected * a denotes the result value of the Action
Constructors
Prim :: PrimAction pkt st a -> Action pkt st a
show/hide Instances
MonadState st (Action pkt st)
Monad (Action pkt st)
MonadIO (Action pkt st)
data Atom Source
Existential type for the PrimAction type.
Constructors
forall a st pkt . Atom (PrimAction pkt st a)
data Runnable Source
A Runnable is an action that can be run. A Runnable has three parameters: * The first is the process to which this Runnable belongs. * The second is a primitive action to be run. * The third is Maybe a continuation.
Constructors
forall a pkt st . Run (Proc pkt st) (PrimAction pkt st a) (Maybe (a -> Runnable))
runnable2process :: Runnable -> ProcessSource
Finds the Process (existential type) belonging to a Runnable.
toRunnable :: Proc pkt st -> Action pkt st () -> RunnableSource
Converts a process with an action to a Runnable.
data AcceptResult pkt st Source
The type of result of the Acceptor
Constructors
Refuse
Parallel (st -> st)
Interrupt (Action pkt st ())
Produced by Haddock version 2.3.0