What do I have to do to make GHC accept this code:
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module STTest where
import Data.Array.ST
import Control.Monad.ST.Strict as S
import Control.Monad.ST.Lazy as L
-- ST monad arrays (unboxed in actual code)
type Arr s a = STArray s Int a
-- representing some algorithm that works on these STArrays
data ArrGen s a = ArrGen (a -> S.ST s (Arr s a)) (Arr s a -> S.ST s ())
-- class for some "generator"
class Generator g a where
gen :: g -> a -> [a]
instance Generator (ArrGen s a) a where
gen (ArrGen create apply) s = L.runST $ do
a <- strictToLazyST $ create s -- DOES NOT WORK
strictToLazyST $ apply a >> getElems a
The error I get is the following:
Couldn't match type `s' with `s1'
`s' is a rigid type variable bound by
the instance declaration at STTest.hs:20:28
`s1' is a rigid type variable bound by
a type expected by the context: L.ST s1 [a] at STTest.hs:21:33
However, this works fine:
data Dummy
create' :: a -> S.ST s (Arr s a)
create' = undefined
apply' :: Arr s a -> S.ST s [a]
apply' = undefined
instance Generator Dummy a where
gen _ s = L.runST $ do
a <- strictToLazyST $ create' s
strictToLazyST $ apply' a >> getElems a
Why does it work with the second and not the first? And what can I do with the data declaration to make it work? Or can I add some sort of "forall" on the instance declaration?
The above is just a minimal test program. I actually loop the apply forever to create an infinite Stream of the output values. (So I can't just merge the two steps together.) And I really want to be able to instantiate once for the ArrGen data type and then make a variety of values of it using these STArray algorithms.
EDIT:
Didn't think to put the forall inside the functions to ArrGen (I put it on the overall type). Though now I have the a problem of getting it to work on STUArray. Like if I use the following:
class (Integral a, Bits a, forall s. MArray (STUArray s) a (S.ST s)) => HasSTU a
type AC a = (HasSTU a) => forall s. a -> S.ST s (STUArray s Int a)
type AU a = (HasSTU a) => forall s. STUArray s Int a -> S.ST s ()
type TX a = (HasSTU a) => a -> a -- or without the context
data ArrayGen a = AG (AC a) (AU a) (TX a)
Then this fails:
instance (HasSTU a) => Generator (ArrayGen a) a [a] where
gens (AG c u p) s = fmap (fmap p) $ L.runST $ do
ar <- strictToLazyST $ (c s)
streamM $ strictToLazyST $ u ar >> getElems ar -- can't use getElems here!
streamM :: (Applicative f) => f a -> f (Stream a))
streamM = Cons <$> a <*> streamM a
It complains:
Could not deduce (MArray (STUArray s) a (S.ST s))
arising from a use of `getElems'
from the context (HasSTU a)
Even though the context (HasSTU a) says (in my mind) that there is an (MArray (STUArray s) a (S.ST s)) context for all s, it doesn't seem to think so. I tried to fix it by changing the (AU a) type:
type AU a = (HasSTU a) => forall s. STUArray s Int a -> S.ST s [a]
And it seems to type check, but I am unable to actually use it. Similarly if I change to:
class (Integral a, Bits a, forall s. MArray (STUArray s) a (S.ST s)) => HasSTU s a
type AC a = (forall s. HasSTU s a) => a -> S.ST s (STUArray s Int a)
...
instance (forall s. HasSTU s a) => Generator (ArrayGen a) a [a] where
...
instance forall s. HasSTU s Word32 -- !!!
But then when I try to run something:
Could not deduce (forall s. HasSTU s Word32)
I hate this s! Why? I have an instance for all s! And I am really lost as to where I should put my foralls and what's really going on.
The problem is that runST requires a forall s. ST s t argument, but your type fixes s, so a use of create and apply in the monadic action makes it unsuitable for runST.
It does not seem to me that your use case forbids giving ArrGen polymorphic (in s) arguments, so
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, RankNTypes #-}
module STTest where
import Data.Array.ST
import Control.Monad.ST.Strict as S
import Control.Monad.ST.Lazy as L
-- ST monad arrays (unboxed in actual code)
type Arr s a = STArray s Int a
-- representing some algorithm that works on these STArrays
data ArrGen a = ArrGen (forall s. a -> S.ST s (Arr s a)) (forall s. Arr s a -> S.ST s ())
-- class for some "generator"
class Generator g a where
gen :: g -> a -> [a]
instance Generator (ArrGen a) a where
gen (ArrGen create apply) s = L.runST $ do
a <- strictToLazyST $ create s -- DOES NOT WORK
strictToLazyST $ apply a >> getElems a
making the components polymorphic works (at least in the sense that it compiles, your use case may forbid this approach).
Why does it work with the second and not the first?
Because there, the s was not fixed, the computation is fully polymorphic in s, as required by runST.
Related
Consider the Haskell functions
test :: ST s [Int]
test = do
arr <- newListArray (0,9) [0..9] :: ST s (STArray s Int Int)
let f i = do writeArray arr i (2*i)
readArray arr i
forM [1,2] f
and
test' :: ST s [Int]
test' = do
arr <- newListArray (0,9) [0..9] :: ST s (STArray s Int Int)
let f = \i -> do writeArray arr i (2*i)
readArray arr i
forM [1,2] f
The first requires FlexibleContexts to compile on ghci 8.10.1, the second compiles with no extra options. Why?
An answer that explains this behaviour in terms of the scope of the type variable s would be especially welcome. As a follow up, what (if any) type signature can be added to the function f to make test compile without FlexibleContexts? Finally, is there a connection with the monomorphism restriction?
You can check which type GHC assigns to f in GHCi:
ghci> import Data.Array
ghci> import Data.Array.MArray
ghci> let arr :: STArray s Int Int; arr = undefined
ghci> :t \i -> do writeArray arr i (2*i); readArray arr i
\i -> do writeArray arr i (2*i); readArray arr i
:: (MArray (STArray s1) Int m, MArray (STArray s2) Int m) =>
Int -> m Int
This is more general than the type you suggest in your comments and the reason that FlexibleContexts are needed.
You can add the type signature you suggested (Int -> ST s Int) to avoid having to use FlexibleContexts:
{-# LANGUAGE ScopedTypeVariables #-}
...
test :: forall s. ST s [Int]
test = do
arr <- newListArray (0,9) [0..9] :: ST s (STArray s Int Int)
let
f :: Int -> ST s Int
f i = do
writeArray arr i (2*i)
readArray arr i
forM [1,2] f
Note that scoped type variables and the forall s. are necessary here because you need to make sure that the s in all the type signatures refer to the same type variable and do not all introduce new type variables.
The reason that the monomorphism restriction treats your first and your second version differently is because it doesn't apply to things that look like functions. In your first version f has an argument, so it looks like a function and therefore will get a general type. In your second version f doesn't have arguments, so it doesn't look like a function which means that the monomorphism restriction forces it to have a more specific type.
I have an Array r Ix2 a such that (Manifest r Ix2 a, Ord a). I'd like to sort this array on its innermost dimension - that is, sort each row internally, but not across rows. According to this, massiv doesn't have any sorting implemented at all. Would I have to roll my own, or can I re-use something that already exists for Vectors (such as vector-algorithms for example)?
Of course, it would be better to roll out your own sorting and submit a PR to massiv library ;) But there is a way to fall back onto vector-algorithms package. I was curious how I'd do it efficiently and here it is, along with automatic parallelization of sorting each row:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Examples.SortRows where
import Data.Massiv.Array as A
import Data.Massiv.Array.Manifest.Vector as A
import Data.Massiv.Core.Scheduler
import Data.Typeable
import Data.Vector.Algorithms.Merge
import Data.Vector.Generic as VG
import Data.Vector.Generic.Mutable as VGM
import System.IO.Unsafe
sortRows ::
forall r e v.
(Ord e, Typeable v, A.Mutable r Ix2 e, VG.Vector v e, ARepr v ~ r, VRepr r ~ v)
=> Array r Ix2 e
-> Array r Ix2 e
sortRows arr = unsafePerformIO $ do
mv :: VG.Mutable v RealWorld e <- VG.thaw (A.toVector arr :: v e)
let comp = getComp arr
sz#(m :. n) = size arr
case comp of
Seq -> do
loopM_ 0 (< m) (+ 1) $ \i -> sort $ VGM.slice (toLinearIndex sz (i :. 0)) n mv
ParOn wIds ->
withScheduler_ wIds $ \scheduler -> do
loopM_ 0 (< m) (+ 1) $ \i ->
scheduleWork scheduler $ sort $ VGM.slice (toLinearIndex sz (i :. 0)) n mv
v :: v e <- VG.unsafeFreeze mv
return $ A.fromVector comp sz v
I did add this to examples in massiv in this commit together with a simple property test.
I'm trying to write the Fisher-Yates shuffle using mutable arrays. So far, I have the following code:
module Main where
import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
fisherYates :: (MonadRandom m, PrimMonad m) => MV.MVector (PrimState m) a -> m ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- getRandomR (i, l)
MV.swap v i j)
where l = MV.length v - 1
shuffle :: MonadRandom m => V.Vector a -> m (V.Vector a)
shuffle v = _ -- don't know how to write this
main :: IO ()
main = print . evalRand (shuffle . V.generate 10 $ id) $ mkStdGen 42
However, I am totally unsure how to define shuffle, which is meant to be a 'high-level wrapper' around the mutable vector operations. It seems (at least from my understanding), that I first have to 'run' the random 'part' of the stack, save the state, run the ST 'part' to get out an immutable vector, and then rewrap the whole thing. Additionally, I know I have to make use of thaw somewhere, but my attempts are coming up short. Could someone please tell me what I'm missing, and how I can do what I want?
I have two suggestions for you:
Select the right monad nesting.
Separate out your monad implementation from the logic of the algorithm.
You are trying to run the random monad last and use the ST internally, thus you need the ST to be a sort of monad transformer. Decide what your monad stack looks like - which monad is the transformer and which is the inner monad? The easy thing to do is make the ST monad the inner monad and the random monad the transformer (easy just because you have all the needed packages already).
Now make a small set of helper functions. It won't really pay off here -
the payoff is large for complex projects. Here's the monad stack and helpers I came up with:
{-# LANGUAGE RankNTypes #-}
module Main where
import System.Random (StdGen)
import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
type KozM s a = RandT StdGen (ST s) a
Notice the transformer is RandT and the inner monad of ST s.
rnd :: (Int,Int) -> KozM s Int
rnd = getRandomR
swp :: MV.MVector s a -> Int -> Int -> KozM s ()
swp v i j = lift (MV.swap v i j)
freeze :: MV.MVector s a -> KozM s (V.Vector a)
thaw :: V.Vector a -> KozM s (MV.MVector s a)
freeze = lift . V.freeze
thaw = lift . V.thaw
All the operations you need to mutate the vector. Now we just need to run this monad so we can somehow escape to another useful context. I noticed you previously hard-coded an RNG (42) - I use a random one but whichever...
run :: (forall s. KozM s a) -> IO a -- Can be just `a` if you hard-code
-- an RNG as done in the question
run m = do g <- newStdGen
pure (runST (evalRandT m g))
Finally we can use this monad to implement f-y:
fisherYates :: MV.MVector s a -> KozM s ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- rnd (i, l)
swp v i j)
where l = MV.length v - 1
At this point you might not be feeling like you learned anything, hopefully the run function was helpful but I can see how you might feel this is getting verbose. The important thing to take note of here is how clean the rest of your code can be if you handle the plumbing of the monad above so you don't have lift and module qualifiers polluting the logic of the possibly complex thing you actually set-out to solve.
That said, here's the underwhelming shuffle:
shuffle :: V.Vector a -> KozM s (V.Vector a)
shuffle v = do
vm <- thaw v
fisherYates vm
freeze vm
The type is important. You had previously called evalRand on shuffle which implied it would be some sort of MonadRandom m and simultaneously have to call runST - a conflation of the monad logic and the algorithm logic that just hurts the brain.
The main is uninteresting:
main :: IO ()
main = print =<< (run (shuffle (V.generate 10 id)) :: IO (V.Vector Int))
EDIT: yes you can do this while keeping the methods more general. At some point you need to specify which monad you run or you can't have a main that will execute it, but all the logic can be general using MonadRandom and PrimMonad.
{-# LANGUAGE RankNTypes #-}
module Main where
import System.Random (StdGen)
import Control.Monad.Random
import Control.Monad.Primitive
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
type KozM s a = RandT StdGen (ST s) a
rnd :: MonadRandom m => (Int, Int) -> m Int
rnd = getRandomR
swp :: PrimMonad m => MV.MVector (PrimState m) a -> Int -> Int -> m ()
swp v i j = MV.swap v i j
-- freeze :: MV.MVector s a -> KozM s (V.Vector a)
-- thaw :: V.Vector a -> KozM s (MV.MVector s a)
freeze :: PrimMonad m => MV.MVector (PrimState m) a -> m (V.Vector a)
thaw :: PrimMonad m => V.Vector a -> m (MV.MVector (PrimState m) a)
freeze = V.freeze
thaw = V.thaw
-- Some monad libraries, like monadlib, have a generalized `run` class method.
-- This doesn't exist, to the best of my knowledge, for the intersection of ST
-- and mtl.
run :: (forall s. KozM s a) -> IO a -- Can be just `a` if you hard-code
-- an RNG as done in the question
run m = do g <- newStdGen
pure (runST (evalRandT m g))
-- fisherYates :: MV.MVector s a -> KozM s ()
fisherYates :: (MonadRandom m, PrimMonad m) => MV.MVector (PrimState m) a -> m ()
fisherYates v = forM_ [0 .. l - 1] (\i -> do j <- rnd (i, l)
swp v i j)
where l = MV.length v - 1
shuffle :: (MonadRandom m, PrimMonad m) => V.Vector a -> m (V.Vector a)
shuffle v = do
vm <- thaw v
fisherYates vm
freeze vm
main :: IO ()
main = print =<< (run (shuffle (V.generate 10 id)) :: IO (V.Vector Int))
A Pipe can be broken into two parts: the generator part (yield) and the consumer part (await).
If you have a Pipe that only uses it's generator half, and only returns () (or never returns), then it can be represented as a "ListT done right". It turns out that MonadPlus can be used to represent anything like ListT-done-right. Quoting Gabriel Gonzalez:
Note that you can build any ListT (not just the one in pipes) with only a transformers dependency. For example, here is how you would implement a ListT analog of Pipes.Prelude.stdinLn:
-- stdinLn :: ListT IO String
stdinLn :: (MonadTrans t, MonadPlus (t IO)) => t IO String
stdinLn = do
eof <- lift isEOF
if eof
then mzero
else do
str <- lift getLine
return str `mplus` stdinLn
That will type check as any ListT out there and do the right thing for all of them.
So my question is this: Is there a dual to ListT and to MonadPlus for the consumer portion of Pipes?
Requirements:
A pipe which never uses yield, and only returns () (or never returns), but does use await can be represented as this "dual to ListT".
The "dual to ListT" can be generalized to the "dual of MonadPlus"
I think the answer is not to dualize the "generator-like" type-class, but rather to extend it with a simple Category instance equivalent to the await/(>~) category of pipes.
Unfortunately, there is no way to arrange the type variables to make this satisfy all three type classes (MonadPlus, MonadTrans, and Category), so I will define a new type class:
{-# LANGUAGE KindSignatures #-}
import Control.Monad
import Control.Monad.Trans.Class
class Consumer (t :: * -> (* -> *) -> * -> *) where
await :: t a m a
(>~) :: t a m b -> t b m c -> t a m c
The laws for this type class are the category laws:
await >~ f = f
f >~ await = f
(f >~ g) >~ h = f >~ (g >~ h)
Then you can implement both Consumers and Pipes once you have this additional type class:
printer :: (Show a, Monad (t a IO), MonadTrans (t a), Consumer t) => t a IO r
printer = do
a <- await
lift (print a)
printer
{-
printer :: Show a => Consumer a IO r
printer = do
a <- await
lift (print a)
printer
-}
cat :: (MonadPlus (t a m), Consumer t) => t a m a
cat = await `mplus` cat
{-
cat :: Monad m => Pipe a a m r
cat = do
a <- await
yield a
cat
-}
debug :: (Show a, MonadPlus (t a IO), MonadTrans (t a), Consumer t) => t a IO a
debug = do
a <- await
lift (print a)
return a `mplus` debug
{-
debug :: Show a => Pipe a a IO r
debug = do
a <- await
lift (print a)
yield a
debug
-}
taker :: (Consumer t, MonadPlus (t a m)) => Int -> t a m a
taker 0 = mzero
taker n = do
a <- await
return a `mplus` taker (n - 1)
{-
taker :: Monad m => Int -> Pipe a a m ()
taker 0 = return ()
taker n = do
a <- await
yield a
taker (n - 1)
-}
The hard part is figuring out how to do this without adding a new type class to base. I'd prefer to reuse the original Category type class if possible, possibly having await and (>~) just be functions that wrap your type in a newtype, use the Category instance, and then unwrap it, but I'm still working out the specifics of how to do that.
Edit: I found the solution. Just define the following newtype:
{-# LANGUAGE KindSignatures, FlexibleContexts #-}
import Control.Category
import Prelude hiding ((.), id)
newtype Consumer t m a b = Consumer { unConsumer :: t a m b }
await :: Category (Consumer t m) => t a m a
await = unConsumer id
(>~) :: Category (Consumer t m) => t a m b -> t b m c -> t a m c
f >~ g = unConsumer (Consumer f >>> Consumer g)
Then any library can just implement a Category instance for their type wrapped in the Consumer newtype.
Then you would get a constraint like this any time you used await or (>~):
cat :: (MonadPlus (t a m), Category (Consumer t m)) => t a m a
cat = await `mplus` cat
let me call the function accumrArray.
accumrArray ::
(e' -> e -> e) An accumulating function
-> e A default element
-> (i, i) The bounds of the array
-> [(i, e')] List of associations
-> a i e The array
accumrArray (:) [] (1,2) [(1,1),(2,2),(2,3)] === array [(1,[1]), (2,[2,3])]
head $ (accumrArray (:) [] (1,1) [(1,x)|x<-[4..]]) ! 1 === 4
How strange... I wrote this function a few days ago for someone else. The function first appeared in LML (I believe), but never made it into the Haskell array library.
Here you go:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Array
import System.IO.Unsafe
import Data.IORef
import Data.Array.MArray
import Data.Array.Base
import Control.Monad
import Data.Array.IO
accumArrayR :: forall a e i. Ix i => (a -> e -> e) -> e -> (i,i) -> [(i,a)] -> Array i e
accumArrayR f e bounds#(l,u) assocs = unsafePerformIO $ do
ref <- newIORef assocs
arr <- newArray_ bounds
let _ = arr :: IOArray i e
let n = safeRangeSize (l,u)
let elem x = unsafePerformIO $ do
ass <- readIORef ref
let loop [] = writeIORef ref [] >> return e
loop ((y,a):rest) = do
let ix = safeIndex bounds n y
let r = f a (elem x)
unsafeWrite arr ix r
if (ix == x)
then writeIORef ref rest >> return r
else loop rest
loop ass
forM_ [0..n] $ \ix -> unsafeWrite arr ix (elem ix)
unsafeFreeze arr
A challenge for the reader: use accumArrayR to implement linear-time depth-first-search of a graph.
Edit I should mention that the function isn't thread-safe as written. Turning the IORef into an MVar would fix it, but there might be better ways.
Not the most efficient, but...
accumrArray f x b l = accumArray (flip f) x b (reverse l)
I would argue that
accumrArray f x b l = accumArray (flip f) x b (reverse l)
is indeed the best solution (credits to sclv's answer).
Its supposed "inefficiency" comes from fact that foldr applies the function f from right to left.
However, since accumArray is strict, l can never be infinite, otherwise the program would be incorrect. It would never terminate.
Therefore, foldl (flip f) is just as good as a foldr.