1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP          #-}
3#ifdef UNSAFETRICKS
4{-# LANGUAGE MagicHash    #-}
5#endif
6
7module Data.HashTable.Internal.UnsafeTricks
8  ( Key
9  , toKey
10  , fromKey
11  , emptyRecord
12  , deletedRecord
13  , keyIsEmpty
14  , keyIsDeleted
15  , writeDeletedElement
16  , makeEmptyVector
17  ) where
18
19import           Control.Monad.Primitive
20import           Data.Vector.Mutable (MVector)
21import qualified Data.Vector.Mutable as M
22#ifdef UNSAFETRICKS
23import           GHC.Exts
24import           Unsafe.Coerce
25
26#if __GLASGOW_HASKELL__ >= 808
27-- Nothing to do here.
28#elif __GLASGOW_HASKELL__ >= 707
29import           GHC.Exts                         (isTrue#)
30#else
31isTrue# :: Bool -> Bool
32isTrue# = id
33#endif
34
35#endif
36
37
38------------------------------------------------------------------------------
39#ifdef UNSAFETRICKS
40type Key a = Any
41
42#else
43data Key a = Key !a
44           | EmptyElement
45           | DeletedElement
46  deriving (Show)
47#endif
48
49
50------------------------------------------------------------------------------
51-- Type signatures
52emptyRecord :: Key a
53deletedRecord :: Key a
54keyIsEmpty :: Key a -> Bool
55keyIsDeleted :: Key a -> Bool
56makeEmptyVector :: PrimMonad m => Int -> m (MVector (PrimState m) (Key a))
57writeDeletedElement :: PrimMonad m =>
58                       MVector (PrimState m) (Key a) -> Int -> m ()
59toKey :: a -> Key a
60fromKey :: Key a -> a
61
62
63#ifdef UNSAFETRICKS
64data TombStone = EmptyElement
65               | DeletedElement
66
67{-# NOINLINE emptyRecord #-}
68emptyRecord = unsafeCoerce EmptyElement
69
70{-# NOINLINE deletedRecord #-}
71deletedRecord = unsafeCoerce DeletedElement
72
73{-# INLINE keyIsEmpty #-}
74keyIsEmpty a = isTrue# (x# ==# 1#)
75  where
76    !x# = reallyUnsafePtrEquality# a emptyRecord
77
78{-# INLINE keyIsDeleted #-}
79keyIsDeleted a = isTrue# (x# ==# 1#)
80  where
81    !x# = reallyUnsafePtrEquality# a deletedRecord
82
83{-# INLINE toKey #-}
84toKey = unsafeCoerce
85
86{-# INLINE fromKey #-}
87fromKey = unsafeCoerce
88
89#else
90
91emptyRecord = EmptyElement
92
93deletedRecord = DeletedElement
94
95keyIsEmpty EmptyElement = True
96keyIsEmpty _            = False
97
98keyIsDeleted DeletedElement = True
99keyIsDeleted _              = False
100
101toKey = Key
102
103fromKey (Key x) = x
104fromKey _ = error "impossible"
105
106#endif
107
108
109------------------------------------------------------------------------------
110{-# INLINE makeEmptyVector #-}
111makeEmptyVector m = M.replicate m emptyRecord
112
113------------------------------------------------------------------------------
114{-# INLINE writeDeletedElement #-}
115writeDeletedElement v i = M.unsafeWrite v i deletedRecord
116