[project @ 2001-09-13 11:37:08 by simonmar]
[packages/random.git] / System / Mem / StableName.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Module : System.Mem.StableName
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- $Id: StableName.hs,v 1.2 2001/09/13 11:37:08 simonmar Exp $
12 --
13 -- Giving an object a stable (GC-invariant) name.
14 --
15 -----------------------------------------------------------------------------
16
17 module System.Mem.StableName
18 ( StableName {-a-} -- abstract, instance of Eq
19 , makeStableName -- :: a -> IO (StableName a)
20 , hashStableName -- :: StableName a -> Int
21 ) where
22
23 import Prelude
24
25 import Data.Dynamic
26
27 #ifdef __GLASGOW_HASKELL__
28 import GHC.Base ( Int(..) )
29 import GHC.IOBase ( IO(..) )
30 import GHC.Prim ( StableName#, makeStableName#
31 , eqStableName#, stableNameToInt# )
32
33 -----------------------------------------------------------------------------
34 -- Stable Names
35
36 data StableName a = StableName (StableName# a)
37
38 makeStableName :: a -> IO (StableName a)
39 #if defined(__PARALLEL_HASKELL__)
40 makeStableName a =
41 error "makeStableName not implemented in parallel Haskell"
42 #else
43 makeStableName a = IO $ \ s ->
44 case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)
45 #endif
46
47 hashStableName :: StableName a -> Int
48 #if defined(__PARALLEL_HASKELL__)
49 hashStableName (StableName sn) =
50 error "hashStableName not implemented in parallel Haskell"
51 #else
52 hashStableName (StableName sn) = I# (stableNameToInt# sn)
53 #endif
54
55 instance Eq (StableName a) where
56 #if defined(__PARALLEL_HASKELL__)
57 (StableName sn1) == (StableName sn2) =
58 error "eqStableName not implemented in parallel Haskell"
59 #else
60 (StableName sn1) == (StableName sn2) =
61 case eqStableName# sn1 sn2 of
62 0# -> False
63 _ -> True
64 #endif
65
66 #endif /* __GLASGOW_HASKELL__ */
67
68 #include "Dynamic.h"
69 INSTANCE_TYPEABLE1(StableName,stableNameTc,"StableName")