TABLE OF CONTENTS

ABINIT/m_pair_list [ Modules ]

[ Top ] [ Modules ]

NAME

  m_pair_list

FUNCTION

  This module defines an API to build
  dictionaries containing string keys and numeric or string values.
  It is implemented in C as a simple linked pair list (associative list).

COPYRIGHT

 Copyright (C) 2009-2024 ABINIT group (TC, MG)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

NOTES

 This module provide an implementation of a pair list
 Possible improvement:
 - Simplify the usage of get by removing the limit in key and string size
 - Simplify the usage of get by removing the need for variable for all possible
   content when you know what is stored

SOURCE

 25 #if defined HAVE_CONFIG_H
 26 #include "config.h"
 27 #endif
 28 
 29 #include "abi_common.h"
 30 
 31 module m_pair_list
 32 
 33   use, intrinsic :: iso_c_binding
 34   use m_type_pair_list
 35   use m_errors
 36 
 37   use m_fstrings, only : sjoin, itoa
 38 
 39   implicit none
 40 
 41   ! Similar constants used in C code.
 42   integer,public,parameter :: TC_EMPTY=-2, TC_NOTFOUND=-1, TC_INT=0, TC_REAL=1, TC_STRING=2
 43 
 44   private
 45   public :: pair_list_set, pair_list_get, pair_list_free
 46   public :: pair_list_next, pair_list_look, pair_list_iter, pair_list_restart
 47   public :: pair_list
 48 
 49   type :: pair_list
 50     type(c_pair_list) :: plc
 51     contains
 52       procedure :: set => pair_list_set
 53       procedure :: set_keys => pair_list_set_keys
 54       procedure :: set_keys_to_null => pair_list_set_keys_to_null
 55       procedure :: get => pair_list_get
 56       procedure :: free => pair_list_free
 57       procedure :: next => pair_list_next
 58       procedure :: look => pair_list_look
 59       procedure :: iter => pair_list_iter
 60       procedure :: restart => pair_list_restart
 61       procedure :: length => pair_list_length
 62       procedure :: increment => pair_list_increment
 63   end type pair_list
 64 
 65 ! -------------------------------------------------------------------------------
 66 ! -                                                                             -
 67 ! -                        Private C function binding                           -
 68 ! -                                                                             -
 69 ! -------------------------------------------------------------------------------
 70   interface
 71 
 72     subroutine pair_list_next_c(pl) bind(C, name="pair_list_next")
 73       use m_type_pair_list
 74       type(c_pair_list),intent(in) :: pl
 75     end subroutine pair_list_next_c
 76 
 77     subroutine pair_list_free_c(pl) bind(C, name="pair_list_free")
 78       use m_type_pair_list
 79       type(c_pair_list),intent(inout) :: pl
 80     end subroutine pair_list_free_c
 81 
 82     subroutine pair_list_seti(pl, key, i, len) bind(C, name="pair_list_seti")
 83       use m_type_pair_list
 84       type(c_pair_list) :: pl
 85       character(kind=c_char) :: key(*)
 86       integer(kind=c_int) :: i, len
 87     end subroutine pair_list_seti
 88 
 89     subroutine pair_list_setr(pl, key, r, len) bind(C, name="pair_list_setr")
 90       use m_type_pair_list
 91       type(c_pair_list) :: pl
 92       character(kind=c_char) :: key(*)
 93       integer(kind=c_int) :: len
 94       real(kind=c_double) :: r
 95     end subroutine pair_list_setr
 96 
 97     subroutine pair_list_sets(pl, key, s, len, len_s) bind(C, name="pair_list_sets")
 98       use m_type_pair_list
 99       type(c_pair_list) :: pl
100       character(kind=c_char) :: key(*), s(*)
101       integer(kind=c_int) :: len, len_s
102       real(kind=c_double) :: r
103     end subroutine pair_list_sets
104 
105     subroutine pair_list_get_c(pl, key, type_code, i, r, s, len, len_s) bind(C, name="pair_list_get_")
106       use m_type_pair_list
107       type(c_pair_list) :: pl
108       character(kind=c_char) :: key(*), s(*)
109       integer(kind=c_int) :: i, type_code, len, len_s
110       real(kind=c_double) :: r
111     end subroutine pair_list_get_c
112 
113     subroutine pair_list_look_c(pl, key, type_code, i, r, s, len, len_s) bind(C, name="pair_list_look_")
114       use m_type_pair_list
115       type(c_pair_list) :: pl
116       integer(kind=c_int) :: type_code, i, len, len_s
117       character(kind=c_char) :: key(len), s(len_s)
118       real(kind=c_double) :: r
119     end subroutine pair_list_look_c
120 
121   end interface
122 
123 ! -------------------------------------------------------------------------------
124 ! -                                                                             -
125 ! -                          Pure Fortran Wrapper                               -
126 ! -                                                                             -
127 ! -------------------------------------------------------------------------------
128   contains

