1{-# LANGUAGE RankNTypes #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Data.Array.ST
5-- Copyright   :  (c) The University of Glasgow 2001
6-- License     :  BSD-style (see the file libraries/base/LICENSE)
7--
8-- Maintainer  :  libraries@haskell.org
9-- Stability   :  experimental
10-- Portability :  non-portable (uses Data.Array.MArray)
11--
12-- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad.
13--
14-----------------------------------------------------------------------------
15
16module Data.Array.ST (
17   -- * Boxed arrays
18   STArray,             -- instance of: Eq, MArray
19   runSTArray,
20
21   -- * Unboxed arrays
22   STUArray,            -- instance of: Eq, MArray
23   runSTUArray,
24
25   -- * Overloaded mutable array interface
26   module Data.Array.MArray,
27 ) where
28
29import Data.Array.Base  ( STUArray, UArray, unsafeFreezeSTUArray )
30import Data.Array.MArray
31import Control.Monad.ST ( ST, runST )
32
33import GHC.Arr          ( STArray, Array, unsafeFreezeSTArray )
34
35-- | A safe way to create and work with a mutable array before returning an
36-- immutable array for later perusal.  This function avoids copying
37-- the array before returning it - it uses 'unsafeFreeze' internally, but
38-- this wrapper is a safe interface to that function.
39--
40runSTArray :: (forall s . ST s (STArray s i e)) -> Array i e
41runSTArray st = runST (st >>= unsafeFreezeSTArray)
42
43-- | A safe way to create and work with an unboxed mutable array before
44-- returning an immutable array for later perusal.  This function
45-- avoids copying the array before returning it - it uses
46-- 'unsafeFreeze' internally, but this wrapper is a safe interface to
47-- that function.
48--
49runSTUArray :: (forall s . ST s (STUArray s i e)) -> UArray i e
50runSTUArray st = runST (st >>= unsafeFreezeSTUArray)
51
52
53-- INTERESTING... this is the type we'd like to give to runSTUArray:
54--
55-- runSTUArray :: (Ix i, IArray UArray e,
56--              forall s. MArray (STUArray s) e (ST s))
57--         => (forall s . ST s (STUArray s i e))
58--         -> UArray i e
59--
60-- Note the quantified constraint.  We dodged the problem by using
61-- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but
62-- this essentially constrains us to a single unsafeFreeze for all STUArrays
63-- (in theory we might have a different one for certain element types).
64