packages feed

aivika-transformers (empty) → 2.0

raw patch · 83 files changed

+17188/−0 lines, 83 filesdep +aivikadep +arraydep +basesetup-changed

Dependencies added: aivika, array, base, containers, mtl, random, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, 2010, 2011, 2012, 2013, 2014 David Sorokin <david.sorokin@gmail.com>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
+ Simulation/Aivika/Trans.hs view
@@ -0,0 +1,91 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module re-exports the most part of the library functionality.
+-- But there are modules that must be imported explicitly, though.
+--
+module Simulation.Aivika.Trans
+       (-- * Modules
+        module Simulation.Aivika.Trans.Agent,
+        module Simulation.Aivika.Trans.Arrival,
+        module Simulation.Aivika.Trans.Circuit,
+        module Simulation.Aivika.Trans.Comp,
+        module Simulation.Aivika.Trans.Comp.IO,
+        module Simulation.Aivika.Trans.Comp.Template,
+        module Simulation.Aivika.Trans.Cont,
+        module Simulation.Aivika.Trans.Dynamics,
+        module Simulation.Aivika.Trans.Dynamics.Extra,
+        module Simulation.Aivika.Trans.Dynamics.Memo.Unboxed,
+        module Simulation.Aivika.Trans.Dynamics.Random,
+        module Simulation.Aivika.Trans.Event,
+        module Simulation.Aivika.Trans.Generator,
+        module Simulation.Aivika.Trans.Net,
+        module Simulation.Aivika.Trans.Parameter,
+        module Simulation.Aivika.Trans.Parameter.Random,
+        module Simulation.Aivika.Trans.Process,
+        module Simulation.Aivika.Trans.Processor,
+        module Simulation.Aivika.Trans.Processor.RoundRobbin,
+        module Simulation.Aivika.Trans.QueueStrategy,
+        module Simulation.Aivika.Trans.Ref,
+        module Simulation.Aivika.Trans.Resource,
+        module Simulation.Aivika.Trans.Results,
+        module Simulation.Aivika.Trans.Results.Locale,
+        module Simulation.Aivika.Trans.Results.IO,
+        module Simulation.Aivika.Trans.Server,
+        module Simulation.Aivika.Trans.Signal,
+        module Simulation.Aivika.Trans.Simulation,
+        module Simulation.Aivika.Trans.Specs,
+        module Simulation.Aivika.Trans.Statistics,
+        module Simulation.Aivika.Trans.Statistics.Accumulator,
+        module Simulation.Aivika.Trans.Stream,
+        module Simulation.Aivika.Trans.Stream.Random,
+        module Simulation.Aivika.Trans.Task,
+        module Simulation.Aivika.Trans.Transform,
+        module Simulation.Aivika.Trans.Transform.Extra,
+        module Simulation.Aivika.Trans.Transform.Memo.Unboxed,
+        module Simulation.Aivika.Trans.Var.Unboxed) where
+
+import Simulation.Aivika.Trans.Agent
+import Simulation.Aivika.Trans.Arrival
+import Simulation.Aivika.Trans.Circuit
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Comp.IO
+import Simulation.Aivika.Trans.Comp.Template
+import Simulation.Aivika.Trans.Cont
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+import Simulation.Aivika.Trans.Dynamics.Random
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Net
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Parameter.Random
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Processor.RoundRobbin
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.Results
+import Simulation.Aivika.Trans.Results.Locale
+import Simulation.Aivika.Trans.Results.IO
+import Simulation.Aivika.Trans.Server
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Specs
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Statistics.Accumulator
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Stream.Random
+import Simulation.Aivika.Trans.Task
+import Simulation.Aivika.Trans.Transform
+import Simulation.Aivika.Trans.Transform.Extra
+import Simulation.Aivika.Trans.Transform.Memo.Unboxed
+import Simulation.Aivika.Trans.Var.Unboxed
+ Simulation/Aivika/Trans/Agent.hs view
@@ -0,0 +1,265 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Agent
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module introduces basic entities for the agent-based modeling.
+--
+module Simulation.Aivika.Trans.Agent
+       (Agent,
+        AgentState,
+        newAgent,
+        newState,
+        newSubstate,
+        selectedState,
+        selectedStateChanged,
+        selectedStateChanged_,
+        selectState,
+        stateAgent,
+        stateParent,
+        addTimeout,
+        addTimer,
+        setStateActivation,
+        setStateDeactivation,
+        setStateTransition) where
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+
+--
+-- Agent-based Modeling
+--
+
+-- | Represents an agent.
+data Agent m = Agent { agentMarker             :: SessionMarker m,
+                       agentModeRef            :: ProtoRef m AgentMode,
+                       agentStateRef           :: ProtoRef m (Maybe (AgentState m)), 
+                       agentStateChangedSource :: SignalSource m (Maybe (AgentState m)) }
+
+-- | Represents the agent state.
+data AgentState m = AgentState { stateAgent         :: Agent m,
+                                 -- ^ Return the corresponded agent.
+                                 stateParent        :: Maybe (AgentState m),
+                                 -- ^ Return the parent state or 'Nothing'.
+                                 stateMarker        :: SessionMarker m,
+                                 stateActivateRef   :: ProtoRef m (Event m ()),
+                                 stateDeactivateRef :: ProtoRef m (Event m ()),
+                                 stateTransitRef    :: ProtoRef m (Event m (Maybe (AgentState m))),
+                                 stateVersionRef    :: ProtoRef m Int }
+                  
+data AgentMode = CreationMode
+               | TransientMode
+               | ProcessingMode
+                      
+instance MonadComp m => Eq (Agent m) where
+  x == y = agentMarker x == agentMarker y
+  
+instance MonadComp m => Eq (AgentState m) where
+  x == y = stateMarker x == stateMarker y
+
+fullPath :: AgentState m -> [AgentState m] -> [AgentState m]
+fullPath st acc =
+  case stateParent st of
+    Nothing  -> st : acc
+    Just st' -> fullPath st' (st : acc)
+
+partitionPath :: MonadComp m => [AgentState m] -> [AgentState m] -> ([AgentState m], [AgentState m])
+partitionPath path1 path2 =
+  case (path1, path2) of
+    (h1 : t1, [h2]) | h1 == h2 -> 
+      (reverse path1, path2)
+    (h1 : t1, h2 : t2) | h1 == h2 -> 
+      partitionPath t1 t2
+    _ ->
+      (reverse path1, path2)
+
+findPath :: MonadComp m => Maybe (AgentState m) -> AgentState m -> ([AgentState m], [AgentState m])
+findPath Nothing target = ([], fullPath target [])
+findPath (Just source) target
+  | stateAgent source /= stateAgent target =
+    error "Different agents: findPath."
+  | otherwise =
+    partitionPath path1 path2
+  where
+    path1 = fullPath source []
+    path2 = fullPath target []
+
+traversePath :: MonadComp m => Maybe (AgentState m) -> AgentState m -> Event m ()
+traversePath source target =
+  let (path1, path2) = findPath source target
+      agent = stateAgent target
+      activate st p   = invokeEvent p =<< readProtoRef (stateActivateRef st)
+      deactivate st p = invokeEvent p =<< readProtoRef (stateDeactivateRef st)
+      transit st p    = invokeEvent p =<< readProtoRef (stateTransitRef st)
+      continue st p   = invokeEvent p $ traversePath (Just target) st
+  in Event $ \p ->
+       unless (null path1 && null path2) $
+       do writeProtoRef (agentModeRef agent) TransientMode
+          forM_ path1 $ \st ->
+            do writeProtoRef (agentStateRef agent) (Just st)
+               deactivate st p
+               -- it makes all timeout and timer handlers outdated
+               modifyProtoRef (stateVersionRef st) (1 +)
+          forM_ path2 $ \st ->
+            do writeProtoRef (agentStateRef agent) (Just st)
+               activate st p
+          st' <- transit target p
+          case st' of
+            Nothing ->
+              do writeProtoRef (agentModeRef agent) ProcessingMode
+                 triggerAgentStateChanged p agent
+            Just st' ->
+              continue st' p
+
+-- | Add to the state a timeout handler that will be actuated 
+-- in the specified time period if the state will remain active.
+addTimeout :: MonadComp m => AgentState m -> Double -> Event m () -> Event m ()
+addTimeout st dt action =
+  Event $ \p ->
+  do v <- readProtoRef (stateVersionRef st)
+     let m1 = Event $ \p ->
+           do v' <- readProtoRef (stateVersionRef st)
+              when (v == v') $
+                invokeEvent p action
+         m2 = enqueueEvent (pointTime p + dt) m1
+     invokeEvent p m2
+
+-- | Add to the state a timer handler that will be actuated
+-- in the specified time period and then repeated again many times,
+-- while the state remains active.
+addTimer :: MonadComp m => AgentState m -> Event m Double -> Event m () -> Event m ()
+addTimer st dt action =
+  Event $ \p ->
+  do v <- readProtoRef (stateVersionRef st)
+     let m1 = Event $ \p ->
+           do v' <- readProtoRef (stateVersionRef st)
+              when (v == v') $
+                do invokeEvent p m2
+                   invokeEvent p action
+         m2 = Event $ \p ->
+           do dt' <- invokeEvent p dt
+              invokeEvent p $ enqueueEvent (pointTime p + dt') m1
+     invokeEvent p m2
+
+-- | Create a new state.
+newState :: MonadComp m => Agent m -> Simulation m (AgentState m)
+newState agent =
+  Simulation $ \r ->
+  do let s = runSession r
+     aref <- newProtoRef s $ return ()
+     dref <- newProtoRef s $ return ()
+     tref <- newProtoRef s $ return Nothing
+     vref <- newProtoRef s 0
+     mrkr <- newSessionMarker s
+     return AgentState { stateAgent = agent,
+                         stateParent = Nothing,
+                         stateMarker = mrkr,
+                         stateActivateRef = aref,
+                         stateDeactivateRef = dref,
+                         stateTransitRef = tref,
+                         stateVersionRef = vref }
+
+-- | Create a child state.
+newSubstate :: MonadComp m => AgentState m -> Simulation m (AgentState m)
+newSubstate parent =
+  Simulation $ \r ->
+  do let agent = stateAgent parent
+         s = runSession r
+     aref <- newProtoRef s $ return ()
+     dref <- newProtoRef s $ return ()
+     tref <- newProtoRef s $ return Nothing
+     vref <- newProtoRef s 0
+     mrkr <- newSessionMarker s
+     return AgentState { stateAgent = agent,
+                         stateParent = Just parent,
+                         stateMarker = mrkr,
+                         stateActivateRef= aref,
+                         stateDeactivateRef = dref,
+                         stateTransitRef = tref,
+                         stateVersionRef = vref }
+
+-- | Create an agent.
+newAgent :: MonadComp m => Simulation m (Agent m)
+newAgent =
+  Simulation $ \r ->
+  do let s = runSession r
+     modeRef  <- newProtoRef s CreationMode
+     stateRef <- newProtoRef s Nothing
+     stateChangedSource <- invokeSimulation r newSignalSource
+     mrkr <- newSessionMarker s
+     return Agent { agentMarker = mrkr,
+                    agentModeRef = modeRef,
+                    agentStateRef = stateRef, 
+                    agentStateChangedSource = stateChangedSource }
+
+-- | Return the selected active state.
+selectedState :: MonadComp m => Agent m -> Event m (Maybe (AgentState m))
+selectedState agent =
+  Event $ \p -> readProtoRef (agentStateRef agent)
+                   
+-- | Select the state. The activation and selection are repeated while
+-- there is the transition state defined by 'setStateTransition'.
+selectState :: MonadComp m => AgentState m -> Event m ()
+selectState st =
+  Event $ \p ->
+  do let agent = stateAgent st
+     mode <- readProtoRef (agentModeRef agent)
+     case mode of
+       CreationMode ->
+         do x0 <- readProtoRef (agentStateRef agent)
+            invokeEvent p $ traversePath x0 st
+       TransientMode ->
+         error $
+         "Use the setStateTransition function to define " ++
+         "the transition state: activateState."
+       ProcessingMode ->
+         do x0 @ (Just st0) <- readProtoRef (agentStateRef agent)
+            invokeEvent p $ traversePath x0 st
+
+-- | Set the activation computation for the specified state.
+setStateActivation :: MonadComp m => AgentState m -> Event m () -> Simulation m ()
+setStateActivation st action =
+  Simulation $ \r ->
+  writeProtoRef (stateActivateRef st) action
+  
+-- | Set the deactivation computation for the specified state.
+setStateDeactivation :: MonadComp m => AgentState m -> Event m () -> Simulation m ()
+setStateDeactivation st action =
+  Simulation $ \r ->
+  writeProtoRef (stateDeactivateRef st) action
+  
+-- | Set the transition state which will be next and which is used only
+-- when selecting the state directly with help of 'selectState'.
+-- If the state was activated intermediately, when selecting
+-- another state, then this computation is not used.
+setStateTransition :: MonadComp m => AgentState m -> Event m (Maybe (AgentState m)) -> Simulation m ()
+setStateTransition st action =
+  Simulation $ \r ->
+  writeProtoRef (stateTransitRef st) action
+  
+-- | Trigger the signal when the agent state changes.
+triggerAgentStateChanged :: MonadComp m => Point m -> Agent m -> m ()
+triggerAgentStateChanged p agent =
+  do st <- readProtoRef (agentStateRef agent)
+     invokeEvent p $ triggerSignal (agentStateChangedSource agent) st
+
+-- | Return a signal that notifies about every change of the selected state.
+selectedStateChanged :: Agent m -> Signal m (Maybe (AgentState m))
+selectedStateChanged agent =
+  publishSignal (agentStateChangedSource agent)
+
+-- | Return a signal that notifies about every change of the selected state.
+selectedStateChanged_ :: MonadComp m => Agent m -> Signal m ()
+selectedStateChanged_ agent =
+  mapSignal (const ()) $ selectedStateChanged agent
+ Simulation/Aivika/Trans/Arrival.hs view
@@ -0,0 +1,84 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Arrival
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the types and functions for working with the events
+-- that can represent something that arrive from outside the model, or
+-- represent other things which computation is delayed and hence is not synchronized.
+--
+-- Therefore, the additional information is provided about the time and delay of arrival.
+
+module Simulation.Aivika.Trans.Arrival
+       (Arrival(..),
+        ArrivalTimer,
+        newArrivalTimer,
+        arrivalTimerProcessor,
+        arrivalProcessingTime,
+        arrivalProcessingTimeChanged,
+        arrivalProcessingTimeChanged_) where
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | Accumulates the statistics about that how long the arrived events are processed.
+data ArrivalTimer m =
+  ArrivalTimer { arrivalProcessingTimeRef :: Ref m (SamplingStats Double),
+                 arrivalProcessingTimeChangedSource :: SignalSource m () }
+
+-- | Create a new timer that measures how long the arrived events are processed.
+newArrivalTimer :: MonadComp m => Simulation m (ArrivalTimer m)
+{-# INLINE newArrivalTimer #-}
+newArrivalTimer =
+  do r <- newRef emptySamplingStats
+     s <- newSignalSource
+     return ArrivalTimer { arrivalProcessingTimeRef = r,
+                           arrivalProcessingTimeChangedSource = s }
+
+-- | Return the statistics about that how long the arrived events were processed.
+arrivalProcessingTime :: MonadComp m => ArrivalTimer m -> Event m (SamplingStats Double)
+{-# INLINE arrivalProcessingTime #-}
+arrivalProcessingTime = readRef . arrivalProcessingTimeRef
+
+-- | Return a signal raised when the the processing time statistics changes.
+arrivalProcessingTimeChanged :: MonadComp m => ArrivalTimer m -> Signal m (SamplingStats Double)
+{-# INLINE arrivalProcessingTimeChanged #-}
+arrivalProcessingTimeChanged timer =
+  mapSignalM (const $ arrivalProcessingTime timer) (arrivalProcessingTimeChanged_ timer)
+
+-- | Return a signal raised when the the processing time statistics changes.
+arrivalProcessingTimeChanged_ :: MonadComp m => ArrivalTimer m -> Signal m ()
+{-# INLINE arrivalProcessingTimeChanged_ #-}
+arrivalProcessingTimeChanged_ timer =
+  publishSignal (arrivalProcessingTimeChangedSource timer)
+
+-- | Return a processor that actually measures how much time has passed from
+-- the time of arriving the events.
+arrivalTimerProcessor :: MonadComp m => ArrivalTimer m -> Processor m (Arrival a) (Arrival a)
+{-# INLINABLE arrivalTimerProcessor #-}
+{-# SPECIALISE arrivalTimerProcessor :: ArrivalTimer IO -> Processor IO (Arrival a) (Arrival a) #-}
+arrivalTimerProcessor timer =
+  Processor $ \xs -> Cons $ loop xs where
+    loop xs =
+      do (a, xs) <- runStream xs
+         liftEvent $
+           do t <- liftDynamics time
+              modifyRef (arrivalProcessingTimeRef timer) $
+                addSamplingStats (t - arrivalTime a)
+              triggerSignal (arrivalProcessingTimeChangedSource timer) ()
+         return (a, Cons $ loop xs)
+ Simulation/Aivika/Trans/Circuit.hs view
@@ -0,0 +1,385 @@+
+{-# LANGUAGE RecursiveDo, Arrows #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Circuit
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It represents a circuit synchronized with the event queue.
+-- Also it allows creating the recursive links with help of
+-- the proc-notation.
+--
+-- The implementation is based on the <http://en.wikibooks.org/wiki/Haskell/Arrow_tutorial Arrow Tutorial>.
+--
+module Simulation.Aivika.Trans.Circuit
+       (-- * The Circuit Arrow
+        Circuit(..),
+        -- * Circuit Primitives
+        arrCircuit,
+        accumCircuit,
+        -- * The Arrival Circuit
+        arrivalCircuit,
+        -- * Delaying the Circuit
+        delayCircuit,
+        -- * The Time Circuit
+        timeCircuit,
+        -- * Conditional Computation
+        (<?<),
+        (>?>),
+        filterCircuit,
+        filterCircuitM,
+        neverCircuit,
+        -- * Converting to Signals and Processors
+        circuitSignaling,
+        circuitProcessor,
+        -- * Integrals and Difference Equations
+        integCircuit,
+        sumCircuit,
+        -- * The Circuit Transform
+        circuitTransform) where
+
+import qualified Control.Category as C
+import Control.Arrow
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Dynamics.Memo
+import Simulation.Aivika.Trans.Transform
+import Simulation.Aivika.Trans.SystemDynamics
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | Represents a circuit synchronized with the event queue.
+-- Besides, it allows creating the recursive links with help of
+-- the proc-notation.
+--
+newtype Circuit m a b =
+  Circuit { runCircuit :: a -> Event m (b, Circuit m a b)
+            -- ^ Run the circuit.
+          }
+
+instance MonadComp m => C.Category (Circuit m) where
+
+  id = Circuit $ \a -> return (a, C.id)
+
+  (.) = dot
+    where 
+      (Circuit g) `dot` (Circuit f) =
+        Circuit $ \a ->
+        Event $ \p ->
+        do (b, cir1) <- invokeEvent p (f a)
+           (c, cir2) <- invokeEvent p (g b)
+           return (c, cir2 `dot` cir1)
+
+instance MonadComp m => Arrow (Circuit m) where
+
+  arr f = Circuit $ \a -> return (f a, arr f)
+
+  first (Circuit f) =
+    Circuit $ \(b, d) ->
+    Event $ \p ->
+    do (c, cir) <- invokeEvent p (f b)
+       return ((c, d), first cir)
+
+  second (Circuit f) =
+    Circuit $ \(d, b) ->
+    Event $ \p ->
+    do (c, cir) <- invokeEvent p (f b)
+       return ((d, c), second cir)
+
+  (Circuit f) *** (Circuit g) =
+    Circuit $ \(b, b') ->
+    Event $ \p ->
+    do (c, cir1) <- invokeEvent p (f b)
+       (c', cir2) <- invokeEvent p (g b')
+       return ((c, c'), cir1 *** cir2)
+       
+  (Circuit f) &&& (Circuit g) =
+    Circuit $ \b ->
+    Event $ \p ->
+    do (c, cir1) <- invokeEvent p (f b)
+       (c', cir2) <- invokeEvent p (g b)
+       return ((c, c'), cir1 &&& cir2)
+
+instance (MonadComp m, MonadFix m) => ArrowLoop (Circuit m) where
+
+  loop (Circuit f) =
+    Circuit $ \b ->
+    Event $ \p ->
+    do rec ((c, d), cir) <- invokeEvent p (f (b, d))
+       return (c, loop cir)
+
+instance MonadComp m => ArrowChoice (Circuit m) where
+
+  left x@(Circuit f) =
+    Circuit $ \ebd ->
+    Event $ \p ->
+    case ebd of
+      Left b ->
+        do (c, cir) <- invokeEvent p (f b)
+           return (Left c, left cir)
+      Right d ->
+        return (Right d, left x)
+
+  right x@(Circuit f) =
+    Circuit $ \edb ->
+    Event $ \p ->
+    case edb of
+      Right b ->
+        do (c, cir) <- invokeEvent p (f b)
+           return (Right c, right cir)
+      Left d ->
+        return (Left d, right x)
+
+  x@(Circuit f) +++ y@(Circuit g) =
+    Circuit $ \ebb' ->
+    Event $ \p ->
+    case ebb' of
+      Left b ->
+        do (c, cir1) <- invokeEvent p (f b)
+           return (Left c, cir1 +++ y)
+      Right b' ->
+        do (c', cir2) <- invokeEvent p (g b')
+           return (Right c', x +++ cir2)
+
+  x@(Circuit f) ||| y@(Circuit g) =
+    Circuit $ \ebc ->
+    Event $ \p ->
+    case ebc of
+      Left b ->
+        do (d, cir1) <- invokeEvent p (f b)
+           return (d, cir1 ||| y)
+      Right b' ->
+        do (d, cir2) <- invokeEvent p (g b')
+           return (d, x ||| cir2)
+
+-- | Get a signal transform by the specified circuit.
+circuitSignaling :: MonadComp m => Circuit m a b -> Signal m a -> Signal m b
+circuitSignaling (Circuit cir) sa =
+  Signal { handleSignal = \f ->
+            Event $ \p ->
+            do let s = runSession (pointRun p)
+               r <- newProtoRef s cir
+               invokeEvent p $
+                 handleSignal sa $ \a ->
+                 Event $ \p ->
+                 do cir <- readProtoRef r
+                    (b, Circuit cir') <- invokeEvent p (cir a)
+                    writeProtoRef r cir'
+                    invokeEvent p (f b) }
+
+-- | Transform the circuit to a processor.
+circuitProcessor :: MonadComp m => Circuit m a b -> Processor m a b
+circuitProcessor (Circuit cir) = Processor $ \sa ->
+  Cons $
+  do (a, xs) <- runStream sa
+     (b, cir') <- liftEvent (cir a)
+     let f = runProcessor (circuitProcessor cir')
+     return (b, f xs)
+
+-- | Create a simple circuit by the specified handling function
+-- that runs the computation for each input value to get an output.
+arrCircuit :: MonadComp m => (a -> Event m b) -> Circuit m a b
+arrCircuit f =
+  let x =
+        Circuit $ \a ->
+        Event $ \p ->
+        do b <- invokeEvent p (f a)
+           return (b, x)
+  in x
+
+-- | Accumulator that outputs a value determined by the supplied function.
+accumCircuit :: MonadComp m => (acc -> a -> Event m (acc, b)) -> acc -> Circuit m a b
+accumCircuit f acc =
+  Circuit $ \a ->
+  Event $ \p ->
+  do (acc', b) <- invokeEvent p (f acc a)
+     return (b, accumCircuit f acc') 
+
+-- | A circuit that adds the information about the time points at which 
+-- the values were received.
+arrivalCircuit :: MonadComp m => Circuit m a (Arrival a)
+arrivalCircuit =
+  let loop t0 =
+        Circuit $ \a ->
+        Event $ \p ->
+        let t = pointTime p
+            b = Arrival { arrivalValue = a,
+                          arrivalTime  = t,
+                          arrivalDelay = 
+                            case t0 of
+                              Nothing -> Nothing
+                              Just t0 -> Just (t - t0) }
+        in return (b, loop $ Just t)
+  in loop Nothing
+
+-- | Delay the input by one step using the specified initial value.
+delayCircuit :: MonadComp m => a -> Circuit m a a
+delayCircuit a0 =
+  Circuit $ \a ->
+  return (a0, delayCircuit a)
+
+-- | A circuit that returns the current modeling time.
+timeCircuit :: MonadComp m => Circuit m a Double
+timeCircuit =
+  Circuit $ \a ->
+  Event $ \p ->
+  return (pointTime p, timeCircuit)
+
+-- | Like '>>>' but processes only the represented events.
+(>?>) :: MonadComp m
+         => Circuit m a (Maybe b)
+         -- ^ whether there is an event
+         -> Circuit m b c
+         -- ^ process the event if it presents
+         -> Circuit m a (Maybe c)
+         -- ^ the resulting circuit that processes only the represented events
+whether >?> process =
+  Circuit $ \a ->
+  Event $ \p ->
+  do (b, whether') <- invokeEvent p (runCircuit whether a)
+     case b of
+       Nothing ->
+         return (Nothing, whether' >?> process)
+       Just b  ->
+         do (c, process') <- invokeEvent p (runCircuit process b)
+            return (Just c, whether' >?> process')
+
+-- | Like '<<<' but processes only the represented events.
+(<?<) :: MonadComp m
+         => Circuit m b c
+         -- ^ process the event if it presents
+         -> Circuit m a (Maybe b)
+         -- ^ whether there is an event
+         -> Circuit m a (Maybe c)
+         -- ^ the resulting circuit that processes only the represented events
+(<?<) = flip (>?>)
+
+-- | Filter the circuit, calculating only those parts of the circuit that satisfy
+-- the specified predicate.
+filterCircuit :: MonadComp m => (a -> Bool) -> Circuit m a b -> Circuit m a (Maybe b)
+filterCircuit pred = filterCircuitM (return . pred)
+
+-- | Filter the circuit within the 'Event' computation, calculating only those parts
+-- of the circuit that satisfy the specified predicate.
+filterCircuitM :: MonadComp m => (a -> Event m Bool) -> Circuit m a b -> Circuit m a (Maybe b)
+filterCircuitM pred cir =
+  Circuit $ \a ->
+  Event $ \p ->
+  do x <- invokeEvent p (pred a)
+     if x
+       then do (b, cir') <- invokeEvent p (runCircuit cir a)
+               return (Just b, filterCircuitM pred cir')
+       else return (Nothing, filterCircuitM pred cir)
+
+-- | The source of events that never occur.
+neverCircuit :: MonadComp m => Circuit m a (Maybe b)
+neverCircuit =
+  Circuit $ \a -> return (Nothing, neverCircuit)
+
+-- | An approximation of the integral using Euler's method.
+--
+-- This function can be rather inaccurate as it depends on
+-- the time points at wich the 'Circuit' computation is actuated.
+-- Also Euler's method per se is not most accurate, although simple
+-- enough for implementation.
+--
+-- Consider using the 'integ' function whenever possible.
+-- That function can integrate with help of the Runge-Kutta method by
+-- the specified integration time points that are passed in the simulation
+-- specs to every 'Simulation', when running the model.
+--
+-- At the same time, the 'integCircuit' function has no mutable state
+-- unlike the former. The latter consumes less memory but at the cost
+-- of inaccuracy and relatively more slow simulation, had we requested
+-- the integral in the same time points.
+--
+-- Regarding the recursive equations, the both functions allow defining them
+-- but whithin different computations (either with help of the recursive
+-- do-notation or the proc-notation).
+integCircuit :: MonadComp m
+                => Double
+                -- ^ the initial value
+                -> Circuit m Double Double
+                -- ^ map the derivative to an integral
+integCircuit init = start
+  where
+    start = 
+      Circuit $ \a ->
+      Event $ \p ->
+      do let t = pointTime p
+         return (init, next t init a)
+    next t0 v0 a0 =
+      Circuit $ \a ->
+      Event $ \p ->
+      do let t  = pointTime p
+             dt = t - t0
+             v  = v0 + a0 * dt
+         v `seq` return (v, next t v a)
+
+-- | A sum of differences starting from the specified initial value.
+--
+-- Consider using the more accurate 'diffsum' function whener possible as
+-- it is calculated in every integration time point specified by specs
+-- passed in to every 'Simulation', when running the model.
+--
+-- At the same time, the 'sumCircuit' function has no mutable state and
+-- it consumes less memory than the former.
+--
+-- Regarding the recursive equations, the both functions allow defining them
+-- but whithin different computations (either with help of the recursive
+-- do-notation or the proc-notation).
+sumCircuit :: (MonadComp m, Num a) =>
+              a
+              -- ^ the initial value
+              -> Circuit m a a
+              -- ^ map the difference to a sum
+sumCircuit init = start
+  where
+    start = 
+      Circuit $ \a ->
+      Event $ \p ->
+      return (init, next init a)
+    next v0 a0 =
+      Circuit $ \a ->
+      Event $ \p ->
+      do let v = v0 + a0
+         v `seq` return (v, next v a)
+
+-- | Approximate the circuit as a transform of time varying function,
+-- calculating the values in the integration time points and then
+-- interpolating in all other time points. The resulting transform
+-- computation is synchronized with the event queue.         
+--
+-- This procedure consumes memory as the underlying memoization allocates
+-- an array to store the calculated values.
+circuitTransform :: MonadComp m => Circuit m a b -> Transform m a b
+circuitTransform cir = Transform start
+  where
+    start m =
+      Simulation $ \r ->
+      do let s = runSession r
+         ref <- newProtoRef s cir
+         invokeSimulation r $
+           memo0Dynamics (next ref m)
+    next ref m =
+      Dynamics $ \p ->
+      do a <- invokeDynamics p m
+         cir <- readProtoRef ref
+         (b, cir') <-
+           invokeDynamics p $
+           runEvent (runCircuit cir a)
+         writeProtoRef ref cir'
+         return b
+ Simulation/Aivika/Trans/Comp.hs view
@@ -0,0 +1,52 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Comp
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a type class of monads based on which the simulation monads can be built.
+--
+module Simulation.Aivika.Trans.Comp
+       (ProtoMonadComp(..),
+        MonadComp(..),
+        MonadCompTrans(..)) where
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray
+import Simulation.Aivika.Trans.Unboxed
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Internal.Specs
+
+-- | A prototype of the type class of monads based on which the simulation monads can be built. 
+class (Monad m,
+       ExceptionHandling m,
+       SessionMonad m,
+       ProtoRefMonad m,
+       ProtoArrayMonad m,
+       Unboxed m Double,
+       Unboxed m Float,
+       Unboxed m Int,
+       GeneratorMonad m) => ProtoMonadComp m
+
+-- | Such a prototype monad that allows enqueueing events.
+class (ProtoMonadComp m, EventQueueing m) => MonadComp m
+
+-- | A variant of the standard 'MonadTrans' type class with one difference:
+-- the computation that will be lifted into another must be 'MonadComp' instead of
+-- more general and less restricted 'Monad'.
+class MonadCompTrans t where
+
+  -- | Lift the underlying computation into another within simulation.
+  liftComp :: MonadComp m => m a -> t m a
+
+instance ProtoMonadComp IO
+ Simulation/Aivika/Trans/Comp/IO.hs view
@@ -0,0 +1,128 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Comp.IO
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the event queue within monad 'IO'.
+--
+module Simulation.Aivika.Trans.Comp.IO() where
+
+import Control.Monad
+
+import qualified Simulation.Aivika.Trans.PriorityQueue as PQ
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+
+instance EventQueueing IO where
+
+  data EventQueue IO =
+    EventQueue { queuePQ :: PQ.PriorityQueue IO (Point IO -> IO ()),
+                 -- ^ the underlying priority queue
+                 queueBusy :: ProtoRef IO Bool,
+                 -- ^ whether the queue is currently processing events
+                 queueTime :: ProtoRef IO Double
+                 -- ^ the actual time of the event queue
+               }
+  
+  newEventQueue session specs = 
+    do f <- newProtoRef session False
+       t <- newProtoRef session $ spcStartTime specs
+       pq <- PQ.newQueue session
+       return EventQueue { queuePQ   = pq,
+                           queueBusy = f,
+                           queueTime = t }
+
+  enqueueEvent t (Event m) =
+    Event $ \p ->
+    let pq = queuePQ $ runEventQueue $ pointRun p
+    in PQ.enqueue pq t m
+
+  runEventWith processing (Event e) =
+    Dynamics $ \p ->
+    do invokeDynamics p $ processEvents processing
+       e p
+
+  eventQueueCount =
+    Event $ PQ.queueCount . queuePQ . runEventQueue . pointRun
+
+instance MonadComp IO
+
+-- | Process the pending events.
+processPendingEventsCore :: Bool -> Dynamics IO ()
+processPendingEventsCore includingCurrentEvents = Dynamics r where
+  r p =
+    do let q = runEventQueue $ pointRun p
+           f = queueBusy q
+       f' <- readProtoRef f
+       unless f' $
+         do writeProtoRef f True
+            call q p
+            writeProtoRef f False
+  call q p =
+    do let pq = queuePQ q
+           r  = pointRun p
+       f <- PQ.queueNull pq
+       unless f $
+         do (t2, c2) <- PQ.queueFront pq
+            let t = queueTime q
+            t' <- readProtoRef t
+            when (t2 < t') $ 
+              error "The time value is too small: processPendingEventsCore"
+            when ((t2 < pointTime p) ||
+                  (includingCurrentEvents && (t2 == pointTime p))) $
+              do writeProtoRef t t2
+                 PQ.dequeue pq
+                 let sc = pointSpecs p
+                     t0 = spcStartTime sc
+                     dt = spcDT sc
+                     n2 = fromIntegral $ floor ((t2 - t0) / dt)
+                 c2 $ p { pointTime = t2,
+                          pointIteration = n2,
+                          pointPhase = -1 }
+                 call q p
+
+-- | Process the pending events synchronously, i.e. without past.
+processPendingEvents :: Bool -> Dynamics IO ()
+processPendingEvents includingCurrentEvents = Dynamics r where
+  r p =
+    do let q = runEventQueue $ pointRun p
+           t = queueTime q
+       t' <- readProtoRef t
+       if pointTime p < t'
+         then error $
+              "The current time is less than " ++
+              "the time in the queue: processPendingEvents"
+         else invokeDynamics p m
+  m = processPendingEventsCore includingCurrentEvents
+
+-- | A memoized value.
+processEventsIncludingCurrent :: Dynamics IO ()
+processEventsIncludingCurrent = processPendingEvents True
+
+-- | A memoized value.
+processEventsIncludingEarlier :: Dynamics IO ()
+processEventsIncludingEarlier = processPendingEvents False
+
+-- | A memoized value.
+processEventsIncludingCurrentCore :: Dynamics IO ()
+processEventsIncludingCurrentCore = processPendingEventsCore True
+
+-- | A memoized value.
+processEventsIncludingEarlierCore :: Dynamics IO ()
+processEventsIncludingEarlierCore = processPendingEventsCore True
+
+-- | Process the events.
+processEvents :: EventProcessing -> Dynamics IO ()
+processEvents CurrentEvents = processEventsIncludingCurrent
+processEvents EarlierEvents = processEventsIncludingEarlier
+processEvents CurrentEventsOrFromPast = processEventsIncludingCurrentCore
+processEvents EarlierEventsOrFromPast = processEventsIncludingEarlierCore
+ Simulation/Aivika/Trans/Comp/Template.hs view
@@ -0,0 +1,130 @@+
+{-# LANGUAGE TypeFamilies, FlexibleInstances, UndecidableInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Comp.Template
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the event queue.
+--
+module Simulation.Aivika.Trans.Comp.Template
+       (TemplateEventQueueing(..)) where
+
+import Control.Monad
+
+import qualified Simulation.Aivika.Trans.PriorityQueue as PQ
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+
+-- | A template-based implementation of the 'EventQueueing' class type.
+class ProtoMonadComp m => TemplateEventQueueing m 
+
+instance TemplateEventQueueing m => EventQueueing m where
+
+  data EventQueue m =
+    EventQueue { queuePQ :: PQ.PriorityQueue m (Point m -> m ()),
+                 -- ^ the underlying priority queue
+                 queueBusy :: ProtoRef m Bool,
+                 -- ^ whether the queue is currently processing events
+                 queueTime :: ProtoRef m Double
+                 -- ^ the actual time of the event queue
+               }
+  
+  newEventQueue session specs = 
+    do f <- newProtoRef session False
+       t <- newProtoRef session $ spcStartTime specs
+       pq <- PQ.newQueue session
+       return EventQueue { queuePQ   = pq,
+                           queueBusy = f,
+                           queueTime = t }
+
+  enqueueEvent t (Event m) =
+    Event $ \p ->
+    let pq = queuePQ $ runEventQueue $ pointRun p
+    in PQ.enqueue pq t m
+
+  runEventWith processing (Event e) =
+    Dynamics $ \p ->
+    do invokeDynamics p $ processEvents processing
+       e p
+
+  eventQueueCount =
+    Event $ PQ.queueCount . queuePQ . runEventQueue . pointRun
+
+-- | Process the pending events.
+processPendingEventsCore :: ProtoMonadComp m => Bool -> Dynamics m ()
+processPendingEventsCore includingCurrentEvents = Dynamics r where
+  r p =
+    do let q = runEventQueue $ pointRun p
+           f = queueBusy q
+       f' <- readProtoRef f
+       unless f' $
+         do writeProtoRef f True
+            call q p
+            writeProtoRef f False
+  call q p =
+    do let pq = queuePQ q
+           r  = pointRun p
+       f <- PQ.queueNull pq
+       unless f $
+         do (t2, c2) <- PQ.queueFront pq
+            let t = queueTime q
+            t' <- readProtoRef t
+            when (t2 < t') $ 
+              error "The time value is too small: processPendingEventsCore"
+            when ((t2 < pointTime p) ||
+                  (includingCurrentEvents && (t2 == pointTime p))) $
+              do writeProtoRef t t2
+                 PQ.dequeue pq
+                 let sc = pointSpecs p
+                     t0 = spcStartTime sc
+                     dt = spcDT sc
+                     n2 = fromIntegral $ floor ((t2 - t0) / dt)
+                 c2 $ p { pointTime = t2,
+                          pointIteration = n2,
+                          pointPhase = -1 }
+                 call q p
+
+-- | Process the pending events synchronously, i.e. without past.
+processPendingEvents :: ProtoMonadComp m => Bool -> Dynamics m ()
+processPendingEvents includingCurrentEvents = Dynamics r where
+  r p =
+    do let q = runEventQueue $ pointRun p
+           t = queueTime q
+       t' <- readProtoRef t
+       if pointTime p < t'
+         then error $
+              "The current time is less than " ++
+              "the time in the queue: processPendingEvents"
+         else invokeDynamics p m
+  m = processPendingEventsCore includingCurrentEvents
+
+-- | A memoized value.
+processEventsIncludingCurrent :: ProtoMonadComp m => Dynamics m ()
+processEventsIncludingCurrent = processPendingEvents True
+
+-- | A memoized value.
+processEventsIncludingEarlier :: ProtoMonadComp m => Dynamics m ()
+processEventsIncludingEarlier = processPendingEvents False
+
+-- | A memoized value.
+processEventsIncludingCurrentCore :: ProtoMonadComp m => Dynamics m ()
+processEventsIncludingCurrentCore = processPendingEventsCore True
+
+-- | A memoized value.
+processEventsIncludingEarlierCore :: ProtoMonadComp m => Dynamics m ()
+processEventsIncludingEarlierCore = processPendingEventsCore True
+
+-- | Process the events.
+processEvents :: ProtoMonadComp m => EventProcessing -> Dynamics m ()
+processEvents CurrentEvents = processEventsIncludingCurrent
+processEvents EarlierEvents = processEventsIncludingEarlier
+processEvents CurrentEventsOrFromPast = processEventsIncludingCurrentCore
+processEvents EarlierEventsOrFromPast = processEventsIncludingEarlierCore
+ Simulation/Aivika/Trans/Cont.hs view
@@ -0,0 +1,18 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Cont
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The 'Cont' monad is a variation of the standard Cont monad 
+-- and F# async workflow, where the result of applying 
+-- the continuations is the 'Event' computation.
+--
+module Simulation.Aivika.Trans.Cont
+       (ContCancellation(..),
+        Cont) where
+
+import Simulation.Aivika.Trans.Internal.Cont
+ Simulation/Aivika/Trans/DoubleLinkedList.hs view
@@ -0,0 +1,172 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.DoubleLinkedList
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- An imperative double-linked list.
+--
+module Simulation.Aivika.Trans.DoubleLinkedList 
+       (DoubleLinkedList, 
+        listNull, 
+        listCount,
+        newList, 
+        listInsertFirst,
+        listAddLast,
+        listRemoveFirst,
+        listRemoveLast,
+        listFirst,
+        listLast) where 
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+
+-- | A cell of the double-linked list.
+data DoubleLinkedItem m a = 
+  DoubleLinkedItem { itemVal  :: a,
+                     itemPrev :: ProtoRef m (Maybe (DoubleLinkedItem m a)),
+                     itemNext :: ProtoRef m (Maybe (DoubleLinkedItem m a)) }
+  
+-- | The 'DoubleLinkedList' type represents an imperative double-linked list.
+data DoubleLinkedList m a =  
+  DoubleLinkedList { listSession :: Session m,
+                     listHead :: ProtoRef m (Maybe (DoubleLinkedItem m a)),
+                     listTail :: ProtoRef m (Maybe (DoubleLinkedItem m a)), 
+                     listSize :: ProtoRef m Int }
+
+-- | Test whether the list is empty.
+listNull :: ProtoRefMonad m => DoubleLinkedList m a -> m Bool
+listNull x =
+  do head <- readProtoRef (listHead x) 
+     case head of
+       Nothing -> return True
+       Just _  -> return False
+    
+-- | Return the number of elements in the list.
+listCount :: ProtoRefMonad m => DoubleLinkedList m a -> m Int
+listCount x = readProtoRef (listSize x)
+
+-- | Create a new list.
+newList :: ProtoRefMonad m => Session m -> m (DoubleLinkedList m a)
+newList s =
+  do head <- newProtoRef s Nothing 
+     tail <- newProtoRef s Nothing
+     size <- newProtoRef s 0
+     return DoubleLinkedList { listSession = s,
+                               listHead = head,
+                               listTail = tail,
+                               listSize = size }
+
+-- | Insert a new element in the beginning.
+listInsertFirst :: ProtoRefMonad m => DoubleLinkedList m a -> a -> m ()
+listInsertFirst x v =
+  do let s = listSession x
+     size <- readProtoRef (listSize x)
+     writeProtoRef (listSize x) (size + 1)
+     head <- readProtoRef (listHead x)
+     case head of
+       Nothing ->
+         do prev <- newProtoRef s Nothing
+            next <- newProtoRef s Nothing
+            let item = Just DoubleLinkedItem { itemVal = v, 
+                                               itemPrev = prev, 
+                                               itemNext = next }
+            writeProtoRef (listHead x) item
+            writeProtoRef (listTail x) item
+       Just h ->
+         do prev <- newProtoRef s Nothing
+            next <- newProtoRef s head
+            let item = Just DoubleLinkedItem { itemVal = v,
+                                               itemPrev = prev,
+                                               itemNext = next }
+            writeProtoRef (itemPrev h) item
+            writeProtoRef (listHead x) item
+
+-- | Add a new element to the end.
+listAddLast :: ProtoRefMonad m => DoubleLinkedList m a -> a -> m ()
+listAddLast x v =
+  do let s = listSession x
+     size <- readProtoRef (listSize x)
+     writeProtoRef (listSize x) (size + 1)
+     tail <- readProtoRef (listTail x)
+     case tail of
+       Nothing ->
+         do prev <- newProtoRef s Nothing
+            next <- newProtoRef s Nothing
+            let item = Just DoubleLinkedItem { itemVal = v, 
+                                               itemPrev = prev, 
+                                               itemNext = next }
+            writeProtoRef (listHead x) item
+            writeProtoRef (listTail x) item
+       Just t ->
+         do prev <- newProtoRef s tail
+            next <- newProtoRef s Nothing
+            let item = Just DoubleLinkedItem { itemVal = v,
+                                               itemPrev = prev,
+                                               itemNext = next }
+            writeProtoRef (itemNext t) item
+            writeProtoRef (listTail x) item
+
+-- | Remove the first element.
+listRemoveFirst :: ProtoRefMonad m => DoubleLinkedList m a -> m ()
+listRemoveFirst x =
+  do head <- readProtoRef (listHead x) 
+     case head of
+       Nothing ->
+         error "Empty list: listRemoveFirst"
+       Just h ->
+         do size  <- readProtoRef (listSize x)
+            writeProtoRef (listSize x) (size - 1)
+            head' <- readProtoRef (itemNext h)
+            case head' of
+              Nothing ->
+                do writeProtoRef (listHead x) Nothing
+                   writeProtoRef (listTail x) Nothing
+              Just h' ->
+                do writeProtoRef (itemPrev h') Nothing
+                   writeProtoRef (listHead x) head'
+
+-- | Remove the last element.
+listRemoveLast :: ProtoRefMonad m => DoubleLinkedList m a -> m ()
+listRemoveLast x =
+  do tail <- readProtoRef (listTail x) 
+     case tail of
+       Nothing ->
+         error "Empty list: listRemoveLast"
+       Just t ->
+         do size  <- readProtoRef (listSize x)
+            writeProtoRef (listSize x) (size - 1)
+            tail' <- readProtoRef (itemPrev t)
+            case tail' of
+              Nothing ->
+                do writeProtoRef (listHead x) Nothing
+                   writeProtoRef (listTail x) Nothing
+              Just t' ->
+                do writeProtoRef (itemNext t') Nothing
+                   writeProtoRef (listTail x) tail'
+
+-- | Return the first element.
+listFirst :: ProtoRefMonad m => DoubleLinkedList m a -> m a
+listFirst x =
+  do head <- readProtoRef (listHead x)
+     case head of
+       Nothing ->
+         error "Empty list: listFirst"
+       Just h ->
+         return $ itemVal h
+
+-- | Return the last element.
+listLast :: ProtoRefMonad m => DoubleLinkedList m a -> m a
+listLast x =
+  do tail <- readProtoRef (listTail x)
+     case tail of
+       Nothing ->
+         error "Empty list: listLast"
+       Just t ->
+         return $ itemVal t
+ Simulation/Aivika/Trans/Dynamics.hs view
@@ -0,0 +1,32 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Dynamics
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'DynamicsT' monad tranformer representing a time varying polymorphic function. 
+--
+module Simulation.Aivika.Trans.Dynamics
+       (-- * Dynamics Monad
+        Dynamics,
+        DynamicsLift(..),
+        runDynamicsInStartTime,
+        runDynamicsInStopTime,
+        runDynamicsInIntegTimes,
+        runDynamicsInTime,
+        runDynamicsInTimes,
+        -- * Error Handling
+        catchDynamics,
+        finallyDynamics,
+        throwDynamics,
+        -- * Simulation Time
+        time,
+        isTimeInteg,
+        integIteration,
+        integPhase) where
+
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Dynamics
+ Simulation/Aivika/Trans/Dynamics/Extra.hs view
@@ -0,0 +1,114 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Dynamics.Extra
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines auxiliary functions such as interpolation ones
+-- that complement the memoization, for example. There are scan functions too.
+--
+
+module Simulation.Aivika.Trans.Dynamics.Extra
+       (-- * Interpolation
+        initDynamics,
+        discreteDynamics,
+        interpolateDynamics,
+        -- * Scans
+        scanDynamics,
+        scan1Dynamics) where
+
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+
+-- | Return the initial value.
+initDynamics :: Dynamics m a -> Dynamics m a
+{-# INLINE initDynamics #-}
+initDynamics (Dynamics m) =
+  Dynamics $ \p ->
+  let sc = pointSpecs p
+  in m $ p { pointTime = basicTime sc 0 0,
+             pointIteration = 0,
+             pointPhase = 0 }
+
+-- | Discretize the computation in the integration time points.
+discreteDynamics :: Dynamics m a -> Dynamics m a
+{-# INLINE discreteDynamics #-}
+discreteDynamics (Dynamics m) =
+  Dynamics $ \p ->
+  if pointPhase p == 0 then
+    m p
+  else
+    let sc = pointSpecs p
+        n  = pointIteration p
+    in m $ p { pointTime = basicTime sc n 0,
+               pointPhase = 0 }
+
+-- | Interpolate the computation based on the integration time points only.
+-- Unlike the 'discreteDynamics' function it knows about the intermediate 
+-- time points that are used in the Runge-Kutta method.
+interpolateDynamics :: Dynamics m a -> Dynamics m a
+{-# INLINE interpolateDynamics #-}
+interpolateDynamics (Dynamics m) = 
+  Dynamics $ \p -> 
+  if pointPhase p >= 0 then 
+    m p
+  else 
+    let sc = pointSpecs p
+        n  = pointIteration p
+    in m $ p { pointTime = basicTime sc n 0,
+               pointPhase = 0 }
+
+-- | Like the standard 'scanl1' function but applied to values in 
+-- the integration time points. The accumulator values are transformed
+-- according to the second argument, which should be either function 
+-- 'memo0Dynamics' or its unboxed version.
+scan1Dynamics :: (MonadComp m, MonadFix m)
+                 => (a -> a -> a)
+                 -> (Dynamics m a -> Simulation m (Dynamics m a))
+                 -> (Dynamics m a -> Simulation m (Dynamics m a))
+scan1Dynamics f tr m =
+  mdo y <- tr $ Dynamics $ \p ->
+        case pointIteration p of
+          0 -> 
+            invokeDynamics p m
+          n -> do 
+            let sc = pointSpecs p
+                ty = basicTime sc (n - 1) 0
+                py = p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
+            s <- invokeDynamics py y
+            x <- invokeDynamics p m
+            return $! f s x
+      return y
+
+-- | Like the standard 'scanl' function but applied to values in 
+-- the integration time points. The accumulator values are transformed
+-- according to the third argument, which should be either function
+-- 'memo0Dynamics' or its unboxed version.
+scanDynamics :: (MonadComp m, MonadFix m)
+                => (a -> b -> a)
+                -> a
+                -> (Dynamics m a -> Simulation m (Dynamics m a))
+                -> (Dynamics m b -> Simulation m (Dynamics m a))
+scanDynamics f acc tr m =
+  mdo y <- tr $ Dynamics $ \p ->
+        case pointIteration p of
+          0 -> do
+            x <- invokeDynamics p m
+            return $! f acc x
+          n -> do 
+            let sc = pointSpecs p
+                ty = basicTime sc (n - 1) 0
+                py = p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
+            s <- invokeDynamics py y
+            x <- invokeDynamics p m
+            return $! f s x
+      return y
+ Simulation/Aivika/Trans/Dynamics/Memo.hs view
@@ -0,0 +1,158 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Dynamics.Memo
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines memo functions. The memoization creates such 'Dynamics'
+-- computations, which values are cached in the integration time points. Then
+-- these values are interpolated in all other time points.
+--
+
+module Simulation.Aivika.Trans.Dynamics.Memo
+       (memoDynamics,
+        memo0Dynamics,
+        iterateDynamics,
+        unzipDynamics,
+        unzip0Dynamics) where
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+
+-- | Memoize and order the computation in the integration time points using 
+-- the interpolation that knows of the Runge-Kutta method. The values are
+-- calculated sequentially starting from 'starttime'.
+memoDynamics :: MonadComp m => Dynamics m e -> Simulation m (Dynamics m e)
+{-# INLINABLE memoDynamics #-}
+memoDynamics (Dynamics m) = 
+  Simulation $ \r ->
+  do let sc  = runSpecs r
+         s   = runSession r
+         phs = 1 + integPhaseHiBnd sc
+         ns  = 1 + integIterationHiBnd sc
+     arr   <- newProtoArray_ s (ns * phs)
+     nref  <- newProtoRef s 0
+     phref <- newProtoRef s 0
+     let r p = 
+           do let n  = pointIteration p
+                  ph = pointPhase p
+                  i  = n * phs + ph
+                  loop n' ph' = 
+                    if (n' > n) || ((n' == n) && (ph' > ph)) 
+                    then 
+                      readProtoArray arr i
+                    else 
+                      let p' = p { pointIteration = n', pointPhase = ph',
+                                   pointTime = basicTime sc n' ph' }
+                          i' = n' * phs + ph'
+                      in do a <- m p'
+                            a `seq` writeProtoArray arr i' a
+                            if ph' >= phs - 1 
+                              then do writeProtoRef phref 0
+                                      writeProtoRef nref (n' + 1)
+                                      loop (n' + 1) 0
+                              else do writeProtoRef phref (ph' + 1)
+                                      loop n' (ph' + 1)
+              n'  <- readProtoRef nref
+              ph' <- readProtoRef phref
+              loop n' ph'
+     return $ interpolateDynamics $ Dynamics r
+
+-- | Memoize and order the computation in the integration time points using 
+-- the 'discreteDynamics' interpolation. It consumes less memory than the 'memoDynamics'
+-- function but it is not aware of the Runge-Kutta method. There is a subtle
+-- difference when we request for values in the intermediate time points
+-- that are used by this method to integrate. In general case you should 
+-- prefer the 'memo0Dynamics' function above 'memoDynamics'.
+memo0Dynamics :: MonadComp m => Dynamics m e -> Simulation m (Dynamics m e)
+{-# INLINABLE memo0Dynamics #-}
+memo0Dynamics (Dynamics m) = 
+  Simulation $ \r ->
+  do let sc = runSpecs r
+         s  = runSession r
+         ns = 1 + integIterationHiBnd sc
+     arr  <- newProtoArray_ s ns
+     nref <- newProtoRef s 0
+     let r p =
+           do let sc = pointSpecs p
+                  n  = pointIteration p
+                  loop n' = 
+                    if n' > n
+                    then 
+                      readProtoArray arr n
+                    else 
+                      let p' = p { pointIteration = n', pointPhase = 0,
+                                   pointTime = basicTime sc n' 0 }
+                      in do a <- m p'
+                            a `seq` writeProtoArray arr n' a
+                            writeProtoRef nref (n' + 1)
+                            loop (n' + 1)
+              n' <- readProtoRef nref
+              loop n'
+     return $ discreteDynamics $ Dynamics r
+
+-- | Iterate sequentially the dynamic process with side effects in 
+-- the integration time points. It is equivalent to a call of the
+-- 'memo0Dynamics' function but significantly more efficient, for the array 
+-- is not created.
+iterateDynamics :: MonadComp m => Dynamics m () -> Simulation m (Dynamics m ())
+{-# INLINABLE iterateDynamics #-}
+iterateDynamics (Dynamics m) = 
+  Simulation $ \r ->
+  do let sc = runSpecs r
+         s  = runSession r
+     nref <- newProtoRef s 0
+     let r p =
+           do let sc = pointSpecs p
+                  n  = pointIteration p
+                  loop n' = 
+                    unless (n' > n) $
+                    let p' = p { pointIteration = n', pointPhase = 0,
+                                 pointTime = basicTime sc n' 0 }
+                    in do a <- m p'
+                          a `seq` writeProtoRef nref (n' + 1)
+                          loop (n' + 1)
+              n' <- readProtoRef nref
+              loop n'
+     return $ discreteDynamics $ Dynamics r
+
+-- | Memoize and unzip the computation of pairs, applying the 'memoDynamics' function.
+unzipDynamics :: MonadComp m => Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
+unzipDynamics m =
+  Simulation $ \r ->
+  do m' <- invokeSimulation r (memoDynamics m)
+     let ma =
+           Dynamics $ \p ->
+           do (a, _) <- invokeDynamics p m'
+              return a
+         mb =
+           Dynamics $ \p ->
+           do (_, b) <- invokeDynamics p m'
+              return b
+     return (ma, mb)
+
+-- | Memoize and unzip the computation of pairs, applying the 'memo0Dynamics' function.
+unzip0Dynamics :: MonadComp m => Dynamics m (a, b) -> Simulation m (Dynamics m a, Dynamics m b)
+unzip0Dynamics m =
+  Simulation $ \r ->
+  do m' <- invokeSimulation r (memo0Dynamics m)
+     let ma =
+           Dynamics $ \p ->
+           do (a, _) <- invokeDynamics p m'
+              return a
+         mb =
+           Dynamics $ \p ->
+           do (_, b) <- invokeDynamics p m'
+              return b
+     return (ma, mb)
+ Simulation/Aivika/Trans/Dynamics/Memo/Unboxed.hs view
@@ -0,0 +1,105 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the unboxed memo functions. The memoization creates such 'DynamicsT'
+-- computations, which values are cached in the integration time points. Then
+-- these values are interpolated in all other time points.
+--
+
+module Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+       (memoDynamics,
+        memo0Dynamics) where
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray.Unboxed
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Comp.IO
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Unboxed
+
+-- | Memoize and order the computation in the integration time points using 
+-- the interpolation that knows of the Runge-Kutta method. The values are
+-- calculated sequentially starting from 'starttime'.
+memoDynamics :: (Unboxed m e, MonadComp m) => Dynamics m e -> Simulation m (Dynamics m e)
+{-# INLINABLE memoDynamics #-}
+memoDynamics (Dynamics m) = 
+  Simulation $ \r ->
+  do let sc  = runSpecs r
+         s   = runSession r
+         phs = 1 + integPhaseHiBnd sc
+         ns  = 1 + integIterationHiBnd sc
+     arr   <- newProtoArray_ s (phs * ns)
+     nref  <- newProtoRef s 0
+     phref <- newProtoRef s 0
+     let r p =
+           do let n  = pointIteration p
+                  ph = pointPhase p
+                  i  = n * phs + ph
+                  loop n' ph' = 
+                    if (n' > n) || ((n' == n) && (ph' > ph)) 
+                    then 
+                      readProtoArray arr i
+                    else 
+                      let p' = p { pointIteration = n', 
+                                   pointPhase = ph',
+                                   pointTime = basicTime sc n' ph' }
+                          i' = n' * phs + ph'
+                      in do a <- m p'
+                            a `seq` writeProtoArray arr i' a
+                            if ph' >= phs - 1 
+                              then do writeProtoRef phref 0
+                                      writeProtoRef nref (n' + 1)
+                                      loop (n' + 1) 0
+                              else do writeProtoRef phref (ph' + 1)
+                                      loop n' (ph' + 1)
+              n'  <- readProtoRef nref
+              ph' <- readProtoRef phref
+              loop n' ph'
+     return $ interpolateDynamics $ Dynamics r
+
+-- | Memoize and order the computation in the integration time points using 
+-- the 'discreteDynamics' interpolation. It consumes less memory than the 'memoDynamics'
+-- function but it is not aware of the Runge-Kutta method. There is a subtle
+-- difference when we request for values in the intermediate time points
+-- that are used by this method to integrate. In general case you should 
+-- prefer the 'memo0Dynamics' function above 'memoDynamics'.
+memo0Dynamics :: (Unboxed m e, MonadComp m) => Dynamics m e -> Simulation m (Dynamics m e)
+{-# INLINABLE memo0Dynamics #-}
+memo0Dynamics (Dynamics m) = 
+  Simulation $ \r ->
+  do let sc = runSpecs r
+         s  = runSession r
+         ns = 1 + integIterationHiBnd sc
+     arr  <- newProtoArray_ s ns
+     nref <- newProtoRef s 0
+     let r p =
+           do let sc = pointSpecs p
+                  n  = pointIteration p
+                  loop n' = 
+                    if n' > n
+                    then 
+                      readProtoArray arr n
+                    else 
+                      let p' = p { pointIteration = n', pointPhase = 0,
+                                   pointTime = basicTime sc n' 0 }
+                      in do a <- m p'
+                            a `seq` writeProtoArray arr n' a
+                            writeProtoRef nref (n' + 1)
+                            loop (n' + 1)
+              n' <- readProtoRef nref
+              loop n'
+     return $ discreteDynamics $ Dynamics r
+ Simulation/Aivika/Trans/Dynamics/Random.hs view
@@ -0,0 +1,140 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Dynamics.Random
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the random functions that always return the same values
+-- in the integration time points within a single simulation run. The values
+-- for another simulation run will be regenerated anew.
+--
+-- For example, the computations returned by these functions can be used in
+-- the equations of System Dynamics.
+--
+-- Also it is worth noting that the values are generated in a strong order starting
+-- from 'starttime' with step 'dt'. This is how the 'memo0Dynamics' function
+-- actually works.
+--
+
+module Simulation.Aivika.Trans.Dynamics.Random
+       (memoRandomUniformDynamics,
+        memoRandomUniformIntDynamics,
+        memoRandomNormalDynamics,
+        memoRandomExponentialDynamics,
+        memoRandomErlangDynamics,
+        memoRandomPoissonDynamics,
+        memoRandomBinomialDynamics) where
+
+import System.Random
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+
+-- | Computation that generates random numbers distributed uniformly and
+-- memoizes them in the integration time points.
+memoRandomUniformDynamics :: MonadComp m
+                             => Dynamics m Double     -- ^ minimum
+                             -> Dynamics m Double     -- ^ maximum
+                             -> Simulation m (Dynamics m Double)
+memoRandomUniformDynamics min max =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     min' <- invokeDynamics p min
+     max' <- invokeDynamics p max
+     generateUniform g min' max'
+
+-- | Computation that generates random integer numbers distributed uniformly and
+-- memoizes them in the integration time points.
+memoRandomUniformIntDynamics :: MonadComp m
+                                => Dynamics m Int     -- ^ minimum
+                                -> Dynamics m Int     -- ^ maximum
+                                -> Simulation m (Dynamics m Int)
+memoRandomUniformIntDynamics min max =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     min' <- invokeDynamics p min
+     max' <- invokeDynamics p max
+     generateUniformInt g min' max'
+
+-- | Computation that generates random numbers distributed normally and
+-- memoizes them in the integration time points.
+memoRandomNormalDynamics :: MonadComp m
+                            => Dynamics m Double     -- ^ mean
+                            -> Dynamics m Double     -- ^ deviation
+                            -> Simulation m (Dynamics m Double)
+memoRandomNormalDynamics mu nu =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     mu' <- invokeDynamics p mu
+     nu' <- invokeDynamics p nu
+     generateNormal g mu' nu'
+
+-- | Computation that generates exponential random numbers with the specified mean
+-- (the reciprocal of the rate) and memoizes them in the integration time points.
+memoRandomExponentialDynamics :: MonadComp m
+                                 => Dynamics m Double
+                                 -- ^ the mean (the reciprocal of the rate)
+                                 -> Simulation m (Dynamics m Double)
+memoRandomExponentialDynamics mu =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     mu' <- invokeDynamics p mu
+     generateExponential g mu'
+
+-- | Computation that generates the Erlang random numbers with the specified scale
+-- (the reciprocal of the rate) and integer shape but memoizes them in the integration
+-- time points.
+memoRandomErlangDynamics :: MonadComp m
+                            => Dynamics m Double
+                            -- ^ the scale (the reciprocal of the rate)
+                            -> Dynamics m Int
+                            -- ^ the shape
+                            -> Simulation m (Dynamics m Double)
+memoRandomErlangDynamics beta m =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     beta' <- invokeDynamics p beta
+     m' <- invokeDynamics p m
+     generateErlang g beta' m'
+
+-- | Computation that generats the Poisson random numbers with the specified mean
+-- and memoizes them in the integration time points.
+memoRandomPoissonDynamics :: MonadComp m
+                             => Dynamics m Double
+                             -- ^ the mean
+                             -> Simulation m (Dynamics m Int)
+memoRandomPoissonDynamics mu =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     mu' <- invokeDynamics p mu
+     generatePoisson g mu'
+
+-- | Computation that generates binomial random numbers with the specified
+-- probability and trials but memoizes them in the integration time points.
+memoRandomBinomialDynamics :: MonadComp m
+                              => Dynamics m Double  -- ^ the probability
+                              -> Dynamics m Int  -- ^ the number of trials
+                              -> Simulation m (Dynamics m Int)
+memoRandomBinomialDynamics prob trials =
+  memo0Dynamics $
+  Dynamics $ \p ->
+  do let g = runGenerator $ pointRun p
+     prob' <- invokeDynamics p prob
+     trials' <- invokeDynamics p trials
+     generateBinomial g prob' trials'
+ Simulation/Aivika/Trans/Event.hs view
@@ -0,0 +1,42 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Event
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'Event' monad which is very similar to the 'Dynamics'
+-- monad but only now the computation is strongly synchronized with the event queue.
+--
+module Simulation.Aivika.Trans.Event
+       (-- * Event Monad
+        Event,
+        EventLift(..),
+        EventProcessing(..),
+        runEventInStartTime,
+        runEventInStopTime,
+        -- * Event Queue
+        EventQueueing(..),
+        enqueueEventWithCancellation,
+        enqueueEventWithTimes,
+        enqueueEventWithIntegTimes,
+        yieldEvent,
+        -- * Cancelling Event
+        EventCancellation,
+        cancelEvent,
+        eventCancelled,
+        eventFinished,
+        -- * Error Handling
+        catchEvent,
+        finallyEvent,
+        throwEvent,
+        -- * Memoization
+        memoEvent,
+        memoEventInTime,
+        -- * Disposable
+        DisposableEvent(..)) where
+
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Event
+ Simulation/Aivika/Trans/Exception.hs view
@@ -0,0 +1,46 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Exception
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a type class of monads with 'IO' exception handling capabilities.
+--
+module Simulation.Aivika.Trans.Exception
+       (ExceptionThrowing(..),
+        ExceptionHandling(..)) where
+
+import Control.Monad.Trans
+import Control.Exception
+
+-- | A computation within which we can throw an exception.
+class ExceptionThrowing m where
+
+  -- | Throw an exception.
+  throwComp :: Exception e => e -> m a
+
+-- | A computation within which we can handle 'IO' exceptions
+-- as well as define finalisation blocks.
+class (ExceptionThrowing m, MonadIO m) => ExceptionHandling m where
+
+  -- | Catch an 'IO' exception within the computation.
+  catchComp :: (Exception e, MonadIO m) => m a -> (e -> m a) -> m a
+
+  -- | Introduce a finalisation block.
+  finallyComp :: MonadIO m => m a -> m b -> m a
+
+instance ExceptionThrowing IO where
+
+  {-# INLINE throwComp #-}
+  throwComp = throw
+
+instance ExceptionHandling IO where
+
+  {-# INLINE catchComp #-}
+  catchComp = catch
+
+  {-# INLINE finallyComp #-}
+  finallyComp = finally
+ Simulation/Aivika/Trans/Generator.hs view
@@ -0,0 +1,269 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Generator
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- Below is defined a random number generator.
+--
+module Simulation.Aivika.Trans.Generator 
+       (GeneratorMonad(..),
+        GeneratorType(..)) where
+
+import System.Random
+
+import Data.IORef
+
+import Simulation.Aivika.Trans.Session
+
+-- | Defines a monad whithin which computation the random number generator can work.
+class (Functor m, Monad m) => GeneratorMonad m where
+
+  -- | Defines a random number generator.
+  data Generator m :: *
+
+  -- | Generate an uniform random number
+  -- with the specified minimum and maximum.
+  generateUniform :: Generator m -> Double -> Double -> m Double
+  
+  -- | Generate an uniform integer random number
+  -- with the specified minimum and maximum.
+  generateUniformInt :: Generator m -> Int -> Int -> m Int
+
+  -- | Generate a normal random number
+  -- with the specified mean and deviation.
+  generateNormal :: Generator m -> Double -> Double -> m Double
+
+  -- | Generate a random number distributed exponentially
+  -- with the specified mean (the reciprocal of the rate).
+  generateExponential :: Generator m -> Double -> m Double
+
+  -- | Generate the Erlang random number
+  -- with the specified scale (the reciprocal of the rate)
+  -- and integer shape.
+  generateErlang :: Generator m -> Double -> Int -> m Double
+  
+  -- | Generate the Poisson random number with the specified mean.
+  generatePoisson :: Generator m -> Double -> m Int
+
+  -- | Generate the binomial random number
+  -- with the specified probability and number of trials.
+  generateBinomial :: Generator m -> Double -> Int -> m Int
+  
+  -- | Create a new random number generator by the specified type with current session.
+  newGenerator :: Session m -> GeneratorType m -> m (Generator m)
+
+  -- | Create a new random generator by the specified standard generator within current session.
+  newRandomGenerator :: RandomGen g => Session m -> g -> m (Generator m)
+
+  -- | Create a new random generator by the specified uniform generator of numbers
+  -- from 0 to 1 within current session.
+  newRandomGenerator01 :: Session m -> m Double -> m (Generator m)
+
+instance GeneratorMonad IO where
+
+  data Generator IO =
+    Generator { generator01 :: IO Double,
+                -- ^ the generator of uniform numbers from 0 to 1
+                generatorNormal01 :: IO Double
+                -- ^ the generator of normal numbers with mean 0 and variance 1
+              }
+
+  {-# SPECIALISE INLINE generateUniform :: Generator IO -> Double -> Double -> IO Double #-}
+  generateUniform = generateUniform01 . generator01
+
+  {-# SPECIALISE INLINE generateUniformInt :: Generator IO -> Int -> Int -> IO Int #-}
+  generateUniformInt = generateUniformInt01 . generator01
+
+  {-# SPECIALISE INLINE generateUniform :: Generator IO -> Double -> Double -> IO Double #-}
+  generateNormal = generateNormal01 . generatorNormal01
+
+  {-# SPECIALISE INLINE generateExponential :: Generator IO -> Double -> IO Double #-}
+  generateExponential = generateExponential01 . generator01
+
+  {-# SPECIALISE INLINE generateErlang :: Generator IO -> Double -> Int -> IO Double #-}
+  generateErlang = generateErlang01 . generator01
+
+  {-# SPECIALISE INLINE generatePoisson :: Generator IO -> Double -> IO Int #-}
+  generatePoisson = generatePoisson01 . generator01
+
+  {-# SPECIALISE INLINE generateBinomial :: Generator IO -> Double -> Int -> IO Int #-}
+  generateBinomial = generateBinomial01 . generator01
+
+  newGenerator session tp =
+    case tp of
+      SimpleGenerator ->
+        newStdGen >>= newRandomGenerator session
+      SimpleGeneratorWithSeed x ->
+        newRandomGenerator session $ mkStdGen x
+      CustomGenerator g ->
+        g
+      CustomGenerator01 g ->
+        newRandomGenerator01 session g
+
+  newRandomGenerator session g = 
+    do r <- newIORef g
+       let g01 = do g <- readIORef r
+                    let (x, g') = random g
+                    writeIORef r g'
+                    return x
+       newRandomGenerator01 session g01
+
+  newRandomGenerator01 session g01 =
+    do gNormal01 <- newNormalGenerator01 g01
+       return Generator { generator01 = g01,
+                          generatorNormal01 = gNormal01 }
+
+-- | Defines a type of the random number generator.
+data GeneratorType m = SimpleGenerator
+                       -- ^ The simple random number generator.
+                     | SimpleGeneratorWithSeed Int
+                       -- ^ The simple random number generator with the specified seed.
+                     | CustomGenerator (m (Generator m))
+                       -- ^ The custom random number generator.
+                     | CustomGenerator01 (m Double)
+                       -- ^ The custom random number generator by the specified uniform
+                       -- generator of numbers from 0 to 1.
+
+-- | Generate an uniform random number with the specified minimum and maximum.
+generateUniform01 :: IO Double
+                     -- ^ the generator
+                     -> Double
+                     -- ^ minimum
+                     -> Double
+                     -- ^ maximum
+                     -> IO Double
+generateUniform01 g min max =
+  do x <- g
+     return $ min + x * (max - min)
+
+-- | Generate an uniform random number with the specified minimum and maximum.
+generateUniformInt01 :: IO Double
+                        -- ^ the generator
+                        -> Int
+                        -- ^ minimum
+                        -> Int
+                        -- ^ maximum
+                        -> IO Int
+generateUniformInt01 g min max =
+  do x <- g
+     let min' = fromIntegral min
+         max' = fromIntegral max
+     return $ round (min' + x * (max' - min'))
+
+-- | Generate a normal random number by the specified generator, mean and variance.
+generateNormal01 :: IO Double
+                    -- ^ normal random numbers with mean 0 and variance 1
+                    -> Double
+                    -- ^ mean
+                    -> Double
+                    -- ^ variance
+                    -> IO Double
+generateNormal01 g mu nu =
+  do x <- g
+     return $ mu + nu * x
+
+-- | Create a normal random number generator with mean 0 and variance 1
+-- by the specified generator of uniform random numbers from 0 to 1.
+newNormalGenerator01 :: IO Double
+                        -- ^ the generator
+                        -> IO (IO Double)
+newNormalGenerator01 g =
+  do nextRef <- newIORef 0.0
+     flagRef <- newIORef False
+     xi1Ref  <- newIORef 0.0
+     xi2Ref  <- newIORef 0.0
+     psiRef  <- newIORef 0.0
+     let loop =
+           do psi <- readIORef psiRef
+              if (psi >= 1.0) || (psi == 0.0)
+                then do g1 <- g
+                        g2 <- g
+                        let xi1 = 2.0 * g1 - 1.0
+                            xi2 = 2.0 * g2 - 1.0
+                            psi = xi1 * xi1 + xi2 * xi2
+                        writeIORef xi1Ref xi1
+                        writeIORef xi2Ref xi2
+                        writeIORef psiRef psi
+                        loop
+                else writeIORef psiRef $ sqrt (- 2.0 * log psi / psi)
+     return $
+       do flag <- readIORef flagRef
+          if flag
+            then do writeIORef flagRef False
+                    readIORef nextRef
+            else do writeIORef xi1Ref 0.0
+                    writeIORef xi2Ref 0.0
+                    writeIORef psiRef 0.0
+                    loop
+                    xi1 <- readIORef xi1Ref
+                    xi2 <- readIORef xi2Ref
+                    psi <- readIORef psiRef
+                    writeIORef flagRef True
+                    writeIORef nextRef $ xi2 * psi
+                    return $ xi1 * psi
+
+-- | Return the exponential random number with the specified mean.
+generateExponential01 :: IO Double
+                         -- ^ the generator
+                         -> Double
+                         -- ^ the mean
+                         -> IO Double
+generateExponential01 g mu =
+  do x <- g
+     return (- log x * mu)
+
+-- | Return the Erlang random number.
+generateErlang01 :: IO Double
+                    -- ^ the generator
+                    -> Double
+                    -- ^ the scale
+                    -> Int
+                    -- ^ the shape
+                    -> IO Double
+generateErlang01 g beta m =
+  do x <- loop m 1
+     return (- log x * beta)
+       where loop m acc
+               | m < 0     = error "Negative shape: generateErlang."
+               | m == 0    = return acc
+               | otherwise = do x <- g
+                                loop (m - 1) (x * acc)
+
+-- | Generate the Poisson random number with the specified mean.
+generatePoisson01 :: IO Double
+                     -- ^ the generator
+                     -> Double
+                     -- ^ the mean
+                     -> IO Int
+generatePoisson01 g mu =
+  do prob0 <- g
+     let loop prob prod acc
+           | prob <= prod = return acc
+           | otherwise    = loop
+                            (prob - prod)
+                            (prod * mu / fromIntegral (acc + 1))
+                            (acc + 1)
+     loop prob0 (exp (- mu)) 0
+
+-- | Generate a binomial random number with the specified probability and number of trials. 
+generateBinomial01 :: IO Double
+                      -- ^ the generator
+                      -> Double 
+                      -- ^ the probability
+                      -> Int
+                      -- ^ the number of trials
+                      -> IO Int
+generateBinomial01 g prob trials = loop trials 0 where
+  loop n acc
+    | n < 0     = error "Negative number of trials: generateBinomial."
+    | n == 0    = return acc
+    | otherwise = do x <- g
+                     if x <= prob
+                       then loop (n - 1) (acc + 1)
+                       else loop (n - 1) acc
+ Simulation/Aivika/Trans/Internal/Cont.hs view
@@ -0,0 +1,687 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Cont
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The 'Cont' monad is a variation of the standard Cont monad 
+-- and F# async workflow, where the result of applying 
+-- the continuations is the 'Event' computation.
+--
+module Simulation.Aivika.Trans.Internal.Cont
+       (ContCancellationSource,
+        ContParams,
+        ContCancellation(..),
+        Cont(..),
+        newContCancellationSource,
+        contCancellationInitiated,
+        contCancellationInitiate,
+        contCancellationInitiating,
+        contCancellationBind,
+        contCancellationConnect,
+        invokeCont,
+        runCont,
+        rerunCont,
+        spawnCont,
+        contParallel,
+        contParallel_,
+        catchCont,
+        finallyCont,
+        throwCont,
+        resumeCont,
+        resumeECont,
+        contCanceled,
+        contFreeze,
+        contAwait) where
+
+import Data.Array
+import Data.Monoid
+
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Applicative
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+
+-- | It defines how the parent and child computations should be cancelled.
+data ContCancellation = CancelTogether
+                        -- ^ Cancel the both computations together.
+                      | CancelChildAfterParent
+                        -- ^ Cancel the child if its parent is cancelled.
+                      | CancelParentAfterChild
+                        -- ^ Cancel the parent if its child is cancelled.
+                      | CancelInIsolation
+                        -- ^ Cancel the computations in isolation.
+
+-- | It manages the cancellation process.
+data ContCancellationSource m =
+  ContCancellationSource { contCancellationInitiatedRef :: ProtoRef m Bool,
+                           contCancellationActivatedRef :: ProtoRef m Bool,
+                           contCancellationInitiatingSource :: SignalSource m ()
+                         }
+
+-- | Create the cancellation source.
+newContCancellationSource :: MonadComp m => Simulation m (ContCancellationSource m)
+newContCancellationSource =
+  Simulation $ \r ->
+  do let sn = runSession r
+     r1 <- newProtoRef sn False
+     r2 <- newProtoRef sn False
+     s  <- invokeSimulation r newSignalSource
+     return ContCancellationSource { contCancellationInitiatedRef = r1,
+                                     contCancellationActivatedRef = r2,
+                                     contCancellationInitiatingSource = s
+                                   }
+
+-- | Signal when the cancellation is intiating.
+contCancellationInitiating :: ContCancellationSource m -> Signal m ()
+contCancellationInitiating =
+  publishSignal . contCancellationInitiatingSource
+
+-- | Whether the cancellation was initiated.
+contCancellationInitiated :: MonadComp m => ContCancellationSource m -> (Event m Bool)
+contCancellationInitiated x =
+  Event $ \p -> readProtoRef (contCancellationInitiatedRef x)
+
+-- | Whether the cancellation was activated.
+contCancellationActivated :: MonadComp m => ContCancellationSource m -> m Bool
+contCancellationActivated =
+  readProtoRef . contCancellationActivatedRef
+
+-- | Deactivate the cancellation.
+contCancellationDeactivate :: MonadComp m => ContCancellationSource m -> m ()
+contCancellationDeactivate x =
+  writeProtoRef (contCancellationActivatedRef x) False
+
+-- | If the main computation is cancelled then all the nested ones will be cancelled too.
+contCancellationBind :: MonadComp m => ContCancellationSource m -> [ContCancellationSource m] -> Event m (DisposableEvent m)
+contCancellationBind x ys =
+  Event $ \p ->
+  do hs1 <- forM ys $ \y ->
+       invokeEvent p $
+       handleSignal (contCancellationInitiating x) $ \_ ->
+       contCancellationInitiate y
+     hs2 <- forM ys $ \y ->
+       invokeEvent p $
+       handleSignal (contCancellationInitiating y) $ \_ ->
+       contCancellationInitiate x
+     return $ mconcat hs1 <> mconcat hs2
+
+-- | Connect the parent computation to the child one.
+contCancellationConnect :: MonadComp m
+                           => ContCancellationSource m
+                           -- ^ the parent
+                           -> ContCancellation
+                           -- ^ how to connect
+                           -> ContCancellationSource m
+                           -- ^ the child
+                           -> Event m (DisposableEvent m)
+                           -- ^ computation of the disposable handler
+contCancellationConnect parent cancellation child =
+  Event $ \p ->
+  do let m1 =
+           handleSignal (contCancellationInitiating parent) $ \_ ->
+           contCancellationInitiate child
+         m2 =
+           handleSignal (contCancellationInitiating child) $ \_ ->
+           contCancellationInitiate parent
+     h1 <- 
+       case cancellation of
+         CancelTogether -> invokeEvent p m1
+         CancelChildAfterParent -> invokeEvent p m1
+         CancelParentAfterChild -> return mempty
+         CancelInIsolation -> return mempty
+     h2 <-
+       case cancellation of
+         CancelTogether -> invokeEvent p m2
+         CancelChildAfterParent -> return mempty
+         CancelParentAfterChild -> invokeEvent p m2
+         CancelInIsolation -> return mempty
+     return $ h1 <> h2
+
+-- | Initiate the cancellation.
+contCancellationInitiate :: MonadComp m => ContCancellationSource m -> Event m ()
+contCancellationInitiate x =
+  Event $ \p ->
+  do f <- readProtoRef (contCancellationInitiatedRef x)
+     unless f $
+       do writeProtoRef (contCancellationInitiatedRef x) True
+          writeProtoRef (contCancellationActivatedRef x) True
+          invokeEvent p $ triggerSignal (contCancellationInitiatingSource x) ()
+
+-- | The 'Cont' type is similar to the standard Cont monad 
+-- and F# async workflow but only the result of applying
+-- the continuations return the 'Event' computation.
+newtype Cont m a = Cont (ContParams m a -> Event m ())
+
+-- | The continuation parameters.
+data ContParams m a = 
+  ContParams { contCont :: a -> Event m (), 
+               contAux  :: ContParamsAux m }
+
+-- | The auxiliary continuation parameters.
+data ContParamsAux m =
+  ContParamsAux { contECont :: SomeException -> Event m (),
+                  contCCont :: () -> Event m (),
+                  contCancelSource :: ContCancellationSource m,
+                  contCancelFlag :: m Bool,
+                  contCatchFlag  :: Bool }
+
+instance MonadComp m => Monad (Cont m) where
+
+  {-# INLINE return #-}
+  return a = 
+    Cont $ \c ->
+    Event $ \p ->
+    do z <- contCanceled c
+       if z 
+         then cancelCont p c
+         else invokeEvent p $ contCont c a
+
+  {-# INLINE (>>=) #-}
+  (Cont m) >>= k =
+    Cont $ \c ->
+    Event $ \p ->
+    do z <- contCanceled c
+       if z 
+         then cancelCont p c
+         else invokeEvent p $ m $ 
+              let cont a = invokeCont c (k a)
+              in c { contCont = cont }
+
+instance MonadCompTrans Cont where
+
+  {-# INLINE liftComp #-}
+  liftComp m =
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching m p c
+    else liftWithoutCatching m p c
+
+instance ParameterLift Cont where
+
+  {-# INLINE liftParameter #-}
+  liftParameter (Parameter m) = 
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching (m $ pointRun p) p c
+    else liftWithoutCatching (m $ pointRun p) p c
+
+instance SimulationLift Cont where
+
+  {-# INLINE liftSimulation #-}
+  liftSimulation (Simulation m) = 
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching (m $ pointRun p) p c
+    else liftWithoutCatching (m $ pointRun p) p c
+
+instance DynamicsLift Cont where
+
+  {-# INLINE liftDynamics #-}
+  liftDynamics (Dynamics m) = 
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching (m p) p c
+    else liftWithoutCatching (m p) p c
+
+instance EventLift Cont where
+
+  {-# INLINE liftEvent #-}
+  liftEvent (Event m) = 
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching (m p) p c
+    else liftWithoutCatching (m p) p c
+
+instance (MonadComp m, MonadIO m) => MonadIO (Cont m) where
+
+  {-# INLINE liftIO #-}
+  liftIO m =
+    Cont $ \c ->
+    Event $ \p ->
+    if contCatchFlag . contAux $ c
+    then liftWithCatching (liftIO m) p c
+    else liftWithoutCatching (liftIO m) p c
+
+instance MonadComp m => Functor (Cont m) where
+
+  {-# INLINE fmap #-}
+  fmap = liftM
+
+instance MonadComp m => Applicative (Cont m) where
+
+  {-# INLINE pure #-}
+  pure = return
+
+  {-# INLINE (<*>) #-}
+  (<*>) = ap
+
+-- | Invoke the computation.
+invokeCont :: ContParams m a -> Cont m a -> Event m ()
+{-# INLINE invokeCont #-}
+invokeCont p (Cont m) = m p
+
+-- | Cancel the computation.
+cancelCont :: MonadComp m => Point m -> ContParams m a -> m ()
+{-# NOINLINE cancelCont #-}
+cancelCont p c =
+  do contCancellationDeactivate (contCancelSource $ contAux c)
+     invokeEvent p $ (contCCont $ contAux c) ()
+
+-- | Like @return a >>= k@.
+callCont :: MonadComp m => (a -> Cont m b) -> a -> ContParams m b -> Event m ()
+callCont k a c =
+  Event $ \p ->
+  do z <- contCanceled c
+     if z 
+       then cancelCont p c
+       else invokeEvent p $ invokeCont c (k a)
+
+-- | Exception handling within 'Cont' computations.
+catchCont :: (MonadComp m, Exception e) => Cont m a -> (e -> Cont m a) -> Cont m a
+catchCont (Cont m) h = 
+  Cont $ \c0 ->
+  Event $ \p -> 
+  do let c = c0 { contAux = (contAux c0) { contCatchFlag = True } }
+     z <- contCanceled c
+     if z 
+       then cancelCont p c
+       else invokeEvent p $ m $
+            let econt e0 =
+                  case fromException e0 of
+                    Just e  -> callCont h e c
+                    Nothing -> (contECont . contAux $ c) e0
+            in c { contAux = (contAux c) { contECont = econt } }
+               
+-- | A computation with finalization part.
+finallyCont :: MonadComp m => Cont m a -> Cont m b -> Cont m a
+finallyCont (Cont m) (Cont m') = 
+  Cont $ \c0 -> 
+  Event $ \p ->
+  do let c = c0 { contAux = (contAux c0) { contCatchFlag = True } }
+     z <- contCanceled c
+     if z 
+       then cancelCont p c
+       else invokeEvent p $ m $
+            let cont a   = 
+                  Event $ \p ->
+                  invokeEvent p $ m' $
+                  let cont b = contCont c a
+                  in c { contCont = cont }
+                econt e  =
+                  Event $ \p ->
+                  invokeEvent p $ m' $
+                  let cont b = (contECont . contAux $ c) e
+                  in c { contCont = cont }
+                ccont () = 
+                  Event $ \p ->
+                  invokeEvent p $ m' $
+                  let cont b  = (contCCont . contAux $ c) ()
+                      econt e = (contCCont . contAux $ c) ()
+                  in c { contCont = cont,
+                         contAux  = (contAux c) { contECont = econt } }
+            in c { contCont = cont,
+                   contAux  = (contAux c) { contECont = econt,
+                                            contCCont = ccont } }
+
+-- | Throw the exception with the further exception handling.
+--
+-- By some reason, an exception raised with help of the standard 'throw' function
+-- is not handled properly within 'Cont' computation, altough it will be still handled 
+-- if it will be wrapped in the 'IO' monad. Therefore, you should use specialised
+-- functions like the stated one that use the 'throw' function but within the 'IO' computation,
+-- which allows already handling the exception.
+throwCont :: (MonadComp m, Exception e) => e -> Cont m a
+throwCont = liftEvent . throwEvent
+
+-- | Run the 'Cont' computation with the specified cancelation source 
+-- and flag indicating whether to catch exceptions from the beginning.
+runCont :: MonadComp m
+           => Cont m a
+           -- ^ the computation to run
+           -> (a -> Event m ())
+           -- ^ the main branch 
+           -> (SomeException -> Event m ())
+           -- ^ the branch for handing exceptions
+           -> (() -> Event m ())
+           -- ^ the branch for cancellation
+           -> ContCancellationSource m
+           -- ^ the cancellation source
+           -> Bool
+           -- ^ whether to support the exception handling from the beginning
+           -> Event m ()
+runCont (Cont m) cont econt ccont cancelSource catchFlag = 
+  m ContParams { contCont = cont,
+                 contAux  = 
+                   ContParamsAux { contECont = econt,
+                                   contCCont = ccont,
+                                   contCancelSource = cancelSource,
+                                   contCancelFlag = contCancellationActivated cancelSource, 
+                                   contCatchFlag  = catchFlag } }
+  
+liftWithoutCatching :: MonadComp m => m a -> Point m -> ContParams m a -> m ()
+{-# INLINE liftWithoutCatching #-}
+liftWithoutCatching m p c =
+  do z <- contCanceled c
+     if z
+       then cancelCont p c
+       else do a <- m
+               invokeEvent p $ contCont c a
+
+liftWithCatching :: MonadComp m => m a -> Point m -> ContParams m a -> m ()
+{-# NOINLINE liftWithCatching #-}
+liftWithCatching m p c =
+  do z <- contCanceled c
+     if z
+       then cancelCont p c
+       else do let s = runSession $ pointRun p
+               aref <- newProtoRef s undefined
+               eref <- newProtoRef s Nothing
+               catchComp
+                 (m >>= writeProtoRef aref) 
+                 (writeProtoRef eref . Just)
+               e <- readProtoRef eref
+               case e of
+                 Nothing -> 
+                   do a <- readProtoRef aref
+                      -- tail recursive
+                      invokeEvent p $ contCont c a
+                 Just e ->
+                   -- tail recursive
+                   invokeEvent p $ (contECont . contAux) c e
+
+-- | Resume the computation by the specified parameters.
+resumeCont :: MonadComp m => ContParams m a -> a -> Event m ()
+{-# INLINE resumeCont #-}
+resumeCont c a = 
+  Event $ \p ->
+  do z <- contCanceled c
+     if z
+       then cancelCont p c
+       else invokeEvent p $ contCont c a
+
+-- | Resume the exception handling by the specified parameters.
+resumeECont :: MonadComp m => ContParams m a -> SomeException -> Event m ()
+{-# INLINE resumeECont #-}
+resumeECont c e = 
+  Event $ \p ->
+  do z <- contCanceled c
+     if z
+       then cancelCont p c
+       else invokeEvent p $ (contECont $ contAux c) e
+
+-- | Test whether the computation is canceled.
+contCanceled :: ContParams m a -> m Bool
+{-# INLINE contCanceled #-}
+contCanceled c = contCancelFlag $ contAux c
+
+-- | Execute the specified computations in parallel within
+-- the current computation and return their results. The cancellation
+-- of any of the nested computations affects the current computation.
+-- The exception raised in any of the nested computations is propogated
+-- to the current computation as well (if the exception handling is
+-- supported).
+--
+-- Here word @parallel@ literally means that the computations are
+-- actually executed on a single operating system thread but
+-- they are processed simultaneously by the event queue.
+contParallel :: MonadComp m
+                => [(Cont m a, ContCancellationSource m)]
+                -- ^ the list of pairs:
+                -- the nested computation,
+                -- the cancellation source
+                -> Cont m [a]
+contParallel xs =
+  Cont $ \c ->
+  Event $ \p ->
+  do let n = length xs
+         s = runSession $ pointRun p
+         worker =
+           do results   <- newProtoArray_ s n
+              counter   <- newProtoRef s 0
+              catchRef  <- newProtoRef s Nothing
+              hs <- invokeEvent p $
+                    contCancellationBind (contCancelSource $ contAux c) $
+                    map snd xs
+              let propagate =
+                    Event $ \p ->
+                    do n' <- readProtoRef counter
+                       when (n' == n) $
+                         do invokeEvent p $ disposeEvent hs  -- unbind the cancellation sources
+                            f1 <- contCanceled c
+                            f2 <- readProtoRef catchRef
+                            case (f1, f2) of
+                              (False, Nothing) ->
+                                do rs <- protoArrayToList results
+                                   invokeEvent p $ resumeCont c rs
+                              (False, Just e) ->
+                                invokeEvent p $ resumeECont c e
+                              (True, _) ->
+                                cancelCont p c
+                  cont i a =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       writeProtoArray results i a
+                       invokeEvent p propagate
+                  econt e =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       r <- readProtoRef catchRef
+                       case r of
+                         Nothing -> writeProtoRef catchRef $ Just e
+                         Just e' -> return ()  -- ignore the next error
+                       invokeEvent p propagate
+                  ccont e =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       -- the main computation was automatically canceled
+                       invokeEvent p propagate
+              forM_ (zip [0..n-1] xs) $ \(i, (x, cancelSource)) ->
+                invokeEvent p $
+                runCont x (cont i) econt ccont cancelSource (contCatchFlag $ contAux c)
+     z <- contCanceled c
+     if z
+       then cancelCont p c
+       else if n == 0
+            then invokeEvent p $ contCont c []
+            else worker
+
+-- | A partial case of 'contParallel' when we are not interested in
+-- the results but we are interested in the actions to be peformed by
+-- the nested computations.
+contParallel_ :: MonadComp m
+                 => [(Cont m a, ContCancellationSource m)]
+                 -- ^ the list of pairs:
+                 -- the nested computation,
+                 -- the cancellation source
+                 -> Cont m ()
+contParallel_ xs =
+  Cont $ \c ->
+  Event $ \p ->
+  do let n = length xs
+         s = runSession $ pointRun p
+         worker =
+           do counter   <- newProtoRef s 0
+              catchRef  <- newProtoRef s Nothing
+              hs <- invokeEvent p $
+                    contCancellationBind (contCancelSource $ contAux c) $
+                    map snd xs
+              let propagate =
+                    Event $ \p ->
+                    do n' <- readProtoRef counter
+                       when (n' == n) $
+                         do invokeEvent p $ disposeEvent hs  -- unbind the cancellation sources
+                            f1 <- contCanceled c
+                            f2 <- readProtoRef catchRef
+                            case (f1, f2) of
+                              (False, Nothing) ->
+                                invokeEvent p $ resumeCont c ()
+                              (False, Just e) ->
+                                invokeEvent p $ resumeECont c e
+                              (True, _) ->
+                                cancelCont p c
+                  cont i a =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       -- ignore the result
+                       invokeEvent p propagate
+                  econt e =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       r <- readProtoRef catchRef
+                       case r of
+                         Nothing -> writeProtoRef catchRef $ Just e
+                         Just e' -> return ()  -- ignore the next error
+                       invokeEvent p propagate
+                  ccont e =
+                    Event $ \p ->
+                    do modifyProtoRef counter (+ 1)
+                       -- the main computation was automatically canceled
+                       invokeEvent p propagate
+              forM_ (zip [0..n-1] xs) $ \(i, (x, cancelSource)) ->
+                invokeEvent p $
+                runCont x (cont i) econt ccont cancelSource (contCatchFlag $ contAux c)
+     z <- contCanceled c
+     if z
+       then cancelCont p c
+       else if n == 0
+            then invokeEvent p $ contCont c ()
+            else worker
+
+-- | Rerun the 'Cont' computation with the specified cancellation source.
+rerunCont :: MonadComp m => Cont m a -> ContCancellationSource m -> Cont m a
+rerunCont x cancelSource =
+  Cont $ \c ->
+  Event $ \p ->
+  do let worker =
+           do hs <- invokeEvent p $
+                    contCancellationBind (contCancelSource $ contAux c) [cancelSource]
+              let cont a  =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       invokeEvent p $ resumeCont c a
+                  econt e =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       invokeEvent p $ resumeECont c e
+                  ccont e =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       cancelCont p c
+              invokeEvent p $
+                runCont x cont econt ccont cancelSource (contCatchFlag $ contAux c)
+     z <- contCanceled c
+     if z
+       then cancelCont p c
+       else worker
+
+-- | Run the 'Cont' computation in parallel but connect the cancellation sources.
+spawnCont :: MonadComp m => ContCancellation -> Cont m () -> ContCancellationSource m -> Cont m ()
+spawnCont cancellation x cancelSource =
+  Cont $ \c ->
+  Event $ \p ->
+  do let worker =
+           do hs <- invokeEvent p $
+                    contCancellationConnect
+                    (contCancelSource $ contAux c) cancellation cancelSource
+              let cont a  =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       -- do nothing and it will finish the computation
+                  econt e =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       invokeEvent p $ throwEvent e  -- this is all we can do
+                  ccont e =
+                    Event $ \p ->
+                    do invokeEvent p $ disposeEvent hs  -- unbind the cancellation source
+                       -- do nothing and it will finish the computation
+              invokeEvent p $
+                enqueueEvent (pointTime p) $
+                runCont x cont econt ccont cancelSource False
+              invokeEvent p $
+                resumeCont c ()
+     z <- contCanceled c
+     if z
+       then cancelCont p c
+       else worker
+
+-- | Freeze the computation parameters temporarily.
+contFreeze :: MonadComp m => ContParams m a -> Event m (Event m (Maybe (ContParams m a)))
+contFreeze c =
+  Event $ \p ->
+  do let s = runSession $ pointRun p
+     rh <- newProtoRef s Nothing
+     rc <- newProtoRef s $ Just c
+     h <- invokeEvent p $
+          handleSignal (contCancellationInitiating $
+                        contCancelSource $
+                        contAux c) $ \a ->
+          Event $ \p ->
+          do h <- readProtoRef rh
+             case h of
+               Nothing ->
+                 error "The handler was lost: contFreeze."
+               Just h ->
+                 do invokeEvent p $ disposeEvent h
+                    c <- readProtoRef rc
+                    case c of
+                      Nothing -> return ()
+                      Just c  ->
+                        do writeProtoRef rc Nothing
+                           invokeEvent p $
+                             enqueueEvent (pointTime p) $
+                             Event $ \p ->
+                             do z <- contCanceled c
+                                when z $ cancelCont p c
+     writeProtoRef rh (Just h)
+     return $
+       Event $ \p ->
+       do invokeEvent p $ disposeEvent h
+          c <- readProtoRef rc
+          writeProtoRef rc Nothing
+          return c
+     
+-- | Await the signal.
+contAwait :: MonadComp m => Signal m a -> Cont m a
+contAwait signal =
+  Cont $ \c ->
+  Event $ \p ->
+  do let s = runSession $ pointRun p
+     c <- invokeEvent p $ contFreeze c
+     r <- newProtoRef s Nothing
+     h <- invokeEvent p $
+          handleSignal signal $ 
+          \a -> Event $ 
+                \p -> do x <- readProtoRef r
+                         case x of
+                           Nothing ->
+                             error "The signal was lost: contAwait."
+                           Just x ->
+                             do invokeEvent p $ disposeEvent x
+                                c <- invokeEvent p c
+                                case c of
+                                  Nothing -> return ()
+                                  Just c  ->
+                                    invokeEvent p $ resumeCont c a
+     writeProtoRef r $ Just h
+ Simulation/Aivika/Trans/Internal/Dynamics.hs view
@@ -0,0 +1,270 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Dynamics
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'Dynamics' monad transformer representing a time varying polymorphic function. 
+--
+module Simulation.Aivika.Trans.Internal.Dynamics
+       (-- * Dynamics
+        DynamicsLift(..),
+        runDynamicsInStartTime,
+        runDynamicsInStopTime,
+        runDynamicsInIntegTimes,
+        runDynamicsInTime,
+        runDynamicsInTimes,
+        -- * Error Handling
+        catchDynamics,
+        finallyDynamics,
+        throwDynamics,
+        -- * Simulation Time
+        time,
+        isTimeInteg,
+        integIteration,
+        integPhase) where
+
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Applicative
+
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+
+instance Monad m => Monad (Dynamics m) where
+
+  {-# INLINE return #-}
+  return a = Dynamics $ \p -> return a
+
+  {-# INLINE (>>=) #-}
+  (Dynamics m) >>= k =
+    Dynamics $ \p -> 
+    do a <- m p
+       let Dynamics m' = k a
+       m' p
+
+-- | Run the 'Dynamics' computation in the initial time point.
+runDynamicsInStartTime :: Dynamics m a -> Simulation m a
+runDynamicsInStartTime (Dynamics m) =
+  Simulation $ m . integStartPoint
+
+-- | Run the 'Dynamics' computation in the final time point.
+runDynamicsInStopTime :: Dynamics m a -> Simulation m a
+runDynamicsInStopTime (Dynamics m) =
+  Simulation $ m . integStopPoint
+
+-- | Run the 'Dynamics' computation in all integration time points.
+runDynamicsInIntegTimes :: Monad m => Dynamics m a -> Simulation m [m a]
+runDynamicsInIntegTimes (Dynamics m) =
+  Simulation $ return . map m . integPoints
+
+-- | Run the 'Dynamics' computation in the specified time point.
+runDynamicsInTime :: Double -> Dynamics m a -> Simulation m a
+runDynamicsInTime t (Dynamics m) =
+  Simulation $ \r -> m $ pointAt r t
+
+-- | Run the 'Dynamics' computation in the specified time points.
+runDynamicsInTimes :: Monad m => [Double] -> Dynamics m a -> Simulation m [m a]
+runDynamicsInTimes ts (Dynamics m) =
+  Simulation $ \r -> return $ map (m . pointAt r) ts 
+
+instance Functor m => Functor (Dynamics m) where
+  
+  {-# INLINE fmap #-}
+  fmap f (Dynamics x) = Dynamics $ \p -> fmap f $ x p
+
+instance Applicative m => Applicative (Dynamics m) where
+  
+  {-# INLINE pure #-}
+  pure = Dynamics . const . pure
+  
+  {-# INLINE (<*>) #-}
+  (Dynamics x) <*> (Dynamics y) = Dynamics $ \p -> x p <*> y p
+
+liftMD :: Monad m => (a -> b) -> Dynamics m a -> Dynamics m b
+{-# INLINE liftMD #-}
+liftMD f (Dynamics x) =
+  Dynamics $ \p -> do { a <- x p; return $ f a }
+
+liftM2D :: Monad m => (a -> b -> c) -> Dynamics m a -> Dynamics m b -> Dynamics m c
+{-# INLINE liftM2D #-}
+liftM2D f (Dynamics x) (Dynamics y) =
+  Dynamics $ \p -> do { a <- x p; b <- y p; return $ f a b }
+
+instance (Num a, Monad m) => Num (Dynamics m a) where
+
+  {-# INLINE (+) #-}
+  x + y = liftM2D (+) x y
+
+  {-# INLINE (-) #-}
+  x - y = liftM2D (-) x y
+
+  {-# INLINE (*) #-}
+  x * y = liftM2D (*) x y
+
+  {-# INLINE negate #-}
+  negate = liftMD negate
+
+  {-# INLINE abs #-}
+  abs = liftMD abs
+
+  {-# INLINE signum #-}
+  signum = liftMD signum
+
+  {-# INLINE fromInteger #-}
+  fromInteger i = return $ fromInteger i
+
+instance (Fractional a, Monad m) => Fractional (Dynamics m a) where
+
+  {-# INLINE (/) #-}
+  x / y = liftM2D (/) x y
+
+  {-# INLINE recip #-}
+  recip = liftMD recip
+
+  {-# INLINE fromRational #-}
+  fromRational t = return $ fromRational t
+
+instance (Floating a, Monad m) => Floating (Dynamics m a) where
+
+  {-# INLINE pi #-}
+  pi = return pi
+
+  {-# INLINE exp #-}
+  exp = liftMD exp
+
+  {-# INLINE log #-}
+  log = liftMD log
+
+  {-# INLINE sqrt #-}
+  sqrt = liftMD sqrt
+
+  {-# INLINE (**) #-}
+  x ** y = liftM2D (**) x y
+
+  {-# INLINE sin #-}
+  sin = liftMD sin
+
+  {-# INLINE cos #-}
+  cos = liftMD cos
+
+  {-# INLINE tan #-}
+  tan = liftMD tan
+
+  {-# INLINE asin #-}
+  asin = liftMD asin
+
+  {-# INLINE acos #-}
+  acos = liftMD acos
+
+  {-# INLINE atan #-}
+  atan = liftMD atan
+
+  {-# INLINE sinh #-}
+  sinh = liftMD sinh
+
+  {-# INLINE cosh #-}
+  cosh = liftMD cosh
+
+  {-# INLINE tanh #-}
+  tanh = liftMD tanh
+
+  {-# INLINE asinh #-}
+  asinh = liftMD asinh
+
+  {-# INLINE acosh #-}
+  acosh = liftMD acosh
+
+  {-# INLINE atanh #-}
+  atanh = liftMD atanh
+
+instance MonadTrans Dynamics where
+
+  {-# INLINE lift #-}
+  lift = Dynamics . const
+
+instance MonadIO m => MonadIO (Dynamics m) where
+  
+  {-# INLINE liftIO #-}
+  liftIO = Dynamics . const . liftIO
+
+instance MonadCompTrans Dynamics where
+
+  {-# INLINE liftComp #-}
+  liftComp = Dynamics . const
+
+-- | A type class to lift the 'Dynamics' computations into other computations.
+class DynamicsLift t where
+  
+  -- | Lift the specified 'Dynamics' computation into another computation.
+  liftDynamics :: MonadComp m => Dynamics m a -> t m a
+
+instance DynamicsLift Dynamics where
+  
+  {-# INLINE liftDynamics #-}
+  liftDynamics = id
+
+instance SimulationLift Dynamics where
+
+  {-# INLINE liftSimulation #-}
+  liftSimulation (Simulation x) = Dynamics $ x . pointRun 
+
+instance ParameterLift Dynamics where
+
+  {-# INLINE liftParameter #-}
+  liftParameter (Parameter x) = Dynamics $ x . pointRun
+  
+-- | Exception handling within 'Dynamics' computations.
+catchDynamics :: (MonadComp m, Exception e) => Dynamics m a -> (e -> Dynamics m a) -> Dynamics m a
+catchDynamics (Dynamics m) h =
+  Dynamics $ \p -> 
+  catchComp (m p) $ \e ->
+  let Dynamics m' = h e in m' p
+                           
+-- | A computation with finalization part like the 'finally' function.
+finallyDynamics :: MonadComp m => Dynamics m a -> Dynamics m b -> Dynamics m a
+finallyDynamics (Dynamics m) (Dynamics m') =
+  Dynamics $ \p ->
+  finallyComp (m p) (m' p)
+
+-- | Like the standard 'throw' function.
+throwDynamics :: (MonadComp m, Exception e) => e -> Dynamics m a
+throwDynamics = throw
+
+instance MonadFix m => MonadFix (Dynamics m) where
+
+  {-# INLINE mfix #-}
+  mfix f = 
+    Dynamics $ \p ->
+    do { rec { a <- invokeDynamics p (f a) }; return a }
+
+-- | Computation that returns the current simulation time.
+time :: Monad m => Dynamics m Double
+{-# INLINE time #-}
+time = Dynamics $ return . pointTime 
+
+-- | Whether the current time is an integration time.
+isTimeInteg :: Monad m => Dynamics m Bool
+{-# INLINE isTimeInteg #-}
+isTimeInteg = Dynamics $ \p -> return $ pointPhase p >= 0
+
+-- | Return the integration iteration closest to the current simulation time.
+integIteration :: Monad m => Dynamics m Int
+{-# INLINE integIteration #-}
+integIteration = Dynamics $ return . pointIteration
+
+-- | Return the integration phase for the current simulation time.
+-- It is @(-1)@ for non-integration time points.
+integPhase :: Monad m => Dynamics m Int
+{-# INLINE integPhase #-}
+integPhase = Dynamics $ return . pointPhase
+ Simulation/Aivika/Trans/Internal/Event.hs view
@@ -0,0 +1,277 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Event
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'Event' monad transformer which is very similar to the 'Dynamics'
+-- monad transformer but only now the computation is strongly synchronized with the event queue.
+--
+module Simulation.Aivika.Trans.Internal.Event
+       (-- * Event Monad
+        EventLift(..),
+        runEventInStartTime,
+        runEventInStopTime,
+        -- * Event Queue
+        enqueueEventWithCancellation,
+        enqueueEventWithTimes,
+        enqueueEventWithPoints,
+        enqueueEventWithIntegTimes,
+        yieldEvent,
+        -- * Cancelling Event
+        EventCancellation,
+        cancelEvent,
+        eventCancelled,
+        eventFinished,
+        -- * Error Handling
+        catchEvent,
+        finallyEvent,
+        throwEvent,
+        -- * Memoization
+        memoEvent,
+        memoEventInTime,
+        -- * Disposable
+        DisposableEvent(..)) where
+
+import Data.Monoid
+
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Applicative
+
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+
+instance Monad m => Monad (Event m) where
+
+  {-# INLINE return #-}
+  return a = Event $ \p -> return a
+
+  {-# INLINE (>>=) #-}
+  (Event m) >>= k =
+    Event $ \p -> 
+    do a <- m p
+       let Event m' = k a
+       m' p
+
+instance Functor m => Functor (Event m) where
+  
+  {-# INLINE fmap #-}
+  fmap f (Event x) = Event $ \p -> fmap f $ x p
+
+instance Applicative m => Applicative (Event m) where
+  
+  {-# INLINE pure #-}
+  pure = Event . const . pure
+  
+  {-# INLINE (<*>) #-}
+  (Event x) <*> (Event y) = Event $ \p -> x p <*> y p
+
+instance MonadTrans Event where
+
+  {-# INLINE lift #-}
+  lift = Event . const
+
+instance MonadIO m => MonadIO (Event m) where
+  
+  {-# INLINE liftIO #-}
+  liftIO = Event . const . liftIO
+
+instance MonadCompTrans Event where
+
+  {-# INLINE liftComp #-}
+  liftComp = Event . const
+
+-- | A type class to lift the 'Event' computations into other computations.
+class EventLift t where
+  
+  -- | Lift the specified 'Event' computation into another computation.
+  liftEvent :: MonadComp m => Event m a -> t m a
+
+instance EventLift Event where
+  
+  {-# INLINE liftEvent #-}
+  liftEvent = id
+
+instance DynamicsLift Event where
+  
+  {-# INLINE liftDynamics #-}
+  liftDynamics (Dynamics x) = Event x
+
+instance SimulationLift Event where
+
+  {-# INLINE liftSimulation #-}
+  liftSimulation (Simulation x) = Event $ x . pointRun 
+
+instance ParameterLift Event where
+
+  {-# INLINE liftParameter #-}
+  liftParameter (Parameter x) = Event $ x . pointRun
+
+-- | Exception handling within 'Event' computations.
+catchEvent :: (MonadComp m, Exception e) => Event m a -> (e -> Event m a) -> Event m a
+catchEvent (Event m) h =
+  Event $ \p -> 
+  catchComp (m p) $ \e ->
+  let Event m' = h e in m' p
+                           
+-- | A computation with finalization part like the 'finally' function.
+finallyEvent :: MonadComp m => Event m a -> Event m b -> Event m a
+finallyEvent (Event m) (Event m') =
+  Event $ \p ->
+  finallyComp (m p) (m' p)
+
+-- | Like the standard 'throw' function.
+throwEvent :: (MonadComp m, Exception e) => e -> Event m a
+throwEvent = throw
+
+instance MonadFix m => MonadFix (Event m) where
+
+  {-# INLINE mfix #-}
+  mfix f = 
+    Event $ \p ->
+    do { rec { a <- invokeEvent p (f a) }; return a }
+
+-- | Run the 'Event' computation in the start time involving all
+-- pending 'CurrentEvents' in the processing too.
+runEventInStartTime :: MonadComp m => Event m a -> Simulation m a
+runEventInStartTime = runDynamicsInStartTime . runEvent
+
+-- | Run the 'Event' computation in the stop time involving all
+-- pending 'CurrentEvents' in the processing too.
+runEventInStopTime :: MonadComp m => Event m a -> Simulation m a
+runEventInStopTime = runDynamicsInStopTime . runEvent
+
+-- | Actuate the event handler in the specified time points.
+enqueueEventWithTimes :: MonadComp m => [Double] -> Event m () -> Event m ()
+enqueueEventWithTimes ts e = loop ts
+  where loop []       = return ()
+        loop (t : ts) = enqueueEvent t $ e >> loop ts
+       
+-- | Actuate the event handler in the specified time points.
+enqueueEventWithPoints :: MonadComp m => [Point m] -> Event m () -> Event m ()
+enqueueEventWithPoints xs (Event e) = loop xs
+  where loop []       = return ()
+        loop (x : xs) = enqueueEvent (pointTime x) $ 
+                        Event $ \p ->
+                        do e x    -- N.B. we substitute the time point!
+                           invokeEvent p $ loop xs
+                           
+-- | Actuate the event handler in the integration time points.
+enqueueEventWithIntegTimes :: MonadComp m => Event m () -> Event m ()
+enqueueEventWithIntegTimes e =
+  Event $ \p ->
+  let points = integPoints $ pointRun p
+  in invokeEvent p $ enqueueEventWithPoints points e
+
+-- | It allows cancelling the event.
+data EventCancellation m =
+  EventCancellation { cancelEvent :: Event m (),
+                      -- ^ Cancel the event.
+                      eventCancelled :: Event m Bool,
+                      -- ^ Test whether the event was cancelled.
+                      eventFinished :: Event m Bool
+                      -- ^ Test whether the event was processed and finished.
+                    }
+
+-- | Enqueue the event with an ability to cancel it.
+enqueueEventWithCancellation :: MonadComp m => Double -> Event m () -> Event m (EventCancellation m)
+enqueueEventWithCancellation t e =
+  Event $ \p ->
+  do let s = runSession $ pointRun p
+     cancelledRef <- newProtoRef s False
+     cancellableRef <- newProtoRef s True
+     finishedRef <- newProtoRef s False
+     let cancel =
+           Event $ \p ->
+           do x <- readProtoRef cancellableRef
+              when x $
+                writeProtoRef cancelledRef True
+         cancelled =
+           Event $ \p -> readProtoRef cancelledRef
+         finished =
+           Event $ \p -> readProtoRef finishedRef
+     invokeEvent p $
+       enqueueEvent t $
+       Event $ \p ->
+       do writeProtoRef cancellableRef False
+          x <- readProtoRef cancelledRef
+          unless x $
+            do invokeEvent p e
+               writeProtoRef finishedRef True
+     return EventCancellation { cancelEvent   = cancel,
+                                eventCancelled = cancelled,
+                                eventFinished = finished }
+
+-- | Memoize the 'Event' computation, always returning the same value
+-- within a simulation run.
+memoEvent :: MonadComp m => Event m a -> Simulation m (Event m a)
+memoEvent m =
+  Simulation $ \r ->
+  do let s = runSession r
+     ref <- newProtoRef s Nothing
+     return $ Event $ \p ->
+       do x <- readProtoRef ref
+          case x of
+            Just v -> return v
+            Nothing ->
+              do v <- invokeEvent p m
+                 writeProtoRef ref (Just v)
+                 return v
+
+-- | Memoize the 'Event' computation, always returning the same value
+-- in the same modeling time. After the time changes, the value is
+-- recalculated by demand.
+--
+-- It is possible to implement this function efficiently, for the 'Event'
+-- computation is always synchronized with the event queue which time
+-- flows in one direction only. This synchronization is a key difference
+-- between the 'Event' and 'Dynamics' computations.
+memoEventInTime :: MonadComp m => Event m a -> Simulation m (Event m a)
+memoEventInTime m =
+  Simulation $ \r ->
+  do let s = runSession r
+     ref <- newProtoRef s Nothing
+     return $ Event $ \p ->
+       do x <- readProtoRef ref
+          case x of
+            Just (t, v) | t == pointTime p ->
+              return v
+            _ ->
+              do v <- invokeEvent p m
+                 writeProtoRef ref (Just (pointTime p, v))
+                 return v
+
+-- | Enqueue the event which must be actuated with the current modeling time but later.
+yieldEvent :: MonadComp m => Event m () -> Event m ()
+yieldEvent m =
+  Event $ \p ->
+  invokeEvent p $
+  enqueueEvent (pointTime p) m
+
+-- | Defines a computation disposing some entity.
+newtype DisposableEvent m =
+  DisposableEvent { disposeEvent :: Event m ()
+                    -- ^ Dispose something within the 'Event' computation.
+                  }
+
+instance Monad m => Monoid (DisposableEvent m) where
+
+  {-# INLINE mempty #-}
+  mempty = DisposableEvent $ return ()
+
+  {-# INLINE mappend #-}
+  mappend (DisposableEvent x) (DisposableEvent y) = DisposableEvent $ x >> y
+ Simulation/Aivika/Trans/Internal/Parameter.hs view
@@ -0,0 +1,341 @@+
+{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Parameter
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'Parameter' monad transformer that allows representing the model
+-- parameters. For example, they can be used when running the Monte-Carlo simulation.
+-- 
+-- In general, this monad is very useful for representing a computation which is external
+-- relative to the model itself.
+--
+module Simulation.Aivika.Trans.Internal.Parameter
+       (-- * Parameter
+        ParameterLift(..),
+        runParameter,
+        runParameters,
+        -- * Error Handling
+        catchParameter,
+        finallyParameter,
+        throwParameter,
+        -- * Predefined Parameters
+        simulationIndex,
+        simulationCount,
+        simulationSpecs,
+        simulationSession,
+        simulationEventQueue,
+        starttime,
+        stoptime,
+        dt,
+        generatorParameter,
+        -- * Memoization
+        memoParameter,
+        -- * Utilities
+        tableParameter) where
+
+import Control.Exception
+import Control.Concurrent.MVar
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Applicative
+
+import Data.IORef
+import qualified Data.IntMap as M
+import Data.Array
+
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Comp.IO
+import Simulation.Aivika.Trans.Internal.Specs
+
+instance Monad m => Monad (Parameter m) where
+
+  {-# INLINE return #-}
+  return a = Parameter $ \r -> return a
+
+  {-# INLINE (>>=) #-}
+  (Parameter m) >>= k =
+    Parameter $ \r -> 
+    do a <- m r
+       let Parameter m' = k a
+       m' r
+
+-- | Run the parameter using the specified specs.
+runParameter :: MonadComp m => Parameter m a -> Specs m -> m a
+runParameter (Parameter m) sc =
+  do s <- newSession
+     q <- newEventQueue s sc
+     g <- newGenerator s $ spcGeneratorType sc
+     m Run { runSpecs = sc,
+             runSession = s,
+             runIndex = 1,
+             runCount = 1,
+             runEventQueue = q,
+             runGenerator = g }
+
+-- | Run the given number of parameters using the specified specs, 
+--   where each parameter is distinguished by its index 'parameterIndex'.
+runParameters :: MonadComp m => Parameter m a -> Specs m -> Int -> [m a]
+runParameters (Parameter m) sc runs = map f [1 .. runs]
+  where f i = do s <- newSession
+                 q <- newEventQueue s sc
+                 g <- newGenerator s $ spcGeneratorType sc
+                 m Run { runSpecs = sc,
+                         runSession = s,
+                         runIndex = i,
+                         runCount = runs,
+                         runEventQueue = q,
+                         runGenerator = g }
+
+-- | Return the run index for the current simulation.
+simulationIndex :: Monad m => Parameter m Int
+{-# INLINE simulationIndex #-}
+simulationIndex = Parameter $ return . runIndex
+
+-- | Return the number of simulations currently run.
+simulationCount :: Monad m => Parameter m Int
+{-# INLINE simulationCount #-}
+simulationCount = Parameter $ return . runCount
+
+-- | Return the simulation specs.
+simulationSpecs :: Monad m => Parameter m (Specs m)
+{-# INLINE simulationSpecs #-}
+simulationSpecs = Parameter $ return . runSpecs
+
+-- | Return the random number generator for the simulation run.
+generatorParameter :: Monad m => Parameter m (Generator m)
+{-# INLINE generatorParameter #-}
+generatorParameter = Parameter $ return . runGenerator
+
+instance Functor m => Functor (Parameter m) where
+  
+  {-# INLINE fmap #-}
+  fmap f (Parameter x) = Parameter $ \r -> fmap f $ x r
+
+instance Applicative m => Applicative (Parameter m) where
+  
+  {-# INLINE pure #-}
+  pure = Parameter . const . pure
+  
+  {-# INLINE (<*>) #-}
+  (Parameter x) <*> (Parameter y) = Parameter $ \r -> x r <*> y r
+
+liftMP :: Monad m => (a -> b) -> Parameter m a -> Parameter m b
+{-# INLINE liftMP #-}
+liftMP f (Parameter x) =
+  Parameter $ \r -> do { a <- x r; return $ f a }
+
+liftM2P :: Monad m => (a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
+{-# INLINE liftM2P #-}
+liftM2P f (Parameter x) (Parameter y) =
+  Parameter $ \r -> do { a <- x r; b <- y r; return $ f a b }
+
+instance (Num a, Monad m) => Num (Parameter m a) where
+
+  {-# INLINE (+) #-}
+  x + y = liftM2P (+) x y
+
+  {-# INLINE (-) #-}
+  x - y = liftM2P (-) x y
+
+  {-# INLINE (*) #-}
+  x * y = liftM2P (*) x y
+
+  {-# INLINE negate #-}
+  negate = liftMP negate
+
+  {-# INLINE abs #-}
+  abs = liftMP abs
+
+  {-# INLINE signum #-}
+  signum = liftMP signum
+
+  {-# INLINE fromInteger #-}
+  fromInteger i = return $ fromInteger i
+
+instance (Fractional a, Monad m) => Fractional (Parameter m a) where
+
+  {-# INLINE (/) #-}
+  x / y = liftM2P (/) x y
+
+  {-# INLINE recip #-}
+  recip = liftMP recip
+
+  {-# INLINE fromRational #-}
+  fromRational t = return $ fromRational t
+
+instance (Floating a, Monad m) => Floating (Parameter m a) where
+
+  {-# INLINE pi #-}
+  pi = return pi
+
+  {-# INLINE exp #-}
+  exp = liftMP exp
+
+  {-# INLINE log #-}
+  log = liftMP log
+
+  {-# INLINE sqrt #-}
+  sqrt = liftMP sqrt
+
+  {-# INLINE (**) #-}
+  x ** y = liftM2P (**) x y
+
+  {-# INLINE sin #-}
+  sin = liftMP sin
+
+  {-# INLINE cos #-}
+  cos = liftMP cos
+
+  {-# INLINE tan #-}
+  tan = liftMP tan
+
+  {-# INLINE asin #-}
+  asin = liftMP asin
+
+  {-# INLINE acos #-}
+  acos = liftMP acos
+
+  {-# INLINE atan #-}
+  atan = liftMP atan
+
+  {-# INLINE sinh #-}
+  sinh = liftMP sinh
+
+  {-# INLINE cosh #-}
+  cosh = liftMP cosh
+
+  {-# INLINE tanh #-}
+  tanh = liftMP tanh
+
+  {-# INLINE asinh #-}
+  asinh = liftMP asinh
+
+  {-# INLINE acosh #-}
+  acosh = liftMP acosh
+
+  {-# INLINE atanh #-}
+  atanh = liftMP atanh
+
+instance MonadTrans Parameter where
+
+  {-# INLINE lift #-}
+  lift = Parameter . const
+
+instance MonadIO m => MonadIO (Parameter m) where
+  
+  {-# INLINE liftIO #-}
+  liftIO = Parameter . const . liftIO
+
+instance MonadCompTrans Parameter where
+
+  {-# INLINE liftComp #-}
+  liftComp = Parameter . const
+
+-- | A type class to lift the parameters into other computations.
+class ParameterLift t where
+  
+  -- | Lift the specified 'Parameter' computation into another computation.
+  liftParameter :: MonadComp m => Parameter m a -> t m a
+
+instance ParameterLift Parameter where
+  
+  {-# INLINE liftParameter #-}
+  liftParameter = id
+    
+-- | Exception handling within 'Parameter' computations.
+catchParameter :: (MonadComp m, Exception e) => Parameter m a -> (e -> Parameter m a) -> Parameter m a
+catchParameter (Parameter m) h =
+  Parameter $ \r -> 
+  catchComp (m r) $ \e ->
+  let Parameter m' = h e in m' r
+                           
+-- | A computation with finalization part like the 'finally' function.
+finallyParameter :: MonadComp m => Parameter m a -> Parameter m b -> Parameter m a
+finallyParameter (Parameter m) (Parameter m') =
+  Parameter $ \r ->
+  finallyComp (m r) (m' r)
+
+-- | Like the standard 'throw' function.
+throwParameter :: (MonadComp m, Exception e) => e -> Parameter m a
+throwParameter = throw
+
+instance MonadFix m => MonadFix (Parameter m) where
+
+  {-# INLINE mfix #-}
+  mfix f = 
+    Parameter $ \r ->
+    do { rec { a <- invokeParameter r (f a) }; return a }
+
+-- | Memoize the 'Parameter' computation, always returning the same value
+-- within a simulation run. However, the value will be recalculated for other
+-- simulation runs. Also it is thread-safe when different simulation runs
+-- are executed in parallel on physically different operating system threads.
+memoParameter :: Parameter IO a -> IO (Parameter IO a)
+memoParameter x = 
+  do lock <- newMVar ()
+     dict <- newIORef M.empty
+     return $ Parameter $ \r ->
+       do let i = runIndex r
+          m <- readIORef dict
+          if M.member i m
+            then do let Just v = M.lookup i m
+                    return v
+            else withMVar lock $ 
+                 \() -> do { m <- readIORef dict;
+                             if M.member i m
+                             then do let Just v = M.lookup i m
+                                     return v
+                             else do v <- invokeParameter r x
+                                     writeIORef dict $ M.insert i v m
+                                     return v }
+
+-- | Return a parameter which value is taken consequently from the specified table
+-- based on the run index of the current simulation starting from zero. After all
+-- values from the table are used, it takes again the first value of the table,
+-- then the second one and so on.
+tableParameter :: Monad m => Array Int a -> Parameter m a
+tableParameter t =
+  do i <- simulationIndex
+     return $ t ! (((i - i1) `mod` n) + i1)
+  where (i1, i2) = bounds t
+        n = i2 - i1 + 1
+
+-- | Computation that returns the start simulation time.
+starttime :: Monad m => Parameter m Double
+{-# INLINE starttime #-}
+starttime =
+  Parameter $ return . spcStartTime . runSpecs
+
+-- | Computation that returns the final simulation time.
+stoptime :: Monad m => Parameter m Double
+{-# INLINE stoptime #-}
+stoptime =
+  Parameter $ return . spcStopTime . runSpecs
+
+-- | Computation that returns the integration time step.
+dt :: Monad m => Parameter m Double
+{-# INLINE dt #-}
+dt =
+  Parameter $ return . spcDT . runSpecs
+
+-- | Return the event queue.
+simulationEventQueue :: Monad m => Parameter m (EventQueue m)
+{-# INLINE simulationEventQueue #-}
+simulationEventQueue =
+  Parameter $ return . runEventQueue
+
+-- | Return the simulation session.
+simulationSession :: Monad m => Parameter m (Session m)
+{-# INLINE simulationSession #-}
+simulationSession =
+  Parameter $ return . runSession
+ Simulation/Aivika/Trans/Internal/Process.hs view
@@ -0,0 +1,641 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Process
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- A value in the 'Process' monad represents a discontinuous process that 
+-- can suspend in any simulation time point and then resume later in the same 
+-- or another time point. 
+-- 
+-- The process of this type can involve the 'Event', 'Dynamics' and 'Simulation'
+-- computations. Moreover, a value in the @Process@ monad can be run within
+-- the @Event@ computation.
+--
+-- A value of the 'ProcessId' type is just an identifier of such a process.
+--
+module Simulation.Aivika.Trans.Internal.Process
+       (-- * Process Monad
+        ProcessId,
+        Process(..),
+        ProcessLift(..),
+        invokeProcess,
+        -- * Running Process
+        runProcess,
+        runProcessUsingId,
+        runProcessInStartTime,
+        runProcessInStartTimeUsingId,
+        runProcessInStopTime,
+        runProcessInStopTimeUsingId,
+        -- * Spawning Processes
+        spawnProcess,
+        spawnProcessUsingId,
+        -- * Enqueuing Process
+        enqueueProcess,
+        enqueueProcessUsingId,
+        -- * Creating Process Identifier
+        newProcessId,
+        processId,
+        processUsingId,
+        -- * Holding, Interrupting, Passivating and Canceling Process
+        holdProcess,
+        interruptProcess,
+        processInterrupted,
+        passivateProcess,
+        processPassive,
+        reactivateProcess,
+        cancelProcessWithId,
+        cancelProcess,
+        processCancelled,
+        processCancelling,
+        whenCancellingProcess,
+        -- * Awaiting Signal
+        processAwait,
+        -- * Yield of Process
+        processYield,
+        -- * Process Timeout
+        timeoutProcess,
+        timeoutProcessUsingId,
+        -- * Parallelizing Processes
+        processParallel,
+        processParallelUsingIds,
+        processParallel_,
+        processParallelUsingIds_,
+        -- * Exception Handling
+        catchProcess,
+        finallyProcess,
+        throwProcess,
+        -- * Utilities
+        zipProcessParallel,
+        zip3ProcessParallel,
+        unzipProcess,
+        -- * Memoizing Process
+        memoProcess,
+        -- * Never Ending Process
+        neverProcess) where
+
+import Data.Maybe
+
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Applicative
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Cont
+import Simulation.Aivika.Trans.Internal.Signal
+
+-- | Represents a process identifier.
+data ProcessId m = 
+  ProcessId { processStarted :: ProtoRef m Bool,
+              processMarker  :: SessionMarker m,
+              processReactCont     :: ProtoRef m (Maybe (ContParams m ())), 
+              processCancelSource  :: ContCancellationSource m,
+              processInterruptRef  :: ProtoRef m Bool, 
+              processInterruptCont :: ProtoRef m (Maybe (ContParams m ())), 
+              processInterruptVersion :: ProtoRef m Int }
+
+-- | Specifies a discontinuous process that can suspend at any time
+-- and then resume later.
+newtype Process m a = Process (ProcessId m -> Cont m a)
+
+-- | A type class to lift the 'Process' computation into other computations.
+class ProcessLift t where
+  
+  -- | Lift the specified 'Process' computation into another computation.
+  liftProcess :: MonadComp m => Process m a -> t m a
+
+-- | Invoke the process computation.
+invokeProcess :: ProcessId m -> Process m a -> Cont m a
+{-# INLINE invokeProcess #-}
+invokeProcess pid (Process m) = m pid
+
+-- | Hold the process for the specified time period.
+holdProcess :: MonadComp m => Double -> Process m ()
+holdProcess dt =
+  Process $ \pid ->
+  Cont $ \c ->
+  Event $ \p ->
+  do let x = processInterruptCont pid
+     writeProtoRef x $ Just c
+     writeProtoRef (processInterruptRef pid) False
+     v <- readProtoRef (processInterruptVersion pid)
+     invokeEvent p $
+       enqueueEvent (pointTime p + dt) $
+       Event $ \p ->
+       do v' <- readProtoRef (processInterruptVersion pid)
+          when (v == v') $ 
+            do writeProtoRef x Nothing
+               invokeEvent p $ resumeCont c ()
+
+-- | Interrupt a process with the specified identifier if the process
+-- is held by computation 'holdProcess'.
+interruptProcess :: MonadComp m => ProcessId m -> Event m ()
+interruptProcess pid =
+  Event $ \p ->
+  do let x = processInterruptCont pid
+     a <- readProtoRef x
+     case a of
+       Nothing -> return ()
+       Just c ->
+         do writeProtoRef x Nothing
+            writeProtoRef (processInterruptRef pid) True
+            modifyProtoRef (processInterruptVersion pid) $ (+) 1
+            invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c ()
+            
+-- | Test whether the process with the specified identifier was interrupted.
+processInterrupted :: MonadComp m => ProcessId m -> Event m Bool
+processInterrupted pid =
+  Event $ \p ->
+  readProtoRef (processInterruptRef pid)
+
+-- | Passivate the process.
+passivateProcess :: MonadComp m => Process m ()
+passivateProcess =
+  Process $ \pid ->
+  Cont $ \c ->
+  Event $ \p ->
+  do let x = processReactCont pid
+     a <- readProtoRef x
+     case a of
+       Nothing -> writeProtoRef x $ Just c
+       Just _  -> error "Cannot passivate the process twice: passivateProcess"
+
+-- | Test whether the process with the specified identifier is passivated.
+processPassive :: MonadComp m => ProcessId m -> Event m Bool
+processPassive pid =
+  Event $ \p ->
+  do let x = processReactCont pid
+     a <- readProtoRef x
+     return $ isJust a
+
+-- | Reactivate a process with the specified identifier.
+reactivateProcess :: MonadComp m => ProcessId m -> Event m ()
+reactivateProcess pid =
+  Event $ \p ->
+  do let x = processReactCont pid
+     a <- readProtoRef x
+     case a of
+       Nothing -> 
+         return ()
+       Just c ->
+         do writeProtoRef x Nothing
+            invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c ()
+
+-- | Prepare the processes identifier for running.
+processIdPrepare :: MonadComp m => ProcessId m -> Event m ()
+processIdPrepare pid =
+  Event $ \p ->
+  do y <- readProtoRef (processStarted pid)
+     if y
+       then error $
+            "Another process with the specified identifier " ++
+            "has been started already: processIdPrepare"
+       else writeProtoRef (processStarted pid) True
+     let signal = processCancelling pid
+     invokeEvent p $
+       handleSignal_ signal $ \_ ->
+       do interruptProcess pid
+          reactivateProcess pid
+
+-- | Run immediately the process. A new 'ProcessId' identifier will be
+-- assigned to the process.
+--            
+-- To run the process at the specified time, you can use
+-- the 'enqueueProcess' function.
+runProcess :: MonadComp m => Process m () -> Event m ()
+runProcess p =
+  do pid <- liftSimulation newProcessId
+     runProcessUsingId pid p
+             
+-- | Run immediately the process with the specified identifier.
+-- It will be more efficient than as you would specify the process identifier
+-- with help of the 'processUsingId' combinator and then would call 'runProcess'.
+--            
+-- To run the process at the specified time, you can use
+-- the 'enqueueProcessUsingId' function.
+runProcessUsingId :: MonadComp m => ProcessId m -> Process m () -> Event m ()
+runProcessUsingId pid p =
+  do processIdPrepare pid
+     runCont m cont econt ccont (processCancelSource pid) False
+       where cont  = return
+             econt = throwEvent
+             ccont = return
+             m = invokeProcess pid p
+
+-- | Run the process in the start time immediately involving all pending
+-- 'CurrentEvents' in the computation too.
+runProcessInStartTime :: MonadComp m => Process m () -> Simulation m ()
+runProcessInStartTime = runEventInStartTime . runProcess
+
+-- | Run the process in the start time immediately using the specified identifier
+-- and involving all pending 'CurrentEvents' in the computation too.
+runProcessInStartTimeUsingId :: MonadComp m => ProcessId m -> Process m () -> Simulation m ()
+runProcessInStartTimeUsingId pid p =
+  runEventInStartTime $ runProcessUsingId pid p
+
+-- | Run the process in the final simulation time immediately involving all
+-- pending 'CurrentEvents' in the computation too.
+runProcessInStopTime :: MonadComp m => Process m () -> Simulation m ()
+runProcessInStopTime = runEventInStopTime . runProcess
+
+-- | Run the process in the final simulation time immediately using 
+-- the specified identifier and involving all pending 'CurrentEvents'
+-- in the computation too.
+runProcessInStopTimeUsingId :: MonadComp m => ProcessId m -> Process m () -> Simulation m ()
+runProcessInStopTimeUsingId pid p =
+  runEventInStopTime $ runProcessUsingId pid p
+
+-- | Enqueue the process that will be then started at the specified time
+-- from the event queue.
+enqueueProcess :: MonadComp m => Double -> Process m () -> Event m ()
+enqueueProcess t p =
+  enqueueEvent t $ runProcess p
+
+-- | Enqueue the process that will be then started at the specified time
+-- from the event queue.
+enqueueProcessUsingId :: MonadComp m => Double -> ProcessId m -> Process m () -> Event m ()
+enqueueProcessUsingId t pid p =
+  enqueueEvent t $ runProcessUsingId pid p
+
+-- | Return the current process identifier.
+processId :: MonadComp m => Process m (ProcessId m)
+processId = Process return
+
+-- | Create a new process identifier.
+newProcessId :: MonadComp m => Simulation m (ProcessId m)
+newProcessId =
+  Simulation $ \r ->
+  do let s = runSession r
+     m <- newSessionMarker s       
+     x <- newProtoRef s Nothing
+     y <- newProtoRef s False
+     c <- invokeSimulation r newContCancellationSource
+     i <- newProtoRef s False
+     z <- newProtoRef s Nothing
+     v <- newProtoRef s 0
+     return ProcessId { processStarted = y,
+                        processMarker  = m,
+                        processReactCont     = x, 
+                        processCancelSource  = c, 
+                        processInterruptRef  = i,
+                        processInterruptCont = z, 
+                        processInterruptVersion = v }
+
+-- | Cancel a process with the specified identifier, interrupting it if needed.
+cancelProcessWithId :: MonadComp m => ProcessId m -> Event m ()
+cancelProcessWithId pid = contCancellationInitiate (processCancelSource pid)
+
+-- | The process cancels itself.
+cancelProcess :: (MonadComp m, MonadIO m) => Process m a
+cancelProcess =
+  do pid <- processId
+     liftEvent $ cancelProcessWithId pid
+     throwProcess $ 
+       (error "The process must be cancelled already: cancelProcess." :: SomeException)
+
+-- | Test whether the process with the specified identifier was cancelled.
+processCancelled :: MonadComp m => ProcessId m -> Event m Bool
+processCancelled pid = contCancellationInitiated (processCancelSource pid)
+
+-- | Return a signal that notifies about cancelling the process with 
+-- the specified identifier.
+processCancelling :: ProcessId m -> Signal m ()
+processCancelling pid = contCancellationInitiating (processCancelSource pid)
+
+-- | Register a handler that will be invoked in case of cancelling the current process.
+whenCancellingProcess :: MonadComp m => Event m () -> Process m ()
+whenCancellingProcess h =
+  Process $ \pid ->
+  liftEvent $
+  handleSignal_ (processCancelling pid) $ \() -> h
+
+instance MonadComp m => Eq (ProcessId m) where
+
+  {-# INLINE (==) #-}
+  x == y = processMarker x == processMarker y
+
+instance MonadComp m => Monad (Process m) where
+
+  {-# INLINE return #-}
+  return a = Process $ \pid -> return a
+
+  {-# INLINE (>>=) #-}
+  (Process m) >>= k =
+    Process $ \pid -> 
+    do a <- m pid
+       let Process m' = k a
+       m' pid
+
+instance MonadCompTrans Process where
+
+  {-# INLINE liftComp #-}
+  liftComp = Process . const . liftComp
+
+instance MonadComp m => Functor (Process m) where
+  
+  {-# INLINE fmap #-}
+  fmap f (Process x) = Process $ \pid -> fmap f $ x pid
+
+instance MonadComp m => Applicative (Process m) where
+  
+  {-# INLINE pure #-}
+  pure = Process . const . pure
+  
+  {-# INLINE (<*>) #-}
+  (Process x) <*> (Process y) = Process $ \pid -> x pid <*> y pid
+
+instance (MonadComp m, MonadIO m) => MonadIO (Process m) where
+  
+  {-# INLINE liftIO #-}
+  liftIO = Process . const . liftIO
+
+instance ParameterLift Process where
+
+  {-# INLINE liftParameter #-}
+  liftParameter = Process . const . liftParameter
+
+instance SimulationLift Process where
+
+  {-# INLINE liftSimulation #-}
+  liftSimulation = Process . const . liftSimulation
+  
+instance DynamicsLift Process where
+
+  {-# INLINE liftDynamics #-}
+  liftDynamics = Process . const . liftDynamics
+  
+instance EventLift Process where
+
+  {-# INLINE liftEvent #-}
+  liftEvent = Process . const . liftEvent
+
+instance ProcessLift Process where
+
+  {-# INLINE liftProcess #-}
+  liftProcess = id
+
+-- | Exception handling within 'Process' computations.
+catchProcess :: (MonadComp m, Exception e) => Process m a -> (e -> Process m a) -> Process m a
+catchProcess (Process m) h =
+  Process $ \pid ->
+  catchCont (m pid) $ \e ->
+  let Process m' = h e in m' pid
+                           
+-- | A computation with finalization part.
+finallyProcess :: MonadComp m => Process m a -> Process m b -> Process m a
+finallyProcess (Process m) (Process m') =
+  Process $ \pid ->
+  finallyCont (m pid) (m' pid)
+
+-- | Throw the exception with the further exception handling.
+-- 
+-- By some reason, an exception raised with help of the standard 'throw' function
+-- is not handled properly within 'Process' computation, altough it will be still handled 
+-- if it will be wrapped in the 'IO' monad. Therefore, you should use specialised
+-- functions like the stated one that use the 'throw' function but within the 'IO' computation,
+-- which allows already handling the exception.
+throwProcess :: (MonadComp m, Exception e) => e -> Process m a
+throwProcess = liftIO . throw
+
+-- | Execute the specified computations in parallel within
+-- the current computation and return their results. The cancellation
+-- of any of the nested computations affects the current computation.
+-- The exception raised in any of the nested computations is propagated
+-- to the current computation as well.
+--
+-- Here word @parallel@ literally means that the computations are
+-- actually executed on a single operating system thread but
+-- they are processed simultaneously by the event queue.
+--
+-- New 'ProcessId' identifiers will be assigned to the started processes.
+processParallel :: MonadComp m => [Process m a] -> Process m [a]
+processParallel xs =
+  liftSimulation (processParallelCreateIds xs) >>= processParallelUsingIds 
+
+-- | Like 'processParallel' but allows specifying the process identifiers.
+-- It will be more efficient than as you would specify the process identifiers
+-- with help of the 'processUsingId' combinator and then would call 'processParallel'.
+processParallelUsingIds :: MonadComp m => [(ProcessId m, Process m a)] -> Process m [a]
+processParallelUsingIds xs =
+  Process $ \pid ->
+  do liftEvent $ processParallelPrepare xs
+     contParallel $
+       flip map xs $ \(pid, m) ->
+       (invokeProcess pid m, processCancelSource pid)
+
+-- | Like 'processParallel' but ignores the result.
+processParallel_ :: MonadComp m => [Process m a] -> Process m ()
+processParallel_ xs =
+  liftSimulation (processParallelCreateIds xs) >>= processParallelUsingIds_ 
+
+-- | Like 'processParallelUsingIds' but ignores the result.
+processParallelUsingIds_ :: MonadComp m => [(ProcessId m, Process m a)] -> Process m ()
+processParallelUsingIds_ xs =
+  Process $ \pid ->
+  do liftEvent $ processParallelPrepare xs
+     contParallel_ $
+       flip map xs $ \(pid, m) ->
+       (invokeProcess pid m, processCancelSource pid)
+
+-- | Create the new process identifiers.
+processParallelCreateIds :: MonadComp m => [Process m a] -> Simulation m [(ProcessId m, Process m a)]
+processParallelCreateIds xs =
+  do pids <- liftSimulation $ forM xs $ const newProcessId
+     return $ zip pids xs
+
+-- | Prepare the processes for parallel execution.
+processParallelPrepare :: MonadComp m => [(ProcessId m, Process m a)] -> Event m ()
+processParallelPrepare xs =
+  Event $ \p ->
+  forM_ xs $ invokeEvent p . processIdPrepare . fst
+
+-- | Allow calling the process with the specified identifier.
+-- It creates a nested process when canceling any of two, or raising an
+-- @IO@ exception in any of the both, affects the 'Process' computation.
+--
+-- At the same time, the interruption has no such effect as it requires
+-- explicit specifying the 'ProcessId' identifier of the nested process itself,
+-- that is the nested process cannot be interrupted using only the parent
+-- process identifier.
+processUsingId :: MonadComp m => ProcessId m -> Process m a -> Process m a
+processUsingId pid x =
+  Process $ \pid' ->
+  do liftEvent $ processIdPrepare pid
+     rerunCont (invokeProcess pid x) (processCancelSource pid)
+
+-- | Spawn the child process specifying how the child and parent processes
+-- should be cancelled in case of need.
+spawnProcess :: MonadComp m => ContCancellation -> Process m () -> Process m ()
+spawnProcess cancellation x =
+  do pid <- liftSimulation newProcessId
+     spawnProcessUsingId cancellation pid x
+
+-- | Spawn the child process specifying how the child and parent processes
+-- should be cancelled in case of need.
+spawnProcessUsingId :: MonadComp m => ContCancellation -> ProcessId m -> Process m () -> Process m ()
+spawnProcessUsingId cancellation pid x =
+  Process $ \pid' ->
+  do liftEvent $ processIdPrepare pid
+     spawnCont cancellation (invokeProcess pid x) (processCancelSource pid)
+
+-- | Await the signal.
+processAwait :: MonadComp m => Signal m a -> Process m a
+processAwait signal =
+  Process $ \pid -> contAwait signal
+
+-- | The result of memoization.
+data MemoResult a = MemoComputed a
+                  | MemoError IOException
+                  | MemoCancelled
+
+-- | Memoize the process so that it would always return the same value
+-- within the simulation run.
+memoProcess :: MonadComp m => Process m a -> Simulation m (Process m a)
+memoProcess x =
+  Simulation $ \r ->
+  do let s = runSession r
+     started  <- newProtoRef s False
+     computed <- invokeSimulation r newSignalSource
+     value    <- newProtoRef s Nothing
+     let result =
+           do Just x <- liftComp $ readProtoRef value
+              case x of
+                MemoComputed a -> return a
+                MemoError e    -> throwProcess e
+                MemoCancelled  -> cancelProcess
+     return $
+       do v <- liftComp $ readProtoRef value
+          case v of
+            Just _ -> result
+            Nothing ->
+              do f <- liftComp $ readProtoRef started
+                 case f of
+                   True ->
+                     do processAwait $ publishSignal computed
+                        result
+                   False ->
+                     do liftComp $ writeProtoRef started True
+                        r <- liftComp $ newProtoRef s MemoCancelled
+                        finallyProcess
+                          (catchProcess
+                           (do a <- x    -- compute only once!
+                               liftComp $ writeProtoRef r (MemoComputed a))
+                           (\e ->
+                             liftComp $ writeProtoRef r (MemoError e)))
+                          (liftEvent $
+                           do liftComp $
+                                do x <- readProtoRef r
+                                   writeProtoRef value (Just x)
+                              triggerSignal computed ())
+                        result
+
+-- | Zip two parallel processes waiting for the both.
+zipProcessParallel :: MonadComp m => Process m a -> Process m b -> Process m (a, b)
+zipProcessParallel x y =
+  do [Left a, Right b] <- processParallel [fmap Left x, fmap Right y]
+     return (a, b)
+
+-- | Zip three parallel processes waiting for their results.
+zip3ProcessParallel :: MonadComp m => Process m a -> Process m b -> Process m c -> Process m (a, b, c)
+zip3ProcessParallel x y z =
+  do [Left a,
+      Right (Left b),
+      Right (Right c)] <-
+       processParallel [fmap Left x,
+                        fmap (Right . Left) y,
+                        fmap (Right . Right) z]
+     return (a, b, c)
+
+-- | Unzip the process using memoization so that the both returned
+-- processes could be applied independently, although they will refer
+-- to the same pair of values.
+unzipProcess :: (MonadComp m, MonadIO m) => Process m (a, b) -> Simulation m (Process m a, Process m b)
+unzipProcess xy =
+  do xy' <- memoProcess xy
+     return (fmap fst xy', fmap snd xy')
+
+-- | Try to run the child process within the specified timeout.
+-- If the process will finish successfully within this time interval then
+-- the result wrapped in 'Just' will be returned; otherwise, the child process
+-- will be cancelled and 'Nothing' will be returned.
+--
+-- If an exception is raised in the child process then it is propagated to
+-- the parent computation as well.
+--
+-- A cancellation of the child process doesn't lead to cancelling the parent process.
+-- Then 'Nothing' is returned within the computation.
+timeoutProcess :: (MonadComp m, MonadIO m) => Double -> Process m a -> Process m (Maybe a)
+timeoutProcess timeout p =
+  do pid <- liftSimulation newProcessId
+     timeoutProcessUsingId timeout pid p
+
+-- | Try to run the child process with the given identifier within the specified timeout.
+-- If the process will finish successfully within this time interval then
+-- the result wrapped in 'Just' will be returned; otherwise, the child process
+-- will be cancelled and 'Nothing' will be returned.
+--
+-- If an exception is raised in the child process then it is propagated to
+-- the parent computation as well.
+--
+-- A cancellation of the child process doesn't lead to cancelling the parent process.
+-- Then 'Nothing' is returned within the computation.
+timeoutProcessUsingId :: (MonadComp m, MonadIO m) => Double -> ProcessId m -> Process m a -> Process m (Maybe a)
+timeoutProcessUsingId timeout pid p =
+  do s <- liftSimulation newSignalSource
+     timeoutPid <- liftSimulation newProcessId
+     spawnProcessUsingId CancelChildAfterParent timeoutPid $
+       finallyProcess
+       (holdProcess timeout)
+       (liftEvent $
+        cancelProcessWithId pid)
+     spawnProcessUsingId CancelChildAfterParent pid $
+       do sn <- liftParameter simulationSession
+          r <- liftComp $ newProtoRef sn Nothing
+          finallyProcess
+            (catchProcess
+             (do a <- p
+                 liftComp $ writeProtoRef r $ Just (Right a))
+             (\e ->
+               liftComp $ writeProtoRef r $ Just (Left e)))
+            (liftEvent $
+             do x <- liftComp $ readProtoRef r
+                triggerSignal s x)
+     x <- processAwait $ publishSignal s
+     case x of
+       Nothing -> return Nothing
+       Just (Right a) -> return (Just a)
+       Just (Left (SomeException e)) -> throwProcess e
+
+-- | Yield to allow other 'Process' and 'Event' computations to run
+-- at the current simulation time point.
+processYield :: MonadComp m => Process m ()
+processYield =
+  Process $ \pid ->
+  Cont $ \c ->
+  Event $ \p ->
+  invokeEvent p $
+  enqueueEvent (pointTime p) $
+  resumeCont c ()
+
+-- | A computation that never computes the result. It behaves like a black hole for
+-- the discontinuous process, although such a process can still be canceled outside
+-- (see 'cancelProcessWithId'), but then only its finalization parts (see 'finallyProcess')
+-- will be called, usually, to release the resources acquired before.
+neverProcess :: MonadComp m => Process m a
+neverProcess =
+  Process $ \pid ->
+  Cont $ \c ->
+  let signal = processCancelling pid
+  in handleSignal_ signal $ \_ ->
+     resumeCont c $ error "It must never be computed: neverProcess"
+ Simulation/Aivika/Trans/Internal/Signal.hs view
@@ -0,0 +1,396 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Signal
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the signal which we can subscribe handlers to. 
+-- These handlers can be disposed. The signal is triggered in the 
+-- current time point actuating the corresponded computations from 
+-- the handlers. 
+--
+
+module Simulation.Aivika.Trans.Internal.Signal
+       (-- * Handling and Triggering Signal
+        Signal(..),
+        handleSignal_,
+        SignalSource,
+        newSignalSource,
+        publishSignal,
+        triggerSignal,
+        -- * Useful Combinators
+        mapSignal,
+        mapSignalM,
+        apSignal,
+        filterSignal,
+        filterSignalM,
+        emptySignal,
+        merge2Signals,
+        merge3Signals,
+        merge4Signals,
+        merge5Signals,
+        -- * Signal Arriving
+        arrivalSignal,
+        -- * Creating Signal in Time Points
+        newSignalInTimes,
+        newSignalInIntegTimes,
+        newSignalInStartTime,
+        newSignalInStopTime,
+        -- * Signal History
+        SignalHistory,
+        signalHistorySignal,
+        newSignalHistory,
+        newSignalHistoryStartingWith,
+        readSignalHistory,
+        -- * Signalable Computations
+        Signalable(..),
+        signalableChanged,
+        emptySignalable,
+        appendSignalable) where
+
+import Data.Monoid
+import Data.List
+import Data.Array
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import qualified Simulation.Aivika.Trans.Vector as V
+import qualified Simulation.Aivika.Trans.Vector.Unboxed as UV
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | The signal source that can publish its signal.
+data SignalSource m a =
+  SignalSource { publishSignal :: Signal m a,
+                                  -- ^ Publish the signal.
+                 triggerSignal :: a -> Event m ()
+                                  -- ^ Trigger the signal actuating 
+                                  -- all its handlers at the current 
+                                  -- simulation time point.
+               }
+  
+-- | The signal that can have disposable handlers.  
+data Signal m a =
+  Signal { handleSignal :: (a -> Event m ()) -> Event m (DisposableEvent m)
+           -- ^ Subscribe the handler to the specified 
+           -- signal and return a nested computation
+           -- within a disposable object that, being applied,
+           -- unsubscribes the handler from this signal.
+         }
+
+-- | The queue of signal handlers.
+data SignalHandlerQueue m a =
+  SignalHandlerQueue { queueList :: ProtoRef m [SignalHandler m a] }
+  
+-- | It contains the information about the disposable queue handler.
+data SignalHandler m a =
+  SignalHandler { handlerComp   :: a -> Event m (),
+                  handlerMarker :: SessionMarker m }
+
+instance SessionMonad m => Eq (SignalHandler m a) where
+
+  {-# INLINE (==) #-}
+  x == y = (handlerMarker x) == (handlerMarker y)
+
+-- | Subscribe the handler to the specified signal forever.
+-- To subscribe the disposable handlers, use function 'handleSignal'.
+handleSignal_ :: MonadComp m => Signal m a -> (a -> Event m ()) -> Event m ()
+{-# INLINE handleSignal_ #-}
+handleSignal_ signal h = 
+  do x <- handleSignal signal h
+     return ()
+     
+-- | Create a new signal source.
+newSignalSource :: MonadComp m => Simulation m (SignalSource m a)
+newSignalSource =
+  Simulation $ \r ->
+  do let s = runSession r
+     list <- newProtoRef s []
+     let queue  = SignalHandlerQueue { queueList = list }
+         signal = Signal { handleSignal = handle }
+         source = SignalSource { publishSignal = signal, 
+                                 triggerSignal = trigger }
+         handle h =
+           Event $ \p ->
+           do m <- newSessionMarker s
+              x <- enqueueSignalHandler queue h m
+              return $
+                DisposableEvent $
+                Event $ \p -> dequeueSignalHandler queue x
+         trigger a =
+           Event $ \p -> triggerSignalHandlers queue a p
+     return source
+
+-- | Trigger all next signal handlers.
+triggerSignalHandlers :: MonadComp m => SignalHandlerQueue m a -> a -> Point m -> m ()
+triggerSignalHandlers q a p =
+  do hs <- readProtoRef (queueList q)
+     forM_ hs $ \h ->
+       invokeEvent p $ handlerComp h a
+            
+-- | Enqueue the handler and return its representative in the queue.            
+enqueueSignalHandler :: MonadComp m => SignalHandlerQueue m a -> (a -> Event m ()) -> SessionMarker m -> m (SignalHandler m a)
+enqueueSignalHandler q h m = 
+  do let handler = SignalHandler { handlerComp   = h,
+                                   handlerMarker = m }
+     modifyProtoRef (queueList q) (handler :)
+     return handler
+
+-- | Dequeue the handler representative.
+dequeueSignalHandler :: MonadComp m => SignalHandlerQueue m a -> SignalHandler m a -> m ()
+dequeueSignalHandler q h = 
+  modifyProtoRef (queueList q) (delete h)
+
+instance MonadComp m => Functor (Signal m) where
+
+  {-# INLINE fmap #-}
+  fmap = mapSignal
+  
+instance MonadComp m => Monoid (Signal m a) where 
+
+  {-# INLINE mempty #-}
+  mempty = emptySignal
+
+  {-# INLINE mappend #-}
+  mappend = merge2Signals
+
+  {-# INLINE mconcat #-}
+  mconcat [] = emptySignal
+  mconcat [x1] = x1
+  mconcat [x1, x2] = merge2Signals x1 x2
+  mconcat [x1, x2, x3] = merge3Signals x1 x2 x3
+  mconcat [x1, x2, x3, x4] = merge4Signals x1 x2 x3 x4
+  mconcat [x1, x2, x3, x4, x5] = merge5Signals x1 x2 x3 x4 x5
+  mconcat (x1 : x2 : x3 : x4 : x5 : xs) = 
+    mconcat $ merge5Signals x1 x2 x3 x4 x5 : xs
+  
+-- | Map the signal according the specified function.
+mapSignal :: MonadComp m => (a -> b) -> Signal m a -> Signal m b
+mapSignal f m =
+  Signal { handleSignal = \h -> 
+            handleSignal m $ h . f }
+
+-- | Filter only those signal values that satisfy to 
+-- the specified predicate.
+filterSignal :: MonadComp m => (a -> Bool) -> Signal m a -> Signal m a
+filterSignal p m =
+  Signal { handleSignal = \h ->
+            handleSignal m $ \a ->
+            when (p a) $ h a }
+  
+-- | Filter only those signal values that satisfy to 
+-- the specified predicate.
+filterSignalM :: MonadComp m => (a -> Event m Bool) -> Signal m a -> Signal m a
+filterSignalM p m =
+  Signal { handleSignal = \h ->
+            handleSignal m $ \a ->
+            do x <- p a
+               when x $ h a }
+  
+-- | Merge two signals.
+merge2Signals :: MonadComp m => Signal m a -> Signal m a -> Signal m a
+merge2Signals m1 m2 =
+  Signal { handleSignal = \h ->
+            do x1 <- handleSignal m1 h
+               x2 <- handleSignal m2 h
+               return $ x1 <> x2 }
+
+-- | Merge three signals.
+merge3Signals :: MonadComp m => Signal m a -> Signal m a -> Signal m a -> Signal m a
+merge3Signals m1 m2 m3 =
+  Signal { handleSignal = \h ->
+            do x1 <- handleSignal m1 h
+               x2 <- handleSignal m2 h
+               x3 <- handleSignal m3 h
+               return $ x1 <> x2 <> x3 }
+
+-- | Merge four signals.
+merge4Signals :: MonadComp m
+                 => Signal m a -> Signal m a -> Signal m a
+                 -> Signal m a -> Signal m a
+merge4Signals m1 m2 m3 m4 =
+  Signal { handleSignal = \h ->
+            do x1 <- handleSignal m1 h
+               x2 <- handleSignal m2 h
+               x3 <- handleSignal m3 h
+               x4 <- handleSignal m4 h
+               return $ x1 <> x2 <> x3 <> x4 }
+           
+-- | Merge five signals.
+merge5Signals :: MonadComp m
+                 => Signal m a -> Signal m a -> Signal m a
+                 -> Signal m a -> Signal m a -> Signal m a
+merge5Signals m1 m2 m3 m4 m5 =
+  Signal { handleSignal = \h ->
+            do x1 <- handleSignal m1 h
+               x2 <- handleSignal m2 h
+               x3 <- handleSignal m3 h
+               x4 <- handleSignal m4 h
+               x5 <- handleSignal m5 h
+               return $ x1 <> x2 <> x3 <> x4 <> x5 }
+
+-- | Compose the signal.
+mapSignalM :: MonadComp m => (a -> Event m b) -> Signal m a -> Signal m b
+mapSignalM f m =
+  Signal { handleSignal = \h ->
+            handleSignal m (f >=> h) }
+  
+-- | Transform the signal.
+apSignal :: MonadComp m => Event m (a -> b) -> Signal m a -> Signal m b
+apSignal f m =
+  Signal { handleSignal = \h ->
+            handleSignal m $ \a -> do { x <- f; h (x a) } }
+
+-- | An empty signal which is never triggered.
+emptySignal :: MonadComp m => Signal m a
+emptySignal =
+  Signal { handleSignal = \h -> return mempty }
+                                    
+-- | Represents the history of the signal values.
+data SignalHistory m a =
+  SignalHistory { signalHistorySignal :: Signal m a,  
+                  -- ^ The signal for which the history is created.
+                  signalHistoryTimes  :: UV.Vector m Double,
+                  signalHistoryValues :: V.Vector m a }
+
+-- | Create a history of the signal values.
+newSignalHistory :: MonadComp m => Signal m a -> Event m (SignalHistory m a)
+newSignalHistory =
+  newSignalHistoryStartingWith Nothing
+
+-- | Create a history of the signal values starting with
+-- the optional initial value.
+newSignalHistoryStartingWith :: MonadComp m => Maybe a -> Signal m a -> Event m (SignalHistory m a)
+newSignalHistoryStartingWith init signal =
+  Event $ \p ->
+  do let s = runSession $ pointRun p
+     ts <- UV.newVector s
+     xs <- V.newVector s
+     case init of
+       Nothing -> return ()
+       Just a ->
+         do UV.appendVector ts (pointTime p)
+            V.appendVector xs a
+     invokeEvent p $
+       handleSignal_ signal $ \a ->
+       Event $ \p ->
+       do UV.appendVector ts (pointTime p)
+          V.appendVector xs a
+     return SignalHistory { signalHistorySignal = signal,
+                            signalHistoryTimes  = ts,
+                            signalHistoryValues = xs }
+       
+-- | Read the history of signal values.
+readSignalHistory :: MonadComp m => SignalHistory m a -> Event m (Array Int Double, Array Int a)
+readSignalHistory history =
+  Event $ \p ->
+  do xs <- UV.freezeVector (signalHistoryTimes history)
+     ys <- V.freezeVector (signalHistoryValues history)
+     return (xs, ys)     
+     
+-- | Trigger the signal with the current time.
+triggerSignalWithCurrentTime :: MonadComp m => SignalSource m Double -> Event m ()
+triggerSignalWithCurrentTime s =
+  Event $ \p -> invokeEvent p $ triggerSignal s (pointTime p)
+
+-- | Return a signal that is triggered in the specified time points.
+newSignalInTimes :: MonadComp m => [Double] -> Event m (Signal m Double)
+newSignalInTimes xs =
+  do s <- liftSimulation newSignalSource
+     enqueueEventWithTimes xs $ triggerSignalWithCurrentTime s
+     return $ publishSignal s
+       
+-- | Return a signal that is triggered in the integration time points.
+-- It should be called with help of 'runEventInStartTime'.
+newSignalInIntegTimes :: MonadComp m => Event m (Signal m Double)
+newSignalInIntegTimes =
+  do s <- liftSimulation newSignalSource
+     enqueueEventWithIntegTimes $ triggerSignalWithCurrentTime s
+     return $ publishSignal s
+     
+-- | Return a signal that is triggered in the start time.
+-- It should be called with help of 'runEventInStartTime'.
+newSignalInStartTime :: MonadComp m => Event m (Signal m Double)
+newSignalInStartTime =
+  do s <- liftSimulation newSignalSource
+     t <- liftParameter starttime
+     enqueueEvent t $ triggerSignalWithCurrentTime s
+     return $ publishSignal s
+
+-- | Return a signal that is triggered in the final time.
+newSignalInStopTime :: MonadComp m => Event m (Signal m Double)
+newSignalInStopTime =
+  do s <- liftSimulation newSignalSource
+     t <- liftParameter stoptime
+     enqueueEvent t $ triggerSignalWithCurrentTime s
+     return $ publishSignal s
+
+-- | Describes a computation that also signals when changing its value.
+data Signalable m a =
+  Signalable { readSignalable :: Event m a,
+               -- ^ Return a computation of the value.
+               signalableChanged_ :: Signal m ()
+               -- ^ Return a signal notifying that the value has changed
+               -- but without providing the information about the changed value.
+             }
+
+-- | Return a signal notifying that the value has changed.
+signalableChanged :: MonadComp m => Signalable m a -> Signal m a
+signalableChanged x = mapSignalM (const $ readSignalable x) $ signalableChanged_ x
+
+instance Functor m => Functor (Signalable m) where
+
+  {-# INLINE fmap #-}
+  fmap f x = x { readSignalable = fmap f (readSignalable x) }
+
+instance (MonadComp m, Monoid a) => Monoid (Signalable m a) where
+
+  {-# INLINE mempty #-}
+  mempty = emptySignalable
+
+  {-# INLINE mappend #-}
+  mappend = appendSignalable
+
+-- | Return an identity.
+emptySignalable :: (MonadComp m, Monoid a) => Signalable m a
+emptySignalable =
+  Signalable { readSignalable = return mempty,
+               signalableChanged_ = mempty }
+
+-- | An associative operation.
+appendSignalable :: (MonadComp m, Monoid a) => Signalable m a -> Signalable m a -> Signalable m a
+appendSignalable m1 m2 =
+  Signalable { readSignalable = liftM2 (<>) (readSignalable m1) (readSignalable m2),
+               signalableChanged_ = (signalableChanged_ m1) <> (signalableChanged_ m2) }
+
+-- | Transform a signal so that the resulting signal returns a sequence of arrivals
+-- saving the information about the time points at which the original signal was received.
+arrivalSignal :: MonadComp m => Signal m a -> Signal m (Arrival a)
+arrivalSignal m = 
+  Signal { handleSignal = \h ->
+             Event $ \p ->
+             do let s = runSession $ pointRun p
+                r <- newProtoRef s Nothing
+                invokeEvent p $
+                  handleSignal m $ \a ->
+                  Event $ \p ->
+                  do t0 <- readProtoRef r
+                     let t = pointTime p
+                     writeProtoRef r (Just t)
+                     invokeEvent p $
+                       h Arrival { arrivalValue = a,
+                                   arrivalTime  = t,
+                                   arrivalDelay =
+                                     case t0 of
+                                       Nothing -> Nothing
+                                       Just t0 -> Just (t - t0) } }
+ Simulation/Aivika/Trans/Internal/Simulation.hs view
@@ -0,0 +1,167 @@+
+{-# LANGUAGE RecursiveDo, TypeSynonymInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Simulation
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'Simulation' monad transformer that represents a computation
+-- within the simulation run.
+-- 
+module Simulation.Aivika.Trans.Internal.Simulation
+       (-- * Simulation
+        SimulationLift(..),
+        runSimulation,
+        runSimulations,
+        -- * Error Handling
+        catchSimulation,
+        finallySimulation,
+        throwSimulation,
+        -- * Memoization
+        memoSimulation) where
+
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Applicative
+
+import Simulation.Aivika.Trans.Exception
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+
+instance Monad m => Monad (Simulation m) where
+
+  {-# INLINE return #-}
+  return a = Simulation $ \r -> return a
+
+  {-# INLINE (>>=) #-}
+  (Simulation m) >>= k =
+    Simulation $ \r -> 
+    do a <- m r
+       let Simulation m' = k a
+       m' r
+
+-- | Run the simulation using the specified specs.
+runSimulation :: MonadComp m => Simulation m a -> Specs m -> m a
+runSimulation (Simulation m) sc =
+  do s <- newSession
+     q <- newEventQueue s sc
+     g <- newGenerator s $ spcGeneratorType sc
+     m Run { runSpecs = sc,
+             runSession = s,
+             runIndex = 1,
+             runCount = 1,
+             runEventQueue = q,
+             runGenerator = g }
+
+-- | Run the given number of simulations using the specified specs, 
+--   where each simulation is distinguished by its index 'simulationIndex'.
+runSimulations :: MonadComp m => Simulation m a -> Specs m -> Int -> [m a]
+runSimulations (Simulation m) sc runs = map f [1 .. runs]
+  where f i = do s <- newSession
+                 q <- newEventQueue s sc
+                 g <- newGenerator s $ spcGeneratorType sc
+                 m Run { runSpecs = sc,
+                         runSession = s,
+                         runIndex = i,
+                         runCount = runs,
+                         runEventQueue = q,
+                         runGenerator = g }
+
+instance Functor m => Functor (Simulation m) where
+  
+  {-# INLINE fmap #-}
+  fmap f (Simulation x) = Simulation $ \r -> fmap f $ x r
+
+instance Applicative m => Applicative (Simulation m) where
+  
+  {-# INLINE pure #-}
+  pure = Simulation . const . pure
+  
+  {-# INLINE (<*>) #-}
+  (Simulation x) <*> (Simulation y) = Simulation $ \r -> x r <*> y r
+
+liftMS :: Monad m => (a -> b) -> Simulation m a -> Simulation m b
+{-# INLINE liftMS #-}
+liftMS f (Simulation x) =
+  Simulation $ \r -> do { a <- x r; return $ f a }
+
+instance MonadTrans Simulation where
+
+  {-# INLINE lift #-}
+  lift = Simulation . const
+
+instance MonadCompTrans Simulation where
+
+  {-# INLINE liftComp #-}
+  liftComp = Simulation . const
+
+instance MonadIO m => MonadIO (Simulation m) where
+  
+  {-# INLINE liftIO #-}
+  liftIO = Simulation . const . liftIO
+
+-- | A type class to lift the simulation computations into other computations.
+class SimulationLift t where
+  
+  -- | Lift the specified 'Simulation' computation into another computation.
+  liftSimulation :: MonadComp m => Simulation m a -> t m a
+
+instance SimulationLift Simulation where
+  
+  {-# INLINE liftSimulation #-}
+  liftSimulation = id
+
+instance ParameterLift Simulation where
+
+  {-# INLINE liftParameter #-}
+  liftParameter (Parameter x) = Simulation x
+    
+-- | Exception handling within 'Simulation' computations.
+catchSimulation :: (MonadComp m, Exception e) => Simulation m a -> (e -> Simulation m a) -> Simulation m a
+catchSimulation (Simulation m) h =
+  Simulation $ \r -> 
+  catchComp (m r) $ \e ->
+  let Simulation m' = h e in m' r
+                           
+-- | A computation with finalization part like the 'finally' function.
+finallySimulation :: MonadComp m => Simulation m a -> Simulation m b -> Simulation m a
+finallySimulation (Simulation m) (Simulation m') =
+  Simulation $ \r ->
+  finallyComp (m r) (m' r)
+
+-- | Like the standard 'throw' function.
+throwSimulation :: (MonadComp m, Exception e) => e -> Simulation m a
+throwSimulation = throw
+
+instance MonadFix m => MonadFix (Simulation m) where
+
+  {-# INLINE mfix #-}
+  mfix f = 
+    Simulation $ \r ->
+    do { rec { a <- invokeSimulation r (f a) }; return a }
+
+-- | Memoize the 'Simulation' computation, always returning the same value
+-- within a simulation run.
+memoSimulation :: MonadComp m => Simulation m a -> Simulation m (Simulation m a)
+memoSimulation m =
+  Simulation $ \r ->
+  do let s = runSession r
+     ref <- newProtoRef s Nothing
+     return $ Simulation $ \r ->
+       do x <- readProtoRef ref
+          case x of
+            Just v -> return v
+            Nothing ->
+              do v <- invokeSimulation r m
+                 writeProtoRef ref (Just v)
+                 return v
+ Simulation/Aivika/Trans/Internal/Specs.hs view
@@ -0,0 +1,307 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Internal.Specs
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines the simulation specs and related stuff.
+module Simulation.Aivika.Trans.Internal.Specs
+       (Specs(..),
+        Method(..),
+        Run(..),
+        Point(..),
+        Parameter(..),
+        Simulation(..),
+        Dynamics(..),
+        Event(..),
+        EventProcessing(..),
+        EventQueueing(..),
+        invokeParameter,
+        invokeSimulation,
+        invokeDynamics,
+        invokeEvent,
+        basicTime,
+        integIterationBnds,
+        integIterationHiBnd,
+        integIterationLoBnd,
+        integPhaseBnds,
+        integPhaseHiBnd,
+        integPhaseLoBnd,
+        integTimes,
+        integPoints,
+        integStartPoint,
+        integStopPoint,
+        pointAt) where
+
+import Data.IORef
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.Generator
+
+-- | It defines the simulation specs.
+data Specs m = Specs { spcStartTime :: Double,    -- ^ the start time
+                       spcStopTime :: Double,     -- ^ the stop time
+                       spcDT :: Double,           -- ^ the integration time step
+                       spcMethod :: Method,       -- ^ the integration method
+                       spcGeneratorType :: GeneratorType m
+                       -- ^ the type of the random number generator
+                     }
+
+-- | It defines the integration method.
+data Method = Euler          -- ^ Euler's method
+            | RungeKutta2    -- ^ the 2nd order Runge-Kutta method
+            | RungeKutta4    -- ^ the 4th order Runge-Kutta method
+            deriving (Eq, Ord, Show)
+
+-- | It indentifies the simulation run.
+data Run m = Run { runSpecs :: Specs m,            -- ^ the simulation specs
+                   runSession :: Session m,        -- ^ the simulation session
+                   runIndex :: Int,       -- ^ the current simulation run index
+                   runCount :: Int,       -- ^ the total number of runs in this experiment
+                   runEventQueue :: EventQueue m,  -- ^ the event queue
+                   runGenerator :: Generator m     -- ^ the random number generator
+                 }
+
+-- | It defines the simulation point appended with the additional information.
+data Point m = Point { pointSpecs :: Specs m,      -- ^ the simulation specs
+                       pointRun :: Run m,          -- ^ the simulation run
+                       pointTime :: Double,        -- ^ the current time
+                       pointIteration :: Int,      -- ^ the current iteration
+                       pointPhase :: Int           -- ^ the current phase
+                     }
+
+-- | The 'Parameter' monad that allows specifying the model parameters.
+-- For example, they can be used when running the Monte-Carlo simulation.
+-- 
+-- In general, this monad is very useful for representing a computation which is external
+-- relative to the model itself.
+newtype Parameter m a = Parameter (Run m -> m a)
+
+-- | A value in the 'Simulation' monad represents a computation
+-- within the simulation run.
+newtype Simulation m a = Simulation (Run m -> m a)
+
+-- | A value in the 'Dynamics' monad represents a polymorphic time varying function
+-- defined in the whole spectrum of time values as a single entity. It is ideal for
+-- numerical approximating integrals.
+newtype Dynamics m a = Dynamics (Point m -> m a)
+
+-- | A value in the 'Event' monad transformer represents a polymorphic time varying
+-- function which is strongly synchronized with the event queue.
+newtype Event m a = Event (Point m -> m a)
+
+-- | Invoke the 'Parameter' computation.
+invokeParameter :: Run m -> Parameter m a -> m a
+{-# INLINE invokeParameter #-}
+invokeParameter r (Parameter m) = m r
+
+-- | Invoke the 'Simulation' computation.
+invokeSimulation :: Run m -> Simulation m a -> m a
+{-# INLINE invokeSimulation #-}
+invokeSimulation r (Simulation m) = m r
+
+-- | Invoke the 'Dynamics' computation.
+invokeDynamics :: Point m -> Dynamics m a -> m a
+{-# INLINE invokeDynamics #-}
+invokeDynamics p (Dynamics m) = m p
+
+-- | Invoke the 'Event' computation.
+invokeEvent :: Point m -> Event m a -> m a
+{-# INLINE invokeEvent #-}
+invokeEvent p (Event m) = m p
+
+-- | Defines how the events are processed.
+data EventProcessing = CurrentEvents
+                       -- ^ either process all earlier and then current events,
+                       -- or raise an error if the current simulation time is less
+                       -- than the actual time of the event queue (safe within
+                       -- the 'Event' computation as this is protected by the type system)
+                     | EarlierEvents
+                       -- ^ either process all earlier events not affecting
+                       -- the events at the current simulation time,
+                       -- or raise an error if the current simulation time is less
+                       -- than the actual time of the event queue (safe within
+                       -- the 'Event' computation as this is protected by the type system)
+                     | CurrentEventsOrFromPast
+                       -- ^ either process all earlier and then current events,
+                       -- or do nothing if the current simulation time is less
+                       -- than the actual time of the event queue
+                       -- (do not use unless the documentation states the opposite)
+                     | EarlierEventsOrFromPast
+                       -- ^ either process all earlier events,
+                       -- or do nothing if the current simulation time is less
+                       -- than the actual time of the event queue
+                       -- (do not use unless the documentation states the opposite)
+                     deriving (Eq, Ord, Show)
+
+-- | A type class of monads that allow enqueueing the events.
+class EventQueueing m where
+
+  -- | It represents the event queue.
+  data EventQueue m :: *
+
+  -- | Create a new event queue by the specified specs with simulation session.
+  newEventQueue :: Session m -> Specs m -> m (EventQueue m)
+
+  -- | Enqueue the event which must be actuated at the specified time.
+  --
+  -- The events are processed when calling the 'runEvent' function. So,
+  -- if you want to insist on their immediate execution then you can apply
+  -- something like
+  --
+  -- @
+  --   liftDynamics $ runEvent IncludingCurrentEvents $ return ()
+  -- @
+  --
+  -- although this is generally not good idea.  
+  enqueueEvent :: Double -> Event m () -> Event m ()
+
+  -- | Run the 'EventT' computation in the current simulation time
+  -- within the 'DynamicsT' computation involving all pending
+  -- 'CurrentEvents' in the processing too.
+  runEvent :: Event m a -> Dynamics m a
+  {-# INLINE runEvent #-}
+  runEvent = runEventWith CurrentEvents
+
+  -- | Run the 'EventT' computation in the current simulation time
+  -- within the 'DynamicsT' computation specifying what pending events 
+  -- should be involved in the processing.
+  runEventWith :: EventProcessing -> Event m a -> Dynamics m a
+
+  -- | Return the number of pending events that should
+  -- be yet actuated.
+  eventQueueCount :: Event m Int
+
+-- | Returns the integration iterations starting from zero.
+integIterations :: Specs m -> [Int]
+integIterations sc = [i1 .. i2] where
+  i1 = integIterationLoBnd sc
+  i2 = integIterationHiBnd sc
+
+-- | Returns the first and last integration iterations.
+integIterationBnds :: Specs m -> (Int, Int)
+integIterationBnds sc = (i1, i2) where
+  i1 = integIterationLoBnd sc
+  i2 = integIterationHiBnd sc
+
+-- | Returns the first integration iteration, i.e. zero.
+integIterationLoBnd :: Specs m -> Int
+integIterationLoBnd sc = 0
+
+-- | Returns the last integration iteration.
+integIterationHiBnd :: Specs m -> Int
+integIterationHiBnd sc =
+  let n = round ((spcStopTime sc - 
+                  spcStartTime sc) / spcDT sc)
+  in if n < 0
+     then
+       error $
+       "Either the simulation specs are incorrect, " ++
+       "or a step time is too small, because of which " ++
+       "a floating point overflow occurred on 32-bit Haskell implementation."
+     else n
+
+-- | Returns the phases for the specified simulation specs starting from zero.
+integPhases :: Specs m -> [Int]
+integPhases sc = 
+  case spcMethod sc of
+    Euler -> [0]
+    RungeKutta2 -> [0, 1]
+    RungeKutta4 -> [0, 1, 2, 3]
+
+-- | Returns the first and last integration phases.
+integPhaseBnds :: Specs m -> (Int, Int)
+integPhaseBnds sc = 
+  case spcMethod sc of
+    Euler -> (0, 0)
+    RungeKutta2 -> (0, 1)
+    RungeKutta4 -> (0, 3)
+
+-- | Returns the first integration phase, i.e. zero.
+integPhaseLoBnd :: Specs m -> Int
+integPhaseLoBnd sc = 0
+                  
+-- | Returns the last integration phase, 0 for Euler's method, 1 for RK2 and 3 for RK4.
+integPhaseHiBnd :: Specs m -> Int
+integPhaseHiBnd sc = 
+  case spcMethod sc of
+    Euler -> 0
+    RungeKutta2 -> 1
+    RungeKutta4 -> 3
+
+-- | Returns a simulation time for the integration point specified by 
+-- the specs, iteration and phase.
+basicTime :: Specs m -> Int -> Int -> Double
+{-# INLINE basicTime #-}
+basicTime sc n ph =
+  if ph < 0 then 
+    error "Incorrect phase: basicTime"
+  else
+    spcStartTime sc + n' * spcDT sc + delta (spcMethod sc) ph 
+      where n' = fromIntegral n
+            delta Euler       0 = 0
+            delta RungeKutta2 0 = 0
+            delta RungeKutta2 1 = spcDT sc
+            delta RungeKutta4 0 = 0
+            delta RungeKutta4 1 = spcDT sc / 2
+            delta RungeKutta4 2 = spcDT sc / 2
+            delta RungeKutta4 3 = spcDT sc
+
+-- | Return the integration time values.
+integTimes :: Specs m -> [Double]
+integTimes sc = map t [nl .. nu]
+  where (nl, nu) = integIterationBnds sc
+        t n = basicTime sc n 0
+
+-- | Return the integration time points.
+integPoints :: Run m -> [Point m]
+integPoints r = points
+  where sc = runSpecs r
+        (nl, nu) = integIterationBnds sc
+        points   = map point [nl .. nu]
+        point n  = Point { pointSpecs = sc,
+                           pointRun = r,
+                           pointTime = basicTime sc n 0,
+                           pointIteration = n,
+                           pointPhase = 0 }
+
+-- | Return the start time point.
+integStartPoint :: Run m -> Point m
+integStartPoint r = point nl
+  where sc = runSpecs r
+        (nl, nu) = integIterationBnds sc
+        point n  = Point { pointSpecs = sc,
+                           pointRun = r,
+                           pointTime = basicTime sc n 0,
+                           pointIteration = n,
+                           pointPhase = 0 }
+
+-- | Return the stop time point.
+integStopPoint :: Run m -> Point m
+integStopPoint r = point nu
+  where sc = runSpecs r
+        (nl, nu) = integIterationBnds sc
+        point n  = Point { pointSpecs = sc,
+                           pointRun = r,
+                           pointTime = basicTime sc n 0,
+                           pointIteration = n,
+                           pointPhase = 0 }
+
+-- | Return the point at the specified time.
+pointAt :: Run m -> Double -> Point m
+{-# INLINABLE pointAt #-}
+pointAt r t = p
+  where sc = runSpecs r
+        t0 = spcStartTime sc
+        dt = spcDT sc
+        n  = fromIntegral $ floor ((t - t0) / dt)
+        p = Point { pointSpecs = sc,
+                    pointRun = r,
+                    pointTime = t,
+                    pointIteration = n,
+                    pointPhase = -1 }
+ Simulation/Aivika/Trans/Net.hs view
@@ -0,0 +1,245 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Net
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines a 'Net' arrow that can be applied to modeling the queue networks
+-- like the 'Processor' arrow from another module. Only the former has a more efficient
+-- implementation of the 'Arrow' interface than the latter, although at the cost of
+-- some decreasing in generality.
+--
+-- While the @Processor@ type is just a function that transforms the input 'Stream' into another,
+-- the @Net@ type is actually an automaton that has an implementation very similar to that one
+-- which the 'Circuit' type has, only the computations occur in the 'Process' monad. But unlike
+-- the @Circuit@ type, the @Net@ type doesn't allow declaring recursive definitions, being based on
+-- continuations.
+--
+-- In a nutshell, the @Net@ type is an interchangeable alternative to the @Processor@ type
+-- with its weaknesses and strengths. The @Net@ arrow is useful for constructing computations
+-- with help of the proc-notation to be transformed then to the @Processor@ computations that
+-- are more general in nature and more easy-to-use but which computations created with help of
+-- the proc-notation are not so efficient.
+--
+module Simulation.Aivika.Trans.Net
+       (-- * Net Arrow
+        Net(..),
+        -- * Net Primitives
+        emptyNet,
+        arrNet,
+        accumNet,
+        -- * Specifying Identifier
+        netUsingId,
+        -- * Arrival Net
+        arrivalNet,
+        -- * Delaying Net
+        delayNet,
+        -- * Interchanging Nets with Processors
+        netProcessor,
+        processorNet) where
+
+import qualified Control.Category as C
+import Control.Arrow
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Cont
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Circuit
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | Represents the net as an automaton working within the 'Process' computation.
+newtype Net m a b =
+  Net { runNet :: a -> Process m (b, Net m a b)
+        -- ^ Run the net.
+      }
+
+instance MonadComp m => C.Category (Net m) where
+
+  id = Net $ \a -> return (a, C.id)
+
+  (.) = dot
+    where 
+      (Net g) `dot` (Net f) =
+        Net $ \a ->
+        do (b, p1) <- f a
+           (c, p2) <- g b
+           return (c, p2 `dot` p1)
+
+instance MonadComp m => Arrow (Net m) where
+
+  arr f = Net $ \a -> return (f a, arr f)
+
+  first (Net f) =
+    Net $ \(b, d) ->
+    do (c, p) <- f b
+       return ((c, d), first p)
+
+  second (Net f) =
+    Net $ \(d, b) ->
+    do (c, p) <- f b
+       return ((d, c), second p)
+
+  (Net f) *** (Net g) =
+    Net $ \(b, b') ->
+    do (c, p1) <- f b
+       (c', p2) <- g b'
+       return ((c, c'), p1 *** p2)
+       
+  (Net f) &&& (Net g) =
+    Net $ \b ->
+    do (c, p1) <- f b
+       (c', p2) <- g b
+       return ((c, c'), p1 &&& p2)
+
+instance MonadComp m => ArrowChoice (Net m) where
+
+  left x@(Net f) =
+    Net $ \ebd ->
+    case ebd of
+      Left b ->
+        do (c, p) <- f b
+           return (Left c, left p)
+      Right d ->
+        return (Right d, left x)
+
+  right x@(Net f) =
+    Net $ \edb ->
+    case edb of
+      Right b ->
+        do (c, p) <- f b
+           return (Right c, right p)
+      Left d ->
+        return (Left d, right x)
+
+  x@(Net f) +++ y@(Net g) =
+    Net $ \ebb' ->
+    case ebb' of
+      Left b ->
+        do (c, p1) <- f b
+           return (Left c, p1 +++ y)
+      Right b' ->
+        do (c', p2) <- g b'
+           return (Right c', x +++ p2)
+
+  x@(Net f) ||| y@(Net g) =
+    Net $ \ebc ->
+    case ebc of
+      Left b ->
+        do (d, p1) <- f b
+           return (d, p1 ||| y)
+      Right b' ->
+        do (d, p2) <- g b'
+           return (d, x ||| p2)
+
+-- | A net that never finishes its work.
+emptyNet :: MonadComp m => Net m a b
+emptyNet = Net $ const neverProcess
+
+-- | Create a simple net by the specified handling function
+-- that runs the discontinuous process for each input value to get an output.
+arrNet :: MonadComp m => (a -> Process m b) -> Net m a b
+arrNet f =
+  let x =
+        Net $ \a ->
+        do b <- f a
+           return (b, x)
+  in x
+
+-- | Accumulator that outputs a value determined by the supplied function.
+accumNet :: MonadComp m => (acc -> a -> Process m (acc, b)) -> acc -> Net m a b
+accumNet f acc =
+  Net $ \a ->
+  do (acc', b) <- f acc a
+     return (b, accumNet f acc') 
+
+-- | Create a net that will use the specified process identifier.
+-- It can be useful to refer to the underlying 'Process' computation which
+-- can be passivated, interrupted, canceled and so on. See also the
+-- 'processUsingId' function for more details.
+netUsingId :: MonadComp m => ProcessId m -> Net m a b -> Net m a b
+netUsingId pid (Net f) =
+  Net $ processUsingId pid . f
+
+-- | Transform the net to an equivalent processor (a rather cheap transformation).
+netProcessor :: MonadComp m => Net m a b -> Processor m a b
+netProcessor = Processor . loop
+  where loop x as =
+          Cons $
+          do (a, as') <- runStream as
+             (b, x') <- runNet x a
+             return (b, loop x' as')
+
+-- | Transform the processor to a similar net (a more costly transformation).
+processorNet :: MonadComp m => Processor m a b -> Net m a b
+processorNet x =
+  Net $ \a ->
+  do readingA <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+     writingA <- liftSimulation $ newResourceWithMaxCount FCFS 1 (Just 1)
+     readingB <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+     writingB <- liftSimulation $ newResourceWithMaxCount FCFS 1 (Just 1)
+     conting  <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+     sn <- liftParameter simulationSession
+     refA <- liftComp $ newProtoRef sn Nothing
+     refB <- liftComp $ newProtoRef sn Nothing
+     let input =
+           do requestResource readingA
+              Just a <- liftComp $ readProtoRef refA
+              liftComp $ writeProtoRef refA Nothing
+              releaseResource writingA
+              return (a, Cons input)
+         consume bs =
+           do (b, bs') <- runStream bs
+              requestResource writingB
+              liftComp $ writeProtoRef refB (Just b)
+              releaseResource readingB
+              requestResource conting
+              consume bs'
+         loop a =
+           do requestResource writingA
+              liftComp $ writeProtoRef refA (Just a)
+              releaseResource readingA
+              requestResource readingB
+              Just b <- liftComp $ readProtoRef refB
+              liftComp $ writeProtoRef refB Nothing
+              releaseResource writingB
+              return (b, Net $ \a -> releaseResource conting >> loop a)
+     spawnProcess CancelTogether $
+       consume $ runProcessor x (Cons input)
+     loop a
+
+-- | A net that adds the information about the time points at which 
+-- the values were received.
+arrivalNet :: MonadComp m => Net m a (Arrival a)
+arrivalNet =
+  let loop t0 =
+        Net $ \a ->
+        do t <- liftDynamics time
+           let b = Arrival { arrivalValue = a,
+                             arrivalTime  = t,
+                             arrivalDelay = 
+                               case t0 of
+                                 Nothing -> Nothing
+                                 Just t0 -> Just (t - t0) }
+           return (b, loop $ Just t)
+  in loop Nothing
+
+-- | Delay the input by one step using the specified initial value.
+delayNet :: MonadComp m => a -> Net m a a
+delayNet a0 =
+  Net $ \a ->
+  return (a0, delayNet a)
+ Simulation/Aivika/Trans/Parameter.hs view
@@ -0,0 +1,40 @@+-- |
+-- Module     : Simulation.Aivika.Trans.Parameter
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'ParameterT' monad transformer that allows representing the model
+-- parameters. For example, they can be used when running the Monte-Carlo simulation.
+--
+-- In general, this monad tranformer is very useful for representing a computation which is external
+-- relative to the model itself.
+-- 
+module Simulation.Aivika.Trans.Parameter
+       (-- * Parameter
+        Parameter,
+        ParameterLift(..),
+        runParameter,
+        runParameters,
+        -- * Error Handling
+        catchParameter,
+        finallyParameter,
+        throwParameter,
+        -- * Predefined Parameters
+        simulationIndex,
+        simulationCount,
+        simulationSpecs,
+        simulationSession,
+        generatorParameter,
+        starttime,
+        stoptime,
+        dt,
+        -- * Memoization
+        memoParameter,
+        -- * Utilities
+        tableParameter) where
+
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+ Simulation/Aivika/Trans/Parameter/Random.hs view
@@ -0,0 +1,142 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Parameter.Random
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the random parameters of simulation experiments.
+--
+-- To create a parameter that would return the same value within the simulation run,
+-- you should memoize the computation with help of 'memoParameter', which is important
+-- for the Monte-Carlo simulation.
+--
+-- To create a random function that would return the same values in the integration
+-- time points within the simulation run, you should either lift the computation to
+-- the 'Dynamics' computation and then memoize it too but using the 'memo0Dynamics'
+-- function for that computation, or just take the predefined function that does
+-- namely this.
+
+module Simulation.Aivika.Trans.Parameter.Random
+       (randomUniform,
+        randomUniformInt,
+        randomNormal,
+        randomExponential,
+        randomErlang,
+        randomPoisson,
+        randomBinomial,
+        randomTrue,
+        randomFalse) where
+
+import System.Random
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Generator
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+
+-- | Computation that generates a new random number distributed uniformly.
+randomUniform :: MonadComp m
+                 => Double     -- ^ minimum
+                 -> Double  -- ^ maximum
+                 -> Parameter m Double
+{-# INLINE randomUniform #-}
+randomUniform min max =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateUniform g min max
+
+-- | Computation that generates a new random integer number distributed uniformly.
+randomUniformInt :: MonadComp m
+                    => Int     -- ^ minimum
+                    -> Int  -- ^ maximum
+                    -> Parameter m Int
+{-# INLINE randomUniformInt #-}
+randomUniformInt min max =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateUniformInt g min max
+
+-- | Computation that generates a new random number distributed normally.
+randomNormal :: MonadComp m
+                => Double     -- ^ mean
+                -> Double  -- ^ deviation
+                -> Parameter m Double
+{-# INLINE randomNormal #-}
+randomNormal mu nu =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateNormal g mu nu
+
+-- | Computation that returns a new exponential random number with the specified mean
+-- (the reciprocal of the rate).
+randomExponential :: MonadComp m
+                     => Double
+                     -- ^ the mean (the reciprocal of the rate)
+                     -> Parameter m Double
+{-# INLINE randomExponential #-}
+randomExponential mu =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateExponential g mu
+
+-- | Computation that returns a new Erlang random number with the specified scale
+-- (the reciprocal of the rate) and integer shape.
+randomErlang :: MonadComp m
+                => Double
+                -- ^ the scale (the reciprocal of the rate)
+                -> Int
+                -- ^ the shape
+                -> Parameter m Double
+{-# INLINE randomErlang #-}
+randomErlang beta m =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateErlang g beta m
+
+-- | Computation that returns a new Poisson random number with the specified mean.
+randomPoisson :: MonadComp m
+                 => Double
+                 -- ^ the mean
+                 -> Parameter m Int
+{-# INLINE randomPoisson #-}
+randomPoisson mu =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generatePoisson g mu
+
+-- | Computation that returns a new binomial random number with the specified
+-- probability and trials.
+randomBinomial :: MonadComp m
+                  => Double  -- ^ the probability
+                  -> Int  -- ^ the number of trials
+                  -> Parameter m Int
+{-# INLINE randomBinomial #-}
+randomBinomial prob trials =
+  Parameter $ \r ->
+  let g = runGenerator r
+  in generateBinomial g prob trials
+
+-- | Computation that returns 'True' in case of success.
+randomTrue :: MonadComp m
+              => Double      -- ^ the probability of the success
+              -> Parameter m Bool
+{-# INLINE randomTrue #-}              
+randomTrue p =
+  do x <- randomUniform 0 1
+     return (x <= p)
+
+-- | Computation that returns 'False' in case of success.
+randomFalse :: MonadComp m
+               => Double      -- ^ the probability of the success
+               -> Parameter m Bool
+{-# INLINE randomFalse #-}
+randomFalse p =
+  do x <- randomUniform 0 1
+     return (x > p)
+ Simulation/Aivika/Trans/PriorityQueue.hs view
@@ -0,0 +1,186 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.PriorityQueue
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- An imperative heap-based priority queue.
+--
+module Simulation.Aivika.Trans.PriorityQueue 
+       (PriorityQueue,
+        queueNull, 
+        queueCount,
+        newQueue, 
+        enqueue, 
+        dequeue, 
+        queueFront) where 
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+
+import qualified Simulation.Aivika.Trans.ProtoArray as A
+import qualified Simulation.Aivika.Trans.ProtoArray.Unboxed as UA
+
+-- | The 'PriorityQueue' type represents an imperative heap-based 
+-- priority queue.
+data PriorityQueue m a = 
+  PriorityQueue { pqSession  :: Session m,
+                  pqKeys     :: ProtoRef m (UA.ProtoArray m Double),
+                  pqVals     :: ProtoRef m (A.ProtoArray m a),
+                  pqSize     :: ProtoRef m Int,
+                  pqCapacity :: ProtoRef m Int }
+
+increase :: ProtoMonadComp m => PriorityQueue m a -> m ()
+increase pq = 
+  do let s = pqSession pq
+         keyRef = pqKeys pq
+         valRef = pqVals pq
+         capacityRef = pqCapacity pq
+     keys <- readProtoRef keyRef
+     vals <- readProtoRef valRef
+     len  <- readProtoRef capacityRef
+     let capacity' | len < 64  = 2 * len
+                   | otherwise = (len `div` 2) * 3
+     keys' <- UA.newProtoArray_ s capacity'
+     vals' <- A.newProtoArray_ s capacity'
+     mapM_ (\i -> do { k <- UA.readProtoArray keys i; UA.writeProtoArray keys' i k }) [0 .. len - 1]
+     mapM_ (\i -> do { v <- A.readProtoArray vals i; A.writeProtoArray vals' i v }) [0 .. len - 1]
+     writeProtoRef keyRef keys'
+     writeProtoRef valRef vals'
+     writeProtoRef capacityRef capacity'
+
+siftUp :: ProtoMonadComp m 
+          => UA.ProtoArray m Double
+          -- ^ keys
+          -> A.ProtoArray m a
+          -- ^ values
+          -> Int
+          -- ^ index
+          -> Double
+          -- ^ key
+          -> a
+          -- ^ value
+          -> m ()
+siftUp keys vals i k v =
+  if i == 0 
+  then do UA.writeProtoArray keys i k
+          A.writeProtoArray vals i v
+  else do let n = (i - 1) `div` 2
+          kn <- UA.readProtoArray keys n
+          if k >= kn 
+            then do UA.writeProtoArray keys i k
+                    A.writeProtoArray vals i v
+            else do vn <- A.readProtoArray vals n
+                    UA.writeProtoArray keys i kn
+                    A.writeProtoArray vals i vn
+                    siftUp keys vals n k v
+
+siftDown :: ProtoMonadComp m 
+            => UA.ProtoArray m Double
+            -- ^ keys
+            -> A.ProtoArray m a
+            -- ^ values
+            -> Int
+            -- ^ size
+            -> Int
+            -- ^ index
+            -> Double
+            -- ^ key
+            -> a
+            -- ^ value
+            -> m ()
+siftDown keys vals size i k v =
+  if i >= (size `div` 2)
+  then do UA.writeProtoArray keys i k
+          A.writeProtoArray vals i v
+  else do let n  = 2 * i + 1
+              n' = n + 1
+          kn  <- UA.readProtoArray keys n
+          if n' >= size 
+            then if k <= kn
+                 then do UA.writeProtoArray keys i k
+                         A.writeProtoArray vals i v
+                 else do vn <- A.readProtoArray vals n
+                         UA.writeProtoArray keys i kn
+                         A.writeProtoArray vals i vn
+                         siftDown keys vals size n k v
+            else do kn' <- UA.readProtoArray keys n'
+                    let n''  = if kn > kn' then n' else n
+                        kn'' = min kn' kn
+                    if k <= kn''
+                      then do UA.writeProtoArray keys i k
+                              A.writeProtoArray vals i v
+                      else do vn'' <- A.readProtoArray vals n''
+                              UA.writeProtoArray keys i kn''
+                              A.writeProtoArray vals i vn''
+                              siftDown keys vals size n'' k v
+
+-- | Test whether the priority queue is empty.
+queueNull :: ProtoMonadComp m => PriorityQueue m a -> m Bool
+queueNull pq =
+  do size <- readProtoRef (pqSize pq)
+     return $ size == 0
+
+-- | Return the number of elements in the priority queue.
+queueCount :: ProtoMonadComp m => PriorityQueue m a -> m Int
+queueCount pq = readProtoRef (pqSize pq)
+
+-- | Create a new priority queue.
+newQueue :: ProtoMonadComp m => Session m -> m (PriorityQueue m a)
+newQueue session =
+  do keys        <- UA.newProtoArray_ session 11
+     vals        <- A.newProtoArray_ session 11
+     keyRef      <- newProtoRef session keys
+     valRef      <- newProtoRef session vals
+     sizeRef     <- newProtoRef session 0
+     capacityRef <- newProtoRef session 11
+     return PriorityQueue { pqSession = session,
+                            pqKeys = keyRef, 
+                            pqVals = valRef, 
+                            pqSize = sizeRef,
+                            pqCapacity = capacityRef }
+
+-- | Enqueue a new element with the specified priority.
+enqueue :: ProtoMonadComp m => PriorityQueue m a -> Double -> a -> m ()
+enqueue pq k v =
+  do i <- readProtoRef (pqSize pq)
+     n <- readProtoRef (pqCapacity pq)
+     when (i >= n - 1) $ increase pq
+     writeProtoRef (pqSize pq) (i + 1)
+     keys <- readProtoRef (pqKeys pq)
+     vals <- readProtoRef (pqVals pq)
+     siftUp keys vals i k v
+
+-- | Dequeue the element with the minimal priority.
+dequeue :: ProtoMonadComp m => PriorityQueue m a -> m ()
+dequeue pq =
+  do size <- readProtoRef (pqSize pq)
+     when (size == 0) $ error "Empty priority queue: dequeue"
+     let i = size - 1
+     writeProtoRef (pqSize pq) i
+     keys <- readProtoRef (pqKeys pq)
+     vals <- readProtoRef (pqVals pq)
+     k  <- UA.readProtoArray keys i
+     v  <- A.readProtoArray vals i
+     let k0 = 0.0
+         v0 = undefined
+     UA.writeProtoArray keys i k0
+     A.writeProtoArray vals i v0
+     siftDown keys vals i 0 k v
+
+-- | Return the element with the minimal priority.
+queueFront :: ProtoMonadComp m => PriorityQueue m a -> m (Double, a)
+queueFront pq =
+  do size <- readProtoRef (pqSize pq)
+     when (size == 0) $ error "Empty priority queue: queueFront"
+     keys <- readProtoRef (pqKeys pq)
+     vals <- readProtoRef (pqVals pq)
+     k <- UA.readProtoArray keys 0
+     v <- A.readProtoArray vals 0
+     return (k, v)
+ Simulation/Aivika/Trans/Process.hs view
@@ -0,0 +1,82 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Process
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- A value in the 'Process' monad represents a discontinuous process that 
+-- can suspend in any simulation time point and then resume later in the same 
+-- or another time point. 
+-- 
+-- The process of this type can involve the 'Event', 'Dynamics' and 'Simulation'
+-- computations. Moreover, a value in the @Process@ monad can be run within
+-- the @Event@ computation.
+--
+-- A value of the 'ProcessId' type is just an identifier of such a process.
+--
+-- The characteristic property of the @Process@ type is function 'holdProcess'
+-- that suspends the current process for the specified time interval.
+--
+module Simulation.Aivika.Trans.Process
+       (-- * Process Monad
+        ProcessId,
+        Process,
+        ProcessLift(..),
+        -- * Running Process
+        runProcess,
+        runProcessUsingId,
+        runProcessInStartTime,
+        runProcessInStartTimeUsingId,
+        runProcessInStopTime,
+        runProcessInStopTimeUsingId,
+        -- * Spawning Processes
+        spawnProcess,
+        spawnProcessUsingId,
+        -- * Enqueueing Process
+        enqueueProcess,
+        enqueueProcessUsingId,
+        -- * Creating Process Identifier
+        newProcessId,
+        processId,
+        processUsingId,
+        -- * Holding, Interrupting, Passivating and Canceling Process
+        holdProcess,
+        interruptProcess,
+        processInterrupted,
+        passivateProcess,
+        processPassive,
+        reactivateProcess,
+        cancelProcessWithId,
+        cancelProcess,
+        processCancelled,
+        processCancelling,
+        whenCancellingProcess,
+        -- * Awaiting Signal
+        processAwait,
+        -- * Yield of Process
+        processYield,
+        -- * Process Timeout
+        timeoutProcess,
+        timeoutProcessUsingId,
+        -- * Parallelizing Processes
+        processParallel,
+        processParallelUsingIds,
+        processParallel_,
+        processParallelUsingIds_,
+        -- * Exception Handling
+        catchProcess,
+        finallyProcess,
+        throwProcess,
+        -- * Utilities
+        zipProcessParallel,
+        zip3ProcessParallel,
+        unzipProcess,
+        -- * Memoizing Process
+        memoProcess,
+        -- * Never Ending Process
+        neverProcess) where
+
+import Simulation.Aivika.Trans.Internal.Process
+ Simulation/Aivika/Trans/Processor.hs view
@@ -0,0 +1,474 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Processor
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The processor of simulation data.
+--
+module Simulation.Aivika.Trans.Processor
+       (-- * Processor Type
+        Processor(..),
+        -- * Processor Primitives
+        emptyProcessor,
+        arrProcessor,
+        accumProcessor,
+        -- * Specifying Identifier
+        processorUsingId,
+        -- * Prefetch and Delay Processors
+        prefetchProcessor,
+        delayProcessor,
+        -- * Buffer Processor
+        bufferProcessor,
+        bufferProcessorLoop,
+        -- * Processing Queues
+        queueProcessor,
+        queueProcessorLoopMerging,
+        queueProcessorLoopSeq,
+        queueProcessorLoopParallel,
+        -- * Sequencing Processors
+        processorSeq,
+        -- * Parallelizing Processors
+        processorParallel,
+        processorQueuedParallel,
+        processorPrioritisingOutputParallel,
+        processorPrioritisingInputParallel,
+        processorPrioritisingInputOutputParallel,
+        -- * Arrival Processor
+        arrivalProcessor,
+        -- * Integrating with Signals
+        signalProcessor,
+        processorSignaling) where
+
+import qualified Control.Category as C
+import Control.Arrow
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Cont
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | Represents a processor of simulation data.
+newtype Processor m a b =
+  Processor { runProcessor :: Stream m a -> Stream m b
+              -- ^ Run the processor.
+            }
+
+instance C.Category (Processor m) where
+
+  id  = Processor id
+
+  Processor x . Processor y = Processor (x . y)
+
+-- The implementation is based on article
+-- A New Notation for Arrows by Ross Paterson,
+-- although my streams are different and they
+-- already depend on the Process monad,
+-- while the pure streams were considered in the
+-- mentioned article.
+  
+instance MonadComp m => Arrow (Processor m) where
+
+  arr = Processor . mapStream
+
+  first (Processor f) =
+    Processor $ \xys ->
+    Cons $
+    do (xs, ys) <- liftSimulation $ unzipStream xys
+       runStream $ zipStreamSeq (f xs) ys
+
+  second (Processor f) =
+    Processor $ \xys ->
+    Cons $
+    do (xs, ys) <- liftSimulation $ unzipStream xys
+       runStream $ zipStreamSeq xs (f ys)
+
+  Processor f *** Processor g =
+    Processor $ \xys ->
+    Cons $
+    do (xs, ys) <- liftSimulation $ unzipStream xys
+       runStream $ zipStreamSeq (f xs) (g ys)
+
+  Processor f &&& Processor g =
+    Processor $ \xs -> zipStreamSeq (f xs) (g xs)
+
+instance MonadComp m => ArrowChoice (Processor m) where
+
+  left (Processor f) =
+    Processor $ \xs ->
+    Cons $
+    do ys <- liftSimulation $ memoStream xs
+       runStream $ replaceLeftStream ys (f $ leftStream ys)
+
+  right (Processor f) =
+    Processor $ \xs ->
+    Cons $
+    do ys <- liftSimulation $ memoStream xs
+       runStream $ replaceRightStream ys (f $ rightStream ys)
+
+instance MonadComp m => ArrowZero (Processor m) where
+
+  zeroArrow = emptyProcessor
+
+instance MonadComp m => ArrowPlus (Processor m) where
+
+  (Processor f) <+> (Processor g) =
+    Processor $ \xs ->
+    Cons $
+    do [xs1, xs2] <- liftSimulation $ splitStream 2 xs
+       runStream $ mergeStreams (f xs1) (g xs2)
+
+-- | A processor that never finishes its work producing an 'emptyStream'.
+emptyProcessor :: MonadComp m => Processor m a b
+emptyProcessor = Processor $ const emptyStream
+
+-- | Create a simple processor by the specified handling function
+-- that runs the discontinuous process for each input value to get the output.
+arrProcessor :: MonadComp m => (a -> Process m b) -> Processor m a b
+arrProcessor = Processor . mapStreamM
+
+-- | Accumulator that outputs a value determined by the supplied function.
+accumProcessor :: MonadComp m => (acc -> a -> Process m (acc, b)) -> acc -> Processor m a b
+accumProcessor f acc =
+  Processor $ \xs -> Cons $ loop xs acc where
+    loop xs acc =
+      do (a, xs') <- runStream xs
+         (acc', b) <- f acc a
+         return (b, Cons $ loop xs' acc') 
+
+-- | Create a processor that will use the specified process identifier.
+-- It can be useful to refer to the underlying 'Process' computation which
+-- can be passivated, interrupted, canceled and so on. See also the
+-- 'processUsingId' function for more details.
+processorUsingId :: MonadComp m => ProcessId m -> Processor m a b -> Processor m a b
+processorUsingId pid (Processor f) =
+  Processor $ Cons . processUsingId pid . runStream . f
+
+-- | Launches the specified processors in parallel consuming the same input
+-- stream and producing a combined output stream.
+--
+-- If you don't know what the enqueue strategies to apply, then
+-- you will probably need 'FCFS' for the both parameters, or
+-- function 'processorParallel' that does namely this.
+processorQueuedParallel :: (MonadComp m,
+                            EnqueueStrategy m si,
+                            EnqueueStrategy m so)
+                           => si
+                           -- ^ the strategy applied for enqueuing the input data
+                           -> so
+                           -- ^ the strategy applied for enqueuing the output data
+                           -> [Processor m a b]
+                           -- ^ the processors to parallelize
+                           -> Processor m a b
+                           -- ^ the parallelized processor
+processorQueuedParallel si so ps =
+  Processor $ \xs ->
+  Cons $
+  do let n = length ps
+     input <- liftSimulation $ splitStreamQueueing si n xs
+     let results = flip map (zip input ps) $ \(input, p) ->
+           runProcessor p input
+         output  = concatQueuedStreams so results
+     runStream output
+
+-- | Launches the specified processors in parallel using priorities for combining the output.
+processorPrioritisingOutputParallel :: (MonadComp m,
+                                        EnqueueStrategy m si,
+                                        PriorityQueueStrategy m so po)
+                                       => si
+                                       -- ^ the strategy applied for enqueuing the input data
+                                       -> so
+                                       -- ^ the strategy applied for enqueuing the output data
+                                       -> [Processor m a (po, b)]
+                                       -- ^ the processors to parallelize
+                                       -> Processor m a b
+                                       -- ^ the parallelized processor
+processorPrioritisingOutputParallel si so ps =
+  Processor $ \xs ->
+  Cons $
+  do let n = length ps
+     input <- liftSimulation $ splitStreamQueueing si n xs
+     let results = flip map (zip input ps) $ \(input, p) ->
+           runProcessor p input
+         output  = concatPriorityStreams so results
+     runStream output
+
+-- | Launches the specified processors in parallel using priorities for consuming the intput.
+processorPrioritisingInputParallel :: (MonadComp m,
+                                       PriorityQueueStrategy m si pi,
+                                       EnqueueStrategy m so)
+                                      => si
+                                      -- ^ the strategy applied for enqueuing the input data
+                                      -> so
+                                      -- ^ the strategy applied for enqueuing the output data
+                                      -> [(Stream m pi, Processor m a b)]
+                                      -- ^ the streams of input priorities and the processors
+                                      -- to parallelize
+                                      -> Processor m a b
+                                      -- ^ the parallelized processor
+processorPrioritisingInputParallel si so ps =
+  Processor $ \xs ->
+  Cons $
+  do input <- liftSimulation $ splitStreamPrioritising si (map fst ps) xs
+     let results = flip map (zip input ps) $ \(input, (_, p)) ->
+           runProcessor p input
+         output  = concatQueuedStreams so results
+     runStream output
+
+-- | Launches the specified processors in parallel using priorities for consuming
+-- the input and combining the output.
+processorPrioritisingInputOutputParallel :: (MonadComp m,
+                                             PriorityQueueStrategy m si pi,
+                                             PriorityQueueStrategy m so po)
+                                            => si
+                                            -- ^ the strategy applied for enqueuing the input data
+                                            -> so
+                                            -- ^ the strategy applied for enqueuing the output data
+                                            -> [(Stream m pi, Processor m a (po, b))]
+                                            -- ^ the streams of input priorities and the processors
+                                            -- to parallelize
+                                            -> Processor m a b
+                                            -- ^ the parallelized processor
+processorPrioritisingInputOutputParallel si so ps =
+  Processor $ \xs ->
+  Cons $
+  do input <- liftSimulation $ splitStreamPrioritising si (map fst ps) xs
+     let results = flip map (zip input ps) $ \(input, (_, p)) ->
+           runProcessor p input
+         output  = concatPriorityStreams so results
+     runStream output
+
+-- | Launches the processors in parallel consuming the same input stream and producing
+-- a combined output stream. This version applies the 'FCFS' strategy both for input
+-- and output, which suits the most part of uses cases.
+processorParallel :: MonadComp m => [Processor m a b] -> Processor m a b
+processorParallel = processorQueuedParallel FCFS FCFS
+
+-- | Launches the processors sequentially using the 'prefetchProcessor' between them
+-- to model an autonomous work of each of the processors specified.
+processorSeq :: MonadComp m => [Processor m a a] -> Processor m a a
+processorSeq []  = emptyProcessor
+processorSeq [p] = p
+processorSeq (p : ps) = p >>> prefetchProcessor >>> processorSeq ps
+
+-- | Create a buffer processor, where the process from the first argument
+-- consumes the input stream but the stream passed in as the second argument
+-- and produced usually by some other process is returned as an output.
+-- This kind of processor is very useful for modeling the queues.
+bufferProcessor :: MonadComp m
+                   => (Stream m a -> Process m ())
+                   -- ^ a separate process to consume the input 
+                   -> Stream m b
+                   -- ^ the resulting stream of data
+                   -> Processor m a b
+bufferProcessor consume output =
+  Processor $ \xs ->
+  Cons $
+  do spawnProcess CancelTogether (consume xs)
+     runStream output
+
+-- | Like 'bufferProcessor' but allows creating a loop when some items
+-- can be processed repeatedly. It is very useful for modeling the processors 
+-- with queues and loop-backs.
+bufferProcessorLoop :: MonadComp m
+                       => (Stream m a -> Stream m c -> Process m ())
+                       -- ^ consume two streams: the input values of type @a@
+                       -- and the values of type @c@ returned by the loop
+                       -> Stream m d
+                       -- ^ the stream of data that may become results
+                       -> Processor m d (Either e b)
+                       -- ^ process and then decide what values of type @e@
+                       -- should be processed in the loop (this is a condition)
+                       -> Processor m e c
+                       -- ^ process in the loop and then return a value
+                       -- of type @c@ to the input again (this is a loop body)
+                       -> Processor m a b
+bufferProcessorLoop consume preoutput cond body =
+  Processor $ \xs ->
+  Cons $
+  do (reverted, output) <-
+       liftSimulation $
+       partitionEitherStream $
+       runProcessor cond preoutput
+     spawnProcess CancelTogether 
+       (consume xs $ runProcessor body reverted)
+     runStream output
+
+-- | Return a processor with help of which we can model the queue.
+--
+-- Although the function doesn't refer to the queue directly, its main use case
+-- is namely a processing of the queue. The first argument should be the enqueueing
+-- operation, while the second argument should be the opposite dequeueing operation.
+--
+-- The reason is as follows. There are many possible combinations how the queues
+-- can be modeled. There is no sense to enumerate all them creating a separate function
+-- for each case. We can just use combinators to define exactly what we need.
+--
+-- So, the queue can lose the input items if the queue is full, or the input process
+-- can suspend while the queue is full, or we can use priorities for enqueueing,
+-- storing and dequeueing the items in different combinations. There are so many use
+-- cases!
+--
+-- There is a hope that this function along with other similar functions from this
+-- module is sufficient to cover the most important cases. Even if it is not sufficient
+-- then you can use a more generic function 'bufferProcessor' which this function is
+-- based on. In case of need, you can even write your own function from scratch. It is
+-- quite easy actually.
+queueProcessor :: MonadComp m =>
+                  (a -> Process m ())
+                  -- ^ enqueue the input item and wait
+                  -- while the queue is full if required
+                  -- so that there were no hanging items
+                  -> Process m b
+                  -- ^ dequeue an output item
+                  -> Processor m a b
+                  -- ^ the buffering processor
+queueProcessor enqueue dequeue =
+  bufferProcessor
+  (consumeStream enqueue)
+  (repeatProcess dequeue)
+
+-- | Like 'queueProcessor' creates a queue processor but with a loop when some items 
+-- can be processed and then added to the queue again. Also it allows specifying 
+-- how two input streams of data can be merged.
+queueProcessorLoopMerging :: MonadComp m
+                             => (Stream m a -> Stream m d -> Stream m e)
+                             -- ^ merge two streams: the input values of type @a@
+                             -- and the values of type @d@ returned by the loop
+                             -> (e -> Process m ())
+                             -- ^ enqueue the input item and wait
+                             -- while the queue is full if required
+                             -- so that there were no hanging items
+                             -> Process m c
+                             -- ^ dequeue an item for the further processing
+                             -> Processor m c (Either f b)
+                             -- ^ process and then decide what values of type @f@
+                             -- should be processed in the loop (this is a condition)
+                             -> Processor m f d
+                             -- ^ process in the loop and then return a value
+                             -- of type @d@ to the queue again (this is a loop body)
+                             -> Processor m a b
+                             -- ^ the buffering processor
+queueProcessorLoopMerging merge enqueue dequeue =
+  bufferProcessorLoop
+  (\bs cs ->
+    consumeStream enqueue $
+    merge bs cs)
+  (repeatProcess dequeue)
+
+-- | Like 'queueProcessorLoopMerging' creates a queue processor with a loop when
+-- some items can be processed and then added to the queue again. Only it sequentially 
+-- merges two input streams of data: one stream that come from the external source and 
+-- another stream of data returned by the loop. The first stream has a priority over 
+-- the second one.
+queueProcessorLoopSeq :: MonadComp m
+                         => (a -> Process m ())
+                         -- ^ enqueue the input item and wait
+                         -- while the queue is full if required
+                         -- so that there were no hanging items
+                         -> Process m c
+                         -- ^ dequeue an item for the further processing
+                         -> Processor m c (Either e b)
+                         -- ^ process and then decide what values of type @e@
+                         -- should be processed in the loop (this is a condition)
+                         -> Processor m e a
+                         -- ^ process in the loop and then return a value
+                         -- of type @a@ to the queue again (this is a loop body)
+                         -> Processor m a b
+                         -- ^ the buffering processor
+queueProcessorLoopSeq =
+  queueProcessorLoopMerging mergeStreams
+
+-- | Like 'queueProcessorLoopMerging' creates a queue processor with a loop when
+-- some items can be processed and then added to the queue again. Only it runs two 
+-- simultaneous processes to enqueue the input streams of data: one stream that come 
+-- from the external source and another stream of data returned by the loop.
+queueProcessorLoopParallel :: MonadComp m
+                              => (a -> Process m ())
+                              -- ^ enqueue the input item and wait
+                              -- while the queue is full if required
+                              -- so that there were no hanging items
+                              -> Process m c
+                              -- ^ dequeue an item for the further processing
+                              -> Processor m c (Either e b)
+                              -- ^ process and then decide what values of type @e@
+                              -- should be processed in the loop (this is a condition)
+                              -> Processor m e a
+                              -- ^ process in the loop and then return a value
+                              -- of type @a@ to the queue again (this is a loop body)
+                              -> Processor m a b
+                              -- ^ the buffering processor
+queueProcessorLoopParallel enqueue dequeue =
+  bufferProcessorLoop
+  (\bs cs ->
+    do spawnProcess CancelTogether $
+         consumeStream enqueue bs
+       spawnProcess CancelTogether $
+         consumeStream enqueue cs)
+  (repeatProcess dequeue)
+
+-- | This is a prefetch processor that requests for one more data item from 
+-- the input in advance while the latest item is not yet fully processed in 
+-- the chain of streams, usually by other processors.
+--
+-- You can think of this as the prefetched processor could place its latest 
+-- data item in some temporary space for later use, which is very useful 
+-- for modeling a sequence of separate and independent work places.
+prefetchProcessor :: MonadComp m => Processor m a a
+prefetchProcessor = Processor prefetchStream
+
+-- | Convert the specified signal transform to a processor.
+--
+-- The processor may return data with delay as the values are requested by demand.
+-- Consider using the 'arrivalSignal' function to provide with the information
+-- about the time points at which the signal was actually triggered.
+--
+-- The point is that the 'Stream' used in the 'Processor' is requested outside, 
+-- while the 'Signal' is triggered inside. They are different by nature. 
+-- The former is passive, while the latter is active.
+--
+-- Cancel the processor's process to unsubscribe from the signals provided.
+signalProcessor :: MonadComp m => (Signal m a -> Signal m b) -> Processor m a b
+signalProcessor f =
+  Processor $ \xs ->
+  Cons $
+  do sa <- streamSignal xs
+     sb <- signalStream (f sa)
+     runStream sb
+
+-- | Convert the specified processor to a signal transform. 
+--
+-- The processor may return data with delay as the values are requested by demand.
+-- Consider using the 'arrivalSignal' function to provide with the information
+-- about the time points at which the signal was actually triggered.
+--
+-- The point is that the 'Stream' used in the 'Processor' is requested outside, 
+-- while the 'Signal' is triggered inside. They are different by nature.
+-- The former is passive, while the latter is active.
+--
+-- Cancel the returned process to unsubscribe from the signal specified.
+processorSignaling :: MonadComp m => Processor m a b -> Signal m a -> Process m (Signal m b)
+processorSignaling (Processor f) sa =
+  do xs <- signalStream sa
+     let ys = f xs
+     streamSignal ys
+
+-- | A processor that adds the information about the time points at which 
+-- the original stream items were received by demand.
+arrivalProcessor :: MonadComp m => Processor m a (Arrival a)
+arrivalProcessor = Processor arrivalStream
+
+-- | A processor that delays the input stream by one step using the specified initial value.
+delayProcessor :: MonadComp m => a -> Processor m a a
+delayProcessor a0 = Processor $ delayStream a0
+ Simulation/Aivika/Trans/Processor/RoundRobbin.hs view
@@ -0,0 +1,59 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Processor.RoundRobbin
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the Round-Robbin processor.
+--
+module Simulation.Aivika.Trans.Processor.RoundRobbin
+       (roundRobbinProcessor,
+        roundRobbinProcessorUsingIds) where
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Queue.Infinite
+
+-- | Represents the Round-Robbin processor that tries to perform the task within
+-- the specified timeout. If the task times out, then it is canceled and returned
+-- to the processor again; otherwise, the successful result is redirected to output.
+roundRobbinProcessor :: MonadComp m => Processor m (Process m Double, Process m a) a
+roundRobbinProcessor =
+  Processor $
+  runProcessor roundRobbinProcessorUsingIds . mapStreamM f where
+    f (timeout, p) =
+      let x = do timeout' <- timeout
+                 pid <- liftSimulation newProcessId
+                 return (timeout', pid)
+      in return (x, p)
+
+-- | Like 'roundRobbinProcessor' but allows specifying the process identifiers which
+-- must be unique for every new attemp to perform the task even if the task is the same.
+roundRobbinProcessorUsingIds :: MonadComp m => Processor m (Process m (Double, ProcessId m), Process m a) a
+roundRobbinProcessorUsingIds =
+  Processor $ \xs ->
+  Cons $
+  do q <- liftEvent newFCFSQueue
+     let process =
+           do t@(x, p) <- dequeue q
+              (timeout, pid) <- x
+              result <- timeoutProcessUsingId timeout pid p
+              case result of
+                Just a  -> return a
+                Nothing ->
+                  do liftEvent $ enqueue q t 
+                     process
+         processor =
+           bufferProcessor
+           (consumeStream $ liftEvent . enqueue q)
+           (repeatProcess process)
+     runStream $ runProcessor processor xs
+ Simulation/Aivika/Trans/ProtoArray.hs view
@@ -0,0 +1,82 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.ProtoArray
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a prototype of all mutable arrays.
+--
+module Simulation.Aivika.Trans.ProtoArray
+       (ProtoArrayMonad(..)) where
+
+import Data.Array
+import Data.Array.IO.Safe
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+
+-- | A monad within which computation we can create and work with
+-- the prototype of mutable arrays.
+class ProtoRefMonad m => ProtoArrayMonad m where
+  
+  -- | A prototype of mutable array.
+  data ProtoArray m :: * -> *
+
+  -- | Return the array size.
+  protoArrayCount :: ProtoArray m a -> m Int
+
+  -- | Create a new ptototype of mutable array by the specified session,
+  -- size and initial value.
+  newProtoArray :: Session m -> Int -> a -> m (ProtoArray m a)
+
+  -- | Create a new ptototype of mutable array by the specified session
+  -- and size with every element initialised to an undefined value.
+  newProtoArray_ :: Session m -> Int -> m (ProtoArray m a)
+
+  -- | Read an element from the mutable array.
+  readProtoArray :: ProtoArray m a -> Int -> m a
+
+  -- | Write the element in the mutable array.
+  writeProtoArray :: ProtoArray m a -> Int -> a -> m ()
+
+  -- | Return a list of the elements.
+  protoArrayToList :: ProtoArray m a -> m [a]
+
+  -- | Create an array by the specified list of elements.
+  protoArrayFromList :: [a] -> m (ProtoArray m a)
+
+  -- | Return the elements of the mutable array in an immutable array.
+  freezeProtoArray :: ProtoArray m a -> m (Array Int a)
+
+instance ProtoArrayMonad IO where
+
+  newtype ProtoArray IO a = ProtoArray (IOArray Int a)
+
+  {-# SPECIALISE INLINE protoArrayCount :: ProtoArray IO a -> IO Int #-}
+  protoArrayCount (ProtoArray a) = do { (0, n') <- getBounds a; return $ n' + 1 }
+
+  {-# SPECIALISE INLINE newProtoArray :: Session IO -> Int -> a -> IO (ProtoArray IO a) #-}
+  newProtoArray s n a = fmap ProtoArray $ newArray (0, n - 1) a
+
+  {-# SPECIALISE INLINE newProtoArray_ :: Session IO -> Int -> IO (ProtoArray IO a) #-}
+  newProtoArray_ s n = fmap ProtoArray $ newArray_ (0, n - 1)
+
+  {-# SPECIALISE INLINE readProtoArray :: ProtoArray IO a -> Int -> IO a #-}
+  readProtoArray (ProtoArray a) = readArray a
+
+  {-# SPECIALISE INLINE writeProtoArray :: ProtoArray IO a -> Int -> a -> IO () #-}
+  writeProtoArray (ProtoArray a) = writeArray a
+
+  {-# SPECIALISE INLINE protoArrayToList :: ProtoArray IO a -> IO [a] #-}
+  protoArrayToList (ProtoArray a) = getElems a
+
+  {-# SPECIALISE INLINE protoArrayFromList :: [a] -> IO (ProtoArray IO a) #-}
+  protoArrayFromList xs = fmap ProtoArray $ newListArray (0, length xs - 1) xs
+
+  {-# SPECIALISE INLINE freezeProtoArray :: ProtoArray IO a -> IO (Array Int a) #-}
+  freezeProtoArray (ProtoArray a) = freeze a
+ Simulation/Aivika/Trans/ProtoArray/Unboxed.hs view
@@ -0,0 +1,98 @@+
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.ProtoArray.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a prototype of all mutable unboxed arrays.
+--
+module Simulation.Aivika.Trans.ProtoArray.Unboxed
+       (ProtoArrayMonad(..)) where
+
+import Data.Array
+import Data.Array.IO.Safe
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+
+-- | A monad within which computation we can create and work with
+-- the prototype of mutable unboxed arrays.
+class ProtoRefMonad m => ProtoArrayMonad m a where
+  
+  -- | A prototype of mutable unboxed array.
+  data ProtoArray m :: * -> *
+
+  -- | Return the array size.
+  protoArrayCount :: ProtoArray m a -> m Int
+
+  -- | Create a new ptototype of mutable array by the specified session,
+  -- size and initial value.
+  newProtoArray :: Session m -> Int -> a -> m (ProtoArray m a)
+
+  -- | Create a new ptototype of mutable array by the specified session
+  -- and size with every element initialised to an undefined value.
+  newProtoArray_ :: Session m -> Int -> m (ProtoArray m a)
+
+  -- | Read an element from the mutable array.
+  readProtoArray :: ProtoArray m a -> Int -> m a
+
+  -- | Write the element in the mutable array.
+  writeProtoArray :: ProtoArray m a -> Int -> a -> m ()
+
+  -- | Return a list of the elements.
+  protoArrayToList :: ProtoArray m a -> m [a]
+
+  -- | Create an array by the specified list of elements.
+  protoArrayFromList :: [a] -> m (ProtoArray m a)
+
+  -- | Return the elements of the mutable array in an immutable array.
+  freezeProtoArray :: ProtoArray m a -> m (Array Int a)
+
+instance MArray IOUArray a IO => ProtoArrayMonad IO a where
+
+  newtype ProtoArray IO a = ProtoArray (IOUArray Int a)
+
+  {-# SPECIALISE INLINE protoArrayCount :: MArray IOUArray Double IO => ProtoArray IO Double -> IO Int #-}
+  {-# SPECIALISE INLINE protoArrayCount :: MArray IOUArray Float IO => ProtoArray IO Float -> IO Int #-}
+  {-# SPECIALISE INLINE protoArrayCount :: MArray IOUArray Int IO => ProtoArray IO Int -> IO Int #-}
+  protoArrayCount (ProtoArray a) = do { (0, n') <- getBounds a; return $ n' + 1 }
+
+  {-# SPECIALISE INLINE newProtoArray :: MArray IOUArray Double IO => Session IO -> Int -> Double -> IO (ProtoArray IO Double) #-}
+  {-# SPECIALISE INLINE newProtoArray :: MArray IOUArray Float IO => Session IO -> Int -> Float -> IO (ProtoArray IO Float) #-}
+  {-# SPECIALISE INLINE newProtoArray :: MArray IOUArray Int IO => Session IO -> Int -> Int -> IO (ProtoArray IO Int) #-}
+  newProtoArray s n a = fmap ProtoArray $ newArray (0, n - 1) a
+
+  {-# SPECIALISE INLINE newProtoArray_ :: MArray IOUArray Double IO => Session IO -> Int -> IO (ProtoArray IO Double) #-}
+  {-# SPECIALISE INLINE newProtoArray_ :: MArray IOUArray Float IO => Session IO -> Int -> IO (ProtoArray IO Float) #-}
+  {-# SPECIALISE INLINE newProtoArray_ :: MArray IOUArray Int IO => Session IO -> Int -> IO (ProtoArray IO Int) #-}
+  newProtoArray_ s n = fmap ProtoArray $ newArray_ (0, n - 1)
+
+  {-# SPECIALISE INLINE readProtoArray :: MArray IOUArray Double IO => ProtoArray IO Double -> Int -> IO Double #-}
+  {-# SPECIALISE INLINE readProtoArray :: MArray IOUArray Float IO => ProtoArray IO Float -> Int -> IO Float #-}
+  {-# SPECIALISE INLINE readProtoArray :: MArray IOUArray Int IO => ProtoArray IO Int -> Int -> IO Int #-}
+  readProtoArray (ProtoArray a) = readArray a
+
+  {-# SPECIALISE INLINE writeProtoArray :: MArray IOUArray Double IO => ProtoArray IO Double -> Int -> Double -> IO () #-}
+  {-# SPECIALISE INLINE writeProtoArray :: MArray IOUArray Float IO => ProtoArray IO Float -> Int -> Float -> IO () #-}
+  {-# SPECIALISE INLINE writeProtoArray :: MArray IOUArray Int IO => ProtoArray IO Int -> Int -> Int -> IO () #-}
+  writeProtoArray (ProtoArray a) = writeArray a
+
+  {-# SPECIALISE INLINE protoArrayToList :: MArray IOUArray Double IO => ProtoArray IO Double -> IO [Double] #-}
+  {-# SPECIALISE INLINE protoArrayToList :: MArray IOUArray Float IO => ProtoArray IO Float -> IO [Float] #-}
+  {-# SPECIALISE INLINE protoArrayToList :: MArray IOUArray Int IO => ProtoArray IO Int -> IO [Int] #-}
+  protoArrayToList (ProtoArray a) = getElems a
+
+  {-# SPECIALISE INLINE protoArrayFromList :: MArray IOUArray Double IO => [Double] -> IO (ProtoArray IO Double) #-}
+  {-# SPECIALISE INLINE protoArrayFromList :: MArray IOUArray Float IO => [Float] -> IO (ProtoArray IO Float) #-}
+  {-# SPECIALISE INLINE protoArrayFromList :: MArray IOUArray Int IO => [Int] -> IO (ProtoArray IO Int) #-}
+  protoArrayFromList xs = fmap ProtoArray $ newListArray (0, length xs - 1) xs
+
+  {-# SPECIALISE INLINE freezeProtoArray :: MArray IOUArray Double IO => ProtoArray IO Double -> IO (Array Int Double) #-}
+  {-# SPECIALISE INLINE freezeProtoArray :: MArray IOUArray Float IO => ProtoArray IO Float -> IO (Array Int Float) #-}
+  {-# SPECIALISE INLINE freezeProtoArray :: MArray IOUArray Int IO => ProtoArray IO Int -> IO (Array Int Int) #-}
+  freezeProtoArray (ProtoArray a) = freeze a
+ Simulation/Aivika/Trans/ProtoRef.hs view
@@ -0,0 +1,61 @@+
+{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.ProtoRef
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a prototype of mutable references.
+--
+module Simulation.Aivika.Trans.ProtoRef
+       (ProtoRefMonad(..),
+        ProtoRef(..)) where
+
+import Data.IORef
+
+import Simulation.Aivika.Trans.Session
+
+-- | A monad within which computation we can create and work with
+-- the prototype of mutable reference.
+class (Functor m, Monad m) => ProtoRefMonad m where
+  
+  -- | A prototype of mutable reference.
+  data ProtoRef m :: * -> *
+
+  -- | Create a new ptototype of mutable reference by the specified session and initial value.
+  newProtoRef :: Session m -> a -> m (ProtoRef m a)
+
+  -- | Read the contents of the prototype of mutable reference.
+  readProtoRef :: ProtoRef m a -> m a
+
+  -- | Write a new value in the prototype of mutable reference.
+  writeProtoRef :: ProtoRef m a -> a -> m ()
+
+  -- | Modify a value stored in the prototype of mutable reference.
+  modifyProtoRef :: ProtoRef m a -> (a -> a) -> m ()
+
+  -- | A strict version of 'modifyProtoRef'.
+  modifyProtoRef' :: ProtoRef m a -> (a -> a) -> m ()
+
+instance ProtoRefMonad IO where
+
+  newtype ProtoRef IO a = ProtoRef (IORef a)
+
+  {-# SPECIALIZE INLINE newProtoRef :: Session IO -> a -> IO (ProtoRef IO a) #-}
+  newProtoRef session = fmap ProtoRef . newIORef
+
+  {-# SPECIALIZE INLINE readProtoRef :: ProtoRef IO a -> IO a #-}
+  readProtoRef (ProtoRef x) = readIORef x
+
+  {-# SPECIALIZE INLINE writeProtoRef :: ProtoRef IO a -> a -> IO () #-}
+  writeProtoRef (ProtoRef x) = writeIORef x
+
+  {-# SPECIALIZE INLINE modifyProtoRef :: ProtoRef IO a -> (a -> a) -> IO () #-}
+  modifyProtoRef (ProtoRef x) = modifyIORef x
+
+  {-# SPECIALIZE INLINE modifyProtoRef' :: ProtoRef IO a -> (a -> a) -> IO () #-}
+  modifyProtoRef' (ProtoRef x) = modifyIORef' x
+ Simulation/Aivika/Trans/Queue.hs view
@@ -0,0 +1,1122 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Queue
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines a queue that can use the specified strategies. So, having only
+-- the 'FCFS', 'LCFS', 'SIRO' and 'StaticPriorities' strategies, you can build
+-- 4 x 4 x 4 = 64 different types of the queue, each of them will have its own
+-- behaviour.
+--
+module Simulation.Aivika.Trans.Queue
+       (-- * Queue Types
+        FCFSQueue,
+        LCFSQueue,
+        SIROQueue,
+        PriorityQueue,
+        Queue,
+        -- * Creating Queue
+        newFCFSQueue,
+        newLCFSQueue,
+        newSIROQueue,
+        newPriorityQueue,
+        newQueue,
+        -- * Queue Properties and Activities
+        enqueueStrategy,
+        enqueueStoringStrategy,
+        dequeueStrategy,
+        queueNull,
+        queueFull,
+        queueMaxCount,
+        queueCount,
+        queueCountStats,
+        enqueueCount,
+        enqueueLostCount,
+        enqueueStoreCount,
+        dequeueCount,
+        dequeueExtractCount,
+        queueLoadFactor,
+        enqueueRate,
+        enqueueStoreRate,
+        dequeueRate,
+        dequeueExtractRate,
+        queueWaitTime,
+        queueTotalWaitTime,
+        enqueueWaitTime,
+        dequeueWaitTime,
+        queueRate,
+        -- * Dequeuing and Enqueuing
+        dequeue,
+        dequeueWithOutputPriority,
+        tryDequeue,
+        enqueue,
+        enqueueWithInputPriority,
+        enqueueWithStoringPriority,
+        enqueueWithInputStoringPriorities,
+        tryEnqueue,
+        tryEnqueueWithStoringPriority,
+        enqueueOrLost,
+        enqueueOrLost_,
+        enqueueWithStoringPriorityOrLost,
+        enqueueWithStoringPriorityOrLost_,
+        -- * Awaiting
+        waitWhileFullQueue,
+        -- * Summary
+        queueSummary,
+        -- * Derived Signals for Properties
+        queueNullChanged,
+        queueNullChanged_,
+        queueFullChanged,
+        queueFullChanged_,
+        queueCountChanged,
+        queueCountChanged_,
+        enqueueCountChanged,
+        enqueueCountChanged_,
+        enqueueLostCountChanged,
+        enqueueLostCountChanged_,
+        enqueueStoreCountChanged,
+        enqueueStoreCountChanged_,
+        dequeueCountChanged,
+        dequeueCountChanged_,
+        dequeueExtractCountChanged,
+        dequeueExtractCountChanged_,
+        queueLoadFactorChanged,
+        queueLoadFactorChanged_,
+        queueWaitTimeChanged,
+        queueWaitTimeChanged_,
+        queueTotalWaitTimeChanged,
+        queueTotalWaitTimeChanged_,
+        enqueueWaitTimeChanged,
+        enqueueWaitTimeChanged_,
+        dequeueWaitTimeChanged,
+        dequeueWaitTimeChanged_,
+        queueRateChanged,
+        queueRateChanged_,
+        -- * Basic Signals
+        enqueueInitiated,
+        enqueueStored,
+        enqueueLost,
+        dequeueRequested,
+        dequeueExtracted,
+        -- * Overall Signal
+        queueChanged_) where
+
+import Data.Monoid
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Process
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Statistics
+
+-- | A type synonym for the ordinary FIFO queue also known as the FCFS
+-- (First Come - First Serviced) queue.
+type FCFSQueue m a = Queue m FCFS FCFS FCFS a
+
+-- | A type synonym for the ordinary LIFO queue also known as the LCFS
+-- (Last Come - First Serviced) queue.
+type LCFSQueue m a = Queue m FCFS LCFS FCFS a
+
+-- | A type synonym for the SIRO (Serviced in Random Order) queue.
+type SIROQueue m a = Queue m FCFS SIRO FCFS a
+
+-- | A type synonym for the queue with static priorities applied when
+-- storing the elements in the queue.
+type PriorityQueue m a = Queue m FCFS StaticPriorities FCFS a
+
+-- | Represents a queue using the specified strategies for enqueueing (input), @si@,
+-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes
+-- the type of items stored in the queue. Type @m@ denotes the underlying monad within
+-- which the simulation executes.
+data Queue m si sm so a =
+  Queue { queueMaxCount :: Int,
+          -- ^ The queue capacity.
+          enqueueStrategy :: si,
+          -- ^ The strategy applied to the enqueueing (input) processes when the queue is full.
+          enqueueStoringStrategy :: sm,
+          -- ^ The strategy applied when storing (in memory) items in the queue.
+          dequeueStrategy :: so,
+          -- ^ The strategy applied to the dequeueing (output) processes when the queue is empty.
+          enqueueRes :: Resource m si,
+          queueStore :: StrategyQueue m sm (QueueItem a),
+          dequeueRes :: Resource m so,
+          queueCountRef :: ProtoRef m Int,
+          queueCountStatsRef :: ProtoRef m (TimingStats Int),
+          enqueueCountRef :: ProtoRef m Int,
+          enqueueLostCountRef :: ProtoRef m Int,
+          enqueueStoreCountRef :: ProtoRef m Int,
+          dequeueCountRef :: ProtoRef m Int,
+          dequeueExtractCountRef :: ProtoRef m Int,
+          queueWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          queueTotalWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          enqueueWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          dequeueWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          enqueueInitiatedSource :: SignalSource m a,
+          enqueueLostSource :: SignalSource m a,
+          enqueueStoredSource :: SignalSource m a,
+          dequeueRequestedSource :: SignalSource m (),
+          dequeueExtractedSource :: SignalSource m a }
+
+-- | Stores the item and a time of its enqueuing. 
+data QueueItem a =
+  QueueItem { itemValue :: a,
+              -- ^ Return the item value.
+              itemInputTime :: Double,
+              -- ^ Return the time of enqueuing the item.
+              itemStoringTime :: Double
+              -- ^ Return the time of storing in the queue, or
+              -- @itemInputTime@ before the actual storing when
+              -- the item was just enqueued.
+            }
+  
+-- | Create a new FCFS queue with the specified capacity.  
+newFCFSQueue :: MonadComp m => Int -> Event m (FCFSQueue m a)
+newFCFSQueue = newQueue FCFS FCFS FCFS
+  
+-- | Create a new LCFS queue with the specified capacity.  
+newLCFSQueue :: MonadComp m => Int -> Event m (LCFSQueue m a)  
+newLCFSQueue = newQueue FCFS LCFS FCFS
+  
+-- | Create a new SIRO queue with the specified capacity.  
+newSIROQueue :: MonadComp m => Int -> Event m (SIROQueue m a)  
+newSIROQueue = newQueue FCFS SIRO FCFS
+  
+-- | Create a new priority queue with the specified capacity.  
+newPriorityQueue :: MonadComp m => Int -> Event m (PriorityQueue m a)  
+newPriorityQueue = newQueue FCFS StaticPriorities FCFS
+  
+-- | Create a new queue with the specified strategies and capacity.  
+newQueue :: (MonadComp m,
+             QueueStrategy m si,
+             QueueStrategy m sm,
+             QueueStrategy m so) =>
+            si
+            -- ^ the strategy applied to the enqueueing (input) processes when the queue is full
+            -> sm
+            -- ^ the strategy applied when storing items in the queue
+            -> so
+            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty
+            -> Int
+            -- ^ the queue capacity
+            -> Event m (Queue m si sm so a)  
+newQueue si sm so count =
+  do t  <- liftDynamics time
+     sn <- liftParameter simulationSession
+     i  <- liftComp $ newProtoRef sn 0
+     is <- liftComp $ newProtoRef sn $ returnTimingStats t 0
+     ci <- liftComp $ newProtoRef sn 0
+     cl <- liftComp $ newProtoRef sn 0
+     cm <- liftComp $ newProtoRef sn 0
+     cr <- liftComp $ newProtoRef sn 0
+     co <- liftComp $ newProtoRef sn 0
+     ri <- liftSimulation $ newResourceWithMaxCount si count (Just count)
+     qm <- liftSimulation $ newStrategyQueue sm
+     ro <- liftSimulation $ newResourceWithMaxCount so 0 (Just count)
+     w  <- liftComp $ newProtoRef sn mempty
+     wt <- liftComp $ newProtoRef sn mempty
+     wi <- liftComp $ newProtoRef sn mempty
+     wo <- liftComp $ newProtoRef sn mempty 
+     s1 <- liftSimulation $ newSignalSource
+     s2 <- liftSimulation $ newSignalSource
+     s3 <- liftSimulation $ newSignalSource
+     s4 <- liftSimulation $ newSignalSource
+     s5 <- liftSimulation $ newSignalSource
+     return Queue { queueMaxCount = count,
+                    enqueueStrategy = si,
+                    enqueueStoringStrategy = sm,
+                    dequeueStrategy = so,
+                    enqueueRes = ri,
+                    queueStore = qm,
+                    dequeueRes = ro,
+                    queueCountRef = i,
+                    queueCountStatsRef = is,
+                    enqueueCountRef = ci,
+                    enqueueLostCountRef = cl,
+                    enqueueStoreCountRef = cm,
+                    dequeueCountRef = cr,
+                    dequeueExtractCountRef = co,
+                    queueWaitTimeRef = w,
+                    queueTotalWaitTimeRef = wt,
+                    enqueueWaitTimeRef = wi,
+                    dequeueWaitTimeRef = wo,
+                    enqueueInitiatedSource = s1,
+                    enqueueLostSource = s2,
+                    enqueueStoredSource = s3,
+                    dequeueRequestedSource = s4,
+                    dequeueExtractedSource = s5 }
+  
+-- | Test whether the queue is empty.
+--
+-- See also 'queueNullChanged' and 'queueNullChanged_'.
+queueNull :: MonadComp m => Queue m si sm so a -> Event m Bool
+queueNull q =
+  Event $ \p ->
+  do n <- readProtoRef (queueCountRef q)
+     return (n == 0)
+  
+-- | Signal when the 'queueNull' property value has changed.
+queueNullChanged :: MonadComp m => Queue m si sm so a -> Signal m Bool
+queueNullChanged q =
+  mapSignalM (const $ queueNull q) (queueNullChanged_ q)
+  
+-- | Signal when the 'queueNull' property value has changed.
+queueNullChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueNullChanged_ = queueCountChanged_
+
+-- | Test whether the queue is full.
+--
+-- See also 'queueFullChanged' and 'queueFullChanged_'.
+queueFull :: MonadComp m => Queue m si sm so a -> Event m Bool
+queueFull q =
+  Event $ \p ->
+  do n <- readProtoRef (queueCountRef q)
+     return (n == queueMaxCount q)
+  
+-- | Signal when the 'queueFull' property value has changed.
+queueFullChanged :: MonadComp m => Queue m si sm so a -> Signal m Bool
+queueFullChanged q =
+  mapSignalM (const $ queueFull q) (queueFullChanged_ q)
+  
+-- | Signal when the 'queueFull' property value has changed.
+queueFullChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueFullChanged_ = queueCountChanged_
+
+-- | Return the current queue size.
+--
+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.
+queueCount :: MonadComp m => Queue m si sm so a -> Event m Int
+queueCount q =
+  Event $ \p -> readProtoRef (queueCountRef q)
+
+-- | Return the queue size statistics.
+queueCountStats :: MonadComp m => Queue m si sm so a -> Event m (TimingStats Int)
+queueCountStats q =
+  Event $ \p -> readProtoRef (queueCountStatsRef q)
+  
+-- | Signal when the 'queueCount' property value has changed.
+queueCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+queueCountChanged q =
+  mapSignalM (const $ queueCount q) (queueCountChanged_ q)
+  
+-- | Signal when the 'queueCount' property value has changed.
+queueCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueCountChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return the total number of input items that were enqueued.
+--
+-- See also 'enqueueCountChanged' and 'enqueueCountChanged_'.
+enqueueCount :: MonadComp m => Queue m si sm so a -> Event m Int
+enqueueCount q =
+  Event $ \p -> readProtoRef (enqueueCountRef q)
+  
+-- | Signal when the 'enqueueCount' property value has changed.
+enqueueCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+enqueueCountChanged q =
+  mapSignalM (const $ enqueueCount q) (enqueueCountChanged_ q)
+  
+-- | Signal when the 'enqueueCount' property value has changed.
+enqueueCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+enqueueCountChanged_ q =
+  mapSignal (const ()) (enqueueInitiated q)
+  
+-- | Return the number of lost items.
+--
+-- See also 'enqueueLostCountChanged' and 'enqueueLostCountChanged_'.
+enqueueLostCount :: MonadComp m => Queue m si sm so a -> Event m Int
+enqueueLostCount q =
+  Event $ \p -> readProtoRef (enqueueLostCountRef q)
+  
+-- | Signal when the 'enqueueLostCount' property value has changed.
+enqueueLostCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+enqueueLostCountChanged q =
+  mapSignalM (const $ enqueueLostCount q) (enqueueLostCountChanged_ q)
+  
+-- | Signal when the 'enqueueLostCount' property value has changed.
+enqueueLostCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+enqueueLostCountChanged_ q =
+  mapSignal (const ()) (enqueueLost q)
+      
+-- | Return the total number of input items that were stored.
+--
+-- See also 'enqueueStoreCountChanged' and 'enqueueStoreCountChanged_'.
+enqueueStoreCount :: MonadComp m => Queue m si sm so a -> Event m Int
+enqueueStoreCount q =
+  Event $ \p -> readProtoRef (enqueueStoreCountRef q)
+  
+-- | Signal when the 'enqueueStoreCount' property value has changed.
+enqueueStoreCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+enqueueStoreCountChanged q =
+  mapSignalM (const $ enqueueStoreCount q) (enqueueStoreCountChanged_ q)
+  
+-- | Signal when the 'enqueueStoreCount' property value has changed.
+enqueueStoreCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+enqueueStoreCountChanged_ q =
+  mapSignal (const ()) (enqueueStored q)
+      
+-- | Return the total number of requests for dequeueing the items,
+-- not taking into account the failed attempts to dequeue immediately
+-- without suspension.
+--
+-- See also 'dequeueCountChanged' and 'dequeueCountChanged_'.
+dequeueCount :: MonadComp m => Queue m si sm so a -> Event m Int
+dequeueCount q =
+  Event $ \p -> readProtoRef (dequeueCountRef q)
+      
+-- | Signal when the 'dequeueCount' property value has changed.
+dequeueCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+dequeueCountChanged q =
+  mapSignalM (const $ dequeueCount q) (dequeueCountChanged_ q)
+  
+-- | Signal when the 'dequeueCount' property value has changed.
+dequeueCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+dequeueCountChanged_ q =
+  mapSignal (const ()) (dequeueRequested q)
+      
+-- | Return the total number of output items that were actually dequeued.
+--
+-- See also 'dequeueExtractCountChanged' and 'dequeueExtractCountChanged_'.
+dequeueExtractCount :: MonadComp m => Queue m si sm so a -> Event m Int
+dequeueExtractCount q =
+  Event $ \p -> readProtoRef (dequeueExtractCountRef q)
+      
+-- | Signal when the 'dequeueExtractCount' property value has changed.
+dequeueExtractCountChanged :: MonadComp m => Queue m si sm so a -> Signal m Int
+dequeueExtractCountChanged q =
+  mapSignalM (const $ dequeueExtractCount q) (dequeueExtractCountChanged_ q)
+  
+-- | Signal when the 'dequeueExtractCount' property value has changed.
+dequeueExtractCountChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+dequeueExtractCountChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return the load factor: the queue size divided by its maximum size.
+--
+-- See also 'queueLoadFactorChanged' and 'queueLoadFactorChanged_'.
+queueLoadFactor :: MonadComp m => Queue m si sm so a -> Event m Double
+queueLoadFactor q =
+  Event $ \p ->
+  do x <- readProtoRef (queueCountRef q)
+     let y = queueMaxCount q
+     return (fromIntegral x / fromIntegral y)
+      
+-- | Signal when the 'queueLoadFactor' property value has changed.
+queueLoadFactorChanged :: MonadComp m => Queue m si sm so a -> Signal m Double
+queueLoadFactorChanged q =
+  mapSignalM (const $ queueLoadFactor q) (queueLoadFactorChanged_ q)
+  
+-- | Signal when the 'queueLoadFactor' property value has changed.
+queueLoadFactorChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueLoadFactorChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (dequeueExtracted q)
+      
+-- | Return the rate of the input items that were enqueued: how many items
+-- per time.
+enqueueRate :: MonadComp m => Queue m si sm so a -> Event m Double
+enqueueRate q =
+  Event $ \p ->
+  do x <- readProtoRef (enqueueCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the rate of the items that were stored: how many items
+-- per time.
+enqueueStoreRate :: MonadComp m => Queue m si sm so a -> Event m Double
+enqueueStoreRate q =
+  Event $ \p ->
+  do x <- readProtoRef (enqueueStoreCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the rate of the requests for dequeueing the items: how many requests
+-- per time. It does not include the failed attempts to dequeue immediately
+-- without suspension.
+dequeueRate :: MonadComp m => Queue m si sm so a -> Event m Double
+dequeueRate q =
+  Event $ \p ->
+  do x <- readProtoRef (dequeueCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the rate of the output items that were actually dequeued: how many items
+-- per time.
+dequeueExtractRate :: MonadComp m => Queue m si sm so a -> Event m Double
+dequeueExtractRate q =
+  Event $ \p ->
+  do x <- readProtoRef (dequeueExtractCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the wait time from the time at which the item was stored in the queue to
+-- the time at which it was dequeued.
+--
+-- See also 'queueWaitTimeChanged' and 'queueWaitTimeChanged_'.
+queueWaitTime :: MonadComp m => Queue m si sm so a -> Event m (SamplingStats Double)
+queueWaitTime q =
+  Event $ \p -> readProtoRef (queueWaitTimeRef q)
+      
+-- | Signal when the 'queueWaitTime' property value has changed.
+queueWaitTimeChanged :: MonadComp m => Queue m si sm so a -> Signal m (SamplingStats Double)
+queueWaitTimeChanged q =
+  mapSignalM (const $ queueWaitTime q) (queueWaitTimeChanged_ q)
+  
+-- | Signal when the 'queueWaitTime' property value has changed.
+queueWaitTimeChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueWaitTimeChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+      
+-- | Return the total wait time from the time at which the enqueueing operation
+-- was initiated to the time at which the item was dequeued.
+--
+-- In some sense, @queueTotalWaitTime == queueInputWaitTime + queueWaitTime@.
+--
+-- See also 'queueTotalWaitTimeChanged' and 'queueTotalWaitTimeChanged_'.
+queueTotalWaitTime :: MonadComp m => Queue m si sm so a -> Event m (SamplingStats Double)
+queueTotalWaitTime q =
+  Event $ \p -> readProtoRef (queueTotalWaitTimeRef q)
+      
+-- | Signal when the 'queueTotalWaitTime' property value has changed.
+queueTotalWaitTimeChanged :: MonadComp m => Queue m si sm so a -> Signal m (SamplingStats Double)
+queueTotalWaitTimeChanged q =
+  mapSignalM (const $ queueTotalWaitTime q) (queueTotalWaitTimeChanged_ q)
+  
+-- | Signal when the 'queueTotalWaitTime' property value has changed.
+queueTotalWaitTimeChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueTotalWaitTimeChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+      
+-- | Return the enqueue wait time from the time at which the enqueueing operation
+-- was initiated to the time at which the item was stored in the queue.
+--
+-- See also 'enqueueWaitTimeChanged' and 'enqueueWaitTimeChanged_'.
+enqueueWaitTime :: MonadComp m => Queue m si sm so a -> Event m (SamplingStats Double)
+enqueueWaitTime q =
+  Event $ \p -> readProtoRef (enqueueWaitTimeRef q)
+      
+-- | Signal when the 'enqueueWaitTime' property value has changed.
+enqueueWaitTimeChanged :: MonadComp m => Queue m si sm so a -> Signal m (SamplingStats Double)
+enqueueWaitTimeChanged q =
+  mapSignalM (const $ enqueueWaitTime q) (enqueueWaitTimeChanged_ q)
+  
+-- | Signal when the 'enqueueWaitTime' property value has changed.
+enqueueWaitTimeChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+enqueueWaitTimeChanged_ q =
+  mapSignal (const ()) (enqueueStored q)
+      
+-- | Return the dequeue wait time from the time at which the item was requested
+-- for dequeueing to the time at which it was actually dequeued.
+--
+-- See also 'dequeueWaitTimeChanged' and 'dequeueWaitTimeChanged_'.
+dequeueWaitTime :: MonadComp m => Queue m si sm so a -> Event m (SamplingStats Double)
+dequeueWaitTime q =
+  Event $ \p -> readProtoRef (dequeueWaitTimeRef q)
+      
+-- | Signal when the 'dequeueWaitTime' property value has changed.
+dequeueWaitTimeChanged :: MonadComp m => Queue m si sm so a -> Signal m (SamplingStats Double)
+dequeueWaitTimeChanged q =
+  mapSignalM (const $ dequeueWaitTime q) (dequeueWaitTimeChanged_ q)
+  
+-- | Signal when the 'dequeueWaitTime' property value has changed.
+dequeueWaitTimeChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+dequeueWaitTimeChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return a long-term average queue rate calculated as
+-- the average queue size divided by the average wait time.
+--
+-- This value may be less than the actual arrival rate as the queue is
+-- finite and new arrivals may be locked while the queue remains full.
+--
+-- See also 'queueRateChanged' and 'queueRateChanged_'.
+queueRate :: MonadComp m => Queue m si sm so a -> Event m Double
+queueRate q =
+  Event $ \p ->
+  do x <- readProtoRef (queueCountStatsRef q)
+     y <- readProtoRef (queueWaitTimeRef q)
+     return (timingStatsMean x / samplingStatsMean y) 
+      
+-- | Signal when the 'queueRate' property value has changed.
+queueRateChanged :: MonadComp m => Queue m si sm so a -> Signal m Double
+queueRateChanged q =
+  mapSignalM (const $ queueRate q) (queueRateChanged_ q)
+      
+-- | Signal when the 'queueRate' property value has changed.
+queueRateChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueRateChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Dequeue suspending the process if the queue is empty.
+dequeue :: (MonadComp m,
+            DequeueStrategy m si,
+            DequeueStrategy m sm,
+            EnqueueStrategy m so)
+           => Queue m si sm so a
+           -- ^ the queue
+           -> Process m a
+           -- ^ the dequeued value
+dequeue q =
+  do t <- liftEvent $ dequeueRequest q
+     requestResource (dequeueRes q)
+     liftEvent $ dequeueExtract q t
+  
+-- | Dequeue with the output priority suspending the process if the queue is empty.
+dequeueWithOutputPriority :: (MonadComp m,
+                              DequeueStrategy m si,
+                              DequeueStrategy m sm,
+                              PriorityQueueStrategy m so po)
+                             => Queue m si sm so a
+                             -- ^ the queue
+                             -> po
+                             -- ^ the priority for output
+                             -> Process m a
+                             -- ^ the dequeued value
+dequeueWithOutputPriority q po =
+  do t <- liftEvent $ dequeueRequest q
+     requestResourceWithPriority (dequeueRes q) po
+     liftEvent $ dequeueExtract q t
+  
+-- | Try to dequeue immediately.
+tryDequeue :: (MonadComp m,
+               DequeueStrategy m si,
+               DequeueStrategy m sm)
+              => Queue m si sm so a
+              -- ^ the queue
+              -> Event m (Maybe a)
+              -- ^ the dequeued value of 'Nothing'
+tryDequeue q =
+  do x <- tryRequestResourceWithinEvent (dequeueRes q)
+     if x 
+       then do t <- dequeueRequest q
+               fmap Just $ dequeueExtract q t
+       else return Nothing
+
+-- | Enqueue the item suspending the process if the queue is full.  
+enqueue :: (MonadComp m,
+            EnqueueStrategy m si,
+            EnqueueStrategy m sm,
+            DequeueStrategy m so)
+           => Queue m si sm so a
+           -- ^ the queue
+           -> a
+           -- ^ the item to enqueue
+           -> Process m ()
+enqueue q a =
+  do i <- liftEvent $ enqueueInitiate q a
+     requestResource (enqueueRes q)
+     liftEvent $ enqueueStore q i
+     
+-- | Enqueue with the input priority the item suspending the process if the queue is full.  
+enqueueWithInputPriority :: (MonadComp m,
+                             PriorityQueueStrategy m si pi,
+                             EnqueueStrategy m sm,
+                             DequeueStrategy m so)
+                            => Queue m si sm so a
+                            -- ^ the queue
+                            -> pi
+                            -- ^ the priority for input
+                            -> a
+                            -- ^ the item to enqueue
+                            -> Process m ()
+enqueueWithInputPriority q pi a =
+  do i <- liftEvent $ enqueueInitiate q a
+     requestResourceWithPriority (enqueueRes q) pi
+     liftEvent $ enqueueStore q i
+     
+-- | Enqueue with the storing priority the item suspending the process if the queue is full.  
+enqueueWithStoringPriority :: (MonadComp m,
+                               EnqueueStrategy m si,
+                               PriorityQueueStrategy m sm pm,
+                               DequeueStrategy m so)
+                              => Queue m si sm so a
+                              -- ^ the queue
+                              -> pm
+                              -- ^ the priority for storing
+                              -> a
+                              -- ^ the item to enqueue
+                              -> Process m ()
+enqueueWithStoringPriority q pm a =
+  do i <- liftEvent $ enqueueInitiate q a
+     requestResource (enqueueRes q)
+     liftEvent $ enqueueStoreWithPriority q pm i
+     
+-- | Enqueue with the input and storing priorities the item suspending the process if the queue is full.  
+enqueueWithInputStoringPriorities :: (MonadComp m,
+                                      PriorityQueueStrategy m si pi,
+                                      PriorityQueueStrategy m sm pm,
+                                      DequeueStrategy m so)
+                                     => Queue m si sm so a
+                                     -- ^ the queue
+                                     -> pi
+                                     -- ^ the priority for input
+                                     -> pm
+                                     -- ^ the priority for storing
+                                     -> a
+                                     -- ^ the item to enqueue
+                                     -> Process m ()
+enqueueWithInputStoringPriorities q pi pm a =
+  do i <- liftEvent $ enqueueInitiate q a
+     requestResourceWithPriority (enqueueRes q) pi
+     liftEvent $ enqueueStoreWithPriority q pm i
+     
+-- | Try to enqueue the item. Return 'False' in the monad if the queue is full.
+tryEnqueue :: (MonadComp m,
+               EnqueueStrategy m sm,
+               DequeueStrategy m so)
+              => Queue m si sm so a
+              -- ^ the queue
+              -> a
+              -- ^ the item which we try to enqueue
+              -> Event m Bool
+tryEnqueue q a =
+  do x <- tryRequestResourceWithinEvent (enqueueRes q)
+     if x 
+       then do enqueueInitiate q a >>= enqueueStore q
+               return True
+       else return False
+
+-- | Try to enqueue with the storing priority the item. Return 'False' in
+-- the monad if the queue is full.
+tryEnqueueWithStoringPriority :: (MonadComp m,
+                                  PriorityQueueStrategy m sm pm,
+                                  DequeueStrategy m so)
+                                 => Queue m si sm so a
+                                 -- ^ the queue
+                                 -> pm
+                                 -- ^ the priority for storing
+                                 -> a
+                                 -- ^ the item which we try to enqueue
+                                 -> Event m Bool
+tryEnqueueWithStoringPriority q pm a =
+  do x <- tryRequestResourceWithinEvent (enqueueRes q)
+     if x 
+       then do enqueueInitiate q a >>= enqueueStoreWithPriority q pm
+               return True
+       else return False
+
+-- | Try to enqueue the item. If the queue is full then the item will be lost
+-- and 'False' will be returned.
+enqueueOrLost :: (MonadComp m,
+                  EnqueueStrategy m sm,
+                  DequeueStrategy m so)
+                 => Queue m si sm so a
+                 -- ^ the queue
+                 -> a
+                 -- ^ the item which we try to enqueue
+                 -> Event m Bool
+enqueueOrLost q a =
+  do x <- tryRequestResourceWithinEvent (enqueueRes q)
+     if x
+       then do enqueueInitiate q a >>= enqueueStore q
+               return True
+       else do enqueueDeny q a
+               return False
+
+-- | Try to enqueue with the storing priority the item. If the queue is full
+-- then the item will be lost and 'False' will be returned.
+enqueueWithStoringPriorityOrLost :: (MonadComp m,
+                                     PriorityQueueStrategy m sm pm,
+                                     DequeueStrategy m so)
+                                    => Queue m si sm so a
+                                    -- ^ the queue
+                                    -> pm
+                                    -- ^ the priority for storing
+                                    -> a
+                                    -- ^ the item which we try to enqueue
+                                    -> Event m Bool
+enqueueWithStoringPriorityOrLost q pm a =
+  do x <- tryRequestResourceWithinEvent (enqueueRes q)
+     if x
+       then do enqueueInitiate q a >>= enqueueStoreWithPriority q pm
+               return True
+       else do enqueueDeny q a
+               return False
+
+-- | Try to enqueue the item. If the queue is full then the item will be lost.
+enqueueOrLost_ :: (MonadComp m,
+                   EnqueueStrategy m sm,
+                   DequeueStrategy m so)
+                  => Queue m si sm so a
+                  -- ^ the queue
+                  -> a
+                  -- ^ the item which we try to enqueue
+                  -> Event m ()
+enqueueOrLost_ q a =
+  do x <- enqueueOrLost q a
+     return ()
+
+-- | Try to enqueue with the storing priority the item. If the queue is full
+-- then the item will be lost.
+enqueueWithStoringPriorityOrLost_ :: (MonadComp m,
+                                      PriorityQueueStrategy m sm pm,
+                                      DequeueStrategy m so)
+                                     => Queue m si sm so a
+                                     -- ^ the queue
+                                     -> pm
+                                     -- ^ the priority for storing
+                                     -> a
+                                     -- ^ the item which we try to enqueue
+                                     -> Event m ()
+enqueueWithStoringPriorityOrLost_ q pm a =
+  do x <- enqueueWithStoringPriorityOrLost q pm a
+     return ()
+
+-- | Return a signal that notifies when the enqueuing operation is initiated.
+enqueueInitiated :: MonadComp m => Queue m si sm so a -> Signal m a
+enqueueInitiated q = publishSignal (enqueueInitiatedSource q)
+
+-- | Return a signal that notifies when the enqueuing operation is completed
+-- and the item is stored in the internal memory of the queue.
+enqueueStored :: MonadComp m => Queue m si sm so a -> Signal m a
+enqueueStored q = publishSignal (enqueueStoredSource q)
+
+-- | Return a signal which notifies that the item was lost when 
+-- attempting to add it to the full queue with help of
+-- 'enqueueOrLost', 'enqueueOrLost_' or similar functions that imply
+-- that the element can be lost. All their names are ending with @OrLost@
+-- or @OrLost_@.
+--
+-- In other cases the enqueued items are not lost but the corresponded process
+-- can suspend until the internal queue storage is freed. Although there is one
+-- exception from this rule. If the process trying to enqueue a new element was
+-- suspended but then canceled through 'cancelProcess' from the outside then
+-- the item will not be added.
+enqueueLost :: MonadComp m => Queue m si sm so a -> Signal m a
+enqueueLost q = publishSignal (enqueueLostSource q)
+
+-- | Return a signal that notifies when the dequeuing operation was requested.
+dequeueRequested :: MonadComp m => Queue m si sm so a -> Signal m ()
+dequeueRequested q = publishSignal (dequeueRequestedSource q)
+
+-- | Return a signal that notifies when the item was extracted from the internal
+-- storage of the queue and prepared for immediate receiving by the dequeuing process.
+dequeueExtracted :: MonadComp m => Queue m si sm so a -> Signal m a
+dequeueExtracted q = publishSignal (dequeueExtractedSource q)
+
+-- | Initiate the process of enqueuing the item.
+enqueueInitiate :: MonadComp m
+                   => Queue m si sm so a
+                   -- ^ the queue
+                   -> a
+                   -- ^ the item to be enqueued
+                   -> Event m (QueueItem a)
+enqueueInitiate q a =
+  Event $ \p ->
+  do let t = pointTime p
+     modifyProtoRef' (enqueueCountRef q) (+ 1)
+     invokeEvent p $
+       triggerSignal (enqueueInitiatedSource q) a
+     return QueueItem { itemValue = a,
+                        itemInputTime = t,
+                        itemStoringTime = t  -- it will be updated soon
+                      }
+
+-- | Store the item.
+enqueueStore :: (MonadComp m,
+                 EnqueueStrategy m sm,
+                 DequeueStrategy m so)
+                => Queue m si sm so a
+                -- ^ the queue
+                -> QueueItem a
+                -- ^ the item to be stored
+                -> Event m ()
+enqueueStore q i =
+  Event $ \p ->
+  do let i' = i { itemStoringTime = pointTime p }  -- now we have the actual time of storing
+     invokeEvent p $
+       strategyEnqueue (queueStore q) i'
+     c <- readProtoRef (queueCountRef q)
+     let c' = c + 1
+         t  = pointTime p 
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (enqueueStoreCountRef q) (+ 1)
+     invokeEvent p $
+       enqueueStat q i'
+     invokeEvent p $
+       releaseResourceWithinEvent (dequeueRes q)
+     invokeEvent p $
+       triggerSignal (enqueueStoredSource q) (itemValue i')
+
+-- | Store with the priority the item.
+enqueueStoreWithPriority :: (MonadComp m,
+                             PriorityQueueStrategy m sm pm,
+                             DequeueStrategy m so)
+                            => Queue m si sm so a
+                            -- ^ the queue
+                            -> pm
+                            -- ^ the priority for storing
+                            -> QueueItem a
+                            -- ^ the item to be enqueued
+                            -> Event m ()
+enqueueStoreWithPriority q pm i =
+  Event $ \p ->
+  do let i' = i { itemStoringTime = pointTime p }  -- now we have the actual time of storing
+     invokeEvent p $
+       strategyEnqueueWithPriority (queueStore q) pm i'
+     c <- readProtoRef (queueCountRef q)
+     let c' = c + 1
+         t  = pointTime p
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (enqueueStoreCountRef q) (+ 1)
+     invokeEvent p $
+       enqueueStat q i'
+     invokeEvent p $
+       releaseResourceWithinEvent (dequeueRes q)
+     invokeEvent p $
+       triggerSignal (enqueueStoredSource q) (itemValue i')
+
+-- | Deny the enqueuing.
+enqueueDeny :: MonadComp m
+               => Queue m si sm so a
+               -- ^ the queue
+               -> a
+               -- ^ the item to be denied
+               -> Event m ()
+enqueueDeny q a =
+  Event $ \p ->
+  do modifyProtoRef' (enqueueLostCountRef q) $ (+) 1
+     invokeEvent p $
+       triggerSignal (enqueueLostSource q) a
+
+-- | Update the statistics for the input wait time of the enqueuing operation.
+enqueueStat :: MonadComp m
+               => Queue m si sm so a
+               -- ^ the queue
+               -> QueueItem a
+               -- ^ the item and its input time
+               -> Event m ()
+               -- ^ the action of updating the statistics
+enqueueStat q i =
+  Event $ \p ->
+  do let t0 = itemInputTime i
+         t1 = itemStoringTime i
+     modifyProtoRef' (enqueueWaitTimeRef q) $
+       addSamplingStats (t1 - t0)
+
+-- | Accept the dequeuing request and return the current simulation time.
+dequeueRequest :: MonadComp m
+                  => Queue m si sm so a
+                  -- ^ the queue
+                  -> Event m Double
+                  -- ^ the current time
+dequeueRequest q =
+  Event $ \p ->
+  do modifyProtoRef' (dequeueCountRef q) (+ 1)
+     invokeEvent p $
+       triggerSignal (dequeueRequestedSource q) ()
+     return $ pointTime p 
+
+-- | Extract an item for the dequeuing request.  
+dequeueExtract :: (MonadComp m,
+                   DequeueStrategy m si,
+                   DequeueStrategy m sm)
+                  => Queue m si sm so a
+                  -- ^ the queue
+                  -> Double
+                  -- ^ the time of the dequeuing request
+                  -> Event m a
+                  -- ^ the dequeued value
+dequeueExtract q t' =
+  Event $ \p ->
+  do i <- invokeEvent p $
+          strategyDequeue (queueStore q)
+     c <- readProtoRef (queueCountRef q)
+     let c' = c - 1
+         t  = pointTime p
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (dequeueExtractCountRef q) (+ 1)
+     invokeEvent p $
+       dequeueStat q t' i
+     invokeEvent p $
+       releaseResourceWithinEvent (enqueueRes q)
+     invokeEvent p $
+       triggerSignal (dequeueExtractedSource q) (itemValue i)
+     return $ itemValue i
+
+-- | Update the statistics for the output wait time of the dequeuing operation
+-- and the wait time of storing in the queue.
+dequeueStat :: MonadComp m
+               => Queue m si sm so a
+               -- ^ the queue
+               -> Double
+               -- ^ the time of the dequeuing request
+               -> QueueItem a
+               -- ^ the item and its input time
+               -> Event m ()
+               -- ^ the action of updating the statistics
+dequeueStat q t' i =
+  Event $ \p ->
+  do let t0 = itemInputTime i
+         t1 = itemStoringTime i
+         t  = pointTime p
+     modifyProtoRef' (dequeueWaitTimeRef q) $
+       addSamplingStats (t - t')
+     modifyProtoRef' (queueTotalWaitTimeRef q) $
+       addSamplingStats (t - t0)
+     modifyProtoRef' (queueWaitTimeRef q) $
+       addSamplingStats (t - t1)
+
+-- | Wait while the queue is full.
+waitWhileFullQueue :: MonadComp m => Queue m si sm so a -> Process m ()
+waitWhileFullQueue q =
+  do x <- liftEvent (queueFull q)
+     when x $
+       do processAwait (dequeueExtracted q)
+          waitWhileFullQueue q
+
+-- | Signal whenever any property of the queue changes.
+--
+-- The property must have the corresponded signal. There are also characteristics
+-- similar to the properties but that have no signals. As a rule, such characteristics
+-- already depend on the simulation time and therefore they may change at any
+-- time point.
+queueChanged_ :: MonadComp m => Queue m si sm so a -> Signal m ()
+queueChanged_ q =
+  mapSignal (const ()) (enqueueInitiated q) <>
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (enqueueLost q) <>
+  dequeueRequested q <>
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return the summary for the queue with desciption of its
+-- properties and activities using the specified indent.
+queueSummary :: (MonadComp m, Show si, Show sm, Show so) => Queue m si sm so a -> Int -> Event m ShowS
+queueSummary q indent =
+  do let si = enqueueStrategy q
+         sm = enqueueStoringStrategy q
+         so = dequeueStrategy q
+     null <- queueNull q
+     full <- queueFull q
+     let maxCount = queueMaxCount q
+     count <- queueCount q
+     countStats <- queueCountStats q
+     enqueueCount <- enqueueCount q
+     enqueueLostCount <- enqueueLostCount q
+     enqueueStoreCount <- enqueueStoreCount q
+     dequeueCount <- dequeueCount q
+     dequeueExtractCount <- dequeueExtractCount q
+     loadFactor <- queueLoadFactor q
+     enqueueRate <- enqueueRate q
+     enqueueStoreRate <- enqueueStoreRate q
+     dequeueRate <- dequeueRate q
+     dequeueExtractRate <- dequeueExtractRate q
+     waitTime <- queueWaitTime q
+     totalWaitTime <- queueTotalWaitTime q
+     enqueueWaitTime <- enqueueWaitTime q
+     dequeueWaitTime <- dequeueWaitTime q
+     let tab = replicate indent ' '
+     return $
+       showString tab .
+       showString "the enqueueing (input) strategy = " .
+       shows si .
+       showString "\n" .
+       showString tab .
+       showString "the storing (memory) strategy = " .
+       shows sm .
+       showString "\n" .
+       showString tab .
+       showString "the dequeueing (output) strategy = " .
+       shows so .
+       showString "\n" .
+       showString tab .
+       showString "empty? = " .
+       shows null .
+       showString "\n" .
+       showString tab .
+       showString "full? = " .
+       shows full .
+       showString "\n" .
+       showString tab .
+       showString "max. capacity = " .
+       shows maxCount .
+       showString "\n" .
+       showString tab .
+       showString "size = " .
+       shows count .
+       showString "\n" .
+       showString tab .
+       showString "the size statistics = \n\n" .
+       timingStatsSummary countStats (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the enqueue count (number of the input items that were enqueued) = " .
+       shows enqueueCount .
+       showString "\n" .
+       showString tab .
+       showString "the enqueue lost count (number of the lost items) = " .
+       shows enqueueLostCount .
+       showString "\n" .
+       showString tab .
+       showString "the enqueue store count (number of the input items that were stored) = " .
+       shows enqueueStoreCount .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue count (number of requests for dequeueing an item) = " .
+       shows dequeueCount .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue extract count (number of the output items that were dequeued) = " .
+       shows dequeueExtractCount .
+       showString "\n" .
+       showString tab .
+       showString "the load factor (size / max. capacity) = " .
+       shows loadFactor .
+       showString "\n" .
+       showString tab .
+       showString "the enqueue rate (how many input items were enqueued per time) = " .
+       shows enqueueRate .
+       showString "\n" .
+       showString tab .
+       showString "the enqueue store rate (how many input items were stored per time) = " .
+       shows enqueueStoreRate .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue rate (how many requests for dequeueing per time) = " .
+       shows dequeueRate .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue extract rate (how many output items were dequeued per time) = " .
+       shows dequeueExtractRate .
+       showString "\n" .
+       showString tab .
+       showString "the wait time (when was stored -> when was dequeued) = \n\n" .
+       samplingStatsSummary waitTime (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the total wait time (when the enqueueing was initiated -> when was dequeued) = \n\n" .
+       samplingStatsSummary totalWaitTime (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the enqueue wait time (when the enqueueing was initiated -> when was stored) = \n\n" .
+       samplingStatsSummary enqueueWaitTime (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" .
+       samplingStatsSummary dequeueWaitTime (2 + indent)
+ Simulation/Aivika/Trans/Queue/Infinite.hs view
@@ -0,0 +1,649 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Queue.Infinite
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines an infinite queue that can use the specified strategies.
+--
+module Simulation.Aivika.Trans.Queue.Infinite
+       (-- * Queue Types
+        FCFSQueue,
+        LCFSQueue,
+        SIROQueue,
+        PriorityQueue,
+        Queue,
+        -- * Creating Queue
+        newFCFSQueue,
+        newLCFSQueue,
+        newSIROQueue,
+        newPriorityQueue,
+        newQueue,
+        -- * Queue Properties and Activities
+        enqueueStoringStrategy,
+        dequeueStrategy,
+        queueNull,
+        queueCount,
+        queueCountStats,
+        enqueueStoreCount,
+        dequeueCount,
+        dequeueExtractCount,
+        enqueueStoreRate,
+        dequeueRate,
+        dequeueExtractRate,
+        queueWaitTime,
+        dequeueWaitTime,
+        queueRate,
+        -- * Dequeuing and Enqueuing
+        dequeue,
+        dequeueWithOutputPriority,
+        tryDequeue,
+        enqueue,
+        enqueueWithStoringPriority,
+        -- * Summary
+        queueSummary,
+        -- * Derived Signals for Properties
+        queueNullChanged,
+        queueNullChanged_,
+        queueCountChanged,
+        queueCountChanged_,
+        enqueueStoreCountChanged,
+        enqueueStoreCountChanged_,
+        dequeueCountChanged,
+        dequeueCountChanged_,
+        dequeueExtractCountChanged,
+        dequeueExtractCountChanged_,
+        queueWaitTimeChanged,
+        queueWaitTimeChanged_,
+        dequeueWaitTimeChanged,
+        dequeueWaitTimeChanged_,
+        queueRateChanged,
+        queueRateChanged_,
+        -- * Basic Signals
+        enqueueStored,
+        dequeueRequested,
+        dequeueExtracted,
+        -- * Overall Signal
+        queueChanged_) where
+
+import Data.IORef
+import Data.Monoid
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Process
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Statistics
+
+-- | A type synonym for the ordinary FIFO queue also known as the FCFS
+-- (First Come - First Serviced) queue.
+type FCFSQueue m a = Queue m FCFS FCFS a
+
+-- | A type synonym for the ordinary LIFO queue also known as the LCFS
+-- (Last Come - First Serviced) queue.
+type LCFSQueue m a = Queue m LCFS FCFS a
+
+-- | A type synonym for the SIRO (Serviced in Random Order) queue.
+type SIROQueue m a = Queue m SIRO FCFS a
+
+-- | A type synonym for the queue with static priorities applied when
+-- storing the elements in the queue.
+type PriorityQueue m a = Queue m StaticPriorities FCFS a
+
+-- | Represents an infinite queue using the specified strategies for
+-- internal storing (in memory), @sm@, and dequeueing (output), @so@, where @a@ denotes
+-- the type of items stored in the queue. As usual, type @m@ denotes
+-- the underlying computation within which the simulation executes.
+data Queue m sm so a =
+  Queue { enqueueStoringStrategy :: sm,
+          -- ^ The strategy applied when storing (in memory) items in the queue.
+          dequeueStrategy :: so,
+          -- ^ The strategy applied to the dequeueing (output) processes.
+          queueStore :: StrategyQueue m sm (QueueItem a),
+          dequeueRes :: Resource m so,
+          queueCountRef :: ProtoRef m Int,
+          queueCountStatsRef :: ProtoRef m (TimingStats Int),
+          enqueueStoreCountRef :: ProtoRef m Int,
+          dequeueCountRef :: ProtoRef m Int,
+          dequeueExtractCountRef :: ProtoRef m Int,
+          queueWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          dequeueWaitTimeRef :: ProtoRef m (SamplingStats Double),
+          enqueueStoredSource :: SignalSource m a,
+          dequeueRequestedSource :: SignalSource m (),
+          dequeueExtractedSource :: SignalSource m a }
+
+-- | Stores the item and a time of its enqueuing. 
+data QueueItem a =
+  QueueItem { itemValue :: a,
+              -- ^ Return the item value.
+              itemStoringTime :: Double
+              -- ^ Return the time of storing in the queue.
+            }
+  
+-- | Create a new infinite FCFS queue.  
+newFCFSQueue :: MonadComp m => Event m (FCFSQueue m a)
+newFCFSQueue = newQueue FCFS FCFS
+  
+-- | Create a new infinite LCFS queue.  
+newLCFSQueue :: MonadComp m => Event m (LCFSQueue m a)  
+newLCFSQueue = newQueue LCFS FCFS
+  
+-- | Create a new infinite SIRO queue.  
+newSIROQueue :: MonadComp m => Event m (SIROQueue m a)  
+newSIROQueue = newQueue SIRO FCFS
+  
+-- | Create a new infinite priority queue.  
+newPriorityQueue :: MonadComp m => Event m (PriorityQueue m a)  
+newPriorityQueue = newQueue StaticPriorities FCFS
+  
+-- | Create a new infinite queue with the specified strategies.  
+newQueue :: (MonadComp m,
+             QueueStrategy m sm,
+             QueueStrategy m so) =>
+            sm
+            -- ^ the strategy applied when storing items in the queue
+            -> so
+            -- ^ the strategy applied to the dequeueing (output) processes when the queue is empty
+            -> Event m (Queue m sm so a)  
+newQueue sm so =
+  do t  <- liftDynamics time
+     sn <- liftParameter simulationSession 
+     i  <- liftComp $ newProtoRef sn 0
+     is <- liftComp $ newProtoRef sn $ returnTimingStats t 0
+     cm <- liftComp $ newProtoRef sn 0
+     cr <- liftComp $ newProtoRef sn 0
+     co <- liftComp $ newProtoRef sn 0
+     qm <- liftSimulation $ newStrategyQueue sm
+     ro <- liftSimulation $ newResourceWithMaxCount so 0 Nothing
+     w  <- liftComp $ newProtoRef sn mempty
+     wo <- liftComp $ newProtoRef sn mempty 
+     s3 <- liftSimulation newSignalSource
+     s4 <- liftSimulation newSignalSource
+     s5 <- liftSimulation newSignalSource
+     return Queue { enqueueStoringStrategy = sm,
+                    dequeueStrategy = so,
+                    queueStore = qm,
+                    dequeueRes = ro,
+                    queueCountRef = i,
+                    queueCountStatsRef = is,
+                    enqueueStoreCountRef = cm,
+                    dequeueCountRef = cr,
+                    dequeueExtractCountRef = co,
+                    queueWaitTimeRef = w,
+                    dequeueWaitTimeRef = wo,
+                    enqueueStoredSource = s3,
+                    dequeueRequestedSource = s4,
+                    dequeueExtractedSource = s5 }
+
+-- | Test whether the queue is empty.
+--
+-- See also 'queueNullChanged' and 'queueNullChanged_'.
+queueNull :: MonadComp m => Queue m sm so a -> Event m Bool
+queueNull q =
+  Event $ \p ->
+  do n <- readProtoRef (queueCountRef q)
+     return (n == 0)
+  
+-- | Signal when the 'queueNull' property value has changed.
+queueNullChanged :: MonadComp m => Queue m sm so a -> Signal m Bool
+queueNullChanged q =
+  mapSignalM (const $ queueNull q) (queueNullChanged_ q)
+  
+-- | Signal when the 'queueNull' property value has changed.
+queueNullChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+queueNullChanged_ = queueCountChanged_
+
+-- | Return the current queue size.
+--
+-- See also 'queueCountStats', 'queueCountChanged' and 'queueCountChanged_'.
+queueCount :: MonadComp m => Queue m sm so a -> Event m Int
+queueCount q =
+  Event $ \p -> readProtoRef (queueCountRef q)
+
+-- | Return the queue size statistics.
+queueCountStats :: MonadComp m => Queue m sm so a -> Event m (TimingStats Int)
+queueCountStats q =
+  Event $ \p -> readProtoRef (queueCountStatsRef q)
+  
+-- | Signal when the 'queueCount' property value has changed.
+queueCountChanged :: MonadComp m => Queue m sm so a -> Signal m Int
+queueCountChanged q =
+  mapSignalM (const $ queueCount q) (queueCountChanged_ q)
+  
+-- | Signal when the 'queueCount' property value has changed.
+queueCountChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+queueCountChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (dequeueExtracted q)
+      
+-- | Return the total number of input items that were stored.
+--
+-- See also 'enqueueStoreCountChanged' and 'enqueueStoreCountChanged_'.
+enqueueStoreCount :: MonadComp m => Queue m sm so a -> Event m Int
+enqueueStoreCount q =
+  Event $ \p -> readProtoRef (enqueueStoreCountRef q)
+  
+-- | Signal when the 'enqueueStoreCount' property value has changed.
+enqueueStoreCountChanged :: MonadComp m => Queue m sm so a -> Signal m Int
+enqueueStoreCountChanged q =
+  mapSignalM (const $ enqueueStoreCount q) (enqueueStoreCountChanged_ q)
+  
+-- | Signal when the 'enqueueStoreCount' property value has changed.
+enqueueStoreCountChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+enqueueStoreCountChanged_ q =
+  mapSignal (const ()) (enqueueStored q)
+      
+-- | Return the total number of requests for dequeueing the items,
+-- not taking into account the failed attempts to dequeue immediately
+-- without suspension.
+--
+-- See also 'dequeueCountChanged' and 'dequeueCountChanged_'.
+dequeueCount :: MonadComp m => Queue m sm so a -> Event m Int
+dequeueCount q =
+  Event $ \p -> readProtoRef (dequeueCountRef q)
+      
+-- | Signal when the 'dequeueCount' property value has changed.
+dequeueCountChanged :: MonadComp m => Queue m sm so a -> Signal m Int
+dequeueCountChanged q =
+  mapSignalM (const $ dequeueCount q) (dequeueCountChanged_ q)
+  
+-- | Signal when the 'dequeueCount' property value has changed.
+dequeueCountChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+dequeueCountChanged_ q =
+  mapSignal (const ()) (dequeueRequested q)
+      
+-- | Return the total number of output items that were actually dequeued.
+--
+-- See also 'dequeueExtractCountChanged' and 'dequeueExtractCountChanged_'.
+dequeueExtractCount :: MonadComp m => Queue m sm so a -> Event m Int
+dequeueExtractCount q =
+  Event $ \p -> readProtoRef (dequeueExtractCountRef q)
+      
+-- | Signal when the 'dequeueExtractCount' property value has changed.
+dequeueExtractCountChanged :: MonadComp m => Queue m sm so a -> Signal m Int
+dequeueExtractCountChanged q =
+  mapSignalM (const $ dequeueExtractCount q) (dequeueExtractCountChanged_ q)
+  
+-- | Signal when the 'dequeueExtractCount' property value has changed.
+dequeueExtractCountChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+dequeueExtractCountChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return the rate of the items that were stored: how many items
+-- per time.
+enqueueStoreRate :: MonadComp m => Queue m sm so a -> Event m Double
+enqueueStoreRate q =
+  Event $ \p ->
+  do x <- readProtoRef (enqueueStoreCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the rate of the requests for dequeueing the items: how many requests
+-- per time. It does not include the failed attempts to dequeue immediately
+-- without suspension.
+dequeueRate :: MonadComp m => Queue m sm so a -> Event m Double
+dequeueRate q =
+  Event $ \p ->
+  do x <- readProtoRef (dequeueCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the rate of the output items that were dequeued: how many items
+-- per time.
+dequeueExtractRate :: MonadComp m => Queue m sm so a -> Event m Double
+dequeueExtractRate q =
+  Event $ \p ->
+  do x <- readProtoRef (dequeueExtractCountRef q)
+     let t0 = spcStartTime $ pointSpecs p
+         t  = pointTime p
+     return (fromIntegral x / (t - t0))
+      
+-- | Return the wait time from the time at which the item was stored in the queue to
+-- the time at which it was dequeued.
+--
+-- See also 'queueWaitTimeChanged' and 'queueWaitTimeChanged_'.
+queueWaitTime :: MonadComp m => Queue m sm so a -> Event m (SamplingStats Double)
+queueWaitTime q =
+  Event $ \p -> readProtoRef (queueWaitTimeRef q)
+      
+-- | Signal when the 'queueWaitTime' property value has changed.
+queueWaitTimeChanged :: MonadComp m => Queue m sm so a -> Signal m (SamplingStats Double)
+queueWaitTimeChanged q =
+  mapSignalM (const $ queueWaitTime q) (queueWaitTimeChanged_ q)
+  
+-- | Signal when the 'queueWaitTime' property value has changed.
+queueWaitTimeChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+queueWaitTimeChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+      
+-- | Return the dequeue wait time from the time at which the item was requested
+-- for dequeueing to the time at which it was actually dequeued.
+--
+-- See also 'dequeueWaitTimeChanged' and 'dequeueWaitTimeChanged_'.
+dequeueWaitTime :: MonadComp m => Queue m sm so a -> Event m (SamplingStats Double)
+dequeueWaitTime q =
+  Event $ \p -> readProtoRef (dequeueWaitTimeRef q)
+      
+-- | Signal when the 'dequeueWaitTime' property value has changed.
+dequeueWaitTimeChanged :: MonadComp m => Queue m sm so a -> Signal m (SamplingStats Double)
+dequeueWaitTimeChanged q =
+  mapSignalM (const $ dequeueWaitTime q) (dequeueWaitTimeChanged_ q)
+  
+-- | Signal when the 'dequeueWaitTime' property value has changed.
+dequeueWaitTimeChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+dequeueWaitTimeChanged_ q =
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return a long-term average queue rate calculated as
+-- the average queue size divided by the average wait time.
+--
+-- See also 'queueRateChanged' and 'queueRateChanged_'.
+queueRate :: MonadComp m => Queue m sm so a -> Event m Double
+queueRate q =
+  Event $ \p ->
+  do x <- readProtoRef (queueCountStatsRef q)
+     y <- readProtoRef (queueWaitTimeRef q)
+     return (timingStatsMean x / samplingStatsMean y) 
+
+-- | Signal when the 'queueRate' property value has changed.
+queueRateChanged :: MonadComp m => Queue m sm so a -> Signal m Double
+queueRateChanged q =
+  mapSignalM (const $ queueRate q) (queueRateChanged_ q)
+
+-- | Signal when the 'queueRate' property value has changed.
+queueRateChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+queueRateChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  mapSignal (const ()) (dequeueExtracted q)
+  
+-- | Dequeue suspending the process if the queue is empty.
+dequeue :: (MonadComp m,
+            DequeueStrategy m sm,
+            EnqueueStrategy m so)
+           => Queue m sm so a
+           -- ^ the queue
+           -> Process m a
+           -- ^ the dequeued value
+dequeue q =
+  do t <- liftEvent $ dequeueRequest q
+     requestResource (dequeueRes q)
+     liftEvent $ dequeueExtract q t
+  
+-- | Dequeue with the output priority suspending the process if the queue is empty.
+dequeueWithOutputPriority :: (MonadComp m,
+                              DequeueStrategy m sm,
+                              PriorityQueueStrategy m so po)
+                             => Queue m sm so a
+                             -- ^ the queue
+                             -> po
+                             -- ^ the priority for output
+                             -> Process m a
+                             -- ^ the dequeued value
+dequeueWithOutputPriority q po =
+  do t <- liftEvent $ dequeueRequest q
+     requestResourceWithPriority (dequeueRes q) po
+     liftEvent $ dequeueExtract q t
+  
+-- | Try to dequeue immediately.
+tryDequeue :: (MonadComp m, DequeueStrategy m sm)
+              => Queue m sm so a
+              -- ^ the queue
+              -> Event m (Maybe a)
+              -- ^ the dequeued value of 'Nothing'
+tryDequeue q =
+  do x <- tryRequestResourceWithinEvent (dequeueRes q)
+     if x 
+       then do t <- dequeueRequest q
+               fmap Just $ dequeueExtract q t
+       else return Nothing
+
+-- | Enqueue the item.  
+enqueue :: (MonadComp m,
+            EnqueueStrategy m sm,
+            DequeueStrategy m so)
+           => Queue m sm so a
+           -- ^ the queue
+           -> a
+           -- ^ the item to enqueue
+           -> Event m ()
+enqueue = enqueueStore
+     
+-- | Enqueue with the storing priority the item.  
+enqueueWithStoringPriority :: (MonadComp m,
+                               PriorityQueueStrategy m sm pm,
+                               DequeueStrategy m so)
+                              => Queue m sm so a
+                              -- ^ the queue
+                              -> pm
+                              -- ^ the priority for storing
+                              -> a
+                              -- ^ the item to enqueue
+                              -> Event m ()
+enqueueWithStoringPriority = enqueueStoreWithPriority
+
+-- | Return a signal that notifies when the enqueued item
+-- is stored in the internal memory of the queue.
+enqueueStored :: MonadComp m => Queue m sm so a -> Signal m a
+enqueueStored q = publishSignal (enqueueStoredSource q)
+
+-- | Return a signal that notifies when the dequeuing operation was requested.
+dequeueRequested :: MonadComp m => Queue m sm so a -> Signal m ()
+dequeueRequested q = publishSignal (dequeueRequestedSource q)
+
+-- | Return a signal that notifies when the item was extracted from the internal
+-- storage of the queue and prepared for immediate receiving by the dequeuing process.
+dequeueExtracted :: MonadComp m => Queue m sm so a -> Signal m a
+dequeueExtracted q = publishSignal (dequeueExtractedSource q)
+
+-- | Store the item.
+enqueueStore :: (MonadComp m,
+                 EnqueueStrategy m sm,
+                 DequeueStrategy m so)
+                => Queue m sm so a
+                -- ^ the queue
+                -> a
+                -- ^ the item to be stored
+                -> Event m ()
+enqueueStore q a =
+  Event $ \p ->
+  do let i = QueueItem { itemValue = a,
+                         itemStoringTime = pointTime p }
+     invokeEvent p $
+       strategyEnqueue (queueStore q) i
+     c <- readProtoRef (queueCountRef q)
+     let c' = c + 1
+         t  = pointTime p
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (enqueueStoreCountRef q) (+ 1)
+     invokeEvent p $
+       releaseResourceWithinEvent (dequeueRes q)
+     invokeEvent p $
+       triggerSignal (enqueueStoredSource q) (itemValue i)
+
+-- | Store with the priority the item.
+enqueueStoreWithPriority :: (MonadComp m,
+                             PriorityQueueStrategy m sm pm,
+                             DequeueStrategy m so)
+                            => Queue m sm so a
+                            -- ^ the queue
+                            -> pm
+                            -- ^ the priority for storing
+                            -> a
+                            -- ^ the item to be enqueued
+                            -> Event m ()
+enqueueStoreWithPriority q pm a =
+  Event $ \p ->
+  do let i = QueueItem { itemValue = a,
+                         itemStoringTime = pointTime p }
+     invokeEvent p $
+       strategyEnqueueWithPriority (queueStore q) pm i
+     c <- readProtoRef (queueCountRef q)
+     let c' = c + 1
+         t  = pointTime p
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (enqueueStoreCountRef q) (+ 1)
+     invokeEvent p $
+       releaseResourceWithinEvent (dequeueRes q)
+     invokeEvent p $
+       triggerSignal (enqueueStoredSource q) (itemValue i)
+
+-- | Accept the dequeuing request and return the current simulation time.
+dequeueRequest :: MonadComp m
+                  => Queue m sm so a
+                  -- ^ the queue
+                  -> Event m Double
+                  -- ^ the current time
+dequeueRequest q =
+  Event $ \p ->
+  do modifyProtoRef' (dequeueCountRef q) (+ 1)
+     invokeEvent p $
+       triggerSignal (dequeueRequestedSource q) ()
+     return $ pointTime p 
+
+-- | Extract an item for the dequeuing request.  
+dequeueExtract :: (MonadComp m, DequeueStrategy m sm)
+                  => Queue m sm so a
+                  -- ^ the queue
+                  -> Double
+                  -- ^ the time of the dequeuing request
+                  -> Event m a
+                  -- ^ the dequeued value
+dequeueExtract q t' =
+  Event $ \p ->
+  do i <- invokeEvent p $
+          strategyDequeue (queueStore q)
+     c <- readProtoRef (queueCountRef q)
+     let c' = c - 1
+         t  = pointTime p
+     c' `seq` writeProtoRef (queueCountRef q) c'
+     modifyProtoRef' (queueCountStatsRef q) (addTimingStats t c')
+     modifyProtoRef' (dequeueExtractCountRef q) (+ 1)
+     invokeEvent p $
+       dequeueStat q t' i
+     invokeEvent p $
+       triggerSignal (dequeueExtractedSource q) (itemValue i)
+     return $ itemValue i
+
+-- | Update the statistics for the output wait time of the dequeuing operation
+-- and the wait time of storing in the queue.
+dequeueStat :: MonadComp m
+               => Queue m sm so a
+               -- ^ the queue
+               -> Double
+               -- ^ the time of the dequeuing request
+               -> QueueItem a
+               -- ^ the item and its input time
+               -> Event m ()
+               -- ^ the action of updating the statistics
+dequeueStat q t' i =
+  Event $ \p ->
+  do let t1 = itemStoringTime i
+         t  = pointTime p
+     modifyProtoRef' (dequeueWaitTimeRef q) $
+       addSamplingStats (t - t')
+     modifyProtoRef' (queueWaitTimeRef q) $
+       addSamplingStats (t - t1)
+
+-- | Signal whenever any property of the queue changes.
+--
+-- The property must have the corresponded signal. There are also characteristics
+-- similar to the properties but that have no signals. As a rule, such characteristics
+-- already depend on the simulation time and therefore they may change at any
+-- time point.
+queueChanged_ :: MonadComp m => Queue m sm so a -> Signal m ()
+queueChanged_ q =
+  mapSignal (const ()) (enqueueStored q) <>
+  dequeueRequested q <>
+  mapSignal (const ()) (dequeueExtracted q)
+
+-- | Return the summary for the queue with desciption of its
+-- properties and activities using the specified indent.
+queueSummary :: (MonadComp m, Show sm, Show so) => Queue m sm so a -> Int -> Event m ShowS
+queueSummary q indent =
+  do let sm = enqueueStoringStrategy q
+         so = dequeueStrategy q
+     null <- queueNull q
+     count <- queueCount q
+     countStats <- queueCountStats q
+     enqueueStoreCount <- enqueueStoreCount q
+     dequeueCount <- dequeueCount q
+     dequeueExtractCount <- dequeueExtractCount q
+     enqueueStoreRate <- enqueueStoreRate q
+     dequeueRate <- dequeueRate q
+     dequeueExtractRate <- dequeueExtractRate q
+     waitTime <- queueWaitTime q
+     dequeueWaitTime <- dequeueWaitTime q
+     let tab = replicate indent ' '
+     return $
+       showString tab .
+       showString "the storing (memory) strategy = " .
+       shows sm .
+       showString "\n" .
+       showString tab .
+       showString "the dequeueing (output) strategy = " .
+       shows so .
+       showString "\n" .
+       showString tab .
+       showString "empty? = " .
+       shows null .
+       showString "\n" .
+       showString tab .
+       showString "the current size = " .
+       shows count .
+       showString "\n" .
+       showString tab .
+       showString "the size statistics = \n\n" .
+       timingStatsSummary countStats (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the enqueue store count (number of the input items that were stored) = " .
+       shows enqueueStoreCount .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue count (number of requests for dequeueing an item) = " .
+       shows dequeueCount .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue extract count (number of the output items that were dequeued) = " .
+       shows dequeueExtractCount .
+       showString "\n" .
+       showString tab .
+       showString "the enqueue store rate (how many input items were stored per time) = " .
+       shows enqueueStoreRate .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue rate (how many requests for dequeueing per time) = " .
+       shows dequeueRate .
+       showString "\n" .
+       showString tab .
+       showString "the dequeue extract rate (how many output items were dequeued per time) = " .
+       shows dequeueExtractRate .
+       showString "\n" .
+       showString tab .
+       showString "the wait time (when was stored -> when was dequeued) = \n\n" .
+       samplingStatsSummary waitTime (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" .
+       samplingStatsSummary dequeueWaitTime (2 + indent)
+ Simulation/Aivika/Trans/QueueStrategy.hs view
@@ -0,0 +1,202 @@+
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, FunctionalDependencies, UndecidableInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.QueueStrategy
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the queue strategies.
+--
+module Simulation.Aivika.Trans.QueueStrategy where
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Comp.Template
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Parameter.Random
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Event
+
+import qualified Simulation.Aivika.Trans.DoubleLinkedList as LL
+import qualified Simulation.Aivika.Trans.PriorityQueue as PQ
+import qualified Simulation.Aivika.Trans.Vector as V
+
+-- | Defines the basic queue strategy.
+class MonadComp m => QueueStrategy m s where
+
+  -- | The strategy queue.
+  data StrategyQueue m s :: * -> *
+
+  -- | Create a new queue by the specified strategy.
+  newStrategyQueue :: s
+                      -- ^ the strategy
+                      -> Simulation m (StrategyQueue m s a)
+                      -- ^ a new queue
+
+  -- | Test whether the queue is empty.
+  strategyQueueNull :: StrategyQueue m s a
+                       -- ^ the queue
+                       -> Event m Bool
+                       -- ^ the result of the test
+
+-- | Defines a strategy with support of the dequeuing operation.
+class QueueStrategy m s => DequeueStrategy m s where
+
+  -- | Dequeue the front element and return it.
+  strategyDequeue :: StrategyQueue m s a
+                     -- ^ the queue
+                     -> Event m a
+                     -- ^ the dequeued element
+
+-- | It defines a strategy when we can enqueue a single element.
+class DequeueStrategy m s => EnqueueStrategy m s where
+
+  -- | Enqueue an element.
+  strategyEnqueue :: StrategyQueue m s a
+                     -- ^ the queue
+                     -> a
+                     -- ^ the element to be enqueued
+                     -> Event m ()
+                     -- ^ the action of enqueuing
+
+-- | It defines a strategy when we can enqueue an element with the specified priority.
+class DequeueStrategy m s => PriorityQueueStrategy m s p | s -> p where
+
+  -- | Enqueue an element with the specified priority.
+  strategyEnqueueWithPriority :: StrategyQueue m s a
+                                 -- ^ the queue
+                                 -> p
+                                 -- ^ the priority
+                                 -> a
+                                 -- ^ the element to be enqueued
+                                 -> Event m ()
+                                 -- ^ the action of enqueuing
+
+-- | Strategy: First Come - First Served (FCFS).
+data FCFS = FCFS deriving (Eq, Ord, Show)
+
+-- | Strategy: Last Come - First Served (LCFS)
+data LCFS = LCFS deriving (Eq, Ord, Show)
+
+-- | Strategy: Service in Random Order (SIRO).
+data SIRO = SIRO deriving (Eq, Ord, Show)
+
+-- | Strategy: Static Priorities. It uses the priority queue.
+data StaticPriorities = StaticPriorities deriving (Eq, Ord, Show)
+
+-- | An implementation of the 'FCFS' queue strategy.
+instance MonadComp m => QueueStrategy m FCFS where
+
+  -- | A queue used by the 'FCFS' strategy.
+  newtype StrategyQueue m FCFS a = FCFSQueue (LL.DoubleLinkedList m a)
+
+  newStrategyQueue s =
+    fmap FCFSQueue $
+    do session <- liftParameter simulationSession
+       liftComp $ LL.newList session
+
+  strategyQueueNull (FCFSQueue q) = liftComp $ LL.listNull q
+
+-- | An implementation of the 'FCFS' queue strategy.
+instance QueueStrategy m FCFS => DequeueStrategy m FCFS where
+
+  strategyDequeue (FCFSQueue q) =
+    liftComp $
+    do i <- LL.listFirst q
+       LL.listRemoveFirst q
+       return i
+
+-- | An implementation of the 'FCFS' queue strategy.
+instance DequeueStrategy m FCFS => EnqueueStrategy m FCFS where
+
+  strategyEnqueue (FCFSQueue q) i = liftComp $ LL.listAddLast q i
+
+-- | An implementation of the 'LCFS' queue strategy.
+instance MonadComp m => QueueStrategy m LCFS where
+
+  -- | A queue used by the 'LCFS' strategy.
+  newtype StrategyQueue m LCFS a = LCFSQueue (LL.DoubleLinkedList m a)
+
+  newStrategyQueue s =
+    fmap LCFSQueue $
+    do session <- liftParameter simulationSession
+       liftComp $ LL.newList session
+       
+  strategyQueueNull (LCFSQueue q) = liftComp $ LL.listNull q
+
+-- | An implementation of the 'LCFS' queue strategy.
+instance QueueStrategy m LCFS => DequeueStrategy m LCFS where
+
+  strategyDequeue (LCFSQueue q) =
+    liftComp $
+    do i <- LL.listFirst q
+       LL.listRemoveFirst q
+       return i
+
+-- | An implementation of the 'LCFS' queue strategy.
+instance DequeueStrategy m LCFS => EnqueueStrategy m LCFS where
+
+  strategyEnqueue (LCFSQueue q) i = liftComp $ LL.listInsertFirst q i
+
+-- | An implementation of the 'StaticPriorities' queue strategy.
+instance MonadComp m => QueueStrategy m StaticPriorities where
+
+  -- | A queue used by the 'StaticPriorities' strategy.
+  newtype StrategyQueue m StaticPriorities a = StaticPriorityQueue (PQ.PriorityQueue m a)
+
+  newStrategyQueue s =
+    fmap StaticPriorityQueue $
+    do session <- liftParameter simulationSession
+       liftComp $ PQ.newQueue session
+
+  strategyQueueNull (StaticPriorityQueue q) = liftComp $ PQ.queueNull q
+
+-- | An implementation of the 'StaticPriorities' queue strategy.
+instance QueueStrategy m StaticPriorities => DequeueStrategy m StaticPriorities where
+
+  strategyDequeue (StaticPriorityQueue q) =
+    liftComp $
+    do (_, i) <- PQ.queueFront q
+       PQ.dequeue q
+       return i
+
+-- | An implementation of the 'StaticPriorities' queue strategy.
+instance DequeueStrategy m StaticPriorities => PriorityQueueStrategy m StaticPriorities Double where
+
+  strategyEnqueueWithPriority (StaticPriorityQueue q) p i = liftComp $ PQ.enqueue q p i
+
+-- | An implementation of the 'SIRO' queue strategy.
+instance MonadComp m => QueueStrategy m SIRO where
+
+  -- | A queue used by the 'SIRO' strategy.
+  newtype StrategyQueue m SIRO a = SIROQueue (V.Vector m a)
+  
+  newStrategyQueue s =
+    fmap SIROQueue $
+    do session <- liftParameter simulationSession
+       liftComp $ V.newVector session
+
+  strategyQueueNull (SIROQueue q) =
+    liftComp $
+    do n <- V.vectorCount q
+       return (n == 0)
+
+-- | An implementation of the 'SIRO' queue strategy.
+instance QueueStrategy m SIRO => DequeueStrategy m SIRO where
+
+  strategyDequeue (SIROQueue q) =
+    do n <- liftComp $ V.vectorCount q
+       i <- liftParameter $ randomUniformInt 0 (n - 1)
+       x <- liftComp $ V.readVector q i
+       liftComp $ V.vectorDeleteAt q i
+       return x
+
+-- | An implementation of the 'SIRO' queue strategy.
+instance DequeueStrategy m SIRO => EnqueueStrategy m SIRO where
+
+  strategyEnqueue (SIROQueue q) i = liftComp $ V.appendVector q i
+ Simulation/Aivika/Trans/Ref.hs view
@@ -0,0 +1,76 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Ref
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines an updatable reference that depends on the event queue.
+--
+module Simulation.Aivika.Trans.Ref
+       (Ref,
+        refChanged,
+        refChanged_,
+        newRef,
+        readRef,
+        writeRef,
+        modifyRef) where
+
+import Data.IORef
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Signal
+
+-- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable 
+-- but only dependent on the event queue, which allows synchronizing the reference
+-- with the model explicitly through the 'Event' monad.
+data Ref m a = 
+  Ref { refValue :: ProtoRef m a, 
+        refChangedSource :: SignalSource m a }
+
+-- | Create a new reference.
+newRef :: MonadComp m => a -> Simulation m (Ref m a)
+newRef a =
+  Simulation $ \r ->
+  do let s = runSession r
+     x <- newProtoRef s a
+     s <- invokeSimulation r newSignalSource
+     return Ref { refValue = x, 
+                  refChangedSource = s }
+     
+-- | Read the value of a reference.
+readRef :: MonadComp m => Ref m a -> Event m a
+readRef r = Event $ \p -> readProtoRef (refValue r)
+
+-- | Write a new value into the reference.
+writeRef :: MonadComp m => Ref m a -> a -> Event m ()
+writeRef r a = Event $ \p -> 
+  do a `seq` writeProtoRef (refValue r) a
+     invokeEvent p $ triggerSignal (refChangedSource r) a
+
+-- | Mutate the contents of the reference.
+modifyRef :: MonadComp m => Ref m a -> (a -> a) -> Event m ()
+modifyRef r f = Event $ \p -> 
+  do a <- readProtoRef (refValue r)
+     let b = f a
+     b `seq` writeProtoRef (refValue r) b
+     invokeEvent p $ triggerSignal (refChangedSource r) b
+
+-- | Return a signal that notifies about every change of the reference state.
+refChanged :: MonadComp m => Ref m a -> Signal m a
+refChanged v = publishSignal (refChangedSource v)
+
+-- | Return a signal that notifies about every change of the reference state.
+refChanged_ :: MonadComp m => Ref m a -> Signal m ()
+refChanged_ r = mapSignal (const ()) $ refChanged r
+ Simulation/Aivika/Trans/Ref/Plain.hs view
@@ -0,0 +1,60 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Ref.Plain
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines a plain and more fast version of an updatable reference
+-- that depends on the event queue but that doesn't supply with the signal notification.
+--
+module Simulation.Aivika.Trans.Ref.Plain
+       (Ref,
+        newRef,
+        readRef,
+        writeRef,
+        modifyRef) where
+
+import Data.IORef
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Event
+
+-- | The 'Ref' type represents a mutable variable similar to the 'IORef' variable 
+-- but only dependent on the event queue, which allows synchronizing the reference
+-- with the model explicitly through the 'Event' monad.
+newtype Ref m a = 
+  Ref { refValue :: ProtoRef m a }
+
+-- | Create a new reference.
+newRef :: MonadComp m => a -> Simulation m (Ref m a)
+newRef a =
+  Simulation $ \r ->
+  do let s = runSession r
+     x <- newProtoRef s a
+     return Ref { refValue = x }
+     
+-- | Read the value of a reference.
+readRef :: MonadComp m => Ref m a -> Event m a
+readRef r = Event $ \p -> readProtoRef (refValue r)
+
+-- | Write a new value into the reference.
+writeRef :: MonadComp m => Ref m a -> a -> Event m ()
+writeRef r a = Event $ \p -> 
+  a `seq` writeProtoRef (refValue r) a
+
+-- | Mutate the contents of the reference.
+modifyRef :: MonadComp m => Ref m a -> (a -> a) -> Event m ()
+modifyRef r f = Event $ \p -> 
+  do a <- readProtoRef (refValue r)
+     let b = f a
+     b `seq` writeProtoRef (refValue r) b
+ Simulation/Aivika/Trans/Resource.hs view
@@ -0,0 +1,347 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Resource
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the resource which can be acquired and 
+-- then released by the discontinuous process 'Process'.
+-- The resource can be either limited by the upper bound
+-- (run-time check), or it can have no upper bound. The latter
+-- is useful for modeling the infinite queue, for example.
+--
+module Simulation.Aivika.Trans.Resource
+       (-- * Resource Types
+        FCFSResource,
+        LCFSResource,
+        SIROResource,
+        PriorityResource,
+        Resource,
+        -- * Creating Resource
+        newFCFSResource,
+        newFCFSResourceWithMaxCount,
+        newLCFSResource,
+        newLCFSResourceWithMaxCount,
+        newSIROResource,
+        newSIROResourceWithMaxCount,
+        newPriorityResource,
+        newPriorityResourceWithMaxCount,
+        newResource,
+        newResourceWithMaxCount,
+        -- * Resource Properties
+        resourceStrategy,
+        resourceMaxCount,
+        resourceCount,
+        -- * Requesting for and Releasing Resource
+        requestResource,
+        requestResourceWithPriority,
+        tryRequestResourceWithinEvent,
+        releaseResource,
+        releaseResourceWithinEvent,
+        usingResource,
+        usingResourceWithPriority) where
+
+import Control.Monad
+import Control.Monad.Trans
+import Control.Exception
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Cont
+import Simulation.Aivika.Trans.Internal.Process
+import Simulation.Aivika.Trans.QueueStrategy
+
+import qualified Simulation.Aivika.Trans.DoubleLinkedList as DLL 
+import qualified Simulation.Aivika.Trans.Vector as V
+import qualified Simulation.Aivika.Trans.PriorityQueue as PQ
+
+-- | The ordinary FCFS (First Come - First Serviced) resource.
+type FCFSResource m = Resource m FCFS
+
+-- | The ordinary LCFS (Last Come - First Serviced) resource.
+type LCFSResource m = Resource m LCFS
+
+-- | The SIRO (Serviced in Random Order) resource.
+type SIROResource m = Resource m SIRO
+
+-- | The resource with static priorities.
+type PriorityResource m = Resource m StaticPriorities
+
+-- | Represents the resource with strategy @s@ applied for queuing the requests.
+data Resource m s = 
+  Resource { resourceStrategy :: s,
+             -- ^ Return the strategy applied for queuing the requests.
+             resourceMaxCount :: Maybe Int,
+             -- ^ Return the maximum count of the resource, where 'Nothing'
+             -- means that the resource has no upper bound.
+             resourceCountRef :: ProtoRef m Int, 
+             resourceWaitList :: StrategyQueue m s (Event m (Maybe (ContParams m ()))) }
+
+-- | Create a new FCFS resource with the specified initial count which value becomes
+-- the upper bound as well.
+newFCFSResource :: MonadComp m
+                   => Int
+                   -- ^ the initial count (and maximal count too) of the resource
+                   -> Simulation m (FCFSResource m)
+newFCFSResource = newResource FCFS
+
+-- | Create a new FCFS resource with the specified initial and maximum counts,
+-- where 'Nothing' means that the resource has no upper bound.
+newFCFSResourceWithMaxCount :: MonadComp m
+                               => Int
+                               -- ^ the initial count of the resource
+                               -> Maybe Int
+                               -- ^ the maximum count of the resource, which can be indefinite
+                               -> Simulation m (FCFSResource m)
+newFCFSResourceWithMaxCount = newResourceWithMaxCount FCFS
+
+-- | Create a new LCFS resource with the specified initial count which value becomes
+-- the upper bound as well.
+newLCFSResource :: MonadComp m
+                   => Int
+                   -- ^ the initial count (and maximal count too) of the resource
+                   -> Simulation m (LCFSResource m)
+newLCFSResource = newResource LCFS
+
+-- | Create a new LCFS resource with the specified initial and maximum counts,
+-- where 'Nothing' means that the resource has no upper bound.
+newLCFSResourceWithMaxCount :: MonadComp m
+                               => Int
+                               -- ^ the initial count of the resource
+                               -> Maybe Int
+                               -- ^ the maximum count of the resource, which can be indefinite
+                               -> Simulation m (LCFSResource m)
+newLCFSResourceWithMaxCount = newResourceWithMaxCount LCFS
+
+-- | Create a new SIRO resource with the specified initial count which value becomes
+-- the upper bound as well.
+newSIROResource :: MonadComp m
+                   => Int
+                   -- ^ the initial count (and maximal count too) of the resource
+                   -> Simulation m (SIROResource m)
+newSIROResource = newResource SIRO
+
+-- | Create a new SIRO resource with the specified initial and maximum counts,
+-- where 'Nothing' means that the resource has no upper bound.
+newSIROResourceWithMaxCount :: MonadComp m
+                               => Int
+                               -- ^ the initial count of the resource
+                               -> Maybe Int
+                               -- ^ the maximum count of the resource, which can be indefinite
+                               -> Simulation m (SIROResource m)
+newSIROResourceWithMaxCount = newResourceWithMaxCount SIRO
+
+-- | Create a new priority resource with the specified initial count which value becomes
+-- the upper bound as well.
+newPriorityResource :: MonadComp m
+                       => Int
+                       -- ^ the initial count (and maximal count too) of the resource
+                       -> Simulation m (PriorityResource m)
+newPriorityResource = newResource StaticPriorities
+
+-- | Create a new priority resource with the specified initial and maximum counts,
+-- where 'Nothing' means that the resource has no upper bound.
+newPriorityResourceWithMaxCount :: MonadComp m
+                                   => Int
+                                   -- ^ the initial count of the resource
+                                   -> Maybe Int
+                                   -- ^ the maximum count of the resource, which can be indefinite
+                                   -> Simulation m (PriorityResource m)
+newPriorityResourceWithMaxCount = newResourceWithMaxCount StaticPriorities
+
+-- | Create a new resource with the specified queue strategy and initial count.
+-- The last value becomes the upper bound as well.
+newResource :: (MonadComp m, QueueStrategy m s)
+               => s
+               -- ^ the strategy for managing the queuing requests
+               -> Int
+               -- ^ the initial count (and maximal count too) of the resource
+               -> Simulation m (Resource m s)
+newResource s count =
+  Simulation $ \r ->
+  do when (count < 0) $
+       error $
+       "The resource count cannot be negative: " ++
+       "newResource."
+     let session = runSession r 
+     countRef <- newProtoRef session count
+     waitList <- invokeSimulation r $ newStrategyQueue s
+     return Resource { resourceStrategy = s,
+                       resourceMaxCount = Just count,
+                       resourceCountRef = countRef,
+                       resourceWaitList = waitList }
+
+-- | Create a new resource with the specified queue strategy, initial and maximum counts,
+-- where 'Nothing' means that the resource has no upper bound.
+newResourceWithMaxCount :: (MonadComp m, QueueStrategy m s)
+                           => s
+                           -- ^ the strategy for managing the queuing requests
+                           -> Int
+                           -- ^ the initial count of the resource
+                           -> Maybe Int
+                           -- ^ the maximum count of the resource, which can be indefinite
+                           -> Simulation m (Resource m s)
+newResourceWithMaxCount s count maxCount =
+  Simulation $ \r ->
+  do when (count < 0) $
+       error $
+       "The resource count cannot be negative: " ++
+       "newResourceWithMaxCount."
+     case maxCount of
+       Just maxCount | count > maxCount ->
+         error $
+         "The resource count cannot be greater than " ++
+         "its maximum value: newResourceWithMaxCount."
+       _ ->
+         return ()
+     let session = runSession r
+     countRef <- newProtoRef session count
+     waitList <- invokeSimulation r $ newStrategyQueue s
+     return Resource { resourceStrategy = s,
+                       resourceMaxCount = maxCount,
+                       resourceCountRef = countRef,
+                       resourceWaitList = waitList }
+
+-- | Return the current count of the resource.
+resourceCount :: MonadComp m => Resource m s -> Event m Int
+resourceCount r =
+  Event $ \p -> readProtoRef (resourceCountRef r)
+
+-- | Request for the resource decreasing its count in case of success,
+-- otherwise suspending the discontinuous process until some other 
+-- process releases the resource.
+requestResource :: (MonadComp m, EnqueueStrategy m s)
+                   => Resource m s 
+                   -- ^ the requested resource
+                   -> Process m ()
+requestResource r =
+  Process $ \pid ->
+  Cont $ \c ->
+  Event $ \p ->
+  do a <- readProtoRef (resourceCountRef r)
+     if a == 0 
+       then do c <- invokeEvent p $ contFreeze c
+               invokeEvent p $
+                 strategyEnqueue (resourceWaitList r) c
+       else do let a' = a - 1
+               a' `seq` writeProtoRef (resourceCountRef r) a'
+               invokeEvent p $ resumeCont c ()
+
+-- | Request with the priority for the resource decreasing its count
+-- in case of success, otherwise suspending the discontinuous process
+-- until some other process releases the resource.
+requestResourceWithPriority :: (MonadComp m, PriorityQueueStrategy m s p)
+                               => Resource m s
+                               -- ^ the requested resource
+                               -> p
+                               -- ^ the priority
+                               -> Process m ()
+requestResourceWithPriority r priority =
+  Process $ \pid ->
+  Cont $ \c ->
+  Event $ \p ->
+  do a <- readProtoRef (resourceCountRef r)
+     if a == 0 
+       then do c <- invokeEvent p $ contFreeze c
+               invokeEvent p $
+                 strategyEnqueueWithPriority (resourceWaitList r) priority c
+       else do let a' = a - 1
+               a' `seq` writeProtoRef (resourceCountRef r) a'
+               invokeEvent p $ resumeCont c ()
+
+-- | Release the resource increasing its count and resuming one of the
+-- previously suspended processes as possible.
+releaseResource :: (MonadComp m, DequeueStrategy m s)
+                   => Resource m s
+                   -- ^ the resource to release
+                   -> Process m ()
+releaseResource r = 
+  Process $ \_ ->
+  Cont $ \c ->
+  Event $ \p ->
+  do invokeEvent p $ releaseResourceWithinEvent r
+     invokeEvent p $ resumeCont c ()
+
+-- | Release the resource increasing its count and resuming one of the
+-- previously suspended processes as possible.
+releaseResourceWithinEvent :: (MonadComp m, DequeueStrategy m s)
+                              => Resource m s
+                              -- ^ the resource to release
+                              -> Event m ()
+releaseResourceWithinEvent r =
+  Event $ \p ->
+  do a <- readProtoRef (resourceCountRef r)
+     let a' = a + 1
+     case resourceMaxCount r of
+       Just maxCount | a' > maxCount ->
+         error $
+         "The resource count cannot be greater than " ++
+         "its maximum value: releaseResourceWithinEvent."
+       _ ->
+         return ()
+     f <- invokeEvent p $
+          strategyQueueNull (resourceWaitList r)
+     if f 
+       then a' `seq` writeProtoRef (resourceCountRef r) a'
+       else do c <- invokeEvent p $
+                    strategyDequeue (resourceWaitList r)
+               c <- invokeEvent p c
+               case c of
+                 Nothing ->
+                   invokeEvent p $ releaseResourceWithinEvent r
+                 Just c  ->
+                   invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c ()
+
+-- | Try to request for the resource decreasing its count in case of success
+-- and returning 'True' in the 'Event' monad; otherwise, returning 'False'.
+tryRequestResourceWithinEvent :: MonadComp m
+                                 => Resource m s
+                                 -- ^ the resource which we try to request for
+                                 -> Event m Bool
+tryRequestResourceWithinEvent r =
+  Event $ \p ->
+  do a <- readProtoRef (resourceCountRef r)
+     if a == 0 
+       then return False
+       else do let a' = a - 1
+               a' `seq` writeProtoRef (resourceCountRef r) a'
+               return True
+               
+-- | Acquire the resource, perform some action and safely release the resource               
+-- in the end, even if the 'IOException' was raised within the action. 
+usingResource :: (MonadComp m, EnqueueStrategy m s)
+                 => Resource m s
+                 -- ^ the resource we are going to request for and then release in the end
+                 -> Process m a
+                 -- ^ the action we are going to apply having the resource
+                 -> Process m a
+                 -- ^ the result of the action
+usingResource r m =
+  do requestResource r
+     finallyProcess m $ releaseResource r
+
+-- | Acquire the resource with the specified priority, perform some action and
+-- safely release the resource in the end, even if the 'IOException' was raised
+-- within the action.
+usingResourceWithPriority :: (MonadComp m, PriorityQueueStrategy m s p)
+                             => Resource m s
+                             -- ^ the resource we are going to request for and then
+                             -- release in the end
+                             -> p
+                             -- ^ the priority
+                             -> Process m a
+                             -- ^ the action we are going to apply having the resource
+                             -> Process m a
+                             -- ^ the result of the action
+usingResourceWithPriority r priority m =
+  do requestResourceWithPriority r priority
+     finallyProcess m $ releaseResource r
+ Simulation/Aivika/Trans/Results.hs view
@@ -0,0 +1,1890 @@+
+{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, UndecidableInstances, ExistentialQuantification, MultiParamTypeClasses, FunctionalDependencies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Results
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module allows exporting the simulation results from the model.
+--
+module Simulation.Aivika.Trans.Results
+       (-- * Definitions Focused on Modeling
+        Results,
+        ResultTransform,
+        ResultName,
+        ResultProvider(..),
+        results,
+        expandResults,
+        resultSummary,
+        resultByName,
+        resultByProperty,
+        resultById,
+        resultByIndex,
+        resultBySubscript,
+        ResultComputing(..),
+        ResultListWithSubscript(..),
+        ResultArrayWithSubscript(..),
+#ifndef __HASTE__
+        ResultVectorWithSubscript(..),
+#endif
+        -- * Definitions Focused on Using the Library
+        ResultExtract(..),
+        extractIntResults,
+        extractIntListResults,
+        extractIntStatsResults,
+        extractIntStatsEitherResults,
+        extractIntTimingStatsResults,
+        extractDoubleResults,
+        extractDoubleListResults,
+        extractDoubleStatsResults,
+        extractDoubleStatsEitherResults,
+        extractDoubleTimingStatsResults,
+        extractStringResults,
+        ResultPredefinedSignals(..),
+        newResultPredefinedSignals,
+        resultSignal,
+        pureResultSignal,
+        -- * Definitions Focused on Extending the Library 
+        ResultSourceMap,
+        ResultSource(..),
+        ResultItem(..),
+        ResultItemable(..),
+        resultItemToIntStatsEitherValue,
+        resultItemToDoubleStatsEitherValue,
+        ResultObject(..),
+        ResultProperty(..),
+        ResultVector(..),
+        memoResultVectorSignal,
+        memoResultVectorSummary,
+        ResultSeparator(..),
+        ResultValue(..),
+        voidResultValue,
+        ResultContainer(..),
+        resultContainerPropertySource,
+        resultContainerConstProperty,
+        resultContainerIntegProperty,
+        resultContainerProperty,
+        resultContainerMapProperty,
+        resultValueToContainer,
+        resultContainerToValue,
+        ResultData,
+        ResultSignal(..),
+        maybeResultSignal,
+        textResultSource,
+        timeResultSource,
+        resultSourceToIntValues,
+        resultSourceToIntListValues,
+        resultSourceToIntStatsValues,
+        resultSourceToIntStatsEitherValues,
+        resultSourceToIntTimingStatsValues,
+        resultSourceToDoubleValues,
+        resultSourceToDoubleListValues,
+        resultSourceToDoubleStatsValues,
+        resultSourceToDoubleStatsEitherValues,
+        resultSourceToDoubleTimingStatsValues,
+        resultSourceToStringValues,
+        resultSourceMap,
+        resultSourceList,
+        resultsToIntValues,
+        resultsToIntListValues,
+        resultsToIntStatsValues,
+        resultsToIntStatsEitherValues,
+        resultsToIntTimingStatsValues,
+        resultsToDoubleValues,
+        resultsToDoubleListValues,
+        resultsToDoubleStatsValues,
+        resultsToDoubleStatsEitherValues,
+        resultsToDoubleTimingStatsValues,
+        resultsToStringValues,
+        composeResults,
+        computeResultValue) where
+
+import Control.Monad
+import Control.Monad.Trans
+
+import qualified Data.Map as M
+import qualified Data.Array as A
+
+#ifndef __HASTE__
+import qualified Data.Vector as V
+#endif
+
+import Data.Ix
+import Data.Maybe
+import Data.Monoid
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Statistics.Accumulator
+import Simulation.Aivika.Trans.Ref
+import qualified Simulation.Aivika.Trans.Ref.Plain as LR
+import Simulation.Aivika.Trans.Var
+import Simulation.Aivika.Trans.QueueStrategy
+import qualified Simulation.Aivika.Trans.Queue as Q
+import qualified Simulation.Aivika.Trans.Queue.Infinite as IQ
+import Simulation.Aivika.Trans.Arrival
+import Simulation.Aivika.Trans.Server
+import Simulation.Aivika.Trans.Results.Locale
+
+-- | A name used for indentifying the results when generating output.
+type ResultName = String
+
+-- | Represents a provider of the simulation results. It is usually something, or
+-- an array of something, or a list of such values which can be simulated to get data.
+class MonadComp m => ResultProvider p m | p -> m where
+  
+  -- | Return the source of simulation results by the specified name, description and provider. 
+  resultSource :: ResultName -> ResultDescription -> p -> ResultSource m
+  resultSource name descr = resultSource' name (UserDefinedResultId descr)
+
+  -- | Return the source of simulation results by the specified name, identifier and provider. 
+  resultSource' :: ResultName -> ResultId -> p -> ResultSource m
+
+-- | It associates the result sources with their names.
+type ResultSourceMap m = M.Map ResultName (ResultSource m)
+
+-- | Encapsulates the result source.
+data ResultSource m = ResultItemSource (ResultItem m)
+                      -- ^ The source consisting of a single item.
+                    | ResultObjectSource (ResultObject m)
+                      -- ^ An object-like source.
+                    | ResultVectorSource (ResultVector m)
+                      -- ^ A vector-like structure.
+                    | ResultSeparatorSource ResultSeparator
+                      -- ^ This is a separator text.
+
+-- | The simulation results represented by a single item.
+data ResultItem m = forall a. ResultItemable a => ResultItem (a m)
+
+-- | Represents a type class for actual representing the items.
+class ResultItemable a where
+
+  -- | The item name.
+  resultItemName :: a m -> ResultName
+  
+  -- | The item identifier.
+  resultItemId :: a m -> ResultId
+
+  -- | Whether the item emits a signal.
+  resultItemSignal :: MonadComp m => a m -> ResultSignal m
+
+  -- | Return an expanded version of the item, for example,
+  -- when the statistics item is exanded to an object
+  -- having the corresponded properties for count, average,
+  -- deviation, minimum, maximum and so on.
+  resultItemExpansion :: MonadComp m => a m -> ResultSource m
+  
+  -- | Return usually a short version of the item, i.e. its summary,
+  -- but values of some data types such as statistics can be
+  -- implicitly expanded to an object with the corresponded
+  -- properties.
+  resultItemSummary :: MonadComp m => a m -> ResultSource m
+  
+  -- | Return integer numbers in time points.
+  resultItemToIntValue :: MonadComp m => a m -> ResultValue Int m
+
+  -- | Return lists of integer numbers in time points. 
+  resultItemToIntListValue :: MonadComp m => a m -> ResultValue [Int] m
+
+  -- | Return statistics based on integer numbers.
+  resultItemToIntStatsValue :: MonadComp m => a m -> ResultValue (SamplingStats Int) m
+
+  -- | Return timing statistics based on integer numbers.
+  resultItemToIntTimingStatsValue :: MonadComp m => a m -> ResultValue (TimingStats Int) m
+
+  -- | Return double numbers in time points.
+  resultItemToDoubleValue :: MonadComp m => a m -> ResultValue Double m
+  
+  -- | Return lists of double numbers in time points. 
+  resultItemToDoubleListValue :: MonadComp m => a m -> ResultValue [Double] m
+
+  -- | Return statistics based on double numbers.
+  resultItemToDoubleStatsValue :: MonadComp m => a m -> ResultValue (SamplingStats Double) m
+
+  -- | Return timing statistics based on integer numbers.
+  resultItemToDoubleTimingStatsValue :: MonadComp m => a m -> ResultValue (TimingStats Double) m
+
+  -- | Return string representations in time points.
+  resultItemToStringValue :: MonadComp m => a m -> ResultValue String m
+
+-- | Return a version optimised for fast aggregation of the statistics based on integer numbers.
+resultItemToIntStatsEitherValue :: (MonadComp m, ResultItemable a) => a m -> ResultValue (Either Int (SamplingStats Int)) m
+resultItemToIntStatsEitherValue x =
+  case resultValueData x1 of
+    Just a1 -> mapResultValue Left x1
+    Nothing ->
+      case resultValueData x2 of
+        Just a2 -> mapResultValue Right x2
+        Nothing -> voidResultValue x2
+  where
+    x1 = resultItemToIntValue x
+    x2 = resultItemToIntStatsValue x
+
+-- | Return a version optimised for fast aggregation of the statistics based on double floating point numbers.
+resultItemToDoubleStatsEitherValue :: (MonadComp m, ResultItemable a) => a m -> ResultValue (Either Double (SamplingStats Double)) m
+resultItemToDoubleStatsEitherValue x =
+  case resultValueData x1 of
+    Just a1 -> mapResultValue Left x1
+    Nothing ->
+      case resultValueData x2 of
+        Just a2 -> mapResultValue Right x2
+        Nothing -> voidResultValue x2
+  where
+    x1 = resultItemToDoubleValue x
+    x2 = resultItemToDoubleStatsValue x
+
+-- | The simulation results represented by an object having properties.
+data ResultObject m =
+  ResultObject { resultObjectName :: ResultName,
+                 -- ^ The object name.
+                 resultObjectId :: ResultId,
+                 -- ^ The object identifier.
+                 resultObjectTypeId :: ResultId,
+                 -- ^ The object type identifier.
+                 resultObjectProperties :: [ResultProperty m],
+                 -- ^ The object properties.
+                 resultObjectSignal :: ResultSignal m,
+                 -- ^ A combined signal if present.
+                 resultObjectSummary :: ResultSource m
+                 -- ^ A short version of the object, i.e. its summary.
+               }
+
+-- | The object property containing the simulation results.
+data ResultProperty m =
+  ResultProperty { resultPropertyLabel :: ResultName,
+                   -- ^ The property short label.
+                   resultPropertyId :: ResultId,
+                   -- ^ The property identifier.
+                   resultPropertySource :: ResultSource m
+                   -- ^ The simulation results supplied by the property.
+                 }
+
+-- | The simulation results represented by a vector.
+data ResultVector m =
+  ResultVector { resultVectorName :: ResultName,
+                 -- ^ The vector name.
+                 resultVectorId :: ResultId,
+                 -- ^ The vector identifier.
+                 resultVectorItems :: A.Array Int (ResultSource m),
+                 -- ^ The results supplied by the vector items.
+                 resultVectorSubscript :: A.Array Int ResultName,
+                 -- ^ The subscript used as a suffix to create item names.
+                 resultVectorSignal :: ResultSignal m,
+                 -- ^ A combined signal if present.
+                 resultVectorSummary :: ResultSource m
+                 -- ^ A short version of the vector, i.e. summary.
+               }
+
+-- | Calculate the result vector signal and memoize it in a new vector.
+memoResultVectorSignal :: MonadComp m => ResultVector m -> ResultVector m
+memoResultVectorSignal x =
+  x { resultVectorSignal =
+         foldr (<>) mempty $ map resultSourceSignal $ A.elems $ resultVectorItems x }
+
+-- | Calculate the result vector summary and memoize it in a new vector.
+memoResultVectorSummary :: MonadComp m => ResultVector m -> ResultVector m
+memoResultVectorSummary x =
+  x { resultVectorSummary =
+         ResultVectorSource $
+         x { resultVectorItems =
+                A.array bnds [(i, resultSourceSummary e) | (i, e) <- ies] } }
+  where
+    arr  = resultVectorItems x
+    bnds = A.bounds arr
+    ies  = A.assocs arr
+
+-- | It separates the simulation results when printing.
+data ResultSeparator =
+  ResultSeparator { resultSeparatorText :: String
+                    -- ^ The separator text.
+                  }
+
+-- | A parameterised value that actually represents a generalised result item that have no parametric type.
+data ResultValue e m =
+  ResultValue { resultValueName :: ResultName,
+                -- ^ The value name.
+                resultValueId :: ResultId,
+                -- ^ The value identifier.
+                resultValueData :: ResultData e m,
+                -- ^ Simulation data supplied by the value.
+                resultValueSignal :: ResultSignal m
+                -- ^ Whether the value emits a signal when changing simulation data.
+              }
+
+mapResultValue :: MonadComp m => (a -> b) -> ResultValue a m -> ResultValue b m
+mapResultValue f x = x { resultValueData = fmap (fmap f) (resultValueData x) }
+
+-- | Return a new value with the discarded simulation results.
+voidResultValue :: ResultValue a m -> ResultValue b m
+voidResultValue x = x { resultValueData = Nothing }
+
+-- | A container of the simulation results such as queue, server or array.
+data ResultContainer e m =
+  ResultContainer { resultContainerName :: ResultName,
+                    -- ^ The container name.
+                    resultContainerId :: ResultId,
+                    -- ^ The container identifier.
+                    resultContainerData :: e,
+                    -- ^ The container data.
+                    resultContainerSignal :: ResultSignal m
+                    -- ^ Whether the container emits a signal when changing simulation data.
+                  }
+
+mapResultContainer :: (a -> b) -> ResultContainer a m -> ResultContainer b m
+mapResultContainer f x = x { resultContainerData = f (resultContainerData x) }
+
+-- | Create a new property source by the specified container.
+resultContainerPropertySource :: ResultItemable (ResultValue b)
+                                 => ResultContainer a m
+                                 -- ^ the container
+                                 -> ResultName
+                                 -- ^ the property label
+                                 -> ResultId
+                                 -- ^ the property identifier
+                                 -> (a -> ResultData b m)
+                                 -- ^ get the specified data from the container
+                                 -> (a -> ResultSignal m)
+                                 -- ^ get the data signal from the container
+                                 -> ResultSource m
+resultContainerPropertySource cont name i f g =
+  ResultItemSource $
+  ResultItem $
+  ResultValue {
+    resultValueName   = (resultContainerName cont) ++ "." ++ name,
+    resultValueId     = i,
+    resultValueData   = f (resultContainerData cont),
+    resultValueSignal = g (resultContainerData cont) }
+
+-- | Create a constant property by the specified container.
+resultContainerConstProperty :: (MonadComp m,
+                                 ResultItemable (ResultValue b))
+                                => ResultContainer a m
+                                -- ^ the container
+                                -> ResultName
+                                -- ^ the property label
+                                -> ResultId
+                                -- ^ the property identifier
+                                -> (a -> b)
+                                -- ^ get the specified data from the container
+                                -> ResultProperty m
+resultContainerConstProperty cont name i f =
+  ResultProperty {
+    resultPropertyLabel = name,
+    resultPropertyId = i,
+    resultPropertySource =
+      resultContainerPropertySource cont name i (Just . return . f) (const EmptyResultSignal) }
+  
+-- | Create by the specified container a property that changes in the integration time points, or it is supposed to be such one.
+resultContainerIntegProperty :: (MonadComp m,
+                                 ResultItemable (ResultValue b))
+                                => ResultContainer a m
+                                -- ^ the container
+                                -> ResultName
+                                -- ^ the property label
+                                -> ResultId
+                                -- ^ the property identifier
+                                -> (a -> Event m b)
+                                -- ^ get the specified data from the container
+                                -> ResultProperty m
+resultContainerIntegProperty cont name i f =
+  ResultProperty {
+    resultPropertyLabel = name,
+    resultPropertyId = i,
+    resultPropertySource =
+      resultContainerPropertySource cont name i (Just . f) (const UnknownResultSignal) }
+  
+-- | Create a property by the specified container.
+resultContainerProperty :: (MonadComp m,
+                            ResultItemable (ResultValue b))
+                           => ResultContainer a m
+                           -- ^ the container
+                           -> ResultName
+                           -- ^ the property label
+                           -> ResultId
+                           -- ^ the property identifier
+                           -> (a -> Event m b)
+                           -- ^ get the specified data from the container
+                           -> (a -> Signal m ())
+                           -- ^ get a signal triggered when changing data.
+                           -> ResultProperty m
+resultContainerProperty cont name i f g =                     
+  ResultProperty {
+    resultPropertyLabel = name,
+    resultPropertyId = i,
+    resultPropertySource =
+      resultContainerPropertySource cont name i (Just . f) (ResultSignal . g) }
+
+-- | Create by the specified container a mapped property which is recomputed each time again and again.
+resultContainerMapProperty :: (MonadComp m,
+                               ResultItemable (ResultValue b))
+                              => ResultContainer (ResultData a m) m
+                              -- ^ the container
+                              -> ResultName
+                              -- ^ the property label
+                              -> ResultId
+                              -- ^ the property identifier
+                              -> (a -> b)
+                              -- ^ recompute the specified data
+                              -> ResultProperty m
+resultContainerMapProperty cont name i f =                     
+  ResultProperty {
+    resultPropertyLabel = name,
+    resultPropertyId = i,
+    resultPropertySource =
+      resultContainerPropertySource cont name i (fmap $ fmap f) (const $ resultContainerSignal cont) }
+
+-- | Convert the result value to a container with the specified object identifier. 
+resultValueToContainer :: ResultValue a m -> ResultContainer (ResultData a m) m
+resultValueToContainer x =
+  ResultContainer {
+    resultContainerName   = resultValueName x,
+    resultContainerId     = resultValueId x,
+    resultContainerData   = resultValueData x,
+    resultContainerSignal = resultValueSignal x }
+
+-- | Convert the result container to a value.
+resultContainerToValue :: ResultContainer (ResultData a m) m -> ResultValue a m
+resultContainerToValue x =
+  ResultValue {
+    resultValueName   = resultContainerName x,
+    resultValueId     = resultContainerId x,
+    resultValueData   = resultContainerData x,
+    resultValueSignal = resultContainerSignal x }
+
+-- | Represents the very simulation results.
+type ResultData e m = Maybe (Event m e)
+
+-- | Whether an object containing the results emits a signal notifying about change of data.
+data ResultSignal m = EmptyResultSignal
+                      -- ^ There is no signal at all.
+                    | UnknownResultSignal
+                      -- ^ The signal is unknown, but the entity probably changes.
+                    | ResultSignal (Signal m ())
+                      -- ^ When the signal is precisely specified.
+                    | ResultSignalMix (Signal m ())
+                      -- ^ When the specified signal was combined with unknown signal.
+
+instance MonadComp m => Monoid (ResultSignal m) where
+
+  mempty = EmptyResultSignal
+
+  mappend EmptyResultSignal z = z
+
+  mappend UnknownResultSignal EmptyResultSignal = UnknownResultSignal
+  mappend UnknownResultSignal UnknownResultSignal = UnknownResultSignal
+  mappend UnknownResultSignal (ResultSignal x) = ResultSignalMix x
+  mappend UnknownResultSignal z@(ResultSignalMix x) = z
+  
+  mappend z@(ResultSignal x) EmptyResultSignal = z
+  mappend (ResultSignal x) UnknownResultSignal = ResultSignalMix x
+  mappend (ResultSignal x) (ResultSignal y) = ResultSignal (x <> y)
+  mappend (ResultSignal x) (ResultSignalMix y) = ResultSignalMix (x <> y)
+  
+  mappend z@(ResultSignalMix x) EmptyResultSignal = z
+  mappend z@(ResultSignalMix x) UnknownResultSignal = z
+  mappend (ResultSignalMix x) (ResultSignal y) = ResultSignalMix (x <> y)
+  mappend (ResultSignalMix x) (ResultSignalMix y) = ResultSignalMix (x <> y)
+
+-- | Construct a new result signal by the specified optional pure signal.
+maybeResultSignal :: Maybe (Signal m ()) -> ResultSignal m
+maybeResultSignal (Just x) = ResultSignal x
+maybeResultSignal Nothing  = EmptyResultSignal
+
+instance ResultItemable (ResultValue Int) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = id
+  resultItemToIntListValue = mapResultValue return
+  resultItemToIntStatsValue = mapResultValue returnSamplingStats
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = mapResultValue fromIntegral
+  resultItemToDoubleListValue = mapResultValue (return . fromIntegral)
+  resultItemToDoubleStatsValue = mapResultValue (returnSamplingStats . fromIntegral)
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue Double) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+  
+  resultItemToDoubleValue = id
+  resultItemToDoubleListValue = mapResultValue return
+  resultItemToDoubleStatsValue = mapResultValue returnSamplingStats
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue [Int]) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = id
+  resultItemToIntStatsValue = mapResultValue listSamplingStats
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = mapResultValue (map fromIntegral)
+  resultItemToDoubleStatsValue = mapResultValue (fromIntSamplingStats . listSamplingStats)
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue [Double]) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+  
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = id
+  resultItemToDoubleStatsValue = mapResultValue listSamplingStats
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue (SamplingStats Int)) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = id
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = mapResultValue fromIntSamplingStats
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = samplingStatsResultSource
+  resultItemSummary = samplingStatsResultSummary
+
+instance ResultItemable (ResultValue (SamplingStats Double)) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+  
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = id
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = samplingStatsResultSource
+  resultItemSummary = samplingStatsResultSummary
+
+instance ResultItemable (ResultValue (TimingStats Int)) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = id
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = mapResultValue fromIntTimingStats
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = timingStatsResultSource
+  resultItemSummary = timingStatsResultSummary
+
+instance ResultItemable (ResultValue  (TimingStats Double)) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = id
+
+  resultItemToStringValue = mapResultValue show
+  
+  resultItemExpansion = timingStatsResultSource
+  resultItemSummary = timingStatsResultSummary
+
+instance ResultItemable (ResultValue Bool) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue String) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue ()) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue FCFS) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue LCFS) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue SIRO) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+instance ResultItemable (ResultValue StaticPriorities) where
+
+  resultItemName = resultValueName
+  resultItemId = resultValueId
+  resultItemSignal = resultValueSignal
+  
+  resultItemToIntValue = voidResultValue
+  resultItemToIntListValue = voidResultValue
+  resultItemToIntStatsValue = voidResultValue
+  resultItemToIntTimingStatsValue = voidResultValue
+
+  resultItemToDoubleValue = voidResultValue
+  resultItemToDoubleListValue = voidResultValue
+  resultItemToDoubleStatsValue = voidResultValue
+  resultItemToDoubleTimingStatsValue = voidResultValue
+
+  resultItemToStringValue = mapResultValue show
+
+  resultItemExpansion = ResultItemSource . ResultItem
+  resultItemSummary = ResultItemSource . ResultItem
+
+-- | Flatten the result source.
+flattenResultSource :: ResultSource m -> [ResultItem m]
+flattenResultSource (ResultItemSource x) = [x]
+flattenResultSource (ResultObjectSource x) =
+  concat $ map (flattenResultSource . resultPropertySource) $ resultObjectProperties x
+flattenResultSource (ResultVectorSource x) =
+  concat $ map flattenResultSource $ A.elems $ resultVectorItems x
+flattenResultSource (ResultSeparatorSource x) = []
+
+-- | Return the result source name.
+resultSourceName :: ResultSource m -> ResultName
+resultSourceName (ResultItemSource (ResultItem x)) = resultItemName x
+resultSourceName (ResultObjectSource x) = resultObjectName x
+resultSourceName (ResultVectorSource x) = resultVectorName x
+resultSourceName (ResultSeparatorSource x) = []
+
+-- | Expand the result source returning a more detailed version expanding the properties as possible.
+expandResultSource :: MonadComp m => ResultSource m -> ResultSource m
+expandResultSource (ResultItemSource (ResultItem x)) = resultItemExpansion x
+expandResultSource (ResultObjectSource x) =
+  ResultObjectSource $
+  x { resultObjectProperties =
+         flip fmap (resultObjectProperties x) $ \p ->
+         p { resultPropertySource = expandResultSource (resultPropertySource p) } }
+expandResultSource (ResultVectorSource x) =
+  ResultVectorSource $
+  x { resultVectorItems =
+         A.array bnds [(i, expandResultSource e) | (i, e) <- ies] }
+    where arr  = resultVectorItems x
+          bnds = A.bounds arr
+          ies  = A.assocs arr
+expandResultSource z@(ResultSeparatorSource x) = z
+
+-- | Return a summarised and usually more short version of the result source expanding the main properties or excluding auxiliary properties if required.
+resultSourceSummary :: MonadComp m => ResultSource m -> ResultSource m
+resultSourceSummary (ResultItemSource (ResultItem x)) = resultItemSummary x
+resultSourceSummary (ResultObjectSource x) = resultObjectSummary x
+resultSourceSummary (ResultVectorSource x) = resultVectorSummary x
+resultSourceSummary z@(ResultSeparatorSource x) = z
+
+-- | Return a signal emitted by the source.
+resultSourceSignal :: MonadComp m => ResultSource m -> ResultSignal m
+resultSourceSignal (ResultItemSource (ResultItem x)) = resultItemSignal x
+resultSourceSignal (ResultObjectSource x) = resultObjectSignal x
+resultSourceSignal (ResultVectorSource x) = resultVectorSignal x
+resultSourceSignal (ResultSeparatorSource x) = EmptyResultSignal
+
+-- | Represent the result source as integer numbers.
+resultSourceToIntValues :: MonadComp m => ResultSource m -> [ResultValue Int m]
+resultSourceToIntValues = map (\(ResultItem x) -> resultItemToIntValue x) . flattenResultSource
+
+-- | Represent the result source as lists of integer numbers.
+resultSourceToIntListValues :: MonadComp m => ResultSource m -> [ResultValue [Int] m]
+resultSourceToIntListValues = map (\(ResultItem x) -> resultItemToIntListValue x) . flattenResultSource
+
+-- | Represent the result source as statistics based on integer numbers.
+resultSourceToIntStatsValues :: MonadComp m => ResultSource m -> [ResultValue (SamplingStats Int) m]
+resultSourceToIntStatsValues = map (\(ResultItem x) -> resultItemToIntStatsValue x) . flattenResultSource
+
+-- | Represent the result source as statistics based on integer numbers and optimised for fast aggregation.
+resultSourceToIntStatsEitherValues :: MonadComp m => ResultSource m -> [ResultValue (Either Int (SamplingStats Int)) m]
+resultSourceToIntStatsEitherValues = map (\(ResultItem x) -> resultItemToIntStatsEitherValue x) . flattenResultSource
+
+-- | Represent the result source as timing statistics based on integer numbers.
+resultSourceToIntTimingStatsValues :: MonadComp m => ResultSource m -> [ResultValue (TimingStats Int) m]
+resultSourceToIntTimingStatsValues = map (\(ResultItem x) -> resultItemToIntTimingStatsValue x) . flattenResultSource
+
+-- | Represent the result source as double floating point numbers.
+resultSourceToDoubleValues :: MonadComp m => ResultSource m -> [ResultValue Double m]
+resultSourceToDoubleValues = map (\(ResultItem x) -> resultItemToDoubleValue x) . flattenResultSource
+
+-- | Represent the result source as lists of double floating point numbers.
+resultSourceToDoubleListValues :: MonadComp m => ResultSource m -> [ResultValue [Double] m]
+resultSourceToDoubleListValues = map (\(ResultItem x) -> resultItemToDoubleListValue x) . flattenResultSource
+
+-- | Represent the result source as statistics based on double floating point numbers.
+resultSourceToDoubleStatsValues :: MonadComp m => ResultSource m -> [ResultValue (SamplingStats Double) m]
+resultSourceToDoubleStatsValues = map (\(ResultItem x) -> resultItemToDoubleStatsValue x) . flattenResultSource
+
+-- | Represent the result source as statistics based on double floating point numbers and optimised for fast aggregation.
+resultSourceToDoubleStatsEitherValues :: MonadComp m => ResultSource m -> [ResultValue (Either Double (SamplingStats Double)) m]
+resultSourceToDoubleStatsEitherValues = map (\(ResultItem x) -> resultItemToDoubleStatsEitherValue x) . flattenResultSource
+
+-- | Represent the result source as timing statistics based on double floating point numbers.
+resultSourceToDoubleTimingStatsValues :: MonadComp m => ResultSource m -> [ResultValue (TimingStats Double) m]
+resultSourceToDoubleTimingStatsValues = map (\(ResultItem x) -> resultItemToDoubleTimingStatsValue x) . flattenResultSource
+
+-- | Represent the result source as string values.
+resultSourceToStringValues :: MonadComp m => ResultSource m -> [ResultValue String m]
+resultSourceToStringValues = map (\(ResultItem x) -> resultItemToStringValue x) . flattenResultSource
+
+-- | It contains the results of simulation.
+data Results m =
+  Results { resultSourceMap :: ResultSourceMap m,
+            -- ^ The sources of simulation results as a map of associated names.
+            resultSourceList :: [ResultSource m]
+            -- ^ The sources of simulation results as an ordered list.
+          }
+
+-- | It transforms the results of simulation.
+type ResultTransform m = Results m -> Results m
+
+-- | It representes the predefined signals provided by every simulation model.
+data ResultPredefinedSignals m =
+  ResultPredefinedSignals { resultSignalInIntegTimes :: Signal m Double,
+                            -- ^ The signal triggered in the integration time points.
+                            resultSignalInStartTime :: Signal m Double,
+                            -- ^ The signal triggered in the start time.
+                            resultSignalInStopTime :: Signal m Double
+                            -- ^ The signal triggered in the stop time.
+                          }
+
+-- | Create the predefined signals provided by every simulation model.
+newResultPredefinedSignals :: MonadComp m => Simulation m (ResultPredefinedSignals m)
+newResultPredefinedSignals = runDynamicsInStartTime $ runEventWith EarlierEvents d where
+  d = do signalInIntegTimes <- newSignalInIntegTimes
+         signalInStartTime  <- newSignalInStartTime
+         signalInStopTime   <- newSignalInStopTime
+         return ResultPredefinedSignals { resultSignalInIntegTimes = signalInIntegTimes,
+                                          resultSignalInStartTime  = signalInStartTime,
+                                          resultSignalInStopTime   = signalInStopTime }
+
+instance Monoid (Results m) where
+
+  mempty      = results mempty
+  mappend x y = results $ resultSourceList x <> resultSourceList y
+
+-- | Prepare the simulation results.
+results :: [ResultSource m] -> Results m
+results ms =
+  Results { resultSourceMap  = M.fromList $ map (\x -> (resultSourceName x, x)) ms,
+            resultSourceList = ms }
+
+-- | Represent the results as integer numbers.
+resultsToIntValues :: MonadComp m => Results m -> [ResultValue Int m]
+resultsToIntValues = concat . map resultSourceToIntValues . resultSourceList
+
+-- | Represent the results as lists of integer numbers.
+resultsToIntListValues :: MonadComp m => Results m -> [ResultValue [Int] m]
+resultsToIntListValues = concat . map resultSourceToIntListValues . resultSourceList
+
+-- | Represent the results as statistics based on integer numbers.
+resultsToIntStatsValues :: MonadComp m => Results m -> [ResultValue (SamplingStats Int) m]
+resultsToIntStatsValues = concat . map resultSourceToIntStatsValues . resultSourceList
+
+-- | Represent the results as statistics based on integer numbers and optimised for fast aggregation.
+resultsToIntStatsEitherValues :: MonadComp m => Results m -> [ResultValue (Either Int (SamplingStats Int)) m]
+resultsToIntStatsEitherValues = concat . map resultSourceToIntStatsEitherValues . resultSourceList
+
+-- | Represent the results as timing statistics based on integer numbers.
+resultsToIntTimingStatsValues :: MonadComp m => Results m -> [ResultValue (TimingStats Int) m]
+resultsToIntTimingStatsValues = concat . map resultSourceToIntTimingStatsValues . resultSourceList
+
+-- | Represent the results as double floating point numbers.
+resultsToDoubleValues :: MonadComp m => Results m -> [ResultValue Double m]
+resultsToDoubleValues = concat . map resultSourceToDoubleValues . resultSourceList
+
+-- | Represent the results as lists of double floating point numbers.
+resultsToDoubleListValues :: MonadComp m => Results m -> [ResultValue [Double] m]
+resultsToDoubleListValues = concat . map resultSourceToDoubleListValues . resultSourceList
+
+-- | Represent the results as statistics based on double floating point numbers.
+resultsToDoubleStatsValues :: MonadComp m => Results m -> [ResultValue (SamplingStats Double) m]
+resultsToDoubleStatsValues = concat . map resultSourceToDoubleStatsValues . resultSourceList
+
+-- | Represent the results as statistics based on double floating point numbers and optimised for fast aggregation.
+resultsToDoubleStatsEitherValues :: MonadComp m => Results m -> [ResultValue (Either Double (SamplingStats Double)) m]
+resultsToDoubleStatsEitherValues = concat . map resultSourceToDoubleStatsEitherValues . resultSourceList
+
+-- | Represent the results as timing statistics based on double floating point numbers.
+resultsToDoubleTimingStatsValues :: MonadComp m => Results m -> [ResultValue (TimingStats Double) m]
+resultsToDoubleTimingStatsValues = concat . map resultSourceToDoubleTimingStatsValues . resultSourceList
+
+-- | Represent the results as string values.
+resultsToStringValues :: MonadComp m => Results m -> [ResultValue String m]
+resultsToStringValues = concat . map resultSourceToStringValues . resultSourceList
+
+-- | Return a signal emitted by the specified results.
+resultSignal :: MonadComp m => Results m -> ResultSignal m
+resultSignal = mconcat . map resultSourceSignal . resultSourceList
+
+-- | Return an expanded version of the simulation results expanding the properties as possible, which
+-- takes place for expanding statistics to show the count, average, deviation, minimum, maximum etc.
+-- as separate values.
+expandResults :: MonadComp m => ResultTransform m
+expandResults = results . map expandResultSource . resultSourceList
+
+-- | Return a short version of the simulation results, i.e. their summary, expanding the main properties
+-- or excluding auxiliary properties if required.
+resultSummary :: MonadComp m => ResultTransform m
+resultSummary = results . map resultSourceSummary . resultSourceList
+
+-- | Take a result by its name.
+resultByName :: ResultName -> ResultTransform m
+resultByName name rs =
+  case M.lookup name (resultSourceMap rs) of
+    Just x -> results [x]
+    Nothing ->
+      error $
+      "Not found result source with name " ++ name ++
+      ": resultByName"
+
+-- | Take a result from the object with the specified property label,
+-- but it is more preferrable to refer to the property by its 'ResultId'
+-- identifier with help of the 'resultById' function.
+resultByProperty :: ResultName -> ResultTransform m
+resultByProperty label rs = flip composeResults rs loop
+  where
+    loop x =
+      case x of
+        ResultObjectSource s ->
+          let ps =
+                flip filter (resultObjectProperties s) $ \p ->
+                resultPropertyLabel p == label
+          in case ps of
+            [] ->
+              error $
+              "Not found property " ++ label ++
+              " for object " ++ resultObjectName s ++
+              ": resultByProperty"
+            ps ->
+              map resultPropertySource ps
+        ResultVectorSource s ->
+          concat $ map loop $ A.elems $ resultVectorItems s
+        x ->
+          error $
+          "Result source " ++ resultSourceName x ++
+          " is neither object, nor vector " ++
+          ": resultByProperty"
+
+-- | Take a result from the object with the specified identifier. It can identify
+-- an item, object property, the object iself, vector or its elements.
+resultById :: ResultId -> ResultTransform m
+resultById i rs = flip composeResults rs loop
+  where
+    loop x =
+      case x of
+        ResultItemSource (ResultItem s) ->
+          if resultItemId s == i
+          then [x]
+          else error $
+               "Expected to find item with Id = " ++ show i ++
+               ", while the item " ++ resultItemName s ++
+               " has actual Id = " ++ show (resultItemId s) ++
+               ": resultById"
+        ResultObjectSource s ->
+          if resultObjectId s == i
+          then [x]
+          else let ps =
+                     flip filter (resultObjectProperties s) $ \p ->
+                     resultPropertyId p == i
+               in case ps of
+                 [] ->
+                   error $
+                   "Not found property with Id = " ++ show i ++
+                   " for object " ++ resultObjectName s ++
+                   " that has actual Id = " ++ show (resultObjectId s) ++
+                   ": resultById"
+                 ps ->
+                   map resultPropertySource ps
+        ResultVectorSource s ->
+          if resultVectorId s == i
+          then [x]
+          else concat $ map loop $ A.elems $ resultVectorItems s
+        x ->
+          error $
+          "Result source " ++ resultSourceName x ++
+          " is neither item, nor object, nor vector " ++
+          ": resultById"
+
+-- | Take a result from the vector by the specified integer index.
+resultByIndex :: Int -> ResultTransform m
+resultByIndex index rs = flip composeResults rs loop
+  where
+    loop x =
+      case x of
+        ResultVectorSource s ->
+          [resultVectorItems s A.! index] 
+        x ->
+          error $
+          "Result source " ++ resultSourceName x ++
+          " is not vector " ++
+          ": resultByIndex"
+
+-- | Take a result from the vector by the specified string subscript.
+resultBySubscript :: ResultName -> ResultTransform m
+resultBySubscript subscript rs = flip composeResults rs loop
+  where
+    loop x =
+      case x of
+        ResultVectorSource s ->
+          let ys = A.elems $ resultVectorItems s
+              zs = A.elems $ resultVectorSubscript s
+              ps =
+                flip filter (zip ys zs) $ \(y, z) ->
+                z == subscript
+          in case ps of
+            [] ->
+              error $
+              "Not found subscript " ++ subscript ++
+              " for vector " ++ resultVectorName s ++
+              ": resultBySubscript"
+            ps ->
+              map fst ps
+        x ->
+          error $
+          "Result source " ++ resultSourceName x ++
+          " is not vector " ++
+          ": resultBySubscript"
+
+-- | Compose the results using the specified transformation function.
+composeResults :: (ResultSource m -> [ResultSource m]) -> ResultTransform m
+composeResults f =
+  results . concat . map f . resultSourceList
+
+-- | Concatenate the results using the specified list of transformation functions.
+concatResults :: [ResultTransform m] -> ResultTransform m
+concatResults trs rs =
+  results $ concat $ map (\tr -> resultSourceList $ tr rs) trs
+
+-- | Append the results using the specified transformation functions.
+appendResults :: ResultTransform m -> ResultTransform m -> ResultTransform m
+appendResults x y =
+  concatResults [x, y]
+
+-- | Return a pure signal as a result of combination of the predefined signals
+-- with the specified result signal usually provided by the sources.
+--
+-- The signal returned is triggered when the source signal is triggered.
+-- The pure signal is also triggered in the integration time points
+-- if the source signal is unknown or it was combined with any unknown signal.
+pureResultSignal :: MonadComp m => ResultPredefinedSignals m -> ResultSignal m -> Signal m ()
+pureResultSignal rs EmptyResultSignal =
+  void (resultSignalInStartTime rs)
+pureResultSignal rs UnknownResultSignal =
+  void (resultSignalInIntegTimes rs)
+pureResultSignal rs (ResultSignal s) =
+  void (resultSignalInStartTime rs) <> void (resultSignalInStopTime rs) <> s
+pureResultSignal rs (ResultSignalMix s) =
+  void (resultSignalInIntegTimes rs) <> s
+
+-- | Defines a final result extract: its name, values and other data.
+data ResultExtract e m =
+  ResultExtract { resultExtractName   :: ResultName,
+                  -- ^ The result name.
+                  resultExtractId     :: ResultId,
+                  -- ^ The result identifier.
+                  resultExtractData   :: Event m e,
+                  -- ^ The result values.
+                  resultExtractSignal :: ResultSignal m
+                  -- ^ Whether the result emits a signal.
+                }
+
+-- | Extract the results as integer values, or raise a conversion error.
+extractIntResults :: MonadComp m => Results m -> [ResultExtract Int m]
+extractIntResults rs = flip map (resultsToIntValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of integer values: extractIntResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as lists of integer values, or raise a conversion error.
+extractIntListResults :: MonadComp m => Results m -> [ResultExtract [Int] m]
+extractIntListResults rs = flip map (resultsToIntListValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of lists of integer values: extractIntListResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as statistics based on integer values,
+-- or raise a conversion error.
+extractIntStatsResults :: MonadComp m => Results m -> [ResultExtract (SamplingStats Int) m]
+extractIntStatsResults rs = flip map (resultsToIntStatsValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of statistics based on integer values: extractIntStatsResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as statistics based on integer values and optimised
+-- for fast aggregation, or raise a conversion error.
+extractIntStatsEitherResults :: MonadComp m => Results m -> [ResultExtract (Either Int (SamplingStats Int)) m]
+extractIntStatsEitherResults rs = flip map (resultsToIntStatsEitherValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of statistics based on integer values: extractIntStatsEitherResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as timing statistics based on integer values,
+-- or raise a conversion error.
+extractIntTimingStatsResults :: MonadComp m => Results m -> [ResultExtract (TimingStats Int) m]
+extractIntTimingStatsResults rs = flip map (resultsToIntTimingStatsValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of timing statistics based on integer values: extractIntTimingStatsResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as double floating point values, or raise a conversion error.
+extractDoubleResults :: MonadComp m => Results m -> [ResultExtract Double m]
+extractDoubleResults rs = flip map (resultsToDoubleValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of double floating point values: extractDoubleResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as lists of double floating point values,
+-- or raise a conversion error.
+extractDoubleListResults :: MonadComp m => Results m -> [ResultExtract [Double] m]
+extractDoubleListResults rs = flip map (resultsToDoubleListValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of lists of double floating point values: extractDoubleListResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as statistics based on double floating point values,
+-- or raise a conversion error.
+extractDoubleStatsResults :: MonadComp m => Results m -> [ResultExtract (SamplingStats Double) m]
+extractDoubleStatsResults rs = flip map (resultsToDoubleStatsValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of statistics based on double floating point values: extractDoubleStatsResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as statistics based on double floating point values
+-- and optimised for fast aggregation, or raise a conversion error.
+extractDoubleStatsEitherResults :: MonadComp m => Results m -> [ResultExtract (Either Double (SamplingStats Double)) m]
+extractDoubleStatsEitherResults rs = flip map (resultsToDoubleStatsEitherValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of statistics based on double floating point values: extractDoubleStatsEitherResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as timing statistics based on double floating point values,
+-- or raise a conversion error.
+extractDoubleTimingStatsResults :: MonadComp m => Results m -> [ResultExtract (TimingStats Double) m]
+extractDoubleTimingStatsResults rs = flip map (resultsToDoubleTimingStatsValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of timing statistics based on double floating point values: extractDoubleTimingStatsResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Extract the results as string values, or raise a conversion error.
+extractStringResults :: MonadComp m => Results m -> [ResultExtract String m]
+extractStringResults rs = flip map (resultsToStringValues rs) $ \x ->
+  let n = resultValueName x
+      i = resultValueId x
+      a = resultValueData x
+      s = resultValueSignal x
+  in case a of
+    Nothing ->
+      error $
+      "Cannot represent variable " ++ n ++
+      " as a source of string values: extractStringResults"
+    Just a ->
+      ResultExtract n i a s
+
+-- | Represents a computation that can return the simulation data.
+class MonadComp m => ResultComputing t m where
+
+  -- | Compute data with the results of simulation.
+  computeResultData :: t m a -> ResultData a m
+
+  -- | Return the signal triggered when data change if such a signal exists.
+  computeResultSignal :: t m a -> ResultSignal m
+
+-- | Return a new result value by the specified name, identifier and computation.
+computeResultValue :: ResultComputing t m
+                      => ResultName
+                      -- ^ the result name
+                      -> ResultId
+                      -- ^ the result identifier
+                      -> t m a
+                      -- ^ the result computation
+                      -> ResultValue a m
+computeResultValue name i m =
+  ResultValue {
+    resultValueName   = name,
+    resultValueId     = i,
+    resultValueData   = computeResultData m,
+    resultValueSignal = computeResultSignal m }
+
+instance MonadComp m => ResultComputing Parameter m where
+
+  computeResultData = Just . liftParameter
+  computeResultSignal = const UnknownResultSignal
+
+instance MonadComp m => ResultComputing Simulation m where
+
+  computeResultData = Just . liftSimulation
+  computeResultSignal = const UnknownResultSignal
+
+instance MonadComp m => ResultComputing Dynamics m where
+
+  computeResultData = Just . liftDynamics
+  computeResultSignal = const UnknownResultSignal
+
+instance MonadComp m => ResultComputing Event m where
+
+  computeResultData = Just . id
+  computeResultSignal = const UnknownResultSignal
+
+instance MonadComp m => ResultComputing Ref m where
+
+  computeResultData = Just . readRef
+  computeResultSignal = ResultSignal . refChanged_
+
+instance MonadComp m => ResultComputing LR.Ref m where
+
+  computeResultData = Just . LR.readRef
+  computeResultSignal = const UnknownResultSignal
+
+instance MonadComp m => ResultComputing Var m where
+
+  computeResultData = Just . readVar
+  computeResultSignal = ResultSignal . varChanged_
+
+instance MonadComp m => ResultComputing Signalable m where
+
+  computeResultData = Just . readSignalable
+  computeResultSignal = ResultSignal . signalableChanged_
+      
+-- | Return a source by the specified statistics.
+samplingStatsResultSource :: (MonadComp m,
+                              ResultItemable (ResultValue a),
+                              ResultItemable (ResultValue (SamplingStats a)))
+                             => ResultValue (SamplingStats a) m
+                             -- ^ the statistics
+                             -> ResultSource m
+samplingStatsResultSource x =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName      = resultValueName x,
+    resultObjectId        = resultValueId x,
+    resultObjectTypeId    = SamplingStatsId,
+    resultObjectSignal    = resultValueSignal x,
+    resultObjectSummary   = samplingStatsResultSummary x,
+    resultObjectProperties = [
+      resultContainerMapProperty c "count" SamplingStatsCountId samplingStatsCount,
+      resultContainerMapProperty c "mean" SamplingStatsMeanId samplingStatsMean,
+      resultContainerMapProperty c "mean2" SamplingStatsMean2Id samplingStatsMean2,
+      resultContainerMapProperty c "std" SamplingStatsDeviationId samplingStatsDeviation,
+      resultContainerMapProperty c "var" SamplingStatsVarianceId samplingStatsVariance,
+      resultContainerMapProperty c "min" SamplingStatsMinId samplingStatsMin,
+      resultContainerMapProperty c "max" SamplingStatsMaxId samplingStatsMax ] }
+  where
+    c = resultValueToContainer x
+
+-- | Return the summary by the specified statistics.
+samplingStatsResultSummary :: (MonadComp m,
+                               ResultItemable (ResultValue (SamplingStats a)))
+                              => ResultValue (SamplingStats a) m
+                              -- ^ the statistics
+                              -> ResultSource m
+samplingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue 
+  
+-- | Return a source by the specified timing statistics.
+timingStatsResultSource :: (MonadComp m,
+                            TimingData a,
+                            ResultItemable (ResultValue a),
+                            ResultItemable (ResultValue (TimingStats a)))
+                           => ResultValue (TimingStats a) m
+                           -- ^ the statistics
+                           -> ResultSource m
+timingStatsResultSource x =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName      = resultValueName x,
+    resultObjectId        = resultValueId x,
+    resultObjectTypeId    = TimingStatsId,
+    resultObjectSignal    = resultValueSignal x,
+    resultObjectSummary   = timingStatsResultSummary x,
+    resultObjectProperties = [
+      resultContainerMapProperty c "count" TimingStatsCountId timingStatsCount,
+      resultContainerMapProperty c "mean" TimingStatsMeanId timingStatsMean,
+      resultContainerMapProperty c "std" TimingStatsDeviationId timingStatsDeviation,
+      resultContainerMapProperty c "var" TimingStatsVarianceId timingStatsVariance,
+      resultContainerMapProperty c "min" TimingStatsMinId timingStatsMin,
+      resultContainerMapProperty c "max" TimingStatsMaxId timingStatsMax,
+      resultContainerMapProperty c "minTime" TimingStatsMinTimeId timingStatsMinTime,
+      resultContainerMapProperty c "maxTime" TimingStatsMaxTimeId timingStatsMaxTime,
+      resultContainerMapProperty c "startTime" TimingStatsStartTimeId timingStatsStartTime,
+      resultContainerMapProperty c "lastTime" TimingStatsLastTimeId timingStatsLastTime,
+      resultContainerMapProperty c "sum" TimingStatsSumId timingStatsSum,
+      resultContainerMapProperty c "sum2" TimingStatsSum2Id timingStatsSum2 ] }
+  where
+    c = resultValueToContainer x
+
+-- | Return the summary by the specified timing statistics.
+timingStatsResultSummary :: (MonadComp m,
+                             TimingData a,
+                             ResultItemable (ResultValue (TimingStats a)))
+                            => ResultValue (TimingStats a) m 
+                            -- ^ the statistics
+                            -> ResultSource m
+timingStatsResultSummary = ResultItemSource . ResultItem . resultItemToStringValue
+  
+-- | Return a source by the specified finite queue.
+queueResultSource :: (MonadComp m,
+                      Show si, Show sm, Show so,
+                      ResultItemable (ResultValue si),
+                      ResultItemable (ResultValue sm),
+                      ResultItemable (ResultValue so))
+                     => ResultContainer (Q.Queue m si sm so a) m
+                     -- ^ the queue container
+                     -> ResultSource m
+queueResultSource c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = FiniteQueueId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = queueResultSummary c,
+    resultObjectProperties = [
+      resultContainerConstProperty c "enqueueStrategy" EnqueueStrategyId Q.enqueueStrategy,
+      resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId Q.enqueueStoringStrategy,
+      resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId Q.dequeueStrategy,
+      resultContainerProperty c "queueNull" QueueNullId Q.queueNull Q.queueNullChanged_,
+      resultContainerProperty c "queueFull" QueueFullId Q.queueFull Q.queueFullChanged_,
+      resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
+      resultContainerProperty c "queueCount" QueueCountId Q.queueCount Q.queueCountChanged_,
+      resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
+      resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
+      resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
+      resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
+      resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
+      resultContainerIntegProperty c "enqueueRate" EnqueueRateId Q.enqueueRate,
+      resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId Q.enqueueStoreRate,
+      resultContainerIntegProperty c "dequeueRate" DequeueRateId Q.dequeueRate,
+      resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId Q.dequeueExtractRate,
+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
+      resultContainerProperty c "queueTotalWaitTime" QueueTotalWaitTimeId Q.queueTotalWaitTime Q.queueTotalWaitTimeChanged_,
+      resultContainerProperty c "enqueueWaitTime" EnqueueWaitTimeId Q.enqueueWaitTime Q.enqueueWaitTimeChanged_,
+      resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId Q.dequeueWaitTime Q.dequeueWaitTimeChanged_,
+      resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
+
+-- | Return the summary by the specified finite queue.
+queueResultSummary :: (MonadComp m,
+                       Show si, Show sm, Show so)
+                      => ResultContainer (Q.Queue m si sm so a) m
+                      -- ^ the queue container
+                      -> ResultSource m
+queueResultSummary c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = FiniteQueueId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = queueResultSummary c,
+    resultObjectProperties = [
+      resultContainerConstProperty c "queueMaxCount" QueueMaxCountId Q.queueMaxCount,
+      resultContainerProperty c "queueCountStats" QueueCountStatsId Q.queueCountStats Q.queueCountChanged_,
+      resultContainerProperty c "enqueueCount" EnqueueCountId Q.enqueueCount Q.enqueueCountChanged_,
+      resultContainerProperty c "enqueueLostCount" EnqueueLostCountId Q.enqueueLostCount Q.enqueueLostCountChanged_,
+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId Q.enqueueStoreCount Q.enqueueStoreCountChanged_,
+      resultContainerProperty c "dequeueCount" DequeueCountId Q.dequeueCount Q.dequeueCountChanged_,
+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId Q.dequeueExtractCount Q.dequeueExtractCountChanged_,
+      resultContainerProperty c "queueLoadFactor" QueueLoadFactorId Q.queueLoadFactor Q.queueLoadFactorChanged_,
+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId Q.queueWaitTime Q.queueWaitTimeChanged_,
+      resultContainerProperty c "queueRate" QueueRateId Q.queueRate Q.queueRateChanged_ ] }
+
+-- | Return a source by the specified infinite queue.
+infiniteQueueResultSource :: (MonadComp m,
+                              Show sm, Show so,
+                              ResultItemable (ResultValue sm),
+                              ResultItemable (ResultValue so))
+                             => ResultContainer (IQ.Queue m sm so a) m
+                             -- ^ the queue container
+                             -> ResultSource m
+infiniteQueueResultSource c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = FiniteQueueId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = infiniteQueueResultSummary c,
+    resultObjectProperties = [
+      resultContainerConstProperty c "enqueueStoringStrategy" EnqueueStoringStrategyId IQ.enqueueStoringStrategy,
+      resultContainerConstProperty c "dequeueStrategy" DequeueStrategyId IQ.dequeueStrategy,
+      resultContainerProperty c "queueNull" QueueNullId IQ.queueNull IQ.queueNullChanged_,
+      resultContainerProperty c "queueCount" QueueCountId IQ.queueCount IQ.queueCountChanged_,
+      resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
+      resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
+      resultContainerIntegProperty c "enqueueStoreRate" EnqueueStoreRateId IQ.enqueueStoreRate,
+      resultContainerIntegProperty c "dequeueRate" DequeueRateId IQ.dequeueRate,
+      resultContainerIntegProperty c "dequeueExtractRate" DequeueExtractRateId IQ.dequeueExtractRate,
+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
+      resultContainerProperty c "dequeueWaitTime" DequeueWaitTimeId IQ.dequeueWaitTime IQ.dequeueWaitTimeChanged_,
+      resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
+
+-- | Return the summary by the specified infinite queue.
+infiniteQueueResultSummary :: (MonadComp m,
+                               Show sm, Show so)
+                              => ResultContainer (IQ.Queue m sm so a) m
+                              -- ^ the queue container
+                              -> ResultSource m
+infiniteQueueResultSummary c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = FiniteQueueId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = infiniteQueueResultSummary c,
+    resultObjectProperties = [
+      resultContainerProperty c "queueCountStats" QueueCountStatsId IQ.queueCountStats IQ.queueCountChanged_,
+      resultContainerProperty c "enqueueStoreCount" EnqueueStoreCountId IQ.enqueueStoreCount IQ.enqueueStoreCountChanged_,
+      resultContainerProperty c "dequeueCount" DequeueCountId IQ.dequeueCount IQ.dequeueCountChanged_,
+      resultContainerProperty c "dequeueExtractCount" DequeueExtractCountId IQ.dequeueExtractCount IQ.dequeueExtractCountChanged_,
+      resultContainerProperty c "queueWaitTime" QueueWaitTimeId IQ.queueWaitTime IQ.queueWaitTimeChanged_,
+      resultContainerProperty c "queueRate" QueueRateId IQ.queueRate IQ.queueRateChanged_ ] }
+  
+-- | Return a source by the specified arrival timer.
+arrivalTimerResultSource :: MonadComp m
+                            => ResultContainer (ArrivalTimer m) m
+                            -- ^ the arrival timer container
+                            -> ResultSource m
+arrivalTimerResultSource c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = ArrivalTimerId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = arrivalTimerResultSummary c,
+    resultObjectProperties = [
+      resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
+
+-- | Return the summary by the specified arrival timer.
+arrivalTimerResultSummary :: MonadComp m
+                             => ResultContainer (ArrivalTimer m) m
+                             -- ^ the arrival timer container
+                             -> ResultSource m
+arrivalTimerResultSummary c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = ArrivalTimerId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = arrivalTimerResultSummary c,
+    resultObjectProperties = [
+      resultContainerProperty c "processingTime" ArrivalProcessingTimeId arrivalProcessingTime arrivalProcessingTimeChanged_ ] }
+
+-- | Return a source by the specified server.
+serverResultSource :: (MonadComp m,
+                       Show s, ResultItemable (ResultValue s))
+                      => ResultContainer (Server m s a b) m
+                      -- ^ the server container
+                      -> ResultSource m
+serverResultSource c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = ServerId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = serverResultSummary c,
+    resultObjectProperties = [
+      resultContainerConstProperty c "initState" ServerInitStateId serverInitState,
+      resultContainerProperty c "state" ServerStateId serverState serverStateChanged_,
+      resultContainerProperty c "totalInputWaitTime" ServerTotalInputWaitTimeId serverTotalInputWaitTime serverTotalInputWaitTimeChanged_,
+      resultContainerProperty c "totalProcessingTime" ServerTotalProcessingTimeId serverTotalProcessingTime serverTotalProcessingTimeChanged_,
+      resultContainerProperty c "totalOutputWaitTime" ServerTotalOutputWaitTimeId serverTotalOutputWaitTime serverTotalOutputWaitTimeChanged_,
+      resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
+      resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
+      resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
+      resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
+      resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
+      resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
+
+-- | Return the summary by the specified server.
+serverResultSummary :: MonadComp m
+                       => ResultContainer (Server m s a b) m
+                       -- ^ the server container
+                       -> ResultSource m
+serverResultSummary c =
+  ResultObjectSource $
+  ResultObject {
+    resultObjectName = resultContainerName c,
+    resultObjectId = resultContainerId c,
+    resultObjectTypeId = ServerId,
+    resultObjectSignal = resultContainerSignal c,
+    resultObjectSummary = serverResultSummary c,
+    resultObjectProperties = [
+      resultContainerProperty c "inputWaitTime" ServerInputWaitTimeId serverInputWaitTime serverInputWaitTimeChanged_,
+      resultContainerProperty c "processingTime" ServerProcessingTimeId serverProcessingTime serverProcessingTimeChanged_,
+      resultContainerProperty c "outputWaitTime" ServerOutputWaitTimeId serverOutputWaitTime serverOutputWaitTimeChanged_,
+      resultContainerProperty c "inputWaitFactor" ServerInputWaitFactorId serverInputWaitFactor serverInputWaitFactorChanged_,
+      resultContainerProperty c "processingFactor" ServerProcessingFactorId serverProcessingFactor serverProcessingFactorChanged_,
+      resultContainerProperty c "outputWaitFactor" ServerOutputWaitFactorId serverOutputWaitFactor serverOutputWaitFactorChanged_ ] }
+
+-- | Return an arbitrary text as a separator source.
+textResultSource :: String -> ResultSource m
+textResultSource text =
+  ResultSeparatorSource $
+  ResultSeparator { resultSeparatorText = text }
+
+-- | Return the source of the modeling time.
+timeResultSource :: MonadComp m => ResultSource m
+timeResultSource = resultSource' "t" TimeId time
+                         
+-- | Make an integer subscript
+intSubscript :: Int -> ResultName
+intSubscript i = "[" ++ show i ++ "]"
+
+instance ResultComputing t m => ResultProvider (t m Double) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m [Double]) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m (SamplingStats Double)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m (TimingStats Double)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m Int) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m [Int]) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m (SamplingStats Int)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m (TimingStats Int)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m String) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ computeResultValue name i m
+
+instance ResultProvider p m => ResultProvider [p] m where
+
+  resultSource' name i m =
+    resultSource' name i $ ResultListWithSubscript m subscript where
+      subscript = map snd $ zip m $ map intSubscript [0..]
+
+instance (Show i, Ix i, ResultProvider p m) => ResultProvider (A.Array i p) m where
+
+  resultSource' name i m =
+    resultSource' name i $ ResultListWithSubscript items subscript where
+      items = A.elems m
+      subscript = map (\i -> "[" ++ show i ++ "]") (A.indices m)
+
+#ifndef __HASTE__
+
+instance ResultProvider p m => ResultProvider (V.Vector p) m where
+  
+  resultSource' name i m =
+    resultSource' name i $ ResultVectorWithSubscript m subscript where
+      subscript = V.imap (\i x -> intSubscript i) m
+
+#endif
+
+-- | Represents a list with the specified subscript.
+data ResultListWithSubscript p =
+  ResultListWithSubscript [p] [String]
+
+-- | Represents an array with the specified subscript.
+data ResultArrayWithSubscript i p =
+  ResultArrayWithSubscript (A.Array i p) (A.Array i String)
+
+#ifndef __HASTE__
+
+-- | Represents a vector with the specified subscript.
+data ResultVectorWithSubscript p =
+  ResultVectorWithSubscript (V.Vector p) (V.Vector String)
+
+#endif
+
+instance ResultProvider p m => ResultProvider (ResultListWithSubscript p) m where
+
+  resultSource' name i (ResultListWithSubscript xs ys) =
+    ResultVectorSource $
+    memoResultVectorSignal $
+    memoResultVectorSummary $
+    ResultVector { resultVectorName = name,
+                   resultVectorId = i,
+                   resultVectorItems = axs,
+                   resultVectorSubscript = ays,
+                   resultVectorSignal = undefined,
+                   resultVectorSummary = undefined }
+    where
+      bnds   = (0, length xs - 1)
+      axs    = A.listArray bnds items
+      ays    = A.listArray bnds ys
+      items  =
+        flip map (zip ys xs) $ \(y, x) ->
+        let name' = name ++ y
+        in resultSource' name' (VectorItemId y) x
+      items' = map resultSourceSummary items
+    
+instance (Show i, Ix i, ResultProvider p m) => ResultProvider (ResultArrayWithSubscript i p) m where
+
+  resultSource' name i (ResultArrayWithSubscript xs ys) =
+    resultSource' name i $ ResultListWithSubscript items subscript where
+      items = A.elems xs
+      subscript = A.elems ys
+      
+#ifndef __HASTE__
+
+instance ResultProvider p m => ResultProvider (ResultVectorWithSubscript p) m where
+
+  resultSource' name i (ResultVectorWithSubscript xs ys) =
+    ResultVectorSource $
+    memoResultVectorSignal $
+    memoResultVectorSummary $
+    ResultVector { resultVectorName = name,
+                   resultVectorId = i,
+                   resultVectorItems = axs,
+                   resultVectorSubscript = ays,
+                   resultVectorSignal = undefined,
+                   resultVectorSummary = undefined }
+    where
+      bnds   = (0, V.length xs - 1)
+      axs    = A.listArray bnds (V.toList items)
+      ays    = A.listArray bnds (V.toList ys)
+      items =
+        V.generate (V.length xs) $ \i ->
+        let x = xs V.! i
+            y = ys V.! i
+            name' = name ++ y
+        in resultSource' name' (VectorItemId y) x
+      items' = V.map resultSourceSummary items
+
+#endif
+
+instance (Ix i, Show i, ResultComputing t m) => ResultProvider (t m (A.Array i Double)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ mapResultValue A.elems $ computeResultValue name i m
+
+instance (Ix i, Show i, ResultComputing t m) => ResultProvider (t m (A.Array i Int)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ mapResultValue A.elems $ computeResultValue name i m
+
+#ifndef __HASTE__
+
+instance ResultComputing t m => ResultProvider (t m (V.Vector Double)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ mapResultValue V.toList $ computeResultValue name i m
+
+instance ResultComputing t m => ResultProvider (t m (V.Vector Int)) m where
+
+  resultSource' name i m =
+    ResultItemSource $ ResultItem $ mapResultValue V.toList $ computeResultValue name i m
+
+#endif
+
+instance (MonadComp m,
+          Show si, Show sm, Show so,
+          ResultItemable (ResultValue si),
+          ResultItemable (ResultValue sm),
+          ResultItemable (ResultValue so))
+         => ResultProvider (Q.Queue m si sm so a) m where
+
+  resultSource' name i m =
+    queueResultSource $ ResultContainer name i m (ResultSignal $ Q.queueChanged_ m)
+
+instance (MonadComp m,
+          Show sm, Show so,
+          ResultItemable (ResultValue sm),
+          ResultItemable (ResultValue so))
+         => ResultProvider (IQ.Queue m sm so a) m where
+
+  resultSource' name i m =
+    infiniteQueueResultSource $ ResultContainer name i m (ResultSignal $ IQ.queueChanged_ m)
+
+instance MonadComp m => ResultProvider (ArrivalTimer m) m where
+
+  resultSource' name i m =
+    arrivalTimerResultSource $ ResultContainer name i m (ResultSignal $ arrivalProcessingTimeChanged_ m)
+
+instance (MonadComp m, Show s, ResultItemable (ResultValue s)) => ResultProvider (Server m s a b) m where
+
+  resultSource' name i m =
+    serverResultSource $ ResultContainer name i m (ResultSignal $ serverChanged_ m)
+ Simulation/Aivika/Trans/Results/IO.hs view
@@ -0,0 +1,485 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Results.IO
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module allows printing and converting the 'Simulation' 'Results' to a 'String'.
+--
+module Simulation.Aivika.Trans.Results.IO
+       (-- * Basic Types
+        ResultSourcePrint,
+        ResultSourceShowS,
+        -- * Printing the Results
+        printResultsWithTime,
+        printResultsInStartTime,
+        printResultsInStopTime,
+        printResultsInIntegTimes,
+        printResultsInTime,
+        printResultsInTimes,
+        -- * Simulating and Printing the Results
+        printSimulationResultsInStartTime,
+        printSimulationResultsInStopTime,
+        printSimulationResultsInIntegTimes,
+        printSimulationResultsInTime,
+        printSimulationResultsInTimes,
+        -- * Showing the Results
+        showResultsWithTime,
+        showResultsInStartTime,
+        showResultsInStopTime,
+        showResultsInIntegTimes,
+        showResultsInTime,
+        showResultsInTimes,
+        -- * Simulating and Showing the Results
+        showSimulationResultsInStartTime,
+        showSimulationResultsInStopTime,
+        showSimulationResultsInIntegTimes,
+        showSimulationResultsInTime,
+        showSimulationResultsInTimes,
+        -- * Printing the Result Source
+        hPrintResultSourceIndented,
+        hPrintResultSource,
+        hPrintResultSourceInRussian,
+        hPrintResultSourceInEnglish,
+        printResultSourceIndented,
+        printResultSource,
+        printResultSourceInRussian,
+        printResultSourceInEnglish,
+        -- * Showing the Result Source
+        showResultSourceIndented,
+        showResultSource,
+        showResultSourceInRussian,
+        showResultSourceInEnglish) where
+
+import Control.Monad
+import Control.Monad.Trans
+
+import qualified Data.Map as M
+import qualified Data.Array as A
+
+import System.IO
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Specs
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Results
+import Simulation.Aivika.Trans.Results.Locale
+
+-- | This is a function that shows the simulation results within
+-- the 'Event' computation synchronized with the event queue.
+type ResultSourceShowS m = ResultSource m -> Event m ShowS
+
+-- | This is a function that prints the simulation results within
+-- the 'Event' computation synchronized with the event queue.
+type ResultSourcePrint m = ResultSource m -> Event m ()
+
+-- | Print a localised text representation of the results by the specified source
+-- and with the given indent.
+hPrintResultSourceIndented :: (MonadComp m, MonadIO m)
+                              => Handle
+                              -- ^ a handle
+                              -> Int
+                              -- ^ an indent
+                              -> ResultLocalisation
+                              -- ^ a localisation
+                              -> ResultSourcePrint m
+hPrintResultSourceIndented h indent loc source@(ResultItemSource (ResultItem x)) =
+  hPrintResultSourceIndentedLabelled h indent (resultItemName x) loc source
+hPrintResultSourceIndented h indent loc source@(ResultVectorSource x) =
+  hPrintResultSourceIndentedLabelled h indent (resultVectorName x) loc source
+hPrintResultSourceIndented h indent loc source@(ResultObjectSource x) =
+  hPrintResultSourceIndentedLabelled h indent (resultObjectName x) loc source
+hPrintResultSourceIndented h indent loc source@(ResultSeparatorSource x) =
+  hPrintResultSourceIndentedLabelled h indent (resultSeparatorText x) loc source
+
+-- | Print an indented and labelled text representation of the results by
+-- the specified source.
+hPrintResultSourceIndentedLabelled :: (MonadComp m, MonadIO m)
+                                      => Handle
+                                      -- ^ a handle
+                                      -> Int
+                                      -- ^ an indent
+                                      -> ResultName
+                                      -- ^ a label
+                                      -> ResultLocalisation
+                                      -- ^ a localisation
+                                      -> ResultSourcePrint m
+hPrintResultSourceIndentedLabelled h indent label loc (ResultItemSource (ResultItem x)) =
+  case resultValueData (resultItemToStringValue x) of
+    Just m ->
+      do a <- m
+         let tab = replicate indent ' '
+         liftIO $
+           do hPutStr h tab
+              hPutStr h "-- "
+              hPutStr h (loc $ resultItemId x)
+              hPutStrLn h ""
+              hPutStr h tab
+              hPutStr h label
+              hPutStr h " = "
+              hPutStrLn h a
+              hPutStrLn h ""
+    _ ->
+      error $
+      "Expected to see a string value for variable " ++
+      (resultItemName x) ++ ": hPrintResultSourceIndentedLabelled"
+hPrintResultSourceIndentedLabelled h indent label loc (ResultVectorSource x) =
+  do let tab = replicate indent ' '
+     liftIO $
+       do hPutStr h tab
+          hPutStr h "-- "
+          hPutStr h (loc $ resultVectorId x)
+          hPutStrLn h ""
+          hPutStr h tab
+          hPutStr h label
+          hPutStrLn h ":"
+          hPutStrLn h ""
+     let items = A.elems (resultVectorItems x)
+         subscript = A.elems (resultVectorSubscript x)
+     forM_ (zip items subscript) $ \(i, s) ->
+       hPrintResultSourceIndentedLabelled h (indent + 2) (label ++ s) loc i
+hPrintResultSourceIndentedLabelled h indent label loc (ResultObjectSource x) =
+  do let tab = replicate indent ' '
+     liftIO $
+       do hPutStr h tab
+          hPutStr h "-- "
+          hPutStr h (loc $ resultObjectId x)
+          hPutStrLn h ""
+          hPutStr h tab
+          hPutStr h label
+          hPutStrLn h ":"
+          hPutStrLn h ""
+     forM_ (resultObjectProperties x) $ \p ->
+       do let indent' = 2 + indent
+              tab'    = "  " ++ tab
+              label'  = resultPropertyLabel p
+              source' = resultPropertySource p
+          hPrintResultSourceIndentedLabelled h indent' label' loc source'
+hPrintResultSourceIndentedLabelled h indent label loc (ResultSeparatorSource x) =
+  do let tab = replicate indent ' '
+     liftIO $
+       do hPutStr h tab
+          hPutStr h label
+          hPutStrLn h ""
+          hPutStrLn h ""
+
+-- | Print a localised text representation of the results by the specified source
+-- and with the given indent.
+printResultSourceIndented :: (MonadComp m, MonadIO m)
+                             => Int
+                             -- ^ an indent
+                             -> ResultLocalisation
+                             -- ^ a localisation
+                             -> ResultSourcePrint m
+printResultSourceIndented = hPrintResultSourceIndented stdout
+
+-- | Print a localised text representation of the results by the specified source.
+hPrintResultSource :: (MonadComp m, MonadIO m)
+                      => Handle
+                      -- ^ a handle
+                      -> ResultLocalisation
+                      -- ^ a localisation
+                      -> ResultSourcePrint m
+hPrintResultSource h = hPrintResultSourceIndented h 0
+
+-- | Print a localised text representation of the results by the specified source.
+printResultSource :: (MonadComp m, MonadIO m)
+                     => ResultLocalisation
+                     -- ^ a localisation
+                     -> ResultSourcePrint m
+printResultSource = hPrintResultSource stdout
+
+-- | Print in Russian a text representation of the results by the specified source.
+hPrintResultSourceInRussian :: (MonadComp m, MonadIO m) => Handle -> ResultSourcePrint m
+hPrintResultSourceInRussian h = hPrintResultSource h russianResultLocalisation
+
+-- | Print in English a text representation of the results by the specified source.
+hPrintResultSourceInEnglish :: (MonadComp m, MonadIO m) => Handle -> ResultSourcePrint m
+hPrintResultSourceInEnglish h = hPrintResultSource h englishResultLocalisation
+
+-- | Print in Russian a text representation of the results by the specified source.
+printResultSourceInRussian :: (MonadComp m, MonadIO m) => ResultSourcePrint m
+printResultSourceInRussian = hPrintResultSourceInRussian stdout
+
+-- | Print in English a text representation of the results by the specified source.
+printResultSourceInEnglish :: (MonadComp m, MonadIO m) => ResultSourcePrint m
+printResultSourceInEnglish = hPrintResultSourceInEnglish stdout
+
+-- | Show a localised text representation of the results by the specified source
+-- and with the given indent.
+showResultSourceIndented :: MonadComp m
+                            => Int
+                            -- ^ an indent
+                            -> ResultLocalisation
+                            -- ^ a localisation
+                            -> ResultSourceShowS m
+showResultSourceIndented indent loc source@(ResultItemSource (ResultItem x)) =
+  showResultSourceIndentedLabelled indent (resultItemName x) loc source
+showResultSourceIndented indent loc source@(ResultVectorSource x) =
+  showResultSourceIndentedLabelled indent (resultVectorName x) loc source
+showResultSourceIndented indent loc source@(ResultObjectSource x) =
+  showResultSourceIndentedLabelled indent (resultObjectName x) loc source
+showResultSourceIndented indent loc source@(ResultSeparatorSource x) =
+  showResultSourceIndentedLabelled indent (resultSeparatorText x) loc source
+
+-- | Show an indented and labelled text representation of the results by the specified source.
+showResultSourceIndentedLabelled :: MonadComp m
+                                    => Int
+                                    -- ^ an indent
+                                    -> String
+                                    -- ^ a label
+                                    -> ResultLocalisation
+                                    -- ^ a localisation
+                                    -> ResultSourceShowS m
+showResultSourceIndentedLabelled indent label loc (ResultItemSource (ResultItem x)) =
+  case resultValueData (resultItemToStringValue x) of
+    Just m ->
+      do a <- m
+         let tab = replicate indent ' '
+         return $
+           showString tab .
+           showString "-- " .
+           showString (loc $ resultItemId x) .
+           showString "\n" .
+           showString tab .
+           showString label .
+           showString " = " .
+           showString a .
+           showString "\n\n"
+    _ ->
+      error $
+      "Expected to see a string value for variable " ++
+      (resultItemName x) ++ ": showResultSourceIndentedLabelled"
+showResultSourceIndentedLabelled indent label loc (ResultVectorSource x) =
+  do let tab = replicate indent ' '
+         items = A.elems (resultVectorItems x)
+         subscript = A.elems (resultVectorSubscript x)
+     contents <-
+       forM (zip items subscript) $ \(i, s) ->
+       showResultSourceIndentedLabelled (indent + 2) (label ++ s) loc i
+     let showContents = foldr (.) id contents
+     return $
+       showString tab .
+       showString "-- " .
+       showString (loc $ resultVectorId x) .
+       showString "\n" .
+       showString tab .
+       showString label .
+       showString ":\n\n" .
+       showContents
+showResultSourceIndentedLabelled indent label loc (ResultObjectSource x) =
+  do let tab = replicate indent ' '
+     contents <-
+       forM (resultObjectProperties x) $ \p ->
+       do let indent' = 2 + indent
+              tab'    = "  " ++ tab
+              label'  = resultPropertyLabel p
+              output' = resultPropertySource p
+          showResultSourceIndentedLabelled indent' label' loc output'
+     let showContents = foldr (.) id contents
+     return $
+       showString tab .
+       showString "-- " .
+       showString (loc $ resultObjectId x) .
+       showString "\n" .
+       showString tab .
+       showString label .
+       showString ":\n\n" .
+       showContents
+showResultSourceIndentedLabelled indent label loc (ResultSeparatorSource x) =
+  do let tab = replicate indent ' '
+     return $
+       showString tab .
+       showString label .
+       showString "\n\n"
+
+-- | Show a localised text representation of the results by the specified source.
+showResultSource :: MonadComp m
+                    => ResultLocalisation
+                    -- ^ a localisation
+                    -> ResultSourceShowS m
+showResultSource = showResultSourceIndented 0
+
+-- | Show in Russian a text representation of the results by the specified source.
+showResultSourceInRussian :: MonadComp m => ResultSourceShowS m
+showResultSourceInRussian = showResultSource russianResultLocalisation
+
+-- | Show in English a text representation of the results by the specified source.
+showResultSourceInEnglish :: MonadComp m => ResultSourceShowS m
+showResultSourceInEnglish = showResultSource englishResultLocalisation
+
+-- | Print the results with the information about the modeling time.
+printResultsWithTime :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Results m -> Event m ()
+printResultsWithTime print results =
+  do let x1 = textResultSource "----------"
+         x2 = timeResultSource
+         x3 = textResultSource ""
+         xs = resultSourceList results
+     print x1
+     print x2
+     -- print x3
+     mapM_ print xs
+     -- print x3
+
+-- | Print the simulation results in start time.
+printResultsInStartTime :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Results m -> Simulation m ()
+printResultsInStartTime print results =
+  runEventInStartTime $ printResultsWithTime print results
+
+-- | Print the simulation results in stop time.
+printResultsInStopTime :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Results m -> Simulation m ()
+printResultsInStopTime print results =
+  runEventInStopTime $ printResultsWithTime print results
+
+-- | Print the simulation results in the integration time points.
+printResultsInIntegTimes :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Results m -> Simulation m ()
+printResultsInIntegTimes print results =
+  do let loop (m : ms) = m >> loop ms
+         loop [] = return ()
+     ms <- runDynamicsInIntegTimes $ runEvent $
+           printResultsWithTime print results
+     liftComp $ loop ms
+
+-- | Print the simulation results in the specified time.
+printResultsInTime :: (MonadComp m, MonadIO m) => Double -> ResultSourcePrint m -> Results m -> Simulation m ()
+printResultsInTime t print results =
+  runDynamicsInTime t $ runEvent $
+  printResultsWithTime print results
+
+-- | Print the simulation results in the specified time points.
+printResultsInTimes :: (MonadComp m, MonadIO m) => [Double] -> ResultSourcePrint m -> Results m -> Simulation m ()
+printResultsInTimes ts print results =
+  do let loop (m : ms) = m >> loop ms
+         loop [] = return ()
+     ms <- runDynamicsInTimes ts $ runEvent $
+           printResultsWithTime print results
+     liftComp $ loop ms
+
+-- | Show the results with the information about the modeling time.
+showResultsWithTime :: MonadComp m => ResultSourceShowS m -> Results m -> Event m ShowS
+showResultsWithTime f results =
+  do let x1 = textResultSource "----------"
+         x2 = timeResultSource
+         x3 = textResultSource ""
+         xs = resultSourceList results
+     y1 <- f x1
+     y2 <- f x2
+     y3 <- f x3
+     ys <- forM xs f
+     return $
+       y1 .
+       y2 .
+       -- y3 .
+       foldr (.) id ys
+       -- y3
+
+-- | Show the simulation results in start time.
+showResultsInStartTime :: MonadComp m => ResultSourceShowS m -> Results m -> Simulation m ShowS
+showResultsInStartTime f results =
+  runEventInStartTime $ showResultsWithTime f results
+
+-- | Show the simulation results in stop time.
+showResultsInStopTime :: MonadComp m => ResultSourceShowS m -> Results m -> Simulation m ShowS
+showResultsInStopTime f results =
+  runEventInStopTime $ showResultsWithTime f results
+
+-- | Show the simulation results in the integration time points.
+--
+-- It may consume much memory, for we have to traverse all the integration
+-- points to create the resulting function within the 'Simulation' computation.
+showResultsInIntegTimes :: MonadComp m => ResultSourceShowS m -> Results m -> Simulation m ShowS
+showResultsInIntegTimes f results =
+  do let loop (m : ms) = return (.) `ap` m `ap` loop ms
+         loop [] = return id
+     ms <- runDynamicsInIntegTimes $ runEvent $
+           showResultsWithTime f results
+     liftComp $ loop ms
+
+-- | Show the simulation results in the specified time point.
+showResultsInTime :: MonadComp m => Double -> ResultSourceShowS m -> Results m -> Simulation m ShowS
+showResultsInTime t f results =
+  runDynamicsInTime t $ runEvent $
+  showResultsWithTime f results
+
+-- | Show the simulation results in the specified time points.
+--
+-- It may consume much memory, for we have to traverse all the specified
+-- points to create the resulting function within the 'Simulation' computation.
+showResultsInTimes :: MonadComp m => [Double] -> ResultSourceShowS m -> Results m -> Simulation m ShowS
+showResultsInTimes ts f results =
+  do let loop (m : ms) = return (.) `ap` m `ap` loop ms
+         loop [] = return id
+     ms <- runDynamicsInTimes ts $ runEvent $
+           showResultsWithTime f results
+     liftComp $ loop ms
+
+-- | Run the simulation and then print the results in the start time.
+printSimulationResultsInStartTime :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
+printSimulationResultsInStartTime print model specs =
+  flip runSimulation specs $
+  model >>= printResultsInStartTime print
+
+-- | Run the simulation and then print the results in the final time.
+printSimulationResultsInStopTime :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
+printSimulationResultsInStopTime print model specs =
+  flip runSimulation specs $
+  model >>= printResultsInStopTime print
+
+-- | Run the simulation and then print the results in the integration time points.
+printSimulationResultsInIntegTimes :: (MonadComp m, MonadIO m) => ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
+printSimulationResultsInIntegTimes print model specs =
+  flip runSimulation specs $
+  model >>= printResultsInIntegTimes print
+
+-- | Run the simulation and then print the results in the specified time point.
+printSimulationResultsInTime :: (MonadComp m, MonadIO m) => Double -> ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
+printSimulationResultsInTime t print model specs =
+  flip runSimulation specs $
+  model >>= printResultsInTime t print
+
+-- | Run the simulation and then print the results in the specified time points.
+printSimulationResultsInTimes :: (MonadComp m, MonadIO m) => [Double] -> ResultSourcePrint m -> Simulation m (Results m) -> Specs m -> m ()
+printSimulationResultsInTimes ts print model specs =
+  flip runSimulation specs $
+  model >>= printResultsInTimes ts print
+
+-- | Run the simulation and then show the results in the start time.
+showSimulationResultsInStartTime :: MonadComp m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
+showSimulationResultsInStartTime f model specs =
+  flip runSimulation specs $
+  model >>= showResultsInStartTime f
+
+-- | Run the simulation and then show the results in the final time.
+showSimulationResultsInStopTime :: MonadComp m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
+showSimulationResultsInStopTime f model specs =
+  flip runSimulation specs $
+  model >>= showResultsInStopTime f
+
+-- | Run the simulation and then show the results in the integration time points.
+--
+-- It may consume much memory, for we have to traverse all the integration
+-- points to create the resulting function within the 'IO' computation.
+showSimulationResultsInIntegTimes :: MonadComp m => ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
+showSimulationResultsInIntegTimes f model specs =
+  flip runSimulation specs $
+  model >>= showResultsInIntegTimes f
+
+-- | Run the simulation and then show the results in the integration time point.
+showSimulationResultsInTime :: MonadComp m => Double -> ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
+showSimulationResultsInTime t f model specs =
+  flip runSimulation specs $
+  model >>= showResultsInTime t f
+
+-- | Run the simulation and then show the results in the specified time points.
+--
+-- It may consume much memory, for we have to traverse all the specified
+-- points to create the resulting function within the 'IO' computation.
+showSimulationResultsInTimes :: MonadComp m => [Double] -> ResultSourceShowS m -> Simulation m (Results m) -> Specs m -> m ShowS
+showSimulationResultsInTimes ts f model specs =
+  flip runSimulation specs $
+  model >>= showResultsInTimes ts f
+ Simulation/Aivika/Trans/Results/Locale.hs view
@@ -0,0 +1,340 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Results.Locale
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines locales for outputting and printing the simulation results.
+--
+module Simulation.Aivika.Trans.Results.Locale
+       (-- * Basic Types
+        ResultLocale,
+        ResultLocalisation,
+        ResultDescription,
+        -- * Locale Codes
+        russianResultLocale,
+        englishResultLocale,
+        -- * Localisations
+        lookupResultLocalisation,
+        russianResultLocalisation,
+        englishResultLocalisation,
+        -- * Unique Identifiers
+        ResultId(..)) where
+
+import qualified Data.Map as M
+
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Statistics.Accumulator
+import qualified Simulation.Aivika.Trans.Queue as Q
+import qualified Simulation.Aivika.Trans.Queue.Infinite as IQ
+import Simulation.Aivika.Trans.Arrival
+import Simulation.Aivika.Trans.Server
+
+-- | A locale to output the simulation results.
+--
+-- Examples are: @\"ru\", @\"en\" etc.
+type ResultLocale = String
+
+-- | It localises the description of simulation results.
+type ResultLocalisation = ResultId -> ResultDescription
+
+-- | A description used for describing the results when generating output.
+type ResultDescription = String
+
+-- | The result entity identifier.
+data ResultId = TimeId
+                -- ^ A 'time' computation.
+              | VectorId
+                -- ^ Describes a vector.
+              | VectorItemId String
+                -- ^ Describes a vector item with the specified subscript.
+              | SamplingStatsId
+                -- ^ A 'SamplingStats' value.
+              | SamplingStatsCountId
+                -- ^ Property 'samplingStatsCount'.
+              | SamplingStatsMinId
+                -- ^ Property 'samplingStatsMin'.
+              | SamplingStatsMaxId
+                -- ^ Property 'samplingStatsMax'.
+              | SamplingStatsMeanId
+                -- ^ Property 'samplingStatsMean'.
+              | SamplingStatsMean2Id
+                -- ^ Property 'samplingStatsMean2'.
+              | SamplingStatsVarianceId
+                -- ^ Property 'samplingStatsVariance'.
+              | SamplingStatsDeviationId
+                -- ^ Property 'samplingStatsDeviation'.
+              | TimingStatsId
+                -- ^ A 'TimingStats' value.
+              | TimingStatsCountId
+                -- ^ Property 'timingStatsCount'.
+              | TimingStatsMinId
+                -- ^ Property 'timingStatsMin'.
+              | TimingStatsMaxId
+                -- ^ Property 'timingStatsMax'.
+              | TimingStatsMeanId
+                -- ^ Property 'timingStatsMean'.
+              | TimingStatsVarianceId
+                -- ^ Property 'timingStatsVariance'.
+              | TimingStatsDeviationId
+                -- ^ Property 'timingStatsDeviation'.
+              | TimingStatsMinTimeId
+                -- ^ Property 'timingStatsMinTime'.
+              | TimingStatsMaxTimeId
+                -- ^ Property 'timingStatsMaxTime'.
+              | TimingStatsStartTimeId
+                -- ^ Property 'timingStatsStartTime'.
+              | TimingStatsLastTimeId
+                -- ^ Property 'timingStatsLastTime'.
+              | TimingStatsSumId
+                -- ^ Property 'timingStatsSum'.
+              | TimingStatsSum2Id
+                -- ^ Property 'timingStatsSum2'.
+              | FiniteQueueId
+                -- ^ A finite 'Q.Queue'.
+              | InfiniteQueueId
+                -- ^ An infinite 'IQ.Queue'.
+              | EnqueueStrategyId
+                -- ^ Property 'Q.enqueueStrategy'.
+              | EnqueueStoringStrategyId
+                -- ^ Property 'Q.enqueueStoringStrategy'.
+              | DequeueStrategyId
+                -- ^ Property 'Q.dequeueStrategy'.
+              | QueueNullId
+                -- ^ Property 'Q.queueNull'.
+              | QueueFullId
+                -- ^ Property 'Q.queueFull'.
+              | QueueMaxCountId
+                -- ^ Property 'Q.queueMaxCount'.
+              | QueueCountId
+                -- ^ Property 'Q.queueCount'.
+              | QueueCountStatsId
+                -- ^ Property 'Q.queueCountStats'.
+              | EnqueueCountId
+                -- ^ Property 'Q.enqueueCount'.
+              | EnqueueLostCountId
+                -- ^ Property 'Q.enqueueLostCount'.
+              | EnqueueStoreCountId
+                -- ^ Property 'Q.enqueueStoreCount'.
+              | DequeueCountId
+                -- ^ Property 'Q.dequeueCount'.
+              | DequeueExtractCountId
+                -- ^ Property 'Q.dequeueExtractCount'.
+              | QueueLoadFactorId
+                -- ^ Property 'Q.queueLoadFactor'.
+              | EnqueueRateId
+                -- ^ Property 'Q.enqueueRate'.
+              | EnqueueStoreRateId
+                -- ^ Property 'Q.enqueueStoreRate'.
+              | DequeueRateId
+                -- ^ Property 'Q.dequeueRate'.
+              | DequeueExtractRateId
+                -- ^ Property 'Q.dequeueExtractRate'.
+              | QueueWaitTimeId
+                -- ^ Property 'Q.queueWaitTime'.
+              | QueueTotalWaitTimeId
+                -- ^ Property 'Q.queueTotalWaitTime'.
+              | EnqueueWaitTimeId
+                -- ^ Property 'Q.enqueueWaitTime'.
+              | DequeueWaitTimeId
+                -- ^ Property 'Q.dequeueWaitTime'.
+              | QueueRateId
+                -- ^ Property 'Q.queueRate'.
+              | ArrivalTimerId
+                -- ^ An 'ArrivalTimer'.
+              | ArrivalProcessingTimeId
+                -- ^ Property 'arrivalProcessingTime'.
+              | ServerId
+                -- ^ Represents a 'Server'.
+              | ServerInitStateId
+                -- ^ Property 'serverInitState'.
+              | ServerStateId
+                -- ^ Property 'serverState'.
+              | ServerTotalInputWaitTimeId
+                -- ^ Property 'serverTotalInputWaitTime'.
+              | ServerTotalProcessingTimeId
+                -- ^ Property 'serverTotalProcessingTime'.
+              | ServerTotalOutputWaitTimeId
+                -- ^ Property 'serverTotalOutputWaitTime'.
+              | ServerInputWaitTimeId
+                -- ^ Property 'serverInputWaitTime'.
+              | ServerProcessingTimeId
+                -- ^ Property 'serverProcessingTime'.
+              | ServerOutputWaitTimeId
+                -- ^ Property 'serverOutputWaitTime'.
+              | ServerInputWaitFactorId
+                -- ^ Property 'serverInputWaitFactor'.
+              | ServerProcessingFactorId
+                -- ^ Property 'serverProcessingFactor'.
+              | ServerOutputWaitFactorId
+                -- ^ Property 'serverOutputWaitFactor'.
+              | UserDefinedResultId ResultDescription
+                -- ^ An user defined description.
+              | LocalisedResultId (M.Map ResultLocale ResultDescription)
+                -- ^ A localised property or object name.
+              deriving (Eq, Ord, Show)
+
+-- | The Russian locale.
+russianResultLocale :: ResultLocale
+russianResultLocale = "ru"
+
+-- | The English locale.
+englishResultLocale :: ResultLocale
+englishResultLocale = "en"
+
+-- | The Russian localisation of the simulation results.
+russianResultLocalisation :: ResultLocalisation
+russianResultLocalisation TimeId = "модельное время"
+russianResultLocalisation VectorId = "вектор"
+russianResultLocalisation (VectorItemId x) = "элемент с индексом " ++ x
+russianResultLocalisation SamplingStatsId = "сводная статистика"
+russianResultLocalisation SamplingStatsCountId = "количество"
+russianResultLocalisation SamplingStatsMinId = "минимальное значение"
+russianResultLocalisation SamplingStatsMaxId = "максимальное значение"
+russianResultLocalisation SamplingStatsMeanId = "среднее значение"
+russianResultLocalisation SamplingStatsMean2Id = "среднее квадратов"
+russianResultLocalisation SamplingStatsVarianceId = "дисперсия"
+russianResultLocalisation SamplingStatsDeviationId = "среднеквадратическое отклонение"
+russianResultLocalisation TimingStatsId = "временная статистика"
+russianResultLocalisation TimingStatsCountId = "количество"
+russianResultLocalisation TimingStatsMinId = "минимальное значение"
+russianResultLocalisation TimingStatsMaxId = "максимальное значение"
+russianResultLocalisation TimingStatsMeanId = "среднее значение"
+russianResultLocalisation TimingStatsVarianceId = "дисперсия"
+russianResultLocalisation TimingStatsDeviationId = "среднеквадратическое отклонение"
+russianResultLocalisation TimingStatsMinTimeId = "время достижения минимума"
+russianResultLocalisation TimingStatsMaxTimeId = "время достижения максимума"
+russianResultLocalisation TimingStatsStartTimeId = "начальное время сбора статистики"
+russianResultLocalisation TimingStatsLastTimeId = "конечное время сбора статистики"
+russianResultLocalisation TimingStatsSumId = "сумма"
+russianResultLocalisation TimingStatsSum2Id = "сумма квадратов"
+russianResultLocalisation FiniteQueueId = "конечная очередь"
+russianResultLocalisation InfiniteQueueId = "бесконечная очередь"
+russianResultLocalisation EnqueueStrategyId = "стратегия добавления элементов"
+russianResultLocalisation EnqueueStoringStrategyId = "стратегия хранения элементов"
+russianResultLocalisation DequeueStrategyId = "стратегия извлечения элементов"
+russianResultLocalisation QueueNullId = "очередь пуста?"
+russianResultLocalisation QueueFullId = "очередь заполнена?"
+russianResultLocalisation QueueMaxCountId = "емкость очереди"
+russianResultLocalisation QueueCountId = "текущий размер очереди"
+russianResultLocalisation QueueCountStatsId = "статистика по размеру очереди"
+russianResultLocalisation EnqueueCountId = "общее количество попыток добавить элементы"
+russianResultLocalisation EnqueueLostCountId = "общее количество неудачных попыток добавить элементы"
+russianResultLocalisation EnqueueStoreCountId = "общее количество сохраненных элементов"
+russianResultLocalisation DequeueCountId = "общее количество запросов на извлечение элементов"
+russianResultLocalisation DequeueExtractCountId = "общее количество извлеченных элементов"
+russianResultLocalisation QueueLoadFactorId = "коэфф. загрузки (размер, поделенный на емкость)"
+russianResultLocalisation EnqueueRateId = "количество попыток добавить на ед. времени"
+russianResultLocalisation EnqueueStoreRateId = "количество сохраненных на ед. времени"
+russianResultLocalisation DequeueRateId = "количество запросов на извлечение в ед. времени"
+russianResultLocalisation DequeueExtractRateId = "количество извлеченных на ед. времени"
+russianResultLocalisation QueueWaitTimeId = "время ожидания (сохранили -> извлекли)"
+russianResultLocalisation QueueTotalWaitTimeId = "общее время ожидания (попытались добавить -> извлекли)"
+russianResultLocalisation EnqueueWaitTimeId = "время ожидания добавления (попытались добавить -> сохранили)"
+russianResultLocalisation DequeueWaitTimeId = "время ожидания извлечения (запросили извлечь -> извлекли)"
+russianResultLocalisation QueueRateId = "усредненная скорость (как средняя длина очереди на среднее время ожидания)"
+russianResultLocalisation ArrivalTimerId = "как долго обрабатываются заявки?"
+russianResultLocalisation ArrivalProcessingTimeId = "время обработки заявки"
+russianResultLocalisation ServerId = "сервер"
+russianResultLocalisation ServerInitStateId = "начальное состояние"
+russianResultLocalisation ServerStateId = "текущее состояние"
+russianResultLocalisation ServerTotalInputWaitTimeId = "общее время блокировки в ожидании ввода"
+russianResultLocalisation ServerTotalProcessingTimeId = "общее время, потраченное на саму обработку заданий"
+russianResultLocalisation ServerTotalOutputWaitTimeId = "общее время блокировки при попытке доставить вывод"
+russianResultLocalisation ServerInputWaitTimeId = "время блокировки в ожидании ввода"
+russianResultLocalisation ServerProcessingTimeId = "время, потраченное на саму обработку заданий"
+russianResultLocalisation ServerOutputWaitTimeId = "время блокировки при попытке доставить вывод"
+russianResultLocalisation ServerInputWaitFactorId = "относительное время блокировки в ожидании ввода (от 0 до 1)"
+russianResultLocalisation ServerProcessingFactorId = "относительное время, потраченное на саму обработку заданий (от 0 до 1)"
+russianResultLocalisation ServerOutputWaitFactorId = "относительное время блокировки при попытке доставить вывод (от 0 до 1)"
+russianResultLocalisation (UserDefinedResultId m) = m
+russianResultLocalisation x@(LocalisedResultId m) =
+  lookupResultLocalisation russianResultLocale x
+
+-- | The English localisation of the simulation results.
+englishResultLocalisation :: ResultLocalisation
+englishResultLocalisation TimeId = "simulation time"
+englishResultLocalisation VectorId = "vector"
+englishResultLocalisation (VectorItemId x) = "item #" ++ x
+englishResultLocalisation SamplingStatsId = "statistics summary"
+englishResultLocalisation SamplingStatsCountId = "count"
+englishResultLocalisation SamplingStatsMinId = "minimum"
+englishResultLocalisation SamplingStatsMaxId = "maximum"
+englishResultLocalisation SamplingStatsMeanId = "mean"
+englishResultLocalisation SamplingStatsMean2Id = "mean square"
+englishResultLocalisation SamplingStatsVarianceId = "variance"
+englishResultLocalisation SamplingStatsDeviationId = "deviation"
+englishResultLocalisation TimingStatsId = "timing statistics"
+englishResultLocalisation TimingStatsCountId = "count"
+englishResultLocalisation TimingStatsMinId = "minimum"
+englishResultLocalisation TimingStatsMaxId = "maximum"
+englishResultLocalisation TimingStatsMeanId = "mean"
+englishResultLocalisation TimingStatsVarianceId = "variance"
+englishResultLocalisation TimingStatsDeviationId = "deviation"
+englishResultLocalisation TimingStatsMinTimeId = "the time of minimum"
+englishResultLocalisation TimingStatsMaxTimeId = "the time of maximum"
+englishResultLocalisation TimingStatsStartTimeId = "the start time"
+englishResultLocalisation TimingStatsLastTimeId = "the last time"
+englishResultLocalisation TimingStatsSumId = "sum"
+englishResultLocalisation TimingStatsSum2Id = "sum square"
+englishResultLocalisation FiniteQueueId = "the finite queue"
+englishResultLocalisation InfiniteQueueId = "the infinite queue"
+englishResultLocalisation EnqueueStrategyId = "the enqueueing strategy"
+englishResultLocalisation EnqueueStoringStrategyId = "the storing strategy"
+englishResultLocalisation DequeueStrategyId = "the dequeueing strategy"
+englishResultLocalisation QueueNullId = "is the queue empty?"
+englishResultLocalisation QueueFullId = "is the queue full?"
+englishResultLocalisation QueueMaxCountId = "the queue capacity"
+englishResultLocalisation QueueCountId = "the current queue size"
+englishResultLocalisation QueueCountStatsId = "the queue size statistics"
+englishResultLocalisation EnqueueCountId = "a total number of attempts to enqueue the items"
+englishResultLocalisation EnqueueLostCountId = "a total number of the lost items when trying to enqueue"
+englishResultLocalisation EnqueueStoreCountId = "a total number of the stored items"
+englishResultLocalisation DequeueCountId = "a total number of requests for dequeueing"
+englishResultLocalisation DequeueExtractCountId = "a total number of the dequeued items"
+englishResultLocalisation QueueLoadFactorId = "the queue load (its size divided by its capacity)"
+englishResultLocalisation EnqueueRateId = "how many attempts to enqueue per time?"
+englishResultLocalisation EnqueueStoreRateId = "how many items were stored per time?"
+englishResultLocalisation DequeueRateId = "how many requests for dequeueing per time?"
+englishResultLocalisation DequeueExtractRateId = "how many items were dequeued per time?"
+englishResultLocalisation QueueWaitTimeId = "the wait time (stored -> dequeued)"
+englishResultLocalisation QueueTotalWaitTimeId = "the total wait time (tried to enqueue -> dequeued)"
+englishResultLocalisation EnqueueWaitTimeId = "the enqueue wait time (tried to enqueue -> stored)"
+englishResultLocalisation DequeueWaitTimeId = "the dequeue wait time (requested for dequeueing -> dequeued)"
+englishResultLocalisation QueueRateId = "the average queue rate (= queue size / wait time)"
+englishResultLocalisation ArrivalTimerId = "how long the arrivals are processed?"
+englishResultLocalisation ArrivalProcessingTimeId = "the processing time of arrivals"
+englishResultLocalisation ServerId = "the server"
+englishResultLocalisation ServerInitStateId = "the initial state"
+englishResultLocalisation ServerStateId = "the current state"
+englishResultLocalisation ServerTotalInputWaitTimeId = "the total time spent while waiting for input"
+englishResultLocalisation ServerTotalProcessingTimeId = "the total time spent on actual processing the tasks"
+englishResultLocalisation ServerTotalOutputWaitTimeId = "the total time spent on delivering the output"
+englishResultLocalisation ServerInputWaitTimeId = "the time spent while waiting for input"
+englishResultLocalisation ServerProcessingTimeId = "the time spent on processing the tasks"
+englishResultLocalisation ServerOutputWaitTimeId = "the time spent on delivering the output"
+englishResultLocalisation ServerInputWaitFactorId = "the relative time spent while waiting for input (from 0 to 1)"
+englishResultLocalisation ServerProcessingFactorId = "the relative time spent on processing the tasks (from 0 to 1)"
+englishResultLocalisation ServerOutputWaitFactorId = "the relative time spent on delivering the output (from 0 to 1)"
+englishResultLocalisation (UserDefinedResultId m) = m
+englishResultLocalisation x@(LocalisedResultId m) =
+  lookupResultLocalisation englishResultLocale x
+
+-- | Lookup a localisation by the specified locale.
+lookupResultLocalisation :: ResultLocale -> ResultLocalisation
+lookupResultLocalisation loc (UserDefinedResultId m) = m
+lookupResultLocalisation loc (LocalisedResultId m) =
+  case M.lookup loc m of
+    Just x -> x
+    Nothing ->
+      case M.lookup russianResultLocale m of
+        Just x -> x
+        Nothing ->
+          case M.lookup englishResultLocale m of
+            Just x -> x
+            Nothing -> ""
+lookupResultLocalisation loc resultId = russianResultLocalisation resultId
+ Simulation/Aivika/Trans/Server.hs view
@@ -0,0 +1,516 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Server
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It models the server that prodives a service.
+module Simulation.Aivika.Trans.Server
+       (-- * Server
+        Server,
+        newServer,
+        newStateServer,
+        -- * Processing
+        serverProcessor,
+        -- * Server Properties and Activities
+        serverInitState,
+        serverState,
+        serverTotalInputWaitTime,
+        serverTotalProcessingTime,
+        serverTotalOutputWaitTime,
+        serverInputWaitTime,
+        serverProcessingTime,
+        serverOutputWaitTime,
+        serverInputWaitFactor,
+        serverProcessingFactor,
+        serverOutputWaitFactor,
+        -- * Summary
+        serverSummary,
+        -- * Derived Signals for Properties
+        serverStateChanged,
+        serverStateChanged_,
+        serverTotalInputWaitTimeChanged,
+        serverTotalInputWaitTimeChanged_,
+        serverTotalProcessingTimeChanged,
+        serverTotalProcessingTimeChanged_,
+        serverTotalOutputWaitTimeChanged,
+        serverTotalOutputWaitTimeChanged_,
+        serverInputWaitTimeChanged,
+        serverInputWaitTimeChanged_,
+        serverProcessingTimeChanged,
+        serverProcessingTimeChanged_,
+        serverOutputWaitTimeChanged,
+        serverOutputWaitTimeChanged_,
+        serverInputWaitFactorChanged,
+        serverInputWaitFactorChanged_,
+        serverProcessingFactorChanged,
+        serverProcessingFactorChanged_,
+        serverOutputWaitFactorChanged,
+        serverOutputWaitFactorChanged_,
+        -- * Basic Signals
+        serverInputReceived,
+        serverTaskProcessed,
+        serverOutputProvided,
+        -- * Overall Signal
+        serverChanged_) where
+
+import Data.Monoid
+
+import Control.Arrow
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.Cont
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Statistics
+
+-- | It models a server that takes @a@ and provides @b@ having state @s@ within underlying computation @m@.
+data Server m s a b =
+  Server { serverInitState :: s,
+           -- ^ The initial state of the server.
+           serverStateRef :: ProtoRef m s,
+           -- ^ The current state of the server.
+           serverProcess :: s -> a -> Process m (s, b),
+           -- ^ Provide @b@ by specified @a@.
+           serverTotalInputWaitTimeRef :: ProtoRef m Double,
+           -- ^ The counted total time spent in awating the input.
+           serverTotalProcessingTimeRef :: ProtoRef m Double,
+           -- ^ The counted total time spent to process the input and prepare the output.
+           serverTotalOutputWaitTimeRef :: ProtoRef m Double,
+           -- ^ The counted total time spent for delivering the output.
+           serverInputWaitTimeRef :: ProtoRef m (SamplingStats Double),
+           -- ^ The statistics for the time spent in awaiting the input.
+           serverProcessingTimeRef :: ProtoRef m (SamplingStats Double),
+           -- ^ The statistics for the time spent to process the input and prepare the output.
+           serverOutputWaitTimeRef :: ProtoRef m (SamplingStats Double),
+           -- ^ The statistics for the time spent for delivering the output.
+           serverInputReceivedSource :: SignalSource m a,
+           -- ^ A signal raised when the server recieves a new input to process.
+           serverTaskProcessedSource :: SignalSource m (a, b),
+           -- ^ A signal raised when the input is processed and
+           -- the output is prepared for deliverying.
+           serverOutputProvidedSource :: SignalSource m (a, b)
+           -- ^ A signal raised when the server has supplied the output.
+         }
+
+-- | Create a new server that can provide output @b@ by input @a@.
+-- Also it returns the corresponded processor that being applied
+-- updates the server state.
+newServer :: MonadComp m
+             => (a -> Process m b)
+             -- ^ provide an output by the specified input
+             -> Simulation m (Server m () a b)
+newServer provide =
+  flip newStateServer () $ \s a ->
+  do b <- provide a
+     return (s, b)
+
+-- | Create a new server that can provide output @b@ by input @a@
+-- starting from state @s@. Also it returns the corresponded processor
+-- that being applied updates the server state.
+newStateServer :: MonadComp m
+                  => (s -> a -> Process m (s, b))
+                  -- ^ provide a new state and output by the specified 
+                  -- old state and input
+                  -> s
+                  -- ^ the initial state
+                  -> Simulation m (Server m s a b)
+newStateServer provide state =
+  do sn <- liftParameter simulationSession
+     r0 <- liftComp $ newProtoRef sn state
+     r1 <- liftComp $ newProtoRef sn 0
+     r2 <- liftComp $ newProtoRef sn 0
+     r3 <- liftComp $ newProtoRef sn 0
+     r4 <- liftComp $ newProtoRef sn emptySamplingStats
+     r5 <- liftComp $ newProtoRef sn emptySamplingStats
+     r6 <- liftComp $ newProtoRef sn emptySamplingStats
+     s1 <- newSignalSource
+     s2 <- newSignalSource
+     s3 <- newSignalSource
+     let server = Server { serverInitState = state,
+                           serverStateRef = r0,
+                           serverProcess = provide,
+                           serverTotalInputWaitTimeRef = r1,
+                           serverTotalProcessingTimeRef = r2,
+                           serverTotalOutputWaitTimeRef = r3,
+                           serverInputWaitTimeRef = r4,
+                           serverProcessingTimeRef = r5,
+                           serverOutputWaitTimeRef = r6,
+                           serverInputReceivedSource = s1,
+                           serverTaskProcessedSource = s2,
+                           serverOutputProvidedSource = s3 }
+     return server
+
+-- | Return a processor for the specified server.
+--
+-- The processor updates the internal state of the server. The usual case is when 
+-- the processor is applied only once in a chain of data processing. Otherwise; 
+-- every time the processor is used, the state of the server changes. Sometimes 
+-- it can be indeed useful if you want to aggregate the statistics for different 
+-- servers simultaneously, but it would be more preferable to avoid this.
+--
+-- If you connect different server processors returned by this function in a chain 
+-- with help of '>>>' or other category combinator then this chain will act as one 
+-- whole, where the first server will take a new task only after the last server 
+-- finishes its current task and requests for the next one from the previous processor 
+-- in the chain. This is not always that thing you might need.
+--
+-- To model a sequence of the server processors working independently, you
+-- should separate them with help of the 'prefetchProcessor' that plays a role
+-- of a small one-place buffer in that case.
+--
+-- The queue processors usually have the prefetching capabilities per se, where
+-- the items are already stored in the queue. Therefore, the server processor
+-- should not be prefetched if it is connected directly with the queue processor.
+serverProcessor :: MonadComp m => Server m s a b -> Processor m a b
+serverProcessor server =
+  Processor $ \xs -> loop (serverInitState server) Nothing xs
+  where
+    loop s r xs =
+      Cons $
+      do t0 <- liftDynamics time
+         liftEvent $
+           case r of
+             Nothing -> return ()
+             Just (t', a', b') ->
+               do liftComp $
+                    do modifyProtoRef' (serverTotalOutputWaitTimeRef server) (+ (t0 - t'))
+                       modifyProtoRef' (serverOutputWaitTimeRef server) $
+                         addSamplingStats (t0 - t')
+                  triggerSignal (serverOutputProvidedSource server) (a', b')
+         -- get input
+         (a, xs') <- runStream xs
+         t1 <- liftDynamics time
+         liftEvent $
+           do liftComp $
+                do modifyProtoRef' (serverTotalInputWaitTimeRef server) (+ (t1 - t0))
+                   modifyProtoRef' (serverInputWaitTimeRef server) $
+                     addSamplingStats (t1 - t0)
+              triggerSignal (serverInputReceivedSource server) a
+         -- provide the service
+         (s', b) <- serverProcess server s a
+         t2 <- liftDynamics time
+         liftEvent $
+           do liftComp $
+                do writeProtoRef (serverStateRef server) $! s'
+                   modifyProtoRef' (serverTotalProcessingTimeRef server) (+ (t2 - t1))
+                   modifyProtoRef' (serverProcessingTimeRef server) $
+                     addSamplingStats (t2 - t1)
+              triggerSignal (serverTaskProcessedSource server) (a, b)
+         return (b, loop s' (Just (t2, a, b)) xs')
+
+-- | Return the current state of the server.
+--
+-- See also 'serverStateChanged' and 'serverStateChanged_'.
+serverState :: MonadComp m => Server m s a b -> Event m s
+serverState server =
+  Event $ \p -> readProtoRef (serverStateRef server)
+  
+-- | Signal when the 'serverState' property value has changed.
+serverStateChanged :: MonadComp m => Server m s a b -> Signal m s
+serverStateChanged server =
+  mapSignalM (const $ serverState server) (serverStateChanged_ server)
+  
+-- | Signal when the 'serverState' property value has changed.
+serverStateChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverStateChanged_ server =
+  mapSignal (const ()) (serverTaskProcessed server)
+
+-- | Return the counted total time when the server was locked while awaiting the input.
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverTotalInputWaitTimeChanged' and 'serverTotalInputWaitTimeChanged_'.
+serverTotalInputWaitTime :: MonadComp m => Server m s a b -> Event m Double
+serverTotalInputWaitTime server =
+  Event $ \p -> readProtoRef (serverTotalInputWaitTimeRef server)
+  
+-- | Signal when the 'serverTotalInputWaitTime' property value has changed.
+serverTotalInputWaitTimeChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverTotalInputWaitTimeChanged server =
+  mapSignalM (const $ serverTotalInputWaitTime server) (serverTotalInputWaitTimeChanged_ server)
+  
+-- | Signal when the 'serverTotalInputWaitTime' property value has changed.
+serverTotalInputWaitTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverTotalInputWaitTimeChanged_ server =
+  mapSignal (const ()) (serverInputReceived server)
+
+-- | Return the counted total time spent by the server while processing the tasks.
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverTotalProcessingTimeChanged' and 'serverTotalProcessingTimeChanged_'.
+serverTotalProcessingTime :: MonadComp m => Server m s a b -> Event m Double
+serverTotalProcessingTime server =
+  Event $ \p -> readProtoRef (serverTotalProcessingTimeRef server)
+  
+-- | Signal when the 'serverTotalProcessingTime' property value has changed.
+serverTotalProcessingTimeChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverTotalProcessingTimeChanged server =
+  mapSignalM (const $ serverTotalProcessingTime server) (serverTotalProcessingTimeChanged_ server)
+  
+-- | Signal when the 'serverTotalProcessingTime' property value has changed.
+serverTotalProcessingTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverTotalProcessingTimeChanged_ server =
+  mapSignal (const ()) (serverTaskProcessed server)
+
+-- | Return the counted total time when the server was locked while trying
+-- to deliver the output.
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverTotalOutputWaitTimeChanged' and 'serverTotalOutputWaitTimeChanged_'.
+serverTotalOutputWaitTime :: MonadComp m => Server m s a b -> Event m Double
+serverTotalOutputWaitTime server =
+  Event $ \p -> readProtoRef (serverTotalOutputWaitTimeRef server)
+  
+-- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
+serverTotalOutputWaitTimeChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverTotalOutputWaitTimeChanged server =
+  mapSignalM (const $ serverTotalOutputWaitTime server) (serverTotalOutputWaitTimeChanged_ server)
+  
+-- | Signal when the 'serverTotalOutputWaitTime' property value has changed.
+serverTotalOutputWaitTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverTotalOutputWaitTimeChanged_ server =
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | Return the statistics of the time when the server was locked while awaiting the input.
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverInputWaitTimeChanged' and 'serverInputWaitTimeChanged_'.
+serverInputWaitTime :: MonadComp m => Server m s a b -> Event m (SamplingStats Double)
+serverInputWaitTime server =
+  Event $ \p -> readProtoRef (serverInputWaitTimeRef server)
+  
+-- | Signal when the 'serverInputWaitTime' property value has changed.
+serverInputWaitTimeChanged :: MonadComp m => Server m s a b -> Signal m (SamplingStats Double)
+serverInputWaitTimeChanged server =
+  mapSignalM (const $ serverInputWaitTime server) (serverInputWaitTimeChanged_ server)
+  
+-- | Signal when the 'serverInputWaitTime' property value has changed.
+serverInputWaitTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverInputWaitTimeChanged_ server =
+  mapSignal (const ()) (serverInputReceived server)
+
+-- | Return the statistics of the time spent by the server while processing the tasks.
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverProcessingTimeChanged' and 'serverProcessingTimeChanged_'.
+serverProcessingTime :: MonadComp m => Server m s a b -> Event m (SamplingStats Double)
+serverProcessingTime server =
+  Event $ \p -> readProtoRef (serverProcessingTimeRef server)
+  
+-- | Signal when the 'serverProcessingTime' property value has changed.
+serverProcessingTimeChanged :: MonadComp m => Server m s a b -> Signal m (SamplingStats Double)
+serverProcessingTimeChanged server =
+  mapSignalM (const $ serverProcessingTime server) (serverProcessingTimeChanged_ server)
+  
+-- | Signal when the 'serverProcessingTime' property value has changed.
+serverProcessingTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverProcessingTimeChanged_ server =
+  mapSignal (const ()) (serverTaskProcessed server)
+
+-- | Return the statistics of the time when the server was locked while trying
+-- to deliver the output. 
+--
+-- The value returned changes discretely and it is usually delayed relative
+-- to the current simulation time.
+--
+-- See also 'serverOutputWaitTimeChanged' and 'serverOutputWaitTimeChanged_'.
+serverOutputWaitTime :: MonadComp m => Server m s a b -> Event m (SamplingStats Double)
+serverOutputWaitTime server =
+  Event $ \p -> readProtoRef (serverOutputWaitTimeRef server)
+  
+-- | Signal when the 'serverOutputWaitTime' property value has changed.
+serverOutputWaitTimeChanged :: MonadComp m => Server m s a b -> Signal m (SamplingStats Double)
+serverOutputWaitTimeChanged server =
+  mapSignalM (const $ serverOutputWaitTime server) (serverOutputWaitTimeChanged_ server)
+  
+-- | Signal when the 'serverOutputWaitTime' property value has changed.
+serverOutputWaitTimeChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverOutputWaitTimeChanged_ server =
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | It returns the factor changing from 0 to 1, which estimates how often
+-- the server was awaiting for the next input task.
+--
+-- This factor is calculated as
+--
+-- @
+--   totalInputWaitTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime)
+-- @
+--
+-- As before in this module, the value returned changes discretely and
+-- it is usually delayed relative to the current simulation time.
+--
+-- See also 'serverInputWaitFactorChanged' and 'serverInputWaitFactorChanged_'.
+serverInputWaitFactor :: MonadComp m => Server m s a b -> Event m Double
+serverInputWaitFactor server =
+  Event $ \p ->
+  do x1 <- readProtoRef (serverTotalInputWaitTimeRef server)
+     x2 <- readProtoRef (serverTotalProcessingTimeRef server)
+     x3 <- readProtoRef (serverTotalOutputWaitTimeRef server)
+     return (x1 / (x1 + x2 + x3))
+  
+-- | Signal when the 'serverInputWaitFactor' property value has changed.
+serverInputWaitFactorChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverInputWaitFactorChanged server =
+  mapSignalM (const $ serverInputWaitFactor server) (serverInputWaitFactorChanged_ server)
+  
+-- | Signal when the 'serverInputWaitFactor' property value has changed.
+serverInputWaitFactorChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverInputWaitFactorChanged_ server =
+  mapSignal (const ()) (serverInputReceived server) <>
+  mapSignal (const ()) (serverTaskProcessed server) <>
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | It returns the factor changing from 0 to 1, which estimates how often
+-- the server was busy with direct processing its tasks.
+--
+-- This factor is calculated as
+--
+-- @
+--   totalProcessingTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime)
+-- @
+--
+-- As before in this module, the value returned changes discretely and
+-- it is usually delayed relative to the current simulation time.
+--
+-- See also 'serverProcessingFactorChanged' and 'serverProcessingFactorChanged_'.
+serverProcessingFactor :: MonadComp m => Server m s a b -> Event m Double
+serverProcessingFactor server =
+  Event $ \p ->
+  do x1 <- readProtoRef (serverTotalInputWaitTimeRef server)
+     x2 <- readProtoRef (serverTotalProcessingTimeRef server)
+     x3 <- readProtoRef (serverTotalOutputWaitTimeRef server)
+     return (x2 / (x1 + x2 + x3))
+  
+-- | Signal when the 'serverProcessingFactor' property value has changed.
+serverProcessingFactorChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverProcessingFactorChanged server =
+  mapSignalM (const $ serverProcessingFactor server) (serverProcessingFactorChanged_ server)
+  
+-- | Signal when the 'serverProcessingFactor' property value has changed.
+serverProcessingFactorChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverProcessingFactorChanged_ server =
+  mapSignal (const ()) (serverInputReceived server) <>
+  mapSignal (const ()) (serverTaskProcessed server) <>
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | It returns the factor changing from 0 to 1, which estimates how often
+-- the server was locked trying to deliver the output after the task is finished.
+--
+-- This factor is calculated as
+--
+-- @
+--   totalOutputWaitTime \/ (totalInputWaitTime + totalProcessingTime + totalOutputWaitTime)
+-- @
+--
+-- As before in this module, the value returned changes discretely and
+-- it is usually delayed relative to the current simulation time.
+--
+-- See also 'serverOutputWaitFactorChanged' and 'serverOutputWaitFactorChanged_'.
+serverOutputWaitFactor :: MonadComp m => Server m s a b -> Event m Double
+serverOutputWaitFactor server =
+  Event $ \p ->
+  do x1 <- readProtoRef (serverTotalInputWaitTimeRef server)
+     x2 <- readProtoRef (serverTotalProcessingTimeRef server)
+     x3 <- readProtoRef (serverTotalOutputWaitTimeRef server)
+     return (x3 / (x1 + x2 + x3))
+  
+-- | Signal when the 'serverOutputWaitFactor' property value has changed.
+serverOutputWaitFactorChanged :: MonadComp m => Server m s a b -> Signal m Double
+serverOutputWaitFactorChanged server =
+  mapSignalM (const $ serverOutputWaitFactor server) (serverOutputWaitFactorChanged_ server)
+  
+-- | Signal when the 'serverOutputWaitFactor' property value has changed.
+serverOutputWaitFactorChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverOutputWaitFactorChanged_ server =
+  mapSignal (const ()) (serverInputReceived server) <>
+  mapSignal (const ()) (serverTaskProcessed server) <>
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | Raised when the server receives a new input task.
+serverInputReceived :: MonadComp m => Server m s a b -> Signal m a
+serverInputReceived = publishSignal . serverInputReceivedSource
+
+-- | Raised when the server has just processed the task.
+serverTaskProcessed :: MonadComp m => Server m s a b -> Signal m (a, b)
+serverTaskProcessed = publishSignal . serverTaskProcessedSource
+
+-- | Raised when the server has just delivered the output.
+serverOutputProvided :: MonadComp m => Server m s a b -> Signal m (a, b)
+serverOutputProvided = publishSignal . serverOutputProvidedSource
+
+-- | Signal whenever any property of the server changes.
+serverChanged_ :: MonadComp m => Server m s a b -> Signal m ()
+serverChanged_ server =
+  mapSignal (const ()) (serverInputReceived server) <>
+  mapSignal (const ()) (serverTaskProcessed server) <>
+  mapSignal (const ()) (serverOutputProvided server)
+
+-- | Return the summary for the server with desciption of its
+-- properties and activities using the specified indent.
+serverSummary :: MonadComp m => Server m s a b -> Int -> Event m ShowS
+serverSummary server indent =
+  Event $ \p ->
+  do tx1 <- readProtoRef (serverTotalInputWaitTimeRef server)
+     tx2 <- readProtoRef (serverTotalProcessingTimeRef server)
+     tx3 <- readProtoRef (serverTotalOutputWaitTimeRef server)
+     let xf1 = tx1 / (tx1 + tx2 + tx3)
+         xf2 = tx2 / (tx1 + tx2 + tx3)
+         xf3 = tx3 / (tx1 + tx2 + tx3)
+     xs1 <- readProtoRef (serverInputWaitTimeRef server)
+     xs2 <- readProtoRef (serverProcessingTimeRef server)
+     xs3 <- readProtoRef (serverOutputWaitTimeRef server)
+     let tab = replicate indent ' '
+     return $
+       showString tab .
+       showString "total input wait time (locked while awaiting the input) = " . shows tx1 .
+       showString "\n" .
+       showString tab .
+       showString "total processing time = " . shows tx2 .
+       showString "\n" .
+       showString tab .
+       showString "total output wait time (locked while delivering the output) = " . shows tx3 .
+       showString "\n\n" .
+       showString tab .
+       showString "input wait factor (from 0 to 1) = " . shows xf1 .
+       showString "\n" .
+       showString tab .
+       showString "processing factor (from 0 to 1) = " . shows xf2 .
+       showString "\n" .
+       showString tab .
+       showString "output wait factor (from 0 to 1) = " . shows xf3 .
+       showString "\n\n" .
+       showString tab .
+       showString "input wait time (locked while awaiting the input):\n\n" .
+       samplingStatsSummary xs1 (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "processing time:\n\n" .
+       samplingStatsSummary xs2 (2 + indent) .
+       showString "\n\n" .
+       showString tab .
+       showString "output wait time (locked while delivering the output):\n\n" .
+       samplingStatsSummary xs3 (2 + indent)
+ Simulation/Aivika/Trans/Session.hs view
@@ -0,0 +1,56 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Session
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It identifies a current simulation session usually associated with the current simulation run.
+--
+module Simulation.Aivika.Trans.Session
+       (SessionMonad(..),
+        Session(..)) where
+
+import Data.IORef
+
+-- | A monad within which computation we can create and work with a simulation session.
+class (Functor m, Monad m) => SessionMonad m where
+  
+  -- | A simulation session.
+  data Session m :: *
+
+  -- | A marker that exists with the session and which can be compared for equality.
+  data SessionMarker m :: *
+
+  -- | Create a new session.
+  newSession :: m (Session m)
+
+  -- | Create a new marker within the current session.
+  newSessionMarker :: Session m -> m (SessionMarker m)
+
+  -- | Compare two markers for equality.
+  equalSessionMarker :: SessionMarker m -> SessionMarker m -> Bool
+
+instance SessionMonad IO where
+
+  data Session IO = Session
+
+  newtype SessionMarker IO = SessionMarker (IORef ())
+
+  {-# SPECIALISE INLINE newSession :: IO (Session IO) #-}
+  newSession = return Session
+
+  {-# SPECIALISE INLINE newSessionMarker :: Session IO -> IO (SessionMarker IO) #-}
+  newSessionMarker session = fmap SessionMarker $ newIORef ()
+
+  {-# SPECIALISE INLINE equalSessionMarker :: SessionMarker IO -> SessionMarker IO -> Bool #-}
+  equalSessionMarker (SessionMarker x) (SessionMarker y) = x == y
+
+instance SessionMonad m => Eq (SessionMarker m) where
+
+  {-# INLINE (==) #-}
+  (==) = equalSessionMarker
+ Simulation/Aivika/Trans/Signal.hs view
@@ -0,0 +1,53 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Signal
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the signal which we can subscribe handlers to. 
+-- These handlers can be disposed. The signal is triggered in the 
+-- current time point actuating the corresponded computations from 
+-- the handlers. 
+--
+module Simulation.Aivika.Trans.Signal
+       (-- * Handling and Triggering Signal
+        Signal(..),
+        handleSignal_,
+        SignalSource,
+        newSignalSource,
+        publishSignal,
+        triggerSignal,
+        -- * Useful Combinators
+        mapSignal,
+        mapSignalM,
+        apSignal,
+        filterSignal,
+        filterSignalM,
+        emptySignal,
+        merge2Signals,
+        merge3Signals,
+        merge4Signals,
+        merge5Signals,
+        -- * Signal Arriving
+        arrivalSignal,
+        -- * Creating Signal in Time Points
+        newSignalInTimes,
+        newSignalInIntegTimes,
+        newSignalInStartTime,
+        newSignalInStopTime,
+        -- * Signal History
+        SignalHistory,
+        signalHistorySignal,
+        newSignalHistory,
+        newSignalHistoryStartingWith,
+        readSignalHistory,
+        -- * Signalable Computations
+        Signalable(..),
+        signalableChanged,
+        emptySignalable,
+        appendSignalable) where
+
+import Simulation.Aivika.Trans.Internal.Signal
+ Simulation/Aivika/Trans/Simulation.hs view
@@ -0,0 +1,26 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Simulation
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines the 'SimulationT' monad transformer that represents a simulation run.
+-- 
+module Simulation.Aivika.Trans.Simulation
+       (-- * Simulation
+        Simulation,
+        SimulationLift(..),
+        runSimulation,
+        runSimulations,
+        -- * Error Handling
+        catchSimulation,
+        finallySimulation,
+        throwSimulation,
+        -- * Memoization
+        memoSimulation) where
+
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+ Simulation/Aivika/Trans/Specs.hs view
@@ -0,0 +1,25 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Specs
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines the simulation specs and functions for this data type.
+module Simulation.Aivika.Trans.Specs
+       (-- * Simulation Specs
+        Specs(..),
+        Method(..),
+        -- * Auxiliary Functions
+        basicTime,
+        integIterationBnds,
+        integIterationHiBnd,
+        integIterationLoBnd,
+        integPhaseBnds,
+        integPhaseHiBnd,
+        integPhaseLoBnd,
+        integTimes) where
+
+import Simulation.Aivika.Trans.Internal.Specs
+ Simulation/Aivika/Trans/Statistics.hs view
@@ -0,0 +1,32 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Statistics
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- Represents statistics.
+--
+
+module Simulation.Aivika.Trans.Statistics
+       (-- * Simple Statistics
+        SamplingStats(..),
+        SamplingData(..),
+        combineSamplingStatsEither,
+        samplingStatsVariance,
+        samplingStatsDeviation,
+        samplingStatsSummary,
+        returnSamplingStats,
+        listSamplingStats,
+        fromIntSamplingStats,
+        -- * Timing Statistics
+        TimingStats(..),
+        TimingData(..),
+        timingStatsDeviation,
+        timingStatsSummary,
+        returnTimingStats,
+        fromIntTimingStats) where
+
+import Simulation.Aivika.Statistics
+ Simulation/Aivika/Trans/Statistics/Accumulator.hs view
@@ -0,0 +1,45 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Statistics.Accumulator
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This small utility module allows accumulating the timing statistics based on 'Signalable' data
+-- such as the queue size or the number of lost items in the queue.
+--
+
+module Simulation.Aivika.Trans.Statistics.Accumulator
+       (-- * Timing Statistics Accumulator
+        TimingStatsAccumulator,
+        newTimingStatsAccumulator,
+        timingStatsAccumulated) where
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Signal
+
+-- | Represents an accumulator for the timing statistics.
+newtype TimingStatsAccumulator m a =
+  TimingStatsAccumulator { timingStatsAccumulatedRef :: Ref m (TimingStats a) }
+
+-- | Return the accumulated statistics.
+timingStatsAccumulated :: MonadComp m => TimingStatsAccumulator m a -> Event m (TimingStats a)
+timingStatsAccumulated = readRef . timingStatsAccumulatedRef
+
+-- | Start gathering the timing statistics from the current simulation time. 
+newTimingStatsAccumulator :: (MonadComp m, TimingData a) => Signalable m a -> Event m (TimingStatsAccumulator m a)
+newTimingStatsAccumulator x =
+  do t0 <- liftDynamics time
+     a0 <- readSignalable x
+     r  <- liftSimulation $ newRef (returnTimingStats t0 a0)
+     handleSignal_ (signalableChanged x) $ \a ->
+       do t <- liftDynamics time
+          modifyRef r $ addTimingStats t a
+     return TimingStatsAccumulator { timingStatsAccumulatedRef = r }
+ Simulation/Aivika/Trans/Stream.hs view
@@ -0,0 +1,550 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Stream
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The infinite stream of data in time.
+--
+module Simulation.Aivika.Trans.Stream
+       (-- * Stream Type
+        Stream(..),
+        -- * Merging and Splitting Stream
+        emptyStream,
+        mergeStreams,
+        mergeQueuedStreams,
+        mergePriorityStreams,
+        concatStreams,
+        concatQueuedStreams,
+        concatPriorityStreams,
+        splitStream,
+        splitStreamQueueing,
+        splitStreamPrioritising,
+        -- * Specifying Identifier
+        streamUsingId,
+        -- * Prefetching and Delaying Stream
+        prefetchStream,
+        delayStream,
+        -- * Stream Arriving
+        arrivalStream,
+        -- * Memoizing, Zipping and Uzipping Stream
+        memoStream,
+        zipStreamSeq,
+        zipStreamParallel,
+        zip3StreamSeq,
+        zip3StreamParallel,
+        unzipStream,
+        streamSeq,
+        streamParallel,
+        -- * Consuming and Sinking Stream
+        consumeStream,
+        sinkStream,
+        -- * Useful Combinators
+        repeatProcess,
+        mapStream,
+        mapStreamM,
+        apStream,
+        apStreamM,
+        filterStream,
+        filterStreamM,
+        -- * Integrating with Signals
+        signalStream,
+        streamSignal,
+        -- * Utilities
+        leftStream,
+        rightStream,
+        replaceLeftStream,
+        replaceRightStream,
+        partitionEitherStream) where
+
+import Data.Maybe
+import Data.Monoid
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Cont
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Resource
+import Simulation.Aivika.Trans.QueueStrategy
+import Simulation.Aivika.Trans.Queue.Infinite
+import Simulation.Aivika.Arrival (Arrival(..))
+
+-- | Represents an infinite stream of data in time,
+-- some kind of never-ending cons cell.
+newtype Stream m a = Cons { runStream :: Process m (a, Stream m a)
+                            -- ^ Run the stream.
+                          }
+
+instance MonadComp m => Functor (Stream m) where
+
+  {-# INLINE fmap #-}
+  fmap = mapStream
+
+instance MonadComp m => Applicative (Stream m) where
+
+  {-# INLINE pure #-}
+  pure a = let y = Cons (return (a, y)) in y
+  
+  {-# INLINE (<*>) #-}
+  (<*>) = apStream
+
+instance MonadComp m => Monoid (Stream m a) where
+
+  {-# INLINE mempty #-}
+  mempty  = emptyStream
+
+  {-# INLINE mappend #-}
+  mappend = mergeStreams
+
+  {-# INLINE mconcat #-}
+  mconcat = concatStreams
+
+-- | Create a stream that will use the specified process identifier.
+-- It can be useful to refer to the underlying 'Process' computation which
+-- can be passivated, interrupted, canceled and so on. See also the
+-- 'processUsingId' function for more details.
+streamUsingId :: MonadComp m => ProcessId m -> Stream m a -> Stream m a
+streamUsingId pid (Cons s) =
+  Cons $ processUsingId pid s
+
+-- | Memoize the stream so that it would always return the same data
+-- within the simulation run.
+memoStream :: MonadComp m => Stream m a -> Simulation m (Stream m a)
+memoStream (Cons s) =
+  do p <- memoProcess $
+          do ~(x, xs) <- s
+             xs' <- liftSimulation $ memoStream xs
+             return (x, xs')
+     return (Cons p)
+
+-- | Zip two streams trying to get data sequentially.
+zipStreamSeq :: MonadComp m => Stream m a -> Stream m b -> Stream m (a, b)
+zipStreamSeq (Cons sa) (Cons sb) = Cons y where
+  y = do ~(x, xs) <- sa
+         ~(y, ys) <- sb
+         return ((x, y), zipStreamSeq xs ys)
+
+-- | Zip two streams trying to get data as soon as possible,
+-- launching the sub-processes in parallel.
+zipStreamParallel :: MonadComp m => Stream m a -> Stream m b -> Stream m (a, b)
+zipStreamParallel (Cons sa) (Cons sb) = Cons y where
+  y = do ~((x, xs), (y, ys)) <- zipProcessParallel sa sb
+         return ((x, y), zipStreamParallel xs ys)
+
+-- | Zip three streams trying to get data sequentially.
+zip3StreamSeq :: MonadComp m => Stream m a -> Stream m b -> Stream m c -> Stream m (a, b, c)
+zip3StreamSeq (Cons sa) (Cons sb) (Cons sc) = Cons y where
+  y = do ~(x, xs) <- sa
+         ~(y, ys) <- sb
+         ~(z, zs) <- sc
+         return ((x, y, z), zip3StreamSeq xs ys zs)
+
+-- | Zip three streams trying to get data as soon as possible,
+-- launching the sub-processes in parallel.
+zip3StreamParallel :: MonadComp m => Stream m a -> Stream m b -> Stream m c -> Stream m (a, b, c)
+zip3StreamParallel (Cons sa) (Cons sb) (Cons sc) = Cons y where
+  y = do ~((x, xs), (y, ys), (z, zs)) <- zip3ProcessParallel sa sb sc
+         return ((x, y, z), zip3StreamParallel xs ys zs)
+
+-- | Unzip the stream.
+unzipStream :: MonadComp m => Stream m (a, b) -> Simulation m (Stream m a, Stream m b)
+unzipStream s =
+  do s' <- memoStream s
+     let sa = mapStream fst s'
+         sb = mapStream snd s'
+     return (sa, sb)
+
+-- | To form each new portion of data for the output stream,
+-- read data sequentially from the input streams.
+--
+-- This is a generalization of 'zipStreamSeq'.
+streamSeq :: MonadComp m => [Stream m a] -> Stream m [a]
+streamSeq xs = Cons y where
+  y = do ps <- forM xs runStream
+         return (map fst ps, streamSeq $ map snd ps)
+
+-- | To form each new portion of data for the output stream,
+-- read data from the input streams in parallel.
+--
+-- This is a generalization of 'zipStreamParallel'.
+streamParallel :: MonadComp m => [Stream m a] -> Stream m [a]
+streamParallel xs = Cons y where
+  y = do ps <- processParallel $ map runStream xs
+         return (map fst ps, streamParallel $ map snd ps)
+
+-- | Return a stream of values generated by the specified process.
+repeatProcess :: MonadComp m => Process m a -> Stream m a
+repeatProcess p = Cons y where
+  y = do a <- p
+         return (a, repeatProcess p)
+
+-- | Map the stream according the specified function.
+mapStream :: MonadComp m => (a -> b) -> Stream m a -> Stream m b
+mapStream f (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         return (f a, mapStream f xs)
+
+-- | Compose the stream.
+mapStreamM :: MonadComp m => (a -> Process m b) -> Stream m a -> Stream m b
+mapStreamM f (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         b <- f a
+         return (b, mapStreamM f xs)
+
+-- | Sequential application.
+apStream :: MonadComp m => Stream m (a -> b) -> Stream m a -> Stream m b
+apStream (Cons sf) (Cons sa) = Cons y where
+  y = do (f, sf') <- sf
+         (a, sa') <- sa
+         return (f a, apStream sf' sa')
+
+-- | Sequential application.
+apStreamM :: MonadComp m => Stream m (a -> Process m b) -> Stream m a -> Stream m b
+apStreamM (Cons sf) (Cons sa) = Cons y where
+  y = do (f, sf') <- sf
+         (a, sa') <- sa
+         x <- f a
+         return (x, apStreamM sf' sa')
+
+-- | Filter only those data values that satisfy to the specified predicate.
+filterStream :: MonadComp m => (a -> Bool) -> Stream m a -> Stream m a
+filterStream p (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         if p a
+           then return (a, filterStream p xs)
+           else let Cons z = filterStream p xs in z
+
+-- | Filter only those data values that satisfy to the specified predicate.
+filterStreamM :: MonadComp m => (a -> Process m Bool) -> Stream m a -> Stream m a
+filterStreamM p (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         b <- p a
+         if b
+           then return (a, filterStreamM p xs)
+           else let Cons z = filterStreamM p xs in z
+
+-- | The stream of 'Left' values.
+leftStream :: MonadComp m => Stream m (Either a b) -> Stream m a
+leftStream (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         case a of
+           Left a  -> return (a, leftStream xs)
+           Right _ -> let Cons z = leftStream xs in z
+
+-- | The stream of 'Right' values.
+rightStream :: MonadComp m => Stream m (Either a b) -> Stream m b
+rightStream (Cons s) = Cons y where
+  y = do (a, xs) <- s
+         case a of
+           Left _  -> let Cons z = rightStream xs in z
+           Right a -> return (a, rightStream xs)
+
+-- | Replace the 'Left' values.
+replaceLeftStream :: MonadComp m => Stream m (Either a b) -> Stream m c -> Stream m (Either c b)
+replaceLeftStream (Cons sab) (ys0 @ ~(Cons sc)) = Cons z where
+  z = do (a, xs) <- sab
+         case a of
+           Left _ ->
+             do (b, ys) <- sc
+                return (Left b, replaceLeftStream xs ys)
+           Right a ->
+             return (Right a, replaceLeftStream xs ys0)
+
+-- | Replace the 'Right' values.
+replaceRightStream :: MonadComp m => Stream m (Either a b) -> Stream m c -> Stream m (Either a c)
+replaceRightStream (Cons sab) (ys0 @ ~(Cons sc)) = Cons z where
+  z = do (a, xs) <- sab
+         case a of
+           Right _ ->
+             do (b, ys) <- sc
+                return (Right b, replaceRightStream xs ys)
+           Left a ->
+             return (Left a, replaceRightStream xs ys0)
+
+-- | Partition the stream of 'Either' values into two streams.
+partitionEitherStream :: MonadComp m => Stream m (Either a b) -> Simulation m (Stream m a, Stream m b)
+partitionEitherStream s =
+  do s' <- memoStream s
+     return (leftStream s', rightStream s')
+
+-- | Split the input stream into the specified number of output streams
+-- after applying the 'FCFS' strategy for enqueuing the output requests.
+splitStream :: MonadComp m => Int -> Stream m a -> Simulation m [Stream m a]
+splitStream = splitStreamQueueing FCFS
+
+-- | Split the input stream into the specified number of output streams.
+--
+-- If you don't know what the strategy to apply, then you probably
+-- need the 'FCFS' strategy, or function 'splitStream' that
+-- does namely this.
+splitStreamQueueing :: (MonadComp m, EnqueueStrategy m s)
+                       => s
+                       -- ^ the strategy applied for enqueuing the output requests
+                       -> Int
+                       -- ^ the number of output streams
+                       -> Stream m a
+                       -- ^ the input stream
+                       -> Simulation m [Stream m a]
+                       -- ^ the splitted output streams
+splitStreamQueueing s n x =
+  do session <- liftParameter simulationSession
+     ref <- liftComp $ newProtoRef session x
+     res <- newResource s 1
+     let reader =
+           usingResource res $
+           do p <- liftComp $ readProtoRef ref
+              (a, xs) <- runStream p
+              liftComp $ writeProtoRef ref xs
+              return a
+     return $ map (\i -> repeatProcess reader) [1..n]
+
+-- | Split the input stream into a list of output streams
+-- using the specified priorities.
+splitStreamPrioritising :: (MonadComp m, PriorityQueueStrategy m s p)
+                           => s
+                           -- ^ the strategy applied for enqueuing the output requests
+                           -> [Stream m p]
+                           -- ^ the streams of priorities
+                           -> Stream m a
+                           -- ^ the input stream
+                           -> Simulation m [Stream m a]
+                           -- ^ the splitted output streams
+splitStreamPrioritising s ps x =
+  do session <- liftParameter simulationSession
+     ref <- liftComp $ newProtoRef session x
+     res <- newResource s 1
+     let stream (Cons p) = Cons z where
+           z = do (p', ps) <- p
+                  a <- usingResourceWithPriority res p' $
+                       do p <- liftComp $ readProtoRef ref
+                          (a, xs) <- runStream p
+                          liftComp $ writeProtoRef ref xs
+                          return a
+                  return (a, stream ps)
+     return $ map stream ps
+
+-- | Concatenate the input streams applying the 'FCFS' strategy and
+-- producing one output stream.
+concatStreams :: MonadComp m => [Stream m a] -> Stream m a
+concatStreams = concatQueuedStreams FCFS
+
+-- | Concatenate the input streams producing one output stream.
+--
+-- If you don't know what the strategy to apply, then you probably
+-- need the 'FCFS' strategy, or function 'concatStreams' that
+-- does namely this.
+concatQueuedStreams :: (MonadComp m, EnqueueStrategy m s)
+                       => s
+                       -- ^ the strategy applied for enqueuing the input data
+                       -> [Stream m a]
+                       -- ^ the input stream
+                       -> Stream m a
+                       -- ^ the combined output stream
+concatQueuedStreams s streams = Cons z where
+  z = do reading <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+         writing <- liftSimulation $ newResourceWithMaxCount s 1 (Just 1)
+         conting <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+         session <- liftParameter simulationSession
+         ref <- liftComp $ newProtoRef session Nothing
+         let writer p =
+               do (a, xs) <- runStream p
+                  requestResource writing
+                  liftComp $ writeProtoRef ref (Just a)
+                  releaseResource reading
+                  requestResource conting
+                  writer xs
+             reader =
+               do requestResource reading
+                  Just a <- liftComp $ readProtoRef ref
+                  liftComp $ writeProtoRef ref Nothing
+                  releaseResource writing
+                  return a
+         forM_ streams $ spawnProcess CancelTogether . writer
+         a <- reader
+         let xs = repeatProcess (releaseResource conting >> reader)
+         return (a, xs)
+
+-- | Concatenate the input priority streams producing one output stream.
+concatPriorityStreams :: (MonadComp m, PriorityQueueStrategy m s p)
+                         => s
+                         -- ^ the strategy applied for enqueuing the input data
+                         -> [Stream m (p, a)]
+                         -- ^ the input stream
+                         -> Stream m a
+                         -- ^ the combined output stream
+concatPriorityStreams s streams = Cons z where
+  z = do reading <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+         writing <- liftSimulation $ newResourceWithMaxCount s 1 (Just 1)
+         conting <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+         session <- liftParameter simulationSession
+         ref <- liftComp $ newProtoRef session Nothing
+         let writer p =
+               do ((priority, a), xs) <- runStream p
+                  requestResourceWithPriority writing priority
+                  liftComp $ writeProtoRef ref (Just a)
+                  releaseResource reading
+                  requestResource conting
+                  writer xs
+             reader =
+               do requestResource reading
+                  Just a <- liftComp $ readProtoRef ref
+                  liftComp $ writeProtoRef ref Nothing
+                  releaseResource writing
+                  return a
+         forM_ streams $ spawnProcess CancelTogether . writer
+         a <- reader
+         let xs = repeatProcess (releaseResource conting >> reader)
+         return (a, xs)
+
+-- | Merge two streams applying the 'FCFS' strategy for enqueuing the input data.
+mergeStreams :: MonadComp m => Stream m a -> Stream m a -> Stream m a
+mergeStreams = mergeQueuedStreams FCFS
+
+-- | Merge two streams.
+--
+-- If you don't know what the strategy to apply, then you probably
+-- need the 'FCFS' strategy, or function 'mergeStreams' that
+-- does namely this.
+mergeQueuedStreams :: (MonadComp m, EnqueueStrategy m s)
+                      => s
+                      -- ^ the strategy applied for enqueuing the input data
+                      -> Stream m a
+                      -- ^ the fist input stream
+                      -> Stream m a
+                      -- ^ the second input stream
+                      -> Stream m a
+                      -- ^ the output combined stream
+mergeQueuedStreams s x y = concatQueuedStreams s [x, y]
+
+-- | Merge two priority streams.
+mergePriorityStreams :: (MonadComp m, PriorityQueueStrategy m s p)
+                        => s
+                        -- ^ the strategy applied for enqueuing the input data
+                        -> Stream m (p, a)
+                        -- ^ the fist input stream
+                        -> Stream m (p, a)
+                        -- ^ the second input stream
+                        -> Stream m a
+                        -- ^ the output combined stream
+mergePriorityStreams s x y = concatPriorityStreams s [x, y]
+
+-- | An empty stream that never returns data.
+emptyStream :: MonadComp m => Stream m a
+emptyStream = Cons neverProcess
+
+-- | Consume the stream. It returns a process that infinitely reads data
+-- from the stream and then redirects them to the provided function.
+-- It is useful for modeling the process of enqueueing data in the queue
+-- from the input stream.
+consumeStream :: MonadComp m => (a -> Process m ()) -> Stream m a -> Process m ()
+consumeStream f = p where
+  p (Cons s) = do (a, xs) <- s
+                  f a
+                  p xs
+
+-- | Sink the stream. It returns a process that infinitely reads data
+-- from the stream. The resulting computation can be a moving force
+-- to simulate the whole system of the interconnected streams and
+-- processors.
+sinkStream :: MonadComp m => Stream m a -> Process m ()
+sinkStream = p where
+  p (Cons s) = do (a, xs) <- s
+                  p xs
+  
+-- | Prefetch the input stream requesting for one more data item in advance 
+-- while the last received item is not yet fully processed in the chain of 
+-- streams, usually by the processors.
+--
+-- You can think of this as the prefetched stream could place its latest 
+-- data item in some temporary space for later use, which is very useful 
+-- for modeling a sequence of separate and independent work places.
+prefetchStream :: MonadComp m => Stream m a -> Stream m a
+prefetchStream s = Cons z where
+  z = do reading <- liftSimulation $ newResourceWithMaxCount FCFS 0 (Just 1)
+         writing <- liftSimulation $ newResourceWithMaxCount FCFS 1 (Just 1)
+         session <- liftParameter simulationSession
+         ref <- liftComp $ newProtoRef session Nothing
+         let writer p =
+               do (a, xs) <- runStream p
+                  requestResource writing
+                  liftComp $ writeProtoRef ref (Just a)
+                  releaseResource reading
+                  writer xs
+             reader =
+               do requestResource reading
+                  Just a <- liftComp $ readProtoRef ref
+                  liftComp $ writeProtoRef ref Nothing
+                  releaseResource writing
+                  return a
+         spawnProcess CancelTogether $ writer s
+         runStream $ repeatProcess reader
+
+-- | Return a stream of values triggered by the specified signal.
+--
+-- Since the time at which the values of the stream are requested for may differ from
+-- the time at which the signal is triggered, it can be useful to apply the 'arrivalSignal'
+-- function to add the information about the time points at which the signal was 
+-- actually received.
+--
+-- The point is that the 'Stream' is requested outside, while the 'Signal' is triggered
+-- inside. They are different by nature. The former is passive, while the latter is active.
+--
+-- The resulting stream may be a root of space leak as it uses an internal queue to store
+-- the values received from the signal. The oldest value is dequeued each time we request
+-- the stream and it is returned within the computation.
+--
+-- Cancel the stream's process to unsubscribe from the specified signal.
+signalStream :: MonadComp m => Signal m a -> Process m (Stream m a)
+signalStream s =
+  do q <- liftEvent newFCFSQueue
+     h <- liftEvent $
+          handleSignal s $ 
+          enqueue q
+     whenCancellingProcess $ disposeEvent h
+     return $ repeatProcess $ dequeue q
+
+-- | Return a computation of the signal that triggers values from the specified stream,
+-- each time the next value of the stream is received within the underlying 'Process' 
+-- computation.
+--
+-- Cancel the returned process to stop reading from the specified stream. 
+streamSignal :: MonadComp m => Stream m a -> Process m (Signal m a)
+streamSignal z =
+  do s <- liftSimulation newSignalSource
+     spawnProcess CancelTogether $
+       consumeStream (liftEvent . triggerSignal s) z
+     return $ publishSignal s
+
+-- | Transform a stream so that the resulting stream returns a sequence of arrivals
+-- saving the information about the time points at which the original stream items 
+-- were received by demand.
+arrivalStream :: MonadComp m => Stream m a -> Stream m (Arrival a)
+arrivalStream s = Cons $ loop s Nothing where
+  loop s t0 = do (a, xs) <- runStream s
+                 t <- liftDynamics time
+                 let b = Arrival { arrivalValue = a,
+                                   arrivalTime  = t,
+                                   arrivalDelay =
+                                     case t0 of
+                                       Nothing -> Nothing
+                                       Just t0 -> Just (t - t0) }
+                 return (b, Cons $ loop xs (Just t))
+
+-- | Delay the stream by one step using the specified initial value.
+delayStream :: MonadComp m => a -> Stream m a -> Stream m a
+delayStream a0 s = Cons $ return (a0, s)
+ Simulation/Aivika/Trans/Stream/Random.hs view
@@ -0,0 +1,162 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Stream.Random
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines random streams of events, which are useful
+-- for describing the input of the model.
+--
+
+module Simulation.Aivika.Trans.Stream.Random
+       (-- * Stream of Random Events
+        randomStream,
+        randomUniformStream,
+        randomUniformIntStream,
+        randomNormalStream,
+        randomExponentialStream,
+        randomErlangStream,
+        randomPoissonStream,
+        randomBinomialStream) where
+
+import System.Random
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Parameter.Random
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Event
+import Simulation.Aivika.Trans.Process
+import Simulation.Aivika.Trans.Processor
+import Simulation.Aivika.Trans.Stream
+import Simulation.Aivika.Trans.Statistics
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Arrival
+
+-- | Return a sream of random events that arrive with the specified delay.
+randomStream :: MonadComp m
+                => Parameter m (Double, a)
+                -- ^ compute a pair of the delay and event of type @a@
+                -> Stream m (Arrival a)
+                -- ^ a stream of delayed events
+randomStream delay = Cons $ loop Nothing where
+  loop t0 =
+    do t1 <- liftDynamics time
+       case t0 of
+         Nothing -> return ()
+         Just t0 ->
+           when (t1 /= t0) $
+           error $
+           "The time of requesting for a new random event is different from " ++
+           "the time when the previous event has arrived. Probably, your model " ++
+           "contains a logical error. The random events should be requested permanently. " ++
+           "At least, they can be lost, for example, when trying to enqueue them, but " ++
+           "the random stream itself must always execute: randomStream."
+       (delay, a) <- liftParameter delay
+       holdProcess delay
+       t2 <- liftDynamics time
+       let arrival = Arrival { arrivalValue = a,
+                               arrivalTime  = t2,
+                               arrivalDelay =
+                                 case t0 of
+                                   Nothing -> Nothing
+                                   Just t0 -> Just delay }
+       return (arrival, Cons $ loop (Just t2))
+
+-- | Create a new stream with delays distributed uniformly.
+randomUniformStream :: MonadComp m
+                       => Double
+                       -- ^ the minimum delay
+                       -> Double
+                       -- ^ the maximum delay
+                       -> Stream m (Arrival Double)
+                       -- ^ the stream of random events with the delays generated
+randomUniformStream min max =
+  randomStream $
+  randomUniform min max >>= \x ->
+  return (x, x)
+
+-- | Create a new stream with integer delays distributed uniformly.
+randomUniformIntStream :: MonadComp m
+                          => Int
+                          -- ^ the minimum delay
+                          -> Int
+                          -- ^ the maximum delay
+                          -> Stream m (Arrival Int)
+                          -- ^ the stream of random events with the delays generated
+randomUniformIntStream min max =
+  randomStream $
+  randomUniformInt min max >>= \x ->
+  return (fromIntegral x, x)
+
+-- | Create a new stream with delays distributed normally.
+randomNormalStream :: MonadComp m
+                      => Double
+                      -- ^ the mean delay
+                      -> Double
+                      -- ^ the delay deviation
+                      -> Stream m (Arrival Double)
+                      -- ^ the stream of random events with the delays generated
+randomNormalStream mu nu =
+  randomStream $
+  randomNormal mu nu >>= \x ->
+  return (x, x)
+         
+-- | Return a new stream with delays distibuted exponentially with the specified mean
+-- (the reciprocal of the rate).
+randomExponentialStream :: MonadComp m
+                           => Double
+                           -- ^ the mean delay (the reciprocal of the rate)
+                           -> Stream m (Arrival Double)
+                           -- ^ the stream of random events with the delays generated
+randomExponentialStream mu =
+  randomStream $
+  randomExponential mu >>= \x ->
+  return (x, x)
+         
+-- | Return a new stream with delays having the Erlang distribution with the specified
+-- scale (the reciprocal of the rate) and shape parameters.
+randomErlangStream :: MonadComp m
+                      => Double
+                      -- ^ the scale (the reciprocal of the rate)
+                      -> Int
+                      -- ^ the shape
+                      -> Stream m (Arrival Double)
+                      -- ^ the stream of random events with the delays generated
+randomErlangStream beta m =
+  randomStream $
+  randomErlang beta m >>= \x ->
+  return (x, x)
+
+-- | Return a new stream with delays having the Poisson distribution with
+-- the specified mean.
+randomPoissonStream :: MonadComp m
+                       => Double
+                       -- ^ the mean delay
+                       -> Stream m (Arrival Int)
+                       -- ^ the stream of random events with the delays generated
+randomPoissonStream mu =
+  randomStream $
+  randomPoisson mu >>= \x ->
+  return (fromIntegral x, x)
+
+-- | Return a new stream with delays having the binomial distribution with the specified
+-- probability and trials.
+randomBinomialStream :: MonadComp m
+                        => Double
+                        -- ^ the probability
+                        -> Int
+                        -- ^ the number of trials
+                        -> Stream m (Arrival Int)
+                        -- ^ the stream of random events with the delays generated
+randomBinomialStream prob trials =
+  randomStream $
+  randomBinomial prob trials >>= \x ->
+  return (fromIntegral x, x)
+ Simulation/Aivika/Trans/SystemDynamics.hs view
@@ -0,0 +1,747 @@+
+{-# LANGUAGE BangPatterns, RecursiveDo, FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.SystemDynamics
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines integrals and other functions of System Dynamics.
+--
+
+module Simulation.Aivika.Trans.SystemDynamics
+       (-- * Equality and Ordering
+        (.==.),
+        (./=.),
+        (.<.),
+        (.>=.),
+        (.>.),
+        (.<=.),
+        maxDynamics,
+        minDynamics,
+        ifDynamics,
+        -- * Ordinary Differential Equations
+        integ,
+        smoothI,
+        smooth,
+        smooth3I,
+        smooth3,
+        smoothNI,
+        smoothN,
+        delay1I,
+        delay1,
+        delay3I,
+        delay3,
+        delayNI,
+        delayN,
+        forecast,
+        trend,
+        -- * Difference Equations
+        diffsum,
+        -- * Table Functions
+        lookupDynamics,
+        lookupStepwiseDynamics,
+        -- * Discrete Functions
+        delay,
+        delayI,
+        step,
+        pulse,
+        pulseP,
+        ramp,
+        -- * Financial Functions
+        npv,
+        npve) where
+
+import Data.Array
+
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Comp.IO
+import Simulation.Aivika.Trans.Unboxed
+import Simulation.Aivika.Trans.Table
+
+import qualified Simulation.Aivika.Trans.Dynamics.Memo as M
+import qualified Simulation.Aivika.Trans.Dynamics.Memo.Unboxed as MU
+
+--
+-- Equality and Ordering
+--
+
+-- | Compare for equality.
+(.==.) :: (MonadComp m, Eq a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (.==.) #-}
+(.==.) = liftM2 (==)
+
+-- | Compare for inequality.
+(./=.) :: (MonadComp m, Eq a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (./=.) #-}
+(./=.) = liftM2 (/=)
+
+-- | Compare for ordering.
+(.<.) :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (.<.) #-}
+(.<.) = liftM2 (<)
+
+-- | Compare for ordering.
+(.>=.) :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (.>=.) #-}
+(.>=.) = liftM2 (>=)
+
+-- | Compare for ordering.
+(.>.) :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (.>.) #-}
+(.>.) = liftM2 (>)
+
+-- | Compare for ordering.
+(.<=.) :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m Bool
+{-# INLINE (.<=.) #-}
+(.<=.) = liftM2 (<=)
+
+-- | Return the maximum.
+maxDynamics :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m a
+{-# INLINE maxDynamics #-}
+maxDynamics = liftM2 max
+
+-- | Return the minimum.
+minDynamics :: (MonadComp m, Ord a) => Dynamics m a -> Dynamics m a -> Dynamics m a
+{-# INLINE minDynamics #-}
+minDynamics = liftM2 min
+
+-- | Implement the if-then-else operator.
+ifDynamics :: MonadComp m => Dynamics m Bool -> Dynamics m a -> Dynamics m a -> Dynamics m a
+{-# INLINE ifDynamics #-}
+ifDynamics cond x y =
+  do a <- cond
+     if a then x else y
+
+--
+-- Ordinary Differential Equations
+--
+
+integEuler :: MonadComp m
+              => Dynamics m Double
+              -> Dynamics m Double 
+              -> Dynamics m Double 
+              -> Point m
+              -> m Double
+integEuler (Dynamics f) (Dynamics i) (Dynamics y) p = 
+  case pointIteration p of
+    0 -> 
+      i p
+    n -> do 
+      let sc = pointSpecs p
+          ty = basicTime sc (n - 1) 0
+          py = p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
+      a <- y py
+      b <- f py
+      let !v = a + spcDT (pointSpecs p) * b
+      return v
+
+integRK2 :: MonadComp m
+            => Dynamics m Double
+            -> Dynamics m Double
+            -> Dynamics m Double
+            -> Point m
+            -> m Double
+integRK2 (Dynamics f) (Dynamics i) (Dynamics y) p =
+  case pointPhase p of
+    0 -> case pointIteration p of
+      0 ->
+        i p
+      n -> do
+        let sc = pointSpecs p
+            ty = basicTime sc (n - 1) 0
+            t1 = ty
+            t2 = basicTime sc (n - 1) 1
+            py = p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
+            p1 = py
+            p2 = p { pointTime = t2, pointIteration = n - 1, pointPhase = 1 }
+        vy <- y py
+        k1 <- f p1
+        k2 <- f p2
+        let !v = vy + spcDT sc / 2.0 * (k1 + k2)
+        return v
+    1 -> do
+      let sc = pointSpecs p
+          n  = pointIteration p
+          ty = basicTime sc n 0
+          t1 = ty
+          py = p { pointTime = ty, pointIteration = n, pointPhase = 0 }
+          p1 = py
+      vy <- y py
+      k1 <- f p1
+      let !v = vy + spcDT sc * k1
+      return v
+    _ -> 
+      error "Incorrect phase: integRK2"
+
+integRK4 :: MonadComp m
+            => Dynamics m Double
+            -> Dynamics m Double
+            -> Dynamics m Double
+            -> Point m
+            -> m Double
+integRK4 (Dynamics f) (Dynamics i) (Dynamics y) p =
+  case pointPhase p of
+    0 -> case pointIteration p of
+      0 -> 
+        i p
+      n -> do
+        let sc = pointSpecs p
+            ty = basicTime sc (n - 1) 0
+            t1 = ty
+            t2 = basicTime sc (n - 1) 1
+            t3 = basicTime sc (n - 1) 2
+            t4 = basicTime sc (n - 1) 3
+            py = p { pointTime = ty, pointIteration = n - 1, pointPhase = 0 }
+            p1 = py
+            p2 = p { pointTime = t2, pointIteration = n - 1, pointPhase = 1 }
+            p3 = p { pointTime = t3, pointIteration = n - 1, pointPhase = 2 }
+            p4 = p { pointTime = t4, pointIteration = n - 1, pointPhase = 3 }
+        vy <- y py
+        k1 <- f p1
+        k2 <- f p2
+        k3 <- f p3
+        k4 <- f p4
+        let !v = vy + spcDT sc / 6.0 * (k1 + 2.0 * k2 + 2.0 * k3 + k4)
+        return v
+    1 -> do
+      let sc = pointSpecs p
+          n  = pointIteration p
+          ty = basicTime sc n 0
+          t1 = ty
+          py = p { pointTime = ty, pointIteration = n, pointPhase = 0 }
+          p1 = py
+      vy <- y py
+      k1 <- f p1
+      let !v = vy + spcDT sc / 2.0 * k1
+      return v
+    2 -> do
+      let sc = pointSpecs p
+          n  = pointIteration p
+          ty = basicTime sc n 0
+          t2 = basicTime sc n 1
+          py = p { pointTime = ty, pointIteration = n, pointPhase = 0 }
+          p2 = p { pointTime = t2, pointIteration = n, pointPhase = 1 }
+      vy <- y py
+      k2 <- f p2
+      let !v = vy + spcDT sc / 2.0 * k2
+      return v
+    3 -> do
+      let sc = pointSpecs p
+          n  = pointIteration p
+          ty = basicTime sc n 0
+          t3 = basicTime sc n 2
+          py = p { pointTime = ty, pointIteration = n, pointPhase = 0 }
+          p3 = p { pointTime = t3, pointIteration = n, pointPhase = 2 }
+      vy <- y py
+      k3 <- f p3
+      let !v = vy + spcDT sc * k3
+      return v
+    _ -> 
+      error "Incorrect phase: integRK4"
+
+-- | Return an integral with the specified derivative and initial value.
+--
+-- To create a loopback, you should use the recursive do-notation.
+-- It allows defining the differential equations unordered as
+-- in mathematics:
+--
+-- @
+-- model = 
+--   mdo a <- integ (- ka * a) 100
+--       b <- integ (ka * a - kb * b) 0
+--       c <- integ (kb * b) 0
+--       let ka = 1
+--           kb = 1
+--       runDynamicsInStopTime $ sequence [a, b, c]
+-- @
+integ :: (MonadComp m, MonadFix m)
+         => Dynamics m Double                  -- ^ the derivative
+         -> Dynamics m Double                  -- ^ the initial value
+         -> Simulation m (Dynamics m Double)   -- ^ the integral
+integ diff i =
+  mdo y <- MU.memoDynamics z
+      z <- Simulation $ \r ->
+        case spcMethod (runSpecs r) of
+          Euler -> return $ Dynamics $ integEuler diff i y
+          RungeKutta2 -> return $ Dynamics $ integRK2 diff i y
+          RungeKutta4 -> return $ Dynamics $ integRK4 diff i y
+      return y
+
+-- | Return the first order exponential smooth.
+--
+-- To create a loopback, you should use the recursive do-notation
+-- with help of which the function itself is defined:
+--
+-- @
+-- smoothI x t i =
+--   mdo y <- integ ((x - y) \/ t) i
+--       return y
+-- @     
+smoothI :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to smooth over time
+           -> Dynamics m Double                  -- ^ time
+           -> Dynamics m Double                  -- ^ the initial value
+           -> Simulation m (Dynamics m Double)   -- ^ the first order exponential smooth
+smoothI x t i =
+  mdo y <- integ ((x - y) / t) i
+      return y
+
+-- | Return the first order exponential smooth.
+--
+-- This is a simplified version of the 'smoothI' function
+-- without specifing the initial value.
+smooth :: (MonadComp m, MonadFix m)
+          => Dynamics m Double                  -- ^ the value to smooth over time
+          -> Dynamics m Double                  -- ^ time
+          -> Simulation m (Dynamics m Double)   -- ^ the first order exponential smooth
+smooth x t = smoothI x t x
+
+-- | Return the third order exponential smooth.
+--
+-- To create a loopback, you should use the recursive do-notation
+-- with help of which the function itself is defined:
+--
+-- @
+-- smooth3I x t i =
+--   mdo y  <- integ ((s2 - y) \/ t') i
+--       s2 <- integ ((s1 - s2) \/ t') i
+--       s1 <- integ ((x - s1) \/ t') i
+--       let t' = t \/ 3.0
+--       return y
+-- @     
+smooth3I :: (MonadComp m, MonadFix m)
+            => Dynamics m Double                  -- ^ the value to smooth over time
+            -> Dynamics m Double                  -- ^ time
+            -> Dynamics m Double                  -- ^ the initial value
+            -> Simulation m (Dynamics m Double)   -- ^ the third order exponential smooth
+smooth3I x t i =
+  mdo y  <- integ ((s2 - y) / t') i
+      s2 <- integ ((s1 - s2) / t') i
+      s1 <- integ ((x - s1) / t') i
+      let t' = t / 3.0
+      return y
+
+-- | Return the third order exponential smooth.
+-- 
+-- This is a simplified version of the 'smooth3I' function
+-- without specifying the initial value.
+smooth3 :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to smooth over time
+           -> Dynamics m Double                  -- ^ time
+           -> Simulation m (Dynamics m Double)   -- ^ the third order exponential smooth
+smooth3 x t = smooth3I x t x
+
+-- | Return the n'th order exponential smooth.
+--
+-- The result is not discrete in that sense that it may change within the integration time
+-- interval depending on the integration method used. Probably, you should apply
+-- the 'discreteDynamics' function to the result if you want to achieve an effect when
+-- the value is not changed within the time interval, which is used sometimes.
+smoothNI :: (MonadComp m, MonadFix m)
+            => Dynamics m Double                  -- ^ the value to smooth over time
+            -> Dynamics m Double                  -- ^ time
+            -> Int                                -- ^ the order
+            -> Dynamics m Double                  -- ^ the initial value
+            -> Simulation m (Dynamics m Double)   -- ^ the n'th order exponential smooth
+smoothNI x t n i =
+  mdo s <- forM [1 .. n] $ \k ->
+        if k == 1
+        then integ ((x - a ! 1) / t') i
+        else integ ((a ! (k - 1) - a ! k) / t') i
+      let a  = listArray (1, n) s 
+          t' = t / fromIntegral n
+      return $ a ! n
+
+-- | Return the n'th order exponential smooth.
+--
+-- This is a simplified version of the 'smoothNI' function
+-- without specifying the initial value.
+smoothN :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to smooth over time
+           -> Dynamics m Double                  -- ^ time
+           -> Int                                -- ^ the order
+           -> Simulation m (Dynamics m Double)   -- ^ the n'th order exponential smooth
+smoothN x t n = smoothNI x t n x
+
+-- | Return the first order exponential delay.
+--
+-- To create a loopback, you should use the recursive do-notation
+-- with help of which the function itself is defined:
+--
+-- @
+-- delay1I x t i =
+--   mdo y <- integ (x - y \/ t) (i * t)
+--       return $ y \/ t
+-- @     
+delay1I :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to conserve
+           -> Dynamics m Double                  -- ^ time
+           -> Dynamics m Double                  -- ^ the initial value
+           -> Simulation m (Dynamics m Double)   -- ^ the first order exponential delay
+delay1I x t i =
+  mdo y <- integ (x - y / t) (i * t)
+      return $ y / t
+
+-- | Return the first order exponential delay.
+--
+-- This is a simplified version of the 'delay1I' function
+-- without specifying the initial value.
+delay1 :: (MonadComp m, MonadFix m)
+          => Dynamics m Double                  -- ^ the value to conserve
+          -> Dynamics m Double                  -- ^ time
+          -> Simulation m (Dynamics m Double)   -- ^ the first order exponential delay
+delay1 x t = delay1I x t x
+
+-- | Return the third order exponential delay.
+delay3I :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to conserve
+           -> Dynamics m Double                  -- ^ time
+           -> Dynamics m Double                  -- ^ the initial value
+           -> Simulation m (Dynamics m Double)   -- ^ the third order exponential delay
+delay3I x t i =
+  mdo y  <- integ (s2 / t' - y / t') (i * t')
+      s2 <- integ (s1 / t' - s2 / t') (i * t')
+      s1 <- integ (x - s1 / t') (i * t')
+      let t' = t / 3.0
+      return $ y / t'         
+
+-- | Return the third order exponential delay.
+--
+-- This is a simplified version of the 'delay3I' function
+-- without specifying the initial value.
+delay3 :: (MonadComp m, MonadFix m)
+          => Dynamics m Double                  -- ^ the value to conserve
+          -> Dynamics m Double                  -- ^ time
+          -> Simulation m (Dynamics m Double)   -- ^ the third order exponential delay
+delay3 x t = delay3I x t x
+
+-- | Return the n'th order exponential delay.
+delayNI :: (MonadComp m, MonadFix m)
+           => Dynamics m Double                  -- ^ the value to conserve
+           -> Dynamics m Double                  -- ^ time
+           -> Int                                -- ^ the order
+           -> Dynamics m Double                  -- ^ the initial value
+           -> Simulation m (Dynamics m Double)   -- ^ the n'th order exponential delay
+delayNI x t n i =
+  mdo s <- forM [1 .. n] $ \k ->
+        if k == 1
+        then integ (x - (a ! 1) / t') (i * t')
+        else integ ((a ! (k - 1)) / t' - (a ! k) / t') (i * t')
+      let a  = listArray (1, n) s
+          t' = t / fromIntegral n
+      return $ (a ! n) / t'
+
+-- | Return the n'th order exponential delay.
+--
+-- This is a simplified version of the 'delayNI' function
+-- without specifying the initial value.
+delayN :: (MonadComp m, MonadFix m)
+          => Dynamics m Double                  -- ^ the value to conserve
+          -> Dynamics m Double                  -- ^ time
+          -> Int                                -- ^ the order
+          -> Simulation m (Dynamics m Double)   -- ^ the n'th order exponential delay
+delayN x t n = delayNI x t n x
+
+-- | Return the forecast.
+--
+-- The function has the following definition:
+--
+-- @
+-- forecast x at hz =
+--   do y <- smooth x at
+--      return $ x * (1.0 + (x \/ y - 1.0) \/ at * hz)
+-- @
+forecast :: (MonadComp m, MonadFix m)
+            => Dynamics m Double                  -- ^ the value to forecast
+            -> Dynamics m Double                  -- ^ the average time
+            -> Dynamics m Double                  -- ^ the time horizon
+            -> Simulation m (Dynamics m Double)   -- ^ the forecast
+forecast x at hz =
+  do y <- smooth x at
+     return $ x * (1.0 + (x / y - 1.0) / at * hz)
+
+-- | Return the trend.
+--
+-- The function has the following definition:
+--
+-- @
+-- trend x at i =
+--   do y <- smoothI x at (x \/ (1.0 + i * at))
+--      return $ (x \/ y - 1.0) \/ at
+-- @
+trend :: (MonadComp m, MonadFix m)
+         => Dynamics m Double                  -- ^ the value for which the trend is calculated
+         -> Dynamics m Double                  -- ^ the average time
+         -> Dynamics m Double                  -- ^ the initial value
+         -> Simulation m (Dynamics m Double)   -- ^ the fractional change rate
+trend x at i =
+  do y <- smoothI x at (x / (1.0 + i * at))
+     return $ (x / y - 1.0) / at
+
+--
+-- Difference Equations
+--
+
+-- | Retun the sum for the difference equation.
+-- It is like an integral returned by the 'integ' function, only now
+-- the difference is used instead of derivative.
+--
+-- As usual, to create a loopback, you should use the recursive do-notation.
+diffsum :: (MonadComp m, MonadFix m,
+            Unboxed m a, Num a)
+           => Dynamics m a                  -- ^ the difference
+           -> Dynamics m a                  -- ^ the initial value
+           -> Simulation m (Dynamics m a)   -- ^ the sum
+diffsum (Dynamics diff) (Dynamics i) =
+  mdo y <-
+        MU.memo0Dynamics $
+        Dynamics $ \p ->
+        case pointIteration p of
+          0 -> i p
+          n -> do 
+            let Dynamics m = y
+                sc = pointSpecs p
+                ty = basicTime sc (n - 1) 0
+                py = p { pointTime = ty, 
+                         pointIteration = n - 1, 
+                         pointPhase = 0 }
+            a <- m py
+            b <- diff py
+            let !v = a + b
+            return v
+      return y
+
+--
+-- Table Functions
+--
+
+-- | Lookup @x@ in a table of pairs @(x, y)@ using linear interpolation.
+lookupDynamics :: MonadComp m => Dynamics m Double -> Array Int (Double, Double) -> Dynamics m Double
+lookupDynamics (Dynamics m) tbl =
+  Dynamics $ \p ->
+  do a <- m p
+     return $ tableLookup a tbl
+
+-- | Lookup @x@ in a table of pairs @(x, y)@ using stepwise function.
+lookupStepwiseDynamics :: MonadComp m => Dynamics m Double -> Array Int (Double, Double) -> Dynamics m Double
+lookupStepwiseDynamics (Dynamics m) tbl =
+  Dynamics $ \p ->
+  do a <- m p
+     return $ tableLookupStepwise a tbl
+
+--
+-- Discrete Functions
+--
+
+-- | Return the delayed value using the specified lag time.
+delay :: MonadComp m
+         => Dynamics m a          -- ^ the value to delay
+         -> Dynamics m Double     -- ^ the lag time
+         -> Dynamics m a          -- ^ the delayed value
+delay (Dynamics x) (Dynamics d) = discreteDynamics $ Dynamics r 
+  where
+    r p = do 
+      let t  = pointTime p
+          sc = pointSpecs p
+          n  = pointIteration p
+      a <- d p
+      let t' = t - a
+          n' = fromIntegral $ floor $ (t' - spcStartTime sc) / spcDT sc
+          y | n' < 0    = x $ p { pointTime = spcStartTime sc,
+                                  pointIteration = 0, 
+                                  pointPhase = 0 }
+            | n' < n    = x $ p { pointTime = t',
+                                  pointIteration = n',
+                                  pointPhase = -1 }
+            | n' > n    = error $
+                          "Cannot return the future data: delay. " ++
+                          "The lag time cannot be negative."
+            | otherwise = error $
+                          "Cannot return the current data: delay. " ++
+                          "The lag time is too small."
+      y
+
+-- | Return the delayed value using the specified lag time and initial value.
+-- Because of the latter, it allows creating a loop back.
+delayI :: MonadComp m
+          => Dynamics m a                    -- ^ the value to delay
+          -> Dynamics m Double               -- ^ the lag time
+          -> Dynamics m a                    -- ^ the initial value
+          -> Simulation m (Dynamics m a)     -- ^ the delayed value
+delayI (Dynamics x) (Dynamics d) (Dynamics i) = M.memo0Dynamics $ Dynamics r 
+  where
+    r p = do 
+      let t  = pointTime p
+          sc = pointSpecs p
+          n  = pointIteration p
+      a <- d p
+      let t' = t - a
+          n' = fromIntegral $ floor $ (t' - spcStartTime sc) / spcDT sc
+          y | n' < 0    = i $ p { pointTime = spcStartTime sc,
+                                  pointIteration = 0, 
+                                  pointPhase = 0 }
+            | n' < n    = x $ p { pointTime = t',
+                                  pointIteration = n',
+                                  pointPhase = -1 }
+            | n' > n    = error $
+                          "Cannot return the future data: delay. " ++
+                          "The lag time cannot be negative."
+            | otherwise = error $
+                          "Cannot return the current data: delay. " ++
+                          "The lag time is too small."
+      y
+
+--
+-- Financial Functions
+--
+
+-- | Return the Net Present Value (NPV) of the stream computed using the specified
+-- discount rate, the initial value and some factor (usually 1).
+--
+-- It is defined in the following way:
+--
+-- @
+-- npv stream rate init factor =
+--   mdo let dt' = liftParameter dt
+--       df <- integ (- df * rate) 1
+--       accum <- integ (stream * df) init
+--       return $ (accum + dt' * stream * df) * factor
+-- @
+npv :: (MonadComp m, MonadFix m)
+       => Dynamics m Double                  -- ^ the stream
+       -> Dynamics m Double                  -- ^ the discount rate
+       -> Dynamics m Double                  -- ^ the initial value
+       -> Dynamics m Double                  -- ^ factor
+       -> Simulation m (Dynamics m Double)   -- ^ the Net Present Value (NPV)
+npv stream rate init factor =
+  mdo let dt' = liftParameter dt
+      df <- integ (- df * rate) 1
+      accum <- integ (stream * df) init
+      return $ (accum + dt' * stream * df) * factor
+
+-- | Return the Net Present Value End of period (NPVE) of the stream computed
+-- using the specified discount rate, the initial value and some factor.
+--
+-- It is defined in the following way:
+--
+-- @
+-- npve stream rate init factor =
+--   mdo let dt' = liftParameter dt
+--       df <- integ (- df * rate \/ (1 + rate * dt')) (1 \/ (1 + rate * dt'))
+--       accum <- integ (stream * df) init
+--       return $ (accum + dt' * stream * df) * factor
+-- @
+npve :: (MonadComp m, MonadFix m)
+        => Dynamics m Double                  -- ^ the stream
+        -> Dynamics m Double                  -- ^ the discount rate
+        -> Dynamics m Double                  -- ^ the initial value
+        -> Dynamics m Double                  -- ^ factor
+        -> Simulation m (Dynamics m Double)   -- ^ the Net Present Value End (NPVE)
+npve stream rate init factor =
+  mdo let dt' = liftParameter dt
+      df <- integ (- df * rate / (1 + rate * dt')) (1 / (1 + rate * dt'))
+      accum <- integ (stream * df) init
+      return $ (accum + dt' * stream * df) * factor
+
+-- | Computation that returns 0 until the step time and then returns the specified height.
+step :: MonadComp m
+        => Dynamics m Double
+        -- ^ the height
+        -> Dynamics m Double
+        -- ^ the step time
+        -> Dynamics m Double
+step h st =
+  discreteDynamics $
+  Dynamics $ \p ->
+  do let sc = pointSpecs p
+         t  = pointTime p
+     st' <- invokeDynamics p st
+     let t' = t + spcDT sc / 2
+     if st' < t'
+       then invokeDynamics p h
+       else return 0
+
+-- | Computation that returns 1, starting at the time start, and lasting for the interval
+-- width; 0 is returned at all other times.
+pulse :: MonadComp m
+         => Dynamics m Double
+         -- ^ the time start
+         -> Dynamics m Double
+         -- ^ the interval width
+         -> Dynamics m Double
+pulse st w =
+  discreteDynamics $
+  Dynamics $ \p ->
+  do let sc = pointSpecs p
+         t  = pointTime p
+     st' <- invokeDynamics p st
+     let t' = t + spcDT sc / 2
+     if st' < t'
+       then do w' <- invokeDynamics p w
+               return $ if t' < st' + w' then 1 else 0
+       else return 0
+
+-- | Computation that returns 1, starting at the time start, and lasting for the interval
+-- width and then repeats this pattern with the specified period; 0 is returned at all
+-- other times.
+pulseP :: MonadComp m
+          => Dynamics m Double
+          -- ^ the time start
+          -> Dynamics m Double
+          -- ^ the interval width
+          -> Dynamics m Double
+          -- ^ the time period
+          -> Dynamics m Double
+pulseP st w period =
+  discreteDynamics $
+  Dynamics $ \p ->
+  do let sc = pointSpecs p
+         t  = pointTime p
+     p'  <- invokeDynamics p period
+     st' <- invokeDynamics p st
+     let y' = if (p' > 0) && (t > st')
+              then fromIntegral (floor $ (t - st') / p') * p'
+              else 0
+     let st' = st' + y'
+     let t' = t + spcDT sc / 2
+     if st' < t'
+       then do w' <- invokeDynamics p w
+               return $ if t' < st' + w' then 1 else 0
+       else return 0
+
+-- | Computation that returns 0 until the specified time start and then
+-- slopes upward until the end time and then holds constant.
+ramp :: MonadComp m
+        => Dynamics m Double
+        -- ^ the slope parameter
+        -> Dynamics m Double
+        -- ^ the time start
+        -> Dynamics m Double
+        -- ^ the end time
+        -> Dynamics m Double
+ramp slope st e =
+  discreteDynamics $
+  Dynamics $ \p ->
+  do let sc = pointSpecs p
+         t  = pointTime p
+     st' <- invokeDynamics p st
+     if st' < t
+       then do slope' <- invokeDynamics p slope
+               e' <- invokeDynamics p e
+               if t < e'
+                 then return $ slope' * (t - st')
+                 else return $ slope' * (e' - st')
+       else return 0
+ Simulation/Aivika/Trans/Table.hs view
@@ -0,0 +1,16 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Table
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines the table functions.
+--
+module Simulation.Aivika.Trans.Table
+       (tableLookup,
+        tableLookupStepwise) where
+
+import Simulation.Aivika.Table
+ Simulation/Aivika/Trans/Task.hs view
@@ -0,0 +1,173 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Task
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The 'Task' value represents a process that was already started in background.
+-- We can check the completion of the task, receive notifications about changing
+-- its state and even suspend an outer process awaiting the final result of the task.
+-- It complements the 'Process' monad as it allows immediately continuing the main
+-- computation without suspension.
+--
+module Simulation.Aivika.Trans.Task
+       (-- * Task
+        Task,
+        TaskResult(..),
+        taskId,
+        tryGetTaskResult,
+        taskResult,
+        taskResultReceived,
+        taskProcess,
+        cancelTask,
+        taskCancelled,
+        -- * Running Task
+        runTask,
+        runTaskUsingId,
+        -- * Spawning Tasks
+        spawnTask,
+        spawnTaskUsingId,
+        -- * Enqueueing Task
+        enqueueTask,
+        enqueueTaskUsingId) where
+
+import Data.Monoid
+
+import Control.Monad
+import Control.Monad.Trans
+import Control.Exception
+
+import Simulation.Aivika.Trans.Specs
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Parameter
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Cont
+import Simulation.Aivika.Trans.Internal.Process
+import Simulation.Aivika.Trans.Internal.Signal
+
+-- | The task represents a process that was already started in background.
+data Task m a =
+  Task { taskId :: ProcessId m,
+         -- ^ Return an identifier for the process that was launched
+         -- in background for this task.
+         taskResultRef :: ProtoRef m (Maybe (TaskResult a)),
+         -- ^ It contains the result of the computation.
+         taskResultReceived :: Signal m (TaskResult a)
+         -- ^ Return a signal that notifies about receiving
+         -- the result of the task.
+       }
+
+-- | Represents the result of the task.
+data TaskResult a = TaskCompleted a
+                    -- ^ the task was successfully completed and
+                    -- it returned the specified result
+                  | TaskError SomeException
+                    -- ^ the specified exception was raised when performing the task.
+                  | TaskCancelled
+                    -- ^ the task was cancelled
+
+-- | Try to get the task result immediately without suspension.
+tryGetTaskResult :: MonadComp m => Task m a -> Event m (Maybe (TaskResult a))
+tryGetTaskResult t =
+  Event $ \p -> readProtoRef (taskResultRef t)
+
+-- | Return the task result suspending the outer process if required.
+taskResult :: MonadComp m => Task m a -> Process m (TaskResult a)
+taskResult t =
+  do x <- liftComp $ readProtoRef (taskResultRef t)
+     case x of
+       Just x -> return x
+       Nothing -> processAwait (taskResultReceived t)
+
+-- | Cancel the task.
+cancelTask :: MonadComp m => Task m a -> Event m ()
+cancelTask t =
+  cancelProcessWithId (taskId t)
+
+-- | Test whether the task was cancelled.
+taskCancelled :: MonadComp m => Task m a -> Event m Bool
+taskCancelled t =
+  processCancelled (taskId t)
+
+-- | Create a task by the specified process and its identifier.
+newTaskUsingId :: MonadComp m => ProcessId m -> Process m a -> Event m (Task m a, Process m ())
+newTaskUsingId pid p =
+  do sn <- liftParameter simulationSession
+     r <- liftComp $ newProtoRef sn Nothing
+     s <- liftSimulation newSignalSource
+     let t = Task { taskId = pid,
+                    taskResultRef = r,
+                    taskResultReceived = publishSignal s }
+     let m =
+           do v <- liftComp $ newProtoRef sn TaskCancelled
+              finallyProcess
+                (catchProcess
+                 (do a <- p
+                     liftComp $ writeProtoRef v (TaskCompleted a))
+                 (\e ->
+                   liftComp $ writeProtoRef v (TaskError e)))
+                (liftEvent $
+                 do x <- liftComp $ readProtoRef v
+                    liftComp $ writeProtoRef r (Just x)
+                    triggerSignal s x)
+     return (t, m)
+
+-- | Run the process with the specified identifier in background and
+-- return the corresponded task immediately.
+runTaskUsingId :: MonadComp m => ProcessId m -> Process m a -> Event m (Task m a)
+runTaskUsingId pid p =
+  do (t, m) <- newTaskUsingId pid p
+     runProcessUsingId pid m
+     return t
+
+-- | Run the process in background and return the corresponded task immediately.
+runTask :: MonadComp m => Process m a -> Event m (Task m a)
+runTask p =
+  do pid <- liftSimulation newProcessId
+     runTaskUsingId pid p
+
+-- | Enqueue the process that will be started at the specified time with the given
+-- identifier from the event queue. It returns the corresponded task immediately.
+enqueueTaskUsingId :: MonadComp m => Double -> ProcessId m -> Process m a -> Event m (Task m a)
+enqueueTaskUsingId time pid p =
+  do (t, m) <- newTaskUsingId pid p
+     enqueueProcessUsingId time pid m
+     return t
+
+-- | Enqueue the process that will be started at the specified time from the event queue.
+-- It returns the corresponded task immediately.
+enqueueTask :: MonadComp m => Double -> Process m a -> Event m (Task m a)
+enqueueTask time p =
+  do pid <- liftSimulation newProcessId
+     enqueueTaskUsingId time pid p
+
+-- | Run using the specified identifier a child process in background and return
+-- immediately the corresponded task.
+spawnTaskUsingId :: MonadComp m => ContCancellation -> ProcessId m -> Process m a -> Process m (Task m a)
+spawnTaskUsingId cancellation pid p =
+  do (t, m) <- liftEvent $ newTaskUsingId pid p
+     spawnProcessUsingId cancellation pid m
+     return t
+
+-- | Run a child process in background and return immediately the corresponded task.
+spawnTask :: MonadComp m => ContCancellation -> Process m a -> Process m (Task m a)
+spawnTask cancellation p =
+  do pid <- liftSimulation newProcessId
+     spawnTaskUsingId cancellation pid p
+
+-- | Return an outer process that behaves like the task itself except for one thing:
+-- if the outer process is cancelled then it is not enough to cancel the task. 
+taskProcess :: MonadComp m => Task m a -> Process m a
+taskProcess t =
+  do x <- taskResult t
+     case x of
+       TaskCompleted a -> return a
+       TaskError e -> throwProcess e
+       TaskCancelled -> cancelProcess
+ Simulation/Aivika/Trans/Transform.hs view
@@ -0,0 +1,130 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Transform
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The module defines something which is most close to the notion of
+-- analogous circuit as an opposite to the digital one.
+--
+module Simulation.Aivika.Trans.Transform
+       (-- * The Transform Arrow
+        Transform(..),
+        -- * Delaying the Transform
+        delayTransform,
+        -- * The Time Transform
+        timeTransform,
+        -- * Differential and Difference Equations
+        integTransform,
+        sumTransform) where
+
+import qualified Control.Category as C
+import Control.Arrow
+import Control.Monad
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Simulation
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Memo
+import Simulation.Aivika.Trans.Unboxed
+import Simulation.Aivika.Trans.SystemDynamics
+
+-- | It allows representing an analogous circuit as an opposite to
+-- the digital one.
+--
+-- This is a transform of one time varying function to another usually
+-- specified in the integration time points and then interpolated in
+-- other time points with help of one of the memoization functions
+-- like 'memo0Dynamics'.
+--
+newtype Transform m a b =
+  Transform { runTransform :: Dynamics m a -> Simulation m (Dynamics m b)
+              -- ^ Run the transform.
+            }
+
+instance MonadComp m => C.Category (Transform m) where
+
+  id = Transform return
+  
+  (Transform g) . (Transform f) =
+    Transform $ \a -> f a >>= g
+
+instance MonadComp m => Arrow (Transform m) where
+
+  arr f = Transform $ return . fmap f
+
+  first (Transform f) =
+    Transform $ \bd ->
+    do (b, d) <- unzip0Dynamics bd
+       c <- f b
+       return $ liftM2 (,) c d 
+
+  second (Transform f) =
+    Transform $ \db ->
+    do (d, b) <- unzip0Dynamics db
+       c <- f b
+       return $ liftM2 (,) d c
+
+  (Transform f) *** (Transform g) =
+    Transform $ \bb' ->
+    do (b, b') <- unzip0Dynamics bb'
+       c  <- f b
+       c' <- g b'
+       return $ liftM2 (,) c c'
+
+  (Transform f) &&& (Transform g) =
+    Transform $ \b ->
+    do c  <- f b
+       c' <- g b
+       return $ liftM2 (,) c c'
+
+instance (MonadComp m, MonadFix m) => ArrowLoop (Transform m) where
+
+  loop (Transform f) =
+    Transform $ \b ->
+    mdo let bd = liftM2 (,) b d
+        cd <- f bd
+        (c, d) <- unzip0Dynamics cd
+        return c
+
+-- | A transform that returns the current modeling time.
+timeTransform :: MonadComp m => Transform m a Double
+timeTransform = Transform $ const $ return time
+
+-- | Return a delayed transform by the specified lag time and initial value.
+--
+-- This is actually the 'delayI' function wrapped in the 'Transform' type. 
+delayTransform :: MonadComp m
+                  => Dynamics m Double     -- ^ the lag time
+                  -> Dynamics m a       -- ^ the initial value
+                  -> Transform m a a    -- ^ the delayed transform
+delayTransform lagTime init =
+  Transform $ \a -> delayI a lagTime init
+  
+-- | Return a transform that maps the derivative to an integral
+-- by the specified initial value.
+--
+-- This is actually the 'integ' function wrapped in the 'Transform' type. 
+integTransform :: (MonadComp m, MonadFix m)
+                  => Dynamics m Double
+                  -- ^ the initial value
+                  -> Transform m Double Double
+                  -- ^ map the derivative to an integral
+integTransform = Transform . integ
+
+-- | Return a transform that maps the difference to a sum
+-- by the specified initial value.
+--
+-- This is actually the 'diffsum' function wrapped in the 'Transform' type. 
+sumTransform :: (MonadComp m, MonadFix m, Num a, Unboxed m a) =>
+                Dynamics m a
+                -- ^ the initial value
+                -> Transform m a a
+                -- ^ map the difference to a sum
+sumTransform = Transform . diffsum
+ Simulation/Aivika/Trans/Transform/Extra.hs view
@@ -0,0 +1,58 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Transform.Extra
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines auxiliary computations such as interpolation ones
+-- that complement the memoization, for example. There are scan computations too.
+--
+
+module Simulation.Aivika.Trans.Transform.Extra
+       (-- * Interpolation
+        initTransform,
+        discreteTransform,
+        interpolatingTransform,
+        -- * Scans
+        scanTransform,
+        scan1Transform) where
+
+import Control.Monad
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Transform
+import Simulation.Aivika.Trans.Transform.Memo
+
+-- | A transform that returns the initial value.
+initTransform :: Monad m => Transform m a a
+initTransform = Transform $ return . initDynamics
+
+-- | A transform that discretizes the computation in the integration time points.
+discreteTransform :: Monad m => Transform m a a
+discreteTransform = Transform $ return . discreteDynamics
+
+-- | A tranform that interpolates the computation based on the integration time points only.
+-- Unlike the 'discreteTransform' computation it knows about the intermediate 
+-- time points that are used in the Runge-Kutta method.
+interpolatingTransform :: Monad m => Transform m a a
+interpolatingTransform = Transform $ return . interpolateDynamics 
+
+-- | Like the standard 'scanl1' function but applied to values in 
+-- the integration time points. The accumulator values are transformed
+-- according to the second argument, which should be either  
+-- 'memo0Transform' or its unboxed version.
+scan1Transform :: (MonadComp m, MonadFix m) => (a -> a -> a) -> Transform m a a -> Transform m a a
+scan1Transform f (Transform tr) = Transform $ scan1Dynamics f tr
+
+-- | Like the standard 'scanl' function but applied to values in 
+-- the integration time points. The accumulator values are transformed
+-- according to the third argument, which should be either
+-- 'memo0Transform' or its unboxed version.
+scanTransform :: (MonadComp m, MonadFix m) => (a -> b -> a) -> a -> Transform m a a -> Transform m b a
+scanTransform f acc (Transform tr) = Transform $ scanDynamics f acc tr
+ Simulation/Aivika/Trans/Transform/Memo.hs view
@@ -0,0 +1,46 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Transform.Memo
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines memoization transforms. The memoization creates such 'Dynamics'
+-- computations, which values are cached in the integration time points. Then
+-- these values are interpolated in all other time points.
+--
+
+module Simulation.Aivika.Trans.Transform.Memo
+       (memoTransform,
+        memo0Transform,
+        iteratingTransform) where
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Dynamics.Memo
+import Simulation.Aivika.Trans.Transform
+
+-- | A transform that memoizes and order the computation in the integration time points
+-- using the interpolation that knows of the Runge-Kutta method. The values are
+-- calculated sequentially starting from 'starttime'.
+memoTransform :: MonadComp m => Transform m e e
+memoTransform = Transform memoDynamics 
+
+-- | A transform that memoizes and order the computation in the integration time points using 
+-- the 'discreteDynamics' interpolation. It consumes less memory than the 'memoTransform'
+-- computation but it is not aware of the Runge-Kutta method. There is a subtle
+-- difference when we request for values in the intermediate time points
+-- that are used by this method to integrate. In general case you should 
+-- prefer the 'memo0Transform' computation above 'memoTransform'.
+memo0Transform :: MonadComp m => Transform m e e
+memo0Transform =  Transform memo0Dynamics
+
+-- | A transform that iterates sequentially the dynamic process with side effects in 
+-- the integration time points. It is equivalent to the 'memo0Transform' computation
+-- but significantly more efficient, for the internal array is not created.
+iteratingTransform :: MonadComp m => Transform m () ()
+iteratingTransform = Transform iterateDynamics
+ Simulation/Aivika/Trans/Transform/Memo/Unboxed.hs view
@@ -0,0 +1,42 @@+
+{-# LANGUAGE FlexibleContexts #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Transform.Memo.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines the unboxed memoization transforms. The memoization creates such 'Dynamics'
+-- computations, which values are cached in the integration time points. Then
+-- these values are interpolated in all other time points.
+--
+
+module Simulation.Aivika.Trans.Transform.Memo.Unboxed
+       (memoTransform,
+        memo0Transform) where
+
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Parameter
+import Simulation.Aivika.Trans.Dynamics
+import Simulation.Aivika.Trans.Dynamics.Extra
+import Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+import Simulation.Aivika.Trans.Transform
+import Simulation.Aivika.Trans.Unboxed
+
+-- | A transform that memoizes and order the computation in the integration time points
+-- using the interpolation that knows of the Runge-Kutta method. The values are
+-- calculated sequentially starting from 'starttime'.
+memoTransform :: (MonadComp m, Unboxed m e) => Transform m e e
+memoTransform = Transform memoDynamics 
+
+-- | A transform that memoizes and order the computation in the integration time points using 
+-- the 'discreteDynamics' interpolation. It consumes less memory than the 'memoTransform'
+-- computation but it is not aware of the Runge-Kutta method. There is a subtle
+-- difference when we request for values in the intermediate time points
+-- that are used by this method to integrate. In general case you should 
+-- prefer the 'memo0Transform' computation above 'memoTransform'.
+memo0Transform :: (MonadComp m, Unboxed m e) => Transform m e e
+memo0Transform =  Transform memo0Dynamics
+ Simulation/Aivika/Trans/Unboxed.hs view
@@ -0,0 +1,45 @@+
+{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- The 'Unboxed' class allows creating unboxed arrays in monad 'IO'.
+--
+
+module Simulation.Aivika.Trans.Unboxed
+       (Unboxed(..)) where
+
+import Simulation.Aivika.Trans.ProtoArray.Unboxed
+
+import Data.Array
+import Data.Int
+import Data.Word
+
+-- | The type which values can be contained in an unboxed array.
+class ProtoArrayMonad m e => Unboxed m e
+
+instance Unboxed IO Bool
+instance Unboxed IO Char
+instance Unboxed IO Double
+instance Unboxed IO Float
+instance Unboxed IO Int
+instance Unboxed IO Int8
+instance Unboxed IO Int16
+instance Unboxed IO Int32
+instance Unboxed IO Word
+instance Unboxed IO Word8
+instance Unboxed IO Word16
+instance Unboxed IO Word32
+
+#ifndef __HASTE__
+
+instance Unboxed IO Int64
+instance Unboxed IO Word64
+
+#endif
+ Simulation/Aivika/Trans/Var.hs view
@@ -0,0 +1,190 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Var
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines a variable that is bound up with the event queue and 
+-- that keeps the history of changes storing the values in arrays, which
+-- allows using the variable in differential and difference equations of
+-- System Dynamics within hybrid discrete-continuous simulation.
+--
+module Simulation.Aivika.Trans.Var
+       (Var,
+        varChanged,
+        varChanged_,
+        newVar,
+        readVar,
+        varMemo,
+        writeVar,
+        modifyVar,
+        freezeVar) where
+
+import Data.Array
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Signal
+
+import qualified Simulation.Aivika.Trans.Vector as V
+import qualified Simulation.Aivika.Trans.Vector.Unboxed as UV
+
+-- | Like the 'Ref' reference but keeps the history of changes in 
+-- different time points. The 'Var' variable is safe to be used in
+-- the hybrid discrete-continuous simulation.
+--
+-- For example, the memoised values of a variable can be used in
+-- the differential or difference equations of System Dynamics, while
+-- the variable iself can be updated wihin the discrete event simulation.
+--
+-- Only this variable is much slower than the reference.
+data Var m a = 
+  Var { varXS    :: UV.Vector m Double,
+        varMS    :: V.Vector m a,
+        varYS    :: V.Vector m a,
+        varChangedSource :: SignalSource m a }
+     
+-- | Create a new variable.
+newVar :: MonadComp m => a -> Simulation m (Var m a)
+newVar a =
+  Simulation $ \r ->
+  do let sn = runSession r
+     xs <- UV.newVector sn
+     ms <- V.newVector sn
+     ys <- V.newVector sn
+     UV.appendVector xs $ spcStartTime $ runSpecs r
+     V.appendVector ms a
+     V.appendVector ys a
+     s  <- invokeSimulation r newSignalSource
+     return Var { varXS = xs,
+                  varMS = ms,
+                  varYS = ms,
+                  varChangedSource = s }
+
+-- | Read the first actual, i.e. memoised, value of a variable for the requested time
+-- actuating the current events from the queue if needed.
+--
+-- This computation can be used in the ordinary differential and
+-- difference equations of System Dynamics.
+varMemo :: MonadComp m => Var m a -> Dynamics m a
+varMemo v =
+  runEventWith CurrentEventsOrFromPast $
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if x < t
+       then do a <- V.readVector ys i
+               UV.appendVector xs t
+               V.appendVector ms a
+               V.appendVector ys a
+               return a
+       else if x == t
+            then V.readVector ms i
+            else do i <- UV.vectorBinarySearch xs t
+                    if i >= 0
+                      then V.readVector ms i
+                      else V.readVector ms $ - (i + 1) - 1
+
+-- | Read the recent actual value of a variable for the requested time.
+--
+-- This computation is destined for using within discrete event simulation.
+readVar :: MonadComp m => Var m a -> Event m a
+readVar v = 
+  Event $ \p ->
+  do let xs = varXS v
+         ys = varYS v
+         t  = pointTime p
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if x <= t 
+       then V.readVector ys i
+       else do i <- UV.vectorBinarySearch xs t
+               if i >= 0
+                 then V.readVector ys i
+                 else V.readVector ys $ - (i + 1) - 1
+
+-- | Write a new value into the variable.
+writeVar :: MonadComp m => Var m a -> a -> Event m ()
+writeVar v a =
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+         s  = varChangedSource v
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if t < x 
+       then error "Cannot update the past data: writeVar."
+       else if t == x
+            then V.writeVector ys i $! a
+            else do UV.appendVector xs t
+                    V.appendVector ms $! a
+                    V.appendVector ys $! a
+     invokeEvent p $ triggerSignal s a
+
+-- | Mutate the contents of the variable.
+modifyVar :: MonadComp m => Var m a -> (a -> a) -> Event m ()
+modifyVar v f =
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+         s  = varChangedSource v
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if t < x
+       then error "Cannot update the past data: modifyVar."
+       else if t == x
+            then do a <- V.readVector ys i
+                    let b = f a
+                    V.writeVector ys i $! b
+                    invokeEvent p $ triggerSignal s b
+            else do a <- V.readVector ys i
+                    let b = f a
+                    UV.appendVector xs t
+                    V.appendVector ms $! b
+                    V.appendVector ys $! b
+                    invokeEvent p $ triggerSignal s b
+
+-- | Freeze the variable and return in arrays the time points and corresponded 
+-- first and last values when the variable had changed or had been memoised in
+-- different time points: (1) the time points are sorted in ascending order;
+-- (2) the first and last actual values per each time point are provided.
+--
+-- If you need to get all changes including those ones that correspond to the same
+-- simulation time points then you can use the 'newSignalHistory' function passing
+-- in the 'varChanged' signal to it and then call function 'readSignalHistory'.
+freezeVar :: MonadComp m => Var m a -> Event m (Array Int Double, Array Int a, Array Int a)
+freezeVar v =
+  Event $ \p ->
+  do xs <- UV.freezeVector (varXS v)
+     ms <- V.freezeVector (varMS v)
+     ys <- V.freezeVector (varYS v)
+     return (xs, ms, ys)
+     
+-- | Return a signal that notifies about every change of the variable state.
+varChanged :: Var m a -> Signal m a
+varChanged v = publishSignal (varChangedSource v)
+
+-- | Return a signal that notifies about every change of the variable state.
+varChanged_ :: MonadComp m => Var m a -> Signal m ()
+varChanged_ v = mapSignal (const ()) $ varChanged v
+ Simulation/Aivika/Trans/Var/Unboxed.hs view
@@ -0,0 +1,190 @@+
+-- |
+-- Module     : Simulation.Aivika.Trans.Var.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- This module defines an unboxed variable that is bound up with the event queue and 
+-- that keeps the history of changes storing the values in unboxed arrays, which
+-- allows using the variable in differential and difference equations of
+-- System Dynamics within hybrid discrete-continuous simulation.
+--
+module Simulation.Aivika.Trans.Var.Unboxed
+       (Var,
+        varChanged,
+        varChanged_,
+        newVar,
+        readVar,
+        varMemo,
+        writeVar,
+        modifyVar,
+        freezeVar) where
+
+import Data.Array
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.Comp
+import Simulation.Aivika.Trans.Internal.Specs
+import Simulation.Aivika.Trans.Internal.Simulation
+import Simulation.Aivika.Trans.Internal.Dynamics
+import Simulation.Aivika.Trans.Internal.Event
+import Simulation.Aivika.Trans.Internal.Signal
+import Simulation.Aivika.Trans.Ref
+import Simulation.Aivika.Trans.Signal
+import Simulation.Aivika.Trans.Unboxed
+
+import qualified Simulation.Aivika.Trans.Vector.Unboxed as UV
+
+-- | Like the 'Ref' reference but keeps the history of changes in 
+-- different time points. The 'Var' variable is safe to be used in
+-- the hybrid discrete-continuous simulation.
+--
+-- For example, the memoised values of a variable can be used in
+-- the differential or difference equations of System Dynamics, while
+-- the variable iself can be updated wihin the discrete event simulation.
+--
+-- Only this variable is much slower than the reference.
+data Var m a = 
+  Var { varXS    :: UV.Vector m Double,
+        varMS    :: UV.Vector m a,
+        varYS    :: UV.Vector m a,
+        varChangedSource :: SignalSource m a }
+
+-- | Create a new variable.
+newVar :: (MonadComp m, Unboxed m a) => a -> Simulation m (Var m a)
+newVar a =
+  Simulation $ \r ->
+  do let sn = runSession r
+     xs <- UV.newVector sn
+     ms <- UV.newVector sn
+     ys <- UV.newVector sn
+     UV.appendVector xs $ spcStartTime $ runSpecs r
+     UV.appendVector ms a
+     UV.appendVector ys a
+     s  <- invokeSimulation r newSignalSource
+     return Var { varXS = xs,
+                  varMS = ms,
+                  varYS = ms,
+                  varChangedSource = s }
+
+-- | Read the first actual, i.e. memoised, value of a variable for the requested time
+-- actuating the current events from the queue if needed.
+--
+-- This computation can be used in the ordinary differential and
+-- difference equations of System Dynamics.
+varMemo :: (MonadComp m, Unboxed m a) => Var m a -> Dynamics m a
+varMemo v =
+  runEventWith CurrentEventsOrFromPast $
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if x < t
+       then do a <- UV.readVector ys i
+               UV.appendVector xs t
+               UV.appendVector ms a
+               UV.appendVector ys a
+               return a
+       else if x == t
+            then UV.readVector ms i
+            else do i <- UV.vectorBinarySearch xs t
+                    if i >= 0
+                      then UV.readVector ms i
+                      else UV.readVector ms $ - (i + 1) - 1
+
+-- | Read the recent actual value of a variable for the requested time.
+--
+-- This computation is destined for using within discrete event simulation.
+readVar :: (MonadComp m, Unboxed m a) => Var m a -> Event m a
+readVar v = 
+  Event $ \p ->
+  do let xs = varXS v
+         ys = varYS v
+         t  = pointTime p
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if x <= t 
+       then UV.readVector ys i
+       else do i <- UV.vectorBinarySearch xs t
+               if i >= 0
+                 then UV.readVector ys i
+                 else UV.readVector ys $ - (i + 1) - 1
+
+-- | Write a new value into the variable.
+writeVar :: (MonadComp m, Unboxed m a) => Var m a -> a -> Event m ()
+writeVar v a =
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+         s  = varChangedSource v
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if t < x 
+       then error "Cannot update the past data: writeVar."
+       else if t == x
+            then UV.writeVector ys i $! a
+            else do UV.appendVector xs t
+                    UV.appendVector ms $! a
+                    UV.appendVector ys $! a
+     invokeEvent p $ triggerSignal s a
+
+-- | Mutate the contents of the variable.
+modifyVar :: (MonadComp m, Unboxed m a) => Var m a -> (a -> a) -> Event m ()
+modifyVar v f =
+  Event $ \p ->
+  do let xs = varXS v
+         ms = varMS v
+         ys = varYS v
+         t  = pointTime p
+         s  = varChangedSource v
+     count <- UV.vectorCount xs
+     let i = count - 1
+     x <- UV.readVector xs i
+     if t < x
+       then error "Cannot update the past data: modifyVar."
+       else if t == x
+            then do a <- UV.readVector ys i
+                    let b = f a
+                    UV.writeVector ys i $! b
+                    invokeEvent p $ triggerSignal s b
+            else do a <- UV.readVector ys i
+                    let b = f a
+                    UV.appendVector xs t
+                    UV.appendVector ms $! b
+                    UV.appendVector ys $! b
+                    invokeEvent p $ triggerSignal s b
+
+-- | Freeze the variable and return in arrays the time points and corresponded 
+-- first and last values when the variable had changed or had been memoised in
+-- different time points: (1) the time points are sorted in ascending order;
+-- (2) the first and last actual values per each time point are provided.
+--
+-- If you need to get all changes including those ones that correspond to the same
+-- simulation time points then you can use the 'newSignalHistory' function passing
+-- in the 'varChanged' signal to it and then call function 'readSignalHistory'.
+freezeVar :: (MonadComp m, Unboxed m a) => Var m a -> Event m (Array Int Double, Array Int a, Array Int a)
+freezeVar v =
+  Event $ \p ->
+  do xs <- UV.freezeVector (varXS v)
+     ms <- UV.freezeVector (varMS v)
+     ys <- UV.freezeVector (varYS v)
+     return (xs, ms, ys)
+     
+-- | Return a signal that notifies about every change of the variable state.
+varChanged :: Var m a -> Signal m a
+varChanged v = publishSignal (varChangedSource v)
+
+-- | Return a signal that notifies about every change of the variable state.
+varChanged_ :: MonadComp m => Var m a -> Signal m ()
+varChanged_ v = mapSignal (const ()) $ varChanged v
+ Simulation/Aivika/Trans/Vector.hs view
@@ -0,0 +1,199 @@+
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Vector
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a prototype of mutable vectors.
+--
+module Simulation.Aivika.Trans.Vector
+       (Vector,
+        newVector, 
+        copyVector,
+        vectorCount, 
+        appendVector, 
+        readVector, 
+        writeVector,
+        vectorBinarySearch,
+        vectorInsert,
+        vectorDeleteAt,
+        vectorIndex,
+        freezeVector) where 
+
+import Data.Array
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray
+
+-- | A prototype of mutable vector.
+data Vector m a =
+    Vector { vectorSession  :: Session m,
+             vectorArrayRef :: ProtoRef m (ProtoArray m a),
+             vectorCountRef :: ProtoRef m Int, 
+             vectorCapacityRef :: ProtoRef m Int }
+
+-- | Create a new vector within the specified simulation session.
+newVector :: ProtoArrayMonad m => Session m -> m (Vector m a)
+newVector session = 
+  do array <- newProtoArray_ session 4
+     arrayRef <- newProtoRef session array
+     countRef <- newProtoRef session 0
+     capacityRef <- newProtoRef session 4
+     return Vector { vectorSession  = session,
+                     vectorArrayRef = arrayRef,
+                     vectorCountRef = countRef,
+                     vectorCapacityRef = capacityRef }
+
+-- | Copy the vector.
+copyVector :: ProtoArrayMonad m => Vector m a -> m (Vector m a)
+copyVector vector =
+  do let session = vectorSession vector
+     array <- readProtoRef (vectorArrayRef vector)
+     count <- readProtoRef (vectorCountRef vector)
+     array' <- newProtoArray_ session count
+     arrayRef' <- newProtoRef session array'
+     countRef' <- newProtoRef session count
+     capacityRef' <- newProtoRef session count
+     forM_ [0 .. count - 1] $ \i ->
+       do x <- readProtoArray array i
+          writeProtoArray array' i x
+     return Vector { vectorSession  = session,
+                     vectorArrayRef = arrayRef',
+                     vectorCountRef = countRef',
+                     vectorCapacityRef = capacityRef' }
+       
+-- | Ensure that the vector has the specified capacity.
+vectorEnsureCapacity :: ProtoArrayMonad m => Vector m a -> Int -> m ()
+vectorEnsureCapacity vector capacity =
+  do capacity' <- readProtoRef (vectorCapacityRef vector)
+     when (capacity' < capacity) $
+       do array' <- readProtoRef (vectorArrayRef vector)
+          count' <- readProtoRef (vectorCountRef vector)
+          let capacity'' = max (2 * capacity') capacity
+              session    = vectorSession vector
+          array'' <- newProtoArray_ session capacity''
+          forM_ [0 .. count' - 1] $ \i ->
+            do x <- readProtoArray array' i
+               writeProtoArray array'' i x
+          writeProtoRef (vectorArrayRef vector) array''
+          writeProtoRef (vectorCapacityRef vector) capacity''
+
+-- | Return the element count.
+vectorCount :: ProtoArrayMonad m => Vector m a -> m Int
+vectorCount vector = readProtoRef (vectorCountRef vector)
+
+-- | Add the specified element to the end of the vector.
+appendVector :: ProtoArrayMonad m => Vector m a -> a -> m ()          
+appendVector vector item =
+  do count <- readProtoRef (vectorCountRef vector)
+     vectorEnsureCapacity vector (count + 1)
+     array <- readProtoRef (vectorArrayRef vector)
+     writeProtoArray array count item
+     writeProtoRef (vectorCountRef vector) (count + 1)
+
+-- | Read a value from the vector, where indices are started from 0.
+readVector :: ProtoArrayMonad m => Vector m a -> Int -> m a
+readVector vector index =
+  do array <- readProtoRef (vectorArrayRef vector)
+     readProtoArray array index
+
+-- | Set an array item at the specified index which is started from 0.
+writeVector :: ProtoArrayMonad m => Vector m a -> Int -> a -> m ()
+writeVector vector index item =
+  do array <- readProtoRef (vectorArrayRef vector)
+     writeProtoArray array index item
+
+-- | Return the index of the specified element using binary search; otherwise, 
+-- a negated insertion index minus one: 0 -> -0 - 1, ..., i -> -i - 1, ....
+vectorBinarySearch :: (ProtoArrayMonad m, Ord a) => Vector m a -> a -> m Int
+vectorBinarySearch vector item =
+  do array <- readProtoRef (vectorArrayRef vector)
+     count <- readProtoRef (vectorCountRef vector)
+     vectorBinarySearch' array item 0 (count - 1)
+
+-- | Return the index of the specified element using binary search
+-- within the specified range; otherwise, a negated insertion index minus one.
+vectorBinarySearchWithin :: (ProtoArrayMonad m, Ord a) => Vector m a -> a -> Int -> Int -> m Int
+vectorBinarySearchWithin vector item left right =
+  do array <- readProtoRef (vectorArrayRef vector)
+     vectorBinarySearch' array item left right
+
+-- | Return the elements of the vector in an immutable array.
+freezeVector :: ProtoArrayMonad m => Vector m a -> m (Array Int a)
+freezeVector vector =
+  do array <- readProtoRef (vectorArrayRef vector)
+     freezeProtoArray array
+
+-- | Insert the element in the vector at the specified index.
+vectorInsert :: ProtoArrayMonad m => Vector m a -> Int -> a -> m ()
+vectorInsert vector index item =
+  do count <- readProtoRef (vectorCountRef vector)
+     when (index < 0) $
+       error $
+       "Index cannot be " ++
+       "negative: vectorInsert."
+     when (index > count) $
+       error $
+       "Index cannot be greater " ++
+       "than the count: vectorInsert."
+     vectorEnsureCapacity vector (count + 1)
+     array <- readProtoRef (vectorArrayRef vector)
+     forM_ [count, count - 1 .. index + 1] $ \i ->
+       do x <- readProtoArray array (i - 1)
+          writeProtoArray array i x
+     writeProtoArray array index item
+     writeProtoRef (vectorCountRef vector) (count + 1)
+
+-- | Delete the element at the specified index.
+vectorDeleteAt :: ProtoArrayMonad m => Vector m a -> Int -> m ()
+vectorDeleteAt vector index =
+  do count <- readProtoRef (vectorCountRef vector)
+     when (index < 0) $
+       error $
+       "Index cannot be " ++
+       "negative: vectorDeleteAt."
+     when (index >= count) $
+       error $
+       "Index must be less " ++
+       "than the count: vectorDeleteAt."
+     array <- readProtoRef (vectorArrayRef vector)
+     forM_ [index, index + 1 .. count - 2] $ \i ->
+       do x <- readProtoArray array (i + 1)
+          writeProtoArray array i x
+     writeProtoArray array (count - 1) undefined
+     writeProtoRef (vectorCountRef vector) (count - 1)
+
+-- | Return the index of the item or -1.
+vectorIndex :: (ProtoArrayMonad m, Eq a) => Vector m a -> a -> m Int
+vectorIndex vector item =
+  do count <- readProtoRef (vectorCountRef vector)
+     array <- readProtoRef (vectorArrayRef vector)
+     let loop index =
+           if index >= count
+           then return $ -1
+           else do x <- readProtoArray array index
+                   if item == x
+                     then return index
+                     else loop $ index + 1
+     loop 0
+
+vectorBinarySearch' :: (ProtoArrayMonad m, Ord a) => ProtoArray m a -> a -> Int -> Int -> m Int
+vectorBinarySearch' array item left right =
+  if left > right 
+  then return $ - (right + 1) - 1
+  else
+    do let index = (left + right) `div` 2
+       curr <- readProtoArray array index
+       if item < curr 
+         then vectorBinarySearch' array item left (index - 1)
+         else if item == curr
+              then return index
+              else vectorBinarySearch' array item (index + 1) right
+ Simulation/Aivika/Trans/Vector/Unboxed.hs view
@@ -0,0 +1,199 @@+
+{-# LANGUAGE CPP, TypeFamilies, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+
+-- |
+-- Module     : Simulation.Aivika.Trans.Vector.Unboxed
+-- Copyright  : Copyright (c) 2009-2014, David Sorokin <david.sorokin@gmail.com>
+-- License    : BSD3
+-- Maintainer : David Sorokin <david.sorokin@gmail.com>
+-- Stability  : experimental
+-- Tested with: GHC 7.8.3
+--
+-- It defines a prototype of mutable unboxed vectors.
+--
+module Simulation.Aivika.Trans.Vector.Unboxed
+       (Vector,
+        newVector, 
+        copyVector,
+        vectorCount, 
+        appendVector, 
+        readVector, 
+        writeVector,
+        vectorBinarySearch,
+        vectorInsert,
+        vectorDeleteAt,
+        vectorIndex,
+        freezeVector) where 
+
+import Data.Array
+
+import Control.Monad
+
+import Simulation.Aivika.Trans.Session
+import Simulation.Aivika.Trans.ProtoRef
+import Simulation.Aivika.Trans.ProtoArray.Unboxed
+
+-- | A prototype of mutable unboxed vector.
+data Vector m a =
+    Vector { vectorSession  :: Session m,
+             vectorArrayRef :: ProtoRef m (ProtoArray m a),
+             vectorCountRef :: ProtoRef m Int, 
+             vectorCapacityRef :: ProtoRef m Int }
+
+-- | Create a new vector within the specified simulation session.
+newVector :: ProtoArrayMonad m a => Session m -> m (Vector m a)
+newVector session = 
+  do array <- newProtoArray_ session 4
+     arrayRef <- newProtoRef session array
+     countRef <- newProtoRef session 0
+     capacityRef <- newProtoRef session 4
+     return Vector { vectorSession  = session,
+                     vectorArrayRef = arrayRef,
+                     vectorCountRef = countRef,
+                     vectorCapacityRef = capacityRef }
+
+-- | Copy the vector.
+copyVector :: ProtoArrayMonad m a => Vector m a -> m (Vector m a)
+copyVector vector =
+  do let session = vectorSession vector
+     array <- readProtoRef (vectorArrayRef vector)
+     count <- readProtoRef (vectorCountRef vector)
+     array' <- newProtoArray_ session count
+     arrayRef' <- newProtoRef session array'
+     countRef' <- newProtoRef session count
+     capacityRef' <- newProtoRef session count
+     forM_ [0 .. count - 1] $ \i ->
+       do x <- readProtoArray array i
+          writeProtoArray array' i x
+     return Vector { vectorSession  = session,
+                     vectorArrayRef = arrayRef',
+                     vectorCountRef = countRef',
+                     vectorCapacityRef = capacityRef' }
+       
+-- | Ensure that the vector has the specified capacity.
+vectorEnsureCapacity :: ProtoArrayMonad m a => Vector m a -> Int -> m ()
+vectorEnsureCapacity vector capacity =
+  do capacity' <- readProtoRef (vectorCapacityRef vector)
+     when (capacity' < capacity) $
+       do array' <- readProtoRef (vectorArrayRef vector)
+          count' <- readProtoRef (vectorCountRef vector)
+          let capacity'' = max (2 * capacity') capacity
+              session    = vectorSession vector
+          array'' <- newProtoArray_ session capacity''
+          forM_ [0 .. count' - 1] $ \i ->
+            do x <- readProtoArray array' i
+               writeProtoArray array'' i x
+          writeProtoRef (vectorArrayRef vector) array''
+          writeProtoRef (vectorCapacityRef vector) capacity''
+
+-- | Return the element count.
+vectorCount :: ProtoArrayMonad m a => Vector m a -> m Int
+vectorCount vector = readProtoRef (vectorCountRef vector)
+
+-- | Add the specified element to the end of the vector.
+appendVector :: ProtoArrayMonad m a => Vector m a -> a -> m ()          
+appendVector vector item =
+  do count <- readProtoRef (vectorCountRef vector)
+     vectorEnsureCapacity vector (count + 1)
+     array <- readProtoRef (vectorArrayRef vector)
+     writeProtoArray array count item
+     writeProtoRef (vectorCountRef vector) (count + 1)
+
+-- | Read a value from the vector, where indices are started from 0.
+readVector :: ProtoArrayMonad m a => Vector m a -> Int -> m a
+readVector vector index =
+  do array <- readProtoRef (vectorArrayRef vector)
+     readProtoArray array index
+
+-- | Set an array item at the specified index which is started from 0.
+writeVector :: ProtoArrayMonad m a => Vector m a -> Int -> a -> m ()
+writeVector vector index item =
+  do array <- readProtoRef (vectorArrayRef vector)
+     writeProtoArray array index item
+
+-- | Return the index of the specified element using binary search; otherwise, 
+-- a negated insertion index minus one: 0 -> -0 - 1, ..., i -> -i - 1, ....
+vectorBinarySearch :: (ProtoArrayMonad m a, Ord a) => Vector m a -> a -> m Int
+vectorBinarySearch vector item =
+  do array <- readProtoRef (vectorArrayRef vector)
+     count <- readProtoRef (vectorCountRef vector)
+     vectorBinarySearch' array item 0 (count - 1)
+
+-- | Return the index of the specified element using binary search
+-- within the specified range; otherwise, a negated insertion index minus one.
+vectorBinarySearchWithin :: (ProtoArrayMonad m a, Ord a) => Vector m a -> a -> Int -> Int -> m Int
+vectorBinarySearchWithin vector item left right =
+  do array <- readProtoRef (vectorArrayRef vector)
+     vectorBinarySearch' array item left right
+
+-- | Return the elements of the vector in an immutable array.
+freezeVector :: ProtoArrayMonad m a => Vector m a -> m (Array Int a)
+freezeVector vector =
+  do array <- readProtoRef (vectorArrayRef vector)
+     freezeProtoArray array
+
+-- | Insert the element in the vector at the specified index.
+vectorInsert :: ProtoArrayMonad m a => Vector m a -> Int -> a -> m ()
+vectorInsert vector index item =
+  do count <- readProtoRef (vectorCountRef vector)
+     when (index < 0) $
+       error $
+       "Index cannot be " ++
+       "negative: vectorInsert."
+     when (index > count) $
+       error $
+       "Index cannot be greater " ++
+       "than the count: vectorInsert."
+     vectorEnsureCapacity vector (count + 1)
+     array <- readProtoRef (vectorArrayRef vector)
+     forM_ [count, count - 1 .. index + 1] $ \i ->
+       do x <- readProtoArray array (i - 1)
+          writeProtoArray array i x
+     writeProtoArray array index item
+     writeProtoRef (vectorCountRef vector) (count + 1)
+
+-- | Delete the element at the specified index.
+vectorDeleteAt :: ProtoArrayMonad m a => Vector m a -> Int -> m ()
+vectorDeleteAt vector index =
+  do count <- readProtoRef (vectorCountRef vector)
+     when (index < 0) $
+       error $
+       "Index cannot be " ++
+       "negative: vectorDeleteAt."
+     when (index >= count) $
+       error $
+       "Index must be less " ++
+       "than the count: vectorDeleteAt."
+     array <- readProtoRef (vectorArrayRef vector)
+     forM_ [index, index + 1 .. count - 2] $ \i ->
+       do x <- readProtoArray array (i + 1)
+          writeProtoArray array i x
+     writeProtoArray array (count - 1) undefined
+     writeProtoRef (vectorCountRef vector) (count - 1)
+
+-- | Return the index of the item or -1.
+vectorIndex :: (ProtoArrayMonad m a, Eq a) => Vector m a -> a -> m Int
+vectorIndex vector item =
+  do count <- readProtoRef (vectorCountRef vector)
+     array <- readProtoRef (vectorArrayRef vector)
+     let loop index =
+           if index >= count
+           then return $ -1
+           else do x <- readProtoArray array index
+                   if item == x
+                     then return index
+                     else loop $ index + 1
+     loop 0
+
+vectorBinarySearch' :: (ProtoArrayMonad m a, Ord a) => ProtoArray m a -> a -> Int -> Int -> m Int
+vectorBinarySearch' array item left right =
+  if left > right 
+  then return $ - (right + 1) - 1
+  else
+    do let index = (left + right) `div` 2
+       curr <- readProtoArray array index
+       if item < curr 
+         then vectorBinarySearch' array item left (index - 1)
+         else if item == curr
+              then return index
+              else vectorBinarySearch' array item (index + 1) right
+ aivika-transformers.cabal view
@@ -0,0 +1,141 @@+name:            aivika-transformers
+version:         2.0
+synopsis:        Transformers for the Aivika simulation library
+description:
+    The package adds the monad and other computation transformers to 
+    the Aivika [1] library. This is a generalization of the simulation library.
+    .
+    \[1] <http://hackage.haskell.org/package/aivika>
+    .
+category:        Simulation
+license:         BSD3
+license-file:    LICENSE
+copyright:       (c) 2009-2014. David Sorokin <david.sorokin@gmail.com>
+author:          David Sorokin
+maintainer:      David Sorokin <david.sorokin@gmail.com>
+homepage:        http://github.com/dsorokin/aivika
+cabal-version:   >= 1.10
+build-type:      Simple
+tested-with:     GHC == 7.8.3
+
+extra-source-files:  examples/BassDiffusion.hs
+                     examples/ChemicalReaction.hs
+                     examples/ChemicalReactionCircuit.hs
+                     examples/FishBank.hs
+                     examples/MachRep1.hs
+                     examples/MachRep1EventDriven.hs
+                     examples/MachRep1TimeDriven.hs
+                     examples/MachRep2.hs
+                     examples/MachRep3.hs
+                     examples/Furnace.hs
+                     examples/InspectionAdjustmentStations.hs
+                     examples/WorkStationsInSeries.hs
+                     examples/TimeOut.hs
+                     examples/TimeOutInt.hs
+                     examples/TimeOutWait.hs
+
+flag haste-inst
+    
+    description: The package is built using haste-inst
+    default:     False
+
+library
+
+    exposed-modules: Simulation.Aivika.Trans
+                     Simulation.Aivika.Trans.Agent
+                     Simulation.Aivika.Trans.Arrival
+                     Simulation.Aivika.Trans.Circuit
+                     Simulation.Aivika.Trans.Comp
+                     Simulation.Aivika.Trans.Comp.IO
+                     Simulation.Aivika.Trans.Comp.Template
+                     Simulation.Aivika.Trans.Cont
+                     Simulation.Aivika.Trans.DoubleLinkedList
+                     Simulation.Aivika.Trans.Dynamics
+                     Simulation.Aivika.Trans.Dynamics.Extra
+                     Simulation.Aivika.Trans.Dynamics.Memo
+                     Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
+                     Simulation.Aivika.Trans.Dynamics.Random
+                     Simulation.Aivika.Trans.Event
+                     Simulation.Aivika.Trans.Exception
+                     Simulation.Aivika.Trans.Generator
+                     Simulation.Aivika.Trans.Net
+                     Simulation.Aivika.Trans.Parameter
+                     Simulation.Aivika.Trans.Parameter.Random
+                     Simulation.Aivika.Trans.PriorityQueue
+                     Simulation.Aivika.Trans.Process
+                     Simulation.Aivika.Trans.Processor
+                     Simulation.Aivika.Trans.Processor.RoundRobbin
+                     Simulation.Aivika.Trans.ProtoArray
+                     Simulation.Aivika.Trans.ProtoArray.Unboxed
+                     Simulation.Aivika.Trans.ProtoRef
+                     Simulation.Aivika.Trans.Queue
+                     Simulation.Aivika.Trans.Queue.Infinite
+                     Simulation.Aivika.Trans.QueueStrategy
+                     Simulation.Aivika.Trans.Ref
+                     Simulation.Aivika.Trans.Ref.Plain
+                     Simulation.Aivika.Trans.Resource
+                     Simulation.Aivika.Trans.Results.Locale
+                     Simulation.Aivika.Trans.Results
+                     Simulation.Aivika.Trans.Results.IO
+                     Simulation.Aivika.Trans.Session
+                     Simulation.Aivika.Trans.Server
+                     Simulation.Aivika.Trans.Signal
+                     Simulation.Aivika.Trans.Simulation
+                     Simulation.Aivika.Trans.Specs
+                     Simulation.Aivika.Trans.Statistics
+                     Simulation.Aivika.Trans.Statistics.Accumulator
+                     Simulation.Aivika.Trans.Stream
+                     Simulation.Aivika.Trans.Stream.Random
+                     Simulation.Aivika.Trans.SystemDynamics
+                     Simulation.Aivika.Trans.Table
+                     Simulation.Aivika.Trans.Task
+                     Simulation.Aivika.Trans.Transform
+                     Simulation.Aivika.Trans.Transform.Extra
+                     Simulation.Aivika.Trans.Transform.Memo
+                     Simulation.Aivika.Trans.Transform.Memo.Unboxed
+                     Simulation.Aivika.Trans.Unboxed
+                     Simulation.Aivika.Trans.Var
+                     Simulation.Aivika.Trans.Var.Unboxed
+                     Simulation.Aivika.Trans.Vector
+                     Simulation.Aivika.Trans.Vector.Unboxed
+
+    other-modules:   Simulation.Aivika.Trans.Internal.Cont
+                     Simulation.Aivika.Trans.Internal.Dynamics
+                     Simulation.Aivika.Trans.Internal.Event
+                     Simulation.Aivika.Trans.Internal.Parameter
+                     Simulation.Aivika.Trans.Internal.Process
+                     Simulation.Aivika.Trans.Internal.Signal
+                     Simulation.Aivika.Trans.Internal.Simulation
+                     Simulation.Aivika.Trans.Internal.Specs
+                     
+    build-depends:   base >= 4.5.0.0 && < 6,
+                     mtl >= 2.1.1,
+                     array >= 0.3.0.0,
+                     containers >= 0.4.0.0,
+                     random >= 1.0.0.3,
+                     aivika >= 2.0
+
+    if !flag(haste-inst)
+       build-depends:   vector >= 0.10.0.1
+
+    other-extensions:   FlexibleContexts,
+                        FlexibleInstances,
+                        UndecidableInstances,
+                        BangPatterns,
+                        RecursiveDo,
+                        Arrows,
+                        MultiParamTypeClasses,
+                        FunctionalDependencies,
+                        ExistentialQuantification,
+                        TypeFamilies,
+                        TypeSynonymInstances,
+                        CPP
+                     
+    ghc-options:     -O2
+
+    default-language:   Haskell2010
+
+source-repository head
+
+    type:     git
+    location: https://github.com/dsorokin/aivika
+ examples/BassDiffusion.hs view
@@ -0,0 +1,104 @@+
+-- This is the Bass Diffusion model solved with help of 
+-- the Agent-based Modeling as described in the AnyLogic 
+-- documentation.
+
+import Data.Array
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+n = 500    -- the number of agents
+
+advertisingEffectiveness = 0.011
+contactRate = 100.0
+adoptionFraction = 0.015
+
+specs = Specs { spcStartTime = 0.0, 
+                spcStopTime = 8.0,
+                spcDT = 0.1,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+data Person m = Person { personAgent :: Agent m,
+                         personPotentialAdopter :: AgentState m,
+                         personAdopter :: AgentState m }
+              
+createPerson :: MonadComp m => Simulation m (Person m) 
+createPerson =    
+  do agent <- newAgent
+     potentialAdopter <- newState agent
+     adopter <- newState agent
+     return Person { personAgent = agent,
+                     personPotentialAdopter = potentialAdopter,
+                     personAdopter = adopter }
+       
+createPersons :: MonadComp m => Simulation m (Array Int (Person m))
+createPersons =
+  do list <- forM [1 .. n] $ \i ->
+       do p <- createPerson
+          return (i, p)
+     return $ array (1, n) list
+     
+definePerson :: MonadComp m => Person m -> Array Int (Person m) -> Ref m Int -> Ref m Int -> Simulation m ()
+definePerson p ps potentialAdopters adopters =
+  do setStateActivation (personPotentialAdopter p) $
+       do modifyRef potentialAdopters $ \a -> a + 1
+          -- add a timeout
+          t <- liftParameter $
+               randomExponential (1 / advertisingEffectiveness) 
+          let st  = personPotentialAdopter p
+              st' = personAdopter p
+          addTimeout st t $ selectState st'
+     setStateActivation (personAdopter p) $ 
+       do modifyRef adopters  $ \a -> a + 1
+          -- add a timer that works while the state is active
+          let t = liftParameter $
+                  randomExponential (1 / contactRate)    -- many times!
+          addTimer (personAdopter p) t $
+            do i <- liftParameter $
+                    randomUniformInt 1 n
+               let p' = ps ! i
+               st <- selectedState (personAgent p')
+               when (st == Just (personPotentialAdopter p')) $
+                 do b <- liftParameter $
+                         randomTrue adoptionFraction
+                    when b $ selectState (personAdopter p')
+     setStateDeactivation (personPotentialAdopter p) $
+       modifyRef potentialAdopters $ \a -> a - 1
+     setStateDeactivation (personAdopter p) $
+       modifyRef adopters $ \a -> a - 1
+        
+definePersons :: MonadComp m => Array Int (Person m) -> Ref m Int -> Ref m Int -> Simulation m ()
+definePersons ps potentialAdopters adopters =
+  forM_ (elems ps) $ \p -> 
+  definePerson p ps potentialAdopters adopters
+                               
+activatePerson :: MonadComp m => Person m -> Event m ()
+activatePerson p = selectState (personPotentialAdopter p)
+
+activatePersons :: MonadComp m => Array Int (Person m) -> Event m ()
+activatePersons ps =
+  forM_ (elems ps) $ \p -> activatePerson p
+
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do potentialAdopters <- newRef 0
+     adopters <- newRef 0
+     ps <- createPersons
+     definePersons ps potentialAdopters adopters
+     runEventInStartTime $
+       activatePersons ps
+     return $ 
+       results
+       [resultSource 
+        "potentialAdopter" "potential adopters" potentialAdopters,
+        resultSource 
+        "adopters" "adopters" adopters]
+
+main =
+  printSimulationResultsInIntegTimes
+  printResultSourceInEnglish
+  model specs
+ examples/ChemicalReaction.hs view
@@ -0,0 +1,30 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans
+import Simulation.Aivika.Trans.SystemDynamics
+
+specs = Specs { spcStartTime = 0, 
+                spcStopTime = 13, 
+                spcDT = 0.01,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+model :: (MonadComp m, MonadFix m) => Simulation m (Results m)
+model = 
+  mdo a <- integ (- ka * a) 100
+      b <- integ (ka * a - kb * b) 0
+      c <- integ (kb * b) 0
+      let ka = 1
+          kb = 1
+      return $ results
+        [resultSource "a" "variable A" a,
+         resultSource "b" "variable B" b,
+         resultSource "c" "variable C" c]
+
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/ChemicalReactionCircuit.hs view
@@ -0,0 +1,44 @@+
+-- Note that the integCircut function uses Euler's method regardless of
+-- the simulation specs specified. Therefore, to receieve almost the same
+-- results in the old example based on using the integ function, you should
+-- specify Euler's method in their specs in that file, although the Runge-Kutta
+-- method gives similar results too, which is expected.
+--
+-- Finally, the integ function can be significantly faster than integCircuit,
+-- although they have different purposes.
+
+{-# LANGUAGE Arrows #-}
+
+import Control.Arrow
+import Control.Monad.Fix
+
+import Simulation.Aivika.Trans
+
+specs = Specs { spcStartTime = 0, 
+                spcStopTime = 13, 
+                spcDT = 0.01,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+circuit :: (MonadComp m, MonadFix m) => Circuit m () [Double]
+circuit =
+  let ka = 1
+      kb = 1
+  in proc () -> do
+    rec let da = - ka * a
+            db = ka * a - kb * b
+            dc = kb * b
+        a  <- integCircuit 100 -< da
+        b  <- integCircuit 0 -< db
+        c  <- integCircuit 0 -< dc
+    returnA -< [a, b, c]
+
+model :: (MonadComp m, MonadFix m) => Simulation m [Double]
+model =
+  do results <-
+       runTransform (circuitTransform circuit) $
+       return ()
+     runDynamicsInStopTime results
+
+main = runSimulation model specs >>= print
+ examples/FishBank.hs view
@@ -0,0 +1,62 @@+
+{-# LANGUAGE RecursiveDo #-}
+
+import Control.Monad.Fix
+
+import Data.Array
+
+import Simulation.Aivika.Trans
+import Simulation.Aivika.Trans.SystemDynamics
+
+specs = Specs { spcStartTime = 0, 
+                spcStopTime = 13, 
+                spcDT = 0.01,
+                -- spcDT = 0.000005,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+model :: (MonadComp m, MonadFix m) => Simulation m (Results m)
+model =
+  mdo let annualProfit = profit
+          area = 100
+          carryingCapacity = 1000
+          catchPerShip = 
+            lookupDynamics density $
+            listArray (1, 11) [(0.0, -0.048), (1.2, 10.875), (2.4, 17.194), 
+                               (3.6, 20.548), (4.8, 22.086), (6.0, 23.344), 
+                               (7.2, 23.903), (8.4, 24.462), (9.6, 24.882), 
+                               (10.8, 25.301), (12.0, 25.86)]
+          deathFraction = 
+            lookupDynamics (fish / carryingCapacity) $
+            listArray (1, 11) [(0.0, 5.161), (0.1, 5.161), (0.2, 5.161), 
+                               (0.3, 5.161), (0.4, 5.161), (0.5, 5.161), 
+                               (0.6, 5.118), (0.7, 5.247), (0.8, 5.849), 
+                               (0.9, 6.151), (10.0, 6.194)]
+          density = fish / area
+      fish <- integ (fishHatchRate - fishDeathRate - totalCatchPerYear) 1000
+      let fishDeathRate = maxDynamics 0 (fish * deathFraction)
+          fishHatchRate = maxDynamics 0 (fish * hatchFraction)
+          fishPrice = 20
+          fractionInvested = 0.2
+          hatchFraction = 6
+          operatingCost = ships * 250
+          profit = revenue - operatingCost
+          revenue = totalCatchPerYear * fishPrice
+      ships <- integ shipBuildingRate 10
+      let shipBuildingRate = maxDynamics 0 (profit * fractionInvested / shipCost)
+          shipCost = 300
+      totalProfit <- integ annualProfit 0
+      let totalCatchPerYear = maxDynamics 0 (ships * catchPerShip)
+      -- results --
+      return $ results
+        [resultSource "fish" "fish" fish,
+         resultSource "annualProfit" "the annual profit" annualProfit,
+         resultSource "totalProfit" "the total profit" totalProfit]
+
+main =
+  flip runSimulation specs $
+  model >>= \results -> do
+    printResultsInStartTime
+      printResultSourceInEnglish results
+    printResultsInStopTime
+      printResultSourceInEnglish results
+ examples/Furnace.hs view
@@ -0,0 +1,322 @@+
+-- This is a model of the Furnace. It is described in different sources [1, 2].
+--
+-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.
+--
+-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006
+
+import Data.Maybe
+import System.Random
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+import Simulation.Aivika.Trans.Queue.Infinite
+
+-- | The simulation specs.
+specs = Specs { spcStartTime = 0.0,
+                -- spcStopTime = 1000.0,
+                spcStopTime = 300.0,
+                spcDT = 0.1,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+        
+-- | Return a random initial temperature of the item.     
+randomTemp :: MonadComp m => Parameter m Double
+randomTemp = randomUniform 400 600
+
+-- | Represents the furnace.
+data Furnace m = 
+  Furnace { furnacePits :: [Pit m],
+            -- ^ The pits for ingots.
+            furnacePitCount :: Ref m Int,
+            -- ^ The count of active pits with ingots.
+            furnaceQueue :: FCFSQueue m (Ingot m),
+            -- ^ The furnace queue.
+            furnaceUnloadedSource :: SignalSource m (),
+            -- ^ Notifies when the ingots have been
+            -- unloaded from the furnace.
+            furnaceHeatingTime :: Ref m (SamplingStats Double),
+            -- ^ The heating time for the ready ingots.
+            furnaceTemp :: Ref m Double,
+            -- ^ The furnace temperature.
+            furnaceReadyCount :: Ref m Int,
+            -- ^ The count of ready ingots.
+            furnaceReadyTemps :: Ref m [Double]
+            -- ^ The temperatures of all ready ingots.
+            }
+
+-- | Notifies when the ingots have been unloaded from the furnace.
+furnaceUnloaded :: Furnace m -> Signal m ()
+furnaceUnloaded = publishSignal . furnaceUnloadedSource
+
+-- | A pit in the furnace to place the ingots.
+data Pit m = 
+  Pit { pitIngot :: Ref m (Maybe (Ingot m)),
+        -- ^ The ingot in the pit.
+        pitTemp :: Ref m Double
+        -- ^ The ingot temperature in the pit.
+        }
+
+data Ingot m = 
+  Ingot { ingotFurnace :: Furnace m,
+          -- ^ The furnace.
+          ingotReceiveTime :: Double,
+          -- ^ The time at which the ingot was received.
+          ingotReceiveTemp :: Double,
+          -- ^ The temperature with which the ingot was received.
+          ingotLoadTime :: Double,
+          -- ^ The time of loading in the furnace.
+          ingotLoadTemp :: Double,
+          -- ^ The temperature when the ingot was loaded in the furnace.
+          ingotCoeff :: Double
+          -- ^ The heating coefficient.
+          }
+
+-- | Create a furnace.
+newFurnace :: MonadComp m => Simulation m (Furnace m)
+newFurnace =
+  do pits <- sequence [newPit | i <- [1..10]]
+     pitCount <- newRef 0
+     queue <- runEventInStartTime newFCFSQueue
+     heatingTime <- newRef emptySamplingStats
+     h <- newRef 1650.0
+     readyCount <- newRef 0
+     readyTemps <- newRef []
+     s <- newSignalSource
+     return Furnace { furnacePits = pits,
+                      furnacePitCount = pitCount,
+                      furnaceQueue = queue,
+                      furnaceUnloadedSource = s,
+                      furnaceHeatingTime = heatingTime,
+                      furnaceTemp = h,
+                      furnaceReadyCount = readyCount, 
+                      furnaceReadyTemps = readyTemps }
+
+-- | Create a new pit.
+newPit :: MonadComp m => Simulation m (Pit m)
+newPit =
+  do ingot <- newRef Nothing
+     h' <- newRef 0.0
+     return Pit { pitIngot = ingot,
+                  pitTemp  = h' }
+
+-- | Create a new ingot.
+newIngot :: MonadComp m => Furnace m -> Event m (Ingot m)
+newIngot furnace =
+  do t  <- liftDynamics time
+     xi <- liftParameter $ randomNormal 0.05 0.01
+     h' <- liftParameter randomTemp
+     let c = 0.1 + xi
+     return Ingot { ingotFurnace = furnace,
+                    ingotReceiveTime = t,
+                    ingotReceiveTemp = h',
+                    ingotLoadTime = t,
+                    ingotLoadTemp = h',
+                    ingotCoeff = c }
+
+-- | Heat the ingot up in the pit if there is such an ingot.
+heatPitUp :: MonadComp m => Pit m -> Event m ()
+heatPitUp pit =
+  do ingot <- readRef (pitIngot pit)
+     case ingot of
+       Nothing -> 
+         return ()
+       Just ingot -> do
+         
+         -- update the temperature of the ingot.
+         let furnace = ingotFurnace ingot
+         dt' <- liftParameter dt
+         h'  <- readRef (pitTemp pit)
+         h   <- readRef (furnaceTemp furnace)
+         writeRef (pitTemp pit) $ 
+           h' + dt' * (h - h') * ingotCoeff ingot
+
+-- | Check whether there are ready ingots in the pits.
+ingotsReady :: MonadComp m => Furnace m -> Event m Bool
+ingotsReady furnace =
+  fmap (not . null) $ 
+  filterM (fmap (>= 2200.0) . readRef . pitTemp) $ 
+  furnacePits furnace
+
+-- | Try to unload the ready ingot from the specified pit.
+tryUnloadPit :: MonadComp m => Furnace m -> Pit m -> Event m ()
+tryUnloadPit furnace pit =
+  do h' <- readRef (pitTemp pit)
+     when (h' >= 2000.0) $
+       do Just ingot <- readRef (pitIngot pit)  
+          unloadIngot furnace ingot pit
+
+-- | Try to load an awaiting ingot in the specified empty pit.
+tryLoadPit :: MonadComp m => Furnace m -> Pit m -> Event m ()       
+tryLoadPit furnace pit =
+  do ingot <- tryDequeue (furnaceQueue furnace)
+     case ingot of
+       Nothing ->
+         return ()
+       Just ingot ->
+         do t' <- liftDynamics time
+            loadIngot furnace (ingot { ingotLoadTime = t',
+                                       ingotLoadTemp = 400.0 }) pit
+              
+-- | Unload the ingot from the specified pit.       
+unloadIngot :: MonadComp m => Furnace m -> Ingot m -> Pit m -> Event m ()
+unloadIngot furnace ingot pit = 
+  do h' <- readRef (pitTemp pit)
+     writeRef (pitIngot pit) Nothing
+     writeRef (pitTemp pit) 0.0
+
+     -- count the active pits
+     modifyRef (furnacePitCount furnace) (+ (- 1))
+     
+     -- how long did we heat the ingot up?
+     t' <- liftDynamics time
+     modifyRef (furnaceHeatingTime furnace) $
+       addSamplingStats (t' - ingotLoadTime ingot)
+     
+     -- what is the temperature of the unloaded ingot?
+     modifyRef (furnaceReadyTemps furnace) (h' :)
+     
+     -- count the ready ingots
+     modifyRef (furnaceReadyCount furnace) (+ 1)
+     
+-- | Load the ingot in the specified pit
+loadIngot :: MonadComp m => Furnace m -> Ingot m -> Pit m -> Event m ()
+loadIngot furnace ingot pit =
+  do writeRef (pitIngot pit) $ Just ingot
+     writeRef (pitTemp pit) $ ingotLoadTemp ingot
+
+     -- count the active pits
+     modifyRef (furnacePitCount furnace) (+ 1)
+     count <- readRef (furnacePitCount furnace)
+     
+     -- decrease the furnace temperature
+     h <- readRef (furnaceTemp furnace)
+     let h' = ingotLoadTemp ingot
+         dh = - (h - h') / fromIntegral count
+     writeRef (furnaceTemp furnace) $ h + dh
+ 
+-- | Start iterating the furnace processing through the event queue.
+startIteratingFurnace :: MonadComp m => Furnace m -> Event m ()
+startIteratingFurnace furnace = 
+  let pits = furnacePits furnace
+  in enqueueEventWithIntegTimes $
+     do -- try to unload ready ingots
+        ready <- ingotsReady furnace
+        when ready $ 
+          do mapM_ (tryUnloadPit furnace) pits
+             triggerSignal (furnaceUnloadedSource furnace) ()
+
+        -- heat up
+        mapM_ heatPitUp pits
+        
+        -- update the temperature of the furnace
+        dt' <- liftParameter dt
+        h   <- readRef (furnaceTemp furnace)
+        writeRef (furnaceTemp furnace) $
+          h + dt' * (2600.0 - h) * 0.2
+
+-- | Return all empty pits.
+emptyPits :: MonadComp m => Furnace m -> Event m [Pit m]
+emptyPits furnace =
+  filterM (fmap isNothing . readRef . pitIngot) $
+  furnacePits furnace
+
+-- | This process takes ingots from the queue and then
+-- loads them in the furnace.
+loadingProcess :: MonadComp m => Furnace m -> Process m ()
+loadingProcess furnace =
+  do ingot <- dequeue (furnaceQueue furnace)
+     let wait =
+           do count <- liftEvent $ readRef (furnacePitCount furnace)
+              when (count >= 10) $
+                do processAwait (furnaceUnloaded furnace)
+                   wait
+     wait
+     --  take any empty pit and load it
+     liftEvent $
+       do pit: _ <- emptyPits furnace
+          loadIngot furnace ingot pit
+     -- repeat it again
+     loadingProcess furnace
+                  
+-- | The input process that adds new ingots to the queue.
+inputProcess :: MonadComp m => Furnace m -> Process m ()
+inputProcess furnace =
+  do delay <- liftParameter $
+              randomExponential 2.5
+     holdProcess delay
+     -- we have got a new ingot
+     liftEvent $
+       do ingot <- newIngot furnace
+          enqueue (furnaceQueue furnace) ingot
+     -- repeat it again
+     inputProcess furnace
+
+-- | Initialize the furnace.
+initializeFurnace :: MonadComp m => Furnace m -> Event m ()
+initializeFurnace furnace =
+  do x1 <- newIngot furnace
+     x2 <- newIngot furnace
+     x3 <- newIngot furnace
+     x4 <- newIngot furnace
+     x5 <- newIngot furnace
+     x6 <- newIngot furnace
+     let p1 : p2 : p3 : p4 : p5 : p6 : ps = 
+           furnacePits furnace
+     loadIngot furnace (x1 { ingotLoadTemp = 550.0 }) p1
+     loadIngot furnace (x2 { ingotLoadTemp = 600.0 }) p2
+     loadIngot furnace (x3 { ingotLoadTemp = 650.0 }) p3
+     loadIngot furnace (x4 { ingotLoadTemp = 700.0 }) p4
+     loadIngot furnace (x5 { ingotLoadTemp = 750.0 }) p5
+     loadIngot furnace (x6 { ingotLoadTemp = 800.0 }) p6
+     writeRef (furnaceTemp furnace) 1650.0
+     
+-- | The simulation model.
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do furnace <- newFurnace
+  
+     -- initialize the furnace and start its iterating in start time
+     runEventInStartTime $
+       do initializeFurnace furnace
+          startIteratingFurnace furnace
+     
+     -- generate randomly new input ingots
+     runProcessInStartTime $
+       inputProcess furnace
+
+     -- load permanently the input ingots in the furnace
+     runProcessInStartTime $
+       loadingProcess furnace
+
+     -- return the simulation results
+     return $
+       resultSummary $
+       results
+       [resultSource "inputIngotCount" "the input ingot count" $
+        enqueueStoreCount (furnaceQueue furnace),
+        --
+        resultSource "loadedIngotCount" "the loaded ingot count" $
+        dequeueCount (furnaceQueue furnace),
+        --
+        resultSource "outputIngotCount" "the output ingot count" $
+        furnaceReadyCount furnace,
+        --
+        resultSource "outputIngotTemp" "the output ingot temperature" $
+        fmap listSamplingStats $ readRef $ furnaceReadyTemps furnace,
+        --
+        resultSource "heatingTime" "the heating time" $
+        furnaceHeatingTime furnace,
+        --
+        resultSource "pitCount" "the number of ingots in pits" $
+        furnacePitCount furnace,
+        --
+        resultSource "furnaceQueue" "the furnace queue" $
+        furnaceQueue furnace]
+
+-- | The main program.
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/InspectionAdjustmentStations.hs view
@@ -0,0 +1,164 @@+
+{-# LANGUAGE RecursiveDo, Arrows #-}
+
+-- Example: Inspection and Adjustment Stations on a Production Line
+-- 
+-- This is a model of the workflow with a loop. Also there are two infinite queues.
+--
+-- It is described in different sources [1, 2]. So, this is chapter 8 of [2] and section 5.15 of [1].
+--
+-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.
+--
+-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006
+
+import Prelude hiding (id, (.)) 
+
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Fix
+import Control.Arrow
+import Control.Category (id, (.))
+
+import Simulation.Aivika.Trans
+import Simulation.Aivika.Trans.Queue.Infinite
+
+-- | The simulation specs.
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 480.0,
+                spcDT = 0.1,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+-- the minimum delay of arriving the next TV set
+minArrivalDelay = 3.5
+
+-- the maximum delay of arriving the next TV set
+maxArrivalDelay = 7.5
+
+-- the minimum time to inspect the TV set
+minInspectionTime = 6
+
+-- the maximum time to inspect the TV set
+maxInspectionTime = 12
+
+-- the probability of passing the inspection phase
+inspectionPassingProb = 0.85
+
+-- how many are inspection stations?
+inspectionStationCount = 2
+
+-- the minimum time to adjust an improper TV set
+minAdjustmentTime = 20
+
+-- the maximum time to adjust an improper TV set
+maxAdjustmentTime = 40
+
+-- how many are adjustment stations?
+adjustmentStationCount = 1
+
+-- create an inspection station (server)
+newInspectionStation :: MonadComp m => Simulation m (Server m () a (Either a a))
+newInspectionStation =
+  newServer $ \a ->
+  do holdProcess =<<
+       (liftParameter $
+        randomUniform minInspectionTime maxInspectionTime)
+     passed <- 
+       liftParameter $
+       randomTrue inspectionPassingProb
+     if passed
+       then return $ Right a
+       else return $ Left a 
+
+-- create an adjustment station (server)
+newAdjustmentStation :: MonadComp m => Simulation m (Server m () a a)
+newAdjustmentStation =
+  newServer $ \a ->
+  do holdProcess =<<
+       (liftParameter $
+        randomUniform minAdjustmentTime maxAdjustmentTime)
+     return a
+  
+model :: (MonadComp m, MonadFix m) => Simulation m (Results m)
+model = mdo
+  -- to count the arrived TV sets for inspecting and adjusting
+  inputArrivalTimer <- newArrivalTimer
+  -- it will gather the statistics of the processing time
+  outputArrivalTimer <- newArrivalTimer
+  -- define a stream of input events
+  let inputStream =
+        randomUniformStream minArrivalDelay maxArrivalDelay 
+  -- create a queue before the inspection stations
+  inspectionQueue <-
+    runEventInStartTime newFCFSQueue
+  -- create a queue before the adjustment stations
+  adjustmentQueue <-
+    runEventInStartTime newFCFSQueue
+  -- create the inspection stations (servers)
+  inspectionStations <-
+    forM [1 .. inspectionStationCount] $ \_ ->
+    newInspectionStation
+  -- create the adjustment stations (servers)
+  adjustmentStations <-
+    forM [1 .. adjustmentStationCount] $ \_ ->
+    newAdjustmentStation
+  -- a processor loop for the inspection stations' queue
+  let inspectionQueueProcessorLoop =
+        queueProcessorLoopSeq
+        (liftEvent . enqueue inspectionQueue)
+        (dequeue inspectionQueue)
+        inspectionProcessor
+        (adjustmentQueueProcessor >>> adjustmentProcessor)
+  -- a processor for the adjustment stations' queue
+  let adjustmentQueueProcessor =
+        queueProcessor
+        (liftEvent . enqueue adjustmentQueue)
+        (dequeue adjustmentQueue)
+  -- a parallel work of the inspection stations
+  let inspectionProcessor =
+        processorParallel (map serverProcessor inspectionStations)
+  -- a parallel work of the adjustment stations
+  let adjustmentProcessor =
+        processorParallel (map serverProcessor adjustmentStations)
+  -- the entire processor from input to output
+  let entireProcessor =
+        arrivalTimerProcessor inputArrivalTimer >>>
+        inspectionQueueProcessorLoop >>>
+        arrivalTimerProcessor outputArrivalTimer
+  -- start simulating the model
+  runProcessInStartTime $
+    sinkStream $ runProcessor entireProcessor inputStream
+  -- return the simulation results in start time
+  return $
+    results
+    [resultSource
+     "inspectionQueue" "the inspection queue"
+     inspectionQueue,
+     --
+     resultSource
+     "adjustmentQueue" "the adjustment queue"
+     adjustmentQueue,
+     --
+     resultSource
+     "inputArrivalTimer" "the input arrival timer"
+     inputArrivalTimer,
+     --
+     resultSource
+     "outputArrivalTimer" "the output arrival timer"
+     outputArrivalTimer,
+     --
+     resultSource
+     "inspectionStations" "the inspection stations"
+     inspectionStations,
+     --
+     resultSource
+     "adjustmentStations" "the adjustment stations"
+     adjustmentStations]
+
+modelSummary :: (MonadComp m, MonadFix m) => Simulation m (Results m)
+modelSummary = fmap resultSummary model
+
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  modelSummary specs
+ examples/MachRep1.hs view
@@ -0,0 +1,66 @@+
+-- It corresponds to model MachRep1 described in document 
+-- Introduction to Discrete-Event Simulation and the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Two machines, which sometimes break down.
+-- Up time is exponentially distributed with mean 1.0, and repair time is
+-- exponentially distributed with mean 0.5. There are two repairpersons,
+-- so the two machines can be repaired simultaneously if they are down
+-- at the same time.
+--
+-- Output is long-run proportion of up time. Should get value of about
+-- 0.66.
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+meanUpTime = 1.0
+meanRepairTime = 0.5
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 1000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+        
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do totalUpTime <- newRef 0.0
+     
+     let machine =
+           do upTime <-
+                liftParameter $
+                randomExponential meanUpTime
+              holdProcess upTime
+              liftEvent $ 
+                modifyRef totalUpTime (+ upTime)
+              repairTime <-
+                liftParameter $
+                randomExponential meanRepairTime
+              holdProcess repairTime
+              machine
+
+     runProcessInStartTime machine
+     runProcessInStartTime machine
+
+     let upTimeProp =
+           do x <- readRef totalUpTime
+              y <- liftDynamics time
+              return $ x / (2 * y)
+
+     return $
+       results
+       [resultSource
+        "upTimeProp"
+        "The long-run proportion of up time (~ 0.66)"
+        upTimeProp]
+  
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/MachRep1EventDriven.hs view
@@ -0,0 +1,79 @@+
+-- It corresponds to model MachRep1 described in document 
+-- Introduction to Discrete-Event Simulation and the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Two machines, which sometimes break down.
+-- Up time is exponentially distributed with mean 1.0, and repair time is
+-- exponentially distributed with mean 0.5. There are two repairpersons,
+-- so the two machines can be repaired simultaneously if they are down
+-- at the same time.
+--
+-- Output is long-run proportion of up time. Should get value of about
+-- 0.66.
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+meanUpTime = 1.0
+meanRepairTime = 0.5
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 1000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+        
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do totalUpTime <- newRef 0.0
+     
+     let machineBroken startUpTime =
+           
+           do finishUpTime <- liftDynamics time
+              modifyRef totalUpTime (+ (finishUpTime - startUpTime))
+              repairTime <-
+                liftParameter $
+                randomExponential meanRepairTime
+              
+              -- enqueue a new event
+              let t = finishUpTime + repairTime
+              enqueueEvent t machineRepaired
+              
+         machineRepaired =
+           
+           do startUpTime <- liftDynamics time
+              upTime <-
+                liftParameter $
+                randomExponential meanUpTime
+              
+              -- enqueue a new event
+              let t = startUpTime + upTime
+              enqueueEvent t $ machineBroken startUpTime
+
+     runEventInStartTime $
+       do -- start the first machine
+          machineRepaired
+          -- start the second machine
+          machineRepaired
+
+     let upTimeProp =
+           do x <- readRef totalUpTime
+              y <- liftDynamics time
+              return $ x / (2 * y)
+
+     return $
+       results
+       [resultSource
+        "upTimeProp"
+        "The long-run proportion of up time (~ 0.66)"
+        upTimeProp]
+  
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/MachRep1TimeDriven.hs view
@@ -0,0 +1,117 @@+
+-- It corresponds to model MachRep1 described in document 
+-- Introduction to Discrete-Event Simulation and the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Two machines, which sometimes break down.
+-- Up time is exponentially distributed with mean 1.0, and repair time is
+-- exponentially distributed with mean 0.5. There are two repairpersons,
+-- so the two machines can be repaired simultaneously if they are down
+-- at the same time.
+--
+-- Output is long-run proportion of up time. Should get value of about
+-- 0.66.
+
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+meanUpTime = 1.0
+meanRepairTime = 0.5
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 1000.0,
+                spcDT = 0.05,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+        
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do totalUpTime <- newRef 0.0
+     
+     let machine =
+           do startUpTime <- newRef 0.0 
+             
+              -- a number of iterations when 
+              -- the machine works
+              upNum <- newRef (-1)
+              
+              -- a number of iterations when 
+              -- the machine is broken
+              repairNum <- newRef (-1)
+              
+              -- create a simulation model
+              return $
+                do upNum' <- readRef upNum
+                   repairNum' <- readRef repairNum
+                   
+                   let untilBroken = 
+                         modifyRef upNum $ \a -> a - 1
+                                                  
+                       untilRepaired =
+                         modifyRef repairNum $ \a -> a - 1
+                                                      
+                       broken =
+                         do writeRef upNum (-1)
+                            -- the machine is broken
+                            startUpTime' <- readRef startUpTime
+                            finishUpTime' <- liftDynamics time
+                            dt' <- liftParameter dt
+                            modifyRef totalUpTime $ 
+                              \a -> a +
+                              (finishUpTime' - startUpTime')
+                            repairTime' <-
+                              liftParameter $
+                              randomExponential meanRepairTime
+                            writeRef repairNum $
+                              round (repairTime' / dt')
+                              
+                       repaired =
+                         do writeRef repairNum (-1)
+                            -- the machine is repaired
+                            t'  <- liftDynamics time
+                            dt' <- liftParameter dt
+                            writeRef startUpTime t'
+                            upTime' <-
+                              liftParameter $
+                              randomExponential meanUpTime
+                            writeRef upNum $
+                              round (upTime' / dt')
+                              
+                       result | upNum' > 0      = untilBroken
+                              | upNum' == 0     = broken
+                              | repairNum' > 0  = untilRepaired
+                              | repairNum' == 0 = repaired
+                              | otherwise       = repaired 
+                   result
+                            
+     -- create two machines with type Event ()
+     m1 <- machine
+     m2 <- machine
+
+     -- start the time-driven simulation of the machines
+     runEventInStartTime $
+       -- in the integration time points
+       enqueueEventWithIntegTimes $
+       do m1
+          m2
+
+     let upTimeProp =
+           do x <- readRef totalUpTime
+              y <- liftDynamics time
+              return $ x / (2 * y)
+
+     return $
+       results
+       [resultSource
+        "upTimeProp"
+        "The long-run proportion of up time (~ 0.66)"
+        upTimeProp]
+  
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/MachRep2.hs view
@@ -0,0 +1,103 @@+
+-- It corresponds to model MachRep2 described in document 
+-- Introduction to Discrete-Event Simulation and the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--   
+-- Two machines, but sometimes break down. Up time is exponentially 
+-- distributed with mean 1.0, and repair time is exponentially distributed 
+-- with mean 0.5. In this example, there is only one repairperson, so 
+-- the two machines cannot be repaired simultaneously if they are down 
+-- at the same time.
+--
+-- In addition to finding the long-run proportion of up time as in
+-- model MachRep1, let’s also find the long-run proportion of the time 
+-- that a given machine does not have immediate access to the repairperson 
+-- when the machine breaks down. Output values should be about 0.6 and 0.67. 
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+meanUpTime = 1.0
+meanRepairTime = 0.5
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 1000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+     
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do -- number of times the machines have broken down
+     nRep <- newRef 0 
+     
+     -- number of breakdowns in which the machine 
+     -- started repair service right away
+     nImmedRep <- newRef 0
+     
+     -- total up time for all machines
+     totalUpTime <- newRef 0.0
+     
+     repairPerson <- newFCFSResource 1
+     
+     let machine =
+           do upTime <-
+                liftParameter $
+                randomExponential meanUpTime
+              holdProcess upTime
+              liftEvent $
+                modifyRef totalUpTime (+ upTime) 
+              
+              -- check the resource availability
+              liftEvent $
+                do modifyRef nRep (+ 1)
+                   n <- resourceCount repairPerson
+                   when (n == 1) $
+                     modifyRef nImmedRep (+ 1)
+                
+              requestResource repairPerson
+              repairTime <-
+                liftParameter $
+                randomExponential meanRepairTime
+              holdProcess repairTime
+              releaseResource repairPerson
+              
+              machine
+
+     runProcessInStartTime machine
+     runProcessInStartTime machine
+
+     let upTimeProp =
+           do x <- readRef totalUpTime
+              y <- liftDynamics time
+              return $ x / (2 * y)
+
+         immedProp =
+           do n <- readRef nRep
+              nImmed <- readRef nImmedRep
+              let x :: Double
+                  x = fromIntegral nImmed /
+                      fromIntegral n
+              return x
+
+     return $
+       results
+       [resultSource
+        "upTimeProp"
+        "The long-run proportion of up time (~ 0.6)"
+        upTimeProp,
+        --
+        resultSource
+        "immedProp"
+        "The proption of time of immediate access (~0.67)"
+        immedProp]
+  
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/MachRep3.hs view
@@ -0,0 +1,93 @@+
+-- It corresponds to model MachRep3 described in document 
+-- Introduction to Discrete-Event Simulation and the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/DESimIntro.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Variation of models MachRep1, MachRep2. Two machines, but
+-- sometimes break down. Up time is exponentially distributed with mean
+-- 1.0, and repair time is exponentially distributed with mean 0.5. In
+-- this example, there is only one repairperson, and she is not summoned
+-- until both machines are down. We find the proportion of up time. It
+-- should come out to about 0.45.
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+meanUpTime = 1.0
+meanRepairTime = 0.5
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 1000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+     
+model :: MonadComp m => Simulation m (Results m)
+model =
+  do -- number of machines currently up
+     nUp <- newRef 2
+     
+     -- total up time for all machines
+     totalUpTime <- newRef 0.0
+     
+     repairPerson <- newResource FCFS 1
+     
+     pid1 <- newProcessId
+     pid2 <- newProcessId
+     
+     let machine pid =
+           do upTime <-
+                liftParameter $
+                randomExponential meanUpTime
+              holdProcess upTime
+              liftEvent $
+                modifyRef totalUpTime (+ upTime) 
+              
+              liftEvent $
+                modifyRef nUp (+ (-1))
+              nUp' <- liftEvent $ readRef nUp
+              if nUp' == 1
+                then passivateProcess
+                else liftEvent $
+                     do n <- resourceCount repairPerson
+                        when (n == 1) $ 
+                          reactivateProcess pid
+              
+              requestResource repairPerson
+              repairTime <-
+                liftParameter $
+                randomExponential meanRepairTime
+              holdProcess repairTime
+              liftEvent $
+                modifyRef nUp (+ 1)
+              releaseResource repairPerson
+              
+              machine pid
+
+     runProcessInStartTimeUsingId
+       pid1 (machine pid2)
+
+     runProcessInStartTimeUsingId
+       pid2 (machine pid1)
+
+     let upTimeProp =
+           do x <- readRef totalUpTime
+              y <- liftDynamics time
+              return $ x / (2 * y)
+
+     return $
+       results
+       [resultSource
+        "upTimeProp"
+        "The long-run proportion of up time (~ 0.45)"
+        upTimeProp]
+  
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  model specs
+ examples/TimeOut.hs view
@@ -0,0 +1,93 @@+
+-- It corresponds to model TimeOut described in document 
+-- Advanced Features of the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/AdvancedSimPy.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Introductory example to illustrate the modeling of "competing
+-- events" such as timeouts, especially using the cancelProcess function. A
+-- network node sends a message but also sets a timeout period; if the
+-- node times out, it assumes the message it had sent was lost, and it
+-- will send again. The time to get an acknowledgement for a message is
+-- exponentially distributed with mean 1.0, and the timeout period is
+-- 0.5. Immediately after receiving an acknowledgement, the node sends
+-- out a new message.
+--
+-- We find the proportion of messages which timeout. The output should
+-- be about 0.61.
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+ackRate = 1.0 / 1.0  -- reciprocal of the acknowledge mean time
+toPeriod = 0.5       -- timeout period
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 10000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+     
+model :: MonadComp m => Simulation m Double
+model =
+  do -- number of messages sent
+     nMsgs <- newRef 0
+     
+     -- number of timeouts which have occured
+     nTimeOuts <- newRef 0
+     
+     -- reactivatedCode will 1 if timeout occurred, 
+     -- 2 ACK if received
+     reactivatedCode <- newRef 0
+     
+     nodePid <- newProcessId
+     
+     let node =
+           do liftEvent $ modifyRef nMsgs $ (+) 1
+              -- create process IDs
+              timeoutPid <- liftSimulation newProcessId
+              ackPid <- liftSimulation newProcessId
+              -- set up the timeout
+              liftEvent $ runProcessUsingId timeoutPid (timeout ackPid)
+              -- set up the message send/ACK
+              liftEvent $ runProcessUsingId ackPid (acknowledge timeoutPid)
+              passivateProcess
+              liftEvent $
+                do code <- readRef reactivatedCode
+                   when (code == 1) $
+                     modifyRef nTimeOuts $ (+) 1
+                   writeRef reactivatedCode 0
+              node
+              
+         timeout ackPid =
+           do holdProcess toPeriod
+              liftEvent $
+                do writeRef reactivatedCode 1
+                   reactivateProcess nodePid
+                   cancelProcessWithId ackPid
+         
+         acknowledge timeoutPid =
+           do ackTime <-
+                liftParameter $
+                randomExponential (1 / ackRate)
+              holdProcess ackTime
+              liftEvent $
+                do writeRef reactivatedCode 2
+                   reactivateProcess nodePid
+                   cancelProcessWithId timeoutPid
+
+     runProcessInStartTimeUsingId
+       nodePid node
+     
+     runEventInStopTime $
+       do x <- readRef nTimeOuts
+          y <- readRef nMsgs
+          return $ x / y
+  
+main = 
+  do putStr "The percentage of timeout was "
+     runSimulation model specs >>= print
+ examples/TimeOutInt.hs view
@@ -0,0 +1,75 @@+
+-- It corresponds to model TimeOutInt described in document 
+-- Advanced Features of the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/AdvancedSimPy.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Same as TimeOut.hs but using interrupts. A network node sends a message
+-- but also sets a timeout period; if the node times out, it assumes the
+-- message it had sent was lost, and it will send again. The time to get
+-- an acknowledgement for a message is exponentially distributed with
+-- mean 1.0, and the timeout period is 0.5. Immediately after receiving
+-- an acknowledgement, the node sends out a new message.
+--
+-- We find the proportion of messages which timeout. The output should
+-- be about 0.61.
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Simulation.Aivika.Trans
+
+ackRate = 1.0 / 1.0  -- reciprocal of the acknowledge mean time
+toPeriod = 0.5       -- timeout period
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 10000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+     
+model :: MonadComp m => Simulation m Double
+model =
+  do -- number of messages sent
+     nMsgs <- newRef 0
+     
+     -- number of timeouts which have occured
+     nTimeOuts <- newRef 0
+
+     nodePid <- newProcessId
+     
+     let node =
+           do liftEvent $ modifyRef nMsgs $ (+) 1
+              -- create the process ID
+              timeoutPid <- liftSimulation newProcessId
+              -- set up the timeout
+              liftEvent $ runProcessUsingId timeoutPid timeout
+              -- wait for ACK, but could be timeout
+              ackTime <-
+                liftParameter $
+                randomExponential (1 / ackRate)
+              holdProcess ackTime
+              liftEvent $
+                do interrupted <- processInterrupted nodePid
+                   if interrupted
+                     then modifyRef nTimeOuts $ (+) 1
+                     else cancelProcessWithId timeoutPid
+              node
+              
+         timeout =
+           do holdProcess toPeriod
+              liftEvent $ interruptProcess nodePid
+
+     runProcessInStartTimeUsingId
+       nodePid node 
+     
+     runEventInStopTime $
+       do x <- readRef nTimeOuts
+          y <- readRef nMsgs
+          return $ x / y
+  
+main = 
+  do putStr "The percentage of timeout was "
+     runSimulation model specs >>= print
+ examples/TimeOutWait.hs view
@@ -0,0 +1,69 @@+
+-- It corresponds to model TimeOut described in document 
+-- Advanced Features of the SimPy Language
+-- [http://heather.cs.ucdavis.edu/~matloff/156/PLN/AdvancedSimPy.pdf]. 
+-- SimPy is available on [http://simpy.sourceforge.net/].
+--   
+-- The model description is as follows.
+--
+-- Introductory example to illustrate the modeling of "competing
+-- events" such as timeouts, especially using the timeoutProcess
+-- function. A network node starts a process within the specified 
+-- timeout and receives a signal that notifies whether the process 
+-- has finished successfully within the timeout; if the node
+-- times out, it assumes the message it had sent was lost, and it
+-- will send again. The time to get an acknowledgement for a message is
+-- exponentially distributed with mean 1.0, and the timeout period is
+-- 0.5. Immediately after receiving an acknowledgement, the node sends
+-- out a new message.
+--
+-- We find the proportion of messages which timeout. The output should
+-- be about 0.61.
+
+import Control.Monad
+import Control.Monad.Trans
+
+import Data.Maybe
+
+import Simulation.Aivika.Trans
+
+ackRate = 1.0 / 1.0  -- reciprocal of the acknowledge mean time
+toPeriod = 0.5       -- timeout period
+
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 10000.0,
+                spcDT = 1.0,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+        
+model :: MonadComp m => Simulation m Double
+model =
+  do -- number of messages sent
+     nMsgs <- newRef 0
+     
+     -- number of timeouts which have occured
+     nTimeOuts <- newRef 0
+     
+     let node =
+           do liftEvent $ modifyRef nMsgs $ (+) 1
+              result <-
+                timeoutProcess toPeriod $
+                do ackTime <-
+                     liftParameter $
+                     randomExponential (1 / ackRate)
+                   holdProcess ackTime
+              liftEvent $
+                when (isNothing result) $
+                modifyRef nTimeOuts $ (+) 1
+              node
+
+     runProcessInStartTime node
+     
+     runEventInStopTime $
+       do x <- readRef nTimeOuts
+          y <- readRef nMsgs
+          return $ x / y
+  
+main = 
+  do putStr "The percentage of timeout was "
+     runSimulation model specs >>= print
+ examples/WorkStationsInSeries.hs view
@@ -0,0 +1,136 @@+
+-- Example: Work Stations in Series
+--
+-- This is a model of two work stations connected in a series and separated by finite queues.
+--
+-- It is described in different sources [1, 2]. So, this is chapter 7 of [2] and section 5.14 of [1].
+--
+-- [1] A. Alan B. Pritsker, Simulation with Visual SLAM and AweSim, 2nd ed.
+--
+-- [2] Труб И.И., Объектно-ориентированное моделирование на C++: Учебный курс. - СПб.: Питер, 2006
+
+import Prelude hiding (id, (.)) 
+
+import Control.Monad
+import Control.Monad.Trans
+import Control.Arrow
+import Control.Category (id, (.))
+
+import Simulation.Aivika.Trans
+import Simulation.Aivika.Trans.Queue
+
+-- | The simulation specs.
+specs = Specs { spcStartTime = 0.0,
+                spcStopTime = 300.0,
+                spcDT = 0.1,
+                spcMethod = RungeKutta4,
+                spcGeneratorType = SimpleGenerator }
+
+-- the mean delay of the input arrivals distributed exponentially
+meanOrderDelay = 0.4 
+
+-- the capacity of the queue before the first work places
+queueMaxCount1 = 4
+
+-- the capacity of the queue before the second work places
+queueMaxCount2 = 2
+
+-- the mean processing time distributed exponentially in
+-- the first work stations
+meanProcessingTime1 = 0.25
+
+-- the mean processing time distributed exponentially in
+-- the second work stations
+meanProcessingTime2 = 0.5
+
+-- the number of the first work stations
+-- (in parallel but the commented code allocates them sequentially)
+workStationCount1 = 1
+
+-- the number of the second work stations
+-- (in parallel but the commented code allocates them sequentially)
+workStationCount2 = 1
+
+-- create a work station (server) with the exponential processing time
+newWorkStationExponential :: MonadComp m => Double -> Simulation m (Server m () a a)
+newWorkStationExponential meanTime =
+  newServer $ \a ->
+  do holdProcess =<<
+       (liftParameter $
+        randomExponential meanTime)
+     return a
+
+model :: MonadComp m => Simulation m (Results m)
+model = do
+  -- it will gather the statistics of the processing time
+  arrivalTimer <- newArrivalTimer
+  -- define a stream of input events
+  let inputStream = randomExponentialStream meanOrderDelay 
+  -- create a queue before the first work stations
+  queue1 <-
+    runEventInStartTime $
+    newFCFSQueue queueMaxCount1
+  -- create a queue before the second work stations
+  queue2 <-
+    runEventInStartTime $
+    newFCFSQueue queueMaxCount2
+  -- create the first work stations (servers)
+  workStation1s <- forM [1 .. workStationCount1] $ \_ ->
+    newWorkStationExponential meanProcessingTime1
+  -- create the second work stations (servers)
+  workStation2s <- forM [1 .. workStationCount2] $ \_ ->
+    newWorkStationExponential meanProcessingTime2
+  -- processor for the queue before the first work station
+  let queueProcessor1 =
+        queueProcessor
+        (\a -> liftEvent $ enqueueOrLost_ queue1 a)
+        (dequeue queue1)
+  -- processor for the queue before the second work station
+  let queueProcessor2 =
+        queueProcessor
+        (enqueue queue2)
+        (dequeue queue2)
+  -- the entire processor from input to output
+  let entireProcessor =
+        queueProcessor1 >>>
+        processorParallel (map serverProcessor workStation1s) >>>
+        -- processorSeq (map serverProcessor workStation1s) >>>
+        queueProcessor2 >>>
+        processorParallel (map serverProcessor workStation2s) >>>
+        -- processorSeq (map serverProcessor workStation2s) >>>
+        arrivalTimerProcessor arrivalTimer
+  -- start simulating the model
+  runProcessInStartTime $
+    sinkStream $ runProcessor entireProcessor inputStream
+  -- return the simulation results
+  return $
+    results
+    [resultSource
+     "queue1" "Queue no. 1"
+     queue1,
+     --
+     resultSource
+     "workStation1s" "Work Stations of line no. 1"
+     workStation1s,
+     --
+     resultSource
+     "queue2" "Queue no. 2"
+     queue2,
+     --
+     resultSource
+     "workStation2s" "Work Stations of line no. 2"
+     workStation2s,
+     --
+     resultSource
+     "arrivalTimer" "The arrival timer"
+     arrivalTimer]
+
+modelSummary :: MonadComp m => Simulation m (Results m)
+modelSummary =
+  fmap resultSummary model
+
+main =
+  printSimulationResultsInStopTime
+  printResultSourceInEnglish
+  -- model specs
+  modelSummary specs