!--------------------------------------------------------------------------------------------------!
! Copyright (C) by the DBCSR developers group - All rights reserved                                !
! This file is part of the DBCSR library.                                                          !
!                                                                                                  !
! For information on the license, see the LICENSE file.                                            !
! For further information please visit https://dbcsr.cp2k.org                                      !
! SPDX-License-Identifier: GPL-2.0+                                                                !
!--------------------------------------------------------------------------------------------------!

#:include 'dbcsr_dict.fypp'
MODULE dbcsr_dict
   !! A dictionary (also known as hashtable or hashmap).
   !! Internally the dictionary uses an array to holds its data.
   !! If this array reaches a load-factor of 75%, a new array with twice the
   !! size will be allocated and the items are then copied over.
   !! This ensures that the dictionary will perform operations in O(1).

   USE dbcsr_kinds, ONLY: ${uselist(usekinds)}$
   USE dbcsr_timings_base_type, ONLY: ${uselist(usetimings)}$
#include "base/dbcsr_base_uses.f90"
   IMPLICIT NONE

   PRIVATE
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_dict'

   PUBLIC :: dict_init, dict_items, dict_haskey, &
             dict_set, dict_get, dict_size, dict_destroy

   #:for keytype, valuetype in keyvalue_list
      PUBLIC :: dict_${keytype}$_${valuetype}$_type
      PUBLIC :: dict_${keytype}$_${valuetype}$_item_type
   #:endfor

   #:for keytype, valuetype, keytype_fort, valuetype_fort, key_assign, value_assign, isequal in inst_params
      !this is an internal type
      !Calculating hashes might be expensive, therefore they are stored
      !for use during change_capacity().
      TYPE private_item_type_${keytype}$_${valuetype}$
         PRIVATE
         ${keytype_fort}$                            :: key
         ${valuetype_fort}$                          :: value
         INTEGER(KIND=int_8)                         :: hash
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER          :: next => Null()
      END TYPE private_item_type_${keytype}$_${valuetype}$

      !this is an internal type
      TYPE private_item_p_type_${keytype}$_${valuetype}$
         PRIVATE
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER :: p => Null()
      END TYPE private_item_p_type_${keytype}$_${valuetype}$

      ! this is the public type, which holds a dictionary-instance
      TYPE dict_${keytype}$_${valuetype}$_type
         PRIVATE
         TYPE(private_item_p_type_${keytype}$_${valuetype}$), DIMENSION(:), POINTER      :: buckets => Null()
         INTEGER                                               :: size = -1
      END TYPE dict_${keytype}$_${valuetype}$_type

      ! this is a public type, its returned by dict_items()
      TYPE dict_${keytype}$_${valuetype}$_item_type
         ${keytype_fort}$        :: key
         ${valuetype_fort}$      :: value
      END TYPE dict_${keytype}$_${valuetype}$_item_type
   #:endfor

   INTERFACE dict_init
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_init
      #:endfor
   END INTERFACE

   INTERFACE dict_haskey
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_haskey
      #:endfor
   END INTERFACE

   INTERFACE dict_set
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_set
      #:endfor
   END INTERFACE

   INTERFACE dict_get
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_get
      #:endfor
   END INTERFACE

   INTERFACE dict_items
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_items
      #:endfor
   END INTERFACE

   INTERFACE dict_size
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_size
      #:endfor
   END INTERFACE

   INTERFACE dict_destroy
      #:for keytype, valuetype in keyvalue_list
         MODULE PROCEDURE dict_${keytype}$_${valuetype}$_destroy
      #:endfor
   END INTERFACE

