pic_hash_32bit_fnv.f90 Source File

! SPDX-License-Identifier: MIT
! Integrated from the Fortran Standard Library licensed under MIT
! Copyright (c) 2025 Jorge Luis Galvez Vallejo

!!------------------------------------------------------------------------------
!! `FNV_1_HASH` and  `FNV_1A_Hash` are translations to Fortran 2008 of the
!! `FNV-1` and `FNV-1a` hash functions of Glenn Fowler, Landon Curt Noll,
!! and Phong Vo, that has been released into the public domain. Permission
!! has been granted, by Landon Curt Noll, for the use of these algorithms
!! in the Fortran Standard Library. A description of these functions is
!! available at https://en.wikipedia.org/wiki/Fowler–Noll–Vo_hash_function.
!!------------------------------------------------------------------------------

!#! Integer kinds to be considered during templating

module pic_hash_32bit_fnv
!! An implementation of the FNV hashes 1 and 1a of Glenn Fowler, Landon Curt
!! Noll, and Kiem-Phong-Vo,
!! https://en.wikipedia.org/wiki/Fowler–Noll–Vo_hash_function
   use, intrinsic :: iso_fortran_env, only: &
      character_storage_size
   use pic_types, only: int8, int16, int32, int64, dp
   implicit none
   private
   public :: fnv_1_hash, fnv_1a_hash
   integer, parameter, public :: &
      int_hash = int32
   integer(int_hash), parameter :: &
      offset_basis = int(z'811C9DC5', int_hash)

! Constants for the FNV multiply. The prime and the reduction constants are
! int64 rather than int_hash so that hash*prime can be formed without signed
! integer overflow; see fnv_mul_prime for the construction and why it is
! bit-identical to a wrapping 32-bit multiply.
   integer(int64), parameter :: &
      ! 0x01000193, the 32-bit FNV prime
      prime = 16777619_int64, &
      ! 2**32 - 1, i.e. 0xFFFFFFFF
      mask_32 = 4294967295_int64, &
      ! 2**32
      two_pow_32 = 4294967296_int64, &
      ! huge(0_int32), i.e. 0x7FFFFFFF
      int32_max = 2147483647_int64

!! The number of bits in the output hash

! The number of bits used by each integer type
   integer, parameter :: &
      ! Should be 8
      bits_int8 = bit_size(0_int8), &
      ! Should be 16
      bits_int16 = bit_size(0_int16), &
      ! Should be 32
      bits_int32 = bit_size(0_int32), &
      ! Should be 64
      bits_int64 = bit_size(0_int64)

   integer, parameter :: &
      ! Should be 1
      bytes_int8 = bits_int8/bits_int8, &
      ! Should be 2
      bytes_int16 = bits_int16/bits_int8, &
      ! Should be 4
      bytes_int32 = bits_int32/bits_int8, &
      ! Should be 8
      bytes_int64 = bits_int64/bits_int8

   integer, parameter :: &
      bits_char = character_storage_size, &
      bytes_char = bits_char/bits_int8

! Dealing with different endians
   logical, parameter, public :: &
      little_endian = (1 == transfer([1_int8, 0_int8], 0_int16))

   interface fnv_1_hash
!! Version: experimental
!!
!! FNV_1 interfaces
      pure module function int8_fnv_1(key) result(hash_code)
!! FNV_1 hash function for rank 1 array keys of kind int8
         implicit none
         integer(int8), intent(in) :: key(:)
         integer(int_hash)           :: hash_code
      end function int8_fnv_1

      pure module function int16_fnv_1(key) result(hash_code)
!! FNV_1 hash function for rank 1 array keys of kind int16
         implicit none
         integer(int16), intent(in) :: key(:)
         integer(int_hash)           :: hash_code
      end function int16_fnv_1

      pure module function int32_fnv_1(key) result(hash_code)
!! FNV_1 hash function for rank 1 array keys of kind int32
         implicit none
         integer(int32), intent(in) :: key(:)
         integer(int_hash)           :: hash_code
      end function int32_fnv_1

      pure module function int64_fnv_1(key) result(hash_code)
