{-# LANGUAGE Trustworthy #-}{-# LANGUAGE DataKinds #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE MagicHash #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE StandaloneKindSignatures #-}{-# LANGUAGE UnboxedTuples #-}{-# LANGUAGE UnliftedNewtypes #-}------------------------------------------------------------------------------- |-- Module : GHC.ArrayArray-- License : see libraries/base/LICENSE---- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC Extensions)---- Legacy interface for arrays of arrays.-- Deprecated, because the 'Array#' type can now store arrays directly.-- Consider simply using 'Array#' instead of 'ArrayArray#'.---- Use GHC.Exts instead of importing this module directly.------------------------------------------------------------------------------moduleGHC.ArrayArray(ArrayArray# (..),MutableArrayArray# (..),newArrayArray# ,unsafeFreezeArrayArray# ,sizeofArrayArray# ,sizeofMutableArrayArray# ,indexByteArrayArray# ,indexArrayArrayArray# ,readByteArrayArray# ,readMutableByteArrayArray# ,readArrayArrayArray# ,readMutableArrayArrayArray# ,writeByteArrayArray# ,writeMutableByteArrayArray# ,writeArrayArrayArray# ,writeMutableArrayArrayArray# ,copyArrayArray# ,copyMutableArrayArray# ,sameArrayArray# ,sameMutableArrayArray# )whereimportGHC.Prim importGHC.Prim.PtrEq (unsafePtrEquality# )importGHC.Types (Type ,UnliftedType ,isTrue# )importUnsafe.Coerce (unsafeCoerce ,unsafeCoerceUnlifted )default(){- ********************************************************************** * * * Arrays of arrays (legacy interface) * * * ********************************************************************** -}typeArrayArray# ::UnliftedType newtypeArrayArray# =ArrayArray# (Array# ByteArray# )typeMutableArrayArray# ::Type ->UnliftedType newtypeMutableArrayArray# s =MutableArrayArray# (MutableArray# s ByteArray# )-- | Create a new mutable array of arrays with the specified number of elements,-- in the specified state thread, with each element recursively referring to the-- newly created array.newArrayArray# ::Int# ->State# s ->(#State# s ,MutableArrayArray# s #)newArrayArray# :: forall s. Int# -> State# s -> (# State# s, MutableArrayArray# s #) newArrayArray# Int# sz State# s s1 =-- Create a placeholder ByteArray to initialise the underlying MutableArray#.caseInt# -> State# s -> (# State# s, MutableByteArray# s #) forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #) newByteArray# Int# 0#State# s s1 of(#State# s s2 ,MutableByteArray# s placeholder #)->-- Create a new MutableArray# holding the placeholder ByteArray# value.caseInt# -> ByteArray# -> State# s -> (# State# s, MutableArray# s ByteArray# #) forall a d. Int# -> a -> State# d -> (# State# d, MutableArray# d a #) newArray# Int# sz (MutableByteArray# s -> ByteArray# forall (a :: UnliftedType) (b :: UnliftedType). a -> b unsafeCoerceUnlifted MutableByteArray# s placeholder )State# s s2 of(#State# s s3 ,MutableArray# s ByteArray# arr #)->-- Now update the MutableArray# so that the elements refer back-- to the mutable array itself.caseMutableArray# s ByteArray# -> Int# -> State# s -> State# s forall s. MutableArray# s ByteArray# -> Int# -> State# s -> State# s write_array_to_array MutableArray# s ByteArray# arr Int# 0#State# s s3 ofState# s s4 ->(#State# s s4 ,MutableArray# s ByteArray# -> MutableArrayArray# s forall s. MutableArray# s ByteArray# -> MutableArrayArray# s MutableArrayArray# (MutableArray# s ByteArray# -> MutableArray# s ByteArray# forall (a :: UnliftedType) (b :: UnliftedType). a -> b unsafeCoerceUnlifted MutableArray# s ByteArray# arr )#)wherewrite_array_to_array ::MutableArray# s ByteArray# ->Int# ->State# s ->State# s write_array_to_array :: forall s. MutableArray# s ByteArray# -> Int# -> State# s -> State# s write_array_to_array MutableArray# s ByteArray# _Int# i State# s s |Int# -> Bool isTrue# (Int# i Int# -> Int# -> Int# >=# Int# sz )=State# s s write_array_to_array MutableArray# s ByteArray# arr Int# i State# s s =caseMutableArray# s ByteArray# -> Int# -> ByteArray# -> State# s -> State# s forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d writeArray# MutableArray# s ByteArray# arr Int# i (MutableArray# s ByteArray# -> ByteArray# forall (a :: UnliftedType) (b :: UnliftedType). a -> b unsafeCoerceUnlifted MutableArray# s ByteArray# arr )State# s s ofState# s s' ->MutableArray# s ByteArray# -> Int# -> State# s -> State# s forall s. MutableArray# s ByteArray# -> Int# -> State# s -> State# s write_array_to_array MutableArray# s ByteArray# arr (Int# i Int# -> Int# -> Int# +# Int# 1#)State# s s' -- | Make a mutable array of arrays immutable, without copying.unsafeFreezeArrayArray# ::MutableArrayArray# s ->State# s ->(#State# s ,ArrayArray# #)unsafeFreezeArrayArray# :: forall s. MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #) unsafeFreezeArrayArray# =(MutableArray# Any Any -> State# Any -> (# State# Any, Array# Any #)) -> MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #) forall a b. a -> b unsafeCoerce MutableArray# Any Any -> State# Any -> (# State# Any, Array# Any #) forall d a. MutableArray# d a -> State# d -> (# State# d, Array# a #) unsafeFreezeArray# -- | Return the number of elements in the array.sizeofArrayArray# ::ArrayArray# ->Int# sizeofArrayArray# :: ArrayArray# -> Int# sizeofArrayArray# =(Array# Any -> Int#) -> ArrayArray# -> Int# forall a b. a -> b unsafeCoerce Array# Any -> Int# forall a. Array# a -> Int# sizeofArray# -- | Return the number of elements in the array.sizeofMutableArrayArray# ::MutableArrayArray# s ->Int# sizeofMutableArrayArray# :: forall s. MutableArrayArray# s -> Int# sizeofMutableArrayArray# =(MutableArray# Any Any -> Int#) -> MutableArrayArray# s -> Int# forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# forall d a. MutableArray# d a -> Int# sizeofMutableArray# indexByteArrayArray# ::ArrayArray# ->Int# ->ByteArray# indexByteArrayArray# :: ArrayArray# -> Int# -> ByteArray# indexByteArrayArray# =(Array# Any -> Int# -> (# Any #)) -> ArrayArray# -> Int# -> ByteArray# forall a b. a -> b unsafeCoerce Array# Any -> Int# -> (# Any #) forall a. Array# a -> Int# -> (# a #) indexArray# indexArrayArrayArray# ::ArrayArray# ->Int# ->ArrayArray# indexArrayArrayArray# :: ArrayArray# -> Int# -> ArrayArray# indexArrayArrayArray# =(Array# Any -> Int# -> (# Any #)) -> ArrayArray# -> Int# -> ArrayArray# forall a b. a -> b unsafeCoerce Array# Any -> Int# -> (# Any #) forall a. Array# a -> Int# -> (# a #) indexArray# readByteArrayArray# ::MutableArrayArray# s ->Int# ->State# s ->(#State# s ,ByteArray# #)readByteArrayArray# :: forall s. MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #) readByteArrayArray# =(MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #)) -> MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #) forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #) forall d a. MutableArray# d a -> Int# -> State# d -> (# State# d, a #) readArray# readMutableByteArrayArray# ::MutableArrayArray# s ->Int# ->State# s ->(#State# s ,MutableByteArray# s #)readMutableByteArrayArray# :: forall s. MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) readMutableByteArrayArray# =(MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #)) -> MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #) forall d a. MutableArray# d a -> Int# -> State# d -> (# State# d, a #) readArray# readArrayArrayArray# ::MutableArrayArray# s ->Int# ->State# s ->(#State# s ,ArrayArray# #)readArrayArrayArray# :: forall s. MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #) readArrayArrayArray# =(MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #)) -> MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #) forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #) forall d a. MutableArray# d a -> Int# -> State# d -> (# State# d, a #) readArray# readMutableArrayArrayArray# ::MutableArrayArray# s ->Int# ->State# s ->(#State# s ,MutableArrayArray# s #)readMutableArrayArrayArray# :: forall s. MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #) readMutableArrayArrayArray# =(MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #)) -> MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #) forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> State# Any -> (# State# Any, Any #) forall d a. MutableArray# d a -> Int# -> State# d -> (# State# d, a #) readArray# writeByteArrayArray# ::MutableArrayArray# s ->Int# ->ByteArray# ->State# s ->State# s writeByteArrayArray# :: forall s. MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s writeByteArrayArray# =(MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any) -> MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d writeArray# writeMutableByteArrayArray# ::MutableArrayArray# s ->Int# ->MutableByteArray# s ->State# s ->State# s writeMutableByteArrayArray# :: forall s. MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s writeMutableByteArrayArray# =(MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any) -> MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d writeArray# writeArrayArrayArray# ::MutableArrayArray# s ->Int# ->ArrayArray# ->State# s ->State# s writeArrayArrayArray# :: forall s. MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s writeArrayArrayArray# =(MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any) -> MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d writeArray# writeMutableArrayArrayArray# ::MutableArrayArray# s ->Int# ->MutableArrayArray# s ->State# s ->State# s writeMutableArrayArrayArray# :: forall s. MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s writeMutableArrayArrayArray# =(MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any) -> MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> Any -> State# Any -> State# Any forall d a. MutableArray# d a -> Int# -> a -> State# d -> State# d writeArray# -- | Copy a range of the 'ArrayArray#' to the specified region in the 'MutableArrayArray#'.-- Both arrays must fully contain the specified ranges, but this is not checked.-- The two arrays must not be the same array in different states, but this is not checked either.copyArrayArray# ::ArrayArray# ->Int# ->MutableArrayArray# s ->Int# ->Int# ->State# s ->State# s copyArrayArray# :: forall s. ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s copyArrayArray# =(Array# Any -> Int# -> MutableArray# Any Any -> Int# -> Int# -> State# Any -> State# Any) -> ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s forall a b. a -> b unsafeCoerce Array# Any -> Int# -> MutableArray# Any Any -> Int# -> Int# -> State# Any -> State# Any forall a d. Array# a -> Int# -> MutableArray# d a -> Int# -> Int# -> State# d -> State# d copyArray# -- | Copy a range of the first MutableArrayArray# to the specified region in the second-- MutableArrayArray#.-- Both arrays must fully contain the specified ranges, but this is not checked.-- The regions are allowed to overlap, although this is only possible when the same-- array is provided as both the source and the destination.copyMutableArrayArray# ::MutableArrayArray# s ->Int# ->MutableArrayArray# s ->Int# ->Int# ->State# s ->State# s copyMutableArrayArray# :: forall s. MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s copyMutableArrayArray# =(MutableArray# Any Any -> Int# -> MutableArray# Any Any -> Int# -> Int# -> State# Any -> State# Any) -> MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s forall a b. a -> b unsafeCoerce MutableArray# Any Any -> Int# -> MutableArray# Any Any -> Int# -> Int# -> State# Any -> State# Any forall d a. MutableArray# d a -> Int# -> MutableArray# d a -> Int# -> Int# -> State# d -> State# d copyMutableArray# -- | Compare the underlying pointers of two arrays of arrays.sameArrayArray# ::ArrayArray# ->ArrayArray# ->Int# sameArrayArray# :: ArrayArray# -> ArrayArray# -> Int# sameArrayArray# (ArrayArray# Array# ByteArray# arr1 )(ArrayArray# Array# ByteArray# arr2 )=Array# ByteArray# -> Array# ByteArray# -> Int# forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafePtrEquality# Array# ByteArray# arr1 Array# ByteArray# arr2 -- | Compare the underlying pointers of two mutable arrays of arrays.sameMutableArrayArray# ::MutableArrayArray# s ->MutableArrayArray# s ->Int# sameMutableArrayArray# :: forall s. MutableArrayArray# s -> MutableArrayArray# s -> Int# sameMutableArrayArray# (MutableArrayArray# MutableArray# s ByteArray# marr1 )(MutableArrayArray# MutableArray# s ByteArray# marr2 )=MutableArray# s ByteArray# -> MutableArray# s ByteArray# -> Int# forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafePtrEquality# MutableArray# s ByteArray# marr1 MutableArray# s ByteArray# marr2