d6ac879f015ec2c0e7a15c2e9975c08c5c616874
[packages/containers.git] / Utils / Containers / Internal / PtrEquality.hs
1 {-# LANGUAGE CPP #-}
2 #ifdef __GLASGOW_HASKELL__
3 {-# LANGUAGE MagicHash #-}
4 #endif
5
6 {-# OPTIONS_HADDOCK hide #-}
7
8 -- | Really unsafe pointer equality
9 module Utils.Containers.Internal.PtrEquality (ptrEq, hetPtrEq) where
10
11 #ifdef __GLASGOW_HASKELL__
12 import GHC.Exts ( reallyUnsafePtrEquality# )
13 import Unsafe.Coerce ( unsafeCoerce )
14 #if __GLASGOW_HASKELL__ < 707
15 import GHC.Exts ( (==#) )
16 #else
17 import GHC.Exts ( isTrue# )
18 #endif
19 #endif
20
21 -- | Checks if two pointers are equal. Yes means yes;
22 -- no means maybe. The values should be forced to at least
23 -- WHNF before comparison to get moderately reliable results.
24 ptrEq :: a -> a -> Bool
25
26 -- | Checks if two pointers are equal, without requiring
27 -- them to have the same type. The values should be forced
28 -- to at least WHNF before comparison to get moderately
29 -- reliable results.
30 hetPtrEq :: a -> b -> Bool
31
32 #ifdef __GLASGOW_HASKELL__
33 #if __GLASGOW_HASKELL__ < 707
34 ptrEq x y = reallyUnsafePtrEquality# x y ==# 1#
35 hetPtrEq x y = unsafeCoerce reallyUnsafePtrEquality# x y ==# 1#
36 #else
37 ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y)
38 hetPtrEq x y = isTrue# (unsafeCoerce reallyUnsafePtrEquality# x y)
39 #endif
40
41 #else
42 -- Not GHC
43 ptrEq _ _ = False
44 hetPtrEq _ _ = False
45 #endif
46
47 {-# INLINE ptrEq #-}
48 {-# INLINE hetPtrEq #-}
49
50 infix 4 `ptrEq`
51 infix 4 `hetPtrEq`