!# This source file is distributed with code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# except function `Jenkins_one_at_a_time_hash`.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_hash

  use mod_types

  implicit none
  private

  type :: struct_hash
     character(len=std_string) :: string = ""
     integer :: indx = -1
     type(struct_hash), pointer :: ptr => null()
  end type struct_hash

  public :: struct_hash, create_hash_table, hash_index, &
       delete_hash_table, print_hash_table

contains

!#======================================================================
  
  function Jenkins_one_at_a_time_hash(key)

!# B. Jenkins, "Hash functions", Dr. Dobb's Journal (September 1997).
    implicit none
    character(len=*), intent(in) :: key
    integer :: Jenkins_one_at_a_time_hash
!#......................................................................    
    integer(long_int) :: hash
    integer :: i
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    hash = 0
    
    do i = 1, len(key)
       hash = hash + iachar(key(i:i))
       hash = hash + ishft(hash, 10)
       hash = ieor(hash, ishft(hash, -6))
    enddo
    hash = hash + ishft(hash, 3)
    hash = ieor(hash, ishft(hash, -11))
    hash = hash + ishft(hash, 15)
    
    Jenkins_one_at_a_time_hash = hash
    
  end function Jenkins_one_at_a_time_hash

!#======================================================================

  subroutine create_hash_table(string, hash_table, dim_hash)

    implicit none
    character(len=*), dimension(:), intent(in) :: string
    type(struct_hash), dimension(:), pointer :: hash_table 
!# `hash_table` is a pointer to an array, not an array of pointers. 
!# `(/hash_table(1) % ptr, ...,  hash_table(i_hash) % ptr/)` is an array of pointers.
!# In Fortran 2003, the array `hash_table` might be `allocatable` and have the
!# the `target` attribute; `hash_node(i_hash) % ptr` could then point directly
!# to `hash_table(i_hash)` instead of `hash_table(i_hash) % ptr`, which would
!# therefore not need to be allocated.
    integer, intent(out) :: dim_hash
!#......................................................................
    real, parameter :: hash_load_factor = 0.1
    integer :: dim_string, i_string, i_hash
    type(struct_hash), dimension(:), allocatable :: hash_node
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    dim_string = size(string)
    if (hash_load_factor <= 0) then
       write(*, "(a)") "File ""mod_hash.f90"", subroutine `create_hash_table`: &
            &parameter `hash_load_factor` must be strictly positive. Stopped."
       stop
    endif
    dim_hash = ceiling(dim_string/hash_load_factor)

!# `hash_table` is an array of `dim_hash` linked lists.
!# `hash_table(i_hash) % ptr` is the head of the `i_hash`-th linked list
!# and `hash_node(i_hash) % ptr` the current tail.

    allocate(hash_table(dim_hash))
    allocate(hash_node(dim_hash))
    do i_string = 1, dim_string
       i_hash = modulo(Jenkins_one_at_a_time_hash(trim(string(i_string))), dim_hash) + 1
       if (.not.associated(hash_table(i_hash) % ptr)) then !# Allocate the head of linked list.
          allocate(hash_table(i_hash) % ptr)
          hash_node(i_hash) % ptr => hash_table(i_hash) % ptr
       else !# Add a new node to the linked list.
          allocate(hash_node(i_hash) % ptr % ptr)
          hash_node(i_hash) % ptr => hash_node(i_hash) % ptr % ptr
       endif
       hash_node(i_hash) % ptr % string = trim(string(i_string))
       hash_node(i_hash) % ptr % indx = i_string
    enddo
!???    deallocate(hash_node) !# This deallocates the *array* `hash_node`, \
!# not the targets pointed to by the *pointer* `hash_node(i_hash) % ptr`,
!# which may be accessed through `hash_table(i_hash)`.
    
  end subroutine create_hash_table

!#======================================================================

  function hash_index(string, hash_table, failed)

    implicit none
    character(len=*), intent(in) :: string
    type(struct_hash), dimension(:), intent(in) :: hash_table
    logical, intent(out) :: failed
    integer :: hash_index
!#......................................................................
    integer :: i_hash, dim_hash
    type(struct_hash), pointer :: hash_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
    
    failed = .false.
    dim_hash = size(hash_table)
    i_hash = modulo(Jenkins_one_at_a_time_hash(trim(string)), dim_hash) + 1
    hash_node => hash_table(i_hash) % ptr
    do
       if (.not.associated(hash_node)) then
          failed = .true.
          exit
       endif
       if (hash_node % string == string) exit
       hash_node => hash_node % ptr
    enddo
    if (.not.failed) then
       hash_index = hash_node % indx
    else
       hash_index = -huge(1)
    endif

  end function hash_index
  
!#======================================================================

  subroutine delete_hash_table(hash_table)

    type(struct_hash), dimension(:), pointer :: hash_table
!#......................................................................
    integer :: i_hash, dim_hash
    type(struct_hash), pointer :: hash_node => null(), next_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    dim_hash = size(hash_table)    
    do i_hash = 1, dim_hash !# Deallocate the *linked list* `hash_table(i_hash) % ptr`.
       hash_node => hash_table(i_hash) % ptr
       do 
          if (.not.associated(hash_node)) exit
          next_node => hash_node % ptr
          deallocate(hash_node)
          hash_node => next_node
       enddo
    enddo

    deallocate(hash_table) !# Deallocate the *array* `hash_table`.

  end subroutine delete_hash_table

!#======================================================================

  subroutine print_hash_table(hash_table) !# Just for checks.

    type(struct_hash), dimension(:), pointer :: hash_table
!#......................................................................
    integer :: i_hash, dim_hash
    type(struct_hash), pointer :: hash_node => null(), next_node => null()
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    dim_hash = size(hash_table)    
    do i_hash = 1, dim_hash
       hash_node => hash_table(i_hash) % ptr
       if (.not.associated(hash_node)) cycle
       write(*,"(i0,tr1,a)") i_hash, trim(hash_node % string)
       do 
          next_node => hash_node % ptr
          hash_node => next_node
          if (.not.associated(hash_node)) exit
          write(*,"(tr4,a)") trim(hash_node % string)
       enddo
    enddo

  end subroutine print_hash_table

end module mod_hash
