Trac #9878: Make the static form illegal in interpreted mode.
[ghc.git] / libraries / base / GHC / StaticPtr.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE MagicHash #-}
3 {-# LANGUAGE UnboxedTuples #-}
4 {-# LANGUAGE ExistentialQuantification #-}
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : GHC.StaticPtr
8 -- Copyright : (C) 2014 I/O Tweag
9 -- License : see libraries/base/LICENSE
10 --
11 -- Maintainer : cvs-ghc@haskell.org
12 -- Stability : internal
13 -- Portability : non-portable (GHC Extensions)
14 --
15 -- Symbolic references to values.
16 --
17 -- References to values are usually implemented with memory addresses, and this
18 -- is practical when communicating values between the different pieces of a
19 -- single process.
20 --
21 -- When values are communicated across different processes running in possibly
22 -- different machines, though, addresses are no longer useful since each
23 -- process may use different addresses to store a given value.
24 --
25 -- To solve such concern, the references provided by this module offer a key
26 -- that can be used to locate the values on each process. Each process maintains
27 -- a global table of references which can be looked up with a given key. This
28 -- table is known as the Static Pointer Table. The reference can then be
29 -- dereferenced to obtain the value.
30 --
31 -----------------------------------------------------------------------------
32
33 module GHC.StaticPtr
34 ( StaticPtr
35 , deRefStaticPtr
36 , StaticKey
37 , staticKey
38 , unsafeLookupStaticPtr
39 , StaticPtrInfo(..)
40 , staticPtrInfo
41 , staticPtrKeys
42 ) where
43
44 import Data.Typeable (Typeable)
45 import Foreign.C.Types (CInt(..))
46 import Foreign.Marshal (allocaArray, peekArray, withArray)
47 import Foreign.Ptr (castPtr)
48 import GHC.Exts (addrToAny#)
49 import GHC.Ptr (Ptr(..), nullPtr)
50 import GHC.Fingerprint (Fingerprint(..))
51
52
53 -- | A reference to a value of type 'a'.
54 data StaticPtr a = StaticPtr StaticKey StaticPtrInfo a
55 deriving Typeable
56
57 -- | Dereferences a static pointer.
58 deRefStaticPtr :: StaticPtr a -> a
59 deRefStaticPtr (StaticPtr _ _ v) = v
60
61 -- | A key for `StaticPtrs` that can be serialized and used with
62 -- 'unsafeLookupStaticPtr'.
63 type StaticKey = Fingerprint
64
65 -- | The 'StaticKey' that can be used to look up the given 'StaticPtr'.
66 staticKey :: StaticPtr a -> StaticKey
67 staticKey (StaticPtr k _ _) = k
68
69 -- | Looks up a 'StaticPtr' by its 'StaticKey'.
70 --
71 -- If the 'StaticPtr' is not found returns @Nothing@.
72 --
73 -- This function is unsafe because the program behavior is undefined if the type
74 -- of the returned 'StaticPtr' does not match the expected one.
75 --
76 unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))
77 unsafeLookupStaticPtr (Fingerprint w1 w2) = do
78 ptr@(Ptr addr) <- withArray [w1,w2] (hs_spt_lookup . castPtr)
79 if (ptr == nullPtr)
80 then return Nothing
81 else case addrToAny# addr of
82 (# spe #) -> return (Just spe)
83
84 foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a)
85
86 -- | Miscelaneous information available for debugging purposes.
87 data StaticPtrInfo = StaticPtrInfo
88 { -- | Package key of the package where the static pointer is defined
89 spInfoPackageKey :: String
90 -- | Name of the module where the static pointer is defined
91 , spInfoModuleName :: String
92 -- | An internal name that is distinct for every static pointer defined in
93 -- a given module.
94 , spInfoName :: String
95 -- | Source location of the definition of the static pointer as a
96 -- @(Line, Column)@ pair.
97 , spInfoSrcLoc :: (Int, Int)
98 }
99 deriving (Show, Typeable)
100
101 -- | 'StaticPtrInfo' of the given 'StaticPtr'.
102 staticPtrInfo :: StaticPtr a -> StaticPtrInfo
103 staticPtrInfo (StaticPtr _ n _) = n
104
105 -- | A list of all known keys.
106 staticPtrKeys :: IO [StaticKey]
107 staticPtrKeys = do
108 keyCount <- hs_spt_key_count
109 allocaArray (fromIntegral keyCount) $ \p -> do
110 count <- hs_spt_keys p keyCount
111 peekArray (fromIntegral count) p >>=
112 mapM (\pa -> peekArray 2 pa >>= \[w1, w2] -> return $ Fingerprint w1 w2)
113 {-# NOINLINE staticPtrKeys #-}
114
115 foreign import ccall unsafe hs_spt_key_count :: IO CInt
116
117 foreign import ccall unsafe hs_spt_keys :: Ptr a -> CInt -> IO CInt