!! FNV_1 hash function for rank 1 array keys of kind int64
         implicit none
         integer(int64), intent(in) :: key(:)
         integer(int_hash)           :: hash_code
      end function int64_fnv_1

      elemental module function character_fnv_1(key) result(hash_code)
!! FNV_1 hash function for default character string keys
         implicit none
         character(*), intent(in)      :: key
         integer(int_hash)             :: hash_code
      end function character_fnv_1

   end interface fnv_1_hash

   interface fnv_1a_hash
!! Version: experimental
!!
!! FNV_1A interfaces
      pure module function int8_fnv_1a(key) result(hash_value)
!! FNV_1A hash function for rank 1 array keys of kind int8
         implicit none
         integer(int8), intent(in)   :: key(:)
         integer(int_hash)             :: hash_value
      end function int8_fnv_1a

      pure module function int16_fnv_1a(key) result(hash_value)
!! FNV_1A hash function for rank 1 array keys of kind int16
         implicit none
         integer(int16), intent(in)   :: key(:)
         integer(int_hash)             :: hash_value
      end function int16_fnv_1a

      pure module function int32_fnv_1a(key) result(hash_value)
!! FNV_1A hash function for rank 1 array keys of kind int32
         implicit none
         integer(int32), intent(in)   :: key(:)
         integer(int_hash)             :: hash_value
      end function int32_fnv_1a

      pure module function int64_fnv_1a(key) result(hash_value)
!! FNV_1A hash function for rank 1 array keys of kind int64
         implicit none
         integer(int64), intent(in)   :: key(:)
         integer(int_hash)             :: hash_value
      end function int64_fnv_1a

      elemental module function character_fnv_1a(key) result(hash_value)
!! FNV_1A hash function for default character string keys
         implicit none
         character(*), intent(in)      :: key
         integer(int_hash)             :: hash_value
      end function character_fnv_1a

   end interface fnv_1a_hash

contains

   pure function fnv_mul_prime(hash_code) result(new_hash)
!! Multiply a 32-bit FNV state by the FNV prime, modulo 2**32.
!!
!! Writing `hash_code*prime` directly in `integer(int32)` overflows for very
!! nearly every state -- for a five-byte key, every single round overflows.
!! Signed integer overflow is not defined by the Fortran standard and is
!! trappable: `-ftrapv`, `-fsanitize=signed-integer-overflow` and Intel's
!! `-check` all abort on it. It only appears to work because most compilers
!! choose to wrap. This function gets the same answer by construction.
!!
!! 1. The product is formed in `int64`, where it cannot overflow: the state is
!!    at most 2**31 in magnitude and the prime is below 2**24, so the exact
!!    product stays below 2**55.
!! 2. `iand` with `mask_32` reduces it modulo 2**32. `iand` is defined on the
!!    integer bit model, so a negative `hash_code` widened to `int64` keeps
!!    its two's-complement bit pattern and the mask yields its correct
!!    residue as a value in [0, 2**32 - 1].
!! 3. That residue cannot simply be assigned to `int32`: anything above
!!    `huge(int32)` is not representable and the conversion would itself be
!!    undefined. Subtracting 2**32 first -- still in `int64`, where the result
!!    is exact and in range -- maps [2**31, 2**32 - 1] onto [-2**31, -1],
!!    which is exactly the bit pattern a wrapping 32-bit multiply leaves
!!    behind. Only then is the value narrowed, from a range `int32` can hold.
!!
!! The result is therefore bit-identical to the old wrapping code on every
!! two's-complement machine, while being defined on every compiler.
      integer(int_hash), intent(in) :: hash_code
      integer(int_hash)             :: new_hash

      integer(int64) :: acc

      acc = iand(int(hash_code, int64)*prime, mask_32)
      if (acc > int32_max) acc = acc - two_pow_32
      new_hash = int(acc, int_hash)

   end function fnv_mul_prime

   pure module function int8_fnv_1(key) result(hash_code)
!! The original FNV-1 8-bit key algorithm.
      integer(int8), intent(in)     :: key(:)
      integer(int_hash)             :: hash_code

      integer(int64) :: i

      hash_code = offset_basis
      do i = 1_int64, size(key, kind=int64)
         hash_code = fnv_mul_prime(hash_code)
         if (little_endian) then
            hash_code = ieor(hash_code, &
                             transfer([key(i), 0_int8, 0_int8, 0_int8], &
                                      0_int_hash))
         else
            hash_code = ieor(hash_code, &
                             transfer([0_int8, 0_int8, 0_int8, key(i)], &
                                      0_int_hash))
         end if
      end do

   end function int8_fnv_1

   pure module function int16_fnv_1(key) result(hash_code)
