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