diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,13 @@ +Version 5.1 +----- + +* Includes changes destined for Aivika Exension Pack. + +* Minor changes in the resource preemption statistics. + +* Added the statistics reset. + Version 5.0 ----- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2009-2015 David Sorokin +Copyright (c) 2009-2017 David Sorokin All rights reserved. diff --git a/Simulation/Aivika.hs b/Simulation/Aivika.hs --- a/Simulation/Aivika.hs +++ b/Simulation/Aivika.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Activity.hs b/Simulation/Aivika/Activity.hs --- a/Simulation/Aivika/Activity.hs +++ b/Simulation/Aivika/Activity.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Activity --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -30,6 +30,8 @@ activityUtilisationFactor, activityIdleFactor, activityPreemptionFactor, + -- * Statistics Reset + resetActivity, -- * Summary activitySummary, -- * Derived Signals for Properties @@ -563,3 +565,14 @@ showString tab . showString "preemption time:\n\n" . samplingStatsSummary xs3 (2 + indent) + +-- | Reset the statistics. +resetActivity :: Activity s a b -> Event () +resetActivity act = + Event $ \p -> + do writeIORef (activityTotalUtilisationTimeRef act) 0 + writeIORef (activityTotalIdleTimeRef act) 0 + writeIORef (activityTotalPreemptionTimeRef act) 0 + writeIORef (activityUtilisationTimeRef act) mempty + writeIORef (activityIdleTimeRef act) mempty + writeIORef (activityPreemptionTimeRef act) mempty diff --git a/Simulation/Aivika/Activity/Random.hs b/Simulation/Aivika/Activity/Random.hs --- a/Simulation/Aivika/Activity/Random.hs +++ b/Simulation/Aivika/Activity/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Activity.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Agent.hs b/Simulation/Aivika/Agent.hs --- a/Simulation/Aivika/Agent.hs +++ b/Simulation/Aivika/Agent.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Agent --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Arrival.hs b/Simulation/Aivika/Arrival.hs --- a/Simulation/Aivika/Arrival.hs +++ b/Simulation/Aivika/Arrival.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Arrival --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -22,7 +22,8 @@ arrivalTimerChannel, arrivalProcessingTime, arrivalProcessingTimeChanged, - arrivalProcessingTimeChanged_) where + arrivalProcessingTimeChanged_, + resetArrivalTimer) where import Control.Monad import Control.Monad.Trans @@ -102,3 +103,9 @@ arrivalTimerChannel timer = Channel $ \sa -> return $ arrivalTimerSignal timer sa + +-- | Reset the statistics. +resetArrivalTimer :: ArrivalTimer -> Event () +resetArrivalTimer timer = + do writeRef (arrivalProcessingTimeRef timer) emptySamplingStats + triggerSignal (arrivalProcessingTimeChangedSource timer) () diff --git a/Simulation/Aivika/Channel.hs b/Simulation/Aivika/Channel.hs --- a/Simulation/Aivika/Channel.hs +++ b/Simulation/Aivika/Channel.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Channel --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Circuit.hs b/Simulation/Aivika/Circuit.hs --- a/Simulation/Aivika/Circuit.hs +++ b/Simulation/Aivika/Circuit.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Circuit --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Composite.hs b/Simulation/Aivika/Composite.hs --- a/Simulation/Aivika/Composite.hs +++ b/Simulation/Aivika/Composite.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Composite --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -15,6 +15,7 @@ module Simulation.Aivika.Composite (-- * Composite Monad Composite, + CompositeLift(..), runComposite, runComposite_, runCompositeInStartTime_, @@ -125,3 +126,12 @@ Composite $ \h0 -> do a <- liftEvent m return (a, h0) + +-- | A type class to lift the 'Composite' computation to other computations. +class CompositeLift m where + + -- | Lift the specified 'Composite' computation to another computation. + liftComposite :: Composite a -> m a + +instance CompositeLift Composite where + liftComposite = id diff --git a/Simulation/Aivika/Cont.hs b/Simulation/Aivika/Cont.hs --- a/Simulation/Aivika/Cont.hs +++ b/Simulation/Aivika/Cont.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Cont --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/DoubleLinkedList.hs b/Simulation/Aivika/DoubleLinkedList.hs --- a/Simulation/Aivika/DoubleLinkedList.hs +++ b/Simulation/Aivika/DoubleLinkedList.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.DoubleLinkedList --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Dynamics.hs b/Simulation/Aivika/Dynamics.hs --- a/Simulation/Aivika/Dynamics.hs +++ b/Simulation/Aivika/Dynamics.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Dynamics/Extra.hs b/Simulation/Aivika/Dynamics/Extra.hs --- a/Simulation/Aivika/Dynamics/Extra.hs +++ b/Simulation/Aivika/Dynamics/Extra.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Extra --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Dynamics/Memo.hs b/Simulation/Aivika/Dynamics/Memo.hs --- a/Simulation/Aivika/Dynamics/Memo.hs +++ b/Simulation/Aivika/Dynamics/Memo.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Memo --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Dynamics/Memo/Unboxed.hs b/Simulation/Aivika/Dynamics/Memo/Unboxed.hs --- a/Simulation/Aivika/Dynamics/Memo/Unboxed.hs +++ b/Simulation/Aivika/Dynamics/Memo/Unboxed.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Memo.Unboxed --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Dynamics/Random.hs b/Simulation/Aivika/Dynamics/Random.hs --- a/Simulation/Aivika/Dynamics/Random.hs +++ b/Simulation/Aivika/Dynamics/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Dynamics.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Event.hs b/Simulation/Aivika/Event.hs --- a/Simulation/Aivika/Event.hs +++ b/Simulation/Aivika/Event.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Event --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Gate.hs b/Simulation/Aivika/Gate.hs --- a/Simulation/Aivika/Gate.hs +++ b/Simulation/Aivika/Gate.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Gate --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -16,6 +16,7 @@ newGateClosed, openGate, closeGate, + invertGate, gateOpened, gateClosed, awaitGateOpened, @@ -56,6 +57,11 @@ closeGate :: Gate -> Event () closeGate gate = writeRef (gateRef gate) False + +-- | Invert the gate. +invertGate :: Gate -> Event () +invertGate gate = + modifyRef (gateRef gate) not -- | Test whether the gate is open. gateOpened :: Gate -> Event Bool diff --git a/Simulation/Aivika/Generator.hs b/Simulation/Aivika/Generator.hs --- a/Simulation/Aivika/Generator.hs +++ b/Simulation/Aivika/Generator.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Generator --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -71,8 +71,10 @@ generateWeibull :: Double -> Double -> IO Double, -- ^ Generate a random number from the Weibull distribution by -- the specified shape and scale. - generateDiscrete :: forall a. DiscretePDF a -> IO a + generateDiscrete :: forall a. DiscretePDF a -> IO a, -- ^ Generate a random value from the specified discrete distribution. + generateSequenceNo :: IO Int + -- ^ Generate a sequence number which can be considered quite unique. } -- | Generate the uniform random number with the specified minimum and maximum. @@ -331,6 +333,8 @@ g2 <- newNormalGenerator01 g1 let g3 mu nu = do { x <- g2; return $ mu + nu * x } g4 mu nu = do { x <- g2; return $ exp (mu + nu * x) } + seqNoRef <- newIORef 0 + let seqNo = do { x <- readIORef seqNoRef; modifyIORef' seqNoRef (+1); return x } return Generator { generateUniform = generateUniform01 g1, generateUniformInt = generateUniformInt01 g1, generateTriangular = generateTriangular01 g1, @@ -343,4 +347,5 @@ generateGamma = generateGamma01 g2 g1, generateBeta = generateBeta01 g2 g1, generateWeibull = generateWeibull01 g1, - generateDiscrete = generateDiscrete01 g1 } + generateDiscrete = generateDiscrete01 g1, + generateSequenceNo = seqNo } diff --git a/Simulation/Aivika/Internal/Arrival.hs b/Simulation/Aivika/Internal/Arrival.hs --- a/Simulation/Aivika/Internal/Arrival.hs +++ b/Simulation/Aivika/Internal/Arrival.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Arrival --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Internal/Cont.hs b/Simulation/Aivika/Internal/Cont.hs --- a/Simulation/Aivika/Internal/Cont.hs +++ b/Simulation/Aivika/Internal/Cont.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Cont --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -51,6 +51,7 @@ substituteCont, contCanceled, contAwait, + transferCont, traceCont) where import Data.IORef @@ -860,6 +861,26 @@ Just c -> invokeEvent p $ reenterCont c a writeIORef r $ Just h + +-- | Like the GoTo statement it transfers the direction of computation, +-- but raises an exception when used within 'catchCont' or 'finallyCont'. +transferCont :: Cont () -> Cont a +transferCont x = + Cont $ \c -> + Event $ \p -> + do let worker = + do let cid = contId $ contAux c + cont = return + econt = throwEvent + ccont = return + when (contCatchFlag $ contAux c) $ + error "Cannot be combined with the exception handling: unsafeTransferCont" + invokeEvent p $ + runCont x cont econt ccont cid False + z <- contCanceled c + if z + then cancelCont p c + else worker -- | Show the debug message with the current simulation time. traceCont :: String -> Cont a -> Cont a diff --git a/Simulation/Aivika/Internal/Dynamics.hs b/Simulation/Aivika/Internal/Dynamics.hs --- a/Simulation/Aivika/Internal/Dynamics.hs +++ b/Simulation/Aivika/Internal/Dynamics.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Internal.Dynamics --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Internal/Event.hs b/Simulation/Aivika/Internal/Event.hs --- a/Simulation/Aivika/Internal/Event.hs +++ b/Simulation/Aivika/Internal/Event.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Internal.Event --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Internal/Parameter.hs b/Simulation/Aivika/Internal/Parameter.hs --- a/Simulation/Aivika/Internal/Parameter.hs +++ b/Simulation/Aivika/Internal/Parameter.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Internal.Parameter --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Internal/Process.hs b/Simulation/Aivika/Internal/Process.hs --- a/Simulation/Aivika/Internal/Process.hs +++ b/Simulation/Aivika/Internal/Process.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Process --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -51,9 +51,12 @@ holdProcess, interruptProcess, processInterrupted, + processInterruptionTime, passivateProcess, + passivateProcessBefore, processPassive, reactivateProcess, + reactivateProcessImmediately, cancelProcessWithId, cancelProcess, processCancelled, @@ -90,6 +93,8 @@ neverProcess, -- * Retrying Computation retryProcess, + -- * GoTo Statement + transferProcess, -- * Debugging traceProcess) where @@ -180,6 +185,20 @@ Event $ \p -> readIORef (processInterruptRef pid) +-- | Return the expected interruption time after finishing the 'holdProcess' computation, +-- which value may change if the corresponding process is preempted. +processInterruptionTime :: ProcessId -> Event (Maybe Double) +processInterruptionTime pid = + Event $ \p -> + do let x = processInterruptCont pid + a <- readIORef x + case a of + Just c -> + do t <- readIORef (processInterruptTime pid) + return (Just t) + Nothing -> + return Nothing + -- | Define a reaction when the process with the specified identifier is preempted. processPreempted :: ProcessId -> Event () processPreempted pid = @@ -223,6 +242,20 @@ Nothing -> writeIORef x $ Just c Just _ -> error "Cannot passivate the process twice: passivateProcess" +-- | Passivate the process before performing some action. +passivateProcessBefore :: Event () -> Process () +passivateProcessBefore m = + Process $ \pid -> + Cont $ \c -> + Event $ \p -> + do let x = processReactCont pid + a <- readIORef x + case a of + Nothing -> + do writeIORef x $ Just c + invokeEvent p m + Just _ -> error "Cannot passivate the process twice: passivateProcessBefore" + -- | Test whether the process with the specified identifier is passivated. processPassive :: ProcessId -> Event Bool processPassive pid = @@ -244,6 +277,19 @@ do writeIORef x Nothing invokeEvent p $ enqueueEvent (pointTime p) $ resumeCont c () +-- | Reactivate a process with the specified identifier immediately. +reactivateProcessImmediately :: ProcessId -> Event () +reactivateProcessImmediately pid = + Event $ \p -> + do let x = processReactCont pid + a <- readIORef x + case a of + Nothing -> + return () + Just c -> + do writeIORef x Nothing + invokeEvent p $ resumeCont c () + -- | Prepare the processes identifier for running. processIdPrepare :: ProcessId -> Event () processIdPrepare pid = @@ -723,6 +769,12 @@ -- as a 'SimulationRetry' exception message in case of failure. retryProcess :: String -> Process a retryProcess = liftEvent . retryEvent + +-- | Like the GoTo statement it transfers the direction of computation, +-- but raises an exception when used within 'catchProcess' or 'finallyProcess'. +transferProcess :: Process () -> Process a +transferProcess (Process m) = + Process $ \pid -> transferCont (m pid) -- | Show the debug message with the current simulation time. traceProcess :: String -> Process a -> Process a diff --git a/Simulation/Aivika/Internal/Simulation.hs b/Simulation/Aivika/Internal/Simulation.hs --- a/Simulation/Aivika/Internal/Simulation.hs +++ b/Simulation/Aivika/Internal/Simulation.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Internal.Simulation --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Internal/Specs.hs b/Simulation/Aivika/Internal/Specs.hs --- a/Simulation/Aivika/Internal/Specs.hs +++ b/Simulation/Aivika/Internal/Specs.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Internal.Specs --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Net.hs b/Simulation/Aivika/Net.hs --- a/Simulation/Aivika/Net.hs +++ b/Simulation/Aivika/Net.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Net --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Net/Random.hs b/Simulation/Aivika/Net/Random.hs --- a/Simulation/Aivika/Net/Random.hs +++ b/Simulation/Aivika/Net/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Net.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Operation.hs b/Simulation/Aivika/Operation.hs --- a/Simulation/Aivika/Operation.hs +++ b/Simulation/Aivika/Operation.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Operation --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -22,6 +22,8 @@ operationPreemptionTime, operationUtilisationFactor, operationPreemptionFactor, + -- * Statistics Reset + resetOperation, -- * Summary operationSummary, -- * Derived Signals for Properties @@ -70,7 +72,7 @@ -- ^ Provide @b@ by specified @a@. operationProcessPreemptible :: Bool, -- ^ Whether the process is preemptible. - operationStartTime :: Double, + operationStartTimeRef :: IORef Double, -- ^ The start time of creating the operation. operationLastTimeRef :: IORef Double, -- ^ The last time of utilising the operation activity. @@ -110,6 +112,7 @@ -> Event (Operation a b) newPreemptibleOperation preemptible provide = do t0 <- liftDynamics time + r' <- liftIO $ newIORef t0 r0 <- liftIO $ newIORef t0 r1 <- liftIO $ newIORef 0 r2 <- liftIO $ newIORef 0 @@ -121,7 +124,7 @@ s4 <- liftSimulation newSignalSource return Operation { operationInitProcess = provide, operationProcessPreemptible = preemptible, - operationStartTime = t0, + operationStartTimeRef = r', operationLastTimeRef = r0, operationTotalUtilisationTimeRef = r1, operationTotalPreemptionTimeRef = r2, @@ -281,7 +284,7 @@ operationUtilisationFactor :: Operation a b -> Event Double operationUtilisationFactor op = Event $ \p -> - do let t0 = operationStartTime op + do t0 <- readIORef (operationStartTimeRef op) t1 <- readIORef (operationLastTimeRef op) x <- readIORef (operationTotalUtilisationTimeRef op) return (x / (t1 - t0)) @@ -308,7 +311,7 @@ operationPreemptionFactor :: Operation a b -> Event Double operationPreemptionFactor op = Event $ \p -> - do let t0 = operationStartTime op + do t0 <- readIORef (operationStartTimeRef op) t1 <- readIORef (operationLastTimeRef op) x <- readIORef (operationTotalPreemptionTimeRef op) return (x / (t1 - t0)) @@ -352,7 +355,7 @@ operationSummary :: Operation a b -> Int -> Event ShowS operationSummary op indent = Event $ \p -> - do let t0 = operationStartTime op + do t0 <- readIORef (operationStartTimeRef op) t1 <- readIORef (operationLastTimeRef op) tx1 <- readIORef (operationTotalUtilisationTimeRef op) tx2 <- readIORef (operationTotalPreemptionTimeRef op) @@ -381,3 +384,16 @@ showString tab . showString "preemption time:\n\n" . samplingStatsSummary xs2 (2 + indent) + +-- | Reset the statistics. +resetOperation :: Operation a b -> Event () +resetOperation op = + Event $ \p -> + do let t0 = pointTime p + writeIORef (operationStartTimeRef op) t0 + writeIORef (operationLastTimeRef op) t0 + writeIORef (operationTotalUtilisationTimeRef op) 0 + writeIORef (operationTotalPreemptionTimeRef op) 0 + writeIORef (operationUtilisationTimeRef op) emptySamplingStats + writeIORef (operationPreemptionTimeRef op) emptySamplingStats + diff --git a/Simulation/Aivika/Operation/Random.hs b/Simulation/Aivika/Operation/Random.hs --- a/Simulation/Aivika/Operation/Random.hs +++ b/Simulation/Aivika/Operation/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Operation.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Parameter.hs b/Simulation/Aivika/Parameter.hs --- a/Simulation/Aivika/Parameter.hs +++ b/Simulation/Aivika/Parameter.hs @@ -1,6 +1,6 @@ -- | -- Module : Simulation.Aivika.Parameter --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Parameter/Random.hs b/Simulation/Aivika/Parameter/Random.hs --- a/Simulation/Aivika/Parameter/Random.hs +++ b/Simulation/Aivika/Parameter/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Parameter.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/PriorityQueue.hs b/Simulation/Aivika/PriorityQueue.hs --- a/Simulation/Aivika/PriorityQueue.hs +++ b/Simulation/Aivika/PriorityQueue.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.PriorityQueue --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/PriorityQueue/Pure.hs b/Simulation/Aivika/PriorityQueue/Pure.hs --- a/Simulation/Aivika/PriorityQueue/Pure.hs +++ b/Simulation/Aivika/PriorityQueue/Pure.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.PriorityQueue.Pure --- Copyright : Copyright (c) 2015-2016, David Sorokin +-- Copyright : Copyright (c) 2015-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Process.hs b/Simulation/Aivika/Process.hs --- a/Simulation/Aivika/Process.hs +++ b/Simulation/Aivika/Process.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Process --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -48,9 +48,12 @@ holdProcess, interruptProcess, processInterrupted, + processInterruptionTime, passivateProcess, + passivateProcessBefore, processPassive, reactivateProcess, + reactivateProcessImmediately, cancelProcessWithId, cancelProcess, processCancelled, @@ -85,6 +88,8 @@ neverProcess, -- * Retrying Computation retryProcess, + -- * GoTo Statement + transferProcess, -- * Debugging traceProcess) where diff --git a/Simulation/Aivika/Process/Random.hs b/Simulation/Aivika/Process/Random.hs --- a/Simulation/Aivika/Process/Random.hs +++ b/Simulation/Aivika/Process/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Process.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Processor.hs b/Simulation/Aivika/Processor.hs --- a/Simulation/Aivika/Processor.hs +++ b/Simulation/Aivika/Processor.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Processor --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Processor/Random.hs b/Simulation/Aivika/Processor/Random.hs --- a/Simulation/Aivika/Processor/Random.hs +++ b/Simulation/Aivika/Processor/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Processor.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Processor/RoundRobbin.hs b/Simulation/Aivika/Processor/RoundRobbin.hs --- a/Simulation/Aivika/Processor/RoundRobbin.hs +++ b/Simulation/Aivika/Processor/RoundRobbin.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Processor.RoundRobbin --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Queue.hs b/Simulation/Aivika/Queue.hs --- a/Simulation/Aivika/Queue.hs +++ b/Simulation/Aivika/Queue.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -70,6 +70,8 @@ queueContains, queueContainsBy, clearQueue, + -- * Statistics Reset + resetQueue, -- * Awaiting waitWhileFullQueue, -- * Summary @@ -1214,3 +1216,22 @@ showString tab . showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" . samplingStatsSummary dequeueWaitTime (2 + indent) + +-- | Reset the statistics. +resetQueue :: Queue si sm so a -> Event () +resetQueue q = + Event $ \p -> + do let t = pointTime p + queueCount <- readIORef (queueCountRef q) + writeIORef (queueCountStatsRef q) $ + returnTimingStats t queueCount + writeIORef (enqueueCountRef q) 0 + writeIORef (enqueueLostCountRef q) 0 + writeIORef (enqueueStoreCountRef q) 0 + writeIORef (dequeueCountRef q) 0 + writeIORef (dequeueExtractCountRef q) 0 + writeIORef (queueWaitTimeRef q) mempty + writeIORef (queueTotalWaitTimeRef q) mempty + writeIORef (enqueueWaitTimeRef q) mempty + writeIORef (dequeueWaitTimeRef q) mempty + diff --git a/Simulation/Aivika/Queue/Base.hs b/Simulation/Aivika/Queue/Base.hs --- a/Simulation/Aivika/Queue/Base.hs +++ b/Simulation/Aivika/Queue/Base.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue.Base --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Queue/Infinite.hs b/Simulation/Aivika/Queue/Infinite.hs --- a/Simulation/Aivika/Queue/Infinite.hs +++ b/Simulation/Aivika/Queue/Infinite.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue.Infinite --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -50,6 +50,8 @@ queueContains, queueContainsBy, clearQueue, + -- * Statistics Reset + resetQueue, -- * Summary queueSummary, -- * Derived Signals for Properties @@ -747,3 +749,17 @@ showString tab . showString "the dequeue wait time (when was requested for dequeueing -> when was dequeued) = \n\n" . samplingStatsSummary dequeueWaitTime (2 + indent) + +-- | Reset the statistics. +resetQueue :: Queue sm so a -> Event () +resetQueue q = + Event $ \p -> + do let t = pointTime p + queueCount <- readIORef (queueCountRef q) + writeIORef (queueCountStatsRef q) $ + returnTimingStats t queueCount + writeIORef (enqueueStoreCountRef q) 0 + writeIORef (dequeueCountRef q) 0 + writeIORef (dequeueExtractCountRef q) 0 + writeIORef (queueWaitTimeRef q) mempty + writeIORef (dequeueWaitTimeRef q) mempty diff --git a/Simulation/Aivika/Queue/Infinite/Base.hs b/Simulation/Aivika/Queue/Infinite/Base.hs --- a/Simulation/Aivika/Queue/Infinite/Base.hs +++ b/Simulation/Aivika/Queue/Infinite/Base.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Queue.Infinite.Base --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/QueueStrategy.hs b/Simulation/Aivika/QueueStrategy.hs --- a/Simulation/Aivika/QueueStrategy.hs +++ b/Simulation/Aivika/QueueStrategy.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.QueueStrategy --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Ref.hs b/Simulation/Aivika/Ref.hs --- a/Simulation/Aivika/Ref.hs +++ b/Simulation/Aivika/Ref.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Ref --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Ref/Base.hs b/Simulation/Aivika/Ref/Base.hs --- a/Simulation/Aivika/Ref/Base.hs +++ b/Simulation/Aivika/Ref/Base.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Ref.Base --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Resource.hs b/Simulation/Aivika/Resource.hs --- a/Simulation/Aivika/Resource.hs +++ b/Simulation/Aivika/Resource.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Resource --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -53,6 +53,8 @@ -- * Altering Resource incResourceCount, decResourceCount, + -- * Statistics Reset + resetResource, -- * Signals resourceCountChanged, resourceCountChanged_, @@ -585,5 +587,24 @@ a' `seq` writeIORef (resourceTotalWaitTimeRef r) a' modifyIORef' (resourceWaitTimeRef r) $ addSamplingStats delta + invokeEvent p $ + triggerSignal (resourceWaitTimeSource r) () + +-- | Reset the statistics. +resetResource :: Resource s -> Event () +resetResource r = + Event $ \p -> + do let t = pointTime p + count <- readIORef (resourceCountRef r) + writeIORef (resourceCountStatsRef r) $ + returnTimingStats t count + utilCount <- readIORef (resourceUtilisationCountRef r) + writeIORef (resourceUtilisationCountStatsRef r) $ + returnTimingStats t utilCount + queueCount <- readIORef (resourceQueueCountRef r) + writeIORef (resourceQueueCountStatsRef r) $ + returnTimingStats t queueCount + writeIORef (resourceTotalWaitTimeRef r) 0 + writeIORef (resourceWaitTimeRef r) emptySamplingStats invokeEvent p $ triggerSignal (resourceWaitTimeSource r) () diff --git a/Simulation/Aivika/Resource/Base.hs b/Simulation/Aivika/Resource/Base.hs --- a/Simulation/Aivika/Resource/Base.hs +++ b/Simulation/Aivika/Resource/Base.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Resource.Base --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Resource/Preemption.hs b/Simulation/Aivika/Resource/Preemption.hs --- a/Simulation/Aivika/Resource/Preemption.hs +++ b/Simulation/Aivika/Resource/Preemption.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Resource.Preemption --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -33,6 +33,8 @@ incResourceCount, decResourceCount, alterResourceCount, + -- * Statistics Reset + resetResource, -- * Signals resourceCountChanged, resourceCountChanged_, @@ -286,6 +288,7 @@ then do PQ.dequeue (resourceActingQueue r) PQ.enqueue (resourceActingQueue r) (- priority) $ ResourceActingItem priority pid PQ.enqueue (resourceWaitQueue r) p0 (Right $ ResourcePreemptedItem p0 t pid0) + invokeEvent p $ updateResourceWaitTime r 0 invokeEvent p $ updateResourceQueueCount r 1 invokeEvent p $ processPreemptionBegin pid0 invokeEvent p $ resumeCont c () @@ -497,5 +500,24 @@ a' `seq` writeIORef (resourceTotalWaitTimeRef r) a' modifyIORef' (resourceWaitTimeRef r) $ addSamplingStats delta + invokeEvent p $ + triggerSignal (resourceWaitTimeSource r) () + +-- | Reset the statistics. +resetResource :: Resource -> Event () +resetResource r = + Event $ \p -> + do let t = pointTime p + count <- readIORef (resourceCountRef r) + writeIORef (resourceCountStatsRef r) $ + returnTimingStats t count + utilCount <- readIORef (resourceUtilisationCountRef r) + writeIORef (resourceUtilisationCountStatsRef r) $ + returnTimingStats t utilCount + queueCount <- readIORef (resourceQueueCountRef r) + writeIORef (resourceQueueCountStatsRef r) $ + returnTimingStats t queueCount + writeIORef (resourceTotalWaitTimeRef r) 0 + writeIORef (resourceWaitTimeRef r) emptySamplingStats invokeEvent p $ triggerSignal (resourceWaitTimeSource r) () diff --git a/Simulation/Aivika/Resource/Preemption/Base.hs b/Simulation/Aivika/Resource/Preemption/Base.hs --- a/Simulation/Aivika/Resource/Preemption/Base.hs +++ b/Simulation/Aivika/Resource/Preemption/Base.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Resource.Preemption.Base --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Results.hs b/Simulation/Aivika/Results.hs --- a/Simulation/Aivika/Results.hs +++ b/Simulation/Aivika/Results.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances, ExistentialQuantification, OverlappingInstances #-} -- | -- Module : Simulation.Aivika.Results --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -1870,71 +1870,158 @@ intSubscript :: Int -> ResultName intSubscript i = "[" ++ show i ++ "]" -instance ResultComputing m => ResultProvider (m Double) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Parameter a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m [Double]) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Simulation a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (SamplingStats Double)) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Dynamics a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (TimingStats Double)) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Event a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (SamplingCounter Double)) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Ref a) where resultSource' name i m = - samplingCounterResultSource $ computeResultValue name i m + ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (TimingCounter Double)) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (BR.Ref a) where resultSource' name i m = - timingCounterResultSource $ computeResultValue name i m + ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m Int) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Var a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m [Int]) where +instance {-# OVERLAPPABLE #-} ResultItemable (ResultValue a) => ResultProvider (Signalable a) where resultSource' name i m = ResultItemSource $ ResultItem $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (SamplingStats Int)) where +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Parameter (SamplingCounter a)) where resultSource' name i m = - ResultItemSource $ ResultItem $ computeResultValue name i m + samplingCounterResultSource $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (TimingStats Int)) where +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Simulation (SamplingCounter a)) where resultSource' name i m = - ResultItemSource $ ResultItem $ computeResultValue name i m + samplingCounterResultSource $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (SamplingCounter Int)) where +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Dynamics (SamplingCounter a)) where resultSource' name i m = samplingCounterResultSource $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (TimingCounter Int)) where +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Event (SamplingCounter a)) where resultSource' name i m = + samplingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Ref (SamplingCounter a)) where + + resultSource' name i m = + samplingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (BR.Ref (SamplingCounter a)) where + + resultSource' name i m = + samplingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Var (SamplingCounter a)) where + + resultSource' name i m = + samplingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (SamplingStats a))) + => ResultProvider (Signalable (SamplingCounter a)) where + + resultSource' name i m = + samplingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Parameter (TimingCounter a)) where + + resultSource' name i m = timingCounterResultSource $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m String) where +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Simulation (TimingCounter a)) where resultSource' name i m = - ResultItemSource $ ResultItem $ computeResultValue name i m + timingCounterResultSource $ computeResultValue name i m +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Dynamics (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Event (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Ref (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (BR.Ref (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Var (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (ResultItemable (ResultValue a), + ResultItemable (ResultValue (TimingStats a))) + => ResultProvider (Signalable (TimingCounter a)) where + + resultSource' name i m = + timingCounterResultSource $ computeResultValue name i m + instance ResultProvider p => ResultProvider [p] where resultSource' name i m = @@ -2019,22 +2106,82 @@ in resultSource' name' (VectorItemId y) x items' = V.map resultSourceSummary items -instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Double)) where +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Parameter (A.Array i e)) where resultSource' name i m = ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m -instance (Ix i, Show i, ResultComputing m) => ResultProvider (m (A.Array i Int)) where +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Simulation (A.Array i e)) where resultSource' name i m = ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (V.Vector Double)) where +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Dynamics (A.Array i e)) where resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Event (A.Array i e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Ref (A.Array i e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (BR.Ref (A.Array i e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Var (A.Array i e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} (Ix i, Show i, ResultItemable (ResultValue [e])) => ResultProvider (Signalable (A.Array i e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap A.elems $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Parameter (V.Vector e)) where + + resultSource' name i m = ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m -instance ResultComputing m => ResultProvider (m (V.Vector Int)) where +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Simulation (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Dynamics (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Event (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Ref (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (BR.Ref (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Var (V.Vector e)) where + + resultSource' name i m = + ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m + +instance {-# OVERLAPPING #-} ResultItemable (ResultValue [e]) => ResultProvider (Signalable (V.Vector e)) where resultSource' name i m = ResultItemSource $ ResultItem $ fmap V.toList $ computeResultValue name i m diff --git a/Simulation/Aivika/Results/IO.hs b/Simulation/Aivika/Results/IO.hs --- a/Simulation/Aivika/Results/IO.hs +++ b/Simulation/Aivika/Results/IO.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Results.IO --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Results/Locale.hs b/Simulation/Aivika/Results/Locale.hs --- a/Simulation/Aivika/Results/Locale.hs +++ b/Simulation/Aivika/Results/Locale.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Results.Locale --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Results/Transform.hs b/Simulation/Aivika/Results/Transform.hs --- a/Simulation/Aivika/Results/Transform.hs +++ b/Simulation/Aivika/Results/Transform.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} -- | -- Module : Simulation.Aivika.Results.Transform --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -132,9 +132,6 @@ -- | Return the result transform. tr :: a -> ResultTransform - -instance ResultTransformer ResultTransform where - tr = id -- | Represents a statistics based upon observations. newtype SamplingStats = SamplingStats ResultTransform diff --git a/Simulation/Aivika/Server.hs b/Simulation/Aivika/Server.hs --- a/Simulation/Aivika/Server.hs +++ b/Simulation/Aivika/Server.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Server --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -32,6 +32,8 @@ serverProcessingFactor, serverOutputWaitFactor, serverPreemptionFactor, + -- * Statistics Reset + resetServer, -- * Summary serverSummary, -- * Derived Signals for Properties @@ -707,3 +709,16 @@ showString tab . showString "preemption time (waiting for the proceeding after preemption):\n\n" . samplingStatsSummary xs4 (2 + indent) + +-- | Reset the statistics. +resetServer :: Server s a b -> Event () +resetServer server = + Event $ \p -> + do writeIORef (serverTotalInputWaitTimeRef server) 0 + writeIORef (serverTotalProcessingTimeRef server) 0 + writeIORef (serverTotalOutputWaitTimeRef server) 0 + writeIORef (serverTotalPreemptionTimeRef server) 0 + writeIORef (serverInputWaitTimeRef server) mempty + writeIORef (serverProcessingTimeRef server) mempty + writeIORef (serverOutputWaitTimeRef server) mempty + writeIORef (serverPreemptionTimeRef server) mempty diff --git a/Simulation/Aivika/Server/Random.hs b/Simulation/Aivika/Server/Random.hs --- a/Simulation/Aivika/Server/Random.hs +++ b/Simulation/Aivika/Server/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Server.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Signal.hs b/Simulation/Aivika/Signal.hs --- a/Simulation/Aivika/Signal.hs +++ b/Simulation/Aivika/Signal.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Signal --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -16,6 +16,7 @@ (-- * Handling and Triggering Signal Signal(..), handleSignal_, + handleSignalComposite, SignalSource, newSignalSource, publishSignal, @@ -68,8 +69,10 @@ import Simulation.Aivika.Internal.Specs import Simulation.Aivika.Internal.Parameter import Simulation.Aivika.Internal.Simulation +import Simulation.Aivika.Internal.Dynamics import Simulation.Aivika.Internal.Event import Simulation.Aivika.Internal.Arrival +import Simulation.Aivika.Composite import qualified Simulation.Aivika.Vector as V import qualified Simulation.Aivika.Vector.Unboxed as UV @@ -111,6 +114,12 @@ handleSignal_ signal h = do x <- handleSignal signal h return () + +-- | Like 'handleSignal' but within the 'Composite' computation. +handleSignalComposite :: Signal a -> (a -> Event ()) -> Composite () +handleSignalComposite signal h = + do x <- liftEvent $ handleSignal signal h + disposableComposite x -- | Create a new signal source. newSignalSource :: Simulation (SignalSource a) @@ -278,24 +287,24 @@ signalHistoryValues :: V.Vector a } -- | Create a history of the signal values. -newSignalHistory :: Signal a -> Event (SignalHistory a) +newSignalHistory :: Signal a -> Composite (SignalHistory a) newSignalHistory = newSignalHistoryStartingWith Nothing -- | Create a history of the signal values starting with -- the optional initial value. -newSignalHistoryStartingWith :: Maybe a -> Signal a -> Event (SignalHistory a) +newSignalHistoryStartingWith :: Maybe a -> Signal a -> Composite (SignalHistory a) newSignalHistoryStartingWith init signal = - Event $ \p -> - do ts <- UV.newVector - xs <- V.newVector + do ts <- liftIO UV.newVector + xs <- liftIO V.newVector case init of Nothing -> return () Just a -> - do UV.appendVector ts (pointTime p) - V.appendVector xs a - invokeEvent p $ - handleSignal_ signal $ \a -> + do t <- liftDynamics time + liftIO $ + do UV.appendVector ts t + V.appendVector xs a + handleSignalComposite signal $ \a -> Event $ \p -> do UV.appendVector ts (pointTime p) V.appendVector xs a diff --git a/Simulation/Aivika/Signal/Random.hs b/Simulation/Aivika/Signal/Random.hs --- a/Simulation/Aivika/Signal/Random.hs +++ b/Simulation/Aivika/Signal/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Signal.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Simulation.hs b/Simulation/Aivika/Simulation.hs --- a/Simulation/Aivika/Simulation.hs +++ b/Simulation/Aivika/Simulation.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Simulation --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Specs.hs b/Simulation/Aivika/Specs.hs --- a/Simulation/Aivika/Specs.hs +++ b/Simulation/Aivika/Specs.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Specs --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Statistics.hs b/Simulation/Aivika/Statistics.hs --- a/Simulation/Aivika/Statistics.hs +++ b/Simulation/Aivika/Statistics.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} + -- | -- Module : Simulation.Aivika.Statistics --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental @@ -44,7 +46,13 @@ setTimingCounter, returnTimingCounter) where +import GHC.Generics (Generic) + +import Control.DeepSeq + import Data.Monoid +import Data.Typeable +import Data.Binary -- | Defines data types that can be converted to 'Double'. class Ord a => ConvertableToDouble a where @@ -72,8 +80,11 @@ samplingStatsMean2 :: !Double -- ^ The average square value. } - deriving (Eq, Ord) - + deriving (Eq, Ord, Typeable, Generic) + +instance NFData a => NFData (SamplingStats a) +instance Binary a => Binary (SamplingStats a) + -- | Specifies data type from which values we can gather the statistics. class Num a => SamplingData a where @@ -259,7 +270,10 @@ -- ^ Return the sum of values. timingStatsSum2 :: !Double -- ^ Return the sum of square values. - } deriving (Eq, Ord) + } deriving (Eq, Ord, Typeable, Generic) + +instance NFData a => NFData (TimingStats a) +instance Binary a => Binary (TimingStats a) -- | Defines the data type from which values we can gather the timing statistics. class Num a => TimingData a where @@ -461,8 +475,11 @@ -- ^ The counter value. samplingCounterStats :: SamplingStats a -- ^ The counter statistics. - } deriving (Eq, Ord, Show) + } deriving (Eq, Ord, Show, Typeable, Generic) +instance NFData a => NFData (SamplingCounter a) +instance Binary a => Binary (SamplingCounter a) + -- | An empty counter. emptySamplingCounter :: SamplingData a => SamplingCounter a emptySamplingCounter = @@ -501,7 +518,10 @@ -- ^ The counter value. timingCounterStats :: TimingStats a -- ^ The counter statistics. - } deriving (Eq, Ord, Show) + } deriving (Eq, Ord, Show, Typeable, Generic) + +instance NFData a => NFData (TimingCounter a) +instance Binary a => Binary (TimingCounter a) -- | An empty counter. emptyTimingCounter :: TimingData a => TimingCounter a diff --git a/Simulation/Aivika/Statistics/Accumulator.hs b/Simulation/Aivika/Statistics/Accumulator.hs --- a/Simulation/Aivika/Statistics/Accumulator.hs +++ b/Simulation/Aivika/Statistics/Accumulator.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Statistics.Accumulator --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Stream.hs b/Simulation/Aivika/Stream.hs --- a/Simulation/Aivika/Stream.hs +++ b/Simulation/Aivika/Stream.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Stream --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Stream/Random.hs b/Simulation/Aivika/Stream/Random.hs --- a/Simulation/Aivika/Stream/Random.hs +++ b/Simulation/Aivika/Stream/Random.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Stream.Random --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/SystemDynamics.hs b/Simulation/Aivika/SystemDynamics.hs --- a/Simulation/Aivika/SystemDynamics.hs +++ b/Simulation/Aivika/SystemDynamics.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.SystemDynamics --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Table.hs b/Simulation/Aivika/Table.hs --- a/Simulation/Aivika/Table.hs +++ b/Simulation/Aivika/Table.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Table --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Task.hs b/Simulation/Aivika/Task.hs --- a/Simulation/Aivika/Task.hs +++ b/Simulation/Aivika/Task.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Task --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Transform.hs b/Simulation/Aivika/Transform.hs --- a/Simulation/Aivika/Transform.hs +++ b/Simulation/Aivika/Transform.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Transform --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Transform/Extra.hs b/Simulation/Aivika/Transform/Extra.hs --- a/Simulation/Aivika/Transform/Extra.hs +++ b/Simulation/Aivika/Transform/Extra.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Transform.Extra --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Transform/Memo.hs b/Simulation/Aivika/Transform/Memo.hs --- a/Simulation/Aivika/Transform/Memo.hs +++ b/Simulation/Aivika/Transform/Memo.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Transform.Memo --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Transform/Memo/Unboxed.hs b/Simulation/Aivika/Transform/Memo/Unboxed.hs --- a/Simulation/Aivika/Transform/Memo/Unboxed.hs +++ b/Simulation/Aivika/Transform/Memo/Unboxed.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Transform.Memo.Unboxed --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Unboxed.hs b/Simulation/Aivika/Unboxed.hs --- a/Simulation/Aivika/Unboxed.hs +++ b/Simulation/Aivika/Unboxed.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Unboxed --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Var.hs b/Simulation/Aivika/Var.hs --- a/Simulation/Aivika/Var.hs +++ b/Simulation/Aivika/Var.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Var --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Var/Unboxed.hs b/Simulation/Aivika/Var/Unboxed.hs --- a/Simulation/Aivika/Var/Unboxed.hs +++ b/Simulation/Aivika/Var/Unboxed.hs @@ -1,7 +1,7 @@ -- | -- Module : Simulation.Aivika.Var.Unboxed --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Vector.hs b/Simulation/Aivika/Vector.hs --- a/Simulation/Aivika/Vector.hs +++ b/Simulation/Aivika/Vector.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Vector --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/Simulation/Aivika/Vector/Unboxed.hs b/Simulation/Aivika/Vector/Unboxed.hs --- a/Simulation/Aivika/Vector/Unboxed.hs +++ b/Simulation/Aivika/Vector/Unboxed.hs @@ -3,7 +3,7 @@ -- | -- Module : Simulation.Aivika.Vector.Unboxed --- Copyright : Copyright (c) 2009-2016, David Sorokin +-- Copyright : Copyright (c) 2009-2017, David Sorokin -- License : BSD3 -- Maintainer : David Sorokin -- Stability : experimental diff --git a/aivika.cabal b/aivika.cabal --- a/aivika.cabal +++ b/aivika.cabal @@ -1,17 +1,21 @@ name: aivika -version: 5.0.1 +version: 5.1 synopsis: A multi-method simulation library description: - Aivika is a multi-method simulation library focused on - discrete event simulation (DES) with partial support of - system dynamics and agent-based modeling. + Aivika is a discrete event simulation (DES) framework with support of activity-oriented, + event-oriented and process-oriented paradigms. It supports resource preemption and other + improved simulation techniques. There is also a partial support of system dynamics and + agent-based modelling. All the complexity is hidden under easy-to-use computations. + . + The represented package is a basic simulation library optimized for sequential execution. + There are also packages for nested and parallel distributed simulation. . The library has the following features: . * allows defining recursive stochastic differential equations of system dynamics (unordered as in maths via the recursive do-notation); . - * supports the event-driven paradigm of DES as a basic core for + * supports the event-driven paradigm of DES as a basis for implementing other paradigms; . * supports extensively the process-oriented paradigm of DES @@ -21,13 +25,14 @@ * allows working with the resources based on specified queue strategies (FCFS\/FIFO, LCFS\/LIFO, SIRO, static priorities and so on); . - * allows customizing the infinite and finite queues based on strategies too; + * allows customizing the unbounded and bounded queues based on strategies too; . * supports the resource preemption; . - * allows defining a queue network based on streams of data (transacts) - and their processors; + * allows defining a queue network based on streams of data (transacts); . + * allows using a GPSS-like DSL with help of the additional library; + . * allows simulating circuits with recursive links and delays; . * supports the activity-oriented paradigm of DES; @@ -52,8 +57,8 @@ * hides technical details in high-level simulation computations (monads, streams and arrows). . - Aivika itself is a light-weight engine with minimal dependencies. - However, it has additional packages [1, 2] that offer the following + The simulation engine itself has minimal dependencies. + However, there are additional packages [1, 2] that offer the following features: . * automating simulation experiments; @@ -70,17 +75,21 @@ * has an extensible architecture. . The charting package has two interchangeable back-ends [3, 4], - where one of them uses Cairo and it is more preferable. + where one of them uses Cairo and it creates small PNG images, while another + creates more detailed SVG files and it can be used on Windows. . - The PDF documentation and installation instructions are - available on the Aivika Wiki website [5]. + There are also additional packages that allow saving the results of simulation + in SQL databases. Then the results can be accessed from other software applications. + For example, it can be useful when creating flight simulators in other programming languages + such as C# or Java. . - Moreover, the method was generalized [6] and applied to - nested simulation [7] and parallel distributed simulation [8]. + Moreover, the method was generalized [5] and applied to + nested simulation [6] and parallel distributed simulation [7]. . The libraries were tested on Linux, Windows and OS X. . - A more full information about Aivika is available on the project website [9]. + The PDF documentation, installation instructions and a more full information about Aivika + are available on the the AivikaSoft website [8]. . \[1] . @@ -90,15 +99,13 @@ . \[4] . - \[5] - . - \[6] + \[5] . - \[7] + \[6] . - \[8] + \[7] . - \[9] + \[8] . P.S. Aivika is actually a genuine female Mari name which is pronounced with stress on the last syllable. @@ -106,13 +113,13 @@ category: Simulation license: BSD3 license-file: LICENSE -copyright: (c) 2009-2016. David Sorokin +copyright: (c) 2009-2017. David Sorokin author: David Sorokin maintainer: David Sorokin -homepage: http://www.aivikasoft.com/en/products/aivika.html +homepage: http://www.aivikasoft.com cabal-version: >= 1.10 build-type: Simple -tested-with: GHC == 8.0.1 +tested-with: GHC == 8.0.2 extra-source-files: examples/BassDiffusion.hs examples/BouncingBall.hs @@ -161,6 +168,14 @@ Simulation.Aivika.Event Simulation.Aivika.Gate Simulation.Aivika.Generator + Simulation.Aivika.Internal.Cont + Simulation.Aivika.Internal.Dynamics + Simulation.Aivika.Internal.Event + Simulation.Aivika.Internal.Parameter + Simulation.Aivika.Internal.Process + Simulation.Aivika.Internal.Simulation + Simulation.Aivika.Internal.Specs + Simulation.Aivika.Internal.Arrival Simulation.Aivika.Net Simulation.Aivika.Net.Random Simulation.Aivika.Operation @@ -212,21 +227,14 @@ Simulation.Aivika.Vector Simulation.Aivika.Vector.Unboxed - other-modules: Simulation.Aivika.Internal.Cont - Simulation.Aivika.Internal.Dynamics - Simulation.Aivika.Internal.Event - Simulation.Aivika.Internal.Parameter - Simulation.Aivika.Internal.Process - Simulation.Aivika.Internal.Simulation - Simulation.Aivika.Internal.Specs - Simulation.Aivika.Internal.Arrival - - build-depends: base >= 4.5.0.0 && < 6, + build-depends: base >= 4.6.0.0 && < 6, mtl >= 2.1.1, array >= 0.3.0.0, containers >= 0.4.0.0, random >= 1.0.0.3, - vector >= 0.10.0.1 + vector >= 0.10.0.1, + deepseq >= 1.1.0.0, + binary >= 0.6.4.0 other-extensions: FlexibleContexts, FlexibleInstances, @@ -239,8 +247,10 @@ ExistentialQuantification, TypeFamilies, DeriveDataTypeable, + DeriveGeneric, TypeSynonymInstances, - RankNTypes + RankNTypes, + OverlappingInstances ghc-options: -O2