1{-# LANGUAGE Unsafe #-}
2{-# LANGUAGE NoImplicitPrelude
3           , MagicHash
4           , UnboxedTuples
5  #-}
6{-# OPTIONS_HADDOCK not-home #-}
7
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  GHC.Stable
11-- Copyright   :  (c) The University of Glasgow, 1992-2004
12-- License     :  see libraries/base/LICENSE
13--
14-- Maintainer  :  ffi@haskell.org
15-- Stability   :  internal
16-- Portability :  non-portable (GHC Extensions)
17--
18-- Stable pointers.
19--
20-----------------------------------------------------------------------------
21
22module GHC.Stable (
23        StablePtr(..),
24        newStablePtr,
25        deRefStablePtr,
26        freeStablePtr,
27        castStablePtrToPtr,
28        castPtrToStablePtr
29    ) where
30
31import GHC.Ptr
32import GHC.Base
33
34-----------------------------------------------------------------------------
35-- Stable Pointers
36
37{- |
38A /stable pointer/ is a reference to a Haskell expression that is
39guaranteed not to be affected by garbage collection, i.e., it will neither be
40deallocated nor will the value of the stable pointer itself change during
41garbage collection (ordinary references may be relocated during garbage
42collection).  Consequently, stable pointers can be passed to foreign code,
43which can treat it as an opaque reference to a Haskell value.
44
45A value of type @StablePtr a@ is a stable pointer to a Haskell
46expression of type @a@.
47-}
48data {-# CTYPE "HsStablePtr" #-} StablePtr a = StablePtr (StablePtr# a)
49
50-- |
51-- Create a stable pointer referring to the given Haskell value.
52--
53newStablePtr   :: a -> IO (StablePtr a)
54newStablePtr a = IO $ \ s ->
55    case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #)
56
57-- |
58-- Obtain the Haskell value referenced by a stable pointer, i.e., the
59-- same value that was passed to the corresponding call to
60-- 'newStablePtr'.  If the argument to 'deRefStablePtr' has
61-- already been freed using 'freeStablePtr', the behaviour of
62-- 'deRefStablePtr' is undefined.
63--
64deRefStablePtr :: StablePtr a -> IO a
65deRefStablePtr (StablePtr sp) = IO $ \s -> deRefStablePtr# sp s
66
67-- |
68-- Dissolve the association between the stable pointer and the Haskell
69-- value. Afterwards, if the stable pointer is passed to
70-- 'deRefStablePtr' or 'freeStablePtr', the behaviour is
71-- undefined.  However, the stable pointer may still be passed to
72-- 'castStablePtrToPtr', but the @'Foreign.Ptr.Ptr' ()@ value returned
73-- by 'castStablePtrToPtr', in this case, is undefined (in particular,
74-- it may be 'Foreign.Ptr.nullPtr').  Nevertheless, the call
75-- to 'castStablePtrToPtr' is guaranteed not to diverge.
76--
77foreign import ccall unsafe "hs_free_stable_ptr" freeStablePtr :: StablePtr a -> IO ()
78
79-- |
80-- Coerce a stable pointer to an address. No guarantees are made about
81-- the resulting value, except that the original stable pointer can be
82-- recovered by 'castPtrToStablePtr'.  In particular, the address may not
83-- refer to an accessible memory location and any attempt to pass it to
84-- the member functions of the class 'Foreign.Storable.Storable' leads to
85-- undefined behaviour.
86--
87castStablePtrToPtr :: StablePtr a -> Ptr ()
88castStablePtrToPtr (StablePtr s) = Ptr (unsafeCoerce# s)
89
90
91-- |
92-- The inverse of 'castStablePtrToPtr', i.e., we have the identity
93--
94-- > sp == castPtrToStablePtr (castStablePtrToPtr sp)
95--
96-- for any stable pointer @sp@ on which 'freeStablePtr' has
97-- not been executed yet.  Moreover, 'castPtrToStablePtr' may
98-- only be applied to pointers that have been produced by
99-- 'castStablePtrToPtr'.
100--
101castPtrToStablePtr :: Ptr () -> StablePtr a
102castPtrToStablePtr (Ptr a) = StablePtr (unsafeCoerce# a)
103
104-- | @since 2.01
105instance Eq (StablePtr a) where
106    (StablePtr sp1) == (StablePtr sp2) =
107        case eqStablePtr# sp1 sp2 of
108           0# -> False
109           _  -> True
110