1:- module(pure,
2 [is_pure_pred/1,
3 is_pure_clause/1,
4 is_pure_body/1
5 ]). 6
7:- use_module(library(lists)). 8:- use_module(library(resolve_calln)). 9:- use_module(library(qualify_meta_goal)). 10
11:- meta_predicate
12 is_pure_pred(0 ),
13 is_pure_body(0 ).
22is_pure_pred(Head) :-
23 is_pure_pred(Head, []).
30is_pure_clause(Ref) :-
31 is_pure_clause(Ref, []).
32
33is_pure_pred(M:Head, Stack1) :-
34 predicate_property(M:Head, interpreted),
35 findall(Ref, ( catch(clause(M:Head, _, Ref), _, fail),
36 \+ memberchk(Ref, Stack1)
37 ), RefL),
38 append(RefL, Stack1, Stack),
39 forall(member(Ref, RefL),
40 is_pure_clause(Ref, Stack)).
41
42is_pure_clause(Ref, Stack) :-
43 clause_property(Ref, module(CM)),
44 catch(clause(M:Head, Body, Ref), _, fail),
45 46 M:Head \== CM:Body,
47 M:call(Head) \== CM:Body,
48 is_pure_body(Body, CM, Stack).
49
54
57
58is_pure_body(M:G) :-
59 is_pure_body(G, M, []).
60
61is_pure_body(G, _, _) :-
62 var(G),
63 !,
64 freeze(G, is_pure_pred(G)).
65is_pure_body(true, _, _) :- !.
66is_pure_body(fail, _, _) :- !.
67is_pure_body(_=_, _, _) :- !.
68is_pure_body(\+ _, _, _) :- !, fail.
69is_pure_body(@(G, CM), _, Stack) :-
70 !,
71 strip_module(CM:G, M, H),
72 is_pure_body_mod(H, M, CM, Stack).
73is_pure_body(M:G, _, Stack) :-
74 !,
75 is_pure_body_mod(G, M, M, Stack).
76is_pure_body((A,B), M, Stack) :-
77 !,
78 is_pure_body(A, M, Stack),
79 is_pure_body(B, M, Stack).
80is_pure_body((A;B), M, Stack) :-
81 !,
82 is_pure_body(A, M, Stack),
83 is_pure_body(B, M, Stack).
84is_pure_body(CallN, M, Stack) :-
85 do_resolve_calln(CallN, Call),
86 is_pure_body(Call, M, Stack).
87is_pure_body(phrase(DCG, L, T), M, Stack) :-
88 !,
89 dcg_translate_rule(('$head$' --> DCG, '$sink$'), _, ('$head$'(L, _) :- Lits, '$sink$'(T, _)), _),
90 is_pure_body(Lits, M, Stack).
91is_pure_body(phrase(DCG, L), M, Stack) :-
92 !,
93 is_pure_body(phrase(DCG, L, []), M, Stack).
94is_pure_body(H, M, Stack) :-
95 ( predicate_property(M:H, meta_predicate(Meta))
96 ->qualify_meta_goal(M:H, Meta, Goal)
97 ; Goal = H
98 ),
99 is_pure_pred(M:Goal, Stack).
100
114
115is_pure_body_mod(H, M, _, Stack) :-
116 is_pure_body(H, M, Stack)