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/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- Giving an object a stable (GC-invariant) name.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module System.Mem.StableName
  16         ( StableName {-a-}   -- abstract, instance of Eq
  17         , makeStableName     -- :: a -> IO (StableName a)
  18         , hashStableName     -- :: StableName a -> Int
  19         ) where
  20
  21 import Prelude
  22
  23 import Data.Dynamic
  24
  25 #ifdef __GLASGOW_HASKELL__
  26 import GHC.IOBase       ( IO(..) )
  27 import GHC.Base         ( Int(..), StableName#, makeStableName#
  28                         , eqStableName#, stableNameToInt# )
  29
  30 -----------------------------------------------------------------------------
  31 -- Stable Names
  32
  33 data StableName a = StableName (StableName# a)
  34
  35 makeStableName  :: a -> IO (StableName a)
  36 #if defined(__PARALLEL_HASKELL__)
  37 makeStableName a =
  38   error "makeStableName not implemented in parallel Haskell"
  39 #else
  40 makeStableName a = IO $ \ s ->
  41     case makeStableName# a s of (# s', sn #) -> (# s', StableName sn #)
  42 #endif
  43
  44 hashStableName :: StableName a -> Int
  45 #if defined(__PARALLEL_HASKELL__)
  46 hashStableName (StableName sn) =
  47   error "hashStableName not implemented in parallel Haskell"
  48 #else
  49 hashStableName (StableName sn) = I# (stableNameToInt# sn)
  50 #endif
  51
  52 instance Eq (StableName a) where
  53 #if defined(__PARALLEL_HASKELL__)
  54     (StableName sn1) == (StableName sn2) =
  55       error "eqStableName not implemented in parallel Haskell"
  56 #else
  57     (StableName sn1) == (StableName sn2) =
  58        case eqStableName# sn1 sn2 of
  59          0# -> False
  60          _  -> True
  61 #endif
  62
  63 #endif /* __GLASGOW_HASKELL__ */
  64
  65 #include "Dynamic.h"
  66 INSTANCE_TYPEABLE1(StableName,stableNameTc,"StableName")