{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,
    MultiParamTypeClasses, UndecidableInstances #-}
{- |
   Module      :  Control.Monad.ST.Trans
   Copyright   :  Josef Svenningsson 2008
                  (c) The University of Glasgow, 1994-2000
   License     :  BSD

   Maintainer  :  josef.svenningsson@gmail.com
   Stability   :  experimental
   Portability :  non-portable (GHC Extensions)

   This library provides a monad transformer version of the ST monad.

   Warning! This monad transformer should not be used with monads that
   can contain multiple answers, like the list monad. The reason is that
   the will be duplicated across the different answers and this cause
   Bad Things to happen (such as loss of referential transparency). Safe
   monads include the monads State, Reader, Writer, Maybe and
   combinations of their corresponding monad transformers.

-}
module Control.Monad.ST.Trans(
      -- * The ST Monad Transformer
      STT,
      runST,
      -- * Mutable references
      STRef,
      newSTRef,
      readSTRef,
      writeSTRef,
      -- * Mutable arrays
      {-
      STArray,
      newSTArray,
      readSTArray,
      writeSTArray,
      boundsSTArray,
      numElementsSTArray,
      freezeSTArray,
      thawSTArray,
      runSTArray,
      -}
      -- * Unsafe Operations
      unsafeIOToST,
      unsafeSTToIO,
      unsafeSTRefToIORef,
      unsafeIORefToSTRef
      )where

import GHC.Base
import GHC.Arr (Ix(..), safeRangeSize, safeIndex,
                Array(..), arrEleBottom)

import Control.Monad.Fix
import Control.Monad.Trans
import Control.Monad.Error.Class
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Writer.Class

import Control.Applicative

import Data.IORef

import Unsafe.Coerce
import System.IO.Unsafe


-- | 'STT' is the monad transformer providing polymorphic updateable references
newtype STT s m a = STT {  unSTT :: forall r . State# s -> (a -> State# s -> m r) -> m r }

instance Monad (STT s m) where
  return a = STT $ \st next -> next a st
  m >>=  f = STT $ \st next ->
     unSTT m st $ \x st' ->
       unSTT (f x) st' next

instance MonadTrans (STT s) where
  lift m = STT $ \st next -> do
    a <- m
    next a st


instance Functor (STT s m) where
  fmap f p = STT $ \s# next -> unSTT p s# (next . f)

-- | Mutable references
data STRef s a = STRef (MutVar# s a)

-- | Create a new reference

newSTRef :: a -> STT s m (STRef s a)
newSTRef init = STT $ \st1 f -> case newMutVar# init st1 of
  (# st2, var #) -> f (STRef var) st2

-- | Reads the value of a reference
readSTRef :: STRef s a  -> STT s m a
readSTRef (STRef var) = STT $ \st1 f -> case readMutVar# var st1 of
  (# st2, a #) -> f a st2

-- | Modifies the value of a reference
writeSTRef :: STRef s a -> a -> STT s m ()
writeSTRef (STRef var) a = STT $ \st1 f -> case writeMutVar# var a st1 of
  st2 -> f () st2

instance Eq (STRef s a) where
  STRef v1 == STRef v2 = sameMutVar# v1 v2

-- | Executes a computation in the 'STT' monad transformer
runST :: Monad m => (forall s. STT s m a) -> m a
runST m = unSTT m realWorld# (\a _ -> return a)

{-# NOINLINE unsafeIOToST #-}
unsafeIOToST :: IO a -> STT s m a
unsafeIOToST m = return $! unsafePerformIO m

unsafeSTToIO :: STT s IO a -> IO a
unsafeSTToIO m = runST $ unsafeCoerce m

-- This should work, as STRef and IORef should have identical internal representation
unsafeSTRefToIORef  :: STRef s a -> IORef a
unsafeSTRefToIORef ref = unsafeCoerce ref

unsafeIORefToSTRef :: IORef a -> STRef s a
unsafeIORefToSTRef ref = unsafeCoerce ref