{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
#ifdef UNSAFETRICKS
{-# LANGUAGE MagicHash    #-}
#endif

module Data.HashTable.Internal.UnsafeTricks
  ( Key
  , toKey
  , fromKey
  , emptyRecord
  , deletedRecord
  , keyIsEmpty
  , keyIsDeleted
  , writeDeletedElement
  , makeEmptyVector
  ) where

import           Control.Monad.Primitive
import           Data.Vector.Mutable (MVector)
import qualified Data.Vector.Mutable as M
#ifdef UNSAFETRICKS
import           GHC.Exts
import           Unsafe.Coerce
#endif


------------------------------------------------------------------------------
#ifdef UNSAFETRICKS
type Key a = Any

#else
data Key a = Key !a
           | EmptyElement
           | DeletedElement
  deriving (Show)
#endif


------------------------------------------------------------------------------
-- Type signatures
emptyRecord :: Key a
deletedRecord :: Key a
keyIsEmpty :: Key a -> Bool
keyIsDeleted :: Key a -> Bool
makeEmptyVector :: PrimMonad m => Int -> m (MVector (PrimState m) (Key a))
writeDeletedElement :: PrimMonad m =>
                       MVector (PrimState m) (Key a) -> Int -> m ()
toKey :: a -> Key a
fromKey :: Key a -> a


#ifdef UNSAFETRICKS
data TombStone = EmptyElement
               | DeletedElement

{-# NOINLINE emptyRecord #-}
emptyRecord :: forall a. Key a
emptyRecord = forall a b. a -> b
unsafeCoerce TombStone
EmptyElement

{-# NOINLINE deletedRecord #-}
deletedRecord :: forall a. Key a
deletedRecord = forall a b. a -> b
unsafeCoerce TombStone
DeletedElement

{-# INLINE keyIsEmpty #-}
keyIsEmpty :: forall a. Key a -> Bool
keyIsEmpty Key a
a = Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
==# Int#
1#)
  where
    !x# :: Int#
x# = forall a. a -> a -> Int#
reallyUnsafePtrEquality# Key a
a forall a. Key a
emptyRecord

{-# INLINE keyIsDeleted #-}
keyIsDeleted :: forall a. Key a -> Bool
keyIsDeleted Key a
a = Int# -> Bool
isTrue# (Int#
x# Int# -> Int# -> Int#
==# Int#
1#)
  where
    !x# :: Int#
x# = forall a. a -> a -> Int#
reallyUnsafePtrEquality# Key a
a forall a. Key a
deletedRecord

{-# INLINE toKey #-}
toKey :: forall a. a -> Key a
toKey = forall a b. a -> b
unsafeCoerce

{-# INLINE fromKey #-}
fromKey :: forall a. Key a -> a
fromKey = forall a b. a -> b
unsafeCoerce

#else

emptyRecord = EmptyElement

deletedRecord = DeletedElement

keyIsEmpty EmptyElement = True
keyIsEmpty _            = False

keyIsDeleted DeletedElement = True
keyIsDeleted _              = False

toKey = Key

fromKey (Key x) = x
fromKey _ = error "impossible"

#endif


------------------------------------------------------------------------------
{-# INLINE makeEmptyVector #-}
makeEmptyVector :: forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) (Key a))
makeEmptyVector Int
m = forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
m forall a. Key a
emptyRecord

------------------------------------------------------------------------------
{-# INLINE writeDeletedElement #-}
writeDeletedElement :: forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) (Key a) -> Int -> m ()
writeDeletedElement MVector (PrimState m) (Key a)
v Int
i = forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite MVector (PrimState m) (Key a)
v Int
i forall a. Key a
deletedRecord