├── tests ├── largeArray.stdout ├── array001.stdout ├── T2120.stdout ├── T229.stdout-ws-32 ├── T229.stdout-ws-64 ├── T9220.script ├── .gitignore ├── Makefile ├── largeArray.hs ├── all.T ├── T2120.hs ├── T229.hs ├── array001.hs └── T9220.stdout ├── prologue.txt ├── Setup.hs ├── .arcconfig ├── .gitignore ├── README.md ├── .github └── workflows │ └── build.yml ├── Data ├── Array │ ├── Unboxed.hs │ ├── ST │ │ └── Safe.hs │ ├── IO │ │ ├── Safe.hs │ │ └── Internals.hs │ ├── Unsafe.hs │ ├── Storable.hs │ ├── Storable │ │ ├── Safe.hs │ │ └── Internals.hs │ ├── IArray.hs │ ├── MArray.hs │ ├── MArray │ │ └── Safe.hs │ ├── ST.hs │ ├── IO.hs │ └── Base.hs └── Array.hs ├── array.cabal ├── changelog.md ├── LICENSE └── .travis.yml /tests/largeArray.stdout: -------------------------------------------------------------------------------- 1 | 11 2 | -------------------------------------------------------------------------------- /prologue.txt: -------------------------------------------------------------------------------- 1 | This package contains arrays. 2 | -------------------------------------------------------------------------------- /tests/array001.stdout: -------------------------------------------------------------------------------- 1 | 11 2 | [1,2,3,4,5,6,7,8,9,10,0,0] 3 | -------------------------------------------------------------------------------- /tests/T2120.stdout: -------------------------------------------------------------------------------- 1 | Ix{Int}.index: Index (5) out of range ((1,4)) 2 | Error in array index 3 | -------------------------------------------------------------------------------- /tests/T229.stdout-ws-32: -------------------------------------------------------------------------------- 1 | Data.Array.Base.safe_scale: Overflow; scale: 4, n: 1073741824 2 | -------------------------------------------------------------------------------- /tests/T229.stdout-ws-64: -------------------------------------------------------------------------------- 1 | Data.Array.Base.safe_scale: Overflow; scale: 4, n: 4611686018427387904 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Distribution.Simple 4 | 5 | main :: IO () 6 | main = defaultMain 7 | 8 | -------------------------------------------------------------------------------- /tests/T9220.script: -------------------------------------------------------------------------------- 1 | :info Data.Array.Base.UArray 2 | :info Data.Array.IO.IOUArray 3 | :info Data.Array.ST.STUArray 4 | :info Data.Array.Storable.StorableArray 5 | -------------------------------------------------------------------------------- /.arcconfig: -------------------------------------------------------------------------------- 1 | { 2 | "project.name" : "array", 3 | "repository.callsign" : "ARRAY", 4 | "phabricator.uri" : "https://phabricator.haskell.org" 5 | } 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | cabal.project.local 2 | cabal.project.local~ 3 | 4 | # Specific generated files 5 | GNUmakefile 6 | dist-install/ 7 | dist/ 8 | dist-newstyle/ 9 | .ghc.environment.* 10 | ghc.mk 11 | -------------------------------------------------------------------------------- /tests/.gitignore: -------------------------------------------------------------------------------- 1 | .hpc*/ 2 | *.o 3 | *.hi 4 | *.comp.std* 5 | *.run.std* 6 | *.normalised 7 | *.eventlog 8 | *.genscript 9 | *.exe 10 | 11 | # specific files 12 | /T2120 13 | /array001 14 | /array001.data 15 | /largeArray 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | The `array` Package [![Build Status](https://travis-ci.org/ghc/packages-array.png?branch=master)](https://travis-ci.org/ghc/packages-array) 2 | =================== 3 | 4 | See [`array` on Hackage](http://hackage.haskell.org/package/array) for more information. 5 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | # This Makefile runs the tests using GHC's testsuite framework. It 2 | # assumes the package is part of a GHC build tree with the testsuite 3 | # installed in ../../../testsuite. 4 | 5 | TOP=../../../testsuite 6 | include $(TOP)/mk/boilerplate.mk 7 | include $(TOP)/mk/test.mk 8 | -------------------------------------------------------------------------------- /tests/largeArray.hs: -------------------------------------------------------------------------------- 1 | import Data.Array 2 | 3 | main :: IO () 4 | main = print (((! 1).inc.inc.inc.inc.inc.inc.inc.inc.inc.inc) a) 5 | 6 | size :: Int 7 | size = 60 8 | 9 | a :: Array Int Integer 10 | a = listArray (1,size) [1..] 11 | 12 | inc :: Array Int Integer -> Array Int Integer 13 | inc a = accum (+) a [(i,1) | i <- [1..size]] 14 | -------------------------------------------------------------------------------- /tests/all.T: -------------------------------------------------------------------------------- 1 | test('T2120', normal, compile_and_run, ['']) 2 | test('largeArray', normal, compile_and_run, ['']) 3 | test('array001', [ 4 | extra_clean(['array001.data']), 5 | ], 6 | compile_and_run, ['']) 7 | 8 | test('T9220', filter_stdout_lines('.*type role .*'), ghci_script, ['T9220.script']) 9 | test('T229', normal, compile_and_run, ['']) 10 | -------------------------------------------------------------------------------- /tests/T2120.hs: -------------------------------------------------------------------------------- 1 | 2 | module Main (main) where 3 | 4 | import Control.Exception 5 | import Data.Array.IArray 6 | 7 | a :: Array Int Int 8 | a = listArray (1,4) [1..4] 9 | 10 | b :: Array (Int,Int) Int 11 | b = listArray ((0,0), (3,3)) (repeat 0) 12 | 13 | main :: IO () 14 | main = do print (a ! 5) `catch` \e -> print (e :: SomeException) 15 | print (b ! (0,5)) `catch` \e -> print (e :: SomeException) 16 | 17 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Building 2 | 3 | on: 4 | pull_request: 5 | branches: 6 | - '**' 7 | 8 | jobs: 9 | build: 10 | runs-on: ${{ matrix.os }} 11 | 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | ghc: ['9.12', '9.10', '9.8', '9.6', '9.4', '9.2', '9.0', '8.10', '8.8', '8.6', '8.4', '8.2', '8.0'] 16 | os: ['ubuntu-latest', 'windows-latest'] 17 | 18 | name: Build on ${{ matrix.os }} with GHC ${{ matrix.ghc }} 19 | 20 | steps: 21 | - uses: actions/checkout@v4 22 | - uses: haskell-actions/setup@v2 23 | with: 24 | ghc-version: ${{ matrix.ghc }} 25 | - run: cabal build 26 | -------------------------------------------------------------------------------- /tests/T229.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #include "MachDeps.h" 4 | 5 | import Control.Exception 6 | import Data.Array.MArray 7 | import Data.Array.IO 8 | import Data.Word 9 | 10 | main :: IO () 11 | main = handle (\(exc :: SomeException) -> print exc) $ do 12 | -- This should fail due to integer overflow 13 | #if WORD_SIZE_IN_BITS == 64 14 | m <- newArray_ (0,2^62-1) :: IO (IOUArray Int Word32) -- allocates 0 bytes 15 | readArray m 17 >>= print -- Read some random location in address space 16 | #else 17 | m <- newArray_ (0,2^30-1) :: IO (IOUArray Int Word32) -- allocates 0 bytes 18 | readArray m 17 >>= print -- Read some random location in address space 19 | #endif 20 | 21 | -------------------------------------------------------------------------------- /Data/Array/Unboxed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.Unboxed 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.IArray) 11 | -- 12 | -- Unboxed immutable arrays. 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Data.Array.Unboxed ( 17 | -- * Arrays with unboxed elements 18 | UArray, 19 | 20 | -- * The overloaded immutable array interface 21 | module Data.Array.IArray, 22 | ) where 23 | 24 | import Data.Array.Base 25 | import Data.Array.IArray 26 | 27 | -------------------------------------------------------------------------------- /tests/array001.hs: -------------------------------------------------------------------------------- 1 | -- !!! Testing that #4827 is fixed (hPutArray/hGetArray use count argument) 2 | module Main(main) where 3 | 4 | import Control.Monad 5 | 6 | import Data.Array.MArray 7 | import Data.Array.IO 8 | 9 | import System.IO 10 | 11 | main :: IO () 12 | main = do 13 | the_array <- newListArray (0, 11) [1..12] 14 | 15 | -- Write out almost all of the array 16 | h_out <- openBinaryFile "array001.data" WriteMode 17 | hPutArray h_out the_array 11 18 | hClose h_out 19 | 20 | 21 | the_array <- newListArray (0, 11) [0 | i <- [1..12]] 22 | 23 | -- Read in almost all of the array 24 | h_in <- openBinaryFile "array001.data" ReadMode 25 | wrote_size <- hFileSize h_in 26 | hGetArray h_in the_array 10 27 | hClose h_in 28 | 29 | 30 | read_elems <- getElems the_array 31 | 32 | 33 | print wrote_size -- Bytes written, should == 11 34 | print read_elems -- Bytes read, should match written array in first 10 bytes, be 0 afterwards 35 | -------------------------------------------------------------------------------- /Data/Array/ST/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.ST.Safe 5 | -- Copyright : (c) The University of Glasgow 2011 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.MArray) 11 | -- 12 | -- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad. 13 | -- 14 | -- Safe API only of "Data.Array.ST". 15 | -- 16 | -- @since 0.4.0.0 17 | ----------------------------------------------------------------------------- 18 | 19 | module Data.Array.ST.Safe ( 20 | -- * Boxed arrays 21 | STArray, -- instance of: Eq, MArray 22 | runSTArray, 23 | 24 | -- * Unboxed arrays 25 | STUArray, -- instance of: Eq, MArray 26 | runSTUArray, 27 | 28 | -- * Overloaded mutable array interface 29 | module Data.Array.MArray.Safe, 30 | ) where 31 | 32 | import Data.Array.ST 33 | import Data.Array.MArray.Safe 34 | 35 | -------------------------------------------------------------------------------- /Data/Array/IO/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Safe #-} 2 | 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Array.IO.Safe 6 | -- Copyright : (c) The University of Glasgow 2001 7 | -- License : BSD-style (see the file libraries/base/LICENSE) 8 | -- 9 | -- Maintainer : libraries@haskell.org 10 | -- Stability : experimental 11 | -- Portability : non-portable (uses Data.Array.MArray) 12 | -- 13 | -- Mutable boxed and unboxed arrays in the IO monad. 14 | -- . 15 | -- Safe API only of "Data.Array.IO". 16 | -- 17 | -- @since 0.4.0.0 18 | ----------------------------------------------------------------------------- 19 | 20 | module Data.Array.IO.Safe ( 21 | -- * @IO@ arrays with boxed elements 22 | IOArray, -- instance of: Eq, Typeable 23 | 24 | -- * @IO@ arrays with unboxed elements 25 | IOUArray, -- instance of: Eq, Typeable 26 | 27 | -- * Overloaded mutable array interface 28 | module Data.Array.MArray.Safe, 29 | 30 | -- * Doing I\/O with @IOUArray@s 31 | hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int 32 | hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO () 33 | ) where 34 | 35 | import Data.Array.IO 36 | import Data.Array.MArray.Safe 37 | -------------------------------------------------------------------------------- /Data/Array/Unsafe.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Data.Array.Unsafe 4 | -- Copyright : (c) The University of Glasgow 2011 5 | -- License : BSD-style (see the file libraries/base/LICENSE) 6 | -- 7 | -- Maintainer : libraries@haskell.org 8 | -- Stability : experimental 9 | -- Portability : non-portable (uses Data.Array.MArray) 10 | -- 11 | -- Contains the various unsafe operations that can be performed 12 | -- on arrays. 13 | -- 14 | -- @since 0.4.0.0 15 | ----------------------------------------------------------------------------- 16 | 17 | module Data.Array.Unsafe ( 18 | -- * Unsafe operations 19 | castSTUArray, -- :: STUArray s i a -> ST s (STUArray s i b) 20 | castIOUArray, -- :: IOUArray i a -> IO (IOUArray i b) 21 | 22 | unsafeFreeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 23 | unsafeThaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 24 | 25 | unsafeForeignPtrToStorableArray -- :: Ix i => ForeignPtr e -> (i,i) 26 | -- -> IO (StorableArray i e) 27 | ) where 28 | 29 | 30 | import Data.Array.Base ( castSTUArray, unsafeFreeze, unsafeThaw ) 31 | import Data.Array.IO.Internals ( castIOUArray ) 32 | import Data.Array.Storable.Internals ( unsafeForeignPtrToStorableArray ) 33 | 34 | -------------------------------------------------------------------------------- /Data/Array/Storable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.Storable 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.MArray) 11 | -- 12 | -- A storable array is an IO-mutable array which stores its 13 | -- contents in a contiguous memory block living in the C 14 | -- heap. Elements are stored according to the class 'Storable'. 15 | -- You can obtain the pointer to the array contents to manipulate 16 | -- elements from languages like C. 17 | -- 18 | -- It is similar to 'Data.Array.IO.IOUArray' but slower. 19 | -- Its advantage is that it's compatible with C. 20 | -- 21 | ----------------------------------------------------------------------------- 22 | 23 | module Data.Array.Storable ( 24 | -- * Arrays of 'Storable' things. 25 | StorableArray, -- data StorableArray index element 26 | -- + index type must be in class Ix 27 | -- + element type must be in class Storable 28 | 29 | -- * Overloaded mutable array interface 30 | -- | Module "Data.Array.MArray" provides the interface of storable arrays. 31 | -- They are instances of class 'MArray' (with the 'IO' monad). 32 | module Data.Array.MArray, 33 | 34 | -- * Accessing the pointer to the array contents 35 | withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a 36 | 37 | touchStorableArray, -- :: StorableArray i e -> IO () 38 | ) where 39 | 40 | import Data.Array.MArray 41 | import Data.Array.Storable.Internals 42 | -------------------------------------------------------------------------------- /array.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.10 2 | name: array 3 | version: 0.5.8.0 4 | 5 | -- NOTE: Don't forget to update ./changelog.md 6 | license: BSD3 7 | license-file: LICENSE 8 | maintainer: libraries@haskell.org 9 | bug-reports: https://github.com/haskell/array/issues 10 | synopsis: Mutable and immutable arrays 11 | category: Data Structures 12 | build-type: Simple 13 | description: 14 | In addition to providing the "Data.Array" module 15 | , 16 | this package also defines the classes 'IArray' of 17 | immutable arrays and 'MArray' of arrays mutable within appropriate 18 | monads, as well as some instances of these classes. 19 | 20 | extra-source-files: changelog.md 21 | 22 | source-repository head 23 | type: git 24 | location: https://github.com/haskell/array.git 25 | 26 | library 27 | default-language: Haskell2010 28 | other-extensions: 29 | BangPatterns, 30 | CPP, 31 | FlexibleContexts, 32 | FlexibleInstances, 33 | MagicHash, 34 | MultiParamTypeClasses, 35 | RankNTypes, 36 | Trustworthy, 37 | UnboxedTuples, 38 | UnliftedFFITypes 39 | build-depends: base >= 4.9 && < 4.23 40 | ghc-options: -Wall 41 | exposed-modules: 42 | Data.Array 43 | Data.Array.Base 44 | Data.Array.IArray 45 | Data.Array.IO 46 | Data.Array.IO.Safe 47 | Data.Array.IO.Internals 48 | Data.Array.MArray 49 | Data.Array.MArray.Safe 50 | Data.Array.ST 51 | Data.Array.ST.Safe 52 | Data.Array.Storable 53 | Data.Array.Storable.Safe 54 | Data.Array.Storable.Internals 55 | Data.Array.Unboxed 56 | Data.Array.Unsafe 57 | -------------------------------------------------------------------------------- /Data/Array/Storable/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.Storable.Safe 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.MArray) 11 | -- 12 | -- A storable array is an IO-mutable array which stores its 13 | -- contents in a contiguous memory block living in the C 14 | -- heap. Elements are stored according to the class 'Storable'. 15 | -- You can obtain the pointer to the array contents to manipulate 16 | -- elements from languages like C. 17 | -- 18 | -- It is similar to 'Data.Array.IO.IOUArray' but slower. 19 | -- Its advantage is that it's compatible with C. 20 | -- 21 | -- Safe API only of "Data.Array.Storable". 22 | -- 23 | -- @since 0.4.0.0 24 | ----------------------------------------------------------------------------- 25 | 26 | module Data.Array.Storable.Safe ( 27 | -- * Arrays of 'Storable' things. 28 | StorableArray, -- data StorableArray index element 29 | -- + index type must be in class Ix 30 | -- + element type must be in class Storable 31 | 32 | -- * Overloaded mutable array interface 33 | -- | Module "Data.Array.MArray" provides the interface of storable arrays. 34 | -- They are instances of class 'MArray' (with the 'IO' monad). 35 | module Data.Array.MArray.Safe, 36 | 37 | -- * Accessing the pointer to the array contents 38 | withStorableArray, -- :: StorableArray i e -> (Ptr e -> IO a) -> IO a 39 | 40 | touchStorableArray, -- :: StorableArray i e -> IO () 41 | ) where 42 | 43 | import Data.Array.MArray.Safe 44 | import Data.Array.Storable.Internals 45 | 46 | -------------------------------------------------------------------------------- /tests/T9220.stdout: -------------------------------------------------------------------------------- 1 | type role Data.Array.Base.UArray nominal nominal 2 | data Data.Array.Base.UArray i e 3 | = Data.Array.Base.UArray !i 4 | !i 5 | {-# UNPACK #-}Int 6 | GHC.Prim.ByteArray# 7 | -- Defined in ‘Data.Array.Base’ 8 | instance (GHC.Arr.Ix ix, Eq e, 9 | Data.Array.Base.IArray Data.Array.Base.UArray e) => 10 | Eq (Data.Array.Base.UArray ix e) 11 | -- Defined in ‘Data.Array.Base’ 12 | instance (GHC.Arr.Ix ix, Ord e, 13 | Data.Array.Base.IArray Data.Array.Base.UArray e) => 14 | Ord (Data.Array.Base.UArray ix e) 15 | -- Defined in ‘Data.Array.Base’ 16 | instance (GHC.Arr.Ix ix, Show ix, Show e, 17 | Data.Array.Base.IArray Data.Array.Base.UArray e) => 18 | Show (Data.Array.Base.UArray ix e) 19 | -- Defined in ‘Data.Array.Base’ 20 | type role Data.Array.IO.Internals.IOUArray nominal nominal 21 | newtype Data.Array.IO.Internals.IOUArray i e 22 | = Data.Array.IO.Internals.IOUArray (Data.Array.Base.STUArray 23 | GHC.Prim.RealWorld i e) 24 | -- Defined in ‘Data.Array.IO.Internals’ 25 | instance Eq (Data.Array.IO.Internals.IOUArray i e) 26 | -- Defined in ‘Data.Array.IO.Internals’ 27 | type role Data.Array.Base.STUArray nominal nominal nominal 28 | data Data.Array.Base.STUArray s i e 29 | = Data.Array.Base.STUArray !i 30 | !i 31 | {-# UNPACK #-}Int 32 | (GHC.Prim.MutableByteArray# s) 33 | -- Defined in ‘Data.Array.Base’ 34 | instance Eq (Data.Array.Base.STUArray s i e) 35 | -- Defined in ‘Data.Array.Base’ 36 | type role Data.Array.Storable.Internals.StorableArray nominal nominal 37 | data Data.Array.Storable.Internals.StorableArray i e 38 | = Data.Array.Storable.Internals.StorableArray !i 39 | !i 40 | Int 41 | !(GHC.ForeignPtr.ForeignPtr e) 42 | -- Defined in ‘Data.Array.Storable.Internals’ 43 | -------------------------------------------------------------------------------- /Data/Array/IArray.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.IArray 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.Base) 11 | -- 12 | -- Immutable arrays, with an overloaded interface. For array types which 13 | -- can be used with this interface, see the 'Array' type exported by this 14 | -- module and the "Data.Array.Unboxed" module. Other packages, such as 15 | -- diffarray, also provide arrays using this interface. 16 | -- 17 | ----------------------------------------------------------------------------- 18 | 19 | module Data.Array.IArray ( 20 | -- * Array classes 21 | IArray, -- :: (* -> * -> *) -> * -> class 22 | 23 | module Data.Ix, 24 | 25 | -- * Immutable non-strict (boxed) arrays 26 | Array, 27 | 28 | -- * Array construction 29 | array, -- :: (IArray a e, Ix i) => (i,i) -> [(i, e)] -> a i e 30 | listArray, -- :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e 31 | accumArray, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> e -> (i,i) -> [(i, e')] -> a i e 32 | genArray, -- :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e 33 | 34 | -- * Accessing arrays 35 | (!), -- :: (IArray a e, Ix i) => a i e -> i -> e 36 | (!?), -- :: (IArray a e, Ix i) => a i e -> i -> Maybe e 37 | bounds, -- :: (HasBounds a, Ix i) => a i e -> (i,i) 38 | indices, -- :: (HasBounds a, Ix i) => a i e -> [i] 39 | elems, -- :: (IArray a e, Ix i) => a i e -> [e] 40 | assocs, -- :: (IArray a e, Ix i) => a i e -> [(i, e)] 41 | 42 | -- * Array folds 43 | foldrArray, 44 | foldlArray', 45 | foldlArray, 46 | foldrArray', 47 | traverseArray_, 48 | forArray_, 49 | foldlArrayM', 50 | foldrArrayM', 51 | 52 | -- * Incremental array updates 53 | (//), -- :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e 54 | accum, -- :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e 55 | 56 | -- * Derived arrays 57 | amap, -- :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e 58 | ixmap, -- :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e 59 | ) where 60 | 61 | import Data.Ix 62 | import Data.Array (Array) 63 | import Data.Array.Base 64 | 65 | -------------------------------------------------------------------------------- /Data/Array/MArray.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, Trustworthy #-} 2 | 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Array.MArray 6 | -- Copyright : (c) The University of Glasgow 2001 7 | -- License : BSD-style (see the file libraries/base/LICENSE) 8 | -- 9 | -- Maintainer : libraries@haskell.org 10 | -- Stability : experimental 11 | -- Portability : non-portable (uses Data.Array.Base) 12 | -- 13 | -- An overloaded interface to mutable arrays. For array types which can be 14 | -- used with this interface, see "Data.Array.IO", "Data.Array.ST", 15 | -- and "Data.Array.Storable". 16 | -- 17 | ----------------------------------------------------------------------------- 18 | 19 | module Data.Array.MArray ( 20 | -- * Class of mutable array types 21 | MArray, -- :: (* -> * -> *) -> * -> (* -> *) -> class 22 | 23 | -- * The @Ix@ class and operations 24 | module Data.Ix, 25 | 26 | -- * Constructing mutable arrays 27 | newArray, -- :: (MArray a e m, Ix i) => (i,i) -> e -> m (a i e) 28 | newArray_, -- :: (MArray a e m, Ix i) => (i,i) -> m (a i e) 29 | newListArray, -- :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) 30 | newGenArray, -- :: (MArray a e m, Ix i) => (i,i) -> (i -> m e) -> m (a i e) 31 | 32 | -- * Reading and writing mutable arrays 33 | readArray, -- :: (MArray a e m, Ix i) => a i e -> i -> m e 34 | writeArray, -- :: (MArray a e m, Ix i) => a i e -> i -> e -> m () 35 | modifyArray, 36 | modifyArray', 37 | 38 | -- * Array folds 39 | foldlMArray', 40 | foldrMArray', 41 | mapMArrayM_, 42 | forMArrayM_, 43 | foldlMArrayM', 44 | foldrMArrayM', 45 | 46 | -- * Derived arrays 47 | mapArray, -- :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) 48 | mapIndices, -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) 49 | 50 | -- * Deconstructing mutable arrays 51 | getBounds, -- :: (MArray a e m, Ix i) => a i e -> m (i,i) 52 | getElems, -- :: (MArray a e m, Ix i) => a i e -> m [e] 53 | getAssocs, -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)] 54 | 55 | -- * Conversions between mutable and immutable arrays 56 | freeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 57 | thaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 58 | ) where 59 | 60 | import Data.Ix 61 | import Data.Array.Base 62 | #ifdef __HADDOCK__ 63 | import Data.Array.IArray 64 | #endif 65 | -------------------------------------------------------------------------------- /Data/Array/MArray/Safe.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.MArray.Safe 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.Base) 11 | -- 12 | -- An overloaded interface to mutable arrays. For array types which can be 13 | -- used with this interface, see "Data.Array.IO", "Data.Array.ST", 14 | -- and "Data.Array.Storable". 15 | -- . 16 | -- Safe API only of "Data.Array.MArray". 17 | -- 18 | -- @since 0.4.0.0 19 | ----------------------------------------------------------------------------- 20 | 21 | module Data.Array.MArray.Safe ( 22 | -- * Class of mutable array types 23 | MArray, -- :: (* -> * -> *) -> * -> (* -> *) -> class 24 | 25 | -- * The @Ix@ class and operations 26 | module Data.Ix, 27 | 28 | -- * Constructing mutable arrays 29 | newArray, -- :: (MArray a e m, Ix i) => (i,i) -> e -> m (a i e) 30 | newArray_, -- :: (MArray a e m, Ix i) => (i,i) -> m (a i e) 31 | newListArray, -- :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) 32 | newGenArray, -- :: (MArray a e m, Ix i) => (i,i) -> (i -> m e) -> m (a i e) 33 | 34 | -- * Reading and writing mutable arrays 35 | readArray, -- :: (MArray a e m, Ix i) => a i e -> i -> m e 36 | writeArray, -- :: (MArray a e m, Ix i) => a i e -> i -> e -> m () 37 | 38 | -- * Array folds 39 | foldlMArray', 40 | foldrMArray', 41 | mapMArrayM_, 42 | forMArrayM_, 43 | foldlMArrayM', 44 | foldrMArrayM', 45 | 46 | -- * Derived arrays 47 | mapArray, -- :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) 48 | mapIndices, -- :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) 49 | 50 | -- * Deconstructing mutable arrays 51 | getBounds, -- :: (MArray a e m, Ix i) => a i e -> m (i,i) 52 | getElems, -- :: (MArray a e m, Ix i) => a i e -> m [e] 53 | getAssocs, -- :: (MArray a e m, Ix i) => a i e -> m [(i, e)] 54 | 55 | -- * Conversions between mutable and immutable arrays 56 | freeze, -- :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 57 | thaw, -- :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 58 | ) where 59 | 60 | import Data.Ix 61 | import Data.Array.Base 62 | #ifdef __HADDOCK__ 63 | import Data.Array.IArray 64 | #endif 65 | 66 | -------------------------------------------------------------------------------- /Data/Array/ST.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes, Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array.ST 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : experimental 10 | -- Portability : non-portable (uses Data.Array.MArray) 11 | -- 12 | -- Mutable boxed and unboxed arrays in the 'Control.Monad.ST.ST' monad. 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Data.Array.ST ( 17 | -- * Boxed arrays 18 | STArray, -- instance of: Eq, MArray 19 | runSTArray, 20 | 21 | -- * Unboxed arrays 22 | STUArray, -- instance of: Eq, MArray 23 | runSTUArray, 24 | 25 | -- * Overloaded mutable array interface 26 | module Data.Array.MArray, 27 | ) where 28 | 29 | import Data.Array.Base ( STUArray, UArray, unsafeFreezeSTUArray ) 30 | import Data.Array.MArray 31 | import Control.Monad.ST ( ST, runST ) 32 | 33 | import GHC.Arr ( STArray, Array, unsafeFreezeSTArray ) 34 | 35 | -- | A safe way to create and work with a mutable array before returning an 36 | -- immutable array for later perusal. This function avoids copying 37 | -- the array before returning it - it uses 'unsafeFreeze' internally, but 38 | -- this wrapper is a safe interface to that function. 39 | -- 40 | runSTArray :: (forall s . ST s (STArray s i e)) -> Array i e 41 | runSTArray st = runST (st >>= unsafeFreezeSTArray) 42 | 43 | -- | A safe way to create and work with an unboxed mutable array before 44 | -- returning an immutable array for later perusal. This function 45 | -- avoids copying the array before returning it - it uses 46 | -- 'unsafeFreeze' internally, but this wrapper is a safe interface to 47 | -- that function. 48 | -- 49 | runSTUArray :: (forall s . ST s (STUArray s i e)) -> UArray i e 50 | runSTUArray st = runST (st >>= unsafeFreezeSTUArray) 51 | 52 | 53 | -- INTERESTING... this is the type we'd like to give to runSTUArray: 54 | -- 55 | -- runSTUArray :: (Ix i, IArray UArray e, 56 | -- forall s. MArray (STUArray s) e (ST s)) 57 | -- => (forall s . ST s (STUArray s i e)) 58 | -- -> UArray i e 59 | -- 60 | -- Note the quantified constraint. We dodged the problem by using 61 | -- unsafeFreezeSTUArray directly in the defn of runSTUArray above, but 62 | -- this essentially constrains us to a single unsafeFreeze for all STUArrays 63 | -- (in theory we might have a different one for certain element types). 64 | -------------------------------------------------------------------------------- /Data/Array.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Trustworthy #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Data.Array 5 | -- Copyright : (c) The University of Glasgow 2001 6 | -- License : BSD-style (see the file libraries/base/LICENSE) 7 | -- 8 | -- Maintainer : libraries@haskell.org 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Basic non-strict arrays. 13 | -- 14 | -- /Note:/ The "Data.Array.IArray" module provides a more general interface 15 | -- to immutable arrays: it defines operations with the same names as 16 | -- those defined below, but with more general types, and also defines 17 | -- 'Array' instances of the relevant classes. To use that more general 18 | -- interface, import "Data.Array.IArray" but not "Data.Array". 19 | -- 20 | ----------------------------------------------------------------------------- 21 | 22 | module Data.Array ( 23 | -- * Immutable non-strict arrays 24 | -- $intro 25 | module Data.Ix, -- export all of Ix 26 | Array, -- Array type is abstract 27 | 28 | -- * Array construction 29 | array, -- :: (Ix a) => (a,a) -> [(a,b)] -> Array a b 30 | listArray, -- :: (Ix a) => (a,a) -> [b] -> Array a b 31 | accumArray, -- :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b 32 | -- * Accessing arrays 33 | (!), -- :: (Ix a) => Array a b -> a -> b 34 | bounds, -- :: (Ix a) => Array a b -> (a,a) 35 | indices, -- :: (Ix a) => Array a b -> [a] 36 | elems, -- :: (Ix a) => Array a b -> [b] 37 | assocs, -- :: (Ix a) => Array a b -> [(a,b)] 38 | -- * Incremental array updates 39 | (//), -- :: (Ix a) => Array a b -> [(a,b)] -> Array a b 40 | accum, -- :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b 41 | -- * Derived arrays 42 | ixmap, -- :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a b 43 | 44 | -- Array instances: 45 | -- 46 | -- Ix a => Functor (Array a) 47 | -- (Ix a, Eq b) => Eq (Array a b) 48 | -- (Ix a, Ord b) => Ord (Array a b) 49 | -- (Ix a, Show a, Show b) => Show (Array a b) 50 | -- (Ix a, Read a, Read b) => Read (Array a b) 51 | -- 52 | 53 | -- Implementation checked wrt. Haskell 98 lib report, 1/99. 54 | ) where 55 | 56 | import Data.Ix 57 | import GHC.Arr -- Most of the hard work is done here 58 | 59 | {- $intro 60 | Haskell provides indexable /arrays/, which may be thought of as functions 61 | whose domains are isomorphic to contiguous subsets of the integers. 62 | Functions restricted in this way can be implemented efficiently; 63 | in particular, a programmer may reasonably expect rapid access to 64 | the components. To ensure the possibility of such an implementation, 65 | arrays are treated as data, not as general functions. 66 | 67 | Since most array functions involve the class 'Ix', this module is exported 68 | from "Data.Array" so that modules need not import both "Data.Array" and 69 | "Data.Ix". 70 | -} 71 | 72 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | # Changelog for [`array` package](http://hackage.haskell.org/package/array) 2 | 3 | ## 0.5.8.0 *Aug 2024* 4 | 5 | ### Added 6 | 7 | * Folds for arrays: `foldrArray`, `foldlArray'`, `foldlArray`, `foldrArray'`, 8 | `traverseArray_`, `forArray_`, `foldlArrayM'`, `foldrArrayM'`. 9 | * Folds for mutable arrays: `foldlMArray'`, `foldrMArray'`, `mapMArrayM_`, 10 | `forMArrayM_`, `foldlMArrayM'`, `foldrMArrayM'`. 11 | 12 | ### Fixed 13 | 14 | * Fix a build error that the package can't be buildable before `base-4.14`. 15 | 16 | ## 0.5.7.0 *April 2024* 17 | 18 | ### Changed 19 | 20 | * `MArray` now has a `MINIMAL` pragma 21 | * Optimisation of `newListArray` and `newGenArray` 22 | 23 | ## 0.5.6.0 *July 2023* 24 | 25 | ### Changed 26 | 27 | * `listArray` and `newListArray` are now good consumers of the input list 28 | * Bump base bound to `<4.20` 29 | 30 | ### Added 31 | 32 | * Add the `genArray` and `newGenArray` function 33 | * Add `Data.Array.MArray.modifyArray` and `Data.Array.MArray.modifyArray'` 34 | These are also exposed from `Data.Array.IO`, `Data.Array.ST`, and 35 | `Data.Array.Storable`. 36 | * Add `Data.Array.IArray.(!?)` 37 | 38 | ### Fixed 39 | 40 | * Array docs regarding constructing arrays 41 | * Update note [Inlining and fusion] 42 | * Unboxed Bool arrays no longer cause spurious alarms 43 | when used with `-fcheck-prim-bounds` 44 | * Replace Haddock hide pragma with not-home to make the Haddocks more readable 45 | 46 | ## 0.5.5.0 *February 2022* 47 | 48 | * Compatibility with GHC's new JavaScript backend. 49 | 50 | ## 0.5.4.0 *July 2019* 51 | 52 | * Add a `Read` instance for `UArray` 53 | 54 | ## 0.5.3.0 *Oct 2018* 55 | 56 | * Bundled with GHC 8.6.2 57 | * Drop support for GHC versions prior to GHC 8.0 58 | 59 | ## 0.5.2.0 *Jul 2017* 60 | 61 | * Bundled with GHC 8.2.1 62 | * Overflow check in `unsafeNewArray` (#229) 63 | * Fix and simplify handling of `Bool` arrays 64 | * Export `unsafeFreezeIOUArray` from `Data.Array.IO.Internals` 65 | * Drop support for GHC versions prior to GHC 7.8 66 | 67 | ## 0.5.1.1 *Apr 2016* 68 | 69 | * Bundled with GHC 8.0.1 70 | * Use `@since` syntax in Haddock comments 71 | * Don't needlessly call `bounds` in `Data.Array.Base.elems` (#10014) 72 | 73 | ## 0.5.1.0 *Mar 2015* 74 | 75 | * Bundled with GHC 7.10.1 76 | * Add role annotations for GHC >= 7.8 (#9220) 77 | 78 | ## 0.5.0.0 *Nov 2013* 79 | 80 | * Update to Cabal 1.10 format 81 | * Remove NHC and Hugs specific code 82 | * Remove deprecated function exports `Data.Array.IO.castIOUArray`, 83 | `Data.Array.MArray.unsafeFreeze`, `Data.Array.MArray.unsafeThaw`, 84 | and `Data.Array.ST.castSTUArray`; These functions are still 85 | available from the `Data.Array.Unsafe` module. 86 | 87 | ## 0.4.0.1 *Sep 2012* 88 | 89 | * Bundled with GHC 7.6.1 90 | * Fix inline rule shadowing warnings 91 | 92 | ## 0.4.0.0 *Feb 2012* 93 | 94 | * Bundled with GHC 7.4.1 95 | * Add support for SafeHaskell 96 | * New `Data.Array.IO.Safe` module 97 | * New `Data.Array.MArray.safe` module 98 | * New `Data.Array.ST.safe` module 99 | * New `Data.Array.Storable.Internals` module 100 | * New `Data.Array.Storable.Safe` module 101 | * New `Data.Array.Unsafe` module 102 | -------------------------------------------------------------------------------- /Data/Array/Storable/Internals.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RoleAnnotations #-} 2 | {-# OPTIONS_HADDOCK not-home #-} 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Array.Storable.Internals 6 | -- Copyright : (c) The University of Glasgow 2011 7 | -- License : BSD-style (see the file libraries/base/LICENSE) 8 | -- 9 | -- Maintainer : libraries@haskell.org 10 | -- Stability : experimental 11 | -- Portability : non-portable (uses Data.Array.MArray) 12 | -- 13 | -- Actual implementation of "Data.Array.Storable". 14 | -- 15 | -- @since 0.4.0.0 16 | -- 17 | -- = WARNING 18 | -- 19 | -- This module is considered __internal__. 20 | -- 21 | -- The Package Versioning Policy __does not apply__. 22 | -- 23 | -- The contents of this module may change __in any way whatsoever__ 24 | -- and __without any warning__ between minor versions of this package. 25 | -- 26 | -- Authors importing this module are expected to track development 27 | -- closely. 28 | ----------------------------------------------------------------------------- 29 | 30 | module Data.Array.Storable.Internals ( 31 | StorableArray(..), 32 | withStorableArray, 33 | touchStorableArray, 34 | unsafeForeignPtrToStorableArray, 35 | ) where 36 | 37 | import Data.Array.Base 38 | import Data.Array.MArray 39 | import Foreign hiding (newArray) 40 | 41 | -- |The array type 42 | data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e) 43 | -- Both parameters have class-based invariants. See also #9220. 44 | type role StorableArray nominal nominal 45 | 46 | instance Storable e => MArray StorableArray e IO where 47 | getBounds (StorableArray l u _ _) = return (l,u) 48 | 49 | getNumElements (StorableArray _l _u n _) = return n 50 | 51 | newArray (l,u) initialValue = do 52 | fp <- mallocForeignPtrArray size 53 | withForeignPtr fp $ \a -> 54 | sequence_ [pokeElemOff a i initialValue | i <- [0..size-1]] 55 | return (StorableArray l u size fp) 56 | where 57 | size = rangeSize (l,u) 58 | 59 | unsafeNewArray_ (l,u) = do 60 | let n = rangeSize (l,u) 61 | fp <- mallocForeignPtrArray n 62 | return (StorableArray l u n fp) 63 | 64 | newArray_ = unsafeNewArray_ 65 | 66 | unsafeRead (StorableArray _ _ _ fp) i = 67 | withForeignPtr fp $ \a -> peekElemOff a i 68 | 69 | unsafeWrite (StorableArray _ _ _ fp) i e = 70 | withForeignPtr fp $ \a -> pokeElemOff a i e 71 | 72 | -- |The pointer to the array contents is obtained by 'withStorableArray'. 73 | -- The idea is similar to 'ForeignPtr' (used internally here). 74 | -- The pointer should be used only during execution of the 'IO' action 75 | -- retured by the function passed as argument to 'withStorableArray'. 76 | withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a 77 | withStorableArray (StorableArray _ _ _ fp) f = withForeignPtr fp f 78 | 79 | -- |If you want to use it afterwards, ensure that you 80 | -- 'touchStorableArray' after the last use of the pointer, 81 | -- so the array is not freed too early. 82 | touchStorableArray :: StorableArray i e -> IO () 83 | touchStorableArray (StorableArray _ _ _ fp) = touchForeignPtr fp 84 | 85 | -- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'. It is 86 | -- the caller's responsibility to ensure that the 'ForeignPtr' points to 87 | -- an area of memory sufficient for the specified bounds. 88 | unsafeForeignPtrToStorableArray 89 | :: Ix i => ForeignPtr e -> (i,i) -> IO (StorableArray i e) 90 | unsafeForeignPtrToStorableArray p (l,u) = 91 | return (StorableArray l u (rangeSize (l,u)) p) 92 | 93 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This library (libraries/base) is derived from code from several 2 | sources: 3 | 4 | * Code from the GHC project which is largely (c) The University of 5 | Glasgow, and distributable under a BSD-style license (see below), 6 | 7 | * Code from the Haskell 98 Report which is (c) Simon Peyton Jones 8 | and freely redistributable (but see the full license for 9 | restrictions). 10 | 11 | * Code from the Haskell Foreign Function Interface specification, 12 | which is (c) Manuel M. T. Chakravarty and freely redistributable 13 | (but see the full license for restrictions). 14 | 15 | The full text of these licenses is reproduced below. All of the 16 | licenses are BSD-style or compatible. 17 | 18 | ----------------------------------------------------------------------------- 19 | 20 | The Glasgow Haskell Compiler License 21 | 22 | Copyright 2004, The University Court of the University of Glasgow. 23 | All rights reserved. 24 | 25 | Redistribution and use in source and binary forms, with or without 26 | modification, are permitted provided that the following conditions are met: 27 | 28 | - Redistributions of source code must retain the above copyright notice, 29 | this list of conditions and the following disclaimer. 30 | 31 | - Redistributions in binary form must reproduce the above copyright notice, 32 | this list of conditions and the following disclaimer in the documentation 33 | and/or other materials provided with the distribution. 34 | 35 | - Neither name of the University nor the names of its contributors may be 36 | used to endorse or promote products derived from this software without 37 | specific prior written permission. 38 | 39 | THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF 40 | GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, 41 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 42 | FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 43 | UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE 44 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 45 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 46 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 47 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 48 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 49 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH 50 | DAMAGE. 51 | 52 | ----------------------------------------------------------------------------- 53 | 54 | Code derived from the document "Report on the Programming Language 55 | Haskell 98", is distributed under the following license: 56 | 57 | Copyright (c) 2002 Simon Peyton Jones 58 | 59 | The authors intend this Report to belong to the entire Haskell 60 | community, and so we grant permission to copy and distribute it for 61 | any purpose, provided that it is reproduced in its entirety, 62 | including this Notice. Modified versions of this Report may also be 63 | copied and distributed for any purpose, provided that the modified 64 | version is clearly presented as such, and that it does not claim to 65 | be a definition of the Haskell 98 Language. 66 | 67 | ----------------------------------------------------------------------------- 68 | 69 | Code derived from the document "The Haskell 98 Foreign Function 70 | Interface, An Addendum to the Haskell 98 Report" is distributed under 71 | the following license: 72 | 73 | Copyright (c) 2002 Manuel M. T. Chakravarty 74 | 75 | The authors intend this Report to belong to the entire Haskell 76 | community, and so we grant permission to copy and distribute it for 77 | any purpose, provided that it is reproduced in its entirety, 78 | including this Notice. Modified versions of this Report may also be 79 | copied and distributed for any purpose, provided that the modified 80 | version is clearly presented as such, and that it does not claim to 81 | be a definition of the Haskell 98 Foreign Function Interface. 82 | 83 | ----------------------------------------------------------------------------- 84 | 85 | -------------------------------------------------------------------------------- /Data/Array/IO.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MagicHash, Trustworthy, UnliftedFFITypes #-} 2 | 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Data.Array.IO 6 | -- Copyright : (c) The University of Glasgow 2001 7 | -- License : BSD-style (see the file libraries/base/LICENSE) 8 | -- 9 | -- Maintainer : libraries@haskell.org 10 | -- Stability : experimental 11 | -- Portability : non-portable (uses Data.Array.MArray) 12 | -- 13 | -- Mutable boxed and unboxed arrays in the IO monad. 14 | -- 15 | ----------------------------------------------------------------------------- 16 | 17 | module Data.Array.IO ( 18 | -- * @IO@ arrays with boxed elements 19 | IOArray, -- instance of: Eq, Typeable 20 | 21 | -- * @IO@ arrays with unboxed elements 22 | IOUArray, -- instance of: Eq, Typeable 23 | 24 | -- * Overloaded mutable array interface 25 | module Data.Array.MArray, 26 | 27 | -- * Doing I\/O with @IOUArray@s 28 | hGetArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO Int 29 | hPutArray, -- :: Handle -> IOUArray Int Word8 -> Int -> IO () 30 | ) where 31 | 32 | import Data.Array.Base 33 | import Data.Array.IO.Internals 34 | import Data.Array.MArray 35 | import System.IO.Error 36 | 37 | import Foreign 38 | import Foreign.C 39 | 40 | import GHC.Exts (MutableByteArray#, RealWorld) 41 | import GHC.IO.Handle 42 | import GHC.IO.Exception 43 | 44 | -- --------------------------------------------------------------------------- 45 | -- hGetArray 46 | 47 | -- | Reads a number of 'Word8's from the specified 'Handle' directly 48 | -- into an array. 49 | hGetArray 50 | :: Handle -- ^ Handle to read from 51 | -> IOUArray Int Word8 -- ^ Array in which to place the values 52 | -> Int -- ^ Number of 'Word8's to read 53 | -> IO Int 54 | -- ^ Returns: the number of 'Word8's actually 55 | -- read, which might be smaller than the number requested 56 | -- if the end of file was reached. 57 | 58 | hGetArray handle (IOUArray (STUArray _l _u n ptr)) count 59 | | count == 0 = return 0 60 | | count < 0 || count > n = illegalBufferSize handle "hGetArray" count 61 | | otherwise = do 62 | -- we would like to read directly into the buffer, but we can't 63 | -- be sure that the MutableByteArray# is pinned, so we have to 64 | -- allocate a separate area of memory and copy. 65 | allocaBytes count $ \p -> do 66 | r <- hGetBuf handle p count 67 | _ <- memcpy_ba_ptr ptr p (fromIntegral r) 68 | return r 69 | 70 | foreign import ccall unsafe "memcpy" 71 | memcpy_ba_ptr :: MutableByteArray# RealWorld -> Ptr a -> CSize -> IO (Ptr ()) 72 | 73 | -- --------------------------------------------------------------------------- 74 | -- hPutArray 75 | 76 | -- | Writes an array of 'Word8' to the specified 'Handle'. 77 | hPutArray 78 | :: Handle -- ^ Handle to write to 79 | -> IOUArray Int Word8 -- ^ Array to write from 80 | -> Int -- ^ Number of 'Word8's to write 81 | -> IO () 82 | 83 | hPutArray handle (IOUArray (STUArray _l _u n raw)) count 84 | | count == 0 = return () 85 | | count < 0 || count > n = illegalBufferSize handle "hPutArray" count 86 | | otherwise = do 87 | -- as in hGetArray, we would like to use the array directly, but 88 | -- we can't be sure that the MutableByteArray# is pinned. 89 | allocaBytes count $ \p -> do 90 | _ <- memcpy_ptr_ba p raw (fromIntegral count) 91 | hPutBuf handle p count 92 | 93 | foreign import ccall unsafe "memcpy" 94 | memcpy_ptr_ba :: Ptr a -> MutableByteArray# RealWorld -> CSize -> IO (Ptr ()) 95 | 96 | -- --------------------------------------------------------------------------- 97 | -- Internal Utils 98 | 99 | illegalBufferSize :: Handle -> String -> Int -> IO a 100 | illegalBufferSize handle fn sz = 101 | ioException (ioeSetErrorString 102 | (mkIOError InvalidArgument fn (Just handle) Nothing) 103 | ("illegal buffer size " ++ showsPrec 9 (sz::Int) [])) 104 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This Travis job script has been generated by a script via 2 | # 3 | # runghc make_travis_yml_2.hs 'array.cabal' 4 | # 5 | # For more information, see https://github.com/hvr/multi-ghc-travis 6 | # 7 | language: c 8 | sudo: false 9 | 10 | git: 11 | submodules: false # whether to recursively clone submodules 12 | 13 | cache: 14 | directories: 15 | - $HOME/.cabal/packages 16 | - $HOME/.cabal/store 17 | 18 | before_cache: 19 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log 20 | # remove files that are regenerated by 'cabal update' 21 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* 22 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json 23 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache 24 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar 25 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx 26 | 27 | - rm -rfv $HOME/.cabal/packages/head.hackage 28 | 29 | matrix: 30 | include: 31 | - compiler: "ghc-8.0.2" 32 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 33 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}} 34 | - compiler: "ghc-8.2.1" 35 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 36 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} 37 | - compiler: "ghc-8.4.2" 38 | # env: TEST=--disable-tests BENCH=--disable-benchmarks 39 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.2], sources: [hvr-ghc]}} 40 | - compiler: "ghc-head" 41 | addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} 42 | 43 | allow_failures: 44 | - compiler: "ghc-head" 45 | 46 | before_install: 47 | - HC=${CC} 48 | - HCPKG=${HC/ghc/ghc-pkg} 49 | - unset CC 50 | - ROOTDIR=$(pwd) 51 | - mkdir -p $HOME/.local/bin 52 | - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" 53 | - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) 54 | - echo $HCNUMVER 55 | 56 | install: 57 | - cabal --version 58 | - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 59 | - BENCH=${BENCH---enable-benchmarks} 60 | - TEST=${TEST---enable-tests} 61 | - HADDOCK=${HADDOCK-true} 62 | - INSTALLED=${INSTALLED-true} 63 | - GHCHEAD=${GHCHEAD-false} 64 | - travis_retry cabal update -v 65 | - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" 66 | - rm -fv cabal.project cabal.project.local 67 | - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' 68 | - "printf 'packages: \".\"\\n' > cabal.project" 69 | - cat cabal.project 70 | - if [ -f "./configure.ac" ]; then 71 | (cd "." && autoreconf -i); 72 | fi 73 | - rm -f cabal.project.freeze 74 | - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all 75 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all 76 | - rm -rf .ghc.environment.* "."/dist 77 | - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) 78 | 79 | # Here starts the actual work to be performed for the package under test; 80 | # any command which exits with a non-zero exit code causes the build to fail. 81 | script: 82 | # test that source-distributions can be generated 83 | - (cd "." && cabal sdist) 84 | - mv "."/dist/array-*.tar.gz ${DISTDIR}/ 85 | - cd ${DISTDIR} || false 86 | - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; 87 | - "printf 'packages: array-*/*.cabal\\n' > cabal.project" 88 | - cat cabal.project 89 | # this builds all libraries and executables (without tests/benchmarks) 90 | - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all 91 | 92 | # # Build with installed constraints for packages in global-db 93 | # - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi 94 | 95 | # build & run tests, build benchmarks 96 | - cabal new-build -w ${HC} ${TEST} ${BENCH} all 97 | 98 | # cabal check 99 | - (cd array-* && cabal check) 100 | 101 | # haddock 102 | - rm -rf ./dist-newstyle 103 | - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi 104 | 105 | # REGENDATA ["array.cabal"] 106 | # EOF 107 | -------------------------------------------------------------------------------- /Data/Array/IO/Internals.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE 2 | FlexibleInstances 3 | , MultiParamTypeClasses 4 | , RoleAnnotations 5 | #-} 6 | 7 | {-# OPTIONS_HADDOCK not-home #-} 8 | ----------------------------------------------------------------------------- 9 | -- | 10 | -- Module : Data.Array.IO.Internal 11 | -- Copyright : (c) The University of Glasgow 2001-2012 12 | -- License : BSD-style (see the file libraries/base/LICENSE) 13 | -- 14 | -- Maintainer : libraries@haskell.org 15 | -- Stability : experimental 16 | -- Portability : non-portable (uses Data.Array.Base) 17 | -- 18 | -- Mutable boxed and unboxed arrays in the IO monad. 19 | -- 20 | -- = WARNING 21 | -- 22 | -- This module is considered __internal__. 23 | -- 24 | -- The Package Versioning Policy __does not apply__. 25 | -- 26 | -- The contents of this module may change __in any way whatsoever__ 27 | -- and __without any warning__ between minor versions of this package. 28 | -- 29 | -- Authors importing this module are expected to track development 30 | -- closely. 31 | -- 32 | ----------------------------------------------------------------------------- 33 | 34 | module Data.Array.IO.Internals ( 35 | IOArray(..), -- instance of: Eq, Typeable 36 | IOUArray(..), -- instance of: Eq, Typeable 37 | castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b) 38 | unsafeThawIOUArray, 39 | unsafeFreezeIOUArray 40 | ) where 41 | 42 | import Data.Int 43 | import Data.Word 44 | 45 | import Control.Monad.ST ( RealWorld, stToIO ) 46 | import Foreign.Ptr ( Ptr, FunPtr ) 47 | import Foreign.StablePtr ( StablePtr ) 48 | 49 | import Data.Array.Base 50 | 51 | import GHC.IOArray (IOArray(..)) 52 | 53 | ----------------------------------------------------------------------------- 54 | -- Flat unboxed mutable arrays (IO monad) 55 | 56 | -- | Mutable, unboxed, strict arrays in the 'IO' monad. The type 57 | -- arguments are as follows: 58 | -- 59 | -- * @i@: the index type of the array (should be an instance of 'Ix') 60 | -- 61 | -- * @e@: the element type of the array. Only certain element types 62 | -- are supported: see "Data.Array.MArray" for a list of instances. 63 | -- 64 | newtype IOUArray i e = IOUArray (STUArray RealWorld i e) 65 | -- Both parameters have class-based invariants. See also #9220. 66 | type role IOUArray nominal nominal 67 | 68 | instance Eq (IOUArray i e) where 69 | IOUArray s1 == IOUArray s2 = s1 == s2 70 | 71 | instance MArray IOUArray Bool IO where 72 | {-# INLINE getBounds #-} 73 | getBounds (IOUArray arr) = stToIO $ getBounds arr 74 | {-# INLINE getNumElements #-} 75 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 76 | {-# INLINE newArray #-} 77 | newArray lu initialValue = stToIO $ do 78 | marr <- newArray lu initialValue; return (IOUArray marr) 79 | {-# INLINE unsafeNewArray_ #-} 80 | unsafeNewArray_ lu = stToIO $ do 81 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 82 | {-# INLINE newArray_ #-} 83 | newArray_ = unsafeNewArray_ 84 | {-# INLINE unsafeRead #-} 85 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 86 | {-# INLINE unsafeWrite #-} 87 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 88 | 89 | instance MArray IOUArray Char IO where 90 | {-# INLINE getBounds #-} 91 | getBounds (IOUArray arr) = stToIO $ getBounds arr 92 | {-# INLINE getNumElements #-} 93 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 94 | {-# INLINE newArray #-} 95 | newArray lu initialValue = stToIO $ do 96 | marr <- newArray lu initialValue; return (IOUArray marr) 97 | {-# INLINE unsafeNewArray_ #-} 98 | unsafeNewArray_ lu = stToIO $ do 99 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 100 | {-# INLINE newArray_ #-} 101 | newArray_ = unsafeNewArray_ 102 | {-# INLINE unsafeRead #-} 103 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 104 | {-# INLINE unsafeWrite #-} 105 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 106 | 107 | instance MArray IOUArray Int IO where 108 | {-# INLINE getBounds #-} 109 | getBounds (IOUArray arr) = stToIO $ getBounds arr 110 | {-# INLINE getNumElements #-} 111 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 112 | {-# INLINE newArray #-} 113 | newArray lu initialValue = stToIO $ do 114 | marr <- newArray lu initialValue; return (IOUArray marr) 115 | {-# INLINE unsafeNewArray_ #-} 116 | unsafeNewArray_ lu = stToIO $ do 117 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 118 | {-# INLINE newArray_ #-} 119 | newArray_ = unsafeNewArray_ 120 | {-# INLINE unsafeRead #-} 121 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 122 | {-# INLINE unsafeWrite #-} 123 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 124 | 125 | instance MArray IOUArray Word IO where 126 | {-# INLINE getBounds #-} 127 | getBounds (IOUArray arr) = stToIO $ getBounds arr 128 | {-# INLINE getNumElements #-} 129 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 130 | {-# INLINE newArray #-} 131 | newArray lu initialValue = stToIO $ do 132 | marr <- newArray lu initialValue; return (IOUArray marr) 133 | {-# INLINE unsafeNewArray_ #-} 134 | unsafeNewArray_ lu = stToIO $ do 135 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 136 | {-# INLINE newArray_ #-} 137 | newArray_ = unsafeNewArray_ 138 | {-# INLINE unsafeRead #-} 139 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 140 | {-# INLINE unsafeWrite #-} 141 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 142 | 143 | instance MArray IOUArray (Ptr a) IO where 144 | {-# INLINE getBounds #-} 145 | getBounds (IOUArray arr) = stToIO $ getBounds arr 146 | {-# INLINE getNumElements #-} 147 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 148 | {-# INLINE newArray #-} 149 | newArray lu initialValue = stToIO $ do 150 | marr <- newArray lu initialValue; return (IOUArray marr) 151 | {-# INLINE unsafeNewArray_ #-} 152 | unsafeNewArray_ lu = stToIO $ do 153 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 154 | {-# INLINE newArray_ #-} 155 | newArray_ = unsafeNewArray_ 156 | {-# INLINE unsafeRead #-} 157 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 158 | {-# INLINE unsafeWrite #-} 159 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 160 | 161 | instance MArray IOUArray (FunPtr a) IO where 162 | {-# INLINE getBounds #-} 163 | getBounds (IOUArray arr) = stToIO $ getBounds arr 164 | {-# INLINE getNumElements #-} 165 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 166 | {-# INLINE newArray #-} 167 | newArray lu initialValue = stToIO $ do 168 | marr <- newArray lu initialValue; return (IOUArray marr) 169 | {-# INLINE unsafeNewArray_ #-} 170 | unsafeNewArray_ lu = stToIO $ do 171 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 172 | {-# INLINE newArray_ #-} 173 | newArray_ = unsafeNewArray_ 174 | {-# INLINE unsafeRead #-} 175 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 176 | {-# INLINE unsafeWrite #-} 177 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 178 | 179 | instance MArray IOUArray Float IO where 180 | {-# INLINE getBounds #-} 181 | getBounds (IOUArray arr) = stToIO $ getBounds arr 182 | {-# INLINE getNumElements #-} 183 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 184 | {-# INLINE newArray #-} 185 | newArray lu initialValue = stToIO $ do 186 | marr <- newArray lu initialValue; return (IOUArray marr) 187 | {-# INLINE unsafeNewArray_ #-} 188 | unsafeNewArray_ lu = stToIO $ do 189 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 190 | {-# INLINE newArray_ #-} 191 | newArray_ = unsafeNewArray_ 192 | {-# INLINE unsafeRead #-} 193 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 194 | {-# INLINE unsafeWrite #-} 195 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 196 | 197 | instance MArray IOUArray Double IO where 198 | {-# INLINE getBounds #-} 199 | getBounds (IOUArray arr) = stToIO $ getBounds arr 200 | {-# INLINE getNumElements #-} 201 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 202 | {-# INLINE newArray #-} 203 | newArray lu initialValue = stToIO $ do 204 | marr <- newArray lu initialValue; return (IOUArray marr) 205 | {-# INLINE unsafeNewArray_ #-} 206 | unsafeNewArray_ lu = stToIO $ do 207 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 208 | {-# INLINE newArray_ #-} 209 | newArray_ = unsafeNewArray_ 210 | {-# INLINE unsafeRead #-} 211 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 212 | {-# INLINE unsafeWrite #-} 213 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 214 | 215 | instance MArray IOUArray (StablePtr a) IO where 216 | {-# INLINE getBounds #-} 217 | getBounds (IOUArray arr) = stToIO $ getBounds arr 218 | {-# INLINE getNumElements #-} 219 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 220 | {-# INLINE newArray #-} 221 | newArray lu initialValue = stToIO $ do 222 | marr <- newArray lu initialValue; return (IOUArray marr) 223 | {-# INLINE unsafeNewArray_ #-} 224 | unsafeNewArray_ lu = stToIO $ do 225 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 226 | {-# INLINE newArray_ #-} 227 | newArray_ = unsafeNewArray_ 228 | {-# INLINE unsafeRead #-} 229 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 230 | {-# INLINE unsafeWrite #-} 231 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 232 | 233 | instance MArray IOUArray Int8 IO where 234 | {-# INLINE getBounds #-} 235 | getBounds (IOUArray arr) = stToIO $ getBounds arr 236 | {-# INLINE getNumElements #-} 237 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 238 | {-# INLINE newArray #-} 239 | newArray lu initialValue = stToIO $ do 240 | marr <- newArray lu initialValue; return (IOUArray marr) 241 | {-# INLINE unsafeNewArray_ #-} 242 | unsafeNewArray_ lu = stToIO $ do 243 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 244 | {-# INLINE newArray_ #-} 245 | newArray_ = unsafeNewArray_ 246 | {-# INLINE unsafeRead #-} 247 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 248 | {-# INLINE unsafeWrite #-} 249 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 250 | 251 | instance MArray IOUArray Int16 IO where 252 | {-# INLINE getBounds #-} 253 | getBounds (IOUArray arr) = stToIO $ getBounds arr 254 | {-# INLINE getNumElements #-} 255 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 256 | {-# INLINE newArray #-} 257 | newArray lu initialValue = stToIO $ do 258 | marr <- newArray lu initialValue; return (IOUArray marr) 259 | {-# INLINE unsafeNewArray_ #-} 260 | unsafeNewArray_ lu = stToIO $ do 261 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 262 | {-# INLINE newArray_ #-} 263 | newArray_ = unsafeNewArray_ 264 | {-# INLINE unsafeRead #-} 265 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 266 | {-# INLINE unsafeWrite #-} 267 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 268 | 269 | instance MArray IOUArray Int32 IO where 270 | {-# INLINE getBounds #-} 271 | getBounds (IOUArray arr) = stToIO $ getBounds arr 272 | {-# INLINE getNumElements #-} 273 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 274 | {-# INLINE newArray #-} 275 | newArray lu initialValue = stToIO $ do 276 | marr <- newArray lu initialValue; return (IOUArray marr) 277 | {-# INLINE unsafeNewArray_ #-} 278 | unsafeNewArray_ lu = stToIO $ do 279 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 280 | {-# INLINE newArray_ #-} 281 | newArray_ = unsafeNewArray_ 282 | {-# INLINE unsafeRead #-} 283 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 284 | {-# INLINE unsafeWrite #-} 285 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 286 | 287 | instance MArray IOUArray Int64 IO where 288 | {-# INLINE getBounds #-} 289 | getBounds (IOUArray arr) = stToIO $ getBounds arr 290 | {-# INLINE getNumElements #-} 291 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 292 | {-# INLINE newArray #-} 293 | newArray lu initialValue = stToIO $ do 294 | marr <- newArray lu initialValue; return (IOUArray marr) 295 | {-# INLINE unsafeNewArray_ #-} 296 | unsafeNewArray_ lu = stToIO $ do 297 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 298 | {-# INLINE newArray_ #-} 299 | newArray_ = unsafeNewArray_ 300 | {-# INLINE unsafeRead #-} 301 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 302 | {-# INLINE unsafeWrite #-} 303 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 304 | 305 | instance MArray IOUArray Word8 IO where 306 | {-# INLINE getBounds #-} 307 | getBounds (IOUArray arr) = stToIO $ getBounds arr 308 | {-# INLINE getNumElements #-} 309 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 310 | {-# INLINE newArray #-} 311 | newArray lu initialValue = stToIO $ do 312 | marr <- newArray lu initialValue; return (IOUArray marr) 313 | {-# INLINE unsafeNewArray_ #-} 314 | unsafeNewArray_ lu = stToIO $ do 315 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 316 | {-# INLINE newArray_ #-} 317 | newArray_ = unsafeNewArray_ 318 | {-# INLINE unsafeRead #-} 319 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 320 | {-# INLINE unsafeWrite #-} 321 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 322 | 323 | instance MArray IOUArray Word16 IO where 324 | {-# INLINE getBounds #-} 325 | getBounds (IOUArray arr) = stToIO $ getBounds arr 326 | {-# INLINE getNumElements #-} 327 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 328 | {-# INLINE newArray #-} 329 | newArray lu initialValue = stToIO $ do 330 | marr <- newArray lu initialValue; return (IOUArray marr) 331 | {-# INLINE unsafeNewArray_ #-} 332 | unsafeNewArray_ lu = stToIO $ do 333 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 334 | {-# INLINE newArray_ #-} 335 | newArray_ = unsafeNewArray_ 336 | {-# INLINE unsafeRead #-} 337 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 338 | {-# INLINE unsafeWrite #-} 339 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 340 | 341 | instance MArray IOUArray Word32 IO where 342 | {-# INLINE getBounds #-} 343 | getBounds (IOUArray arr) = stToIO $ getBounds arr 344 | {-# INLINE getNumElements #-} 345 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 346 | {-# INLINE newArray #-} 347 | newArray lu initialValue = stToIO $ do 348 | marr <- newArray lu initialValue; return (IOUArray marr) 349 | {-# INLINE unsafeNewArray_ #-} 350 | unsafeNewArray_ lu = stToIO $ do 351 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 352 | {-# INLINE newArray_ #-} 353 | newArray_ = unsafeNewArray_ 354 | {-# INLINE unsafeRead #-} 355 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 356 | {-# INLINE unsafeWrite #-} 357 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 358 | 359 | instance MArray IOUArray Word64 IO where 360 | {-# INLINE getBounds #-} 361 | getBounds (IOUArray arr) = stToIO $ getBounds arr 362 | {-# INLINE getNumElements #-} 363 | getNumElements (IOUArray arr) = stToIO $ getNumElements arr 364 | {-# INLINE newArray #-} 365 | newArray lu initialValue = stToIO $ do 366 | marr <- newArray lu initialValue; return (IOUArray marr) 367 | {-# INLINE unsafeNewArray_ #-} 368 | unsafeNewArray_ lu = stToIO $ do 369 | marr <- unsafeNewArray_ lu; return (IOUArray marr) 370 | {-# INLINE newArray_ #-} 371 | newArray_ = unsafeNewArray_ 372 | {-# INLINE unsafeRead #-} 373 | unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) 374 | {-# INLINE unsafeWrite #-} 375 | unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) 376 | 377 | -- | Casts an 'IOUArray' with one element type into one with a 378 | -- different element type. All the elements of the resulting array 379 | -- are undefined (unless you know what you\'re doing...). 380 | castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) 381 | castIOUArray (IOUArray marr) = stToIO $ do 382 | marr' <- castSTUArray marr 383 | return (IOUArray marr') 384 | 385 | {-# INLINE unsafeThawIOUArray #-} 386 | unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e) 387 | unsafeThawIOUArray arr = stToIO $ do 388 | marr <- unsafeThawSTUArray arr 389 | return (IOUArray marr) 390 | 391 | {-# RULES 392 | "unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray 393 | #-} 394 | 395 | thawIOUArray :: UArray ix e -> IO (IOUArray ix e) 396 | thawIOUArray arr = stToIO $ do 397 | marr <- thawSTUArray arr 398 | return (IOUArray marr) 399 | 400 | {-# RULES 401 | "thaw/IOUArray" thaw = thawIOUArray 402 | #-} 403 | 404 | {-# INLINE unsafeFreezeIOUArray #-} 405 | unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e) 406 | unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr) 407 | 408 | {-# RULES 409 | "unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray 410 | #-} 411 | 412 | freezeIOUArray :: IOUArray ix e -> IO (UArray ix e) 413 | freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr) 414 | 415 | {-# RULES 416 | "freeze/IOUArray" freeze = freezeIOUArray 417 | #-} 418 | -------------------------------------------------------------------------------- /Data/Array/Base.hs: -------------------------------------------------------------------------------- 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 not-home #-} 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 | -- = WARNING 29 | -- 30 | -- This module is considered __internal__. 31 | -- 32 | -- The Package Versioning Policy __does not apply__. 33 | -- 34 | -- The contents of this module may change __in any way whatsoever__ 35 | -- and __without any warning__ between minor versions of this package. 36 | -- 37 | -- Authors importing this module are expected to track development 38 | -- closely. 39 | ----------------------------------------------------------------------------- 40 | 41 | module Data.Array.Base where 42 | 43 | import Control.Monad.ST.Lazy ( strictToLazyST ) 44 | import qualified Control.Monad.ST.Lazy as Lazy (ST) 45 | import Data.Ix ( Ix, range, index, inRange, rangeSize ) 46 | import Foreign.C.Types 47 | import Foreign.StablePtr 48 | 49 | import Data.Char 50 | import GHC.Arr ( STArray, unsafeIndex ) 51 | import qualified GHC.Arr as Arr 52 | import qualified GHC.Arr as ArrST 53 | import GHC.ST ( ST(..), runST ) 54 | import GHC.Base ( IO(..), divInt# ) 55 | import GHC.Exts 56 | import GHC.Ptr ( nullPtr, nullFunPtr ) 57 | import GHC.Show ( appPrec ) 58 | import GHC.Stable ( StablePtr(..) ) 59 | import GHC.Read ( expectP, parens, Read(..) ) 60 | import GHC.Int ( Int8(..), Int16(..), Int32(..), Int64(..) ) 61 | import GHC.Word ( Word8(..), Word16(..), Word32(..), Word64(..) ) 62 | import GHC.IO ( stToIO ) 63 | import GHC.IOArray ( IOArray(..), 64 | newIOArray, unsafeReadIOArray, unsafeWriteIOArray ) 65 | import Text.Read.Lex ( Lexeme(Ident) ) 66 | import Text.ParserCombinators.ReadPrec ( prec, ReadPrec, step ) 67 | 68 | #include "MachDeps.h" 69 | 70 | ----------------------------------------------------------------------------- 71 | -- Class of immutable arrays 72 | 73 | {- | Class of immutable array types. 74 | 75 | An array type has the form @(a i e)@ where @a@ is the array type 76 | constructor (kind @* -> * -> *@), @i@ is the index type (a member of 77 | the class 'Ix'), and @e@ is the element type. The @IArray@ class is 78 | parameterised over both @a@ and @e@, so that instances specialised to 79 | certain element types can be defined. 80 | -} 81 | class IArray a e where 82 | -- | Extracts the bounds of an immutable array 83 | bounds :: Ix i => a i e -> (i,i) 84 | numElements :: Ix i => a i e -> Int 85 | unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> a i e 86 | unsafeAt :: Ix i => a i e -> Int -> e 87 | unsafeReplace :: Ix i => a i e -> [(Int, e)] -> a i e 88 | unsafeAccum :: Ix i => (e -> e' -> e) -> a i e -> [(Int, e')] -> a i e 89 | unsafeAccumArray :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> a i e 90 | 91 | unsafeReplace arr ies = runST (unsafeReplaceST arr ies >>= unsafeFreeze) 92 | unsafeAccum f arr ies = runST (unsafeAccumST f arr ies >>= unsafeFreeze) 93 | unsafeAccumArray f e lu ies = runST (unsafeAccumArrayST f e lu ies >>= unsafeFreeze) 94 | 95 | {-# INLINE safeRangeSize #-} 96 | safeRangeSize :: Ix i => (i, i) -> Int 97 | safeRangeSize (l,u) = let r = rangeSize (l, u) 98 | in if r < 0 then error "Negative range size" 99 | else r 100 | 101 | {-# INLINE safeIndex #-} 102 | safeIndex :: Ix i => (i, i) -> Int -> i -> Int 103 | safeIndex (l,u) n i = let i' = index (l,u) i 104 | in if (0 <= i') && (i' < n) 105 | then i' 106 | else error ("Error in array index; " ++ show i' ++ 107 | " not in range [0.." ++ show n ++ ")") 108 | 109 | {-# INLINE unsafeReplaceST #-} 110 | unsafeReplaceST :: (IArray a e, Ix i) => a i e -> [(Int, e)] -> ST s (STArray s i e) 111 | unsafeReplaceST arr ies = do 112 | marr <- thaw arr 113 | sequence_ [unsafeWrite marr i e | (i, e) <- ies] 114 | return marr 115 | 116 | {-# INLINE unsafeAccumST #-} 117 | unsafeAccumST :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(Int, e')] -> ST s (STArray s i e) 118 | unsafeAccumST f arr ies = do 119 | marr <- thaw arr 120 | sequence_ [do old <- unsafeRead marr i 121 | unsafeWrite marr i (f old new) 122 | | (i, new) <- ies] 123 | return marr 124 | 125 | {-# INLINE unsafeAccumArrayST #-} 126 | unsafeAccumArrayST :: Ix i => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (STArray s i e) 127 | unsafeAccumArrayST f e (l,u) ies = do 128 | marr <- newArray (l,u) e 129 | sequence_ [do old <- unsafeRead marr i 130 | unsafeWrite marr i (f old new) 131 | | (i, new) <- ies] 132 | return marr 133 | 134 | 135 | {-# INLINE array #-} 136 | 137 | {-| Constructs an immutable array from a pair of bounds and a list of 138 | initial associations. 139 | 140 | The bounds are specified as a pair of the lowest and highest bounds in 141 | the array respectively. For example, a one-origin vector of length 10 142 | has bounds (1,10), and a one-origin 10 by 10 matrix has bounds 143 | ((1,1),(10,10)). 144 | 145 | An association is a pair of the form @(i,x)@, which defines the value of 146 | the array at index @i@ to be @x@. The array is undefined if any index 147 | in the list is out of bounds. If any two associations in the list have 148 | the same index, the value at that index is implementation-dependent. 149 | (In GHC, the last value specified for that index is used. 150 | Other implementations will also do this for unboxed arrays, but Haskell 151 | 98 requires that for 'Array' the value at such indices is bottom.) 152 | 153 | Because the indices must be checked for these errors, 'array' is 154 | strict in the bounds argument and in the indices of the association 155 | list. Whether @array@ is strict or non-strict in the elements depends 156 | on the array type: 'Data.Array.Array' is a non-strict array type, but 157 | all of the 'Data.Array.Unboxed.UArray' arrays are strict. Thus in a 158 | non-strict array, recurrences such as the following are possible: 159 | 160 | > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i \<- [2..100]]) 161 | 162 | Not every index within the bounds of the array need appear in the 163 | association list, but the values associated with indices that do not 164 | appear will be undefined. 165 | 166 | If, in any dimension, the lower bound is greater than the upper bound, 167 | then the array is legal, but empty. Indexing an empty array always 168 | gives an array-bounds error, but 'bounds' still yields the bounds with 169 | which the array was constructed. 170 | -} 171 | array :: (IArray a e, Ix i) 172 | => (i,i) -- ^ bounds of the array: (lowest,highest) 173 | -> [(i, e)] -- ^ list of associations 174 | -> a i e 175 | array (l,u) ies 176 | = let n = safeRangeSize (l,u) 177 | in unsafeArray (l,u) 178 | [(safeIndex (l,u) n i, e) | (i, e) <- ies] 179 | 180 | -- Since unsafeFreeze is not guaranteed to be only a cast, we will 181 | -- use unsafeArray and zip instead of a specialized loop to implement 182 | -- listArray, unlike Array.listArray, even though it generates some 183 | -- unnecessary heap allocation. Will use the loop only when we have 184 | -- fast unsafeFreeze, namely for Array and UArray (well, they cover 185 | -- almost all cases). 186 | 187 | {-# INLINE [1] listArray #-} 188 | 189 | -- | Constructs an immutable array from a list of initial elements. 190 | -- The list gives the elements of the array in ascending order 191 | -- beginning with the lowest index. 192 | listArray :: (IArray a e, Ix i) => (i,i) -> [e] -> a i e 193 | listArray (l,u) es = 194 | let n = safeRangeSize (l,u) 195 | in unsafeArray (l,u) (zip [0 .. n - 1] es) 196 | 197 | {-# INLINE genArray #-} 198 | -- | Constructs an immutable array using a generator function. 199 | -- 200 | -- @since 0.5.6.0 201 | genArray :: (IArray a e, Ix i) => (i,i) -> (i -> e) -> a i e 202 | genArray (l,u) f = listArray (l,u) $ map f $ range (l,u) 203 | 204 | {-# INLINE listArrayST #-} -- See Note [Inlining and fusion] 205 | listArrayST :: Ix i => (i,i) -> [e] -> ST s (STArray s i e) 206 | listArrayST = newListArray 207 | 208 | {-# RULES 209 | "listArray/Array" listArray = 210 | \lu es -> runST (listArrayST lu es >>= ArrST.unsafeFreezeSTArray) 211 | #-} 212 | 213 | {-# INLINE listUArrayST #-} -- See Note [Inlining and fusion] 214 | listUArrayST :: (MArray (STUArray s) e (ST s), Ix i) 215 | => (i,i) -> [e] -> ST s (STUArray s i e) 216 | listUArrayST = newListArray 217 | 218 | -- I don't know how to write a single rule for listUArrayST, because 219 | -- the type looks like constrained over 's', which runST doesn't 220 | -- like. In fact all MArray (STUArray s) instances are polymorphic 221 | -- wrt. 's', but runST can't know that. 222 | -- 223 | -- More precisely, we'd like to write this: 224 | -- listUArray :: (forall s. MArray (STUArray s) e (ST s), Ix i) 225 | -- => (i,i) -> [e] -> UArray i e 226 | -- listUArray lu = runST (listUArrayST lu es >>= unsafeFreezeSTUArray) 227 | -- {-# RULES listArray = listUArray 228 | -- Then we could call listUArray at any type 'e' that had a suitable 229 | -- MArray instance. But sadly we can't, because we don't have quantified 230 | -- constraints. Hence the mass of rules below. 231 | 232 | -- I would like also to write a rule for listUArrayST (or listArray or 233 | -- whatever) applied to unpackCString#. Unfortunately unpackCString# 234 | -- calls seem to be floated out, then floated back into the middle 235 | -- of listUArrayST, so I was not able to do this. 236 | 237 | type ListUArray e = forall i . Ix i => (i,i) -> [e] -> UArray i e 238 | 239 | {-# RULES 240 | "listArray/UArray/Bool" listArray 241 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Bool 242 | "listArray/UArray/Char" listArray 243 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Char 244 | "listArray/UArray/Int" listArray 245 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int 246 | "listArray/UArray/Word" listArray 247 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word 248 | "listArray/UArray/Ptr" listArray 249 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (Ptr a) 250 | "listArray/UArray/FunPtr" listArray 251 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (FunPtr a) 252 | "listArray/UArray/Float" listArray 253 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Float 254 | "listArray/UArray/Double" listArray 255 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Double 256 | "listArray/UArray/StablePtr" listArray 257 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray (StablePtr a) 258 | "listArray/UArray/Int8" listArray 259 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int8 260 | "listArray/UArray/Int16" listArray 261 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int16 262 | "listArray/UArray/Int32" listArray 263 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int32 264 | "listArray/UArray/Int64" listArray 265 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Int64 266 | "listArray/UArray/Word8" listArray 267 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word8 268 | "listArray/UArray/Word16" listArray 269 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word16 270 | "listArray/UArray/Word32" listArray 271 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word32 272 | "listArray/UArray/Word64" listArray 273 | = (\lu es -> runST (listUArrayST lu es >>= unsafeFreezeSTUArray)) :: ListUArray Word64 274 | #-} 275 | 276 | {-# INLINE (!) #-} 277 | -- | Returns the element of an immutable array at the specified index, 278 | -- or throws an exception if the index is out of bounds. 279 | (!) :: (IArray a e, Ix i) => a i e -> i -> e 280 | (!) arr i = case bounds arr of 281 | (l,u) -> unsafeAt arr $ safeIndex (l,u) (numElements arr) i 282 | 283 | {-# INLINE (!?) #-} 284 | -- | Returns 'Just' the element of an immutable array at the specified index, 285 | -- or 'Nothing' if the index is out of bounds. 286 | -- 287 | -- @since 0.5.6.0 288 | (!?) :: (IArray a e, Ix i) => a i e -> i -> Maybe e 289 | (!?) arr i = let b = bounds arr in 290 | if inRange b i 291 | then Just $ unsafeAt arr $ unsafeIndex b i 292 | else Nothing 293 | 294 | {-# INLINE indices #-} 295 | -- | Returns a list of all the valid indices in an array. 296 | indices :: (IArray a e, Ix i) => a i e -> [i] 297 | indices arr = case bounds arr of (l,u) -> range (l,u) 298 | 299 | {-# INLINE elems #-} 300 | -- | Returns a list of all the elements of an array, in the same order 301 | -- as their indices. 302 | elems :: (IArray a e, Ix i) => a i e -> [e] 303 | elems arr = [unsafeAt arr i | i <- [0 .. numElements arr - 1]] 304 | 305 | {-# INLINE assocs #-} 306 | -- | Returns the contents of an array as a list of associations. 307 | assocs :: (IArray a e, Ix i) => a i e -> [(i, e)] 308 | assocs arr = case bounds arr of 309 | (l,u) -> [(i, arr ! i) | i <- range (l,u)] 310 | 311 | {-# INLINE accumArray #-} 312 | 313 | {-| 314 | Constructs an immutable array from a list of associations. Unlike 315 | 'array', the same index is allowed to occur multiple times in the list 316 | of associations; an /accumulating function/ is used to combine the 317 | values of elements with the same index. 318 | 319 | For example, given a list of values of some index type, hist produces 320 | a histogram of the number of occurrences of each index within a 321 | specified range: 322 | 323 | > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b 324 | > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i\<-is, inRange bnds i] 325 | -} 326 | accumArray :: (IArray a e, Ix i) 327 | => (e -> e' -> e) -- ^ An accumulating function 328 | -> e -- ^ A default element 329 | -> (i,i) -- ^ The bounds of the array 330 | -> [(i, e')] -- ^ List of associations 331 | -> a i e -- ^ Returns: the array 332 | accumArray f initialValue (l,u) ies = 333 | let n = safeRangeSize (l, u) 334 | in unsafeAccumArray f initialValue (l,u) 335 | [(safeIndex (l,u) n i, e) | (i, e) <- ies] 336 | 337 | {-# INLINE (//) #-} 338 | {-| 339 | Takes an array and a list of pairs and returns an array identical to 340 | the left argument except that it has been updated by the associations 341 | in the right argument. For example, if m is a 1-origin, n by n matrix, 342 | then @m\/\/[((i,i), 0) | i \<- [1..n]]@ is the same matrix, except with 343 | the diagonal zeroed. 344 | 345 | As with the 'array' function, if any two associations in the list have 346 | the same index, the value at that index is implementation-dependent. 347 | (In GHC, the last value specified for that index is used. 348 | Other implementations will also do this for unboxed arrays, but Haskell 349 | 98 requires that for 'Array' the value at such indices is bottom.) 350 | 351 | For most array types, this operation is O(/n/) where /n/ is the size 352 | of the array. However, the diffarray package provides an array type 353 | for which this operation has complexity linear in the number of updates. 354 | -} 355 | (//) :: (IArray a e, Ix i) => a i e -> [(i, e)] -> a i e 356 | arr // ies = case bounds arr of 357 | (l,u) -> unsafeReplace arr [ (safeIndex (l,u) (numElements arr) i, e) 358 | | (i, e) <- ies] 359 | 360 | {-# INLINE accum #-} 361 | {-| 362 | @accum f@ takes an array and an association list and accumulates pairs 363 | from the list into the array with the accumulating function @f@. Thus 364 | 'accumArray' can be defined using 'accum': 365 | 366 | > accumArray f z b = accum f (array b [(i, z) | i \<- range b]) 367 | -} 368 | accum :: (IArray a e, Ix i) => (e -> e' -> e) -> a i e -> [(i, e')] -> a i e 369 | accum f arr ies = case bounds arr of 370 | (l,u) -> let n = numElements arr 371 | in unsafeAccum f arr [(safeIndex (l,u) n i, e) | (i, e) <- ies] 372 | 373 | {-# INLINE amap #-} 374 | -- | Returns a new array derived from the original array by applying a 375 | -- function to each of the elements. 376 | amap :: (IArray a e', IArray a e, Ix i) => (e' -> e) -> a i e' -> a i e 377 | amap f arr = case bounds arr of 378 | (l,u) -> let n = numElements arr 379 | in unsafeArray (l,u) [ (i, f (unsafeAt arr i)) 380 | | i <- [0 .. n - 1]] 381 | 382 | {-# INLINE ixmap #-} 383 | -- | Returns a new array derived from the original array by applying a 384 | -- function to each of the indices. 385 | ixmap :: (IArray a e, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> a i e 386 | ixmap (l,u) f arr = 387 | array (l,u) [(i, arr ! f i) | i <- range (l,u)] 388 | 389 | -- | Lazy right-associative fold. 390 | -- 391 | -- @since 0.5.8.0 392 | foldrArray :: (IArray a e, Ix i) => (e -> b -> b) -> b -> a i e -> b 393 | foldrArray f z = \a -> 394 | let !n = numElements a 395 | go i | i >= n = z 396 | | otherwise = f (unsafeAt a i) (go (i+1)) 397 | in go 0 398 | {-# INLINE foldrArray #-} 399 | 400 | -- | Strict accumulating left-associative fold. 401 | -- 402 | -- @since 0.5.8.0 403 | foldlArray' :: (IArray a e, Ix i) => (b -> e -> b) -> b -> a i e -> b 404 | foldlArray' f z0 = \a -> 405 | let !n = numElements a 406 | go !z i | i >= n = z 407 | | otherwise = go (f z (unsafeAt a i)) (i+1) 408 | in go z0 0 409 | {-# INLINE foldlArray' #-} 410 | 411 | -- | Lazy left-associative fold. 412 | -- 413 | -- @since 0.5.8.0 414 | foldlArray :: (IArray a e, Ix i) => (b -> e -> b) -> b -> a i e -> b 415 | foldlArray f z = \a -> 416 | let !n = numElements a 417 | go i | i < 0 = z 418 | | otherwise = f (go (i-1)) (unsafeAt a i) 419 | in go (n-1) 420 | {-# INLINE foldlArray #-} 421 | 422 | -- | Strict accumulating right-associative fold. 423 | -- 424 | -- @since 0.5.8.0 425 | foldrArray' :: (IArray a e, Ix i) => (e -> b -> b) -> b -> a i e -> b 426 | foldrArray' f z0 = \a -> 427 | let !n = numElements a 428 | go i !z | i < 0 = z 429 | | otherwise = go (i-1) (f (unsafeAt a i) z) 430 | in go (n-1) z0 431 | {-# INLINE foldrArray' #-} 432 | 433 | -- | Map elements to applicative actions, sequence them left-to-right, and 434 | -- discard the results. 435 | -- 436 | -- @since 0.5.8.0 437 | traverseArray_ 438 | :: (IArray a e, Ix i, Applicative f) => (e -> f b) -> a i e -> f () 439 | traverseArray_ f = foldrArray (\x z -> f x *> z) (pure ()) 440 | {-# INLINE traverseArray_ #-} 441 | 442 | -- | @forArray_@ is 'traverseArray_' with its arguments flipped. 443 | -- 444 | -- @since 0.5.8.0 445 | forArray_ :: (IArray a e, Ix i, Applicative f) => a i e -> (e -> f b) -> f () 446 | forArray_ = flip traverseArray_ 447 | {-# INLINE forArray_ #-} 448 | 449 | -- | Strict accumulating left-associative monadic fold. 450 | -- 451 | -- @since 0.5.8.0 452 | foldlArrayM' 453 | :: (IArray a e, Ix i, Monad m) => (b -> e -> m b) -> b -> a i e -> m b 454 | foldlArrayM' f z0 = \a -> 455 | let !n = numElements a 456 | go !z i | i >= n = pure z 457 | | otherwise = do 458 | z' <- f z (unsafeAt a i) 459 | go z' (i+1) 460 | in go z0 0 461 | {-# INLINE foldlArrayM' #-} 462 | 463 | -- | Strict accumulating right-associative monadic fold. 464 | -- 465 | -- @since 0.5.8.0 466 | foldrArrayM' 467 | :: (IArray a e, Ix i, Monad m) => (e -> b -> m b) -> b -> a i e -> m b 468 | foldrArrayM' f z0 = \a -> 469 | let !n = numElements a 470 | go i !z | i < 0 = pure z 471 | | otherwise = do 472 | z' <- f (unsafeAt a i) z 473 | go (i-1) z' 474 | in go (n-1) z0 475 | {-# INLINE foldrArrayM' #-} 476 | 477 | ----------------------------------------------------------------------------- 478 | -- Normal polymorphic arrays 479 | 480 | instance IArray Arr.Array e where 481 | {-# INLINE bounds #-} 482 | bounds = Arr.bounds 483 | {-# INLINE numElements #-} 484 | numElements = Arr.numElements 485 | {-# INLINE unsafeArray #-} 486 | unsafeArray = Arr.unsafeArray 487 | {-# INLINE unsafeAt #-} 488 | unsafeAt = Arr.unsafeAt 489 | {-# INLINE unsafeReplace #-} 490 | unsafeReplace = Arr.unsafeReplace 491 | {-# INLINE unsafeAccum #-} 492 | unsafeAccum = Arr.unsafeAccum 493 | {-# INLINE unsafeAccumArray #-} 494 | unsafeAccumArray = Arr.unsafeAccumArray 495 | 496 | ----------------------------------------------------------------------------- 497 | -- Flat unboxed arrays 498 | 499 | -- | Arrays with unboxed elements. Instances of 'IArray' are provided 500 | -- for 'UArray' with certain element types ('Int', 'Float', 'Char', 501 | -- etc.; see the 'UArray' class for a full list). 502 | -- 503 | -- A 'UArray' will generally be more efficient (in terms of both time 504 | -- and space) than the equivalent 'Data.Array.Array' with the same 505 | -- element type. However, 'UArray' is strict in its elements - so 506 | -- don\'t use 'UArray' if you require the non-strictness that 507 | -- 'Data.Array.Array' provides. 508 | -- 509 | -- Because the @IArray@ interface provides operations overloaded on 510 | -- the type of the array, it should be possible to just change the 511 | -- array type being used by a program from say @Array@ to @UArray@ to 512 | -- get the benefits of unboxed arrays (don\'t forget to import 513 | -- "Data.Array.Unboxed" instead of "Data.Array"). 514 | -- 515 | data UArray i e = UArray !i !i !Int ByteArray# 516 | -- There are class-based invariants on both parameters. See also #9220. 517 | type role UArray nominal nominal 518 | 519 | {-# INLINE unsafeArrayUArray #-} 520 | unsafeArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) 521 | => (i,i) -> [(Int, e)] -> e -> ST s (UArray i e) 522 | unsafeArrayUArray (l,u) ies default_elem = do 523 | marr <- newArray (l,u) default_elem 524 | sequence_ [unsafeWrite marr i e | (i, e) <- ies] 525 | unsafeFreezeSTUArray marr 526 | 527 | {-# INLINE unsafeFreezeSTUArray #-} 528 | unsafeFreezeSTUArray :: STUArray s i e -> ST s (UArray i e) 529 | unsafeFreezeSTUArray (STUArray l u n marr#) = ST $ \s1# -> 530 | case unsafeFreezeByteArray# marr# s1# of { (# s2#, arr# #) -> 531 | (# s2#, UArray l u n arr# #) } 532 | 533 | {-# INLINE unsafeReplaceUArray #-} 534 | unsafeReplaceUArray :: (MArray (STUArray s) e (ST s), Ix i) 535 | => UArray i e -> [(Int, e)] -> ST s (UArray i e) 536 | unsafeReplaceUArray arr ies = do 537 | marr <- thawSTUArray arr 538 | sequence_ [unsafeWrite marr i e | (i, e) <- ies] 539 | unsafeFreezeSTUArray marr 540 | 541 | {-# INLINE unsafeAccumUArray #-} 542 | unsafeAccumUArray :: (MArray (STUArray s) e (ST s), Ix i) 543 | => (e -> e' -> e) -> UArray i e -> [(Int, e')] -> ST s (UArray i e) 544 | unsafeAccumUArray f arr ies = do 545 | marr <- thawSTUArray arr 546 | sequence_ [do old <- unsafeRead marr i 547 | unsafeWrite marr i (f old new) 548 | | (i, new) <- ies] 549 | unsafeFreezeSTUArray marr 550 | 551 | {-# INLINE unsafeAccumArrayUArray #-} 552 | unsafeAccumArrayUArray :: (MArray (STUArray s) e (ST s), Ix i) 553 | => (e -> e' -> e) -> e -> (i,i) -> [(Int, e')] -> ST s (UArray i e) 554 | unsafeAccumArrayUArray f initialValue (l,u) ies = do 555 | marr <- newArray (l,u) initialValue 556 | sequence_ [do old <- unsafeRead marr i 557 | unsafeWrite marr i (f old new) 558 | | (i, new) <- ies] 559 | unsafeFreezeSTUArray marr 560 | 561 | {-# INLINE eqUArray #-} 562 | eqUArray :: (IArray UArray e, Ix i, Eq e) => UArray i e -> UArray i e -> Bool 563 | eqUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = 564 | if n1 == 0 then n2 == 0 else 565 | l1 == l2 && u1 == u2 && 566 | and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. n1 - 1]] 567 | 568 | {-# INLINE [1] cmpUArray #-} 569 | cmpUArray :: (IArray UArray e, Ix i, Ord e) => UArray i e -> UArray i e -> Ordering 570 | cmpUArray arr1 arr2 = compare (assocs arr1) (assocs arr2) 571 | 572 | {-# INLINE cmpIntUArray #-} 573 | cmpIntUArray :: (IArray UArray e, Ord e) => UArray Int e -> UArray Int e -> Ordering 574 | cmpIntUArray arr1@(UArray l1 u1 n1 _) arr2@(UArray l2 u2 n2 _) = 575 | if n1 == 0 then if n2 == 0 then EQ else LT else 576 | if n2 == 0 then GT else 577 | case compare l1 l2 of 578 | EQ -> foldr cmp (compare u1 u2) [0 .. (n1 `min` n2) - 1] 579 | other -> other 580 | where 581 | cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of 582 | EQ -> rest 583 | other -> other 584 | 585 | {-# RULES "cmpUArray/Int" cmpUArray = cmpIntUArray #-} 586 | 587 | ----------------------------------------------------------------------------- 588 | -- Showing and Reading IArrays 589 | 590 | showsIArray :: (IArray a e, Ix i, Show i, Show e) => Int -> a i e -> ShowS 591 | showsIArray p a = 592 | showParen (p > appPrec) $ 593 | showString "array " . 594 | shows (bounds a) . 595 | showChar ' ' . 596 | shows (assocs a) 597 | 598 | 599 | readIArray :: (IArray a e, Ix i, Read i, Read e) => ReadPrec (a i e) 600 | readIArray = parens $ prec appPrec $ 601 | do expectP (Ident "array") 602 | theBounds <- step readPrec 603 | vals <- step readPrec 604 | return (array theBounds vals) 605 | 606 | ----------------------------------------------------------------------------- 607 | -- Flat unboxed arrays: instances 608 | 609 | instance IArray UArray Bool where 610 | {-# INLINE bounds #-} 611 | bounds (UArray l u _ _) = (l,u) 612 | {-# INLINE numElements #-} 613 | numElements (UArray _ _ n _) = n 614 | {-# INLINE unsafeArray #-} 615 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies False) 616 | {-# INLINE unsafeAt #-} 617 | unsafeAt (UArray _ _ _ arr#) (I# i#) = isTrue# 618 | ((indexWordArray# arr# (bOOL_INDEX i#) `and#` bOOL_BIT i#) 619 | `neWord#` int2Word# 0#) 620 | 621 | {-# INLINE unsafeReplace #-} 622 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 623 | {-# INLINE unsafeAccum #-} 624 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 625 | {-# INLINE unsafeAccumArray #-} 626 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 627 | 628 | instance IArray UArray Char where 629 | {-# INLINE bounds #-} 630 | bounds (UArray l u _ _) = (l,u) 631 | {-# INLINE numElements #-} 632 | numElements (UArray _ _ n _) = n 633 | {-# INLINE unsafeArray #-} 634 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies '\0') 635 | {-# INLINE unsafeAt #-} 636 | unsafeAt (UArray _ _ _ arr#) (I# i#) = C# (indexWideCharArray# arr# i#) 637 | {-# INLINE unsafeReplace #-} 638 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 639 | {-# INLINE unsafeAccum #-} 640 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 641 | {-# INLINE unsafeAccumArray #-} 642 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 643 | 644 | instance IArray UArray Int where 645 | {-# INLINE bounds #-} 646 | bounds (UArray l u _ _) = (l,u) 647 | {-# INLINE numElements #-} 648 | numElements (UArray _ _ n _) = n 649 | {-# INLINE unsafeArray #-} 650 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 651 | {-# INLINE unsafeAt #-} 652 | unsafeAt (UArray _ _ _ arr#) (I# i#) = I# (indexIntArray# arr# i#) 653 | {-# INLINE unsafeReplace #-} 654 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 655 | {-# INLINE unsafeAccum #-} 656 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 657 | {-# INLINE unsafeAccumArray #-} 658 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 659 | 660 | instance IArray UArray Word where 661 | {-# INLINE bounds #-} 662 | bounds (UArray l u _ _) = (l,u) 663 | {-# INLINE numElements #-} 664 | numElements (UArray _ _ n _) = n 665 | {-# INLINE unsafeArray #-} 666 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 667 | {-# INLINE unsafeAt #-} 668 | unsafeAt (UArray _ _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#) 669 | {-# INLINE unsafeReplace #-} 670 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 671 | {-# INLINE unsafeAccum #-} 672 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 673 | {-# INLINE unsafeAccumArray #-} 674 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 675 | 676 | instance IArray UArray (Ptr a) where 677 | {-# INLINE bounds #-} 678 | bounds (UArray l u _ _) = (l,u) 679 | {-# INLINE numElements #-} 680 | numElements (UArray _ _ n _) = n 681 | {-# INLINE unsafeArray #-} 682 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullPtr) 683 | {-# INLINE unsafeAt #-} 684 | unsafeAt (UArray _ _ _ arr#) (I# i#) = Ptr (indexAddrArray# arr# i#) 685 | {-# INLINE unsafeReplace #-} 686 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 687 | {-# INLINE unsafeAccum #-} 688 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 689 | {-# INLINE unsafeAccumArray #-} 690 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 691 | 692 | instance IArray UArray (FunPtr a) where 693 | {-# INLINE bounds #-} 694 | bounds (UArray l u _ _) = (l,u) 695 | {-# INLINE numElements #-} 696 | numElements (UArray _ _ n _) = n 697 | {-# INLINE unsafeArray #-} 698 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullFunPtr) 699 | {-# INLINE unsafeAt #-} 700 | unsafeAt (UArray _ _ _ arr#) (I# i#) = FunPtr (indexAddrArray# arr# i#) 701 | {-# INLINE unsafeReplace #-} 702 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 703 | {-# INLINE unsafeAccum #-} 704 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 705 | {-# INLINE unsafeAccumArray #-} 706 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 707 | 708 | instance IArray UArray Float where 709 | {-# INLINE bounds #-} 710 | bounds (UArray l u _ _) = (l,u) 711 | {-# INLINE numElements #-} 712 | numElements (UArray _ _ n _) = n 713 | {-# INLINE unsafeArray #-} 714 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 715 | {-# INLINE unsafeAt #-} 716 | unsafeAt (UArray _ _ _ arr#) (I# i#) = F# (indexFloatArray# arr# i#) 717 | {-# INLINE unsafeReplace #-} 718 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 719 | {-# INLINE unsafeAccum #-} 720 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 721 | {-# INLINE unsafeAccumArray #-} 722 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 723 | 724 | instance IArray UArray Double where 725 | {-# INLINE bounds #-} 726 | bounds (UArray l u _ _) = (l,u) 727 | {-# INLINE numElements #-} 728 | numElements (UArray _ _ n _) = n 729 | {-# INLINE unsafeArray #-} 730 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 731 | {-# INLINE unsafeAt #-} 732 | unsafeAt (UArray _ _ _ arr#) (I# i#) = D# (indexDoubleArray# arr# i#) 733 | {-# INLINE unsafeReplace #-} 734 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 735 | {-# INLINE unsafeAccum #-} 736 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 737 | {-# INLINE unsafeAccumArray #-} 738 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 739 | 740 | instance IArray UArray (StablePtr a) where 741 | {-# INLINE bounds #-} 742 | bounds (UArray l u _ _) = (l,u) 743 | {-# INLINE numElements #-} 744 | numElements (UArray _ _ n _) = n 745 | {-# INLINE unsafeArray #-} 746 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies nullStablePtr) 747 | {-# INLINE unsafeAt #-} 748 | unsafeAt (UArray _ _ _ arr#) (I# i#) = StablePtr (indexStablePtrArray# arr# i#) 749 | {-# INLINE unsafeReplace #-} 750 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 751 | {-# INLINE unsafeAccum #-} 752 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 753 | {-# INLINE unsafeAccumArray #-} 754 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 755 | 756 | -- bogus StablePtr value for initialising a UArray of StablePtr. 757 | nullStablePtr :: StablePtr a 758 | nullStablePtr = StablePtr (unsafeCoerce# nullAddr#) 759 | 760 | instance IArray UArray Int8 where 761 | {-# INLINE bounds #-} 762 | bounds (UArray l u _ _) = (l,u) 763 | {-# INLINE numElements #-} 764 | numElements (UArray _ _ n _) = n 765 | {-# INLINE unsafeArray #-} 766 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 767 | {-# INLINE unsafeAt #-} 768 | unsafeAt (UArray _ _ _ arr#) (I# i#) = I8# (indexInt8Array# arr# i#) 769 | {-# INLINE unsafeReplace #-} 770 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 771 | {-# INLINE unsafeAccum #-} 772 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 773 | {-# INLINE unsafeAccumArray #-} 774 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 775 | 776 | instance IArray UArray Int16 where 777 | {-# INLINE bounds #-} 778 | bounds (UArray l u _ _) = (l,u) 779 | {-# INLINE numElements #-} 780 | numElements (UArray _ _ n _) = n 781 | {-# INLINE unsafeArray #-} 782 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 783 | {-# INLINE unsafeAt #-} 784 | unsafeAt (UArray _ _ _ arr#) (I# i#) = I16# (indexInt16Array# arr# i#) 785 | {-# INLINE unsafeReplace #-} 786 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 787 | {-# INLINE unsafeAccum #-} 788 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 789 | {-# INLINE unsafeAccumArray #-} 790 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 791 | 792 | instance IArray UArray Int32 where 793 | {-# INLINE bounds #-} 794 | bounds (UArray l u _ _) = (l,u) 795 | {-# INLINE numElements #-} 796 | numElements (UArray _ _ n _) = n 797 | {-# INLINE unsafeArray #-} 798 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 799 | {-# INLINE unsafeAt #-} 800 | unsafeAt (UArray _ _ _ arr#) (I# i#) = I32# (indexInt32Array# arr# i#) 801 | {-# INLINE unsafeReplace #-} 802 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 803 | {-# INLINE unsafeAccum #-} 804 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 805 | {-# INLINE unsafeAccumArray #-} 806 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 807 | 808 | instance IArray UArray Int64 where 809 | {-# INLINE bounds #-} 810 | bounds (UArray l u _ _) = (l,u) 811 | {-# INLINE numElements #-} 812 | numElements (UArray _ _ n _) = n 813 | {-# INLINE unsafeArray #-} 814 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 815 | {-# INLINE unsafeAt #-} 816 | unsafeAt (UArray _ _ _ arr#) (I# i#) = I64# (indexInt64Array# arr# i#) 817 | {-# INLINE unsafeReplace #-} 818 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 819 | {-# INLINE unsafeAccum #-} 820 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 821 | {-# INLINE unsafeAccumArray #-} 822 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 823 | 824 | instance IArray UArray Word8 where 825 | {-# INLINE bounds #-} 826 | bounds (UArray l u _ _) = (l,u) 827 | {-# INLINE numElements #-} 828 | numElements (UArray _ _ n _) = n 829 | {-# INLINE unsafeArray #-} 830 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 831 | {-# INLINE unsafeAt #-} 832 | unsafeAt (UArray _ _ _ arr#) (I# i#) = W8# (indexWord8Array# arr# i#) 833 | {-# INLINE unsafeReplace #-} 834 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 835 | {-# INLINE unsafeAccum #-} 836 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 837 | {-# INLINE unsafeAccumArray #-} 838 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 839 | 840 | instance IArray UArray Word16 where 841 | {-# INLINE bounds #-} 842 | bounds (UArray l u _ _) = (l,u) 843 | {-# INLINE numElements #-} 844 | numElements (UArray _ _ n _) = n 845 | {-# INLINE unsafeArray #-} 846 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 847 | {-# INLINE unsafeAt #-} 848 | unsafeAt (UArray _ _ _ arr#) (I# i#) = W16# (indexWord16Array# arr# i#) 849 | {-# INLINE unsafeReplace #-} 850 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 851 | {-# INLINE unsafeAccum #-} 852 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 853 | {-# INLINE unsafeAccumArray #-} 854 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 855 | 856 | instance IArray UArray Word32 where 857 | {-# INLINE bounds #-} 858 | bounds (UArray l u _ _) = (l,u) 859 | {-# INLINE numElements #-} 860 | numElements (UArray _ _ n _) = n 861 | {-# INLINE unsafeArray #-} 862 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 863 | {-# INLINE unsafeAt #-} 864 | unsafeAt (UArray _ _ _ arr#) (I# i#) = W32# (indexWord32Array# arr# i#) 865 | {-# INLINE unsafeReplace #-} 866 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 867 | {-# INLINE unsafeAccum #-} 868 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 869 | {-# INLINE unsafeAccumArray #-} 870 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 871 | 872 | instance IArray UArray Word64 where 873 | {-# INLINE bounds #-} 874 | bounds (UArray l u _ _) = (l,u) 875 | {-# INLINE numElements #-} 876 | numElements (UArray _ _ n _) = n 877 | {-# INLINE unsafeArray #-} 878 | unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0) 879 | {-# INLINE unsafeAt #-} 880 | unsafeAt (UArray _ _ _ arr#) (I# i#) = W64# (indexWord64Array# arr# i#) 881 | {-# INLINE unsafeReplace #-} 882 | unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies) 883 | {-# INLINE unsafeAccum #-} 884 | unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies) 885 | {-# INLINE unsafeAccumArray #-} 886 | unsafeAccumArray f initialValue lu ies = runST (unsafeAccumArrayUArray f initialValue lu ies) 887 | 888 | instance (Ix ix, Eq e, IArray UArray e) => Eq (UArray ix e) where 889 | (==) = eqUArray 890 | 891 | instance (Ix ix, Ord e, IArray UArray e) => Ord (UArray ix e) where 892 | compare = cmpUArray 893 | 894 | instance (Ix ix, Show ix, Show e, IArray UArray e) => Show (UArray ix e) where 895 | showsPrec = showsIArray 896 | 897 | instance (Ix ix, Read ix, Read e, IArray UArray e) => Read (UArray ix e) where 898 | readPrec = readIArray 899 | 900 | ----------------------------------------------------------------------------- 901 | -- Mutable arrays 902 | 903 | {-# NOINLINE arrEleBottom #-} 904 | arrEleBottom :: a 905 | arrEleBottom = error "MArray: undefined array element" 906 | 907 | {-| Class of mutable array types. 908 | 909 | An array type has the form @(a i e)@ where @a@ is the array type 910 | constructor (kind @* -> * -> *@), @i@ is the index type (a member of 911 | the class 'Ix'), and @e@ is the element type. 912 | 913 | The @MArray@ class is parameterised over both @a@ and @e@ (so that 914 | instances specialised to certain element types can be defined, in the 915 | same way as for 'IArray'), and also over the type of the monad, @m@, 916 | in which the mutable array will be manipulated. 917 | -} 918 | class (Monad m) => MArray a e m where 919 | -- | Returns the bounds of the array (lowest,highest). 920 | getBounds :: Ix i => a i e -> m (i,i) 921 | -- | Returns the number of elements in the array. 922 | getNumElements :: Ix i => a i e -> m Int 923 | 924 | -- | Builds a new array, with every element initialised to the supplied 925 | -- value. The first and second element of the tuple specifies the lowest 926 | -- and highest index, respectively. 927 | newArray :: Ix i => (i,i) -> e -> m (a i e) 928 | 929 | -- | Builds a new array, with every element initialised to an 930 | -- undefined value. In a monadic context in which operations must 931 | -- be deterministic (e.g. the ST monad), the array elements are 932 | -- initialised to a fixed but undefined value, such as zero. 933 | -- The first and second element of the tuple specifies the lowest 934 | -- and highest index, respectively. 935 | newArray_ :: Ix i => (i,i) -> m (a i e) 936 | 937 | -- | Builds a new array, with every element initialised to an undefined 938 | -- value. The first and second element of the tuple specifies the lowest 939 | -- and highest index, respectively. 940 | unsafeNewArray_ :: Ix i => (i,i) -> m (a i e) 941 | 942 | unsafeRead :: Ix i => a i e -> Int -> m e 943 | unsafeWrite :: Ix i => a i e -> Int -> e -> m () 944 | 945 | {-# INLINE newArray #-} 946 | -- The INLINE is crucial, because until we know at least which monad 947 | -- we are in, the code below allocates like crazy. So inline it, 948 | -- in the hope that the context will know the monad. 949 | newArray (l,u) initialValue = do 950 | let n = safeRangeSize (l,u) 951 | marr <- unsafeNewArray_ (l,u) 952 | sequence_ [unsafeWrite marr i initialValue | i <- [0 .. n - 1]] 953 | return marr 954 | 955 | {-# INLINE unsafeNewArray_ #-} 956 | unsafeNewArray_ (l,u) = newArray (l,u) arrEleBottom 957 | 958 | {-# INLINE newArray_ #-} 959 | newArray_ (l,u) = newArray (l,u) arrEleBottom 960 | 961 | -- newArray takes an initialiser which all elements of 962 | -- the newly created array are initialised to. unsafeNewArray_ takes 963 | -- no initialiser, it is assumed that the array is initialised with 964 | -- "undefined" values. 965 | 966 | -- why not omit unsafeNewArray_? Because in the unboxed array 967 | -- case we would like to omit the initialisation altogether if 968 | -- possible. We can't do this for boxed arrays, because the 969 | -- elements must all have valid values at all times in case of 970 | -- garbage collection. 971 | 972 | -- why not omit newArray? Because in the boxed case, we can omit the 973 | -- default initialisation with undefined values if we *do* know the 974 | -- initial value and it is constant for all elements. 975 | 976 | {-# MINIMAL getBounds, getNumElements, (newArray | unsafeNewArray_), unsafeRead, unsafeWrite #-} 977 | 978 | instance MArray IOArray e IO where 979 | {-# INLINE getBounds #-} 980 | getBounds (IOArray marr) = stToIO $ getBounds marr 981 | {-# INLINE getNumElements #-} 982 | getNumElements (IOArray marr) = stToIO $ getNumElements marr 983 | newArray = newIOArray 984 | unsafeRead = unsafeReadIOArray 985 | unsafeWrite = unsafeWriteIOArray 986 | 987 | {-# INLINE newListArray #-} -- See Note [Inlining and fusion] 988 | -- | Constructs a mutable array from a list of initial elements. 989 | -- The list gives the elements of the array in ascending order 990 | -- beginning with the lowest index. The first and second element 991 | -- of the tuple specifies the lowest and highest index, respectively. 992 | newListArray :: (MArray a e m, Ix i) => (i,i) -> [e] -> m (a i e) 993 | newListArray (l,u) es = do 994 | marr <- newArray_ (l,u) 995 | let n = safeRangeSize (l,u) 996 | f x k i 997 | | i == n = return () 998 | | otherwise = unsafeWrite marr i x >> k (i+1) 999 | foldr f (\ !_i -> return ()) es 0 1000 | -- The bang above is important for GHC for unbox the Int. 1001 | return marr 1002 | 1003 | {-# INLINE newGenArray #-} 1004 | -- | Constructs a mutable array using a generator function. 1005 | -- It invokes the generator function in ascending order of the indices. 1006 | -- 1007 | -- @since 0.5.6.0 1008 | newGenArray :: (MArray a e m, Ix i) => (i,i) -> (i -> m e) -> m (a i e) 1009 | newGenArray bnds f = do 1010 | let n = safeRangeSize bnds 1011 | marr <- unsafeNewArray_ bnds 1012 | let g ix k i 1013 | | i == n = return () 1014 | | otherwise = do 1015 | x <- f ix 1016 | unsafeWrite marr i x 1017 | k (i+1) 1018 | foldr g (\ !_i -> return ()) (range bnds) 0 1019 | -- The bang above is important for GHC for unbox the Int. 1020 | return marr 1021 | 1022 | {-# INLINE readArray #-} 1023 | -- | Read an element from a mutable array 1024 | readArray :: (MArray a e m, Ix i) => a i e -> i -> m e 1025 | readArray marr i = do 1026 | (l,u) <- getBounds marr 1027 | n <- getNumElements marr 1028 | unsafeRead marr (safeIndex (l,u) n i) 1029 | 1030 | {-# INLINE writeArray #-} 1031 | -- | Write an element in a mutable array 1032 | writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m () 1033 | writeArray marr i e = do 1034 | (l,u) <- getBounds marr 1035 | n <- getNumElements marr 1036 | unsafeWrite marr (safeIndex (l,u) n i) e 1037 | 1038 | {-# INLINE modifyArray #-} 1039 | -- | Modify an element in a mutable array 1040 | -- 1041 | -- @since 0.5.6.0 1042 | modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m () 1043 | modifyArray marr i f = do 1044 | (l,u) <- getBounds marr 1045 | n <- getNumElements marr 1046 | let idx = safeIndex (l,u) n i 1047 | x <- unsafeRead marr idx 1048 | unsafeWrite marr idx (f x) 1049 | 1050 | {-# INLINE modifyArray' #-} 1051 | -- | Modify an element in a mutable array. Strict in the written element. 1052 | -- 1053 | -- @since 0.5.6.0 1054 | modifyArray' :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m () 1055 | modifyArray' marr i f = do 1056 | (l,u) <- getBounds marr 1057 | n <- getNumElements marr 1058 | let idx = safeIndex (l,u) n i 1059 | x <- unsafeRead marr idx 1060 | let !x' = f x 1061 | unsafeWrite marr idx x' 1062 | 1063 | {-# INLINE getElems #-} 1064 | -- | Return a list of all the elements of a mutable array 1065 | getElems :: (MArray a e m, Ix i) => a i e -> m [e] 1066 | getElems marr = do 1067 | (_l, _u) <- getBounds marr 1068 | n <- getNumElements marr 1069 | sequence [unsafeRead marr i | i <- [0 .. n - 1]] 1070 | 1071 | {-# INLINE getAssocs #-} 1072 | -- | Return a list of all the associations of a mutable array, in 1073 | -- index order. 1074 | getAssocs :: (MArray a e m, Ix i) => a i e -> m [(i, e)] 1075 | getAssocs marr = do 1076 | (l,u) <- getBounds marr 1077 | n <- getNumElements marr 1078 | sequence [ do e <- unsafeRead marr (safeIndex (l,u) n i); return (i,e) 1079 | | i <- range (l,u)] 1080 | 1081 | {-# INLINE mapArray #-} 1082 | -- | Constructs a new array derived from the original array by applying a 1083 | -- function to each of the elements. 1084 | mapArray :: (MArray a e' m, MArray a e m, Ix i) => (e' -> e) -> a i e' -> m (a i e) 1085 | mapArray f marr = do 1086 | (l,u) <- getBounds marr 1087 | n <- getNumElements marr 1088 | marr' <- newArray_ (l,u) 1089 | sequence_ [do e <- unsafeRead marr i 1090 | unsafeWrite marr' i (f e) 1091 | | i <- [0 .. n - 1]] 1092 | return marr' 1093 | 1094 | {-# INLINE mapIndices #-} 1095 | -- | Constructs a new array derived from the original array by applying a 1096 | -- function to each of the indices. 1097 | mapIndices :: (MArray a e m, Ix i, Ix j) => (i,i) -> (i -> j) -> a j e -> m (a i e) 1098 | mapIndices (l',u') f marr = do 1099 | marr' <- newArray_ (l',u') 1100 | n' <- getNumElements marr' 1101 | sequence_ [do e <- readArray marr (f i') 1102 | unsafeWrite marr' (safeIndex (l',u') n' i') e 1103 | | i' <- range (l',u')] 1104 | return marr' 1105 | 1106 | -- | Strict accumulating left-associative fold. 1107 | -- 1108 | -- @since 0.5.8.0 1109 | foldlMArray' :: (MArray a e m, Ix i) => (b -> e -> b) -> b -> a i e -> m b 1110 | foldlMArray' f = foldlMArrayM' (\z x -> pure (f z x)) 1111 | {-# INLINE foldlMArray' #-} 1112 | 1113 | -- | Strict accumulating right-associative fold. 1114 | -- 1115 | -- @since 0.5.8.0 1116 | foldrMArray' :: (MArray a e m, Ix i) => (e -> b -> b) -> b -> a i e -> m b 1117 | foldrMArray' f = foldrMArrayM' (\x z -> pure (f x z)) 1118 | {-# INLINE foldrMArray' #-} 1119 | 1120 | -- | Strict accumulating left-associative monadic fold. 1121 | -- 1122 | -- @since 0.5.8.0 1123 | foldlMArrayM' :: (MArray a e m, Ix i) => (b -> e -> m b) -> b -> a i e -> m b 1124 | foldlMArrayM' f z0 = \a -> do 1125 | !n <- getNumElements a 1126 | let go !z i | i >= n = pure z 1127 | | otherwise = do 1128 | x <- unsafeRead a i 1129 | z' <- f z x 1130 | go z' (i+1) 1131 | go z0 0 1132 | {-# INLINE foldlMArrayM' #-} 1133 | 1134 | -- | Strict accumulating right-associative monadic fold. 1135 | -- 1136 | -- @since 0.5.8.0 1137 | foldrMArrayM' :: (MArray a e m, Ix i) => (e -> b -> m b) -> b -> a i e -> m b 1138 | foldrMArrayM' f z0 = \a -> do 1139 | !n <- getNumElements a 1140 | let go i !z | i < 0 = pure z 1141 | | otherwise = do 1142 | x <- unsafeRead a i 1143 | z' <- f x z 1144 | go (i-1) z' 1145 | go (n-1) z0 1146 | {-# INLINE foldrMArrayM' #-} 1147 | 1148 | -- | Map elements to monadic actions, sequence them left-to-right, and discard 1149 | -- the results. 1150 | -- 1151 | -- @since 0.5.8.0 1152 | mapMArrayM_ :: (MArray a e m, Ix i) => (e -> m b) -> a i e -> m () 1153 | mapMArrayM_ f = \a -> do 1154 | !n <- getNumElements a 1155 | let go i | i >= n = pure () 1156 | | otherwise = do 1157 | x <- unsafeRead a i 1158 | _ <- f x 1159 | go (i+1) 1160 | go 0 1161 | {-# INLINE mapMArrayM_ #-} 1162 | 1163 | -- | @forMArrayM_@ is 'mapMArrayM_' with its arguments flipped. 1164 | -- 1165 | -- @since 0.5.8.0 1166 | forMArrayM_ :: (MArray a e m, Ix i) => a i e -> (e -> m b) -> m () 1167 | forMArrayM_ = flip mapMArrayM_ 1168 | {-# INLINE forMArrayM_ #-} 1169 | 1170 | ----------------------------------------------------------------------------- 1171 | -- Polymorphic non-strict mutable arrays (ST monad) 1172 | 1173 | instance MArray (STArray s) e (ST s) where 1174 | {-# INLINE getBounds #-} 1175 | getBounds arr = return $! ArrST.boundsSTArray arr 1176 | {-# INLINE getNumElements #-} 1177 | getNumElements arr = return $! ArrST.numElementsSTArray arr 1178 | {-# INLINE newArray #-} 1179 | newArray = ArrST.newSTArray 1180 | {-# INLINE unsafeRead #-} 1181 | unsafeRead = ArrST.unsafeReadSTArray 1182 | {-# INLINE unsafeWrite #-} 1183 | unsafeWrite = ArrST.unsafeWriteSTArray 1184 | 1185 | instance MArray (STArray s) e (Lazy.ST s) where 1186 | {-# INLINE getBounds #-} 1187 | getBounds arr = strictToLazyST (return $! ArrST.boundsSTArray arr) 1188 | {-# INLINE getNumElements #-} 1189 | getNumElements arr = strictToLazyST (return $! ArrST.numElementsSTArray arr) 1190 | {-# INLINE newArray #-} 1191 | newArray (l,u) e = strictToLazyST (ArrST.newSTArray (l,u) e) 1192 | {-# INLINE unsafeRead #-} 1193 | unsafeRead arr i = strictToLazyST (ArrST.unsafeReadSTArray arr i) 1194 | {-# INLINE unsafeWrite #-} 1195 | unsafeWrite arr i e = strictToLazyST (ArrST.unsafeWriteSTArray arr i e) 1196 | 1197 | ----------------------------------------------------------------------------- 1198 | -- Flat unboxed mutable arrays (ST monad) 1199 | 1200 | -- | A mutable array with unboxed elements, that can be manipulated in 1201 | -- the 'ST' monad. The type arguments are as follows: 1202 | -- 1203 | -- * @s@: the state variable argument for the 'ST' type 1204 | -- 1205 | -- * @i@: the index type of the array (should be an instance of @Ix@) 1206 | -- 1207 | -- * @e@: the element type of the array. Only certain element types 1208 | -- are supported. 1209 | -- 1210 | -- An 'STUArray' will generally be more efficient (in terms of both time 1211 | -- and space) than the equivalent boxed version ('STArray') with the same 1212 | -- element type. However, 'STUArray' is strict in its elements - so 1213 | -- don\'t use 'STUArray' if you require the non-strictness that 1214 | -- 'STArray' provides. 1215 | data STUArray s i e = STUArray !i !i !Int (MutableByteArray# s) 1216 | -- The "ST" parameter must be nominal for the safety of the ST trick. 1217 | -- The other parameters have class constraints. See also #9220. 1218 | type role STUArray nominal nominal nominal 1219 | 1220 | instance Eq (STUArray s i e) where 1221 | STUArray _ _ _ arr1# == STUArray _ _ _ arr2# = 1222 | isTrue# (sameMutableByteArray# arr1# arr2#) 1223 | 1224 | {-# INLINE unsafeNewArraySTUArray_ #-} 1225 | unsafeNewArraySTUArray_ :: Ix i 1226 | => (i,i) -> (Int# -> Int#) -> ST s (STUArray s i e) 1227 | unsafeNewArraySTUArray_ (l,u) elemsToBytes 1228 | = case rangeSize (l,u) of 1229 | n@(I# n#) -> 1230 | ST $ \s1# -> 1231 | case newByteArray# (elemsToBytes n#) s1# of 1232 | (# s2#, marr# #) -> 1233 | (# s2#, STUArray l u n marr# #) 1234 | 1235 | instance MArray (STUArray s) Bool (ST s) where 1236 | {-# INLINE getBounds #-} 1237 | getBounds (STUArray l u _ _) = return (l,u) 1238 | {-# INLINE getNumElements #-} 1239 | getNumElements (STUArray _ _ n _) = return n 1240 | {-# INLINE newArray #-} 1241 | newArray (l,u) initialValue = ST $ \s1# -> 1242 | case safeRangeSize (l,u) of { n@(I# n#) -> 1243 | case bOOL_SCALE n# of { nbytes# -> 1244 | case newByteArray# nbytes# s1# of { (# s2#, marr# #) -> 1245 | case setByteArray# marr# 0# nbytes# e# s2# of { s3# -> 1246 | (# s3#, STUArray l u n marr# #) }}}} 1247 | where 1248 | !(I# e#) = if initialValue then 0xff else 0x0 1249 | {-# INLINE unsafeNewArray_ #-} 1250 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) bOOL_SCALE 1251 | {-# INLINE newArray_ #-} 1252 | newArray_ arrBounds = newArray arrBounds False 1253 | {-# INLINE unsafeRead #-} 1254 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1255 | case readWordArray# marr# (bOOL_INDEX i#) s1# of { (# s2#, e# #) -> 1256 | (# s2#, isTrue# ((e# `and#` bOOL_BIT i#) `neWord#` int2Word# 0#) :: Bool #) } 1257 | {-# INLINE unsafeWrite #-} 1258 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) e = ST $ \s1# -> 1259 | case bOOL_INDEX i# of { j# -> 1260 | case readWordArray# marr# j# s1# of { (# s2#, old# #) -> 1261 | case if e then old# `or#` bOOL_BIT i# 1262 | else old# `and#` bOOL_NOT_BIT i# of { e# -> 1263 | case writeWordArray# marr# j# e# s2# of { s3# -> 1264 | (# s3#, () #) }}}} 1265 | 1266 | instance MArray (STUArray s) Char (ST s) where 1267 | {-# INLINE getBounds #-} 1268 | getBounds (STUArray l u _ _) = return (l,u) 1269 | {-# INLINE getNumElements #-} 1270 | getNumElements (STUArray _ _ n _) = return n 1271 | {-# INLINE unsafeNewArray_ #-} 1272 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1273 | {-# INLINE newArray_ #-} 1274 | newArray_ arrBounds = newArray arrBounds (chr 0) 1275 | {-# INLINE unsafeRead #-} 1276 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1277 | case readWideCharArray# marr# i# s1# of { (# s2#, e# #) -> 1278 | (# s2#, C# e# #) } 1279 | {-# INLINE unsafeWrite #-} 1280 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (C# e#) = ST $ \s1# -> 1281 | case writeWideCharArray# marr# i# e# s1# of { s2# -> 1282 | (# s2#, () #) } 1283 | 1284 | instance MArray (STUArray s) Int (ST s) where 1285 | {-# INLINE getBounds #-} 1286 | getBounds (STUArray l u _ _) = return (l,u) 1287 | {-# INLINE getNumElements #-} 1288 | getNumElements (STUArray _ _ n _) = return n 1289 | {-# INLINE unsafeNewArray_ #-} 1290 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1291 | {-# INLINE newArray_ #-} 1292 | newArray_ arrBounds = newArray arrBounds 0 1293 | {-# INLINE unsafeRead #-} 1294 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1295 | case readIntArray# marr# i# s1# of { (# s2#, e# #) -> 1296 | (# s2#, I# e# #) } 1297 | {-# INLINE unsafeWrite #-} 1298 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I# e#) = ST $ \s1# -> 1299 | case writeIntArray# marr# i# e# s1# of { s2# -> 1300 | (# s2#, () #) } 1301 | 1302 | instance MArray (STUArray s) Word (ST s) where 1303 | {-# INLINE getBounds #-} 1304 | getBounds (STUArray l u _ _) = return (l,u) 1305 | {-# INLINE getNumElements #-} 1306 | getNumElements (STUArray _ _ n _) = return n 1307 | {-# INLINE unsafeNewArray_ #-} 1308 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1309 | {-# INLINE newArray_ #-} 1310 | newArray_ arrBounds = newArray arrBounds 0 1311 | {-# INLINE unsafeRead #-} 1312 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1313 | case readWordArray# marr# i# s1# of { (# s2#, e# #) -> 1314 | (# s2#, W# e# #) } 1315 | {-# INLINE unsafeWrite #-} 1316 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W# e#) = ST $ \s1# -> 1317 | case writeWordArray# marr# i# e# s1# of { s2# -> 1318 | (# s2#, () #) } 1319 | 1320 | instance MArray (STUArray s) (Ptr a) (ST s) where 1321 | {-# INLINE getBounds #-} 1322 | getBounds (STUArray l u _ _) = return (l,u) 1323 | {-# INLINE getNumElements #-} 1324 | getNumElements (STUArray _ _ n _) = return n 1325 | {-# INLINE unsafeNewArray_ #-} 1326 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1327 | {-# INLINE newArray_ #-} 1328 | newArray_ arrBounds = newArray arrBounds nullPtr 1329 | {-# INLINE unsafeRead #-} 1330 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1331 | case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> 1332 | (# s2#, Ptr e# #) } 1333 | {-# INLINE unsafeWrite #-} 1334 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (Ptr e#) = ST $ \s1# -> 1335 | case writeAddrArray# marr# i# e# s1# of { s2# -> 1336 | (# s2#, () #) } 1337 | 1338 | instance MArray (STUArray s) (FunPtr a) (ST s) where 1339 | {-# INLINE getBounds #-} 1340 | getBounds (STUArray l u _ _) = return (l,u) 1341 | {-# INLINE getNumElements #-} 1342 | getNumElements (STUArray _ _ n _) = return n 1343 | {-# INLINE unsafeNewArray_ #-} 1344 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1345 | {-# INLINE newArray_ #-} 1346 | newArray_ arrBounds = newArray arrBounds nullFunPtr 1347 | {-# INLINE unsafeRead #-} 1348 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1349 | case readAddrArray# marr# i# s1# of { (# s2#, e# #) -> 1350 | (# s2#, FunPtr e# #) } 1351 | {-# INLINE unsafeWrite #-} 1352 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (FunPtr e#) = ST $ \s1# -> 1353 | case writeAddrArray# marr# i# e# s1# of { s2# -> 1354 | (# s2#, () #) } 1355 | 1356 | instance MArray (STUArray s) Float (ST s) where 1357 | {-# INLINE getBounds #-} 1358 | getBounds (STUArray l u _ _) = return (l,u) 1359 | {-# INLINE getNumElements #-} 1360 | getNumElements (STUArray _ _ n _) = return n 1361 | {-# INLINE unsafeNewArray_ #-} 1362 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) fLOAT_SCALE 1363 | {-# INLINE newArray_ #-} 1364 | newArray_ arrBounds = newArray arrBounds 0 1365 | {-# INLINE unsafeRead #-} 1366 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1367 | case readFloatArray# marr# i# s1# of { (# s2#, e# #) -> 1368 | (# s2#, F# e# #) } 1369 | {-# INLINE unsafeWrite #-} 1370 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (F# e#) = ST $ \s1# -> 1371 | case writeFloatArray# marr# i# e# s1# of { s2# -> 1372 | (# s2#, () #) } 1373 | 1374 | instance MArray (STUArray s) Double (ST s) where 1375 | {-# INLINE getBounds #-} 1376 | getBounds (STUArray l u _ _) = return (l,u) 1377 | {-# INLINE getNumElements #-} 1378 | getNumElements (STUArray _ _ n _) = return n 1379 | {-# INLINE unsafeNewArray_ #-} 1380 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) dOUBLE_SCALE 1381 | {-# INLINE newArray_ #-} 1382 | newArray_ arrBounds = newArray arrBounds 0 1383 | {-# INLINE unsafeRead #-} 1384 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1385 | case readDoubleArray# marr# i# s1# of { (# s2#, e# #) -> 1386 | (# s2#, D# e# #) } 1387 | {-# INLINE unsafeWrite #-} 1388 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (D# e#) = ST $ \s1# -> 1389 | case writeDoubleArray# marr# i# e# s1# of { s2# -> 1390 | (# s2#, () #) } 1391 | 1392 | instance MArray (STUArray s) (StablePtr a) (ST s) where 1393 | {-# INLINE getBounds #-} 1394 | getBounds (STUArray l u _ _) = return (l,u) 1395 | {-# INLINE getNumElements #-} 1396 | getNumElements (STUArray _ _ n _) = return n 1397 | {-# INLINE unsafeNewArray_ #-} 1398 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) wORD_SCALE 1399 | {-# INLINE newArray_ #-} 1400 | newArray_ arrBounds = newArray arrBounds (castPtrToStablePtr nullPtr) 1401 | {-# INLINE unsafeRead #-} 1402 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1403 | case readStablePtrArray# marr# i# s1# of { (# s2#, e# #) -> 1404 | (# s2# , StablePtr e# #) } 1405 | {-# INLINE unsafeWrite #-} 1406 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (StablePtr e#) = ST $ \s1# -> 1407 | case writeStablePtrArray# marr# i# e# s1# of { s2# -> 1408 | (# s2#, () #) } 1409 | 1410 | instance MArray (STUArray s) Int8 (ST s) where 1411 | {-# INLINE getBounds #-} 1412 | getBounds (STUArray l u _ _) = return (l,u) 1413 | {-# INLINE getNumElements #-} 1414 | getNumElements (STUArray _ _ n _) = return n 1415 | {-# INLINE unsafeNewArray_ #-} 1416 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) 1417 | {-# INLINE newArray_ #-} 1418 | newArray_ arrBounds = newArray arrBounds 0 1419 | {-# INLINE unsafeRead #-} 1420 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1421 | case readInt8Array# marr# i# s1# of { (# s2#, e# #) -> 1422 | (# s2#, I8# e# #) } 1423 | {-# INLINE unsafeWrite #-} 1424 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I8# e#) = ST $ \s1# -> 1425 | case writeInt8Array# marr# i# e# s1# of { s2# -> 1426 | (# s2#, () #) } 1427 | 1428 | instance MArray (STUArray s) Int16 (ST s) where 1429 | {-# INLINE getBounds #-} 1430 | getBounds (STUArray l u _ _) = return (l,u) 1431 | {-# INLINE getNumElements #-} 1432 | getNumElements (STUArray _ _ n _) = return n 1433 | {-# INLINE unsafeNewArray_ #-} 1434 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#) 1435 | {-# INLINE newArray_ #-} 1436 | newArray_ arrBounds = newArray arrBounds 0 1437 | {-# INLINE unsafeRead #-} 1438 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1439 | case readInt16Array# marr# i# s1# of { (# s2#, e# #) -> 1440 | (# s2#, I16# e# #) } 1441 | {-# INLINE unsafeWrite #-} 1442 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I16# e#) = ST $ \s1# -> 1443 | case writeInt16Array# marr# i# e# s1# of { s2# -> 1444 | (# s2#, () #) } 1445 | 1446 | instance MArray (STUArray s) Int32 (ST s) where 1447 | {-# INLINE getBounds #-} 1448 | getBounds (STUArray l u _ _) = return (l,u) 1449 | {-# INLINE getNumElements #-} 1450 | getNumElements (STUArray _ _ n _) = return n 1451 | {-# INLINE unsafeNewArray_ #-} 1452 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1453 | {-# INLINE newArray_ #-} 1454 | newArray_ arrBounds = newArray arrBounds 0 1455 | {-# INLINE unsafeRead #-} 1456 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1457 | case readInt32Array# marr# i# s1# of { (# s2#, e# #) -> 1458 | (# s2#, I32# e# #) } 1459 | {-# INLINE unsafeWrite #-} 1460 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I32# e#) = ST $ \s1# -> 1461 | case writeInt32Array# marr# i# e# s1# of { s2# -> 1462 | (# s2#, () #) } 1463 | 1464 | instance MArray (STUArray s) Int64 (ST s) where 1465 | {-# INLINE getBounds #-} 1466 | getBounds (STUArray l u _ _) = return (l,u) 1467 | {-# INLINE getNumElements #-} 1468 | getNumElements (STUArray _ _ n _) = return n 1469 | {-# INLINE unsafeNewArray_ #-} 1470 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#) 1471 | {-# INLINE newArray_ #-} 1472 | newArray_ arrBounds = newArray arrBounds 0 1473 | {-# INLINE unsafeRead #-} 1474 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1475 | case readInt64Array# marr# i# s1# of { (# s2#, e# #) -> 1476 | (# s2#, I64# e# #) } 1477 | {-# INLINE unsafeWrite #-} 1478 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (I64# e#) = ST $ \s1# -> 1479 | case writeInt64Array# marr# i# e# s1# of { s2# -> 1480 | (# s2#, () #) } 1481 | 1482 | instance MArray (STUArray s) Word8 (ST s) where 1483 | {-# INLINE getBounds #-} 1484 | getBounds (STUArray l u _ _) = return (l,u) 1485 | {-# INLINE getNumElements #-} 1486 | getNumElements (STUArray _ _ n _) = return n 1487 | {-# INLINE unsafeNewArray_ #-} 1488 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (\x -> x) 1489 | {-# INLINE newArray_ #-} 1490 | newArray_ arrBounds = newArray arrBounds 0 1491 | {-# INLINE unsafeRead #-} 1492 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1493 | case readWord8Array# marr# i# s1# of { (# s2#, e# #) -> 1494 | (# s2#, W8# e# #) } 1495 | {-# INLINE unsafeWrite #-} 1496 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W8# e#) = ST $ \s1# -> 1497 | case writeWord8Array# marr# i# e# s1# of { s2# -> 1498 | (# s2#, () #) } 1499 | 1500 | instance MArray (STUArray s) Word16 (ST s) where 1501 | {-# INLINE getBounds #-} 1502 | getBounds (STUArray l u _ _) = return (l,u) 1503 | {-# INLINE getNumElements #-} 1504 | getNumElements (STUArray _ _ n _) = return n 1505 | {-# INLINE unsafeNewArray_ #-} 1506 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 2#) 1507 | {-# INLINE newArray_ #-} 1508 | newArray_ arrBounds = newArray arrBounds 0 1509 | {-# INLINE unsafeRead #-} 1510 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1511 | case readWord16Array# marr# i# s1# of { (# s2#, e# #) -> 1512 | (# s2#, W16# e# #) } 1513 | {-# INLINE unsafeWrite #-} 1514 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W16# e#) = ST $ \s1# -> 1515 | case writeWord16Array# marr# i# e# s1# of { s2# -> 1516 | (# s2#, () #) } 1517 | 1518 | instance MArray (STUArray s) Word32 (ST s) where 1519 | {-# INLINE getBounds #-} 1520 | getBounds (STUArray l u _ _) = return (l,u) 1521 | {-# INLINE getNumElements #-} 1522 | getNumElements (STUArray _ _ n _) = return n 1523 | {-# INLINE unsafeNewArray_ #-} 1524 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 4#) 1525 | {-# INLINE newArray_ #-} 1526 | newArray_ arrBounds = newArray arrBounds 0 1527 | {-# INLINE unsafeRead #-} 1528 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1529 | case readWord32Array# marr# i# s1# of { (# s2#, e# #) -> 1530 | (# s2#, W32# e# #) } 1531 | {-# INLINE unsafeWrite #-} 1532 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W32# e#) = ST $ \s1# -> 1533 | case writeWord32Array# marr# i# e# s1# of { s2# -> 1534 | (# s2#, () #) } 1535 | 1536 | instance MArray (STUArray s) Word64 (ST s) where 1537 | {-# INLINE getBounds #-} 1538 | getBounds (STUArray l u _ _) = return (l,u) 1539 | {-# INLINE getNumElements #-} 1540 | getNumElements (STUArray _ _ n _) = return n 1541 | {-# INLINE unsafeNewArray_ #-} 1542 | unsafeNewArray_ (l,u) = unsafeNewArraySTUArray_ (l,u) (safe_scale 8#) 1543 | {-# INLINE newArray_ #-} 1544 | newArray_ arrBounds = newArray arrBounds 0 1545 | {-# INLINE unsafeRead #-} 1546 | unsafeRead (STUArray _ _ _ marr#) (I# i#) = ST $ \s1# -> 1547 | case readWord64Array# marr# i# s1# of { (# s2#, e# #) -> 1548 | (# s2#, W64# e# #) } 1549 | {-# INLINE unsafeWrite #-} 1550 | unsafeWrite (STUArray _ _ _ marr#) (I# i#) (W64# e#) = ST $ \s1# -> 1551 | case writeWord64Array# marr# i# e# s1# of { s2# -> 1552 | (# s2#, () #) } 1553 | 1554 | ----------------------------------------------------------------------------- 1555 | -- Translation between elements and bytes 1556 | 1557 | bOOL_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# 1558 | bOOL_SCALE n# = 1559 | -- Round the number of bits up to the next whole-word-aligned number 1560 | -- of bytes to avoid ghc#23132; the addition can signed-overflow but 1561 | -- that's OK because it will not unsigned-overflow and the logical 1562 | -- right-shift brings us back in-bounds 1563 | #if SIZEOF_HSWORD == 4 1564 | ((n# +# 31#) `uncheckedIShiftRL#` 5#) `uncheckedIShiftL#` 2# 1565 | #elif SIZEOF_HSWORD == 8 1566 | ((n# +# 63#) `uncheckedIShiftRL#` 6#) `uncheckedIShiftL#` 3# 1567 | #endif 1568 | wORD_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSWORD 1569 | dOUBLE_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSDOUBLE 1570 | fLOAT_SCALE n# = safe_scale scale# n# where !(I# scale#) = SIZEOF_HSFLOAT 1571 | 1572 | safe_scale :: Int# -> Int# -> Int# 1573 | safe_scale scale# n# 1574 | | not overflow = res# 1575 | | otherwise = error $ "Data.Array.Base.safe_scale: Overflow; scale: " 1576 | ++ show (I# scale#) ++ ", n: " ++ show (I# n#) 1577 | where 1578 | !res# = scale# *# n# 1579 | !overflow = isTrue# (maxN# `divInt#` scale# <# n#) 1580 | !(I# maxN#) = maxBound 1581 | {-# INLINE safe_scale #-} 1582 | 1583 | -- | The index of the word which the given @Bool@ array elements falls within. 1584 | bOOL_INDEX :: Int# -> Int# 1585 | #if SIZEOF_HSWORD == 4 1586 | bOOL_INDEX i# = i# `uncheckedIShiftRA#` 5# 1587 | #elif SIZEOF_HSWORD == 8 1588 | bOOL_INDEX i# = i# `uncheckedIShiftRA#` 6# 1589 | #endif 1590 | 1591 | bOOL_BIT, bOOL_NOT_BIT :: Int# -> Word# 1592 | bOOL_BIT n# = int2Word# 1# `uncheckedShiftL#` (word2Int# (int2Word# n# `and#` mask#)) 1593 | where !(W# mask#) = SIZEOF_HSWORD * 8 - 1 1594 | bOOL_NOT_BIT n# = bOOL_BIT n# `xor#` mb# 1595 | where !(W# mb#) = maxBound 1596 | 1597 | ----------------------------------------------------------------------------- 1598 | -- Freezing 1599 | 1600 | -- | Converts a mutable array (any instance of 'MArray') to an 1601 | -- immutable array (any instance of 'IArray') by taking a complete 1602 | -- copy of it. 1603 | freeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 1604 | {-# NOINLINE [1] freeze #-} 1605 | freeze marr = do 1606 | (l,u) <- getBounds marr 1607 | n <- getNumElements marr 1608 | es <- mapM (unsafeRead marr) [0 .. n - 1] 1609 | -- The old array and index might not be well-behaved, so we need to 1610 | -- use the safe array creation function here. 1611 | return (listArray (l,u) es) 1612 | 1613 | freezeSTUArray :: STUArray s i e -> ST s (UArray i e) 1614 | freezeSTUArray (STUArray l u n marr#) = ST $ \s1# -> 1615 | case getSizeofMutableByteArray# marr# s1# of { (# s2#, n# #) -> 1616 | case newByteArray# n# s2# of { (# s3#, marr'# #) -> 1617 | case memcpy_freeze marr'# marr# (fromIntegral (I# n#)) of { IO m -> 1618 | case unsafeCoerce# m s3# of { (# s4#, _ #) -> 1619 | case unsafeFreezeByteArray# marr'# s4# of { (# s5#, arr# #) -> 1620 | (# s5#, UArray l u n arr# #) }}}}} 1621 | 1622 | foreign import ccall unsafe "memcpy" 1623 | memcpy_freeze :: MutableByteArray# s -> MutableByteArray# s -> CSize 1624 | -> IO (Ptr a) 1625 | 1626 | {-# RULES 1627 | "freeze/STArray" freeze = ArrST.freezeSTArray 1628 | "freeze/STUArray" freeze = freezeSTUArray 1629 | #-} 1630 | 1631 | -- In-place conversion of mutable arrays to immutable ones places 1632 | -- a proof obligation on the user: no other parts of your code can 1633 | -- have a reference to the array at the point where you unsafely 1634 | -- freeze it (and, subsequently mutate it, I suspect). 1635 | 1636 | {- | 1637 | Converts an mutable array into an immutable array. The 1638 | implementation may either simply cast the array from 1639 | one type to the other without copying the array, or it 1640 | may take a full copy of the array. 1641 | 1642 | Note that because the array is possibly not copied, any subsequent 1643 | modifications made to the mutable version of the array may be 1644 | shared with the immutable version. It is safe to use, therefore, if 1645 | the mutable version is never modified after the freeze operation. 1646 | 1647 | The non-copying implementation is supported between certain pairs 1648 | of array types only; one constraint is that the array types must 1649 | have identical representations. In GHC, The following pairs of 1650 | array types have a non-copying O(1) implementation of 1651 | 'unsafeFreeze'. Because the optimised versions are enabled by 1652 | specialisations, you will need to compile with optimisation (-O) to 1653 | get them. 1654 | 1655 | * 'Data.Array.IO.IOUArray' -> 'Data.Array.Unboxed.UArray' 1656 | 1657 | * 'Data.Array.ST.STUArray' -> 'Data.Array.Unboxed.UArray' 1658 | 1659 | * 'Data.Array.IO.IOArray' -> 'Data.Array.Array' 1660 | 1661 | * 'Data.Array.ST.STArray' -> 'Data.Array.Array' 1662 | -} 1663 | {-# INLINE [1] unsafeFreeze #-} 1664 | unsafeFreeze :: (Ix i, MArray a e m, IArray b e) => a i e -> m (b i e) 1665 | unsafeFreeze = freeze 1666 | 1667 | {-# RULES 1668 | "unsafeFreeze/STArray" unsafeFreeze = ArrST.unsafeFreezeSTArray 1669 | "unsafeFreeze/STUArray" unsafeFreeze = unsafeFreezeSTUArray 1670 | #-} 1671 | 1672 | ----------------------------------------------------------------------------- 1673 | -- Thawing 1674 | 1675 | -- | Converts an immutable array (any instance of 'IArray') into a 1676 | -- mutable array (any instance of 'MArray') by taking a complete copy 1677 | -- of it. 1678 | thaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 1679 | {-# NOINLINE [1] thaw #-} 1680 | thaw arr = case bounds arr of 1681 | (l,u) -> do 1682 | marr <- newArray_ (l,u) 1683 | let n = safeRangeSize (l,u) 1684 | sequence_ [ unsafeWrite marr i (unsafeAt arr i) 1685 | | i <- [0 .. n - 1]] 1686 | return marr 1687 | 1688 | thawSTUArray :: UArray i e -> ST s (STUArray s i e) 1689 | thawSTUArray (UArray l u n arr#) = ST $ \s1# -> 1690 | case sizeofByteArray# arr# of { n# -> 1691 | case newByteArray# n# s1# of { (# s2#, marr# #) -> 1692 | case memcpy_thaw marr# arr# (fromIntegral (I# n#)) of { IO m -> 1693 | case unsafeCoerce# m s2# of { (# s3#, _ #) -> 1694 | (# s3#, STUArray l u n marr# #) }}}} 1695 | 1696 | foreign import ccall unsafe "memcpy" 1697 | memcpy_thaw :: MutableByteArray# s -> ByteArray# -> CSize 1698 | -> IO (Ptr a) 1699 | 1700 | {-# RULES 1701 | "thaw/STArray" thaw = ArrST.thawSTArray 1702 | "thaw/STUArray" thaw = thawSTUArray 1703 | #-} 1704 | 1705 | -- In-place conversion of immutable arrays to mutable ones places 1706 | -- a proof obligation on the user: no other parts of your code can 1707 | -- have a reference to the array at the point where you unsafely 1708 | -- thaw it (and, subsequently mutate it, I suspect). 1709 | 1710 | {- | 1711 | Converts an immutable array into a mutable array. The 1712 | implementation may either simply cast the array from 1713 | one type to the other without copying the array, or it 1714 | may take a full copy of the array. 1715 | 1716 | Note that because the array is possibly not copied, any subsequent 1717 | modifications made to the mutable version of the array may be 1718 | shared with the immutable version. It is only safe to use, 1719 | therefore, if the immutable array is never referenced again in this 1720 | thread, and there is no possibility that it can be also referenced 1721 | in another thread. If you use an unsafeThaw/write/unsafeFreeze 1722 | sequence in a multi-threaded setting, then you must ensure that 1723 | this sequence is atomic with respect to other threads, or a garbage 1724 | collector crash may result (because the write may be writing to a 1725 | frozen array). 1726 | 1727 | The non-copying implementation is supported between certain pairs 1728 | of array types only; one constraint is that the array types must 1729 | have identical representations. In GHC, The following pairs of 1730 | array types have a non-copying O(1) implementation of 1731 | 'unsafeThaw'. Because the optimised versions are enabled by 1732 | specialisations, you will need to compile with optimisation (-O) to 1733 | get them. 1734 | 1735 | * 'Data.Array.Unboxed.UArray' -> 'Data.Array.IO.IOUArray' 1736 | 1737 | * 'Data.Array.Unboxed.UArray' -> 'Data.Array.ST.STUArray' 1738 | 1739 | * 'Data.Array.Array' -> 'Data.Array.IO.IOArray' 1740 | 1741 | * 'Data.Array.Array' -> 'Data.Array.ST.STArray' 1742 | -} 1743 | {-# INLINE [1] unsafeThaw #-} 1744 | unsafeThaw :: (Ix i, IArray a e, MArray b e m) => a i e -> m (b i e) 1745 | unsafeThaw = thaw 1746 | 1747 | {-# INLINE unsafeThawSTUArray #-} 1748 | unsafeThawSTUArray :: UArray i e -> ST s (STUArray s i e) 1749 | unsafeThawSTUArray (UArray l u n marr#) = 1750 | return (STUArray l u n (unsafeCoerce# marr#)) 1751 | 1752 | {-# RULES 1753 | "unsafeThaw/STArray" unsafeThaw = ArrST.unsafeThawSTArray 1754 | "unsafeThaw/STUArray" unsafeThaw = unsafeThawSTUArray 1755 | #-} 1756 | 1757 | {-# INLINE unsafeThawIOArray #-} 1758 | unsafeThawIOArray :: Arr.Array ix e -> IO (IOArray ix e) 1759 | unsafeThawIOArray arr = stToIO $ do 1760 | marr <- ArrST.unsafeThawSTArray arr 1761 | return (IOArray marr) 1762 | 1763 | {-# RULES 1764 | "unsafeThaw/IOArray" unsafeThaw = unsafeThawIOArray 1765 | #-} 1766 | 1767 | thawIOArray :: Arr.Array ix e -> IO (IOArray ix e) 1768 | thawIOArray arr = stToIO $ do 1769 | marr <- ArrST.thawSTArray arr 1770 | return (IOArray marr) 1771 | 1772 | {-# RULES 1773 | "thaw/IOArray" thaw = thawIOArray 1774 | #-} 1775 | 1776 | freezeIOArray :: IOArray ix e -> IO (Arr.Array ix e) 1777 | freezeIOArray (IOArray marr) = stToIO (ArrST.freezeSTArray marr) 1778 | 1779 | {-# RULES 1780 | "freeze/IOArray" freeze = freezeIOArray 1781 | #-} 1782 | 1783 | {-# INLINE unsafeFreezeIOArray #-} 1784 | unsafeFreezeIOArray :: IOArray ix e -> IO (Arr.Array ix e) 1785 | unsafeFreezeIOArray (IOArray marr) = stToIO (ArrST.unsafeFreezeSTArray marr) 1786 | 1787 | {-# RULES 1788 | "unsafeFreeze/IOArray" unsafeFreeze = unsafeFreezeIOArray 1789 | #-} 1790 | 1791 | -- | Casts an 'STUArray' with one element type into one with a 1792 | -- different element type. All the elements of the resulting array 1793 | -- are undefined (unless you know what you\'re doing...). 1794 | 1795 | castSTUArray :: STUArray s ix a -> ST s (STUArray s ix b) 1796 | castSTUArray (STUArray l u n marr#) = return (STUArray l u n marr#) 1797 | 1798 | -------------------------------------------------------------------------------- 1799 | 1800 | -- Note [Inlining and fusion] 1801 | -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ 1802 | -- Many functions in this module are marked INLINE because they consume their 1803 | -- input with `foldr`. By inlining them, it is possible that the `foldr` will 1804 | -- meet a `build` from the call site, and beneficial fusion will take place. 1805 | -- That is, they become "good consumers". See array issue #8 for data showing 1806 | -- the perf improvement that comes with fusion. 1807 | --------------------------------------------------------------------------------