[Haskell] Data.Array.ST, polymorphism, and escaping type variables

Samuel J.J.Bronson naesten at gmail.com
Mon May 2 13:02:49 EDT 2005


I was trying to implement quicksort using Data.Array.ST. I can't find a typing
for qsortIndices in the following module:

<file name="STUArraySort.hs">
{-# OPTIONS_GHC -fglasgow-exts #-}

module STUArraySort where

import Control.Monad.ST

import Data.Array.IArray
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed

mkIndices (arr) = 
    (newListArray (bounds arr) (indices arr))
     
qsortIndices :: (Ord e, IArray a e, MArray (STUArray s) i  (ST s))
                => a i e -> UArray i i
qsortIndices arr = 
    runSTUArray $ 
    do mkIndices arr
</file>

When I try to load this in GHCi, I get a nasty type error -- I even get this if
I take out the type signature.

I noticed a comment in Data.Array.ST that looks quite related:

-- INTERESTING... this is the type we'd like to give to runSTUArray:
--
-- runSTUArray :: (Ix i, IArray UArray e, 
--	        forall s. MArray (STUArray s) e (ST s))
-- 	   => (forall s . ST s (STUArray s i e))
--	   -> UArray i e
--
-- Note the quantified constraint.  We dodged the problem by using
-- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but
-- this essentially constrains us to a single unsafeFreeze for all STUArrays
-- (in theory we might have a different one for certain element types).

In a similar vain, I think that the signature I want would be:

qsortIndices :: (Ord e, IArray a e, forall s. MArray (STUArray s) i  (ST s))
                => a i e -> UArray i i

Unfortunately, this is not even syntactically valid...

-- Thanks,
        Sam



More information about the Haskell mailing list