Copyright (c) 2018 Neil Hoskins
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28:- module(fld, [ 29 fld_object/2, 30 fld_default/2, 31 fld/2, 32 flds/2, 33 fld_set/3, 34 flds_set/3, 35 fld_template/2, 36 fld_template/3, 37 fld_fields/2]). 38 39:- meta_predicate fld:fld_template(,,). 40 41:- discontiguous(fld:fld_object_def/2). 42:- multifile(fld_object_def/2). 43 44:- discontiguous(fld_object/2). 45:- multifile(fld_object/2).
49:- discontiguous(fld/2). 50:- multifile(fld/2). 51 52:- discontiguous(flds/2). 53:- multifile(flds/2).
57:- discontiguous(fld_set/3). 58:- multifile(fld_set/3).
62:- discontiguous(fld_default/2). 63:- multifile(fld_default/2). 64 65 66fld_object(Name, Fields) :- fld_object_def(Name, Fields).
71fld_template(Name, Template) :- 72 fld_template(Name, Template, fld_default). 73 74% ! fld_template(?Name:atom, ?Template:list, ++Goal:callable) is nondet. 75% template is an object with all fields as uninstaniated variables. 76% Goal determines the defaults for the fields or if there is not default 77% for a field then an uninstantiated variable is used. 78fld_template(Name, Template, Goal) :- 79 fld_object_def(Name, Flds), 80 81 length(Flds, Len), 82 length(TemplateFlds, Len), 83 Template =.. [Name|TemplateFlds], 84 callable(Goal) -> 85 maplist(fld_add_default(Goal), Flds, TemplateFlds) 86 ; 87 true. 88 89fld_add_default(Goal, Field, Value) :- 90 call(Goal, Field, Value) -> true ; true. 91 92blank_template(_,_).
fld_object(Name, Flds) :- fld_object_def(Name, Flds), !.100generate_flds([], _, _, _, []). 101generate_flds([F|T], Name, Len, N, [fld:fld(Fld, Obj), fld:fld_set(Fld, SetObj, NewObj)|Rest]) :- 102 103 % the field that will be the first argument 104 Fld =.. [F, X], 105 106 % the getter 107 obj(Name, Len, Obj, Flds), 108 fld_arg(X, Flds, N), 109 110 % the setter 111 obj(Name, Len, SetObj, SetObjFlds), 112 obj(Name, Len, NewObj, NewObjFlds), 113 fld_set_arg(X, SetObjFlds, NewObjFlds, N), 114 115 % next field uses the next argument 116 N1 is N + 1, 117 generate_flds(T, Name, Len, N1, Rest). 118 119 120% helper to generate blank objects 121obj(Name, Len, Obj, Flds) :- 122 length(Flds, Len), 123 Obj =.. [Name|Flds]. 124 125 126% generate the second argument of the getter 127fld_arg(Val, [Val|_], 0). 128fld_arg(Val, [_|T], N) :- 129 dif(N,0), 130 N1 is N - 1, 131 fld_arg(Val, T, N1). 132 133% generate the second and third arguments of the setter 134fld_set_arg(_, [], [], _). 135fld_set_arg(Val, [F|T], [F|Nt], N) :- 136 dif(N,0), 137 N1 is N - 1, 138 fld_set_arg(Val, T, Nt, N1). 139fld_set_arg(Val, [_|T], [Val|Nt], 0) :- 140 fld_set_arg(Val, T, Nt, -1). 141 142systemterm_expansion(':-'(fld_object(Name, Flds)), [fld:fld_object_def(Name, Flds)|GetSet]) :- 143 \+ fld_object_def(Name, Flds), 144 length(Flds, Len), 145 generate_flds(Flds, Name, Len, 0, GetSet).
150fld_fields(Obj, Fields) :- 151 Obj =.. [Name|Vals], 152 fld_object_def(Name, Flds), 153 maplist(fld_field_object,Flds,Vals,Fields). 154 155fld_field_object(FldName,Value,Field) :- Field =.. [FldName,Value]. 156 157 158 159 160% expand the type specific goals to be efficient 161% to do this look for a name of <type>_flds and expand this to use the 162% actual object rather than the fld lookup method 163resolve_fld(Template, Getter) :- 164 fld(Getter, Template) 165 ; 166 Template =.. [Name|_], 167 throw(fld_error(Getter, Name, 'fld mapping not found for object')). 168 169systemgoal_expansion(Flds, (Object = Template)) :- 170 Flds =.. [Name,List,Object], 171 atom(Name), 172 atom_concat(FldType, '_flds', Name), 173 fld_template(FldType, Template, blank_template), 174 maplist(resolve_fld(Template), List). 175 176 177% expand the flds term to use the multiple fld terms instead 178% this is signifiantly faster that using a list, but can fail if the field does not exist. 179flds_to_fld([], _, Last, Last). 180flds_to_fld([Fld|T], Object, Last, ','(Last, Result)) :- 181 flds_to_fld(T, Object, fld(Fld, Object), Result). 182 183flds_to_fld([Fld|T], Object, Result) :- 184 flds_to_fld(T, Object, fld(Fld, Object), Result). 185 186systemgoal_expansion(flds(Flds, Object), Result) :- 187 flds_to_fld(Flds, Object, Result). 188 189% expand the <type>_flds_set to use two objects instead of a recursive list 190% throw an error if the field is not present in the template 191flds_set([], O, O). 192flds_set([F|T], Obj, Newer) :- 193 fld_set(F, Obj, New) -> flds_set(T, New, Newer) 194 ; 195 Obj =.. [Name|_], 196 throw(fld_error(F, Name, 'fld mapping not found for object')). 197 198systemgoal_expansion(Flds, (Object = Template, NewObject = SetTemplate)) :- 199 Flds =.. [Name,List,Object,NewObject], 200 atom(Name), 201 atom_concat(FldType, '_flds_set', Name), 202 fld_template(FldType, Template, blank_template), 203 fld_template(FldType, SetTemplate, blank_template), 204 flds_set(List, Template, SetTemplate)