How does one delare a 2D STUArray in Haskell?

I see the following from a diffusion program segment:



module Diffusion where

import Data.Array
import Data.List (sortBy)

type VFieldElem = Float
type VField = Array (Int,Int) VFieldElem

<snip>

zeros = listArray ((1,1),(imax,jmax)) (repeat 0)



From Real World Haskell to declare a 1D array (I changed some of the
value names) there is the following:

import Data.Array.ST (STUArray)
import Data.Array.Unboxed (UArray)
import Data.Word (Word32)


data PlayingField1D a = PF1D {
    pf1DState  :: (a -> [Word32])
        , pf1DArray :: UArray Word32 Bool
    }


data MutPlayingField1D s a = MPF1D {
          mpf1DState :: (a -> [Word32])
        , mutpf1DArray :: STUArray s Word32 Bool
    }


But I cannot see how to declare a 2D array.

Although, it is not "strictly" necessary, pun intended, since one can
reframe the 1D array as 2D array by using row/column mapping
functions.




--
Regards,
Casey
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to