module Control.Monad.Array.ArrayT (ArrayM, ArrayT, runArrayM, runArrayM_, runArrayT, runArrayT_) where
import GHC.Exts
import GHC.ST(ST(..))
import Prelude hiding (getContents)
import Control.Monad.ST
import Control.Monad.Fix
import Control.Monad.Array.Class
import Control.Monad
import Control.Monad.Trans
import Control.Monad.RWS.Class
import Control.Monad.State
import Control.Monad.ST.Class
data MArr s e = MArr !Int e (MutableArray# s e)
type ArrayM s e = ArrayT e (ST s)
newtype ArrayT e m a = ArrayT {runArrT :: StateT (MArr (StateThread m) e) m a} deriving (Monad, MonadFix, MonadPlus, MonadReader r, MonadWriter w)
instance MonadTrans (ArrayT e) where
lift = ArrayT . lift
instance MonadState s m => MonadState s (ArrayT e m) where
get = lift get
put = lift . put
runArrayM :: Int -> e -> (forall s . ArrayM s e a) -> a
runArrayM n d m = runST $ runArrayT n d m
runArrayM_ :: Int -> (forall s . ArrayM s e a) -> a
runArrayM_ n = runArrayM n emptyElement
runArrayT :: (MonadST m, Monad m) => Int -> e -> ArrayT e m a -> m a
runArrayT n d m = liftST (newMArr n d) >>= evalStateT (runArrT m)
runArrayT_ :: (MonadST m, Monad m) => Int -> ArrayT e m a -> m a
runArrayT_ n = runArrayT n emptyElement
emptyElement = error "Undefined array element"
instance (MonadST m, Monad m) => MonadArray e (ArrayT e m) where
unsafeReadAt i = ArrayT $ do arr <- get
liftST $ readMArr arr i
unsafeWriteAt i x = ArrayT $ do arr <- get
liftST $ writeMArr arr i x
getSize = ArrayT $ do MArr n _ _ <- get
return n
resize n' = ArrayT $ do a@(MArr n d _) <- get
a' <- liftST $ newMArr n' d
liftST $ mapM_ (\ i -> readMArr a i >>= writeMArr a' i) [0..n1]
put a'
newMArr :: Int -> e -> ST s (MArr s e)
newMArr (I# n) d = ST $ \ s -> case newArray# n d s of (# s', arr' #) -> (# s', MArr (I# n) d arr' #)
readMArr :: MArr s e -> Int -> ST s e
readMArr (MArr n _ arr) i@(I# i#) = ST $ readArray# arr i#
writeMArr :: MArr s e -> Int -> e -> ST s ()
writeMArr (MArr n _ arr) i@(I# i#) x = ST $ \ s -> (# writeArray# arr i# x s, () #)