CONTAINS

   #:for fct in hash_fct
      $:fct
   #:endfor

   #:for keytype, valuetype, keytype_fort, valuetype_fort, key_assign, value_assign, isequal in inst_params
      SUBROUTINE dict_${keytype}$_${valuetype}$_init(dict, initial_capacity)
      !! Allocates the internal data-structures of the given dictionary.

         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         INTEGER, INTENT(in), OPTIONAL                         :: initial_capacity
         !! The initial size of the internal array (default=11).

         INTEGER :: initial_capacity_
         initial_capacity_ = 11
         IF (PRESENT(initial_capacity)) initial_capacity_ = initial_capacity

         IF (initial_capacity_ < 1) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_init: initial_capacity < 1")

         IF (ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_init: dictionary is already initialized.")

         ALLOCATE (dict%buckets(initial_capacity_))
         dict%size = 0

      END SUBROUTINE dict_${keytype}$_${valuetype}$_init

      SUBROUTINE dict_${keytype}$_${valuetype}$_destroy(dict)
      !! Deallocated the internal data-structures if the given dictionary.
      !! Caution: If the stored keys or values are pointers, their targets will
      !! not get deallocated by this routine.

         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER  :: item, prev_item
         INTEGER :: i

         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_destroy: dictionary is not initialized.")

         do i = 1, size(dict%buckets)
            item => dict%buckets(i)%p
            do while (ASSOCIATED(item))
               prev_item => item
               item => item%next
               deallocate (prev_item)
            end do
         end do

         deallocate (dict%buckets)
         dict%size = -1

      END SUBROUTINE dict_${keytype}$_${valuetype}$_destroy

      SUBROUTINE dict_${keytype}$_${valuetype}$_set(dict, key, value)
      !! Stores, and possibly overwrites, a given value under a given key.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         ${keytype_fort}$, intent(in)                          :: key
         ${valuetype_fort}$, intent(in)                          :: value
         INTEGER(KIND=int_8)                                   :: hash
         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_set: dictionary is not initialized.")

         hash = hash_${keytype}$ (key)
         call set_hashed_${keytype}$_${valuetype}$ (dict, key, value, hash)
      END SUBROUTINE dict_${keytype}$_${valuetype}$_set

      RECURSIVE SUBROUTINE set_hashed_${keytype}$_${valuetype}$ (dict, key, value, hash)
      !! Common code used internally by dict_set() and change_capacity().
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         ${keytype_fort}$, intent(in)                          :: key
         ${valuetype_fort}$, intent(in)                          :: value
         INTEGER(KIND=int_8), intent(in)                       :: hash
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER  :: item, new_item
         INTEGER(KIND=int_8)                                   :: idx

         idx = MOD(hash, INT(size(dict%buckets), KIND=int_8)) + 1

         ! if already in dict just update its value
         item => dict%buckets(idx)%p
         do while (ASSOCIATED(item))
            IF (item%hash == hash) THEN
               IF (@{isequal(item%key, key)}@) THEN
                  item%value ${value_assign}$value
                  return
               END IF
            END IF
            item => item%next
         end do

         ! check load-factor
         IF (4*dict%size > 3*size(dict%buckets)) THEN ! load-factor > 75%
            call change_capacity_${keytype}$_${valuetype}$ (dict, 2*size(dict%buckets)) !double capacity
            idx = MOD(hash, INT(size(dict%buckets), KIND=int_8)) + 1
         END IF

         ! create a new item
         allocate (new_item)
         new_item%hash = hash
         new_item%key ${key_assign}$key
         new_item%value ${value_assign}$value
         new_item%next => dict%buckets(idx)%p
         dict%buckets(idx)%p => new_item
         dict%size = dict%size + 1

      END SUBROUTINE set_hashed_${keytype}$_${valuetype}$

      RECURSIVE SUBROUTINE change_capacity_${keytype}$_${valuetype}$ (dict, new_capacity)
      !! Internal routine for changing the dictionary's capacity.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         INTEGER, intent(in) :: new_capacity
         INTEGER :: i, old_size, new_cap
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER  :: item, prev_item
         TYPE(private_item_p_type_${keytype}$_${valuetype}$), DIMENSION(:), POINTER  :: old_buckets
         new_cap = new_capacity
         ! pre checks
         IF (new_cap > HUGE(i)) THEN
            IF (size(dict%buckets) == HUGE(i)) RETURN ! reached maximum - stay there.
            new_cap = HUGE(i) ! grow as far as possible
         END IF
         IF (new_cap < 1) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_change_capacity: new_capacity < 1.")
         IF (4*dict%size > 3*new_cap) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_change_capacity: new_capacity too small.")

         old_size = dict%size
         old_buckets => dict%buckets
         ALLOCATE (dict%buckets(new_capacity))
         dict%size = 0
         do i = 1, size(old_buckets)
            item => old_buckets(i)%p
            do while (ASSOCIATED(item))
               call set_hashed_${keytype}$_${valuetype}$ (dict, item%key, item%value, item%hash)
               prev_item => item
               item => item%next
               deallocate (prev_item)
            end do
         end do

         deallocate (old_buckets)

         IF (old_size /= dict%size) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_change_capacity: assertion failed")
      END SUBROUTINE change_capacity_${keytype}$_${valuetype}$

      FUNCTION dict_${keytype}$_${valuetype}$_get(dict, key, default_value) RESULT(value)
      !! Gets a value for a given key from the dictionary.
      !! If the key is not found the default_value will be returned.
      !! If the key is not found and default_value was not provided the program stops.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         ${keytype_fort}$                                        :: key
         ${valuetype_fort}$, intent(in), optional                :: default_value
         ${valuetype_fort}$                                      :: value
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER                      :: item
         INTEGER(KIND=int_8)                                   :: hash, idx

         #:if valuetype_fort == 'INTEGER(kind=int_4)'
            value = 0
         #:elif valuetype_fort == 'TYPE(call_stat_type), POINTER'
            NULLIFY (value)
         #:endif

         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_get: dictionary is not initialized.")

         hash = hash_${keytype}$ (key)
         idx = MOD(hash, INT(size(dict%buckets), KIND=int_8)) + 1

         item => dict%buckets(idx)%p
         do while (ASSOCIATED(item))
            IF (item%hash == hash) THEN
               IF (@{isequal(item%key, key)}@) THEN
                  value ${value_assign}$item%value
                  return
               END IF
            END IF
            item => item%next
         end do

         IF (PRESENT(default_value)) THEN
            value ${value_assign}$default_value
            return
         END IF

         DBCSR_ABORT("dict_${keytype}$_${valuetype}$_get: Key not found in dictionary.")
      END FUNCTION dict_${keytype}$_${valuetype}$_get

      FUNCTION dict_${keytype}$_${valuetype}$_size(dict) RESULT(size)
      !! Returns the number of key/value-items currently stored in the dictionary.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         INTEGER :: size

         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_size: dictionary is not initialized.")

         size = dict%size
      END FUNCTION dict_${keytype}$_${valuetype}$_size

      FUNCTION dict_${keytype}$_${valuetype}$_haskey(dict, key) RESULT(res)
      !! Checks whether a given key is currently stored in the dictionary.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         ${keytype_fort}$                                        :: key
         LOGICAL                                               :: res
         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER                      :: item
         INTEGER(KIND=int_8)                                   :: hash, idx

         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_haskey: dictionary is not initialized.")

         res = .FALSE.
         IF (dict%size == 0) RETURN

         hash = hash_${keytype}$ (key)
         idx = MOD(hash, INT(size(dict%buckets), KIND=int_8)) + 1

         item => dict%buckets(idx)%p
         do while (ASSOCIATED(item))
            IF (item%hash == hash) THEN
               IF (@{isequal(item%key, key)}@) THEN
                  res = .TRUE.
                  return
               END IF
            END IF
            item => item%next
         end do

      END FUNCTION dict_${keytype}$_${valuetype}$_haskey

      FUNCTION dict_${keytype}$_${valuetype}$_items(dict) RESULT(items)
      !! Returns a pointer to an array of all key/value-items stored in the dictionary.
      !! Caution: The caller is responsible for deallocating targeted array after usage.
         TYPE(dict_${keytype}$_${valuetype}$_type), intent(inout)  :: dict
         TYPE(dict_${keytype}$_${valuetype}$_item_type), dimension(:), POINTER :: items

         TYPE(private_item_type_${keytype}$_${valuetype}$), POINTER  :: item
         INTEGER :: i, j

         IF (.not. ASSOCIATED(dict%buckets)) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_items: dictionary is not initialized.")

         allocate (items(dict%size))
         j = 1
         do i = 1, size(dict%buckets)
            item => dict%buckets(i)%p
            do while (ASSOCIATED(item))
               items(j)%key ${key_assign}$item%key
               items(j)%value ${value_assign}$item%value
               j = j + 1
               item => item%next
            end do
         end do

         IF (j /= dict%size + 1) &
            DBCSR_ABORT("dict_${keytype}$_${valuetype}$_items: assertion failed!")
      END FUNCTION dict_${keytype}$_${valuetype}$_items

   #:endfor

END MODULE dbcsr_dict
