{-# OPTIONS_HADDOCK prune #-}

-- | Note that what is referred to as a \"nonce\" in this library may be
-- better known as a \"<https://en.wikipedia.org/wiki/Salt_(cryptography) salt>\".
module Data.PerfectHash.Lookup (
    LookupTable (LookupTable, nonces, values)
  , size
  , encodeDirectEntry
  , lookup
  ) where

import           Data.Vector      (Vector, (!))
import qualified Data.Vector      as Vector
import           Prelude                  hiding (lookup)

import Data.PerfectHash.Types.Nonces (Nonce (Nonce))
import qualified Data.PerfectHash.Hashing as Hashing
import qualified Data.PerfectHash.Types.Nonces as Nonces


-- | Inputs for the lookup function.
--
-- There are two arrays used in successive stages of the lookup.
-- In this implementation, both arrays are the same length.
data LookupTable a = LookupTable {
    LookupTable a -> Vector Int
nonces :: Vector Int
    -- ^ This is the intermediate lookup table.
    --
    -- In the lookup process, the key's hash is computed first with a nonce of
    -- zero to obtain an index into this array.
    --
    -- If the value at this index is negative, it is (after negating and
    -- subtracting one) a direct index into the 'values' array.
    -- Otherwise, the value shall be used as a nonce in a second application of
    -- the hashing function to compute the index into the 'values' array.
    --
    -- See the documentation of 'lookup' for details.
  , LookupTable a -> Vector a
values :: Vector a
    -- ^ An array of values of arbitrary type.
    --
    -- The objective of the perfect hash is to efficiently retrieve an index into
    -- this array, given the key associated with the value at that index.
  }


size :: LookupTable a -> Hashing.ArraySize
size :: LookupTable a -> ArraySize
size = Int -> ArraySize
Hashing.ArraySize (Int -> ArraySize)
-> (LookupTable a -> Int) -> LookupTable a -> ArraySize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Int
forall a. Vector a -> Int
Vector.length (Vector a -> Int)
-> (LookupTable a -> Vector a) -> LookupTable a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupTable a -> Vector a
forall a. LookupTable a -> Vector a
values


-- NOTE: We subtract one to ensure it's negative even if the
-- zeroeth slot was used. This lets us test for "direct encoding"
-- by checking of the value is negative.
encodeDirectEntry :: Hashing.SlotIndex -> Int
encodeDirectEntry :: SlotIndex -> Int
encodeDirectEntry (Hashing.SlotIndex Int
val) =
  Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
val


-- | NOTE: negation, followed by subtracting 1 is its own self-inverse.
--
-- Example:
-- > a = 7
-- > f(a) = -7 - 1
-- >      = -8
-- >
-- > a' = -8
-- > f(a') = -(-8) - 1
-- >      = 8 - 1
-- >      = 7
decodeDirectEntry :: Int -> Hashing.SlotIndex
decodeDirectEntry :: Int -> SlotIndex
decodeDirectEntry Int
val =
  Int -> SlotIndex
Hashing.SlotIndex (Int -> SlotIndex) -> Int -> SlotIndex
forall a b. (a -> b) -> a -> b
$ SlotIndex -> Int
encodeDirectEntry (SlotIndex -> Int) -> SlotIndex -> Int
forall a b. (a -> b) -> a -> b
$ Int -> SlotIndex
Hashing.SlotIndex Int
val


-- | For embedded applications, this function would usually be re-implemented
-- in C code.
--
-- == Procedure description
-- The lookup procedure is three steps:
--
--     1. Compute the 'Hashing.hash' (with a nonce of zero) of the "key", modulo
--        the length of the 'values' array.
--     2. Use the resulting value as an index into the 'nonces' array.  The value
--        found there represents either a direct index into the 'values' array
--        or a nonce for a second round of hashing.
--
--         * If negative, it is the former.  Negate it (to obtain a positive
--           value) and subtract one to obtain the actual index.
--         * Otherwise, re-compute the hash of the key, using this
--           value instead of zero as the nonce. Again, compute the modulus with
--           respect to the length of the 'values' array.
--
--     3. Use the result of (2) as the index into the 'values' array.
lookup
  :: (Hashing.ToHashableChunks a)
  => LookupTable b
  -> a -- ^ key
  -> b -- ^ value
lookup :: LookupTable b -> a -> b
lookup LookupTable b
lookup_table a
key =

  LookupTable b -> Vector b
forall a. LookupTable a -> Vector a
values LookupTable b
lookup_table Vector b -> Int -> b
forall a. Vector a -> Int -> a
! Int
v_key

  where
    table_size :: ArraySize
table_size = LookupTable b -> ArraySize
forall a. LookupTable a -> ArraySize
size LookupTable b
lookup_table

    Hashing.SlotIndex Int
nonce_index = Nonce -> ArraySize -> a -> SlotIndex
forall a.
ToHashableChunks a =>
Nonce -> ArraySize -> a -> SlotIndex
Hashing.hashToSlot (Int -> Nonce
Nonce Int
0) ArraySize
table_size a
key
    nonce :: Int
nonce = LookupTable b -> Vector Int
forall a. LookupTable a -> Vector Int
nonces LookupTable b
lookup_table Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
nonce_index

    -- Negative nonce value indicates that we don't need extra lookup layer
    Hashing.SlotIndex Int
v_key = if Int -> Bool
Nonces.isDirectSlot Int
nonce
      then Int -> SlotIndex
decodeDirectEntry Int
nonce
      else Nonce -> ArraySize -> a -> SlotIndex
forall a.
ToHashableChunks a =>
Nonce -> ArraySize -> a -> SlotIndex
Hashing.hashToSlot (Int -> Nonce
Nonces.Nonce Int
nonce) ArraySize
table_size a
key