1 module Array (
2 module Ix, -- export all of Ix
3 Array, array, listArray, (!), bounds, indices, elems, assocs,
4 accumArray, (//), accum, ixmap ) where
6 import Ix
7 import List( (\\) )
9 infixl 9 !, //
11 data (Ix a) => Array a b = MkArray (a,a) (a -> b) deriving ()
13 array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
14 array b ivs =
15 if and [inRange b i | (i,_) <- ivs]
16 then MkArray b
17 (\j -> case [v | (i,v) <- ivs, i == j] of
18 [v] -> v
19 [] -> error "Array.!: \
20 \undefined array element"
21 _ -> error "Array.!: \
22 \multiply defined array element")
23 else error "Array.array: out-of-range array association"
25 listArray :: (Ix a) => (a,a) -> [b] -> Array a b
26 listArray b vs = array b (zipWith (\ a b -> (a,b)) (range b) vs)
28 (!) :: (Ix a) => Array a b -> a -> b
29 (!) (MkArray _ f) = f
31 bounds :: (Ix a) => Array a b -> (a,a)
32 bounds (MkArray b _) = b
34 indices :: (Ix a) => Array a b -> [a]
35 indices = range . bounds
37 elems :: (Ix a) => Array a b -> [b]
38 elems a = [a!i | i <- indices a]
40 assocs :: (Ix a) => Array a b -> [(a,b)]
41 assocs a = [(i, a!i) | i <- indices a]
43 (//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
44 a // new_ivs = array (bounds a) (old_ivs ++ new_ivs)
45 where
46 old_ivs = [(i,a!i) | i <- indices a,
47 i `notElem` new_is]
48 new_is = [i | (i,_) <- new_ivs]
50 accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]
51 -> Array a b
52 accum f = foldl (\a (i,v) -> a // [(i,f (a!i) v)])
54 accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]
55 -> Array a b
56 accumArray f z b = accum f (array b [(i,z) | i <- range b])
58 ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c
59 -> Array a c
60 ixmap b f a = array b [(i, a ! f i) | i <- range b]
62 instance (Ix a) => Functor (Array a) where
63 fmap fn (MkArray b f) = MkArray b (fn . f)
65 instance (Ix a, Eq b) => Eq (Array a b) where
66 a == a' = assocs a == assocs a'
68 instance (Ix a, Ord b) => Ord (Array a b) where
69 a <= a' = assocs a <= assocs a'
71 instance (Ix a, Show a, Show b) => Show (Array a b) where
72 showsPrec p a = showParen (p > arrPrec) (
73 showString "array " .
74 showsPrec (arrPrec+1) (bounds a) . showChar ' ' .
75 showsPrec (arrPrec+1) (assocs a) )