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