File: Internals.hs

package info (click to toggle)
ghc 8.8.4-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 80,760 kB
  • sloc: haskell: 461,232; ansic: 62,975; sh: 8,706; python: 1,902; asm: 1,714; makefile: 1,120; perl: 458; javascript: 207; xml: 196; cpp: 147; ruby: 84; lisp: 7
file content (80 lines) | stat: -rw-r--r-- 2,944 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RoleAnnotations #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Array.Storable.Internals
-- Copyright   :  (c) The University of Glasgow 2011
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (uses Data.Array.MArray)
--
-- Actual implementation of "Data.Array.Storable".
--
-- @since 0.4.0.0
-----------------------------------------------------------------------------

module Data.Array.Storable.Internals (
    StorableArray(..),
    withStorableArray,
    touchStorableArray,
    unsafeForeignPtrToStorableArray,
  ) where

import Data.Array.Base
import Data.Array.MArray
import Foreign hiding (newArray)

-- |The array type
data StorableArray i e = StorableArray !i !i Int !(ForeignPtr e)
-- Both parameters have class-based invariants. See also #9220.
type role StorableArray nominal nominal

instance Storable e => MArray StorableArray e IO where
    getBounds (StorableArray l u _ _) = return (l,u)

    getNumElements (StorableArray _l _u n _) = return n

    newArray (l,u) initialValue = do
        fp <- mallocForeignPtrArray size
        withForeignPtr fp $ \a ->
            sequence_ [pokeElemOff a i initialValue | i <- [0..size-1]]
        return (StorableArray l u size fp)
        where
        size = rangeSize (l,u)

    unsafeNewArray_ (l,u) = do
        let n = rangeSize (l,u)
        fp <- mallocForeignPtrArray n
        return (StorableArray l u n fp)

    newArray_ = unsafeNewArray_

    unsafeRead (StorableArray _ _ _ fp) i =
        withForeignPtr fp $ \a -> peekElemOff a i

    unsafeWrite (StorableArray _ _ _ fp) i e =
        withForeignPtr fp $ \a -> pokeElemOff a i e

-- |The pointer to the array contents is obtained by 'withStorableArray'.
-- The idea is similar to 'ForeignPtr' (used internally here).
-- The pointer should be used only during execution of the 'IO' action
-- retured by the function passed as argument to 'withStorableArray'.
withStorableArray :: StorableArray i e -> (Ptr e -> IO a) -> IO a
withStorableArray (StorableArray _ _ _ fp) f = withForeignPtr fp f

-- |If you want to use it afterwards, ensure that you
-- 'touchStorableArray' after the last use of the pointer,
-- so the array is not freed too early.
touchStorableArray :: StorableArray i e -> IO ()
touchStorableArray (StorableArray _ _ _ fp) = touchForeignPtr fp

-- |Construct a 'StorableArray' from an arbitrary 'ForeignPtr'.  It is
-- the caller's responsibility to ensure that the 'ForeignPtr' points to
-- an area of memory sufficient for the specified bounds.
unsafeForeignPtrToStorableArray
   :: Ix i => ForeignPtr e -> (i,i) -> IO (StorableArray i e)
unsafeForeignPtrToStorableArray p (l,u) =
   return (StorableArray l u (rangeSize (l,u)) p)