1{-# LANGUAGE CPP #-}
2{-# LANGUAGE MagicHash #-}
3{-# LANGUAGE UnboxedTuples #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5
6-- |
7-- Module      : Data.Primitive.Ptr
8-- Copyright   : (c) Roman Leshchinskiy 2009-2012
9-- License     : BSD-style
10--
11-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
12-- Portability : non-portable
13--
14-- Primitive operations on machine addresses
15--
16-- @since 0.6.4.0
17
18module Data.Primitive.Ptr (
19  -- * Types
20  Ptr(..),
21
22  -- * Address arithmetic
23  nullPtr, advancePtr, subtractPtr,
24
25  -- * Element access
26  indexOffPtr, readOffPtr, writeOffPtr,
27
28  -- * Block operations
29  copyPtr, movePtr, setPtr
30
31#if __GLASGOW_HASKELL__ >= 708
32  , copyPtrToMutablePrimArray
33  , copyPtrToMutableByteArray
34#endif
35) where
36
37import Control.Monad.Primitive
38import Data.Primitive.Types
39#if __GLASGOW_HASKELL__ >= 708
40import Data.Primitive.PrimArray (MutablePrimArray(..))
41import Data.Primitive.ByteArray (MutableByteArray(..))
42#endif
43
44import GHC.Base ( Int(..) )
45import GHC.Exts
46
47import GHC.Ptr
48import Foreign.Marshal.Utils
49
50
51-- | Offset a pointer by the given number of elements.
52advancePtr :: forall a. Prim a => Ptr a -> Int -> Ptr a
53{-# INLINE advancePtr #-}
54advancePtr (Ptr a#) (I# i#) = Ptr (plusAddr# a# (i# *# sizeOf# (undefined :: a)))
55
56-- | Subtract a pointer from another pointer. The result represents
57--   the number of elements of type @a@ that fit in the contiguous
58--   memory range bounded by these two pointers.
59subtractPtr :: forall a. Prim a => Ptr a -> Ptr a -> Int
60{-# INLINE subtractPtr #-}
61subtractPtr (Ptr a#) (Ptr b#) = I# (quotInt# (minusAddr# a# b#) (sizeOf# (undefined :: a)))
62
63-- | Read a value from a memory position given by a pointer and an offset.
64-- The memory block the address refers to must be immutable. The offset is in
65-- elements of type @a@ rather than in bytes.
66indexOffPtr :: Prim a => Ptr a -> Int -> a
67{-# INLINE indexOffPtr #-}
68indexOffPtr (Ptr addr#) (I# i#) = indexOffAddr# addr# i#
69
70-- | Read a value from a memory position given by an address and an offset.
71-- The offset is in elements of type @a@ rather than in bytes.
72readOffPtr :: (Prim a, PrimMonad m) => Ptr a -> Int -> m a
73{-# INLINE readOffPtr #-}
74readOffPtr (Ptr addr#) (I# i#) = primitive (readOffAddr# addr# i#)
75
76-- | Write a value to a memory position given by an address and an offset.
77-- The offset is in elements of type @a@ rather than in bytes.
78writeOffPtr :: (Prim a, PrimMonad m) => Ptr a -> Int -> a -> m ()
79{-# INLINE writeOffPtr #-}
80writeOffPtr (Ptr addr#) (I# i#) x = primitive_ (writeOffAddr# addr# i# x)
81
82-- | Copy the given number of elements from the second 'Ptr' to the first. The
83-- areas may not overlap.
84copyPtr :: forall m a. (PrimMonad m, Prim a)
85  => Ptr a -- ^ destination pointer
86  -> Ptr a -- ^ source pointer
87  -> Int -- ^ number of elements
88  -> m ()
89{-# INLINE copyPtr #-}
90copyPtr (Ptr dst#) (Ptr src#) n
91  = unsafePrimToPrim $ copyBytes (Ptr dst#) (Ptr src#) (n * sizeOf (undefined :: a))
92
93-- | Copy the given number of elements from the second 'Ptr' to the first. The
94-- areas may overlap.
95movePtr :: forall m a. (PrimMonad m, Prim a)
96  => Ptr a -- ^ destination address
97  -> Ptr a -- ^ source address
98  -> Int -- ^ number of elements
99  -> m ()
100{-# INLINE movePtr #-}
101movePtr (Ptr dst#) (Ptr src#) n
102  = unsafePrimToPrim $ moveBytes (Ptr dst#) (Ptr src#) (n * sizeOf (undefined :: a))
103
104-- | Fill a memory block with the given value. The length is in
105-- elements of type @a@ rather than in bytes.
106setPtr :: (Prim a, PrimMonad m) => Ptr a -> Int -> a -> m ()
107{-# INLINE setPtr #-}
108setPtr (Ptr addr#) (I# n#) x = primitive_ (setOffAddr# addr# 0# n# x)
109
110
111#if __GLASGOW_HASKELL__ >= 708
112-- | Copy from a pointer to a mutable primitive array.
113-- The offset and length are given in elements of type @a@.
114-- This function is only available when building with GHC 7.8
115-- or newer.
116copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)
117  => MutablePrimArray (PrimState m) a -- ^ destination array
118  -> Int -- ^ destination offset
119  -> Ptr a -- ^ source pointer
120  -> Int -- ^ number of elements
121  -> m ()
122{-# INLINE copyPtrToMutablePrimArray #-}
123copyPtrToMutablePrimArray (MutablePrimArray ba#) (I# doff#) (Ptr addr#) (I# n#) =
124  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))
125  where
126  siz# = sizeOf# (undefined :: a)
127
128-- | Copy from a pointer to a mutable byte array.
129-- The offset and length are given in elements of type @a@.
130-- This function is only available when building with GHC 7.8
131-- or newer.
132copyPtrToMutableByteArray :: forall m a. (PrimMonad m, Prim a)
133  => MutableByteArray (PrimState m) -- ^ destination array
134  -> Int   -- ^ destination offset given in elements of type @a@
135  -> Ptr a -- ^ source pointer
136  -> Int   -- ^ number of elements
137  -> m ()
138{-# INLINE copyPtrToMutableByteArray #-}
139copyPtrToMutableByteArray (MutableByteArray ba#) (I# doff#) (Ptr addr#) (I# n#) =
140  primitive_ (copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#))
141  where
142  siz# = sizeOf# (undefined :: a)
143#endif
144