Array

module  Array ( 
    module Ix,  -- export all of Ix for convenience
    Array, array, listArray, (!), bounds, indices, elems, assocs, 
    accumArray, (//), accum, ixmap ) where

import Prelude
import Ix
import List(sortBy)
import qualified Array0 as A0

infixl 9  !, //

data Array i e = MkArray (i,i) (A0.Array e)

array       :: Ix i => (i,i) -> [(i,e)] -> Array i e
array b ivs
  | map fst ivs==range b = MkArray b (A0.listArray (map snd ivs))
  | and [inRange b i | (i,_) <- ivs] = MkArray b (A0.listArray es)
  | otherwise = error "Array.array: out-of-range array association"
  where ivs' = sortIx [(index b i,v)|(i,v)<-ivs]
        es = f 0 ivs'
        n = rangeSize b
        u = error "Array.!: undefined array element"
        m = error "Array.!: multiply defined array element"
        f i [] = if i==n then [] else if i<n then u:f (i+1) [] else m
        f i ivs0@((j,v):ivs) =
          case compare i j of
            LT -> u:f (i+1) ivs0
            EQ -> case span ((==i).fst) ivs of
                    ([],_) -> v:f (i+1) ivs
                    (_,ivs') -> m:f (i+1) ivs'
            GT -> f i ivs -- impossible

sortIx ivs = sortBy cmpFst ivs
cmpFst (i1,_) (i2,_) = compare i1 i2

listArray             :: Ix i => (i,i) -> [e] -> Array i e
listArray b vs = MkArray b a0
  where
    a0 = A0.listArray (take n vs)
    n = rangeSize b
    -- a0 might be shorter than n, which is ok, but you might get an
    -- "Array0.!: index out of bounds" error when you would expect an
    -- "Array.!: undefined array element" error.


(!)                   :: Ix a => Array a b -> a -> b
MkArray b a0 ! i      =  if inRange b i
	       	      	 then a0 A0.! (index b i)
			 else error "Array.!: index out of bounds"

bounds                :: Ix a => Array a b -> (a,a)
bounds (MkArray b _)  =  b

indices               :: Ix a => Array a b -> [a]
indices               =  range . bounds

elems                 :: Ix a => Array a b -> [b]
elems (MkArray b a0)  =  elems0 b a0

elems0 b a0 = [a0 A0.! i | i <- [0..rangeSize b-1]]

assocs                :: Ix a => Array a b -> [(a,b)]
assocs a              =  [(i, a!i) | i <- indices a]

(//)                  :: Ix a => Array a b -> [(a,b)] -> Array a b
a // us               =  listArray b (complete (range b) (sortIx us))
  where
    b = bounds a

    complete is0@(i:is) ivs0@((i',v):ivs) =
      case compare i i' of
        LT -> (a!i):complete is ivs0
        EQ -> v:complete is ivs
        GT -> complete is0 ivs -- hmm
    complete is _ = [a!i|i<-is]

accum                 :: Ix a => (b -> c -> b) -> Array a b -> [(a,c)]
                                   -> Array a b
accum f a ivs         =  a // [(i,f (a!i) v)|(i,v)<-ivs]

accumArray            :: Ix a => (b -> c -> b) -> b -> (a,a) -> [(a,c)]
                                   -> Array a b
accumArray f z b      =  accum f (array b [(i,z) | i <- range b])

ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c
                                         -> Array a c
ixmap b f a           = array b [(i, a ! f i) | i <- range b]

instance  Ix a          => Functor (Array a) where
    fmap fn (MkArray b a0) =  MkArray b (A0.listArray (map fn (elems0 b a0)))

instance  (Ix a, Eq b)  => Eq (Array a b)  where
    a == a'             =  assocs a == assocs a'

instance  (Ix a, Ord b) => Ord (Array a b)  where
    a <=  a'            =  assocs a <=  assocs a'

instance  (Ix a, Show a, Show b) => Show (Array a b)  where
    showsPrec p a = showParen (p > 9) (
                    showString "array " .
                    shows (bounds a) . showChar ' ' .
                    shows (assocs a)                  )

instance  (Ix a, Read a, Read b) => Read (Array a b)  where
    readsPrec p = readParen (p > 9)
           (\r -> [(array b as, u) | ("array",s) <- lex r,
                                     (b,t)       <- reads s,
                                     (as,u)      <- reads t   ])