fhash/fhash_modules.f90 at master · jl2922/fhash · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
! Define the module for the key type.
! Override the hash_value and == operator interface.
module ints_module

  implicit none

  type ints_type
    integer, allocatable :: ints(:)
  end type

  interface hash_value
    module procedure hash_value_ints
  end interface

  interface operator (==)
    module procedure ints_equal
  end interface

#ifdef __GFORTRAN__
  interface assignment (=)
    module procedure ints_ptr_assign
  end interface
#endif

  contains

    function hash_value_ints(ints) result(hash)
      type(ints_type), intent(in) :: ints
      integer :: hash
      integer :: i

      hash = 0
      do i = 1, size(ints%ints)
        hash = xor(hash, ints%ints(i) + 1640531527 + ishft(hash, 6) + ishft(hash, -2))
      enddo
    end function

    function ints_equal(lhs, rhs)
      type(ints_type), intent(in) :: lhs, rhs
      logical :: ints_equal
      integer :: i

      if (size(lhs%ints) /= size(rhs%ints)) then
        ints_equal = .false.
        return
      endif

      do i = 1, size(lhs%ints)
        if (lhs%ints(i) /= rhs%ints(i)) then
          ints_equal = .false.
          return
        endif
      enddo

      ints_equal = .true.

    end function

#ifdef __GFORTRAN__
    subroutine ints_ptr_assign(lhs, rhs)
      type(ints_type), pointer, intent(inout) :: lhs
      type(ints_type), pointer, intent(in) :: rhs
      lhs => rhs
    end subroutine
#endif

end module ints_module

! Define the macros needed by fhash and include fhash.f90
#define KEY_USE use ints_module
#define KEY_TYPE type(ints_type)
#define VALUE_USE use, intrinsic :: iso_fortran_env
#define VALUE_TYPE real(real64)
#define VALUE_TYPE_INIT 0.0
#define SHORTNAME ints_double
#include "fhash.f90"

module int_module
  implicit none

  interface hash_value
    module procedure hash_value_int
  end interface

  contains

    function hash_value_int(int) result(hash)
      integer, intent(in) :: int
      integer :: hash

      hash = int
    end function
end module

! Define the macros needed by fhash and include fhash.f90
#define KEY_USE use int_module
#define KEY_TYPE integer
#define VALUE_USE use ints_module
#define VALUE_TYPE type(ints_type), pointer
!#define VALUE_TYPE_INIT null()
#define SHORTNAME int_ints_ptr
#ifndef __GFORTRAN__
#define VALUE_POINTER
#endif
#ifdef VALUE_TYPE_INIT
#define CHECK_ITERATOR_VALUE
#endif
#include "fhash.f90"