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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-----------------------------------------------------------------------------
-- |
-- Module : GHC.StaticPtr
-- Copyright : (C) 2014 I/O Tweag
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- Symbolic references to values.
--
-- References to values are usually implemented with memory addresses, and this
-- is practical when communicating values between the different pieces of a
-- single process.
--
-- When values are communicated across different processes running in possibly
-- different machines, though, addresses are no longer useful since each
-- process may use different addresses to store a given value.
--
-- To solve such concern, the references provided by this module indicate
-- package, module and name of a value. This information could be used to locate
-- the value in different processes.
--
-- Currently, the main use case for references is the StaticPointers language
-- extension.
--
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ExistentialQuantification #-}
module GHC.StaticPtr
( StaticPtr
, staticName
, StaticName(..)
, DynStaticPtr(..)
, SptEntry
, deRefStaticPtr
, encodeStaticPtr
, decodeStaticPtr
) where
import Data.Typeable (Typeable)
import Data.Char
import Foreign.C.String ( withCString, CString )
import Foreign.Marshal ( withArray )
import Foreign.Ptr ( castPtr )
import GHC.Exts ( addrToAny# )
import GHC.Ptr ( Ptr(..), nullPtr )
import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
import Numeric
import System.Info ( os )
import System.IO.Unsafe ( unsafePerformIO )
import Unsafe.Coerce ( unsafeCoerce )
-- | A reference to a top-level value of type 'a'.
data StaticPtr a = StaticPtr StaticName a
deriving (Read, Show, Typeable)
staticName :: StaticPtr a -> StaticName
staticName (StaticPtr n _) = n
-- | Identification of top-level values
--
-- > StaticName package_id module_name value_name
--
data StaticName = StaticName String String String
deriving (Read, Show, Typeable)
-- | Entries of the static pointer table.
data SptEntry = forall a . SptEntry StaticName a
-- | Dynamic static pointer.
data DynStaticPtr = forall a . DSP (StaticPtr a)
-- | Encodes static pointer in the form that can be later serialized.
encodeStaticPtr :: StaticPtr a -> Fingerprint
encodeStaticPtr = fingerprintStaticName . staticName
-- | Decodes an encoded pointer. It looks up a static pointer in
-- entry in the static pointer table.
decodeStaticPtr :: Fingerprint -> Maybe DynStaticPtr
decodeStaticPtr key = unsafePerformIO $
fmap (fmap (\(SptEntry s v) -> DSP $ StaticPtr s v)) (sptLookup key)
-- | Dereferences a static pointer.
deRefStaticPtr :: StaticPtr a -> a
deRefStaticPtr p@(StaticPtr s v) = v
fingerprintStaticName :: StaticName -> Fingerprint
fingerprintStaticName (StaticName pkg m valsym) =
fingerprintString $ concat [pkg, ":", m, ".", valsym]
sptLookup :: Fingerprint -> IO (Maybe SptEntry)
sptLookup (Fingerprint w1 w2) = do
ptr@(Ptr addr) <- withArray [w1,w2] (hs_spt_lookup . castPtr)
if (ptr == nullPtr)
then return Nothing
else case addrToAny# addr of
(# spe #) -> return (Just spe)
foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a)
|
