{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, RankNTypes #-}
module Simulation.Aivika.Trans.Internal.Parameter
(
Parameter(..),
ParameterLift(..),
invokeParameter,
runParameter,
runParameters,
catchParameter,
finallyParameter,
throwParameter,
simulationIndex,
simulationCount,
simulationSpecs,
simulationEventQueue,
starttime,
stoptime,
dt,
generatorParameter,
memoParameter,
tableParameter) where
import Control.Exception
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative
import Data.IORef
import qualified Data.IntMap as M
import Data.Array
import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Generator
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Internal.Specs
import {-# SOURCE #-} Simulation.Aivika.Trans.Concurrent.MVar
instance Monad m => Monad (Parameter m) where
{-# INLINE (>>=) #-}
(Parameter Run m -> m a
m) >>= :: forall a b. Parameter m a -> (a -> Parameter m b) -> Parameter m b
>>= a -> Parameter m b
k =
(Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do a
a <- Run m -> m a
m Run m
r
let Parameter Run m -> m b
m' = a -> Parameter m b
k a
a
Run m -> m b
m' Run m
r
runParameter :: MonadDES m => Parameter m a -> Specs m -> m a
{-# INLINABLE runParameter #-}
runParameter :: forall (m :: * -> *) a.
MonadDES m =>
Parameter m a -> Specs m -> m a
runParameter (Parameter Run m -> m a
m) Specs m
sc =
do EventQueue m
q <- Specs m -> m (EventQueue m)
forall (m :: * -> *).
EventQueueing m =>
Specs m -> m (EventQueue m)
newEventQueue Specs m
sc
Generator m
g <- GeneratorType m -> m (Generator m)
forall (m :: * -> *).
MonadGenerator m =>
GeneratorType m -> m (Generator m)
newGenerator (GeneratorType m -> m (Generator m))
-> GeneratorType m -> m (Generator m)
forall a b. (a -> b) -> a -> b
$ Specs m -> GeneratorType m
forall (m :: * -> *). Specs m -> GeneratorType m
spcGeneratorType Specs m
sc
Run m -> m a
m Run { runSpecs :: Specs m
runSpecs = Specs m
sc,
runIndex :: Int
runIndex = Int
1,
runCount :: Int
runCount = Int
1,
runEventQueue :: EventQueue m
runEventQueue = EventQueue m
q,
runGenerator :: Generator m
runGenerator = Generator m
g }
runParameters :: MonadDES m => Parameter m a -> Specs m -> Int -> [m a]
{-# INLINABLE runParameters #-}
runParameters :: forall (m :: * -> *) a.
MonadDES m =>
Parameter m a -> Specs m -> Int -> [m a]
runParameters (Parameter Run m -> m a
m) Specs m
sc Int
runs = (Int -> m a) -> [Int] -> [m a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> m a
f [Int
1 .. Int
runs]
where f :: Int -> m a
f Int
i = do EventQueue m
q <- Specs m -> m (EventQueue m)
forall (m :: * -> *).
EventQueueing m =>
Specs m -> m (EventQueue m)
newEventQueue Specs m
sc
Generator m
g <- GeneratorType m -> m (Generator m)
forall (m :: * -> *).
MonadGenerator m =>
GeneratorType m -> m (Generator m)
newGenerator (GeneratorType m -> m (Generator m))
-> GeneratorType m -> m (Generator m)
forall a b. (a -> b) -> a -> b
$ Specs m -> GeneratorType m
forall (m :: * -> *). Specs m -> GeneratorType m
spcGeneratorType Specs m
sc
Run m -> m a
m Run { runSpecs :: Specs m
runSpecs = Specs m
sc,
runIndex :: Int
runIndex = Int
i,
runCount :: Int
runCount = Int
runs,
runEventQueue :: EventQueue m
runEventQueue = EventQueue m
q,
runGenerator :: Generator m
runGenerator = Generator m
g }
simulationIndex :: Monad m => Parameter m Int
{-# INLINE simulationIndex #-}
simulationIndex :: forall (m :: * -> *). Monad m => Parameter m Int
simulationIndex = (Run m -> m Int) -> Parameter m Int
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m Int) -> Parameter m Int)
-> (Run m -> m Int) -> Parameter m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> (Run m -> Int) -> Run m -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Int
forall (m :: * -> *). Run m -> Int
runIndex
simulationCount :: Monad m => Parameter m Int
{-# INLINE simulationCount #-}
simulationCount :: forall (m :: * -> *). Monad m => Parameter m Int
simulationCount = (Run m -> m Int) -> Parameter m Int
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m Int) -> Parameter m Int)
-> (Run m -> m Int) -> Parameter m Int
forall a b. (a -> b) -> a -> b
$ Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> (Run m -> Int) -> Run m -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Int
forall (m :: * -> *). Run m -> Int
runCount
simulationSpecs :: Monad m => Parameter m (Specs m)
{-# INLINE simulationSpecs #-}
simulationSpecs :: forall (m :: * -> *). Monad m => Parameter m (Specs m)
simulationSpecs = (Run m -> m (Specs m)) -> Parameter m (Specs m)
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m (Specs m)) -> Parameter m (Specs m))
-> (Run m -> m (Specs m)) -> Parameter m (Specs m)
forall a b. (a -> b) -> a -> b
$ Specs m -> m (Specs m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Specs m -> m (Specs m))
-> (Run m -> Specs m) -> Run m -> m (Specs m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs
generatorParameter :: Monad m => Parameter m (Generator m)
{-# INLINE generatorParameter #-}
generatorParameter :: forall (m :: * -> *). Monad m => Parameter m (Generator m)
generatorParameter = (Run m -> m (Generator m)) -> Parameter m (Generator m)
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m (Generator m)) -> Parameter m (Generator m))
-> (Run m -> m (Generator m)) -> Parameter m (Generator m)
forall a b. (a -> b) -> a -> b
$ Generator m -> m (Generator m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Generator m -> m (Generator m))
-> (Run m -> Generator m) -> Run m -> m (Generator m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Generator m
forall (m :: * -> *). Run m -> Generator m
runGenerator
instance Functor m => Functor (Parameter m) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> Parameter m a -> Parameter m b
fmap a -> b
f (Parameter Run m -> m a
x) = (Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r -> (a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ Run m -> m a
x Run m
r
instance Applicative m => Applicative (Parameter m) where
{-# INLINE pure #-}
pure :: forall a. a -> Parameter m a
pure = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (a -> Run m -> m a) -> a -> Parameter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Run m -> m a
forall a b. a -> b -> a
const (m a -> Run m -> m a) -> (a -> m a) -> a -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE (<*>) #-}
(Parameter Run m -> m (a -> b)
x) <*> :: forall a b. Parameter m (a -> b) -> Parameter m a -> Parameter m b
<*> (Parameter Run m -> m a
y) = (Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r -> Run m -> m (a -> b)
x Run m
r m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Run m -> m a
y Run m
r
instance Monad m => MonadFail (Parameter m) where
{-# INLINE fail #-}
fail :: forall a. String -> Parameter m a
fail = String -> Parameter m a
forall a. HasCallStack => String -> a
error
liftMP :: Monad m => (a -> b) -> Parameter m a -> Parameter m b
{-# INLINE liftMP #-}
liftMP :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> b
f (Parameter Run m -> m a
x) =
(Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r -> do { a
a <- Run m -> m a
x Run m
r; b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a }
liftM2P :: Monad m => (a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
{-# INLINE liftM2P #-}
liftM2P :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> b -> c
f (Parameter Run m -> m a
x) (Parameter Run m -> m b
y) =
(Run m -> m c) -> Parameter m c
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m c) -> Parameter m c)
-> (Run m -> m c) -> Parameter m c
forall a b. (a -> b) -> a -> b
$ \Run m
r -> do { a
a <- Run m -> m a
x Run m
r; b
b <- Run m -> m b
y Run m
r; c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> c -> m c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b }
instance (Num a, Monad m) => Num (Parameter m a) where
{-# INLINE (+) #-}
Parameter m a
x + :: Parameter m a -> Parameter m a -> Parameter m a
+ Parameter m a
y = (a -> a -> a) -> Parameter m a -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> a -> a
forall a. Num a => a -> a -> a
(+) Parameter m a
x Parameter m a
y
{-# INLINE (-) #-}
Parameter m a
x - :: Parameter m a -> Parameter m a -> Parameter m a
- Parameter m a
y = (a -> a -> a) -> Parameter m a -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P (-) Parameter m a
x Parameter m a
y
{-# INLINE (*) #-}
Parameter m a
x * :: Parameter m a -> Parameter m a -> Parameter m a
* Parameter m a
y = (a -> a -> a) -> Parameter m a -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> a -> a
forall a. Num a => a -> a -> a
(*) Parameter m a
x Parameter m a
y
{-# INLINE negate #-}
negate :: Parameter m a -> Parameter m a
negate = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Num a => a -> a
negate
{-# INLINE abs #-}
abs :: Parameter m a -> Parameter m a
abs = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Num a => a -> a
abs
{-# INLINE signum #-}
signum :: Parameter m a -> Parameter m a
signum = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Num a => a -> a
signum
{-# INLINE fromInteger #-}
fromInteger :: Integer -> Parameter m a
fromInteger Integer
i = a -> Parameter m a
forall a. a -> Parameter m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parameter m a) -> a -> Parameter m a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i
instance (Fractional a, Monad m) => Fractional (Parameter m a) where
{-# INLINE (/) #-}
Parameter m a
x / :: Parameter m a -> Parameter m a -> Parameter m a
/ Parameter m a
y = (a -> a -> a) -> Parameter m a -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> a -> a
forall a. Fractional a => a -> a -> a
(/) Parameter m a
x Parameter m a
y
{-# INLINE recip #-}
recip :: Parameter m a -> Parameter m a
recip = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Fractional a => a -> a
recip
{-# INLINE fromRational #-}
fromRational :: Rational -> Parameter m a
fromRational Rational
t = a -> Parameter m a
forall a. a -> Parameter m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parameter m a) -> a -> Parameter m a
forall a b. (a -> b) -> a -> b
$ Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
t
instance (Floating a, Monad m) => Floating (Parameter m a) where
{-# INLINE pi #-}
pi :: Parameter m a
pi = a -> Parameter m a
forall a. a -> Parameter m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Floating a => a
pi
{-# INLINE exp #-}
exp :: Parameter m a -> Parameter m a
exp = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
exp
{-# INLINE log #-}
log :: Parameter m a -> Parameter m a
log = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
log
{-# INLINE sqrt #-}
sqrt :: Parameter m a -> Parameter m a
sqrt = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
sqrt
{-# INLINE (**) #-}
Parameter m a
x ** :: Parameter m a -> Parameter m a -> Parameter m a
** Parameter m a
y = (a -> a -> a) -> Parameter m a -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> a -> a
forall a. Floating a => a -> a -> a
(**) Parameter m a
x Parameter m a
y
{-# INLINE sin #-}
sin :: Parameter m a -> Parameter m a
sin = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
sin
{-# INLINE cos #-}
cos :: Parameter m a -> Parameter m a
cos = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
cos
{-# INLINE tan #-}
tan :: Parameter m a -> Parameter m a
tan = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
tan
{-# INLINE asin #-}
asin :: Parameter m a -> Parameter m a
asin = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
asin
{-# INLINE acos #-}
acos :: Parameter m a -> Parameter m a
acos = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
acos
{-# INLINE atan #-}
atan :: Parameter m a -> Parameter m a
atan = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
atan
{-# INLINE sinh #-}
sinh :: Parameter m a -> Parameter m a
sinh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
sinh
{-# INLINE cosh #-}
cosh :: Parameter m a -> Parameter m a
cosh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
cosh
{-# INLINE tanh #-}
tanh :: Parameter m a -> Parameter m a
tanh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
tanh
{-# INLINE asinh #-}
asinh :: Parameter m a -> Parameter m a
asinh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
asinh
{-# INLINE acosh #-}
acosh :: Parameter m a -> Parameter m a
acosh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
acosh
{-# INLINE atanh #-}
atanh :: Parameter m a -> Parameter m a
atanh = (a -> a) -> Parameter m a -> Parameter m a
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> a
forall a. Floating a => a -> a
atanh
instance MonadTrans Parameter where
{-# INLINE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> Parameter m a
lift = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (m a -> Run m -> m a) -> m a -> Parameter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Run m -> m a
forall a b. a -> b -> a
const
instance MonadIO m => MonadIO (Parameter m) where
{-# INLINE liftIO #-}
liftIO :: forall a. IO a -> Parameter m a
liftIO = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (IO a -> Run m -> m a) -> IO a -> Parameter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Run m -> m a
forall a b. a -> b -> a
const (m a -> Run m -> m a) -> (IO a -> m a) -> IO a -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance Monad m => MonadCompTrans Parameter m where
{-# INLINE liftComp #-}
liftComp :: forall a. m a -> Parameter m a
liftComp = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (m a -> Run m -> m a) -> m a -> Parameter m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Run m -> m a
forall a b. a -> b -> a
const
class ParameterLift t m where
liftParameter :: Parameter m a -> t m a
instance Monad m => ParameterLift Parameter m where
{-# INLINE liftParameter #-}
liftParameter :: forall a. Parameter m a -> Parameter m a
liftParameter = Parameter m a -> Parameter m a
forall a. a -> a
id
catchParameter :: (MonadException m, Exception e) => Parameter m a -> (e -> Parameter m a) -> Parameter m a
{-# INLINABLE catchParameter #-}
catchParameter :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catchParameter (Parameter Run m -> m a
m) e -> Parameter m a
h =
(Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (Run m -> m a) -> Parameter m a
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
m a -> (e -> m a) -> m a
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp (Run m -> m a
m Run m
r) ((e -> m a) -> m a) -> (e -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \e
e ->
let Parameter Run m -> m a
m' = e -> Parameter m a
h e
e in Run m -> m a
m' Run m
r
finallyParameter :: MonadException m => Parameter m a -> Parameter m b -> Parameter m a
{-# INLINABLE finallyParameter #-}
finallyParameter :: forall (m :: * -> *) a b.
MonadException m =>
Parameter m a -> Parameter m b -> Parameter m a
finallyParameter (Parameter Run m -> m a
m) (Parameter Run m -> m b
m') =
(Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (Run m -> m a) -> Parameter m a
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
m a -> m b -> m a
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp (Run m -> m a
m Run m
r) (Run m -> m b
m' Run m
r)
throwParameter :: (MonadException m, Exception e) => e -> Parameter m a
{-# INLINABLE throwParameter #-}
throwParameter :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Parameter m a
throwParameter e
e =
(Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (Run m -> m a) -> Parameter m a
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
e -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e
maskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b
{-# INLINABLE maskParameter #-}
maskParameter :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
maskParameter (forall a. Parameter m a -> Parameter m a) -> Parameter m b
a =
(Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
Run m -> Parameter m b -> m b
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r ((forall a. Parameter m a -> Parameter m a) -> Parameter m b
a ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> (forall a. Parameter m a -> Parameter m a) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Parameter m a -> Parameter m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
forall a. m a -> m a
u)
where q :: (m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
u (Parameter Run m -> m a
b) = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter (m a -> m a
u (m a -> m a) -> (Run m -> m a) -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> m a
b)
uninterruptibleMaskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b
{-# INLINABLE uninterruptibleMaskParameter #-}
uninterruptibleMaskParameter :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMaskParameter (forall a. Parameter m a -> Parameter m a) -> Parameter m b
a =
(Run m -> m b) -> Parameter m b
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m b) -> Parameter m b)
-> (Run m -> m b) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
((forall a. m a -> m a) -> m b) -> m b
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
Run m -> Parameter m b -> m b
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r ((forall a. Parameter m a -> Parameter m a) -> Parameter m b
a ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> (forall a. Parameter m a -> Parameter m a) -> Parameter m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> Parameter m a -> Parameter m a
forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
forall a. m a -> m a
u)
where q :: (m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
u (Parameter Run m -> m a
b) = (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter (m a -> m a
u (m a -> m a) -> (Run m -> m a) -> Run m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> m a
b)
generalBracketParameter :: MC.MonadMask m
=> Parameter m a
-> (a -> MC.ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
{-# INLINABLE generalBracketParameter #-}
generalBracketParameter :: forall (m :: * -> *) a b c.
MonadMask m =>
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracketParameter Parameter m a
acquire a -> ExitCase b -> Parameter m c
release a -> Parameter m b
use =
(Run m -> m (b, c)) -> Parameter m (b, c)
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m (b, c)) -> Parameter m (b, c))
-> (Run m -> m (b, c)) -> Parameter m (b, c)
forall a b. (a -> b) -> a -> b
$ \Run m
r -> do
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
MC.generalBracket
(Run m -> Parameter m a -> m a
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r Parameter m a
acquire)
(\a
resource ExitCase b
e -> Run m -> Parameter m c -> m c
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r (Parameter m c -> m c) -> Parameter m c -> m c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Parameter m c
release a
resource ExitCase b
e)
(\a
resource -> Run m -> Parameter m b -> m b
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r (Parameter m b -> m b) -> Parameter m b -> m b
forall a b. (a -> b) -> a -> b
$ a -> Parameter m b
use a
resource)
instance MonadFix m => MonadFix (Parameter m) where
{-# INLINE mfix #-}
mfix :: forall a. (a -> Parameter m a) -> Parameter m a
mfix a -> Parameter m a
f =
(Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (Run m -> m a) -> Parameter m a
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do { rec { a
a <- Run m -> Parameter m a -> m a
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r (a -> Parameter m a
f a
a) }; a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a }
instance MonadException m => MC.MonadThrow (Parameter m) where
{-# INLINE throwM #-}
throwM :: forall e a. (HasCallStack, Exception e) => e -> Parameter m a
throwM = e -> Parameter m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Parameter m a
throwParameter
instance MonadException m => MC.MonadCatch (Parameter m) where
{-# INLINE catch #-}
catch :: forall e a.
(HasCallStack, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catch = Parameter m a -> (e -> Parameter m a) -> Parameter m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catchParameter
instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Parameter m) where
{-# INLINE mask #-}
mask :: forall b.
HasCallStack =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
mask = ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
maskParameter
{-# INLINE uninterruptibleMask #-}
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMask = ((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMaskParameter
{-# INLINE generalBracket #-}
generalBracket :: forall a b c.
HasCallStack =>
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracket = Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracketParameter
memoParameter :: (MonadComp m, MonadIO m, MC.MonadMask m) => Parameter m a -> m (Parameter m a)
memoParameter :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m, MonadMask m) =>
Parameter m a -> m (Parameter m a)
memoParameter Parameter m a
x =
do MVar ()
lock <- IO (MVar ()) -> m (MVar ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> m (MVar ())) -> IO (MVar ()) -> m (MVar ())
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
IORef (IntMap a)
dict <- IO (IORef (IntMap a)) -> m (IORef (IntMap a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (IntMap a)) -> m (IORef (IntMap a)))
-> IO (IORef (IntMap a)) -> m (IORef (IntMap a))
forall a b. (a -> b) -> a -> b
$ IntMap a -> IO (IORef (IntMap a))
forall a. a -> IO (IORef a)
newIORef IntMap a
forall a. IntMap a
M.empty
Parameter m a -> m (Parameter m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parameter m a -> m (Parameter m a))
-> Parameter m a -> m (Parameter m a)
forall a b. (a -> b) -> a -> b
$ (Run m -> m a) -> Parameter m a
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m a) -> Parameter m a)
-> (Run m -> m a) -> Parameter m a
forall a b. (a -> b) -> a -> b
$ \Run m
r ->
do let i :: Int
i = Run m -> Int
forall (m :: * -> *). Run m -> Int
runIndex Run m
r
IntMap a
m <- IO (IntMap a) -> m (IntMap a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap a) -> m (IntMap a)) -> IO (IntMap a) -> m (IntMap a)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap a) -> IO (IntMap a)
forall a. IORef a -> IO a
readIORef IORef (IntMap a)
dict
if Int -> IntMap a -> Bool
forall a. Int -> IntMap a -> Bool
M.member Int
i IntMap a
m
then do let Just a
v = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap a
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
else MVar () -> (() -> m a) -> m a
forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> m b) -> m b
withMVarComp MVar ()
lock ((() -> m a) -> m a) -> (() -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
\() -> do { IntMap a
m <- IO (IntMap a) -> m (IntMap a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap a) -> m (IntMap a)) -> IO (IntMap a) -> m (IntMap a)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap a) -> IO (IntMap a)
forall a. IORef a -> IO a
readIORef IORef (IntMap a)
dict;
if Int -> IntMap a -> Bool
forall a. Int -> IntMap a -> Bool
M.member Int
i IntMap a
m
then do let Just a
v = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap a
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
else do a
v <- Run m -> Parameter m a -> m a
forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r Parameter m a
x
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap a) -> IntMap a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap a)
dict (IntMap a -> IO ()) -> IntMap a -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
i a
v IntMap a
m
a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v }
tableParameter :: Monad m => Array Int a -> Parameter m a
{-# INLINABLE tableParameter #-}
tableParameter :: forall (m :: * -> *) a. Monad m => Array Int a -> Parameter m a
tableParameter Array Int a
t =
do Int
i <- Parameter m Int
forall (m :: * -> *). Monad m => Parameter m Int
simulationIndex
a -> Parameter m a
forall a. a -> Parameter m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Parameter m a) -> a -> Parameter m a
forall a b. (a -> b) -> a -> b
$ Array Int a
t Array Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
! (((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i1)
where (Int
i1, Int
i2) = Array Int a -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int a
t
n :: Int
n = Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
starttime :: Monad m => Parameter m Double
{-# INLINE starttime #-}
starttime :: forall (m :: * -> *). Monad m => Parameter m Double
starttime =
(Run m -> m Double) -> Parameter m Double
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m Double) -> Parameter m Double)
-> (Run m -> m Double) -> Parameter m Double
forall a b. (a -> b) -> a -> b
$ Double -> m Double
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> (Run m -> Double) -> Run m -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStartTime (Specs m -> Double) -> (Run m -> Specs m) -> Run m -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs
stoptime :: Monad m => Parameter m Double
{-# INLINE stoptime #-}
stoptime :: forall (m :: * -> *). Monad m => Parameter m Double
stoptime =
(Run m -> m Double) -> Parameter m Double
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m Double) -> Parameter m Double)
-> (Run m -> m Double) -> Parameter m Double
forall a b. (a -> b) -> a -> b
$ Double -> m Double
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> (Run m -> Double) -> Run m -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcStopTime (Specs m -> Double) -> (Run m -> Specs m) -> Run m -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs
dt :: Monad m => Parameter m Double
{-# INLINE dt #-}
dt :: forall (m :: * -> *). Monad m => Parameter m Double
dt =
(Run m -> m Double) -> Parameter m Double
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m Double) -> Parameter m Double)
-> (Run m -> m Double) -> Parameter m Double
forall a b. (a -> b) -> a -> b
$ Double -> m Double
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> (Run m -> Double) -> Run m -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Specs m -> Double
forall (m :: * -> *). Specs m -> Double
spcDT (Specs m -> Double) -> (Run m -> Specs m) -> Run m -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> Specs m
forall (m :: * -> *). Run m -> Specs m
runSpecs
simulationEventQueue :: Monad m => Parameter m (EventQueue m)
{-# INLINE simulationEventQueue #-}
simulationEventQueue :: forall (m :: * -> *). Monad m => Parameter m (EventQueue m)
simulationEventQueue =
(Run m -> m (EventQueue m)) -> Parameter m (EventQueue m)
forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter ((Run m -> m (EventQueue m)) -> Parameter m (EventQueue m))
-> (Run m -> m (EventQueue m)) -> Parameter m (EventQueue m)
forall a b. (a -> b) -> a -> b
$ EventQueue m -> m (EventQueue m)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EventQueue m -> m (EventQueue m))
-> (Run m -> EventQueue m) -> Run m -> m (EventQueue m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> EventQueue m
forall (m :: * -> *). Run m -> EventQueue m
runEventQueue