1:- module(swi_dicts, 2 [ % +Key, +Dict0:dict, +OnNotEmpty:callable, +Value, -Dict:dict 3 put_dict/5, 4 5 merge_dict/3, % +Dict0:dict, +Dict1:dict, -Dict:dict 6 merge_pair/3, % +Dict0:dict, +Pair, -Dict:dict 7 merge_dicts/2, % +Dicts:list(dict), -Dict:dict 8 9 dict_member/2, % ?Dict:dict, ?Member 10 dict_leaf/2, % ?Dict, ?Pair 11 dict_pair/2, % ?Dict, ?Pair 12 13 % ?Tag, ?Template, :Goal, -Dicts:list(dict) 14 findall_dict/4, 15 16 dict_tag/2, % +Dict, ?Tag 17 create_dict/3, % ?Tag, +Dict0, -Dict 18 is_key/1, % +Key 19 dict_compound/2, % +Dict, -Compound 20 list_dict/3 % ?List, ?Tag, ?Dict 21 ]). 22 23:- use_module(compounds). 24:- use_module(atoms). 25:- use_module(lists). 26 27:- meta_predicate 28 put_dict(, , , , ), 29 findall_dict(, , , ).
The implementation puts Key and Value in Dict0, unifying the result at Dict. However, if the dictionary Dict0 already contains another value for the indicated Key then it invokes OnNotEmpty with the original Value0 and the replacement Value, finally putting the combined or selected Value_ in the dictionary for the Key.
72put_dict(Key, Dict0, OnNotEmpty, Value, Dict) :- 73 get_dict(Key, Dict0, Value0), 74 !, 75 call(OnNotEmpty, Value0, Value, Value_), 76 put_dict(Key, Dict0, Value_, Dict). 77put_dict(Key, Dict0, _, Value, Dict) :- 78 put_dict(Key, Dict0, Value, Dict).
Merges non-dictionaries according to type. Appends lists when the value in a key-value pair has list type. Only replaces existing values with incoming values when the leaf is not a dictionary, and neither existing nor incoming is a list.
Note the argument order. The first argument specifies the base dictionary starting point. The second argument merges into the first. The resulting merge unifies at the third argument. The order only matters if keys collide. Pairs from Dict1 replace key-matching pairs in Dict0.
Merging does not replace the original dictionary tag. This includes an unbound tag. The tag of Dict0 remains unchanged after merge.
101merge_dict(Dict0, Dict1, Dict) :-
102 is_dict(Dict1),
103 dict_pairs(Dict1, _, Pairs),
104 foldl(merge_pair_, Pairs, Dict0, Dict).
Private predicate merge_dict_/3
is the value merging predicate; given the original Value0 and the
incoming Value, it merges the two values at Value_.
115merge_pair(Dict0, Key-Value, Dict) :- 116 merge_pair_(Key-Value, Dict0, Dict). 117 118merge_pair_(Key-Value, Dict0, Dict) :- 119 put_dict(Key, Dict0, merge_dict_, Value, Dict).
127merge_dict_(Value0, Value, Dict) :- 128 is_dict(Value), 129 !, 130 merge_dict(Value0, Value, Dict). 131merge_dict_(Value0, Value, Values) :- 132 is_list(Value), 133 !, 134 merge_list_(Value0, Value, Values). 135merge_dict_(Value0, Value, [Value0|Value]) :- 136 is_list(Value0), 137 !. 138merge_dict_(_, Value, Value). 139 140merge_list_(Value0, Values0, Values) :- 141 is_list(Value0), 142 !, 143 append(Value0, Values0, Values). 144merge_list_(Value0, Values0, Values) :- 145 append([Value0], Values0, Values).
Merging ignores tags.
156merge_dicts([Dict], Dict) :- 157 !. 158merge_dicts([Dict0, Dict1|Dicts], Dict) :- 159 merge_dict(Dict0, Dict1, Dict_), 160 merge_dicts([Dict_|Dicts], Dict).
Keys become tagged keys of the form Tag^Key. The caret operator
neatly fits by operator precedence in-between the pair operator
(-) and the sub-key slash delimiter (/). Nested keys become
nested slash-functor binary compounds of the form
TaggedKeys/TaggedKey. So for example, the compound Tag^Key-Value
translates to Tag{Key:Value} in dictionary form. Tag^Key-Value
decomposes term-wise as [-, Tag^Key, Value]. Note that tagged
keys, including super-sub tagged keys, take precedence within the
term.
This is a non-standard approach to dictionary unification. It turns nested sub-dictionary hierarchies into flatten pair-lists of tagged-key paths and their leaf values.
182dict_member(Dict, Member) :- 183 var(Dict), 184 !, 185 member_dict_(Member, Dict). 186dict_member(Dict, Member) :- 187 dict_pairs(Dict, Tag, Pairs), 188 member(Key-Value0, Pairs), 189 dict_member_(Tag^Key-Value0, Member). 190 191dict_member_(Tag0^Key0-Tag{}, Tag0^Key0-Tag{}) :- 192 !. 193dict_member_(Tag0^Key0-Dict, TaggedKeys-Value) :- 194 is_dict(Dict), 195 !, 196 dict_member(Dict, TaggedKeys0-Value), 197 flatten_slashes(Tag0^Key0/TaggedKeys0, TaggedKeys). 198dict_member_(Member, Member).
Tag
rather than Tag^Key-Value.206member_dict_(TaggedKeys/Tag^Key-Value, Dict) :- 207 !, 208 member_dict_(Tag^Key-Value, Dict0), 209 member_dict_(TaggedKeys-Dict0, Dict). 210member_dict_(Tag^Key-Value, Tag{}.put(Key, Value)) :- 211 !. 212member_dict_(Tag0^Key/Tag, Tag0{}.put(Key, Dict)) :- 213 !, 214 member_dict_(Tag, Dict). 215member_dict_(Tag, Tag{}) :- 216 atom(Tag).
Fails for integer keys because integers cannot serve as functors.
Does not attempt to map integer keys to an atom, since this will
create a reverse conversion disambiguation issue. This does work
for nested integer leaf keys, e.g. a(1), provided that the integer
key does not translate to a functor.
235dict_leaf(Dict, Leaf-Value) :- var(Dict), !, leaf_dict_(Dict, Leaf-Value). 236dict_leaf(Dict, Leaf-Value) :- 237 dict_pairs(Dict, _Tag, Pairs), 238 member(Key-Value0, Pairs), 239 dict_leaf_(Key-Value0, Leaf-Value). 240 241dict_leaf_(Key-Value0, Leaf-Value) :- is_dict(Value0), !, 242 dict_leaf(Value0, Leaf0-Value), 243 atom(Key), 244 Leaf =.. [Key, Leaf0]. 245dict_leaf_(Key-Value, Key-Value). 246 247leaf_dict_(Dict, Leaf-Value) :- is_key(Leaf), !, 248 dict_create(Dict, _, [Leaf-Value]). 249leaf_dict_(Dict, Leaf-Value) :- 250 compound(Leaf), 251 compound_name_arguments(Leaf, Key, [Leaf_]), 252 leaf_dict_(Dict0, Leaf_-Value), 253 dict_create(Dict, _, [Key-Dict0]).
264dict_pair(Dict, Path-Value) :- 265 is_dict(Dict), 266 !, 267 dict_pairs(Dict, _, Pairs), 268 member(Key-Value0, Pairs), 269 dict_pair_(Key-Value0, Path-Value). 270dict_pair(_{}.put(Path, Value), Path-Value). 271 272dict_pair_(Key-Value0, Path-Value) :- 273 is_dict(Value0), 274 !, 275 dict_pair(Value0, Path0-Value), 276 append_path(Key, Path0, Path). 277dict_pair_(Key-Value, Key-Value).
286findall_dict(Tag, Template, Goal, Dicts) :- 287 findall(Template, Goal, Bag), 288 convlist(findall_dict_(Tag), Bag, Dicts). 289 290:- public 291 findall_dict_/3. 292 293findall_dict_(Tag, Dict, Dict) :- 294 is_dict(Dict, Tag).
The implementation uses atomic concatenation to merge Tag and the dictionary sub-keys. Note that atomic_list_concat/3 works for non-atomic keys, including numbers and strings. Does not traverse sub-lists. Ignores sub-dictionaries where a dictionary value is a list containing dictionaries. Perhaps future versions will.
310dict_tag(Dict, Tag) :- 311 is_dict(Dict, Tag), 312 dict_pairs(Dict, Tag, Pairs), 313 pairs_tag(Pairs, Tag). 314 315pairs_tag([], _). 316pairs_tag([Key-Value|T], Tag) :- 317 ( is_dict(Value) 318 -> atomic_list_concat([Tag, Key], '_', Tag_), 319 dict_tag(Value, Tag_) 320 ; true 321 ), 322 pairs_tag(T, Tag).
Creating a dictionary using standard dict_create/3 overrides the tag argument from its Data dictionary, ignoring the Tag if any. For example, using dict_create/3 for tag xyz and dictionary abc{} gives you abc{} as the outgoing dictionary. This predicate reverses this behaviour; the Tag argument replaces any tag in a Data dictionary.
339create_dict(Tag, Dict0, Dict) :- 340 is_dict(Dict0, _), 341 !, 342 dict_pairs(Dict0, _, Pairs), 343 dict_create(Dict, Tag, Pairs). 344create_dict(Tag, Data, Dict) :- 345 dict_create(Dict, Tag, Data).
356is_key(Key) :- atom(Key), !. 357is_key(Key) :- integer(Key).
key(Value) where key matches
the dictionary key converted to one-two style and lower-case.
Unfolds lists and sub-dictionaries non-deterministically. For most occasions, the non-deterministic unfolding of sub-lists results in multiple non-deterministic solutions and typically has a plural compound name. This is not a perfect solution for lists of results, since the order of the solutions defines the relations between list elements.
Dictionary keys can be atoms or integers. Converts integers to compound names using integer-to-atom translation. However, compounds for sub-dictionaries re-wrap the sub-compounds by inserting the integer key as the prefix argument of a two or more arity compound.
377dict_compound(Dict, Compound) :- 378 dict_pairs(Dict, _, Pairs), 379 member(Key-Value, Pairs), 380 dict_compound_(Key-Value, Compound). 381 382dict_compound_(Key-Value, Compound) :- 383 is_dict(Value), 384 !, 385 dict_compound__(Key-Value, Compound). 386dict_compound_(Key-Value, Compound) :- 387 is_list(Value), 388 !, 389 member(Member, Value), 390 dict_compound_(Key-Member, Compound). 391dict_compound_(Key0-Value, Compound) :- 392 dict_compound_key(Key0, Key), 393 Compound =.. [Key, Value]. 394 395dict_compound__(Key-Dict, Compound) :- 396 integer(Key), 397 !, 398 dict_compound(Dict, Compound0), 399 Compound0 =.. [Name|Arguments], 400 Compound =.. [Name, Key|Arguments]. 401dict_compound__(Key0-Dict, Compound) :- 402 dict_compound(Dict, Compound0), 403 dict_compound_key(Key0, Key), 404 Compound =.. [Key, Compound0]. 405 406dict_compound_key(Key0, Key) :- 407 integer(Key0), 408 !, 409 atom_number(Key, Key0). 410dict_compound_key(Key0, Key) :- 411 restyle_identifier_ex(one_two, Key0, Key_), 412 downcase_atom(Key_, Key).
420list_dict(List, Tag, Dict) :-
421 indexed(List, 1, Pairs),
422 dict_create(Dict, Tag, Pairs),
423 !
SWI-Prolog dictionary extensions
This module provides extensions to the SWI-Prolog dictionary implementation. It includes predicates for merging dictionaries, putting values into dictionaries with custom merge behavior, and handling dictionary members and leaves in a more flexible way. It also includes predicates for creating dictionaries from lists and converting dictionaries to compounds.
### Non-deterministic
dict_member(?Dict, ?Member)This predicate offers an alternative approach to dictionary iteration in Prolog. It makes a dictionary expose its leaves as a list exposes its elements, one by one non-deterministically. It does not unify with non-leaves, as for empty dictionaries.
?- dict_member(a{b:c{d:e{f:g{h:i{j:999}}}}}, Key-Value). Key = a^b/c^d/e^f/g^h/i^j, Value = 999. ?- dict_member(Dict, a^b/c^d/e^f/g^h/i^j-999). Dict = a{b:c{d:e{f:g{h:i{j:999}}}}}./