1{-# LANGUAGE 2 BangPatterns 3 , CPP 4 , RankNTypes 5 , MagicHash 6 , UnboxedTuples 7 , MultiParamTypeClasses 8 , FlexibleInstances 9 , FlexibleContexts 10 , UnliftedFFITypes 11 , RoleAnnotations 12 #-} 13{-# OPTIONS_HADDOCK hide #-} 14 15----------------------------------------------------------------------------- 16-- | 17-- Module : Data.Array.Base 18-- Copyright : (c) The University of Glasgow 2001 19-- License : BSD-style (see the file libraries/base/LICENSE) 20-- 21-- Maintainer : libraries@haskell.org 22-- Stability : experimental 23-- Portability : non-portable (MPTCs, uses Control.Monad.ST) 24-- 25-- Basis for IArray and MArray. Not intended for external consumption; 26-- use IArray or MArray instead. 27-- 28----------------------------------------------------------------------------- 29 30module Data.Array.Base where 31 32import Control.Monad.ST.Lazy ( strictToLazyST ) 33import qualified Control.Monad.ST.Lazy as Lazy (ST) 34import Data.Ix ( Ix, range, index, rangeSize ) 35import Foreign.C.Types 36import Foreign.StablePtr 37 38import Data.Char 39import GHC.Arr ( STArray ) 40import qualified GHC.Arr as Arr 41import qualified GHC.Arr as ArrST 42import GHC.ST ( ST(..), runST ) 43import GHC.Base ( IO(..), divInt# ) 44import GHC.Exts 45import GHC.Ptr ( nullPtr, nullFunPtr ) 46import GHC.Show ( appPrec ) 47import GHC.Stable ( StablePtr(..) ) 48import GHC.Read ( expectP, parens, Read(..) ) 49import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) 50import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) ) 51import GHC.IO ( stToIO ) 52import GHC.IOArray ( IOArray(..), 53 newIOArray, unsafeReadIOArray, unsafeWriteIOArray ) 54import Text.Read.Lex ( Lexeme(Ident) ) 55import Text.ParserCombinators.ReadPrec ( prec, ReadPrec, step ) 56 57#include "MachDeps.h" 58 59----------------------------------------------------------------------------- 60-- Class of immutable arrays 61 62{- | Class of immutable array types. 63 64An array type has the form @(a i e)@ where @a@ is the array type 65constructor (kind @* -> * -> *@), @i@ is the index type (a member of 66the class 'Ix'), and @e@ is the element type. The @IArray@ class is 67parameterised over both @a@ and @e@, so that instances specialised to 68certain element types can be defined. 69-} 70class IArray a e where 71 -- | Extracts the bounds of an immutable array 72 bounds :: Ix i => a i e -> (i,i) 73 numElements :: Ix i => a i e -> Int 74 unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e 75 unsafeAt :: Ix i => a i e -> Int -> e 76 unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e 77 unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e 78 unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e 79 80 unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze) 81 unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze) 82 unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze) 83 84{-# INLINE safeRangeSize #-} 85safeRangeSize :: Ix i => (i, i) -> Int 86safeRangeSize (l,u) = let r = rangeSize (l, u) 87 in if r < 0 then error "Negative range size" 88 else r 89 90{-# INLINE safeIndex #-} 91safeIndex :: Ix i => (i, i) -> Int -> i -> Int 92safeIndex (l,u) n i = let i' = index (l,u) i 93 in if (0 <= i') && (i' < n) 94 then i' 95 else error ("Error in array index; " ++ show i' ++ 96 " not in range [0.." ++ show n ++ ")") 97 98{-# INLINE unsafeReplaceST #-} 99unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e) 100unsafeReplaceST arr ies = do 101 marr <- thaw arr 102 sequence_ [unsafeWrite marr i e | (i, e) <- ies] 103 return marr 104 105{-# INLINE unsafeAccumST #-} 106unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e) 107unsafeAccumST f arr ies = do 108 marr <- thaw arr 109 sequence_ [do old <- unsafeRead marr i 110 unsafeWrite marr i (f old new) 111 | (i, new) <- ies] 112 return marr 113 114{-# INLINE unsafeAccumArrayST #-} 115unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e) 116unsafeAccumArrayST f e (l,u) ies = do 117 marr <- newArray (l,u) e 118 sequence_ [do old <- unsafeRead marr i 119 unsafeWrite marr i (f old new) 120 | (i, new) <- ies] 121 return marr 122 123 124{-# INLINE array #-} 125 126{-| Constructs an immutable array from a pair of bounds and a list of 127initial associations. 128 129The bounds are specified as a pair of the lowest and highest bounds in 130the array respectively. For example, a one-origin vector of length 10 131has bounds (1,10), and a one-origin 10 by 10 matrix has bounds 132((1,1),(10,10)). 133 134An association is a pair of the form @(i,x)@, which defines the value of 135the array at index @i@ to be @x@. The array is undefined if any index 136in the list is out of bounds. If any two associations in the list have 137the same index, the value at that index is implementation-dependent. 138(In GHC, the last value specified for that index is used. 139Other implementations will also do this for unboxed arrays, but Haskell 14098 requires that for 'Array' the value at such indices is bottom.) 141 142Because the indices must be checked for these errors, 'array' is 143strict in the bounds argument and in the indices of the association 144list. Whether @array@ is strict or non-strict in the elements depends 145on the array type: 'Data.Array.Array' is a non-strict array type, but 146all of the 'Data.Array.Unboxed.UArray' arrays are strict. Thus in a 147non-strict array, recurrences such as the following are possible: 148 149> a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]]) 150 151Not every index within the bounds of the array need appear in the 152association list, but the values associated with indices that do not 153appear will be undefined. 154 155If, in any dimension, the lower bound is greater than the upper bound, 156then the array is legal, but empty. Indexing an empty array always 157gives an array-bounds error, but 'bounds' still yields the bounds with 158which the array was constructed. 159-} 160array :: (IArray a e, Ix i) 161 => (i,i) -- ^ bounds of the array: (lowest,highest) 162 -> [(i, e)] -- ^ list of associations 163 -> a i e 164array (l,u) ies 165 = let n = safeRangeSize (l,u) 166 in unsafeArray (l,u) 167 [(safeIndex (l,u) n i, e) | (i, e) <- ies] 168 169-- Since unsafeFreeze is not guaranteed to be only a cast, we will 170-- use unsafeArray and zip instead of a specialized loop to implement 171-- listArray, unlike Array.listArray, even though it generates some 172-- unnecessary heap allocation. Will use the loop only when we have 173-- fast unsafeFreeze, namely for Array and UArray (well, they cover 174-- almost all cases). 175 176{-# INLINE [1] listArray #-} 177 178-- | Constructs an immutable array from a list of initial elements. 179-- The list gives the elements of the array in ascending order 180-- beginning with the lowest index. 181listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e 182listArray (l,u) es = 183 let n = safeRangeSize (l,u) 184 in unsafeArray (l,u) (zip [0 .. n - 1] es) 185 186{-# INLINE listArrayST #-} 187listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e) 188listArrayST (l,u) es = do 189 marr <- newArray_ (l,u) 190 let n = safeRangeSize (l,u) 191 let fillFromList i xs | i == n = return () 192 | otherwise = case xs of 193 [] -> return () 194 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys 195 fillFromList 0 es 196 return marr 197 198{-# RULES 199"listArray/Array" listArray = 200 \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray) 201 #-} 202 203{-# INLINE listUArrayST #-} 204listUArrayST :: (MArray (STUArray s) e (ST s), Ix i) 205 => (i,i) -> [e] -> ST s (STUArray s i e) 206listUArrayST (l,u) es = do 207 marr <- newArray_ (l,u) 208 let n = safeRangeSize (l,u) 209 let fillFromList i xs | i == n = return () 210 | otherwise = case xs of 211 [] -> return () 212 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys 213 fillFromList 0 es 214 return marr 215 216-- I don't know how to write a single rule for listUArrayST, because 217-- the type looks like constrained over 's', which runST doesn't 218-- like. In fact all MArray (STUArray s) instances are polymorphic 219-- wrt. 's', but runST can't know that. 220-- 221-- More precisely, we'd like to write this: 222-- listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i) 223-- => (i,i) -> [e] -> UArray i e 224-- listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray) 225-- {-# RULES listArray = listUArray 226-- Then we could call listUArray at any type 'e' that had a suitable 227-- MArray instance. But sadly we can't, because we don't have quantified 228-- constraints. Hence the mass of rules below. 229 230-- I would like also to write a rule for listUArrayST (or listArray or 231-- whatever) applied to unpackCString#. Unfortunately unpackCString# 232-- calls seem to be floated out, then floated back into the middle 233-- of listUArrayST, so I was not able to do this. 234 235type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e 236 237{-# RULES 238"listArray/UArray/Bool" listArray 239 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool 240"listArray/UArray/Char" listArray 241 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char 242"listArray/UArray/Int" listArray 243 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int 244"listArray/UArray/Word" listArray 245 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word 246"listArray/UArray/Ptr" listArray 247 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a) 248"listArray/UArray/FunPtr" listArray 249 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a) 250"listArray/UArray/Float" listArray 251 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float 252"listArray/UArray/Double" listArray 253 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double 254"listArray/UArray/StablePtr" listArray 255 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a) 256"listArray/UArray/Int8" listArray 257 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8 258"listArray/UArray/Int16" listArray 259 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16 260"listArray/UArray/Int32" listArray 261 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32 262"listArray/UArray/Int64" listArray 263 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64 264"listArray/UArray/Word8" listArray 265 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8 266"listArray/UArray/Word16" listArray 267 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16 268"listArray/UArray/Word32" listArray 269 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32 270"listArray/UArray/Word64" listArray 271 = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64 272 #-} 273 274{-# INLINE (!) #-} 275-- | Returns the element of an immutable array at the specified index. 276(!) :: (IArray a e, Ix i) => a i e -> i -> e 277(!) arr i = case bounds arr of 278 (l,u) -> unsafeAt arr $ safeIndex (l,u) (numElements arr) i 279 280{-# INLINE indices #-} 281-- | Returns a list of all the valid indices in an array. 282indices :: (IArray a e, Ix i) => a i e -> [i] 283indices arr = case bounds arr of (l,u) -> range (l,u) 284 285{-# INLINE elems #-} 286-- | Returns a list of all the elements of an array, in the same order 287-- as their indices. 288elems :: (IArray a e, Ix i) => a i e -> [e] 289elems arr = [unsafeAt arr i | i <- [0 .. numElements arr - 1]] 290 291{-# INLINE assocs #-} 292-- | Returns the contents of an array as a list of associations. 293assocs :: (IArray a e, Ix i) => a i e -> [(i, e)] 294assocs arr = case bounds arr of 295 (l,u) -> [(i, arr ! i) | i <- range (l,u)] 296 297{-# INLINE accumArray #-} 298 299{-| 300Constructs an immutable array from a list of associations. Unlike 301'array', the same index is allowed to occur multiple times in the list 302of associations; an /accumulating function/ is used to combine the 303values of elements with the same index. 304 305For example, given a list of values of some index type, hist produces 306a histogram of the number of occurrences of each index within a 307specified range: 308 309> hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b 310> hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i] 311-} 312accumArray :: (IArray a e, Ix i) 313 => (e -> e' -> e) -- ^ An accumulating function 314 -> e -- ^ A default element 315 -> (i,i) -- ^ The bounds of the array 316 -> [(i, e')] -- ^ List of associations 317 -> a i e -- ^ Returns: the array 318accumArray f initialValue (l,u) ies = 319 let n = safeRangeSize (l, u) 320 in unsafeAccumArray f initialValue (l,u) 321 [(safeIndex (l,u) n i, e) | (i, e) <- ies] 322 323{-# INLINE (//) #-} 324{-| 325Takes an array and a list of pairs and returns an array identical to 326the left argument except that it has been updated by the associations 327in the right argument. For example, if m is a 1-origin, n by n matrix, 328then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with 329the diagonal zeroed. 330 331As with the 'array' function, if any two associations in the list have 332the same index, the value at that index is implementation-dependent. 333(In GHC, the last value specified for that index is used. 334Other implementations will also do this for unboxed arrays, but Haskell 33598 requires that for 'Array' the value at such indices is bottom.) 336 337For most array types, this operation is O(/n/) where /n/ is the size 338of the array. However, the diffarray package provides an array type 339for which this operation has complexity linear in the number of updates. 340-} 341(//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e 342arr // ies = case bounds arr of 343 (l,u) -> unsafeReplace arr [ (safeIndex (l,u) (numElements arr) i, e) 344 | (i, e) <- ies] 345 346{-# INLINE accum #-} 347{-| 348@accum f@ takes an array and an association list and accumulates pairs 349from the list into the array with the accumulating function @f@. Thus 350'accumArray' can be defined using 'accum': 351 352> accumArray f z b = accum f (array b [(i, z) | i \<- range b]) 353-} 354accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e 355accum f arr ies = case bounds arr of 356 (l,u) -> let n = numElements arr 357 in unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies] 358 359{-# INLINE amap #-} 360-- | Returns a new array derived from the original array by applying a 361-- function to each of the elements. 362amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e 363amap f arr = case bounds arr of 364 (l,u) -> let n = numElements arr 365 in unsafeArray (l,u) [ (i, f (unsafeAt arr i)) 366 | i <- [0 .. n - 1]] 367 368{-# INLINE ixmap #-} 369-- | Returns a new array derived from the original array by applying a 370-- function to each of the indices. 371ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e 372ixmap (l,u) f arr = 373 array (l,u) [(i, arr ! f i) | i <- range (l,u)] 374 375----------------------------------------------------------------------------- 376-- Normal polymorphic arrays 377 378instance IArray Arr.Array e where 379 {-# INLINE bounds #-} 380 bounds = Arr.bounds 381 {-# INLINE numElements #-} 382 numElements = Arr.numElements 383 {-# INLINE unsafeArray #-} 384 unsafeArray = Arr.unsafeArray 385 {-# INLINE unsafeAt #-} 386 unsafeAt = Arr.unsafeAt 387 {-# INLINE unsafeReplace #-} 388 unsafeReplace = Arr.unsafeReplace 389 {-# INLINE unsafeAccum #-} 390 unsafeAccum = Arr.unsafeAccum 391 {-# INLINE unsafeAccumArray #-} 392 unsafeAccumArray = Arr.unsafeAccumArray 393 394----------------------------------------------------------------------------- 395-- Flat unboxed arrays 396 397-- | Arrays with unboxed elements. Instances of 'IArray' are provided 398-- for 'UArray' with certain element types ('Int', 'Float', 'Char', 399-- etc.; see the 'UArray' class for a full list). 400-- 401-- A 'UArray' will generally be more efficient (in terms of both time 402-- and space) than the equivalent 'Data.Array.Array' with the same 403-- element type. However, 'UArray' is strict in its elements - so 404-- don\'t use 'UArray' if you require the non-strictness that 405-- 'Data.Array.Array' provides. 406-- 407-- Because the @IArray@ interface provides operations overloaded on 408-- the type of the array, it should be possible to just change the 409-- array type being used by a program from say @Array@ to @UArray@ to 410-- get the benefits of unboxed arrays (don\'t forget to import 411-- "Data.Array.Unboxed" instead of "Data.Array"). 412-- 413data UArray i e = UArray !i !i !Int ByteArray# 414-- There are class-based invariants on both parameters. See also #9220. 415type role UArray nominal nominal 416 417{-# INLINE unsafeArrayUArray #-} 418unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) 419 => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e) 420unsafeArrayUArray (l,u) ies default_elem = do 421 marr <- newArray (l,u) default_elem 422 sequence_ [unsafeWrite marr i e | (i, e) <- ies] 423 unsafeFreezeSTUArray marr 424 425{-# INLINE unsafeFreezeSTUArray #-} 426unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e) 427unsafeFreezeSTUArray (STUArray l u n marr#) = ST $ \s1# -> 428 case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) -> 429 (# s2#, UArray l u n arr# #) } 430 431{-# INLINE unsafeReplaceUArray #-} 432unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i) 433 => UArray i e -> [(Int, e)] -> ST s (UArray i e) 434unsafeReplaceUArray arr ies = do 435 marr <- thawSTUArray arr 436 sequence_ [unsafeWrite marr i e | (i, e) <- ies] 437 unsafeFreezeSTUArray marr 438 439{-# INLINE unsafeAccumUArray #-} 440unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i) 441 => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e) 442unsafeAccumUArray f arr ies = do 443 marr <- thawSTUArray arr 444 sequence_ [do old <- unsafeRead marr i 445 unsafeWrite marr i (f old new) 446 | (i, new) <- ies] 447 unsafeFreezeSTUArray marr 448 449{-# INLINE unsafeAccumArrayUArray #-} 450unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) 451 => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e) 452unsafeAccumArrayUArray f initialValue (l,u) ies = do 453 marr <- newArray (l,u) initialValue 454 sequence_ [do old <- unsafeRead marr i 455 unsafeWrite marr i (f old new) 456 | (i, new) <- ies] 457 unsafeFreezeSTUArray marr 458 459{-# INLINE eqUArray #-} 460eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool 461eqUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = 462 if n1 == 0 then n2 == 0 else 463 l1 == l2 && u1 == u2 && 464 and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]] 465 466{-# INLINE [1] cmpUArray #-} 467cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering 468cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2) 469 470{-# INLINE cmpIntUArray #-} 471cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering 472cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = 473 if n1 == 0 then if n2 == 0 then EQ else LT else 474 if n2 == 0 then GT else 475 case compare l1 l2 of 476 EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] 477 other -> other 478 where 479 cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of 480 EQ -> rest 481 other -> other 482 483{-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-} 484 485----------------------------------------------------------------------------- 486-- Showing and Reading IArrays 487 488{-# SPECIALISE 489 showsIArray :: (IArray UArray e, Ix i, Show i, Show e) => 490 Int -> UArray i e -> ShowS 491 #-} 492 493showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS 494showsIArray p a = 495 showParen (p > appPrec) $ 496 showString "array " . 497 shows (bounds a) . 498 showChar ' ' . 499 shows (assocs a) 500 501{-# SPECIALISE 502 readIArray :: (IArray UArray e, Ix i, Read i, Read e) => 503 ReadPrec (UArray i e) 504 #-} 505 506readIArray :: (IArray a e, Ix i, Read i, Read e) => ReadPrec (a i e) 507readIArray = parens $ prec appPrec $ 508 do expectP (Ident "array") 509 theBounds <- step readPrec 510 vals <- step readPrec 511 return (array theBounds vals) 512 513----------------------------------------------------------------------------- 514-- Flat unboxed arrays: instances 515 516instance IArray UArray Bool where 517 {-# INLINE bounds #-} 518 bounds (UArray l u _ _) = (l,u) 519 {-# INLINE numElements #-} 520 numElements (UArray _ _ n _) = n 521 {-# INLINE unsafeArray #-} 522 unsafeArray lu ies = runST (unsafeArrayUArray lu ies False) 523 {-# INLINE unsafeAt #-} 524 unsafeAt (UArray _ _ _ arr#) (I# i#) = isTrue# 525 ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#) 526 `neWord#` int2Word# 0#) 527 528 {-# INLINE unsafeReplace #-} 529 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 530 {-# INLINE unsafeAccum #-} 531 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 532 {-# INLINE unsafeAccumArray #-} 533 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 534 535instance IArray UArray Char where 536 {-# INLINE bounds #-} 537 bounds (UArray l u _ _) = (l,u) 538 {-# INLINE numElements #-} 539 numElements (UArray _ _ n _) = n 540 {-# INLINE unsafeArray #-} 541 unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0') 542 {-# INLINE unsafeAt #-} 543 unsafeAt (UArray _ _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#) 544 {-# INLINE unsafeReplace #-} 545 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 546 {-# INLINE unsafeAccum #-} 547 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 548 {-# INLINE unsafeAccumArray #-} 549 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 550 551instance IArray UArray Int where 552 {-# INLINE bounds #-} 553 bounds (UArray l u _ _) = (l,u) 554 {-# INLINE numElements #-} 555 numElements (UArray _ _ n _) = n 556 {-# INLINE unsafeArray #-} 557 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 558 {-# INLINE unsafeAt #-} 559 unsafeAt (UArray _ _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#) 560 {-# INLINE unsafeReplace #-} 561 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 562 {-# INLINE unsafeAccum #-} 563 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 564 {-# INLINE unsafeAccumArray #-} 565 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 566 567instance IArray UArray Word where 568 {-# INLINE bounds #-} 569 bounds (UArray l u _ _) = (l,u) 570 {-# INLINE numElements #-} 571 numElements (UArray _ _ n _) = n 572 {-# INLINE unsafeArray #-} 573 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 574 {-# INLINE unsafeAt #-} 575 unsafeAt (UArray _ _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#) 576 {-# INLINE unsafeReplace #-} 577 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 578 {-# INLINE unsafeAccum #-} 579 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 580 {-# INLINE unsafeAccumArray #-} 581 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 582 583instance IArray UArray (Ptr a) where 584 {-# INLINE bounds #-} 585 bounds (UArray l u _ _) = (l,u) 586 {-# INLINE numElements #-} 587 numElements (UArray _ _ n _) = n 588 {-# INLINE unsafeArray #-} 589 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr) 590 {-# INLINE unsafeAt #-} 591 unsafeAt (UArray _ _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#) 592 {-# INLINE unsafeReplace #-} 593 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 594 {-# INLINE unsafeAccum #-} 595 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 596 {-# INLINE unsafeAccumArray #-} 597 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 598 599instance IArray UArray (FunPtr a) where 600 {-# INLINE bounds #-} 601 bounds (UArray l u _ _) = (l,u) 602 {-# INLINE numElements #-} 603 numElements (UArray _ _ n _) = n 604 {-# INLINE unsafeArray #-} 605 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr) 606 {-# INLINE unsafeAt #-} 607 unsafeAt (UArray _ _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#) 608 {-# INLINE unsafeReplace #-} 609 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 610 {-# INLINE unsafeAccum #-} 611 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 612 {-# INLINE unsafeAccumArray #-} 613 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 614 615instance IArray UArray Float where 616 {-# INLINE bounds #-} 617 bounds (UArray l u _ _) = (l,u) 618 {-# INLINE numElements #-} 619 numElements (UArray _ _ n _) = n 620 {-# INLINE unsafeArray #-} 621 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 622 {-# INLINE unsafeAt #-} 623 unsafeAt (UArray _ _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#) 624 {-# INLINE unsafeReplace #-} 625 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 626 {-# INLINE unsafeAccum #-} 627 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 628 {-# INLINE unsafeAccumArray #-} 629 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 630 631instance IArray UArray Double where 632 {-# INLINE bounds #-} 633 bounds (UArray l u _ _) = (l,u) 634 {-# INLINE numElements #-} 635 numElements (UArray _ _ n _) = n 636 {-# INLINE unsafeArray #-} 637 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 638 {-# INLINE unsafeAt #-} 639 unsafeAt (UArray _ _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#) 640 {-# INLINE unsafeReplace #-} 641 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 642 {-# INLINE unsafeAccum #-} 643 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 644 {-# INLINE unsafeAccumArray #-} 645 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 646 647instance IArray UArray (StablePtr a) where 648 {-# INLINE bounds #-} 649 bounds (UArray l u _ _) = (l,u) 650 {-# INLINE numElements #-} 651 numElements (UArray _ _ n _) = n 652 {-# INLINE unsafeArray #-} 653 unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr) 654 {-# INLINE unsafeAt #-} 655 unsafeAt (UArray _ _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#) 656 {-# INLINE unsafeReplace #-} 657 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 658 {-# INLINE unsafeAccum #-} 659 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 660 {-# INLINE unsafeAccumArray #-} 661 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 662 663-- bogus StablePtr value for initialising a UArray of StablePtr. 664nullStablePtr :: StablePtr a 665nullStablePtr = StablePtr (unsafeCoerce# 0#) 666 667instance IArray UArray Int8 where 668 {-# INLINE bounds #-} 669 bounds (UArray l u _ _) = (l,u) 670 {-# INLINE numElements #-} 671 numElements (UArray _ _ n _) = n 672 {-# INLINE unsafeArray #-} 673 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 674 {-# INLINE unsafeAt #-} 675 unsafeAt (UArray _ _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#) 676 {-# INLINE unsafeReplace #-} 677 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 678 {-# INLINE unsafeAccum #-} 679 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 680 {-# INLINE unsafeAccumArray #-} 681 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 682 683instance IArray UArray Int16 where 684 {-# INLINE bounds #-} 685 bounds (UArray l u _ _) = (l,u) 686 {-# INLINE numElements #-} 687 numElements (UArray _ _ n _) = n 688 {-# INLINE unsafeArray #-} 689 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 690 {-# INLINE unsafeAt #-} 691 unsafeAt (UArray _ _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#) 692 {-# INLINE unsafeReplace #-} 693 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 694 {-# INLINE unsafeAccum #-} 695 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 696 {-# INLINE unsafeAccumArray #-} 697 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 698 699instance IArray UArray Int32 where 700 {-# INLINE bounds #-} 701 bounds (UArray l u _ _) = (l,u) 702 {-# INLINE numElements #-} 703 numElements (UArray _ _ n _) = n 704 {-# INLINE unsafeArray #-} 705 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 706 {-# INLINE unsafeAt #-} 707 unsafeAt (UArray _ _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#) 708 {-# INLINE unsafeReplace #-} 709 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 710 {-# INLINE unsafeAccum #-} 711 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 712 {-# INLINE unsafeAccumArray #-} 713 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 714 715instance IArray UArray Int64 where 716 {-# INLINE bounds #-} 717 bounds (UArray l u _ _) = (l,u) 718 {-# INLINE numElements #-} 719 numElements (UArray _ _ n _) = n 720 {-# INLINE unsafeArray #-} 721 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 722 {-# INLINE unsafeAt #-} 723 unsafeAt (UArray _ _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#) 724 {-# INLINE unsafeReplace #-} 725 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 726 {-# INLINE unsafeAccum #-} 727 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 728 {-# INLINE unsafeAccumArray #-} 729 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 730 731instance IArray UArray Word8 where 732 {-# INLINE bounds #-} 733 bounds (UArray l u _ _) = (l,u) 734 {-# INLINE numElements #-} 735 numElements (UArray _ _ n _) = n 736 {-# INLINE unsafeArray #-} 737 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 738 {-# INLINE unsafeAt #-} 739 unsafeAt (UArray _ _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#) 740 {-# INLINE unsafeReplace #-} 741 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 742 {-# INLINE unsafeAccum #-} 743 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 744 {-# INLINE unsafeAccumArray #-} 745 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 746 747instance IArray UArray Word16 where 748 {-# INLINE bounds #-} 749 bounds (UArray l u _ _) = (l,u) 750 {-# INLINE numElements #-} 751 numElements (UArray _ _ n _) = n 752 {-# INLINE unsafeArray #-} 753 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 754 {-# INLINE unsafeAt #-} 755 unsafeAt (UArray _ _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#) 756 {-# INLINE unsafeReplace #-} 757 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 758 {-# INLINE unsafeAccum #-} 759 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 760 {-# INLINE unsafeAccumArray #-} 761 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 762 763instance IArray UArray Word32 where 764 {-# INLINE bounds #-} 765 bounds (UArray l u _ _) = (l,u) 766 {-# INLINE numElements #-} 767 numElements (UArray _ _ n _) = n 768 {-# INLINE unsafeArray #-} 769 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 770 {-# INLINE unsafeAt #-} 771 unsafeAt (UArray _ _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#) 772 {-# INLINE unsafeReplace #-} 773 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 774 {-# INLINE unsafeAccum #-} 775 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 776 {-# INLINE unsafeAccumArray #-} 777 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 778 779instance IArray UArray Word64 where 780 {-# INLINE bounds #-} 781 bounds (UArray l u _ _) = (l,u) 782 {-# INLINE numElements #-} 783 numElements (UArray _ _ n _) = n 784 {-# INLINE unsafeArray #-} 785 unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 786 {-# INLINE unsafeAt #-} 787 unsafeAt (UArray _ _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#) 788 {-# INLINE unsafeReplace #-} 789 unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 790 {-# INLINE unsafeAccum #-} 791 unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 792 {-# INLINE unsafeAccumArray #-} 793 unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 794 795instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where 796 (==) = eqUArray 797 798instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where 799 compare = cmpUArray 800 801instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where 802 showsPrec = showsIArray 803 804instance (Ix ix, Read ix, Read e, IArray UArray e) => Read (UArray ix e) where 805 readPrec = readIArray 806 807----------------------------------------------------------------------------- 808-- Mutable arrays 809 810{-# NOINLINE arrEleBottom #-} 811arrEleBottom :: a 812arrEleBottom = error "MArray: undefined array element" 813 814{-| Class of mutable array types. 815 816An array type has the form @(a i e)@ where @a@ is the array type 817constructor (kind @* -> * -> *@), @i@ is the index type (a member of 818the class 'Ix'), and @e@ is the element type. 819 820The @MArray@ class is parameterised over both @a@ and @e@ (so that 821instances specialised to certain element types can be defined, in the 822same way as for 'IArray'), and also over the type of the monad, @m@, 823in which the mutable array will be manipulated. 824-} 825class (Monad m) => MArray a e m where 826 827 -- | Returns the bounds of the array 828 getBounds :: Ix i => a i e -> m (i,i) 829 -- | Returns the number of elements in the array 830 getNumElements :: Ix i => a i e -> m Int 831 832 -- | Builds a new array, with every element initialised to the supplied 833 -- value. 834 newArray :: Ix i => (i,i) -> e -> m (a i e) 835 836 -- | Builds a new array, with every element initialised to an 837 -- undefined value. In a monadic context in which operations must 838 -- be deterministic (e.g. the ST monad), the array elements are 839 -- initialised to a fixed but undefined value, such as zero. 840 newArray_ :: Ix i => (i,i) -> m (a i e) 841 842 -- | Builds a new array, with every element initialised to an undefined 843 -- value. 844 unsafeNewArray_ :: Ix i => (i,i) -> m (a i e) 845 846 unsafeRead :: Ix i => a i e -> Int -> m e 847 unsafeWrite :: Ix i => a i e -> Int -> e -> m () 848 849 {-# INLINE newArray #-} 850 -- The INLINE is crucial, because until we know at least which monad 851 -- we are in, the code below allocates like crazy. So inline it, 852 -- in the hope that the context will know the monad. 853 newArray (l,u) initialValue = do 854 let n = safeRangeSize (l,u) 855 marr <- unsafeNewArray_ (l,u) 856 sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]] 857 return marr 858 859 {-# INLINE unsafeNewArray_ #-} 860 unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom 861 862 {-# INLINE newArray_ #-} 863 newArray_ (l,u) = newArray (l,u) arrEleBottom 864 865 -- newArray takes an initialiser which all elements of 866 -- the newly created array are initialised to. unsafeNewArray_ takes 867 -- no initialiser, it is assumed that the array is initialised with 868 -- "undefined" values. 869 870 -- why not omit unsafeNewArray_? Because in the unboxed array 871 -- case we would like to omit the initialisation altogether if 872 -- possible. We can't do this for boxed arrays, because the 873 -- elements must all have valid values at all times in case of 874 -- garbage collection. 875 876 -- why not omit newArray? Because in the boxed case, we can omit the 877 -- default initialisation with undefined values if we *do* know the 878 -- initial value and it is constant for all elements. 879 880instance MArray IOArray e IO where 881 {-# INLINE getBounds #-} 882 getBounds (IOArray marr) = stToIO $ getBounds marr 883 {-# INLINE getNumElements #-} 884 getNumElements (IOArray marr) = stToIO $ getNumElements marr 885 newArray = newIOArray 886 unsafeRead = unsafeReadIOArray 887 unsafeWrite = unsafeWriteIOArray 888 889{-# INLINE newListArray #-} 890-- | Constructs a mutable array from a list of initial elements. 891-- The list gives the elements of the array in ascending order 892-- beginning with the lowest index. 893newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) 894newListArray (l,u) es = do 895 marr <- newArray_ (l,u) 896 let n = safeRangeSize (l,u) 897 let fillFromList i xs | i == n = return () 898 | otherwise = case xs of 899 [] -> return () 900 y:ys -> unsafeWrite marr i y >> fillFromList (i+1) ys 901 fillFromList 0 es 902 return marr 903 904{-# INLINE readArray #-} 905-- | Read an element from a mutable array 906readArray :: (MArray a e m, Ix i) => a i e -> i -> m e 907readArray marr i = do 908 (l,u) <- getBounds marr 909 n <- getNumElements marr 910 unsafeRead marr (safeIndex (l,u) n i) 911 912{-# INLINE writeArray #-} 913-- | Write an element in a mutable array 914writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m () 915writeArray marr i e = do 916 (l,u) <- getBounds marr 917 n <- getNumElements marr 918 unsafeWrite marr (safeIndex (l,u) n i) e 919 920{-# INLINE getElems #-} 921-- | Return a list of all the elements of a mutable array 922getElems :: (MArray a e m, Ix i) => a i e -> m [e] 923getElems marr = do 924 (_l, _u) <- getBounds marr 925 n <- getNumElements marr 926 sequence [unsafeRead marr i | i <- [0 .. n - 1]] 927 928{-# INLINE getAssocs #-} 929-- | Return a list of all the associations of a mutable array, in 930-- index order. 931getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)] 932getAssocs marr = do 933 (l,u) <- getBounds marr 934 n <- getNumElements marr 935 sequence [ do e <- unsafeRead marr (safeIndex (l,u) n i); return (i,e) 936 | i <- range (l,u)] 937 938{-# INLINE mapArray #-} 939-- | Constructs a new array derived from the original array by applying a 940-- function to each of the elements. 941mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) 942mapArray f marr = do 943 (l,u) <- getBounds marr 944 n <- getNumElements marr 945 marr' <- newArray_ (l,u) 946 sequence_ [do e <- unsafeRead marr i 947 unsafeWrite marr' i (f e) 948 | i <- [0 .. n - 1]] 949 return marr' 950 951{-# INLINE mapIndices #-} 952-- | Constructs a new array derived from the original array by applying a 953-- function to each of the indices. 954mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) 955mapIndices (l',u') f marr = do 956 marr' <- newArray_ (l',u') 957 n' <- getNumElements marr' 958 sequence_ [do e <- readArray marr (f i') 959 unsafeWrite marr' (safeIndex (l',u') n' i') e 960 | i' <- range (l',u')] 961 return marr' 962 963----------------------------------------------------------------------------- 964-- Polymorphic non-strict mutable arrays (ST monad) 965 966instance MArray (STArray s) e (ST s) where 967 {-# INLINE getBounds #-} 968 getBounds arr = return $! ArrST.boundsSTArray arr 969 {-# INLINE getNumElements #-} 970 getNumElements arr = return $! ArrST.numElementsSTArray arr 971 {-# INLINE newArray #-} 972 newArray = ArrST.newSTArray 973 {-# INLINE unsafeRead #-} 974 unsafeRead = ArrST.unsafeReadSTArray 975 {-# INLINE unsafeWrite #-} 976 unsafeWrite = ArrST.unsafeWriteSTArray 977 978instance MArray (STArray s) e (Lazy.ST s) where 979 {-# INLINE getBounds #-} 980 getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr) 981 {-# INLINE getNumElements #-} 982 getNumElements arr = strictToLazyST (return $! ArrST.numElementsSTArray arr) 983 {-# INLINE newArray #-} 984 newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e) 985 {-# INLINE unsafeRead #-} 986 unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i) 987 {-# INLINE unsafeWrite #-} 988 unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e) 989 990----------------------------------------------------------------------------- 991-- Flat unboxed mutable arrays (ST monad) 992 993-- | A mutable array with unboxed elements, that can be manipulated in 994-- the 'ST' monad. The type arguments are as follows: 995-- 996-- * @s@: the state variable argument for the 'ST' type 997-- 998-- * @i@: the index type of the array (should be an instance of @Ix@) 999-- 1000-- * @e@: the element type of the array. Only certain element types 1001-- are supported. 1002-- 1003-- An 'STUArray' will generally be more efficient (in terms of both time 1004-- and space) than the equivalent boxed version ('STArray') with the same 1005-- element type. However, 'STUArray' is strict in its elements - so 1006-- don\'t use 'STUArray' if you require the non-strictness that 1007-- 'STArray' provides. 1008data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s) 1009-- The "ST" parameter must be nominal for the safety of the ST trick. 1010-- The other parameters have class constraints. See also #9220. 1011type role STUArray nominal nominal nominal 1012 1013instance Eq (STUArray s i e) where 1014 STUArray _ _ _ arr1# == STUArray _ _ _ arr2# = 1015 isTrue# (sameMutableByteArray# arr1# arr2#) 1016 1017{-# INLINE unsafeNewArraySTUArray_ #-} 1018unsafeNewArraySTUArray_ :: Ix i 1019 => (i,i) -> (Int# -> Int#) -> ST s (STUArray s i e) 1020unsafeNewArraySTUArray_ (l,u) elemsToBytes 1021 = case rangeSize (l,u) of 1022 n@(I# n#) -> 1023 ST $ \s1# -> 1024 case newByteArray# (elemsToBytes n#) s1# of 1025 (# s2#, marr# #) -> 1026 (# s2#, STUArray l u n marr# #) 1027 1028instance MArray (STUArray s) Bool (ST s) where 1029 {-# INLINE getBounds #-} 1030 getBounds (STUArray l u _ _) = return (l,u) 1031 {-# INLINE getNumElements #-} 1032 getNumElements (STUArray _ _ n _) = return n 1033 {-# INLINE newArray #-} 1034 newArray (l,u) initialValue = ST $ \s1# -> 1035 case safeRangeSize (l,u) of { n@(I# n#) -> 1036 case bOOL_SCALE n# of { nbytes# -> 1037 case newByteArray# nbytes# s1# of { (# s2#, marr# #) -> 1038 case setByteArray# marr# 0# nbytes# e# s2# of { s3# -> 1039 (# s3#, STUArray l u n marr# #) }}}} 1040 where 1041 !(I# e#) = if initialValue then 0xff else 0x0 1042 {-# INLINE unsafeNewArray_ #-} 1043 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE 1044 {-# INLINE newArray_ #-} 1045 newArray_ arrBounds = newArray arrBounds False 1046 {-# INLINE unsafeRead #-} 1047 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1048 case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) -> 1049 (# s2#, isTrue# ((e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) :: Bool #) } 1050 {-# INLINE unsafeWrite #-} 1051 unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# -> 1052 case bOOL_INDEX i# of { j# -> 1053 case readWordArray# marr# j# s1# of { (# s2#, old# #) -> 1054 case if e then old# `or#` bOOL_BIT i# 1055 else old# `and#` bOOL_NOT_BIT i# of { e# -> 1056 case writeWordArray# marr# j# e# s2# of { s3# -> 1057 (# s3#, () #) }}}} 1058 1059instance MArray (STUArray s) Char (ST s) where 1060 {-# INLINE getBounds #-} 1061 getBounds (STUArray l u _ _) = return (l,u) 1062 {-# INLINE getNumElements #-} 1063 getNumElements (STUArray _ _ n _) = return n 1064 {-# INLINE unsafeNewArray_ #-} 1065 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1066 {-# INLINE newArray_ #-} 1067 newArray_ arrBounds = newArray arrBounds (chr 0) 1068 {-# INLINE unsafeRead #-} 1069 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1070 case readWideCharArray# marr# i# s1# of { (# s2#, e# #) -> 1071 (# s2#, C# e# #) } 1072 {-# INLINE unsafeWrite #-} 1073 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (C# e#) = ST $ \s1# -> 1074 case writeWideCharArray# marr# i# e# s1# of { s2# -> 1075 (# s2#, () #) } 1076 1077instance MArray (STUArray s) Int (ST s) where 1078 {-# INLINE getBounds #-} 1079 getBounds (STUArray l u _ _) = return (l,u) 1080 {-# INLINE getNumElements #-} 1081 getNumElements (STUArray _ _ n _) = return n 1082 {-# INLINE unsafeNewArray_ #-} 1083 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1084 {-# INLINE newArray_ #-} 1085 newArray_ arrBounds = newArray arrBounds 0 1086 {-# INLINE unsafeRead #-} 1087 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1088 case readIntArray# marr# i# s1# of { (# s2#, e# #) -> 1089 (# s2#, I# e# #) } 1090 {-# INLINE unsafeWrite #-} 1091 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I# e#) = ST $ \s1# -> 1092 case writeIntArray# marr# i# e# s1# of { s2# -> 1093 (# s2#, () #) } 1094 1095instance MArray (STUArray s) Word (ST s) where 1096 {-# INLINE getBounds #-} 1097 getBounds (STUArray l u _ _) = return (l,u) 1098 {-# INLINE getNumElements #-} 1099 getNumElements (STUArray _ _ n _) = return n 1100 {-# INLINE unsafeNewArray_ #-} 1101 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1102 {-# INLINE newArray_ #-} 1103 newArray_ arrBounds = newArray arrBounds 0 1104 {-# INLINE unsafeRead #-} 1105 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1106 case readWordArray# marr# i# s1# of { (# s2#, e# #) -> 1107 (# s2#, W# e# #) } 1108 {-# INLINE unsafeWrite #-} 1109 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W# e#) = ST $ \s1# -> 1110 case writeWordArray# marr# i# e# s1# of { s2# -> 1111 (# s2#, () #) } 1112 1113instance MArray (STUArray s) (Ptr a) (ST s) where 1114 {-# INLINE getBounds #-} 1115 getBounds (STUArray l u _ _) = return (l,u) 1116 {-# INLINE getNumElements #-} 1117 getNumElements (STUArray _ _ n _) = return n 1118 {-# INLINE unsafeNewArray_ #-} 1119 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1120 {-# INLINE newArray_ #-} 1121 newArray_ arrBounds = newArray arrBounds nullPtr 1122 {-# INLINE unsafeRead #-} 1123 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1124 case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> 1125 (# s2#, Ptr e# #) } 1126 {-# INLINE unsafeWrite #-} 1127 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# -> 1128 case writeAddrArray# marr# i# e# s1# of { s2# -> 1129 (# s2#, () #) } 1130 1131instance MArray (STUArray s) (FunPtr a) (ST s) where 1132 {-# INLINE getBounds #-} 1133 getBounds (STUArray l u _ _) = return (l,u) 1134 {-# INLINE getNumElements #-} 1135 getNumElements (STUArray _ _ n _) = return n 1136 {-# INLINE unsafeNewArray_ #-} 1137 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1138 {-# INLINE newArray_ #-} 1139 newArray_ arrBounds = newArray arrBounds nullFunPtr 1140 {-# INLINE unsafeRead #-} 1141 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1142 case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> 1143 (# s2#, FunPtr e# #) } 1144 {-# INLINE unsafeWrite #-} 1145 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# -> 1146 case writeAddrArray# marr# i# e# s1# of { s2# -> 1147 (# s2#, () #) } 1148 1149instance MArray (STUArray s) Float (ST s) where 1150 {-# INLINE getBounds #-} 1151 getBounds (STUArray l u _ _) = return (l,u) 1152 {-# INLINE getNumElements #-} 1153 getNumElements (STUArray _ _ n _) = return n 1154 {-# INLINE unsafeNewArray_ #-} 1155 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE 1156 {-# INLINE newArray_ #-} 1157 newArray_ arrBounds = newArray arrBounds 0 1158 {-# INLINE unsafeRead #-} 1159 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1160 case readFloatArray# marr# i# s1# of { (# s2#, e# #) -> 1161 (# s2#, F# e# #) } 1162 {-# INLINE unsafeWrite #-} 1163 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (F# e#) = ST $ \s1# -> 1164 case writeFloatArray# marr# i# e# s1# of { s2# -> 1165 (# s2#, () #) } 1166 1167instance MArray (STUArray s) Double (ST s) where 1168 {-# INLINE getBounds #-} 1169 getBounds (STUArray l u _ _) = return (l,u) 1170 {-# INLINE getNumElements #-} 1171 getNumElements (STUArray _ _ n _) = return n 1172 {-# INLINE unsafeNewArray_ #-} 1173 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE 1174 {-# INLINE newArray_ #-} 1175 newArray_ arrBounds = newArray arrBounds 0 1176 {-# INLINE unsafeRead #-} 1177 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1178 case readDoubleArray# marr# i# s1# of { (# s2#, e# #) -> 1179 (# s2#, D# e# #) } 1180 {-# INLINE unsafeWrite #-} 1181 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (D# e#) = ST $ \s1# -> 1182 case writeDoubleArray# marr# i# e# s1# of { s2# -> 1183 (# s2#, () #) } 1184 1185instance MArray (STUArray s) (StablePtr a) (ST s) where 1186 {-# INLINE getBounds #-} 1187 getBounds (STUArray l u _ _) = return (l,u) 1188 {-# INLINE getNumElements #-} 1189 getNumElements (STUArray _ _ n _) = return n 1190 {-# INLINE unsafeNewArray_ #-} 1191 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1192 {-# INLINE newArray_ #-} 1193 newArray_ arrBounds = newArray arrBounds (castPtrToStablePtr nullPtr) 1194 {-# INLINE unsafeRead #-} 1195 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1196 case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) -> 1197 (# s2# , StablePtr e# #) } 1198 {-# INLINE unsafeWrite #-} 1199 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# -> 1200 case writeStablePtrArray# marr# i# e# s1# of { s2# -> 1201 (# s2#, () #) } 1202 1203instance MArray (STUArray s) Int8 (ST s) where 1204 {-# INLINE getBounds #-} 1205 getBounds (STUArray l u _ _) = return (l,u) 1206 {-# INLINE getNumElements #-} 1207 getNumElements (STUArray _ _ n _) = return n 1208 {-# INLINE unsafeNewArray_ #-} 1209 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) 1210 {-# INLINE newArray_ #-} 1211 newArray_ arrBounds = newArray arrBounds 0 1212 {-# INLINE unsafeRead #-} 1213 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1214 case readInt8Array# marr# i# s1# of { (# s2#, e# #) -> 1215 (# s2#, I8# e# #) } 1216 {-# INLINE unsafeWrite #-} 1217 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# -> 1218 case writeInt8Array# marr# i# e# s1# of { s2# -> 1219 (# s2#, () #) } 1220 1221instance MArray (STUArray s) Int16 (ST s) where 1222 {-# INLINE getBounds #-} 1223 getBounds (STUArray l u _ _) = return (l,u) 1224 {-# INLINE getNumElements #-} 1225 getNumElements (STUArray _ _ n _) = return n 1226 {-# INLINE unsafeNewArray_ #-} 1227 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#) 1228 {-# INLINE newArray_ #-} 1229 newArray_ arrBounds = newArray arrBounds 0 1230 {-# INLINE unsafeRead #-} 1231 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1232 case readInt16Array# marr# i# s1# of { (# s2#, e# #) -> 1233 (# s2#, I16# e# #) } 1234 {-# INLINE unsafeWrite #-} 1235 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# -> 1236 case writeInt16Array# marr# i# e# s1# of { s2# -> 1237 (# s2#, () #) } 1238 1239instance MArray (STUArray s) Int32 (ST s) where 1240 {-# INLINE getBounds #-} 1241 getBounds (STUArray l u _ _) = return (l,u) 1242 {-# INLINE getNumElements #-} 1243 getNumElements (STUArray _ _ n _) = return n 1244 {-# INLINE unsafeNewArray_ #-} 1245 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1246 {-# INLINE newArray_ #-} 1247 newArray_ arrBounds = newArray arrBounds 0 1248 {-# INLINE unsafeRead #-} 1249 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1250 case readInt32Array# marr# i# s1# of { (# s2#, e# #) -> 1251 (# s2#, I32# e# #) } 1252 {-# INLINE unsafeWrite #-} 1253 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# -> 1254 case writeInt32Array# marr# i# e# s1# of { s2# -> 1255 (# s2#, () #) } 1256 1257instance MArray (STUArray s) Int64 (ST s) where 1258 {-# INLINE getBounds #-} 1259 getBounds (STUArray l u _ _) = return (l,u) 1260 {-# INLINE getNumElements #-} 1261 getNumElements (STUArray _ _ n _) = return n 1262 {-# INLINE unsafeNewArray_ #-} 1263 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#) 1264 {-# INLINE newArray_ #-} 1265 newArray_ arrBounds = newArray arrBounds 0 1266 {-# INLINE unsafeRead #-} 1267 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1268 case readInt64Array# marr# i# s1# of { (# s2#, e# #) -> 1269 (# s2#, I64# e# #) } 1270 {-# INLINE unsafeWrite #-} 1271 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# -> 1272 case writeInt64Array# marr# i# e# s1# of { s2# -> 1273 (# s2#, () #) } 1274 1275instance MArray (STUArray s) Word8 (ST s) where 1276 {-# INLINE getBounds #-} 1277 getBounds (STUArray l u _ _) = return (l,u) 1278 {-# INLINE getNumElements #-} 1279 getNumElements (STUArray _ _ n _) = return n 1280 {-# INLINE unsafeNewArray_ #-} 1281 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) 1282 {-# INLINE newArray_ #-} 1283 newArray_ arrBounds = newArray arrBounds 0 1284 {-# INLINE unsafeRead #-} 1285 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1286 case readWord8Array# marr# i# s1# of { (# s2#, e# #) -> 1287 (# s2#, W8# e# #) } 1288 {-# INLINE unsafeWrite #-} 1289 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# -> 1290 case writeWord8Array# marr# i# e# s1# of { s2# -> 1291 (# s2#, () #) } 1292 1293instance MArray (STUArray s) Word16 (ST s) where 1294 {-# INLINE getBounds #-} 1295 getBounds (STUArray l u _ _) = return (l,u) 1296 {-# INLINE getNumElements #-} 1297 getNumElements (STUArray _ _ n _) = return n 1298 {-# INLINE unsafeNewArray_ #-} 1299 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#) 1300 {-# INLINE newArray_ #-} 1301 newArray_ arrBounds = newArray arrBounds 0 1302 {-# INLINE unsafeRead #-} 1303 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1304 case readWord16Array# marr# i# s1# of { (# s2#, e# #) -> 1305 (# s2#, W16# e# #) } 1306 {-# INLINE unsafeWrite #-} 1307 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# -> 1308 case writeWord16Array# marr# i# e# s1# of { s2# -> 1309 (# s2#, () #) } 1310 1311instance MArray (STUArray s) Word32 (ST s) where 1312 {-# INLINE getBounds #-} 1313 getBounds (STUArray l u _ _) = return (l,u) 1314 {-# INLINE getNumElements #-} 1315 getNumElements (STUArray _ _ n _) = return n 1316 {-# INLINE unsafeNewArray_ #-} 1317 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1318 {-# INLINE newArray_ #-} 1319 newArray_ arrBounds = newArray arrBounds 0 1320 {-# INLINE unsafeRead #-} 1321 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1322 case readWord32Array# marr# i# s1# of { (# s2#, e# #) -> 1323 (# s2#, W32# e# #) } 1324 {-# INLINE unsafeWrite #-} 1325 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# -> 1326 case writeWord32Array# marr# i# e# s1# of { s2# -> 1327 (# s2#, () #) } 1328 1329instance MArray (STUArray s) Word64 (ST s) where 1330 {-# INLINE getBounds #-} 1331 getBounds (STUArray l u _ _) = return (l,u) 1332 {-# INLINE getNumElements #-} 1333 getNumElements (STUArray _ _ n _) = return n 1334 {-# INLINE unsafeNewArray_ #-} 1335 unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#) 1336 {-# INLINE newArray_ #-} 1337 newArray_ arrBounds = newArray arrBounds 0 1338 {-# INLINE unsafeRead #-} 1339 unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1340 case readWord64Array# marr# i# s1# of { (# s2#, e# #) -> 1341 (# s2#, W64# e# #) } 1342 {-# INLINE unsafeWrite #-} 1343 unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# -> 1344 case writeWord64Array# marr# i# e# s1# of { s2# -> 1345 (# s2#, () #) } 1346 1347----------------------------------------------------------------------------- 1348-- Translation between elements and bytes 1349 1350bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# 1351bOOL_SCALE n# = 1352 -- + 7 to handle case where n is not divisible by 8 1353 (n# +# 7#) `uncheckedIShiftRA#` 3# 1354wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD 1355dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE 1356fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT 1357 1358safe_scale :: Int# -> Int# -> Int# 1359safe_scale scale# n# 1360 | not overflow = res# 1361 | otherwise = error $ "Data.Array.Base.safe_scale: Overflow; scale: " 1362 ++ show (I# scale#) ++ ", n: " ++ show (I# n#) 1363 where 1364 !res# = scale# *# n# 1365 !overflow = isTrue# (maxN# `divInt#` scale# <# n#) 1366 !(I# maxN#) = maxBound 1367{-# INLINE safe_scale #-} 1368 1369-- | The index of the word which the given @Bool@ array elements falls within. 1370bOOL_INDEX :: Int# -> Int# 1371#if SIZEOF_HSWORD == 4 1372bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5# 1373#elif SIZEOF_HSWORD == 8 1374bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6# 1375#endif 1376 1377bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word# 1378bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#)) 1379 where !(W# mask#) = SIZEOF_HSWORD * 8 - 1 1380bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# 1381 where !(W# mb#) = maxBound 1382 1383----------------------------------------------------------------------------- 1384-- Freezing 1385 1386-- | Converts a mutable array (any instance of 'MArray') to an 1387-- immutable array (any instance of 'IArray') by taking a complete 1388-- copy of it. 1389freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 1390{-# NOINLINE [1] freeze #-} 1391freeze marr = do 1392 (l,u) <- getBounds marr 1393 n <- getNumElements marr 1394 es <- mapM (unsafeRead marr) [0 .. n - 1] 1395 -- The old array and index might not be well-behaved, so we need to 1396 -- use the safe array creation function here. 1397 return (listArray (l,u) es) 1398 1399freezeSTUArray :: STUArray s i e -> ST s (UArray i e) 1400freezeSTUArray (STUArray l u n marr#) = ST $ \s1# -> 1401 case sizeofMutableByteArray# marr# of { n# -> 1402 case newByteArray# n# s1# of { (# s2#, marr'# #) -> 1403 case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m -> 1404 case unsafeCoerce# m s2# of { (# s3#, _ #) -> 1405 case unsafeFreezeByteArray# marr'# s3# of { (# s4#, arr# #) -> 1406 (# s4#, UArray l u n arr# #) }}}}} 1407 1408foreign import ccall unsafe "memcpy" 1409 memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize 1410 -> IO (Ptr a) 1411 1412{-# RULES 1413"freeze/STArray" freeze = ArrST.freezeSTArray 1414"freeze/STUArray" freeze = freezeSTUArray 1415 #-} 1416 1417-- In-place conversion of mutable arrays to immutable ones places 1418-- a proof obligation on the user: no other parts of your code can 1419-- have a reference to the array at the point where you unsafely 1420-- freeze it (and, subsequently mutate it, I suspect). 1421 1422{- | 1423 Converts an mutable array into an immutable array. The 1424 implementation may either simply cast the array from 1425 one type to the other without copying the array, or it 1426 may take a full copy of the array. 1427 1428 Note that because the array is possibly not copied, any subsequent 1429 modifications made to the mutable version of the array may be 1430 shared with the immutable version. It is safe to use, therefore, if 1431 the mutable version is never modified after the freeze operation. 1432 1433 The non-copying implementation is supported between certain pairs 1434 of array types only; one constraint is that the array types must 1435 have identical representations. In GHC, The following pairs of 1436 array types have a non-copying O(1) implementation of 1437 'unsafeFreeze'. Because the optimised versions are enabled by 1438 specialisations, you will need to compile with optimisation (-O) to 1439 get them. 1440 1441 * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray' 1442 1443 * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray' 1444 1445 * 'Data.Array.IO.IOArray' -> 'Data.Array.Array' 1446 1447 * 'Data.Array.ST.STArray' -> 'Data.Array.Array' 1448-} 1449{-# INLINE [1] unsafeFreeze #-} 1450unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 1451unsafeFreeze = freeze 1452 1453{-# RULES 1454"unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray 1455"unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray 1456 #-} 1457 1458----------------------------------------------------------------------------- 1459-- Thawing 1460 1461-- | Converts an immutable array (any instance of 'IArray') into a 1462-- mutable array (any instance of 'MArray') by taking a complete copy 1463-- of it. 1464thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 1465{-# NOINLINE [1] thaw #-} 1466thaw arr = case bounds arr of 1467 (l,u) -> do 1468 marr <- newArray_ (l,u) 1469 let n = safeRangeSize (l,u) 1470 sequence_ [ unsafeWrite marr i (unsafeAt arr i) 1471 | i <- [0 .. n - 1]] 1472 return marr 1473 1474thawSTUArray :: UArray i e -> ST s (STUArray s i e) 1475thawSTUArray (UArray l u n arr#) = ST $ \s1# -> 1476 case sizeofByteArray# arr# of { n# -> 1477 case newByteArray# n# s1# of { (# s2#, marr# #) -> 1478 case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m -> 1479 case unsafeCoerce# m s2# of { (# s3#, _ #) -> 1480 (# s3#, STUArray l u n marr# #) }}}} 1481 1482foreign import ccall unsafe "memcpy" 1483 memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize 1484 -> IO (Ptr a) 1485 1486{-# RULES 1487"thaw/STArray" thaw = ArrST.thawSTArray 1488"thaw/STUArray" thaw = thawSTUArray 1489 #-} 1490 1491-- In-place conversion of immutable arrays to mutable ones places 1492-- a proof obligation on the user: no other parts of your code can 1493-- have a reference to the array at the point where you unsafely 1494-- thaw it (and, subsequently mutate it, I suspect). 1495 1496{- | 1497 Converts an immutable array into a mutable array. The 1498 implementation may either simply cast the array from 1499 one type to the other without copying the array, or it 1500 may take a full copy of the array. 1501 1502 Note that because the array is possibly not copied, any subsequent 1503 modifications made to the mutable version of the array may be 1504 shared with the immutable version. It is only safe to use, 1505 therefore, if the immutable array is never referenced again in this 1506 thread, and there is no possibility that it can be also referenced 1507 in another thread. If you use an unsafeThaw/write/unsafeFreeze 1508 sequence in a multi-threaded setting, then you must ensure that 1509 this sequence is atomic with respect to other threads, or a garbage 1510 collector crash may result (because the write may be writing to a 1511 frozen array). 1512 1513 The non-copying implementation is supported between certain pairs 1514 of array types only; one constraint is that the array types must 1515 have identical representations. In GHC, The following pairs of 1516 array types have a non-copying O(1) implementation of 1517 'unsafeThaw'. Because the optimised versions are enabled by 1518 specialisations, you will need to compile with optimisation (-O) to 1519 get them. 1520 1521 * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray' 1522 1523 * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray' 1524 1525 * 'Data.Array.Array' -> 'Data.Array.IO.IOArray' 1526 1527 * 'Data.Array.Array' -> 'Data.Array.ST.STArray' 1528-} 1529{-# INLINE [1] unsafeThaw #-} 1530unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 1531unsafeThaw = thaw 1532 1533{-# INLINE unsafeThawSTUArray #-} 1534unsafeThawSTUArray :: UArray i e -> ST s (STUArray s i e) 1535unsafeThawSTUArray (UArray l u n marr#) = 1536 return (STUArray l u n (unsafeCoerce# marr#)) 1537 1538{-# RULES 1539"unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray 1540"unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray 1541 #-} 1542 1543{-# INLINE unsafeThawIOArray #-} 1544unsafeThawIOArray :: Arr.Array ix e -> IO (IOArray ix e) 1545unsafeThawIOArray arr = stToIO $ do 1546 marr <- ArrST.unsafeThawSTArray arr 1547 return (IOArray marr) 1548 1549{-# RULES 1550"unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray 1551 #-} 1552 1553thawIOArray :: Arr.Array ix e -> IO (IOArray ix e) 1554thawIOArray arr = stToIO $ do 1555 marr <- ArrST.thawSTArray arr 1556 return (IOArray marr) 1557 1558{-# RULES 1559"thaw/IOArray" thaw = thawIOArray 1560 #-} 1561 1562freezeIOArray :: IOArray ix e -> IO (Arr.Array ix e) 1563freezeIOArray (IOArray marr) = stToIO (ArrST.freezeSTArray marr) 1564 1565{-# RULES 1566"freeze/IOArray" freeze = freezeIOArray 1567 #-} 1568 1569{-# INLINE unsafeFreezeIOArray #-} 1570unsafeFreezeIOArray :: IOArray ix e -> IO (Arr.Array ix e) 1571unsafeFreezeIOArray (IOArray marr) = stToIO (ArrST.unsafeFreezeSTArray marr) 1572 1573{-# RULES 1574"unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray 1575 #-} 1576 1577-- | Casts an 'STUArray' with one element type into one with a 1578-- different element type. All the elements of the resulting array 1579-- are undefined (unless you know what you\'re doing...). 1580 1581castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) 1582castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#) 1583