!== Hash module
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dc_hash.f90,v 1.3 2006/05/31 14:17:48 morikawa Exp $
! Tag Name::  $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides dc_hash
!


module dc_hash 4,8
  !
  !== Overview
  !
  ! スクリプト言語ではおなじみとなっている ハッシュ (連想配列)
  ! を提供します.
  !
  ! ただし, 現在「値」として与えられるのは文字型のみです.
  !
  !== List
  !
  ! Put      :: ハッシュにキーと値を付加
  ! Get      :: キーを与え, ハッシュ内の関連する値を取得
  ! Rewind   :: ハッシュ内全体を探査するための初期化
  ! Next     :: Rewind 参照
  ! Delete   :: キーを与え, ハッシュ内の関連する値を削除
  ! Size     :: ハッシュのサイズを返す
  ! Put_Line :: ハッシュの内容を標準出力に出力 (デバック用)
  !
  !
  !== Usage
  !
  !      use dc_types
  !      use dc_hash
  !      type(HASH):: hashv
  !      character(len = STRING):: key, value
  !      logical:: end
  !
  !      call Put(hashv, 'key1', 'val1')
  !      call Put(hashv, 'key2', 'val2')
  !      call Put(hashv, 'key3', 'val3')
  !
  !      call Get(hashv, 'key1', value)
  !      write(*,*) 'key=' // 'key1' // ', value=' // trim(value)
  !
  !      write(*,*) 'size(hashv)=', Size(hashv)
  !
  !      call Delete(hashv, 'key1')
  !
  !      call Rewind(hashv)
  !      do
  !        call Next(hashv, key, value, end)
  !        if (end) exit
  !        write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
  !      enddo
  !
  !      call Delete(hashv) ! cleaning
  !
  ! 以下のように出力されます.
  !
  !      key=key1, value=val1
  !      size(hashv)= 3
  !      key=key2, value=val2
  !      key=key3, value=val3
  !
  !
  use dc_types, only : STRING
  implicit none
  private

  public:: HASH
  public:: Put, Put_Line, Get, Rewind, Next, Delete, Size

  type HASH
    !
    !=== ハッシュ構造体
    !
    ! 利用法に関しては dc_hash を参照してください.
    !
    private
    type(HASH_INTERNAL), pointer :: hash_table(:) => null()
    integer :: search_index = 0
  end type HASH

  type HASH_INTERNAL
    private
    character(STRING) :: key
    character(STRING) :: value
  end type HASH_INTERNAL


  interface Put 11
    module procedure DCHashPut
  end interface


  interface Size
    module procedure DCHashSize
  end interface


  interface Put_Line 1
    module procedure DCHashPut_Line
  end interface


  interface Rewind 1
    module procedure DCHashRewind
  end interface


  interface Next 1
    module procedure DCHashNext
  end interface


  interface Get 32
    module procedure DCHashGet
  end interface


  interface Delete 4
    module procedure DCHashDelete
  end interface

