module Simulation.Aivika.Var.Unboxed
(Var,
varChanged,
varChanged_,
newVar,
readVar,
writeVar,
modifyVar,
freezeVar) where
import Data.Array
import Data.Array.IO.Safe
import Data.IORef
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Event
import Simulation.Aivika.Internal.Signal
import Simulation.Aivika.Signal
import Simulation.Aivika.Unboxed
import qualified Simulation.Aivika.Vector.Unboxed as UV
data Var a =
Var { varXS :: UV.Vector Double,
varYS :: UV.Vector a,
varChangedSource :: SignalSource a }
newVar :: Unboxed a => a -> Simulation (Var a)
newVar a =
Simulation $ \r ->
do xs <- UV.newVector
ys <- UV.newVector
UV.appendVector xs $ spcStartTime $ runSpecs r
UV.appendVector ys a
s <- invokeSimulation r newSignalSource
return Var { varXS = xs,
varYS = ys,
varChangedSource = s }
readVar :: Unboxed a => Var a -> Event a
readVar v =
Event $ \p ->
do let xs = varXS v
ys = varYS v
t = pointTime p
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if x <= t
then UV.readVector ys i
else do i <- UV.vectorBinarySearch xs t
if i >= 0
then UV.readVector ys i
else UV.readVector ys $ (i + 1) 1
writeVar :: Unboxed a => Var a -> a -> Event ()
writeVar v a =
Event $ \p ->
do let xs = varXS v
ys = varYS v
t = pointTime p
s = varChangedSource v
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if t < x
then error "Cannot update the past data: writeVar."
else if t == x
then UV.writeVector ys i $! a
else do UV.appendVector xs t
UV.appendVector ys $! a
invokeEvent p $ triggerSignal s a
modifyVar :: Unboxed a => Var a -> (a -> a) -> Event ()
modifyVar v f =
Event $ \p ->
do let xs = varXS v
ys = varYS v
t = pointTime p
s = varChangedSource v
count <- UV.vectorCount xs
let i = count 1
x <- UV.readVector xs i
if t < x
then error "Cannot update the past data: modifyVar."
else if t == x
then do a <- UV.readVector ys i
let b = f a
UV.writeVector ys i $! b
invokeEvent p $ triggerSignal s b
else do i <- UV.vectorBinarySearch xs t
if i >= 0
then do a <- UV.readVector ys i
let b = f a
UV.appendVector xs t
UV.appendVector ys $! b
invokeEvent p $ triggerSignal s b
else do a <- UV.readVector ys $ (i + 1) 1
let b = f a
UV.appendVector xs t
UV.appendVector ys $! b
invokeEvent p $ triggerSignal s b
freezeVar :: Unboxed a => Var a -> Event (Array Int Double, Array Int a)
freezeVar v =
Event $ \p ->
do xs <- UV.freezeVector (varXS v)
ys <- UV.freezeVector (varYS v)
return (xs, ys)
varChanged :: Var a -> Signal a
varChanged v = publishSignal (varChangedSource v)
varChanged_ :: Var a -> Signal ()
varChanged_ v = mapSignal (const ()) $ varChanged v