This program:
{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector as V
import Control.Monad.ST
import Control.Monad.Primitive
unsafeModify :: [(forall s . MV.MVector s Int -> ST s ())] -> V.Vector Int -> V.Vector Int
unsafeModify mods vec = runST $ do
mvec <- V.unsafeThaw vec
(mods !! 0) mvec
V.unsafeFreeze mvec
Compiles. This program:
{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector as V
import Control.Monad.ST
import Control.Monad.Primitive
unsafeModify :: [(forall s . MV.MVector s Int -> ST s ())] -> V.Vector Int -> V.Vector Int
unsafeModify mods vec = runST $ do
mvec <- V.unsafeThaw vec
($ mvec) (mods !! 0)
V.unsafeFreeze mvec
Does not compile with the following error:
Muts.hs:10:15:
Couldn't match type ‘forall s1. UV.MVector s1 Int -> ST s1 ()’
with ‘UV.MVector s Int -> ST s a0’
Expected type: [UV.MVector s Int -> ST s a0]
Actual type: [forall s. UV.MVector s Int -> ST s ()]
Relevant bindings include
mvec :: UV.MVector s Int (bound at Muts.hs:9:5)
In the first argument of ‘(!!)’, namely ‘mods’
In the first argument of ‘$ mvec’, namely ‘(mods !! 0)’
Why?
Note: This post is written in literate Haskell. You can save it as Unsafe.lhs and try it in your GHCi.
Let's compare the types of the different lines:
They aren't equivalent due to
$
's type:Whereas you would need something along
which isn't legal.
However, let's have a look at what you actually want to do.
Things got messy due to
unsafeModify
's polymorphic first argumentmods
. Your original typetells us it is a list of functions, where every function is polymorphic the parameter
s
, so every function could use anothers
. However, that's too much. It's fine if thes
gets shared throuhgout the whole list:After all, we want to use all functions in the same
ST
computation, therefore the type of the stream state tokens
can be the same. We end up withAnd now your code happily compiles, regardless of whether you use
($ mvec) (mods !! 0)
,(mods !! 0) mvec
ormapM_
, becauses
is now correctly fixed byrunST
throughout the whole list.