1:- module(
    2  assoc_ext,
    3  [
    4    merge_assoc/3,    % +New, +Old, -Merge
    5    transpose_assoc/2 % +Original, -Transposed
    6  ]
    7).    8:- reexport(library(assoc)).

Extended support for association lists

This module extends the support for association lists in the SWI-Prolog standard library.

*/

   17:- use_module(library(pair_ext)).   18
   19:- multifile
   20    error:has_type/2.   21
   22error:has_type(assoc(_KeyT,_ValueT), Term) :-
   23  is_assoc(Term).
 merge_assoc(+New:assoc, +Old:assoc, -Merge:assoc) is det
Merges two association lists (New and Old) into one new association list (Merge).

If the same key appear in both New and Old, then the value from New is used and the value from Old is discarded.

   35merge_assoc(New, Old, Merge) :-
   36  assoc_to_list(New, NewPairs),
   37  assoc_to_list(Old, OldPairs),
   38  merge_pairs(NewPairs, OldPairs, MergePairs),
   39  list_to_assoc(MergePairs, Merge).
 transpose_assoc(+Original:assoc, -Transposed:assoc) is det
Transposes an association list, i.e., turns all keys into values and all values into keys.
   48transpose_assoc(Assoc1, Assoc2) :-
   49  assoc_to_list(Assoc1, Pairs1),
   50  transpose_pairs(Pairs1, Pairs2),
   51  list_to_assoc(Pairs2, Assoc2)