<div dir="ltr"><div><div>Hi,<br></div>I have stumbled upon the Control-Monad-ST2 package by Kevin Backhouse, I have decided to expand the code with a run function and replace IO with ST s; and as of now I have removed the functions working on arrays and conversion to IO for the sake of simplicity. Here is the code in its modified form with newtype wrappers removed:<br><br><div style="margin-left:40px">{-# LANGUAGE RankNTypes #-}<br>{-# LANGUAGE DeriveFunctor #-}<br>-- Copyright 2013 Kevin Backhouse.<br>-- Copyright 2017 Timotej Tomandl. Modifications<br><br>import Data.STRef<br>import <a href="http://Control.Monad.ST">Control.Monad.ST</a><br>import Control.Applicative<br>import Control.Monad<br><br>newtype ST2 r w s a = ST2 { unwrapST2 :: ST s a }<br>    deriving (Functor)<br>instance Monad (ST2 r w s) where<br>  return x = ST2 $ return x<br>  (ST2 m) >>= f = ST2 $ do<br>        x <- m<br>        unwrapST2 (f x)<br>instance Applicative (ST2 r w s) where<br>  pure = return<br>  (<*>) = ap<br><br>-- | This function checks that the sub-computation is polymorphic in<br>-- both type parameters. This means that the sub-computation does not<br>-- read or write any state from the enclosing context.<br>{-# INLINE pureST2 #-}<br>pureST2 :: (forall r w. ST2 r w s a) -> ST2 r' w' s a<br>pureST2 m = m<br><br>-- | This function checks that the computation is polymorphic in<br>-- both parameters and then returns a pure value<br>{-# INLINE runST2 #-}<br>runST2 :: (forall r w s. ST2 r w s a) -> a<br>runST2 m=runST $ unwrapST2 m<br><br>-- | This function checks that the sub-computation is polymorphic in<br>-- the @w@ type parameter. This means that the sub-computation does<br>-- not write any state from the enclosing context (but read-only<br>-- operations are permitted).<br>{-# inline readOnlyST2 #-}<br>readOnlyST2 :: (forall w. ST2 r w s a) -> ST2 r w' s a<br>readOnlyST2 m = m<br><br>-- | Mutable reference. 'ST2Ref' is actually just a newtype of an<br>-- 'STRef', but the @r@ and @w@ type parameters allow the read and<br>-- write dependencies to be tracked by the type system.<br>newtype ST2Ref r w s a = ST2Ref (STRef s a)<br><br>-- | Create a new reference. The @r@ and @w@ type parameters of the<br>-- reference are unified with the 'ST2' monad to indicate that new<br>-- state is created in the enclosing context.<br>{-# INLINE newST2Ref #-}<br>newST2Ref :: a -> ST2 r w s (ST2Ref r w s a)<br>newST2Ref x = ST2 $ do<br>    r <- newSTRef x >>= \ var -> return var<br>    return (ST2Ref r)<br><br>-- | Read a reference. The @w@ type parameter of the reference is not<br>-- unified with the 'ST2' monad to indicate that this access is<br>-- read-only.<br>{-# INLINE readST2Ref #-}<br>readST2Ref :: ST2Ref r w s a -> ST2 r w' s a<br>readST2Ref (ST2Ref r) = ST2 $ readSTRef r<br><br>-- | Write to a reference. The @w@ type parameter of the reference is<br>-- unified with the 'ST2' monad to indicate that state is written in<br>-- the enclosing context.<br>{-# INLINE writeST2Ref #-}<br>writeST2Ref :: ST2Ref r w s a -> a -> ST2 r w s ()<br>writeST2Ref (ST2Ref r) x = ST2 $ writeSTRef r x<br><br>-- | Modify a reference.<br>{-# INLINE modifyST2Ref #-}<br>modifyST2Ref :: ST2Ref r w s a -> (a -> a) -> ST2 r w s ()<br>modifyST2Ref (ST2Ref r) f = ST2 $ modifySTRef r f<br></div><br></div><div>But as you can see, now all my types got tainted by s even though sharing the same r or w implies sharing the same s. Is there a way how to hide s from the type signatures, but still preserve an ability to write runST2 without resorting to IO/RealWorld? I have tried writing such a function and failed.<br></div><div><br>Timotej Tomandl<br></div></div>