m_pair_list/pair_list_free [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_free

FUNCTION

  free memory occupied by the list (not the pair_list variable itself !)
  and reset the pair_list variable (it can be reused as an empty list)

SOURCE

252 subroutine pair_list_free(pl)
253 
254   class(pair_list),intent(inout) :: pl
255   call pair_list_free_c(pl%plc)
256 
257 end subroutine pair_list_free

m_pair_list/pair_list_get [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_get

FUNCTION

  Get the value associated with a key, only one of i and r is modified

INPUTS

  pl <class(pair_list)>=
  key <character(kind=c_char,len=*)>=
  s <character(kind=c_char,len=*)>=

OUTPUT

  i <integer(kind=c_int)>=
  type_code <integer(kind=c_int)>=
      0 if the value was an integer (and so that i is setted)
      1 if the value was a real number (and so that r is setted)
      2 if the value was a string (and so that s is setted)
     -1 if the key was not present (neither i nor r are setted)
     -2 if the list is empty (neither i nor r are setted)
  r <real(kind=c_double)>=

SOURCE

176 subroutine pair_list_get(pl, key, type_code, i, r, s)
177   class(pair_list),intent(in) :: pl
178   character(kind=c_char,len=*),intent(in) :: key, s
179   integer(kind=c_int),intent(out) :: i, type_code
180   real(kind=c_double),intent(out) :: r
181   call pair_list_get_c(pl%plc, trim(key), type_code, i, r, s, len_trim(key), len(s))
182 end subroutine pair_list_get

m_pair_list/pair_list_increment [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_increment

FUNCTION

  Increment integer value. Create key if not already present.

INPUTS

  pl <class(pair_list)>=
  key <character(len=*)>=
  cnt=Increment

SOURCE

476 subroutine pair_list_increment(pl, key, cnt)
477 
478  class(pair_list),intent(in) :: pl
479  character(len=*),intent(in) :: key
480  integer,intent(in) :: cnt
481 
482  integer(kind=c_int) :: i, type_code
483  real(kind=c_double) :: r
484  character(kind=c_char,len=500) :: s
485 
486  call pair_list_get(pl, key, type_code, i, r, s)
487  select case (type_code)
488  case (TC_EMPTY, TC_NOTFOUND)
489    call pair_list_set(pl, key, i=cnt)
490  case (TC_INT)
491    call pair_list_set(pl, key, i=cnt + i)
492  case default
493    ABI_ERROR(sjoin("Expecting value in dict of integer type. got:", itoa(type_code)))
494  end select
495 
496 end subroutine pair_list_increment

m_pair_list/pair_list_iter [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_iter

FUNCTION

  equivalent to pair_list_look followed by pair_list_next

INPUTS

  pl <class(pair_list)>=

OUTPUT

  key <character(len=*)>=
  type_code <integer>=
  i <integer>=
  r <real(kind=c_double)>=
  s <character(len=*)>=

SOURCE

447 subroutine pair_list_iter(pl, key, type_code, i, r, s)
448 
449   class(pair_list),intent(in) :: pl
450   character(len=*),intent(out) :: key
451   integer,intent(out) :: type_code
452   integer,intent(out) :: i
453   real(kind=c_double),intent(out) :: r
454   character(len=*),intent(out) :: s
455 
456   call pair_list_look(pl, key, type_code, i, r, s)
457   if(type_code >= 0) call pair_list_next_c(pl%plc)
458 
459 end subroutine pair_list_iter

m_pair_list/pair_list_length [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_length

FUNCTION

  REturn the number of items stored in pl

INPUTS

  pl <class(pair_list)>=

OUTPUT

SOURCE

145 function pair_list_length(pl) result(length)
146   class(pair_list),intent(in) :: pl
147   integer :: length
148   length = pl%plc%length
149 end function pair_list_length

m_pair_list/pair_list_look [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_look

FUNCTION

  pair_list has a cursor which point onto an arbitrary element
  of the list. pair_list_look allow to extract the key-value pair from
  that element

  If key is shorter than the actual key of the pair, only available space
  is used resulting in truncated key
  If key is longer than the actual key remaining space is filled with spaces

INPUTS

  pl <class(pair_list)>=

OUTPUT

  key <character(kind=c_char,len=*)>=
  s <character(kind=c_char,len=*)>=
  type_code <integer(kind=c_int)>=
      1 if the value was a real number (and so that r is setted)
      0 if the value was an integer (and so that i is setted)
     -2 if the cursor is null (list is empty or end have been reached)
  i <integer(kind=c_int)>=
  r <real(kind=c_double)>=

SOURCE

213 subroutine pair_list_look(pl, key, type_code, i, r, s)
214   use m_type_pair_list
215   class(pair_list),intent(in) :: pl
216   character(kind=c_char,len=*),intent(out) :: key, s
217   integer(kind=c_int),intent(out) :: type_code, i
218   real(kind=c_double),intent(out) :: r
219   call pair_list_look_c(pl%plc, key, type_code, i, r, s, len(key), len(s))
220 end subroutine pair_list_look

m_pair_list/pair_list_next [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_next

FUNCTION

  have the cursor (cf: pair_list_look) moving forward of one element.

INPUTS

  pl <class(pair_list)>=

OUTPUT

SOURCE

236   subroutine pair_list_next(pl)
237     class(pair_list),intent(in) :: pl
238     call pair_list_next_c(pl%plc)
239   end subroutine pair_list_next

m_pair_list/pair_list_restart [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_restart

FUNCTION

  have the cursor going back to the first element (cf: pair_list_next)

SOURCE

420 subroutine pair_list_restart(pl)
421 
422   class(pair_list),intent(inout) :: pl
423   pl%plc%cursor = pl%plc%first;
424 
425 end subroutine pair_list_restart

m_pair_list/pair_list_set [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_set

FUNCTION

  set a key-value par into the list. If the key is already present, the
  corresponding pair is updated. If not the pair is created.
  Only one of i and r should be provided (i is the default if both are
  provided). Nothing happen if none of them are provided.

INPUTS

  pl <class(pair_list)>=
  key <character(len=*)>=
  i <integer>=optional
  r <real(kind=c_double)>=optional
  s <character(len=*)>=optional

OUTPUT

SOURCE

281 subroutine pair_list_set(pl, key, i, r, s)
282 
283  class(pair_list),intent(in) :: pl
284  character(len=*),intent(in) :: key
285  integer,intent(in),optional :: i
286  real(kind=c_double),intent(in),optional :: r
287  character(len=*),intent(in),optional :: s
288 
289  if (present(i)) then
290    call pair_list_seti(pl%plc, trim(key), i, len_trim(key))
291  else if (present(r)) then
292    call pair_list_setr(pl%plc, trim(key), r, len_trim(key))
293  else if (present(s)) then
294    call pair_list_sets(pl%plc, trim(key), s, len_trim(key), len_trim(s))
295  end if
296 
297 end subroutine pair_list_set

m_pair_list/pair_list_set_keys [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_set_keys

FUNCTION

  Set the value of a list of comma-separated keys.

  Example

  d%set_keys("foo, bar", ivals=[1, 2])

INPUTS

  pl <class(pair_list)>=
  keylist <character(len=*)>=
  i <integer>=optional
  r <real(kind=c_double)>=optional
  s <character(len=*)>=optional

OUTPUT

SOURCE

322 subroutine pair_list_set_keys(pl, keylist, ivals, rvals) !, svals)
323 
324  class(pair_list),intent(in) :: pl
325  character(len=*),intent(in) :: keylist
326  integer,intent(in),optional :: ivals(:)
327  real(kind=c_double),intent(in),optional :: rvals(:)
328  !character(len=*),intent(in),optional :: svals(:)
329 
330 !Local variables-------------------------------
331  integer :: i, n, start, stp
332  character(len=len(keylist)) :: key
333 ! *************************************************************************
334 
335  n = 1
336  do i=1,len_trim(keylist)
337    if (keylist(i:i) == ",") n = n + 1
338  end do
339 
340  start = 1
341  do i=1,n
342    stp = index(keylist(start:), ",")
343    if (stp == 0) then
344      key = keylist(start:)
345    else
346      key = keylist(start: start + stp - 2)
347      start = start + stp
348      ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
349    end if
350    key = adjustl(key)
351 
352    if (present(ivals)) then
353      ABI_CHECK(size(ivals) == n, "size(ivals) != n")
354      call pair_list_seti(pl%plc, trim(key), ivals(i), len_trim(key))
355 
356    else if (present(rvals)) then
357      ABI_CHECK(size(rvals) == n, "size(rvals) != n")
358      call pair_list_setr(pl%plc, trim(key), rvals(i), len_trim(key))
359 
360    !else if (present(svals)) then
361    !  TODO: Pass single string with comma-separated tokens.
362    !  ABI_CHECK(size(svals) == n, "size(svals) != n")
363    !  call pair_list_sets(pl%plc, trim(key), svals(i), len_trim(key), len_trim(svals(i)))
364    end if
365  end do
366 
367 end subroutine pair_list_set_keys

m_pair_list/pair_list_set_keys_to_null [ Functions ]

[ Top ] [ m_pair_list ] [ Functions ]

NAME

 pair_list_set_keys_to_null

FUNCTION

  Set the value of a list of comma-separated keys to null

  Example:

      dict%set_keys_to_null("foo, bar")

INPUTS

  keylist: List of comma-separated keys

SOURCE

386 subroutine pair_list_set_keys_to_null(pl, keylist)
387 
388  class(pair_list),intent(in) :: pl
389  character(len=*),intent(in) :: keylist
390 
391 !Local variables-------------------------------
392  integer :: start, stp
393 ! *************************************************************************
394 
395  start = 1
396  do
397    stp = index(keylist(start:), ",")
398    if (stp == 0) then
399      call pl%set(adjustl(trim(keylist(start:))), s="null")
400      exit
401    else
402      call pl%set(adjustl(trim(keylist(start:start+stp-2))), s="null")
403      start = start + stp
404      ABI_CHECK(start < len_trim(keylist), sjoin("Invalid keylist:", keylist))
405    end if
406  end do
407 
408 end subroutine pair_list_set_keys_to_null