GHC and the Lazy Functional State Threads Paper

Marcin 'Qrczak' Kowalczyk qrczak@knm.org.pl
27 Apr 2001 21:57:19 GMT


Sat, 28 Apr 2001 00:13:48 +0200, Thomas Pasch <pasch@netzGeneration.com> pisze:

> > newArr = newSTArray
> > readArr = readSTArray
> > writeArr = writeSTArray
> > -- Error: Ambiguous type variable(s) `ix' in the constraint `Ix ix'   
> > freezeArr = freezeSTArray 

Monomorphism restriction strikes again. Constrained type variables
of variable bindings without type signatures get a single type.
Solution: add explicit type signatures:

newArr:: Ix i => (i,i) -> e -> ST s (STArray s i e)
newArr = newSTArray
readArr:: Ix i => STArray s i e -> i -> ST s e
readArr = readSTArray
writeArr:: Ix i => STArray s i e -> i -> e -> ST s ()
writeArr = writeSTArray
freezeArr:: Ix i => STArray s i e -> ST s (Array i e)
freezeArr = freezeSTArray

or (with ghc >= 5.00) compile with -fno-monomorphism-restriction.

Welcome to the club of people who think that the monomorphism
restriction should be removed.

> > putString [] = returnST ()
> > --  Error: Couldn't match `ST s a' against `IO ()' 
> > putString (c:cs) = putChar c `thenST_`
> > 		   putString cs

The 'Lazy Functional State Threads' paper was written a long time ago,
where monads were not a standard part of Haskell. I think that its IO
was a special case of ST, which is not true anymore. There are stToIO
and unsafeIOToST functions in module ST, but you should not really
perform IO from the ST monad.

> > -- Error: Couldn't match `ST s a' against `[b]'  
> > putString2 cs = seqST (map putChar cs)

Use seqST2, which is now available under the name sequence_ (works
for arbitrary monad; at the time where the paper was written it was
not even possible to define the Monad class, because it has a higher
order kind).

> Why is there a different definition of seqST in GlaExts?

Because it's newer than the paper - actually this module is already
obsolete:-)

For the ST monad you can use standard overloaded monadic functions
and operators: >>=, >>, return, sequence, sequence_, mapM, mapM_ etc.

> 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?

Right: nothing determines which mutable array type to use, and its
type doesn't appear in the result, so it's ambiguous. But it's not
the whole story. This is a really weird case.

The MArray class is defined over the array type, the monad, and the
element type. The element type is there because some arrays (namely
STUArray and IOUArray among these privided by ghc) are not fully
polymorphic wrt. the element type, but have different implementations
for different element types (and store element values unboxed instead
of under generic object pointers).

The ST and STArray types are parametrized by a dummy type variable,
and the runST function has a special type with forall in the argument.
This ensures that the result of a computation run by runST doesn't
depend on values which are mutable in this computation, i.e. that
mutable values don't escape their state thread, so separate state
threads are truly independent.

The result of accumArray is an immutable array. So it should be legal
to return it from a computation run by runST... Unfortunately it does
depend on the dummy type variable! It's because it requires that the
mutable array used to build the result accepts the given element type.

The MArray constraint applies to the element type and to the monad.
The monad type contains the dummy type variable. So although in
practice all MArray instances with ST s as the monad work for all
choices of s, the type of a general MArray constraint looks as if it
could place constraints on s, and such type is rejected by runST.

Fortunately you must resolve the mutable array type anyway. You can
choose STArray, which is fully polymorphic wrt. the element type
This causes the resulting type not depend on the dummy type variable:
an unusual case where the type inferred as the most general type
is not really most general!

So you can fix it for example by using a specialized version of
freezeArr inside accumArray, of type
    (Ix i, IArray a e) => STArray s i e -> ST s (a i e)
This will give quite general type of accumArray: arbitrary immutable
array from the IArray class.

If the immutable array type used was particularly UArray, it would
be more efficient to use the corresponding STUArray instead of
STArray, so freezing could just copy a memory block (there are magic
specializations in ghc's libraries for such case). But if the element
type was to remain generic, the type would have to be constrained
over STUArray: the compiler doesn't know that UArray and STUArray
are in practice defined for the same element types. The STUArray
type includes the dummy type variable, so it doesn't work in runST,
as explained above. Sorry.

-- 
 __("<  Marcin Kowalczyk * qrczak@knm.org.pl http://qrczak.ids.net.pl/
 \__/
  ^^                      SYGNATURA ZASTĘPCZA
QRCZAK