[Haskell-cafe] Trouble with the ST monad
Ross Mellgren
rmm-haskell at z.odi.ac
Mon Dec 29 14:19:33 EST 2008
(I'm kinda a newbie, take my explanation with a grain of salt:)
The problem is that you're trying to take a STMatrix from some other
ST computation and freeze it in a new ST computation. The isolation
between separate computations is done via the rank-2 type variable "s"
in all those ST functions.
Instead of this:
freezeMatrix :: forall s. STMatrix s a -> Matrix a
freezeMatrix = runST . freezeMatrix -- does not unify
runST :: (forall s. ST s a) -> a
Which is trying to unify the type variable "s" from the STMatrix you
pass in with the explicitly polymorphic "s" in runST -- Note the
parentheses -- these are different "s"s and cannot be unified
Try this:
freezeMatrix :: (forall s . STMatrix s a) -> Matrix a
freezeMatrix f :: runST (freezeMatrix f)
Also, instead of using an array of arrays, maybe an array with (Int,
Int) as the Ix might be a bit smoother?
-Ross
Here is a working version:
{-# LANGUAGE Rank2Types #-}
import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
data STMatrix s a = STMatrix
{ stm_elements :: Array Int (STArray s Int a)
, stm_nrows :: Int
, stm_ncols :: Int
}
data Matrix a = Matrix
{ m_elements :: Array Int (Array Int a)
, m_nrows :: Int
, m_ncols :: Int
}
listMatrix :: (Int, Int) -> [Array Int a] -> Matrix a
listMatrix (n,m) rs = Matrix { m_elements = listArray (0, length rs -
1) rs
, m_nrows = m
, m_ncols = n }
doFreeze :: STMatrix s a -> ST s (Matrix a)
doFreeze mat = do
let m = stm_nrows mat
n = stm_ncols mat
rows <- foldM (freezeRow mat) [] [m-1,m-2..0]
return $ listMatrix (m, n) rows
where
freezeRow mat rs i = do
r <- unsafeFreeze (stm_elements mat ! i)
return (r:rs)
freezeMatrix :: (forall s. STMatrix s a) -> Matrix a
freezeMatrix f = runST (doFreeze f)
On Dec 29, 2008, at 1:57 PM, Andre Nathan wrote:
> On Sun, 2008-12-21 at 16:47 -0800, Ryan Ingram wrote:
>> The problem is that you are trying to return a mutable array out of
>> an
>> ST computation. This lets the "mutability" of the computation
>> escape.
>> That's what the "s" type variable is for; without it, runST is just
>> unsafePerformIO.
>
> I'm trying something similar now... I have defined a data type for
> mutable matrices as
>
> data STMatrix s a = STMatrix
> { elements :: Array Int (STArray s Int a)
> , nrows :: Int
> , ncols :: Int
> }
>
> and one for immutable matrices:
>
> data Matrix a = Matrix
> { elements :: Array Int (Array int a)
> , nrows :: Int
> , ncols :: Int
> }
>
> What I wanted was a way to freeze an STMatrix into a Matrix so that I
> could work with it out of the ST monad after doing all of the
> modifications I need on the elements.
>
> I came up with the following:
>
> doFreeze :: STMatrix s a -> ST s (Matrix a)
> doFreeze mat = do
> let m = nrows mat
> n = ncols mat
> rows <- foldM (freezeRow mat) [] [m-1,m-2..0]
> return $ listMatrix (m, n) rows
> where
> freezeRow mat rs i = do
> r <- unsafeFreeze (elements mat ! i)
> return (r:rs)
>
> where "listMatrix" builds a Matrix from a list of Arrays.
>
> However, when I this:
>
> freezeMatrix = runST . doFreeze
>
> I get the "less polymorphic than expected" error from ghc. I fail to
> see
> why though. Since "freezeRow" returns a list of immutable Arrays,
> where
> is the mutability of the computation escaping here?
>
> Thanks in advance,
> Andre
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list