ghc/lib/required/Array.hs

   1 module  Array (
   2     module Ix,  -- export all of Ix
   3     Array, array, listArray, (!), bounds, indices, elems, assocs,
   4     accumArray, (//), accum, amap, ixmap ) where
   5 import Ix
   6 import List((\\))
   7 import GHCbase
   8
   9 -- Report note:
  10 -- This module specifies the semantics of arrays only: it is not
  11 -- intended as an efficient implementation.
  12
  13 infixl 9  !, //
  14
  15 --Report:data  (Ix a)    => Array a b = MkArray (a,a) (a -> b) deriving ()
  16 -- in GHCbase:
  17 -- data Ix ix => Array ix elt = Array (ix, ix) (Array# elt)
  18
  19 --type IPr = (Int, Int)
  20
  21 {-# GENERATE_SPECS array a{~,Int,IPr} b{} #-}
  22 array                 :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
  23
  24 {-# GENERATE_SPECS listArray a{~,Int,IPr} b{} #-}
  25 listArray             :: (Ix a) => (a,a) -> [b] -> Array a b
  26
  27 {-# GENERATE_SPECS (!) a{~,Int,IPr} b{} #-}
  28 (!)                   :: (Ix a) => Array a b -> a -> b
  29
  30 bounds                :: (Ix a) => Array a b -> (a,a)
  31
  32 {-# GENERATE_SPECS indices a{~,Int,IPr} b{} #-}
  33 indices               :: (Ix a) => Array a b -> [a]
  34
  35 {-# GENERATE_SPECS elems a{~,Int,IPr} b{} #-}
  36 elems                 :: (Ix a) => Array a b -> [b]
  37
  38 {-# GENERATE_SPECS assocs a{~,Int,IPr} b{} #-}
  39 assocs                :: (Ix a) => Array a b -> [(a,b)]
  40
  41 {-# GENERATE_SPECS (//) a{~,Int,IPr} b{} #-}
  42 (//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
  43
  44 {-# GENERATE_SPECS accum a{~,Int,IPr} b{} c{} #-}
  45 accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
  46
  47 {-# GENERATE_SPECS accumArray a{~,Int,IPr} b{} c{} #-}
  48 accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
  49
  50 {-# GENERATE_SPECS amap a{~,Int,IPr} b{} c{} #-}
  51 amap                  :: (Ix a) => (b -> c) -> Array a b -> Array a c
  52
  53 ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
  54
  55 -----------------------------------------------------------------------
  56 {- "array", "!" and "bounds" are basic;
  57    the rest can be defined in terms of them
  58 -}
  59
  60 bounds (Array b _)  = b
  61
  62 (Array bounds arr#) ! i
  63   = let n# = case (index bounds i) of { I# x -> x } -- index fails if out of range
  64     in
  65     case (indexArray# arr# n#) of
  66       Lift v -> v
  67
  68 #ifdef USE_FOLDR_BUILD
  69 {-# INLINE array #-}
  70 #endif
  71 array ixs@(ix_start, ix_end) ivs =
  72    runST ( ST $ \ s ->
  73         case (newArray ixs arrEleBottom)        of { ST new_array_thing ->
  74         case (new_array_thing s)                of { (arr@(MutableArray _ arr#),s) ->
  75         let
  76          fill_one_in (S# s#) (i, v)
  77              = case index ixs  i                of { I# n# ->
  78                case writeArray# arr# n# v s#    of { s2#   ->
  79                S# s2# }}
  80         in
  81         case (foldl fill_one_in s ivs)          of { s@(S# _) ->
  82         case (freezeArray arr)                  of { ST freeze_array_thing ->
  83         freeze_array_thing s }}}})
  84
  85 arrEleBottom = error "(Array.!): undefined array element"
  86
  87 fill_it_in :: Ix ix => MutableArray s ix elt -> [(ix, elt)] -> ST s ()
  88 fill_it_in arr lst
  89   = foldr fill_one_in (returnStrictlyST ()) lst
  90   where  -- **** STRICT **** (but that's OK...)
  91     fill_one_in (i, v) rst
  92       = writeArray arr i v `seqStrictlyST` rst
  93
  94 -----------------------------------------------------------------------
  95 -- these also go better with magic: (//), accum, accumArray
  96
  97 old_array // ivs
  98   = runST (
  99         -- copy the old array:
 100         thawArray old_array                 `thenStrictlyST` \ arr# ->
 101         -- now write the new elements into the new array:
 102         fill_it_in arr# ivs                 `seqStrictlyST`
 103         freezeArray arr#
 104     )
 105   where
 106     bottom = error "(Array.//): error in copying old array\n"
 107
 108 zap_with_f :: Ix ix => (elt -> elt2 -> elt) -> MutableArray s ix elt -> [(ix,elt2)] -> ST s ()
 109 -- zap_with_f: reads an elem out first, then uses "f" on that and the new value
 110
 111 zap_with_f f arr lst
 112   = foldr zap_one (returnStrictlyST ()) lst
 113   where
 114     zap_one (i, new_v) rst
 115       = readArray  arr i                 `thenStrictlyST`  \ old_v ->
 116         writeArray arr i (f old_v new_v) `seqStrictlyST`
 117         rst
 118
 119 accum f arr ivs
 120   = runST (
 121         -- copy the old array:
 122         newArray (bounds arr) bottom    >>= \ arr# ->
 123         fill_it_in arr# (assocs arr)    >>
 124
 125         -- now zap the elements in question with "f":
 126         zap_with_f f arr# ivs           >>
 127         freezeArray arr#
 128     )
 129   where
 130     bottom = error "Array.accum: error in copying old array\n"
 131
 132 accumArray f zero ixs ivs
 133   = runST (
 134         newArray ixs zero       >>= \ arr# ->
 135         zap_with_f f  arr# ivs  >>
 136         freezeArray arr#
 137     )
 138
 139 -----------------------------------------------------------------------
 140
 141 listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
 142
 143 #ifdef USE_FOLDR_BUILD
 144 {-# INLINE indices #-}
 145 {-# INLINE elems #-}
 146 {-# INLINE assocs #-}
 147 #endif
 148
 149 indices               =  range . bounds
 150
 151 elems a               =  [a!i | i <- indices a]
 152
 153 assocs a              =  [(i, a!i) | i <- indices a]
 154
 155 amap f a              =  array b [(i, f (a!i)) | i <- range b]
 156                          where b = bounds a
 157
 158 ixmap b f a           =  array b [(i, a ! f i) | i <- range b]