contains


  subroutine DCHashPut(hashv, key, value) 1,2
    !
    !=== ハッシュへ代入
    !
    ! *hashv* のキー *key* に値 *value* を関連付けます.
    !
    !
    implicit none
    type(HASH), intent(inout) :: hashv
    character(*), intent(in) :: key, value
    type(HASH_INTERNAL), pointer :: hash_table_tmp(:) => null()
    integer :: table_size, new_index, i
    logical :: found
    character(STRING) :: search_value
  continue
    call DCHashGet(hashv, key, search_value, found)
    if (.not. found) then
      table_size = DCHashSize(hashv)
      if (table_size > 0) then
        allocate(hash_table_tmp(table_size))
        hash_table_tmp = hashv % hash_table
        deallocate(hashv % hash_table)
        allocate(hashv % hash_table(table_size + 1))
        hashv % hash_table(1:table_size) = hash_table_tmp(1:table_size)
        deallocate(hash_table_tmp)
        new_index = table_size + 1
      else
        allocate(hashv % hash_table(1))
        new_index = 1
      end if

      hashv % hash_table(new_index) % key = key
      hashv % hash_table(new_index) % value = value
    else
      do i = 1, size(hashv % hash_table)
        if (trim(hashv % hash_table(i) % key) == trim(key)) then
          hashv % hash_table(i) % value = value
        end if
      end do
    end if

  end subroutine DCHashPut



  function DCHashSize(hashv) result(result) 4
    !
    !=== ハッシュのサイズ
    !
    ! *hashv* のサイズを返します.
    !
    implicit none
    type(HASH), intent(in) :: hashv
    integer :: result
  continue
    if (associated(hashv % hash_table)) then
      result = size(hashv % hash_table)
    else
      result = 0
    end if
  end function DCHashSize


  subroutine DCHashRewind(hashv) 3
    !
    !=== ハッシュの内容を取り出すための初期化 (巻き戻し)
    !
    ! *hashv* の巻き戻しを行います. Next との組み合わせによって
    ! キーと値のリストを取得すること可能です.
    !
    ! 以下のサンプルソースコードを参照ください.
    !
    !      ! ハッシュ一覧の取得
    !      use dc_type
    !      use dc_hash
    !      type(HASH):: hashv
    !      character(len = STRING):: key, value
    !      logical:: end
    !
    !      call Rewind(hashv)
    !      do
    !        call Next(hashv, key, value, end)
    !        if (end) exit
    !        write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
    !      enddo
    !
    implicit none
    type(HASH), intent(inout) :: hashv
  continue
    hashv % search_index = 1
  end subroutine DCHashRewind


  subroutine DCHashNext(hashv, key, value, end) 3,1
    !
    !=== ハッシュの内容を取得
    !
    ! *hashv* の内容を *key* と *value* に返します.
    ! 詳しくは Rewind を参照してください.
    !
    implicit none
    type(HASH), intent(inout) :: hashv
    character(*), intent(out) :: key
    character(*), intent(out), optional :: value
    logical, intent(out) :: end
    integer :: table_size
    character(STRING) :: value_tmp
  continue
    table_size = DCHashSize(hashv)
    if (table_size < hashv % search_index) then
      key = ''
      value_tmp = ''
      end = .true.
    else
      key = hashv % hash_table(hashv % search_index) % key
      value_tmp = hashv % hash_table(hashv % search_index) % value
      end = .false.
      hashv % search_index = hashv % search_index + 1
    end if
    if (present(value)) then
      value = value_tmp
    end if

  end subroutine DCHashNext



  subroutine DCHashPut_Line(hashv) 1,7
    !
    !=== ハッシュの内容を印字
    !
    ! *hashv* の内容を標準出力に表示します.
    !
    use dc_types, only: STRING
    use dc_string, only: Printf, JoinChar
    implicit none
    type(HASH), intent(in) :: hashv
    type(HASH) :: hashv_tmp
    character(len = STRING):: key, value
    logical:: end
  continue
    hashv_tmp = hashv

    call Printf(6, '#<HASH:: ')
    call DCHashRewind(hashv_tmp)
    do
      call DCHashNext(hashv_tmp, key, value, end)
      if (end) exit
      call Printf(6, '         "%c" -> "%c",', &
        & c1=trim(key), c2=trim(value))
    enddo
    call Printf(6, '> ')

  end subroutine DCHashPut_Line



  subroutine DCHashGet(hashv, key, value, found) 3,3
    !
    !=== ハッシュの値を取得
    !
    ! *hashv* のキー *key* に関連する値を *value* に返します.
    ! *key* に関連する値が存在しない場合は *value* に
    ! 空文字を返します.
    !
    ! *found* を与えると, *key* に関連する値が見つからなかった
    ! 場合に .false. を返します.
    !
    use dc_types, only: STRING
    implicit none
    type(HASH), intent(inout) :: hashv
    character(*), intent(in)  :: key
    character(*), intent(out) :: value
    logical, intent(out), optional :: found
    character(STRING) :: search_key, search_value
    logical :: end
  continue
    call DCHashRewind(hashv)
    do
      call DCHashNext(hashv, search_key, search_value, end)
      if (end) then
        value = ''
        if (present(found)) found = .false.
        exit
      end if

      if (trim(search_key) == trim(key)) then
        value = search_value
        if (present(found)) found = .true.
        exit
      end if
    enddo

  end subroutine DCHashGet


  subroutine DCHashDelete(hashv, key) 1,2
    !
    !=== ハッシュ内の値の削除
    !
    ! *hashv* のキー *key* およびその関連する値を削除します.
    ! *hashv* 内に *key* が見つからない場合には何もしません.
    !
    ! *key* が省略される場合には *hashv* 内の全てのキーと値を
    ! 削除します.
    !
    implicit none
    type(HASH), intent(inout) :: hashv
    character(*), intent(in), optional :: key
    type(HASH_INTERNAL), pointer :: hash_table_tmp(:) => null()
    integer :: table_size, i, j
    logical :: found
    character(STRING) :: search_value
  continue
    if (present(key)) then
      call DCHashGet(hashv, key, search_value, found)
      table_size = DCHashSize(hashv)
      if (found .and. table_size > 1) then
        allocate(hash_table_tmp(table_size))
        hash_table_tmp = hashv % hash_table
        deallocate(hashv % hash_table)
        allocate(hashv % hash_table(table_size - 1))
        j = 1
        do i = 1, table_size
          if (trim(hash_table_tmp(i) % key) /= trim(key)) then
            hashv % hash_table(j) % key = hash_table_tmp(i) % key
            hashv % hash_table(j) % value = hash_table_tmp(i) % value
            j = j + 1
          end if
        end do
        
        deallocate(hash_table_tmp)
      elseif (found .and. table_size == 1) then
        deallocate(hashv % hash_table)
      end if
    else
      if (associated(hashv % hash_table)) deallocate(hashv % hash_table)
    end if

  end subroutine DCHashDelete

end module dc_hash