34
35:- module(wfs,
36 [ call_residual_program/2, 37
38 call_delays/2, 39 delays_residual_program/2, 40 answer_residual/2, 41
42 op(900, fy, tnot)
43 ]). 44:- autoload(library(apply),[maplist/3]). 45:- autoload(library(error),[instantiation_error/1,permission_error/3]). 46:- autoload(library(lists),[list_to_set/2,member/2]).
55:- meta_predicate
56 call_delays(0, :),
57 delays_residual_program(:, :),
58 call_residual_program(0, :),
59 answer_residual(:, :).
70call_delays(Goal, Delays) :-
71 '$wfs_call'(Goal, Delays).
81delays_residual_program(GM:Delays, M:Clauses) :-
82 phrase(residual_program(Delays, GM, [], _), Program),
83 maplist(unqualify_clause(M), Program, Clauses0),
84 list_to_set(Clauses0, Clauses).
90call_residual_program(Goal, M:Clauses) :-
91 '$wfs_call'(Goal, 0:R0), 92 phrase(residual_program(R0, M, [], _), Program),
93 maplist(unqualify_clause(M), Program, Clauses).
94
95
96residual_program(Var, _, _, _) -->
97 { var(Var),
98 !,
99 instantiation_error(Var)
100 }.
101residual_program(M:G, _, Done0, Done) -->
102 !,
103 residual_program(G, M, Done0, Done).
104residual_program(true, _, Done, Done) -->
105 !.
106residual_program(undefined, _, Done, Done) -->
107 !.
108residual_program(G, M, Done, Done) -->
109 { member(M:G2, Done),
110 G2 =@= G
111 }, !.
112residual_program((A;B), M, Done0, Done) -->
113 !,
114 residual_program(A, M, Done0, Done1),
115 residual_program(B, M, Done1, Done).
116residual_program((A,B), M, Done0, Done) -->
117 !,
118 residual_program(A, M, Done0, Done1),
119 residual_program(B, M, Done1, Done).
120residual_program(tnot(A), M, Done0, Done) -->
121 !,
122 residual_program(A, M, Done0, Done).
123residual_program(Goal0, M, Done0, Done) -->
124 { predicate_property(M:Goal0, imported_from(M2))
125 },
126 !,
127 residual_program(Goal0, M2, Done0, Done).
128residual_program(Goal, M, Done0, Done) -->
129 { M:'$table_mode'(Goal, Variant, ModeArgs),
130 ( current_table(M:Variant, Trie)
131 -> true
132 ; '$tabling':more_general_table(M:Variant, Trie)
133 ),
134 !,
135 '$tbl_table_status'(Trie, _Status, M:Variant, Skeleton),
136 copy_term(Skeleton, Skeleton2),
137 ( ( '$tbl_is_trienode'(ModeArgs)
138 -> '$tbl_answer'(Trie, Skeleton2, Condition0)
139 ; '$tbl_answer'(Trie, Skeleton2, ModeArgs, Condition0)
140 ),
141 Skeleton2 =@= Skeleton
142 -> Skeleton2 = Skeleton
143 ),
144 as_cond(Condition0, Condition)
145 },
146 [ (M:Goal :- Condition) ],
147 residual_program(Condition, M, [M:Goal|Done0], Done).
148residual_program(Goal, M, Done, Done) -->
149 { format(user_error, 'OOPS: Missing Call? ~p', [M:Goal])
150 },
151 [ (M:Goal :- ???) ].
152
153as_cond((M:Variant)/ModeArgs, M:Goal) :-
154 !,
155 M:'$table_mode'(Goal, Variant, ModeArgs).
156as_cond(Goal, Goal).
157
158unqualify_clause(M, (Head0 :- Body0), (Head :- Body)) :-
159 unqualify(Head0, M, Head),
160 unqualify(Body0, M, Body).
169answer_residual(Goal, M:Residual) :-
170 predicate_property(Goal, tabled(_)),
171 !,
172 '$tbl_variant_table'(VariantTrie),
173 trie_gen(VariantTrie, Goal, Trie),
174 '$tbl_table_status'(Trie, _Status, Goal, Skeleton),
175 '$tbl_answer'(Trie, Skeleton, Condition),
176 unqualify(Condition, M, Residual).
177answer_residual(Goal, _) :-
178 permission_error(answer_residual, non_tabled_procedure, Goal).
179
180unqualify((A0;B0), M, G) :-
181 !,
182 G = (A;B),
183 unqualify(A0, M, A),
184 unqualify(B0, M, B).
185unqualify((A0,B0), M, G) :-
186 !,
187 G = (A,B),
188 unqualify(A0, M, A),
189 unqualify(B0, M, B).
190unqualify(tnot(A0), M, G) :-
191 !,
192 G = tnot(A),
193 unqualify(A0, M, A).
194unqualify(M:G0, MG, G) :-
195 '$c_current_predicate'(_, MG:G0),
196 predicate_property(MG:G0, imported_from(M)),
197 !,
198 G = G0.
199unqualify(M:G0, M, G) :-
200 !,
201 G = G0.
202unqualify(system:G0, _, G) :-
203 !,
204 G = G0.
205unqualify(G, _, G)
Well Founded Semantics interface
The library(wfs) provides the user interface to the Well Founded Semantics (WFS) support in SWI-Prolog. */