dictionary_m.f90

Go to the documentation of this file.

module dictionary_m
  implicit none

  private

  public :: dictionary_t

  type entry_t
     character(len=:), allocatable :: key
     character(len=:), allocatable :: value
  end type entry_t

  type bucket_t
     type(entry_t), allocatable :: entries(:)
     integer :: current_size = 0
     integer :: current_idx = 0
   contains
     procedure :: find
  end type bucket_t

  type dictionary_t
     type(bucket_t), allocatable :: buckets(:)
     integer :: dict_size = 0
   contains
     procedure :: djb2
     procedure :: set
     procedure :: get
     procedure :: init
     procedure :: show
  end type dictionary_t

  integer, parameter :: BUCKET_EMPTY = -2
  integer, parameter :: BUCKET_ENTRY_NOT_FOUND = -4

contains

  function djb2(this, s) result(r)
    class(dictionary_t), intent(in) :: this
    character(len=*), intent(in) :: s
    integer :: r

    integer :: i, l

    l = len(s)

    r = 5381

    do i = 1, l
       r = r*33 + ichar(s(i:i))
    end do

    r = modulo(r, this%dict_size)

  end function djb2

  subroutine set(this, k, v)
    class(dictionary_t), intent(inout) :: this
    character(len=*), intent(in) :: k
    character(len=*), intent(in) :: v

    type(bucket_t) :: tmp_bucket

    integer :: h, i, b_idx

    h = this%djb2(k) + 1

    b_idx = this%buckets(h)%find(k)

    if (b_idx == bucket_empty) then
       ! allocate bucket for 1 entry
       ! also, means we can take the first entry
       allocate(this%buckets(h)%entries(1))
       this%buckets(h)%current_size = 1
       this%buckets(h)%current_idx = 1
       b_idx = 1
       this%buckets(h)%entries(1)%key = trim(k)
       this%buckets(h)%entries(1)%value = trim(v)
       ! the values are registered, exit
       return
    end if

    if (b_idx == bucket_entry_not_found) then
       ! copy and grow bucket entries
       
       allocate(tmp_bucket%entries(this%buckets(h)%current_size + 1))
       tmp_bucket%current_size = this%buckets(h)%current_size + 1
       tmp_bucket%current_idx = this%buckets(h)%current_idx + 1

       do i = 1, this%buckets(h)%current_size
          tmp_bucket%entries(i)%key = this%buckets(h)%entries(i)%key
          tmp_bucket%entries(i)%value = this%buckets(h)%entries(i)%value
       end do

       deallocate(this%buckets(h)%entries)
       allocate(this%buckets(h)%entries, source=tmp_bucket%entries)
       deallocate(tmp_bucket%entries)

       this%buckets(h)%current_size = tmp_bucket%current_size
       this%buckets(h)%current_idx = tmp_bucket%current_idx
       b_idx = this%buckets(h)%current_idx
    end if

    if (b_idx > 0) then
       this%buckets(h)%entries(b_idx)%key = k
       this%buckets(h)%entries(b_idx)%value = v
    end if

  end subroutine set

  subroutine init(this, dict_size)
    class(dictionary_t), intent(out) :: this
    integer, intent(in) :: dict_size

    allocate(this%buckets(dict_size))
    this%dict_size = dict_size

  end subroutine init

  subroutine show(this)
    class(dictionary_t), intent(in) :: this

    integer :: i, j, s
    integer :: n

    n = 0
    do i = 1, this%dict_size
       s = this%buckets(i)%current_idx
       if (s > 0) then
             write(*,*) 'bucket   : ', i, ' size ', s
          do j = 1, s
             write(*,*) 'key      : ', this%buckets(i)%entries(j)%key
             write(*,*) 'value    : ', this%buckets(i)%entries(j)%value
          end do
       end if
    end do

  end subroutine show

  function find(this, k) result(r)
    class(bucket_t), intent(in) :: this
    character(len=*), intent(in) :: k
    integer :: r

    integer :: i

    if (this%current_size == 0) then
       r = bucket_empty
       return
    end if

    r = bucket_entry_not_found
    do i = 1, this%current_size
       if (this%entries(i)%key == trim(k)) then
          r = i
          exit
       end if
    end do

  end function find

  function get(this, k) result(r)
    class(dictionary_t), intent(in) :: this
    character(len=*), intent(in) :: k

    character(len=:), allocatable :: r

    integer :: h, b_idx

    h = this%djb2(k) + 1

    b_idx = this%buckets(h)%find(k)

    if ( (b_idx == bucket_empty) .or. &
         (b_idx == bucket_entry_not_found) ) then
       r = ''
       return
    end if

    if (b_idx>0) then
       r = this%buckets(h)%entries(b_idx)%value
    end if

  end function get

end module dictionary_m