TABLE OF CONTENTS
- ABINIT/m_pair_list
- m_pair_list/pair_list_free
- m_pair_list/pair_list_get
- m_pair_list/pair_list_increment
- m_pair_list/pair_list_iter
- m_pair_list/pair_list_length
- m_pair_list/pair_list_look
- m_pair_list/pair_list_next
- m_pair_list/pair_list_restart
- m_pair_list/pair_list_set
- m_pair_list/pair_list_set_keys
- m_pair_list/pair_list_set_keys_to_null
ABINIT/m_pair_list [ 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