1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE StandaloneDeriving #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE UnboxedTuples #-}
5
6-----------------------------------------------------------------------------
7-- |
8-- Module      :  System.Mem.StableName
9-- Copyright   :  (c) The University of Glasgow 2001
10-- License     :  BSD-style (see the file libraries/base/LICENSE)
11--
12-- Maintainer  :  libraries@haskell.org
13-- Stability   :  experimental
14-- Portability :  non-portable
15--
16-- Stable names are a way of performing fast ( \(\mathcal{O}(1)\) ),
17-- not-quite-exact comparison between objects.
18--
19-- Stable names solve the following problem: suppose you want to build
20-- a hash table with Haskell objects as keys, but you want to use
21-- pointer equality for comparison; maybe because the keys are large
22-- and hashing would be slow, or perhaps because the keys are infinite
23-- in size.  We can\'t build a hash table using the address of the
24-- object as the key, because objects get moved around by the garbage
25-- collector, meaning a re-hash would be necessary after every garbage
26-- collection.
27--
28-------------------------------------------------------------------------------
29
30module GHC.StableName (
31  -- * Stable Names
32  StableName (..),
33  makeStableName,
34  hashStableName,
35  eqStableName
36  ) where
37
38import GHC.IO           ( IO(..) )
39import GHC.Base         ( Int(..), StableName#, makeStableName#
40                        , eqStableName#, stableNameToInt# )
41
42-----------------------------------------------------------------------------
43-- Stable Names
44
45{-|
46  An abstract name for an object, that supports equality and hashing.
47
48  Stable names have the following property:
49
50  * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@
51   then @sn1@ and @sn2@ were created by calls to @makeStableName@ on
52   the same object.
53
54  The reverse is not necessarily true: if two stable names are not
55  equal, then the objects they name may still be equal.  Note in particular
56  that `makeStableName` may return a different `StableName` after an
57  object is evaluated.
58
59  Stable Names are similar to Stable Pointers ("Foreign.StablePtr"),
60  but differ in the following ways:
61
62  * There is no @freeStableName@ operation, unlike "Foreign.StablePtr"s.
63    Stable names are reclaimed by the runtime system when they are no
64    longer needed.
65
66  * There is no @deRefStableName@ operation.  You can\'t get back from
67    a stable name to the original Haskell object.  The reason for
68    this is that the existence of a stable name for an object does not
69    guarantee the existence of the object itself; it can still be garbage
70    collected.
71-}
72
73data StableName a = StableName (StableName# a)
74
75-- | Makes a 'StableName' for an arbitrary object.  The object passed as
76-- the first argument is not evaluated by 'makeStableName'.
77makeStableName  :: a -> IO (StableName a)
78makeStableName a = IO $ \ s ->
79    case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)
80
81-- | Convert a 'StableName' to an 'Int'.  The 'Int' returned is not
82-- necessarily unique; several 'StableName's may map to the same 'Int'
83-- (in practice however, the chances of this are small, so the result
84-- of 'hashStableName' makes a good hash key).
85hashStableName :: StableName a -> Int
86hashStableName (StableName sn) = I# (stableNameToInt# sn)
87
88-- | @since 2.01
89instance Eq (StableName a) where
90    (StableName sn1) == (StableName sn2) =
91       case eqStableName# sn1 sn2 of
92         0# -> False
93         _  -> True
94
95-- | Equality on 'StableName' that does not require that the types of
96-- the arguments match.
97--
98-- @since 4.7.0.0
99eqStableName :: StableName a -> StableName b -> Bool
100eqStableName (StableName sn1) (StableName sn2) =
101       case eqStableName# sn1 sn2 of
102         0# -> False
103         _  -> True
104  -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to
105  -- use it for implementing observable sharing.
106
107