ghc/interpreter/library/Array.hs

   1 #ifdef HEAD
   2 module  Array (
   3     module Ix,  -- export all of Ix
   4     Array, array, listArray, (!), bounds, indices, elems, assocs,
   5     accumArray, (//), accum, ixmap ) where
   6
   7 import Ix
   8 #if STD_PRELUDE
   9 import List( (\\) )
  10
  11 infixl 9  !, //
  12 #else
  13 import PreludeBuiltin
  14 #endif
  15 #endif /* HEAD */
  16 #ifdef BODY
  17
  18 #if STD_PRELUDE
  19 data Array a b = MkArray (a,a) (a -> b) deriving ()
  20
  21 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  22 array b ivs =
  23     if and [inRange b i | (i,_) <- ivs]
  24         then MkArray b
  25                      (\j -> case [v | (i,v) <- ivs, i == j] of
  26                             [v]   -> v
  27                             []    -> error "Array.!: \
  28                                            \undefined array element"
  29                             _     -> error "Array.!: \
  30                                            \multiply defined array element")
  31         else error "Array.array: out-of-range array association"
  32
  33 listArray             :: (Ix a) => (a,a) -> [b] -> Array a b
  34 listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
  35
  36 (!)                   :: (Ix a) => Array a b -> a -> b
  37 (!) (MkArray _ f)     =  f
  38
  39 bounds                :: (Ix a) => Array a b -> (a,a)
  40 bounds (MkArray b _)  =  b
  41
  42 indices               :: (Ix a) => Array a b -> [a]
  43 indices               =  range . bounds
  44
  45 elems                 :: (Ix a) => Array a b -> [b]
  46 elems a               =  [a!i | i <- indices a]
  47
  48 assocs                :: (Ix a) => Array a b -> [(a,b)]
  49 assocs a              =  [(i, a!i) | i <- indices a]
  50
  51 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  52 a // us               =  array (bounds a)
  53                             ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]]
  54                              ++ us)
  55
  56 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]
  57                                    -> Array a b
  58 accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])
  59
  60 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]
  61                                    -> Array a b
  62 accumArray f z b      =  accum f (array b [(i,z) | i <- range b])
  63
  64 ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c
  65                                          -> Array a c
  66 ixmap b f a           = array b [(i, a ! f i) | i <- range b]
  67
  68 instance  (Ix a)         => Functor (Array a) where
  69     map fn (MkArray b f) =  MkArray b (fn . f)
  70
  71 #else /* STD_PRELUDE */
  72
  73 data Ix ix => Array ix elt              = Array            (ix,ix) (PrimArray elt)
  74 data Ix ix => ByteArray ix              = ByteArray        (ix,ix) PrimByteArray
  75 data Ix ix => MutableArray     s ix elt = MutableArray     (ix,ix) (PrimMutableArray s elt)
  76 data Ix ix => MutableByteArray s ix     = MutableByteArray (ix,ix) (PrimMutableByteArray s)
  77
  78 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  79 array ixs@(ix_start, ix_end) ivs = runST (do
  80   { mut_arr <- primNewArray (rangeSize ixs) arrEleBottom
  81   ; mapM_ (\ (i,v) -> primWriteArray mut_arr (index ixs i) v) ivs
  82   ; arr <- primUnsafeFreezeArray mut_arr
  83   ; return (Array ixs arr)
  84   }
  85   )
  86  where
  87   arrEleBottom = error "(Array.!): undefined array element"
  88
  89 listArray             :: (Ix a) => (a,a) -> [b] -> Array a b
  90 listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
  91
  92 (!)                   :: (Ix a) => Array a b -> a -> b
  93 (Array bounds arr) ! i = primIndexArray arr (index bounds i)
  94
  95 bounds                :: (Ix a) => Array a b -> (a,a)
  96 bounds (Array b _)    =  b
  97
  98 indices               :: (Ix a) => Array a b -> [a]
  99 indices               =  range . bounds
 100
 101 elems                 :: (Ix a) => Array a b -> [b]
 102 elems a               =  [a!i | i <- indices a]
 103
 104 assocs                :: (Ix a) => Array a b -> [(a,b)]
 105 assocs a              =  [(i, a!i) | i <- indices a]
 106
 107 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
 108 a // us               =  array (bounds a)
 109                             ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]]
 110                              ++ us)
 111
 112 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]
 113                                    -> Array a b
 114 accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])
 115
 116 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]
 117                                    -> Array a b
 118 accumArray f z b      =  accum f (array b [(i,z) | i <- range b])
 119
 120 ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c
 121                                          -> Array a c
 122 ixmap b f a           = array b [(i, a ! f i) | i <- range b]
 123
 124 instance  (Ix a)         => Functor (Array a)
 125
 126
 127 #endif /* STD_PRELUDE */
 128
 129 #ifdef PROVIDE_ARRAY
 130 data PrimArray              a -- immutable arrays with Int indices
 131 data PrimByteArray
 132
 133 data Ref                  s a -- mutable variables
 134 data PrimMutableArray     s a -- mutable arrays with Int indices
 135 data PrimMutableByteArray s
 136
 137 ----------------------------------------------------------------
 138 -- pointer equality tests:
 139 ----------------------------------------------------------------
 140
 141 instance Eq (Ref s a)                where (==) = primSameRef
 142 instance Eq (PrimMutableArray s a)   where (==) = primSameMutableArray
 143
 144 instance Eq (PrimMutableByteArray s) where (==) = primSameMutableByteArray
 145
 146 instance (Ix ix) => Eq (MutableArray s ix elt) where
 147   MutableArray _ arr1 == MutableArray _ arr2 = arr1 == arr2
 148
 149 instance (Ix ix) => Eq (MutableByteArray s ix) where
 150   MutableByteArray _ arr1 == MutableByteArray _ arr2 = arr1 == arr2
 151
 152 #endif /* PROVIDE_ARRAYS */
 153
 154 instance  (Ix a, Eq b)  => Eq (Array a b)  where
 155     a == a'             =  assocs a == assocs a'
 156
 157 instance  (Ix a, Ord b) => Ord (Array a b)  where
 158     a <=  a'            =  assocs a <=  assocs a'
 159
 160 instance  (Ix a, Show a, Show b) => Show (Array a b)  where
 161     showsPrec p a = showParen (p > 9) (
 162                     showString "array " .
 163                     shows (bounds a) . showChar ' ' .
 164                     shows (assocs a)                  )
 165
 166 instance  (Ix a, Read a, Read b) => Read (Array a b)  where
 167     readsPrec p = readParen (p > 9)
 168            (\r -> [(array b as, u) | ("array",s) <- lex r,
 169                                      (b,t)       <- reads s,
 170                                      (as,u)      <- reads t   ])
 171 #endif /* BODY */