{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Prim.StableName
( StableName(..)
, makeStableName
, makeAnyStableName
, hashStableName
, eqStableName
) where
import Control.Prim.Monad
import GHC.Exts
#if MIN_VERSION_base(4,12,0)
import GHC.StableName (StableName(..), eqStableName, hashStableName)
instance Show (StableName a) where
showsPrec :: Int -> StableName a -> ShowS
showsPrec = Int -> StableName a -> ShowS
forall a. Int -> StableName a -> ShowS
showPrecStableName
#else
data StableName a = StableName (StableName# a)
instance Eq (StableName a) where
(==) = eqStableName
instance Show (StableName a) where
showsPrec = showPrecStableName
hashStableName :: StableName a -> Int
hashStableName (StableName sn) = I# (stableNameToInt# sn)
eqStableName :: StableName a -> StableName b -> Bool
eqStableName (StableName sn1) (StableName sn2) =
case eqStableName# sn1 sn2 of
0# -> False
_ -> True
#endif
showPrecStableName :: Int -> StableName a -> ShowS
showPrecStableName :: Int -> StableName a -> ShowS
showPrecStableName Int
n StableName a
sname =
case Int
n of
Int
0 -> ShowS
inner
Int
_ -> (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)
where
inner :: ShowS
inner = (String
"StableName " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (StableName a -> Int
forall a. StableName a -> Int
hashStableName StableName a
sname)
makeStableName :: MonadPrim RW m => a -> m (StableName a)
makeStableName :: a -> m (StableName a)
makeStableName a
a =
(State# RealWorld -> (# State# RealWorld, StableName a #))
-> m (StableName a)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, StableName a #))
-> m (StableName a))
-> (State# RealWorld -> (# State# RealWorld, StableName a #))
-> m (StableName a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
makeStableName# a
a State# RealWorld
s of
(# State# RealWorld
s', StableName# a
sn #) -> (# State# RealWorld
s', StableName# a -> StableName a
forall a. StableName# a -> StableName a
StableName StableName# a
sn #)
makeAnyStableName :: MonadPrim RW m => a -> m (StableName Any)
makeAnyStableName :: a -> m (StableName Any)
makeAnyStableName a
a =
(State# RealWorld -> (# State# RealWorld, StableName Any #))
-> m (StableName Any)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, StableName Any #))
-> m (StableName Any))
-> (State# RealWorld -> (# State# RealWorld, StableName Any #))
-> m (StableName Any)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
case a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
forall a.
a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
makeStableName# a
a State# RealWorld
s of
(# State# RealWorld
s', StableName# a
sn# #) -> (# State# RealWorld
s', StableName# Any -> StableName Any
forall a. StableName# a -> StableName a
StableName (StableName# a -> StableName# Any
unsafeCoerce# StableName# a
sn#) #)