34
35:- module(prolog_metainference,
36 [ infer_meta_predicate/2, 37 inferred_meta_predicate/2 38 ]). 39:- autoload(library(apply),[maplist/4]). 40:- autoload(library(lists),[append/3]). 41
42
43:- meta_predicate
44 inferred_meta_predicate(:, ?),
45 infer_meta_predicate(:, -). 46
47:- dynamic
48 inferred_meta_pred/3. 49
64
65
70
71inferred_meta_predicate(M:Head, MetaSpec) :-
72 inferred_meta_pred(Head, M, MetaSpec).
73inferred_meta_predicate(M:Head, MetaSpec) :-
74 predicate_property(M:Head, imported_from(From)),
75 inferred_meta_pred(Head, From, MetaSpec).
76
77
83
84infer_meta_predicate(Head, MetaSpec) :-
85 inferred_meta_predicate(Head, MetaSpec),
86 !.
87infer_meta_predicate(M:Head, MetaSpec) :-
88 predicate_property(M:Head, imported_from(From)),
89 !,
90 do_infer_meta_predicate(From:Head, MetaSpec),
91 assertz(inferred_meta_pred(Head, From, MetaSpec)).
92infer_meta_predicate(M:Head, MetaSpec) :-
93 do_infer_meta_predicate(M:Head, MetaSpec),
94 assertz(inferred_meta_pred(Head, M, MetaSpec)).
95
96:- meta_predicate
97 do_infer_meta_predicate(:, -). 98
99do_infer_meta_predicate(Module:AHead, MetaSpec):-
100 functor(AHead, Functor, Arity),
101 functor(Head, Functor, Arity), 102 findall(MetaSpec,
103 meta_pred_args_in_clause(Module, Head, MetaSpec),
104 MetaSpecs),
105 MetaSpecs \== [],
106 combine_meta_args(MetaSpecs, MetaSpec).
107
108
110
111meta_pred_args_in_clause(Module, Head, MetaArgs) :-
112 clause(Module:Head, Body),
113 annotate_meta_vars_in_body(Body, Module),
114 meta_annotation(Head, MetaArgs).
115
116
129
130annotate_meta_vars_in_body(A, _) :-
131 atomic(A),
132 !.
133annotate_meta_vars_in_body(Var, _) :-
134 var(Var),
135 !,
136 annotate(Var, 0).
137annotate_meta_vars_in_body(Module:Term, _) :-
138 !,
139 ( atom(Module)
140 -> annotate_meta_vars_in_body(Term, Module)
141 ; var(Module)
142 -> annotate(Module, m)
143 ; true 144 ). 145annotate_meta_vars_in_body((TermA, TermB), Module) :-
146 !,
147 annotate_meta_vars_in_body(TermB, Module),
148 annotate_meta_vars_in_body(TermA, Module).
149annotate_meta_vars_in_body((TermA; TermB), Module) :-
150 !,
151 annotate_meta_vars_in_body(TermB, Module),
152 annotate_meta_vars_in_body(TermA, Module).
153annotate_meta_vars_in_body((TermA->TermB), Module) :-
154 !,
155 annotate_meta_vars_in_body(TermB, Module),
156 annotate_meta_vars_in_body(TermA, Module).
157annotate_meta_vars_in_body((TermA*->TermB), Module) :-
158 !,
159 annotate_meta_vars_in_body(TermB, Module),
160 annotate_meta_vars_in_body(TermA, Module).
161annotate_meta_vars_in_body(A=B, _) :-
162 var(A), var(B),
163 !,
164 A = B.
165annotate_meta_vars_in_body(Goal, Module) :- 166 predicate_property(Module:Goal, meta_predicate(Head)),
167 !,
168 functor(Goal, _, Arity),
169 annotate_meta_args(1, Arity, Goal, Head, Module).
170annotate_meta_vars_in_body(Goal, Module) :-
171 inferred_meta_predicate(Module:Goal, Head),
172 !,
173 functor(Goal, _, Arity),
174 annotate_meta_args(1, Arity, Goal, Head, Module).
175annotate_meta_vars_in_body(_, _).
176
177
179
180annotate_meta_args(I, Arity, Goal, MetaSpec, Module) :-
181 I =< Arity,
182 !,
183 arg(I, MetaSpec, MetaArg),
184 arg(I, Goal, Arg),
185 annotate_meta_arg(MetaArg, Arg, Module),
186 I2 is I + 1,
187 annotate_meta_args(I2, Arity, Goal, MetaSpec, Module).
188annotate_meta_args(_, _, _, _, _).
189
190annotate_meta_arg(Spec, Arg, _) :-
191 var(Arg),
192 !,
193 annotate(Arg, Spec).
194annotate_meta_arg(0, Arg, Module) :-
195 !,
196 annotate_meta_vars_in_body(Arg, Module).
197annotate_meta_arg(N, Arg, Module) :-
198 integer(N),
199 callable(Arg),
200 !,
201 Arg =.. List,
202 length(Extra, N),
203 append(List, Extra, ListX),
204 ArgX =.. ListX,
205 annotate_meta_vars_in_body(ArgX, Module).
206annotate_meta_arg(Spec, Arg, _) :-
207 is_meta(Spec),
208 compound(Arg),
209 Arg = Module:_,
210 var(Module),
211 !,
212 annotate(Module, m).
213annotate_meta_arg(_,_,_).
214
215annotate(Var, Annotation) :-
216 get_attr(Var, prolog_metainference, Annot0),
217 !,
218 join_annotation(Annot0, Annotation, Joined),
219 put_attr(Var, prolog_metainference, Joined).
220annotate(Var, Annotation) :-
221 put_attr(Var, prolog_metainference, Annotation).
222
223join_annotation(A, A, A) :- !.
224join_annotation(A, B, C) :-
225 ( is_meta(A), \+ is_meta(B)
226 -> C = A
227 ; \+ is_meta(A), is_meta(B)
228 -> C = B
229 ; is_meta(A), is_meta(B)
230 -> C = (:)
231 ; C = *
232 ).
233
234attr_unify_hook(A0, Other) :-
235 get_attr(Other, prolog_metainference, A1),
236 !,
237 join_annotation(A0, A1, A),
238 put_attr(Other, prolog_metainference, A).
239
240
245
246meta_annotation(Head, Meta) :-
247 functor(Head, Name, Arity),
248 functor(Meta, Name, Arity),
249 meta_args(1, Arity, Head, Meta, HasMeta),
250 HasMeta == true.
251
252meta_args(I, Arity, Head, Meta, HasMeta) :-
253 I =< Arity,
254 !,
255 arg(I, Head, HeadArg),
256 arg(I, Meta, MetaArg),
257 meta_arg(HeadArg, MetaArg),
258 ( is_meta(MetaArg)
259 -> HasMeta = true
260 ; true
261 ),
262 I2 is I + 1,
263 meta_args(I2, Arity, Head, Meta, HasMeta).
264meta_args(_, _, _, _, _).
265
266is_meta(I) :- integer(I), !.
267is_meta(:).
268is_meta(^).
269is_meta(//).
270
279
280meta_arg(HeadArg, MetaArg) :-
281 get_attr(HeadArg, prolog_metainference, MetaArg),
282 MetaArg \== m,
283 !.
284meta_arg(HeadArg, :) :-
285 compound(HeadArg),
286 HeadArg = M:_,
287 get_attr(M, prolog_metainference, m),
288 !.
289meta_arg(_, *).
290
294
295combine_meta_args([], []) :- !.
296combine_meta_args([List], List) :- !.
297combine_meta_args([Spec,Spec|Specs], CombinedArgs) :-
298 !,
299 combine_meta_args([Spec|Specs], CombinedArgs).
300combine_meta_args([Spec1,Spec2|Specs], CombinedArgs) :-
301 Spec1 =.. [Name|Args1],
302 Spec2 =.. [Name|Args2],
303 maplist(join_annotation, Args1, Args2, Args),
304 Spec =.. [Name|Args],
305 combine_meta_args([Spec|Specs], CombinedArgs)