Hello, to get a better understanding I tried to get the code from 'Lazy Functional State Thread' to work. But I encounter some error messages that I don't fully understand.
module Lfs where
import PrelGHC import GlaExts import ST import qualified MArray import qualified Array
newArr = newSTArray readArr = readSTArray writeArr = writeSTArray -- Error: Ambiguous type variable(s) `ix' in the constraint `Ix ix' freezeArr = freezeSTArray
thenST_ a b = a `thenST` \_ -> b
accumArray bnds f z ivs = runST (newArr bnds z `thenST` \a -> fill a f ivs `thenST_` freezeArr a)
fill a f [] = returnST () fill a f ((i,v):ivs) = readArr a i `thenST` \x -> writeArr a i (f x v) `thenST_` fill a f ivs
-- in GlaExts: seqST = (>>) seqST2 = foldr thenST_ (returnST ())
accumArray2 bnds f z ivs = runST (newArr bnds z `thenST` \a -> seqST2 (map (update a f) ivs) `thenST_` freezeArr a)
update a f (i,v) = readArr a i `thenST` \x -> writeArr a i (f x v)
putString [] = returnST () -- Error: Couldn't match `ST s a' against `IO ()' putString (c:cs) = putChar c `thenST_` putString cs
-- Error: Couldn't match `ST s a' against `[b]' putString2 cs = seqST (map putChar cs)
main = putStrLn "Hello, world"
How to change the code to get it to work? Why is there a different definition of seqST in GlaExts? Best regards, Thomas PS: When I change the definition of the mutable Array to
newArr = MArray.newArray readArr = MArray.readArray writeArr = MArray.writeArray freezeArr = MArray.freeze
I get Error in accumArray and accumArray2. I guess this is because of the fact that a STArray is only one possible MArray and there are other possiblities, right?