! A int16 array key wrapper for the FNV-1 algorithm.
      integer(int16), intent(in) :: key(:)
      integer(int_hash)           :: hash_code

      hash_code = int8_fnv_1(transfer(key, 0_int8, &
                                      bytes_int16* &
                                      size(key, kind=int64)))

   end function int16_fnv_1

   pure module function int32_fnv_1(key) result(hash_code)
! A int32 array key wrapper for the FNV-1 algorithm.
      integer(int32), intent(in) :: key(:)
      integer(int_hash)           :: hash_code

      hash_code = int8_fnv_1(transfer(key, 0_int8, &
                                      bytes_int32* &
                                      size(key, kind=int64)))

   end function int32_fnv_1

   pure module function int64_fnv_1(key) result(hash_code)
! A int64 array key wrapper for the FNV-1 algorithm.
      integer(int64), intent(in) :: key(:)
      integer(int_hash)           :: hash_code

      hash_code = int8_fnv_1(transfer(key, 0_int8, &
                                      bytes_int64* &
                                      size(key, kind=int64)))

   end function int64_fnv_1

   elemental module function character_fnv_1(key) result(hash_code)
! A default character key wrapper for the FNV-1 algorithm.
      character(*), intent(in)      :: key
      integer(int_hash)             :: hash_code

      hash_code = int8_fnv_1(transfer(key, &
                                      0_int8, &
                                      bytes_char* &
                                      len(key, kind=int64)))

   end function character_fnv_1

   pure module function int8_fnv_1a(key) result(hash_code)
!! The original FNV-1a 8-bit key algorithm.
      integer(int8), intent(in)     :: key(:)
      integer(int_hash)             :: hash_code

      integer(int64) :: i

      hash_code = offset_basis
      do i = 1_int64, size(key, kind=int64)
         if (little_endian) then
            hash_code = ieor(hash_code, &
                             transfer([key(i), 0_int8, 0_int8, 0_int8], &
                                      0_int_hash))
         else
            hash_code = ieor(hash_code, &
                             transfer([0_int8, 0_int8, 0_int8, key(i)], &
                                      0_int_hash))
         end if
         hash_code = fnv_mul_prime(hash_code)
      end do

   end function int8_fnv_1a

   pure module function int16_fnv_1a(key) result(hash_code)
! A int16 array key wrapper for the FNV-1a algorithm.
      integer(int16), intent(in)   :: key(:)
      integer(int_hash)             :: hash_code

      hash_code = int8_fnv_1a(transfer(key, 0_int8, &
                                       bytes_int16* &
                                       size(key, kind=int64)))

   end function int16_fnv_1a

   pure module function int32_fnv_1a(key) result(hash_code)
! A int32 array key wrapper for the FNV-1a algorithm.
      integer(int32), intent(in)   :: key(:)
      integer(int_hash)             :: hash_code

      hash_code = int8_fnv_1a(transfer(key, 0_int8, &
                                       bytes_int32* &
                                       size(key, kind=int64)))

   end function int32_fnv_1a

   pure module function int64_fnv_1a(key) result(hash_code)
! A int64 array key wrapper for the FNV-1a algorithm.
      integer(int64), intent(in)   :: key(:)
      integer(int_hash)             :: hash_code

      hash_code = int8_fnv_1a(transfer(key, 0_int8, &
                                       bytes_int64* &
                                       size(key, kind=int64)))

   end function int64_fnv_1a

   elemental module function character_fnv_1a(key) result(hash_code)
! A default character key wrapper for the FNV-1 algorithm.
      character(*), intent(in)      :: key
      integer(int_hash)             :: hash_code

      hash_code = int8_fnv_1a(transfer(key, 0_int8, &
                                       (bits_char/bits_int8)* &
                                       len(key, kind=int64)))

   end function character_fnv_1a

end module pic_hash_32bit_fnv