dictype - a directive for concise dict type definition @author Avery Katko @version 0.0.1 @license MIT */

    7:- module(dictype, [dictype/1, op(1150, fx, dictype)]).    8
    9:- use_module(library(error)).   10:- use_module(library(mavis)).   11:- use_module(library(pairs)).   12
   13:- op(1150, fx, dictype).
 dict_type(Dict:dict, Type:dict)
body for has_type clauses asserted by dictype directive
   17dict_type(Dict, Type) :-
   18	is_dict(Dict, Tag),
   19	is_dict(Type, Tag),
   20	dict_pairs(Dict, Tag, DictPairs),
   21	dict_pairs(Type, Tag, TypePairs),
   22	keysort(DictPairs, DictSorted),
   23	keysort(TypePairs, TypeSorted),
   24	pairs_keys_values(DictSorted, Keys, DictValues),
   25	pairs_keys_values(TypeSorted, Keys, TypeValues),
   26	maplist(the, TypeValues, DictValues).
 dictype(+Spec:compound) is det
directive to register dict types specified by dicts of the form typename{field1: type1, field2: type2, ...}
   30dictype Spec :-
   31	is_dict(Spec, Tag),
   32	assertz((error:has_type(Tag, Dict) :- dict_type(Dict, Spec))).
   33
   34dictype Spec1, Spec2 :-
   35	(dictype Spec1),
   36	(dictype Spec2)