{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}

-- |
-- Module     : Simulation.Aivika.IO.Dynamics.Memo.Unboxed
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The 'IO' monad can be an instance of the 'MonadMemo' type class.
--

module Simulation.Aivika.IO.Dynamics.Memo.Unboxed () where

import Control.Monad
import Control.Monad.Trans

import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.IORef

import Simulation.Aivika.Trans.Internal.Specs
import Simulation.Aivika.Trans.Internal.Parameter
import Simulation.Aivika.Trans.Internal.Simulation
import Simulation.Aivika.Trans.Internal.Dynamics
import Simulation.Aivika.Trans.Dynamics.Memo.Unboxed
import Simulation.Aivika.Trans.Dynamics.Extra
import Simulation.Aivika.Trans.Array

-- | The 'IO' based monad can be an instance of the 'MonadMemo' type class.
instance MArray IOUArray e IO => MonadMemo IO e where
-- instance (Monad m, MonadIO m, MonadTemplate m, MArray IOUArray e IO) => MonadMemo m e where

  {-# SPECIALISE instance MonadMemo IO Double #-}
  {-# SPECIALISE instance MonadMemo IO Float #-}
  {-# SPECIALISE instance MonadMemo IO Int #-}

  {-# INLINE memoDynamics #-}
  memoDynamics :: Dynamics IO e -> Simulation IO (Dynamics IO e)
memoDynamics (Dynamics Point IO -> IO e
m) = 
    forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run IO
r ->
    do let sc :: Specs IO
sc  = forall (m :: * -> *). Run m -> Specs m
runSpecs Run IO
r
           (Int
phl, Int
phu) = forall (m :: * -> *). Specs m -> (Int, Int)
integPhaseBnds Specs IO
sc
           (Int
nl, Int
nu)   = forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs IO
sc
       IOUArray (Int, Int) e
arr   <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall i e.
(Ix i, MArray IOUArray e IO) =>
(i, i) -> IO (IOUArray i e)
newIOUArray_ ((Int
phl, Int
nl), (Int
phu, Int
nu))
       IORef Int
nref  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
       IORef Int
phref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
       let r :: Point IO -> IO e
r Point IO
p = 
             do let n :: Int
n  = forall (m :: * -> *). Point m -> Int
pointIteration Point IO
p
                    ph :: Int
ph = forall (m :: * -> *). Point m -> Int
pointPhase Point IO
p
                    loop :: Int -> Int -> IO e
loop Int
n' Int
ph' = 
                      if (Int
n' forall a. Ord a => a -> a -> Bool
> Int
n) Bool -> Bool -> Bool
|| ((Int
n' forall a. Eq a => a -> a -> Bool
== Int
n) Bool -> Bool -> Bool
&& (Int
ph' forall a. Ord a => a -> a -> Bool
> Int
ph)) 
                      then 
                        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray (Int, Int) e
arr (Int
ph, Int
n)
                      else 
                        let p' :: Point IO
p' = Point IO
p { pointIteration :: Int
pointIteration = Int
n', pointPhase :: Int
pointPhase = Int
ph',
                                     pointTime :: Double
pointTime = forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs IO
sc Int
n' Int
ph' }
                        in do e
a <- Point IO -> IO e
m Point IO
p'
                              e
a seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray (Int, Int) e
arr (Int
ph', Int
n') e
a
                              if Int
ph' forall a. Ord a => a -> a -> Bool
>= Int
phu 
                                then do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Int
phref Int
0
                                        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Int
nref (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
                                        Int -> Int -> IO e
loop (Int
n' forall a. Num a => a -> a -> a
+ Int
1) Int
0
                                else do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Int
phref (Int
ph' forall a. Num a => a -> a -> a
+ Int
1)
                                        Int -> Int -> IO e
loop Int
n' (Int
ph' forall a. Num a => a -> a -> a
+ Int
1)
                Int
n'  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Int
nref
                Int
ph' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Int
phref
                Int -> Int -> IO e
loop Int
n' Int
ph'
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Dynamics m a -> Dynamics m a
interpolateDynamics forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point IO -> IO e
r

  {-# INLINE memo0Dynamics #-}
  memo0Dynamics :: Dynamics IO e -> Simulation IO (Dynamics IO e)
memo0Dynamics (Dynamics Point IO -> IO e
m) = 
    forall (m :: * -> *) a. (Run m -> m a) -> Simulation m a
Simulation forall a b. (a -> b) -> a -> b
$ \Run IO
r ->
    do let sc :: Specs IO
sc = forall (m :: * -> *). Run m -> Specs m
runSpecs Run IO
r
           bnds :: (Int, Int)
bnds = forall (m :: * -> *). Specs m -> (Int, Int)
integIterationBnds Specs IO
sc
       IOUArray Int e
arr  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall i e.
(Ix i, MArray IOUArray e IO) =>
(i, i) -> IO (IOUArray i e)
newIOUArray_ (Int, Int)
bnds
       IORef Int
nref <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef Int
0
       let r :: Point IO -> IO e
r Point IO
p =
             do let sc :: Specs IO
sc = forall (m :: * -> *). Point m -> Specs m
pointSpecs Point IO
p
                    n :: Int
n  = forall (m :: * -> *). Point m -> Int
pointIteration Point IO
p
                    loop :: Int -> IO e
loop Int
n' = 
                      if Int
n' forall a. Ord a => a -> a -> Bool
> Int
n
                      then 
                        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int e
arr Int
n
                      else 
                        let p' :: Point IO
p' = Point IO
p { pointIteration :: Int
pointIteration = Int
n', pointPhase :: Int
pointPhase = Int
0,
                                     pointTime :: Double
pointTime = forall (m :: * -> *). Specs m -> Int -> Int -> Double
basicTime Specs IO
sc Int
n' Int
0 }
                        in do e
a <- Point IO -> IO e
m Point IO
p'
                              e
a seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int e
arr Int
n' e
a
                              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Int
nref (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
                              Int -> IO e
loop (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
                Int
n' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Int
nref
                Int -> IO e
loop Int
n'
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Dynamics m a -> Dynamics m a
discreteDynamics forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Point m -> m a) -> Dynamics m a
Dynamics Point IO -> IO e
r