SHOW:
|
|
- or go back to the newest paste.
1 | /* Part of LogicMOO Base Logicmoo Debug Tools | |
2 | % =================================================================== | |
3 | % File '$FILENAME.pl' | |
4 | % Purpose: An Implementation in SWI-Prolog of certain debugging tools | |
5 | % Maintainer: Douglas Miles | |
6 | % Contact: $Author: dmiles $@users.sourceforge.net ; | |
7 | % Version: '$FILENAME.pl' 1.0.0 | |
8 | % Revision: $Revision: 1.1 $ | |
9 | % Revised At: $Date: 2002/07/11 21:57:28 $ | |
10 | % Licience: LGPL | |
11 | % =================================================================== | |
12 | */ | |
13 | ||
14 | :- module(mpred_pfc_d, [ | |
15 | - | with_umt/1, |
15 | + | call_u/1, |
16 | mpred_ain/1,mpred_ain/1,mpred_ain/2, | |
17 | action_is_undoable/1, | |
18 | mpred_assumption/1,mpred_assumptions/2,mpred_axiom/1,bagof_or_nil/3,bases_union/2,brake/1,build_rhs/2, | |
19 | build_neg_test/3,build_rule/3,build_test/2,build_trigger/3, | |
20 | defaultmpred_select/1,fc_eval_action/2, | |
21 | - | foreachl_do/2,get_next_fact/1,if_mooZz/2,mpred_justification/2,mpred_justification_S/2,mpred_BC/1,mpred_BC_CACHE/1,mpred_CALL/1, |
21 | + | foreachl_do/2,get_next_fact/1, |
22 | - | mpred_CALL/2,mpred_CALL/3,mpred_CALL_MI/3,mpred_halt/0,mpred_halt/1,mpred_halt/2, |
22 | + | mpred_justification/2,mpred_justification_S/2,mpred_BC/1,mpred_BC_CACHE/1,mpred_CALL/1,mpred_CALL/2,mpred_CALL/3,mpred_CALL_MI/3, |
23 | - | mpred_ain_db_to_head/2,mpred_ain_actiontrace/2,mpred_ain_special_support/2,mpred_add_support/2,mpred_ain_trigger_reprop/2, |
23 | + | mpred_halt/0,mpred_halt/1,mpred_halt/2, |
24 | mpred_ain_db_to_head/2,mpred_ain_actiontrace/2,mpred_trace_op/2,mpred_add_support/2,mpred_ain_trigger_reprop/2, | |
25 | mpred_ain_by_type/2, | |
26 | mpred_prompt_ask/2, | |
27 | mpred_CALL_MI/3,mpred_BC_w_cache/1, | |
28 | format_to_message/3, | |
29 | ||
30 | - | mpred_fact/2,mpred_facts/1,mpred_facts/2,mpred_facts/3,mpred_fwc/1,mpred_get_support/2,mpred_get_trigger_quick/1, |
30 | + | |
31 | mpred_classifyFacts/4,mpred_collect_supports/1,mpred_unhandled_command/3,mpred_compile_rhs_term/2,mpred_conjoin/3,mpred_connective/1, | |
32 | mpred_database_item/1,mpred_database_term/1,mpred_db_type/2,mpred_set_default/2,mpred_define_bc_rule/3,mpred_descendant/2, | |
33 | - | mpred_nospy/0,mpred_nospy/1,mpred_nospy/3,mpred_positive_literal/1,mpred_post/2,lqu/0,mpred_rem_actionTrace/1, |
33 | + | |
34 | mpred_fact/2,mpred_facts/1,mpred_facts/2,mpred_facts/3,mpred_fwc/1,mpred_get_support/2,lookup_u/1,lookup_u/2, | |
35 | mpred_literal/1,mpred_load/1,mpred_make_supports/1,mpred_ain_object/1,mpred_aina/2,mpred_ainz/2, | |
36 | mpred_negated_literal/1,mpred_negation/2,mpred_nf/2,mpred_nf1_negation/2,mpred_nf_negation/2,mpred_nf_negations/2,mpred_noTrace/0,mpred_noWatch/0, | |
37 | - | mpred_trace/0,mpred_trace/1,mpred_trace/2,mpred_trace_add_print/2,mpred_trace_break/2,mpred_trace_exec/0,mpred_trace_mpred_ain/1, |
37 | + | mpred_nospy/0,mpred_nospy/1,mpred_nospy/3,mpred_positive_literal/1,mpred_post/2,lqu/0,mpred_undo_action/1, |
38 | - | mpred_trace_mpred_ain/2,mpred_trace_msg/1,mpred_trace_msg/2,mpred_trace_rem/1,mpred_trigger_key/2,mpred_trigger_key/2,mpred_undo/1,mpred_unfwc/1, |
38 | + | |
39 | mpred_retract_type/2,mpred_select_justification_node/3,mpred_set_warnings/1,mpred_pp_justifications/2, | |
40 | mpred_spy/1,mpred_spy/2,mpred_spy/3,mpred_step/0,mpred_support_relation/1,mpred_supported/1,mpred_supported/2, | |
41 | mpred_trace/0,mpred_trace/1,mpred_trace/2,mpred_trace_maybe_print/3,mpred_trace_maybe_break/3,mpred_trace_exec/0,mpred_trace_op/3, | |
42 | mpred_trace_op/2,mpred_trace_msg/1,mpred_trace_msg/2,mpred_trigger_key/2,mpred_trigger_key/2,mpred_undo/1,mpred_unfwc/1, | |
43 | - | remove_if_unsupported/1,remove_selection/1, |
43 | + | |
44 | mpred_warn/2,mpred_watch/0,well_founded_0/2,mpred_why/0,mpred_why/1,mpred_whyBrouse/2,mpred_handle_why_command/3, | |
45 | - | mpred_run/0,mpred_test/1, |
45 | + | |
46 | pp_rules/0,pp_supports/0,pp_triggers/0,mpred_load/1,process_rule/3, | |
47 | remove_if_unsupported/1,remove_selection/1,mpred_withdraw1/2, | |
48 | ||
49 | mpred_run/0,mpred_test/1,mpred_test_fok/1, | |
50 | ||
51 | call_u/1,call_u2/2,asserta_u/1,assert_u/1,assertz_u/1,retract_u/1,retractall_u/1,clause_u/2,clause_u/3,get_umt/1,lookup_u/1, | |
52 | ||
53 | stop_trace/1, | |
54 | select_next_fact/1,supporters_list/2,triggerSupports/2,trigger_trigger/3,well_founded/1,well_founded_list/2, | |
55 | % c_umt/1, | |
56 | do_assumpts/2,mpred_do_fcnt/2,mpred_do_fcpt/2,mpred_fwc1/1,mpred_do_rule/1,mpred_descendant1/3,mpred_eval_rhs1/2,mpred_nf1/2, | |
57 | - | bagof_or_nil(?, ^, -), |
57 | + | |
58 | - | brake(0), |
58 | + | |
59 | - | call_u(0), |
59 | + | |
60 | - | fc_eval_action(0, ?), |
60 | + | |
61 | - | foreachl_do(0, ?), |
61 | + | get_umt(-), |
62 | - | mpred_CALL(1, +), |
62 | + | with_each_item(2,+,+), |
63 | - | mpred_fact(?, 0), |
63 | + | with_each_item(1,+), |
64 | - | with_each_item(1,+), |
64 | + | pfcl_do(0), |
65 | - | with_each_item(2,+,+), |
65 | + | mpred_get_support(+,-), |
66 | - | pfcl_do(0). |
66 | + | mpred_fact(?,0), |
67 | mpred_CALL_MI(1,-,+), | |
68 | - | :- module_transparent(( bagof_or_nil/3,brake/1,call_u/1,fc_eval_action/2,foreachl_do/2,mpred_CALL/2,mpred_fact/2,pfcl_do/1 )). |
68 | + | mpred_CALL(1,-,+), |
69 | mpred_CALL(1,+), | |
70 | - | :- user:dynamic(( |
70 | + | mpred_CALL(+), |
71 | mpred_BC(+), | |
72 | mpred_BC_CACHE(+), | |
73 | foreachl_do(0,-), | |
74 | fc_eval_action(0,-), | |
75 | - | mpred_is_tracing_pred/1,mpred_is_tracing_exec/0,mpred_is_spying_pred/2,mpred_warnings/1,why_buffer/2, % for debugging |
75 | + | clause_u(+,+,-), |
76 | call_u(+), | |
77 | - | user:term_expansion/2)). |
77 | + | call_u2(+), |
78 | - | :- user:multifile(( |
78 | + | brake(0), |
79 | bagof_or_nil(?,^,-). | |
80 | ||
81 | :- module_transparent(mpred_pfc_d:(call_u)/1). | |
82 | ||
83 | - | mpred_is_tracing_pred/1,mpred_is_tracing_exec/0,mpred_is_spying_pred/2,mpred_warnings/1,why_buffer/2, % for debugging |
83 | + | :- module_transparent(( bagof_or_nil/3,brake/1,call_u/1,fc_eval_action/2,foreachl_do/2,mpred_CALL/2,mpred_fact/2,pfcl_do/1, |
84 | call_u/1,asserta_u/1,assert_u/1,assertz_u/1,retract_u/1,retractall_u/1,clause_u/2,clause_u/3, | |
85 | - | user:term_expansion/2)). |
85 | + | mpred_handle_why_command/2,mpred_run/0,mpred_test/1,mpred_test_fok/1, |
86 | ||
87 | call_u/1,get_umt/1, | |
88 | mpred_ain/1,mpred_ain/1,mpred_ain/2, | |
89 | action_is_undoable/1, | |
90 | mpred_assumption/1,mpred_assumptions/2,mpred_axiom/1,bagof_or_nil/3,bases_union/2,brake/1,build_rhs/2, | |
91 | build_neg_test/3,build_rule/3,build_test/2,build_trigger/3, | |
92 | defaultmpred_select/1,fc_eval_action/2, | |
93 | foreachl_do/2,get_next_fact/1, | |
94 | mpred_justification/2,mpred_justification_S/2,mpred_BC/1,mpred_BC_CACHE/1,mpred_CALL/1,mpred_CALL/2,mpred_CALL/3,mpred_CALL_MI/3, | |
95 | mpred_halt/0,mpred_halt/1,mpred_halt/2, | |
96 | mpred_ain_db_to_head/2,mpred_ain_actiontrace/2,mpred_trace_op/2,mpred_add_support/2,mpred_ain_trigger_reprop/2, | |
97 | mpred_ain_by_type/2, | |
98 | mpred_prompt_ask/2, | |
99 | ||
100 | ||
101 | mpred_assert_w_support/2,mpred_asserta_w_support/2,mpred_assertz_w_support/2,mpred_basis_list/2,mpred_bt_pt_combine/3,mpred_child/2,mpred_children/2, | |
102 | mpred_classifyFacts/4,mpred_collect_supports/1,mpred_unhandled_command/3,mpred_compile_rhs_term/2,mpred_conjoin/3,mpred_connective/1, | |
103 | mpred_database_item/1,mpred_database_term/1,mpred_db_type/2,mpred_set_default/2,mpred_define_bc_rule/3,mpred_descendant/2, | |
104 | mpred_descendants/2,mpred_enqueue/2,mpred_error/1,mpred_error/2,mpred_eval_lhs/2,mpred_eval_rhs/2,mpred_fact/1, | |
105 | mpred_fact/2,mpred_facts/1,mpred_facts/2,mpred_facts/3,mpred_fwc/1,mpred_get_support/2,lookup_u/1,lookup_u/2, | |
106 | mpred_literal/1,mpred_load/1,mpred_make_supports/1,mpred_ain_object/1,mpred_aina/2,mpred_ainz/2, | |
107 | mpred_negated_literal/1,mpred_negation/2,mpred_nf/2,mpred_nf1_negation/2,mpred_nf_negation/2,mpred_nf_negations/2,mpred_noTrace/0,mpred_noWatch/0, | |
108 | mpred_nospy/0,mpred_nospy/1,mpred_nospy/3,mpred_positive_literal/1,mpred_post/2,lqu/0,mpred_undo_action/1, | |
109 | ||
110 | mpred_rem_support/2,mpred_remove_old_version/1,mpred_remove_supports/1,mpred_remove_supports_quietly/1,mpred_reset/0,mpred_retract/1,mpred_retract_i_or_warn/1,mpred_retract_supported_relations/1, | |
111 | mpred_retract_type/2,mpred_select_justification_node/3,mpred_set_warnings/1,mpred_pp_justifications/2, | |
112 | mpred_spy/1,mpred_spy/2,mpred_spy/3,mpred_step/0,mpred_support_relation/1,mpred_supported/1,mpred_supported/2, | |
113 | mpred_trace/0,mpred_trace/1,mpred_trace/2,mpred_trace_maybe_print/3,mpred_trace_maybe_break/3,mpred_trace_exec/0,mpred_trace_op/3, | |
114 | mpred_trace_op/2,mpred_trace_msg/1,mpred_trace_msg/2,mpred_trigger_key/2,mpred_trigger_key/2,mpred_undo/1,mpred_unfwc/1, | |
115 | mpred_unfwc_check_triggers/1,mpred_union/3,mpred_unique_u/1,mpred_untrace/0,mpred_untrace/1,mpred_warn/0,mpred_warn/1, | |
116 | - | :- dynamic(c_umt/1). |
116 | + | mpred_warn/2,mpred_watch/0,well_founded_0/2,mpred_why/0,mpred_why/1,mpred_whyBrouse/2,mpred_handle_why_command/3, |
117 | - | get_umt(C):- c_umt(C). |
117 | + | nompred_warn/0,pfcl_do/1,pp_DB/0,pp_facts/0,pp_facts/1,pp_facts/2,pp_items/1, |
118 | pp_rules/0,pp_supports/0,pp_triggers/0,mpred_load/1,process_rule/3, | |
119 | remove_if_unsupported/1,remove_selection/1,mpred_withdraw1/2, | |
120 | ||
121 | ||
122 | - | set_umt(M):- |
122 | + | |
123 | - | ('$set_source_module'(_,M),'$module'(_,M)), |
123 | + | mpred_justification/2,mpred_justification_S/2,mpred_BC/1,mpred_BC_CACHE/1,mpred_CALL/1,mpred_CALL/2,mpred_CALL/3,mpred_CALL_MI/3, |
124 | ||
125 | - | forall(mpred_database_term(F/A),(dynamic(M:F/A),discontiguous(M:F/A),multifile(M:F/A))), |
125 | + | |
126 | - | retractall(get_umt(_M)),asserta(get_umt(M)). |
126 | + | |
127 | mpred_run/0,mpred_test/1,mpred_test_fok/1, | |
128 | ||
129 | stop_trace/1, | |
130 | - | :- meta_predicate with_umt(0). |
130 | + | |
131 | - | :- meta_predicate mpred_test(+). |
131 | + | |
132 | do_assumpts/2,mpred_do_fcnt/2,mpred_do_fcpt/2,mpred_fwc1/1,mpred_do_rule/1,mpred_descendant1/3,mpred_eval_rhs1/2,mpred_nf1/2, | |
133 | - | % with_umt(G):- !, G. |
133 | + | |
134 | - | with_umt(G):- get_umt(U), |
134 | + | mpred_unfwc1/1,mpred_why1/1,mpred_blast/1,trigger_trigger1/2, |
135 | ||
136 | mpred_why/1,supporters_list/2, mpred_justification/2 )). | |
137 | - | call_cleanup(G, |
137 | + | |
138 | :- thread_local(t_l:c_umt/1). | |
139 | ||
140 | set_umt(M):- must(atom(M)), | |
141 | - | listing_u(P):-with_umt(listing(P)). |
141 | + | ( |
142 | - | call_u(G):- with_umt(G). |
142 | + | '$set_source_module'(_,M),'$module'(_,M)), |
143 | - | assert_u(A):-get_umt(M),assert(M:A). |
143 | + | |
144 | - | asserta_u(A):-get_umt(M),asserta(M:A). |
144 | + | forall(mpred_database_term(F/A),(M:dynamic(M:F/A),M:discontiguous(M:F/A),M:multifile(M:F/A))), |
145 | - | assertz_u(A):-get_umt(M),assertz(M:A). |
145 | + | retractall(t_l:c_umt(_M)),asserta(t_l:c_umt(M)). |
146 | ||
147 | setup_mpred_support(M):- | |
148 | must(atom(M)), | |
149 | M:dynamic(M:( | |
150 | - | clause_u(H,B,R):- get_umt(M), M:clause(H,B,R). |
150 | + | |
151 | spft/3,nt/3,pt/2,bt/2,actn/1,qu/1,hs/1, % forward/backward chaining state | |
152 | mpred_current_db/1,mpred_select_hook/1,tms/1,sm/1, % forward/backward settings | |
153 | mpred_is_tracing_pred/1,mpred_is_tracing_exec/0,mpred_is_spying_pred/2,mpred_warnings/1,why_buffer/2 % for debugging | |
154 | - | call_u(G):- (G). |
154 | + | )), |
155 | ||
156 | M:multifile(M:( | |
157 | (::::)/2, (<-)/2, (<==>)/2, (==>)/2, (==>)/1, (~)/1, do_and_undo/2, % mined from program database | |
158 | spft/3,nt/3,pt/2,bt/2,actn/1,qu/1,hs/1, % forward/backward chaining state | |
159 | mpred_current_db/1,mpred_select_hook/1,tms/1,sm/1, % forward/backward settings | |
160 | mpred_is_tracing_pred/1,mpred_is_tracing_exec/0,mpred_is_spying_pred/2,mpred_warnings/1,why_buffer/2 % for debugging | |
161 | )). | |
162 | ||
163 | ||
164 | ||
165 | ||
166 | % ================================================= | |
167 | % ============== UTILS BEGIN ============== | |
168 | % ================================================= | |
169 | ||
170 | ||
171 | - | with_each_item(P,HV,S):- var(HV),!,with_umt(call(P,HV,S)). |
171 | + | |
172 | op(500,fx,'-'), | |
173 | - | with_each_item(P,[H|T],S) :- !, with_umt(call(P,H,S)), with_each_item(P,T,S). |
173 | + | |
174 | - | with_each_item(P,(H,T),S) :- !,with_umt(with_each_item(P,H,S)), with_each_item(P,T,S). |
174 | + | |
175 | - | with_each_item(P,H,S) :- with_umt(call(P,H,S)). |
175 | + | |
176 | op(1050,xfx,('<-')), | |
177 | op(1100,fx,('==>')), | |
178 | op(1150,xfx,('::::')), | |
179 | op(500,fx,user:'-'), | |
180 | op(300,fx,user:'~'), | |
181 | - | with_each_item(P,HV):- var(HV),!,with_umt(call(P,HV)). |
181 | + | |
182 | op(1050,xfx,user:'<==>'), | |
183 | - | with_each_item(P,[H|T]) :- !, with_umt(call(P,H)), with_each_item(P,T). |
183 | + | |
184 | op(1100,fx,(user:'==>')), | |
185 | - | with_each_item(P,H) :- with_umt(call(P,H)). |
185 | + | |
186 | :- setup_mpred_ops. | |
187 | ||
188 | ||
189 | get_source_ref((X,X)):- get_source_ref1(X). | |
190 | get_source_ref1(M):- (get_umt(M)->true;(atom(M)->(module_property(M,class(_)),!);(var(M),module_property(M,class(_))))). | |
191 | ||
192 | % not just user modules | |
193 | % get_umt(C):- !, C = fred. | |
194 | get_umt(C):- t_l:c_umt(C). | |
195 | get_umt(C):- '$set_source_module'(C,C). | |
196 | % get_umt(mpred_pfc_d). | |
197 | ||
198 | ||
199 | ||
200 | % :- get_umt(M),!, M:dynamic((M:spft/3,M:why_buffer/2,M:current_ooZz/1,M:if_mooZz/2)). | |
201 | ||
202 | :- meta_predicate call_u(+). | |
203 | :- meta_predicate mpred_test(+),mpred_test_fok(+). | |
204 | ||
205 | %:- if(\+ current_prolog_flag(umt_local,false)). | |
206 | ||
207 | listing_u(P):-call_u(listing(P)). | |
208 | assert_u(A0):- strip_module(A0,_,A),get_umt(M),assert(M:A). | |
209 | - | :- meta_predicate brake(0). |
209 | + | asserta_u(A0):- strip_module(A0,_,A), get_umt(M),asserta(M:A). |
210 | - | :- meta_predicate fc_eval_action(0,*). |
210 | + | assertz_u(A0):- strip_module(A0,_,A), get_umt(M),assertz(M:A). |
211 | - | :- meta_predicate foreachl_do(0,*). |
211 | + | retract_u(M:(H:-B)):- atom(M),!, clause_u(H,B,R),erase(R). |
212 | - | :- meta_predicate pfcl_do(0). |
212 | + | |
213 | - | :- meta_predicate mpred_fact(*,0). |
213 | + | retract_u(H0):- strip_module(H0,_,H),!, clause_u(H,true,R),erase(R). |
214 | - | :- meta_predicate with_umt(0). |
214 | + | |
215 | - | :- meta_predicate call_u(0). |
215 | + | |
216 | - | :- meta_predicate bagof_or_nil(?,^,-). |
216 | + | |
217 | - | :- meta_predicate mpred_CALL(1,+). |
217 | + | clause_u(_:H,B,R):- !, get_umt(M), M:clause(H,B,R). |
218 | clause_u(H,B,R):- get_umt(M), M:clause(M:H,B,R). | |
219 | ||
220 | - | :- dynamic('user:term_expansion'/2). |
220 | + | lookup_u(Trigger):- clause_u(Trigger,B),call(B). |
221 | - | :- multifile('user:term_expansion'/2). |
221 | + | lookup_u(Trigger,Ref):- clause_u(Trigger,B,Ref),call(B). |
222 | - | :- dynamic((why_buffer/2)). |
222 | + | |
223 | call_u(G0):- | |
224 | strip_module(G0,_,G),functor(G,F,A), | |
225 | - | user:term_expansion((P==>Q),(:- mpred_ain((P==>Q)))):- mpred_te. |
225 | + | (memberchk(F/A,[(',')/2])-> |
226 | - | %user:term_expansion((P==>Q),(:- mpred_ain(('<-'(Q,P))))):- mpred_te. % speed-up attempt |
226 | + | mpred_CALL(call_u,G); |
227 | - | user:term_expansion(('<-'(P,Q)),(:- mpred_ain(('<-'(P,Q))))):- mpred_te. |
227 | + | call_u2(G0)). |
228 | - | user:term_expansion((P<==>Q),(:- mpred_ain((P<==>Q)))):- mpred_te. |
228 | + | |
229 | - | user:term_expansion((_ruleName :::: Rule),(:- mpred_ain((_ruleName :::: Rule)))):- mpred_te. |
229 | + | call_u2(G0):- |
230 | - | user:term_expansion((==>P),(:- mpred_ain(P))):- mpred_te. |
230 | + | strip_module(G0,WM,G), |
231 | get_umt(U), | |
232 | must(current_predicate(_,U:G)->(CALL=U:G);(current_predicate(_,WM:G0)->CALL=WM:G0; fail)), | |
233 | '$set_source_module'(S,U), | |
234 | '$module'(M,U), | |
235 | - | lqu:- with_umt(listing(qu/1)). |
235 | + | call_cleanup(CALL, |
236 | ('$set_source_module'(_,S),'$module'(_,M))). | |
237 | ||
238 | ||
239 | %:- else. | |
240 | /* | |
241 | listing_u(P):- (listing(P)). | |
242 | assert_u(A):- assert(A). | |
243 | asserta_u(A):- asserta(A). | |
244 | assertz_u(A):- assertz(A). | |
245 | retract_u((H:-B)):-!, clause_u(H,B,R),erase(R). | |
246 | retract_u(H):-!, clause_u(H,true,R),erase(R). | |
247 | retractall_u(H):- forall(clause_u(H,_,R),erase(R)). | |
248 | clause_u(H,B):- clause_u(H,B,_). | |
249 | clause_u(H,B,R):- clause(H,B,R). | |
250 | call_u(G):- G. | |
251 | */ | |
252 | %:- endif. | |
253 | ||
254 | isSlot(V):- is_ftVar(V). | |
255 | ||
256 | %% with_each_item(+P2,+HT,+S) semidet. | |
257 | % | |
258 | % Call P(E,S). each Element in the list. | |
259 | % | |
260 | - | :- mpred_set_default(sm(_), sm(direct)). |
260 | + | with_each_item(P,HV,S):- var(HV),!,call_u2(call(P,HV,S)). |
261 | with_each_item(P,M:HT,S) :- !,must_be(atom,M),M:with_each_item(P,HT,S). | |
262 | with_each_item(P,[H|T],S) :- !, call_u2(call(P,H,S)), with_each_item(P,T,S). | |
263 | with_each_item(P,(H,T),S) :- !,call_u(with_each_item(P,H,S)), with_each_item(P,T,S). | |
264 | with_each_item(P,H,S) :- call_u2(call(P,H,S)). | |
265 | ||
266 | %% with_each_item(+P2,+HT) semidet. | |
267 | % | |
268 | % Call P(E). each Element in the list. | |
269 | % | |
270 | with_each_item(P,HV):- var(HV),!,call_u2(call(P,HV)). | |
271 | with_each_item(P,M:HT) :- !,must_be(atom,M),M:with_each_item(P,HT). | |
272 | with_each_item(P,[H|T]) :- !, call_u2(call(P,H)), with_each_item(P,T). | |
273 | with_each_item(P,(H,T)) :- !,with_each_item(P,H), with_each_item(P,T). | |
274 | with_each_item(P,H) :- call_u2(call(P,H)). | |
275 | ||
276 | % ================================================= | |
277 | % ============== UTILS END ============== | |
278 | % ================================================= | |
279 | ||
280 | % File : mpred_syntax.pl | |
281 | % Author : Tim Finin, finin@prc.unisys.com | |
282 | % Purpose: syntactic sugar for Pfc - operator definitions and term expansions. | |
283 | - | mpred_ain(P):- get_source_ref(UU),with_umt(mpred_ain(P,UU)). |
283 | + | |
284 | :- op(500,fx,'-'). | |
285 | :- op(300,fx,'~'). | |
286 | :- op(1050,xfx,('==>')). | |
287 | :- op(1050,xfx,'<==>'). | |
288 | :- op(1050,xfx,('<-')). | |
289 | :- op(1100,fx,('==>')). | |
290 | :- op(1150,xfx,('::::')). | |
291 | ||
292 | ||
293 | :- use_module(library(lists)). | |
294 | ||
295 | ||
296 | mpred_current_db(pred_pfc_d). | |
297 | ||
298 | ||
299 | ||
300 | :- dynamic(mpred_te/0). | |
301 | :- multifile(user:term_expansion/2). | |
302 | :- dynamic(user:term_expansion/2). | |
303 | user:term_expansion(I,O):-mpred_te->mpred_te(I,O). | |
304 | ||
305 | mpred_te((P==>Q),(:- mpred_ain((P==>Q)))). | |
306 | %mpred_te((P==>Q),(:- mpred_ain(('<-'(Q,P))))). % speed-up attempt | |
307 | mpred_te(('<-'(P,Q)),(:- mpred_ain(('<-'(P,Q))))). | |
308 | mpred_te((P<==>Q),(:- mpred_ain((P<==>Q)))). | |
309 | mpred_te((RuleName :::: Rule),(:- mpred_ain((RuleName :::: Rule)))). | |
310 | mpred_te((==>P),(:- mpred_ain(P))). | |
311 | ||
312 | ||
313 | % predicates to examine the state of mpred_ | |
314 | ||
315 | - | mpred_ain_special_support(P,S), |
315 | + | lqu:- call_u(listing(qu/1)). |
316 | ||
317 | % File : mpred_core.pl | |
318 | % Author : Tim Finin, finin@prc.unisys.com | |
319 | % Updated: 10/11/87, ... | |
320 | % 4/2/91 by R. McEntire: added calls to valid_dbref as a | |
321 | % workaround for the Quintus 3.1 | |
322 | % bug in the recorded database. | |
323 | % Purpose: core Pfc predicates. | |
324 | ||
325 | ||
326 | ||
327 | % % initialization of global assertons | |
328 | ||
329 | - | mpred_current_db(Db), |
329 | + | |
330 | % mpred_set_default(P,Q) - if there is any fact unifying with P, then do | |
331 | % nothing, else assert_i Q. | |
332 | ||
333 | mpred_set_default(GeneralTerm,Default):- | |
334 | clause_u(GeneralTerm,true) -> true ; assert_u(Default). | |
335 | ||
336 | % tms is one of {none,local,cycles} and controles the tms alg. | |
337 | :- mpred_set_default(tms(_), tms(cycles)). | |
338 | ||
339 | % Pfc Search strategy. sm(X) where X is one of {direct,depth,breadth} | |
340 | % :- must(mpred_set_default(sm(_), sm(direct))). | |
341 | ||
342 | ||
343 | ||
344 | %% mpred_ainz( ?G, ?S) is semidet. | |
345 | % | |
346 | % PFC Ainz. | |
347 | % | |
348 | mpred_ainz(G,S):-mpred_ain(G,S). | |
349 | ||
350 | - | sm(Mode) |
350 | + | |
351 | % | |
352 | % PFC Aina. | |
353 | % | |
354 | - | true -> mpred_warn("Unrecognized sm mode: ~p", Mode)) |
354 | + | |
355 | - | ; mpred_warn("No sm mode"). |
355 | + | |
356 | %% mpred_ain(P,S) | |
357 | % | |
358 | % asserts P into the dataBase with support from S. | |
359 | % | |
360 | % mpred_ain/2 and mpred_post/2 are the proper ways to add new clauses into the | |
361 | % database and have forward reasoning done. | |
362 | % | |
363 | mpred_ain(P):- get_source_ref(UU),mpred_ain(P,UU). | |
364 | ||
365 | mpred_ain(( \+ P ), S):- !, mpred_withdraw(P, S). | |
366 | mpred_ain((==>P),S):- !, mpred_ain(P,S). | |
367 | mpred_ain(P,S):- | |
368 | mpred_post(P,S), | |
369 | mpred_run. | |
370 | ||
371 | %mpred_ain(_,_). | |
372 | mpred_ain(P,S):- mpred_warn("mpred_ain(~p,~p) failed",[P,S]). | |
373 | ||
374 | ||
375 | %% mpred_post(+Ps,+S) | |
376 | % | |
377 | % tries to assert a fact or set of fact to the database. For | |
378 | % each fact (or the singelton) mpred_post1 is called. It always succeeds. | |
379 | % | |
380 | mpred_post(Ps,S):- with_each_item(mpred_post1,Ps,S). | |
381 | ||
382 | ||
383 | %% mpred_post1(+P,+S) is det. | |
384 | % | |
385 | - | % mpred_run :- sm(direct),!. |
385 | + | |
386 | - | % mpred_run :- \+ sm(direct), !, repeat, \+ mpred_step, !. |
386 | + | |
387 | % It always succeeds. | |
388 | - | (\+ sm(direct)), |
388 | + | |
389 | mpred_post1(P,S):- | |
390 | % db mpred_ain_db_to_head(P,P2), | |
391 | % mpred_remove_old_version(P), | |
392 | mpred_add_support(P,S), | |
393 | mpred_unique_u(P), | |
394 | assert_u(P), | |
395 | mpred_trace_op(add,P,S), | |
396 | !, | |
397 | mpred_enqueue(P,S), | |
398 | !. | |
399 | - | with_umt(hs(Was)), |
399 | + | |
400 | mpred_post1(_,_). | |
401 | % mpred_post1(P,S):- mpred_warn("mpred_ain(~p,~p) failed",[P,S]). | |
402 | ||
403 | ||
404 | %% mpred_ain_db_to_head(+P,-NewP) is semidet. | |
405 | % takes a fact P or a conditioned fact | |
406 | % (P:-C) and adds the Db context. | |
407 | % | |
408 | mpred_ain_db_to_head(P,NewP):- | |
409 | lookup_u(mpred_current_db(Db)), | |
410 | (Db=true -> NewP = P; | |
411 | P=(Head:-Body) -> NewP = (Head:- (Db,Body)); | |
412 | otherwise -> NewP = (P:- Db)). | |
413 | ||
414 | ||
415 | ||
416 | ||
417 | %% mpred_unique_u( ?P) is semidet. | |
418 | - | with_umt(qu(P)), |
418 | + | |
419 | - | mpred_retract(qu(P)), |
419 | + | |
420 | % | |
421 | % mpred_unique_u(X) is true if there is no assertion X in the prolog db. | |
422 | mpred_unique_u((Head:-Tail)):- !, \+ clause_u(Head,Tail). | |
423 | - | brake(dmsg("~Nmpred_:get_next_fact - selected fact not on Queue: ~p", |
423 | + | |
424 | ||
425 | mpred_unique_u((Head:-Tail)):- !, \+ clause_u(Head,Tail). | |
426 | mpred_unique_u(P):- !, \+ clause_u(P,true). | |
427 | ||
428 | ||
429 | get_search_mode(_P,_S,Mode):- lookup_u(sm(Mode)),!. | |
430 | get_search_mode(_P,_S,Mode):- must(Mode=direct),!. | |
431 | ||
432 | - | with_umt(mpred_select_hook(P)), |
432 | + | |
433 | get_search_mode(P,S,Mode) | |
434 | -> (Mode=direct -> mpred_fwc(P) ; | |
435 | Mode=depth -> mpred_asserta_w_support(qu(P),S) ; | |
436 | Mode=breadth -> mpred_assert_w_support(qu(P),S) ; | |
437 | true -> mpred_error("Unrecognized sm mode: ~p", Mode)) | |
438 | ; mpred_error("No sm mode"). | |
439 | - | defaultmpred_select(P):- with_umt(qu(P)),!. |
439 | + | |
440 | ||
441 | %% mpred_remove_old_version( :TermIdentifier) is semidet. | |
442 | % | |
443 | % if there is a rule of the form Identifier ::: Rule then delete it. | |
444 | - | mpred_halt(Format,Args):- format(string(Now),Format,Args), mpred_halt(Now). |
444 | + | |
445 | mpred_remove_old_version((Identifier::::Body)):- | |
446 | % this should never happen. | |
447 | var(identifier), | |
448 | - | (hs(Was) -> |
448 | + | |
449 | mpred_warn("variable used as an rule name in ~p :::: ~p", | |
450 | [Identifier,Body]). | |
451 | ||
452 | ||
453 | - | stop_trace(Msg):- notrace((tracing,leash(+all),dtrace(dmsg(Msg)))),!,rtrace. |
453 | + | |
454 | - | stop_trace(Msg):- dtrace(dmsg(Msg)). |
454 | + | |
455 | clause_u((Identifier::::OldBody),_), | |
456 | \+(Body=OldBody), | |
457 | mpred_withdraw((Identifier::::OldBody)), | |
458 | !. | |
459 | mpred_remove_old_version(_). | |
460 | ||
461 | ||
462 | ||
463 | % mpred_run compute the deductive closure of the current database. | |
464 | % How this is done depends on the searching mode: | |
465 | % direct - mpred_fwc has already done the job. | |
466 | % depth or breadth - use the qu mechanism. | |
467 | ||
468 | % mpred_run :- lookup_u(sm(direct)),!. | |
469 | % mpred_run :- repeat, \+ mpred_step, !. | |
470 | mpred_run:- | |
471 | % (\+ lookup_u(sm(direct))), | |
472 | mpred_step, | |
473 | mpred_run. | |
474 | mpred_run. | |
475 | ||
476 | ||
477 | % mpred_step removes one entry from the qu and reasons from it. | |
478 | ||
479 | ||
480 | mpred_step:- | |
481 | % if hs/1 is true, reset it and fail, thereby stopping inferencing. | |
482 | lookup_u(hs(Was)), | |
483 | mpred_retract(hs(Was)), | |
484 | mpred_trace_msg('Stopping on: ~p',[hs(Was)]), | |
485 | !, | |
486 | fail. | |
487 | ||
488 | mpred_step:- | |
489 | % draw immediate conclusions from the next fact to be considered. | |
490 | % fails iff the queue is empty. | |
491 | get_next_fact(P), | |
492 | pfcl_do(mpred_fwc(P)), | |
493 | !. | |
494 | ||
495 | get_next_fact(P):- | |
496 | %identifies the nect fact to mpred_fwc from and removes it from the queue. | |
497 | - | mpred_get_trigger_quick(pt(Head,Body)), |
497 | + | |
498 | remove_selection(P). | |
499 | ||
500 | remove_selection(P):- | |
501 | lookup_u(qu(P)), | |
502 | - | mpred_get_trigger_quick(Trigger):- clause_u(Trigger,true). |
502 | + | mus(mpred_retract(qu(P))), |
503 | mpred_remove_supports_quietly(qu(P)), | |
504 | !. | |
505 | remove_selection(P):- | |
506 | brake(format("~Nmpred_:get_next_fact - selected fact not on Queue: ~p", | |
507 | [P])). | |
508 | ||
509 | ||
510 | :- module_transparent((format_to_message)/3). | |
511 | :- module_transparent((setup_mpred_support)/1). | |
512 | ||
513 | - | mpred_rem_actionTrace(actn(A)):- |
513 | + | format_to_message(Format,Args,Info):- |
514 | - | do_and_undo(A,M), |
514 | + | is_list(Args)-> |
515 | - | M, |
515 | + | format(string(Info),Format,Args); |
516 | format(string(Info),'~N~p <> ~p~n',[Format,Args]). | |
517 | ||
518 | ||
519 | % select_next_fact(P) identifies the next fact to reason from. | |
520 | % It tries the user defined predicate first and, failing that, | |
521 | % the default mechanism. | |
522 | ||
523 | select_next_fact(P):- | |
524 | lookup_u(mpred_select_hook(P)), | |
525 | !. | |
526 | select_next_fact(P):- | |
527 | defaultmpred_select(P), | |
528 | !. | |
529 | ||
530 | % the default selection predicate takes the item at the froint of the queue. | |
531 | defaultmpred_select(P):- lookup_u(qu(P)),!. | |
532 | ||
533 | % mpred_halt stops the forward chaining. | |
534 | - | *-> mpred_unfwc(X) ; mpred_unfwc(X)). |
534 | + | |
535 | ||
536 | mpred_halt(Format,Args):- format_to_message(Format,Args,Info), mpred_halt(Info). | |
537 | ||
538 | mpred_halt(Now):- | |
539 | mpred_trace_msg("New halt signal ",[Now]), | |
540 | (lookup_u(hs(Was)) -> | |
541 | mpred_warn("mpred_halt finds halt signal already set to: ~p ",[Was]) | |
542 | ; assert_u(hs(Now))). | |
543 | ||
544 | ||
545 | - | mpred_retract_type(action,X):- mpred_rem_actionTrace(X). |
545 | + | stop_trace(Info):- notrace((tracing,leash(+all),dtrace(dmsg(Info)))),!,rtrace. |
546 | stop_trace(Info):- dtrace(dmsg(Info)). | |
547 | ||
548 | ||
549 | % | |
550 | % predicates for manipulating triggers | |
551 | % | |
552 | ||
553 | ||
554 | mpred_ain_trigger_reprop(pt(Trigger,Body),Support):- | |
555 | !, | |
556 | mpred_trace_msg('~N~n\tAdding positive~n\t\ttrigger: ~p~n\t\tbody: ~p~n\t Support: ~p~n', | |
557 | [Trigger,Body,Support]), | |
558 | mpred_assert_w_support(pt(Trigger,Body),Support), | |
559 | copy_term(pt(Trigger,Body),Tcopy), | |
560 | mpred_BC(Trigger), | |
561 | mpred_eval_lhs(Body,(Trigger,Tcopy)), | |
562 | fail. | |
563 | ||
564 | ||
565 | mpred_ain_trigger_reprop(nt(Trigger,Test,Body),Support):- | |
566 | !, | |
567 | mpred_trace_msg('~N~n\tAdding negative~n\t\ttrigger: ~p~n\t\ttest: ~p~n\t\tbody: ~p~n\t Support: ~p~n', | |
568 | [Trigger,Test,Body,Support]), | |
569 | copy_term(Trigger,TriggerCopy), | |
570 | mpred_assert_w_support(nt(TriggerCopy,Test,Body),Support), | |
571 | % stop_trace(mpred_assert_w_support(nt(TriggerCopy,Test,Body),Support)), | |
572 | \+Test, | |
573 | mpred_eval_lhs(Body,((\+Trigger),nt(TriggerCopy,Test,Body))). | |
574 | ||
575 | mpred_ain_trigger_reprop(bt(Trigger,Body),Support):- | |
576 | !, | |
577 | mpred_trace_msg('~N~n\tAdding backwards~n\t\ttrigger: ~p~n\t\tbody: ~p~n\t Support: ~p~n', | |
578 | [Trigger,Body,Support]), | |
579 | mpred_assert_w_support(bt(Trigger,Body),Support), | |
580 | mpred_bt_pt_combine(Trigger,Body,Support). | |
581 | ||
582 | mpred_ain_trigger_reprop(X,Support):- | |
583 | mpred_warn("Unrecognized trigger to mpred_ain_trigger_reprop: ~p\n~~p~n",[X,Support]). | |
584 | ||
585 | ||
586 | mpred_bt_pt_combine(Head,Body,Support):- | |
587 | % a backward trigger (bt) was just added with head and Body and support Support | |
588 | % find any pt''s with unifying heads and add the instantied bt body. | |
589 | lookup_u(pt(Head,Body)), | |
590 | mpred_eval_lhs(Body,Support), | |
591 | fail. | |
592 | mpred_bt_pt_combine(_,_,_):- !. | |
593 | ||
594 | ||
595 | ||
596 | % | |
597 | % predicates for manipulating action traces. | |
598 | % | |
599 | ||
600 | mpred_ain_actiontrace(Action,Support):- | |
601 | % adds an action trace and it''s support. | |
602 | mpred_add_support(actn(Action),Support). | |
603 | ||
604 | mpred_undo_action(actn(A)):- | |
605 | lookup_u(do_and_undo(A,M)), | |
606 | call_u(M), | |
607 | !. | |
608 | ||
609 | ||
610 | %% mpred_retract(X) is det. | |
611 | % | |
612 | % predicates to remove Pfc facts, triggers, action traces, and queue items | |
613 | % from the database. | |
614 | % | |
615 | mpred_retract(X):- | |
616 | % retract an arbitrary thing. | |
617 | mpred_db_type(X,Type),!, | |
618 | mpred_retract_type(Type,X), | |
619 | !. | |
620 | ||
621 | mpred_retract_type(fact(_FT),X):- | |
622 | % db mpred_ain_db_to_head(X,X2), retract_u(X2). | |
623 | % stop_trace(mpred_retract_type(fact(_FT),X)), | |
624 | (retract_u(X) | |
625 | *-> mpred_unfwc(X) ; (mpred_unfwc(X),!,fail)). | |
626 | ||
627 | mpred_retract_type(rule,X):- | |
628 | % db mpred_ain_db_to_head(X,X2), retract_u(X2). | |
629 | retract_u(X). | |
630 | ||
631 | mpred_retract_type(trigger,X):- | |
632 | retract_u(X) | |
633 | -> mpred_unfwc(X) | |
634 | ; mpred_warn("Trigger not found to retract_u: ~p",[X]). | |
635 | ||
636 | mpred_retract_type(action,X):- mpred_undo_action(X). | |
637 | ||
638 | ||
639 | %% mpred_ain_object(X) | |
640 | % | |
641 | % adds item X to some database | |
642 | % | |
643 | mpred_ain_object(X):- | |
644 | % what type of X do we have? | |
645 | mpred_db_type(X,Type), | |
646 | % call the appropriate predicate. | |
647 | mpred_ain_by_type(Type,X). | |
648 | ||
649 | mpred_ain_by_type(fact(_FT),X):- | |
650 | mpred_unique_u(X), | |
651 | assert_u(X),!. | |
652 | mpred_ain_by_type(rule,X):- | |
653 | - | mpred_rem_actionTrace(actn(A)). |
653 | + | |
654 | assert_u(X),!. | |
655 | mpred_ain_by_type(trigger,X):- | |
656 | assert_u(X). | |
657 | mpred_ain_by_type(action,_ZAction):- !. | |
658 | ||
659 | ||
660 | ||
661 | ||
662 | %% mpred_withdraw(P). | |
663 | % removes support S from P and checks to see if P is still supported. | |
664 | % If it is not, then the fact is retreactred from the database and any support | |
665 | % relationships it participated in removed. | |
666 | ||
667 | mpred_withdraw(Ps):- get_source_ref(UU),mpred_withdraw(Ps,UU). | |
668 | ||
669 | /* | |
670 | mpred_withdraw(List):- | |
671 | % iterate down the list of facts to be mpred_withdraw'ed. | |
672 | nonvar(List), | |
673 | List=[_|_], | |
674 | remlist(List). | |
675 | ||
676 | mpred_withdraw(P):- | |
677 | % mpred_withdraw/1 is the user''s interface - it withdraws user support for P. | |
678 | get_source_ref(UU), | |
679 | mpred_withdraw(P,UU). | |
680 | ||
681 | - | mpred_trace_rem(Fact), |
681 | + | |
682 | % mpred_withdraw each element in the list. | |
683 | get_source_ref(UU), | |
684 | mpred_withdraw(H,UU), | |
685 | remlist(T). | |
686 | */ | |
687 | ||
688 | %% mpred_withdraw(P,S) is det. | |
689 | % removes support S from P and checks to see if P is still supported. | |
690 | % If it is not, then the fact is retreactred from the database and any support | |
691 | % relationships it participated in removed. | |
692 | mpred_withdraw(Ps,S):- with_each_item(mpred_withdraw1,Ps,S). | |
693 | mpred_withdraw1(P,S):- | |
694 | mpred_trace_msg('~N~n\tRemoving~n\t\tsupport: ~p~n\t\tfrom: ~p~n',[S,P]), | |
695 | mpred_rem_support(P,S) | |
696 | -> remove_if_unsupported(P) | |
697 | ; mpred_warn("mpred_withdraw/2 Could not find support ~p to remove from fact ~p", | |
698 | [S,P]). | |
699 | ||
700 | %% mpred_remove(+P) is det. | |
701 | % | |
702 | % mpred_remove is like mpred_withdraw, but if P is still in the DB after removing the | |
703 | % user''s support, it is retracted by more forceful means (e.g. remove). | |
704 | % | |
705 | mpred_remove(P):- get_source_ref(UU), mpred_remove(P,UU). | |
706 | - | nt(Fcopy,Condition,Action), |
706 | + | |
707 | - | (\+ Condition), |
707 | + | |
708 | mpred_withdraw(P,S), | |
709 | mpred_BC(P) | |
710 | -> mpred_blast(P) | |
711 | ; true. | |
712 | ||
713 | % | |
714 | - | (Type=trigger -> mpred_rem_support(P,(_,Fact)) |
714 | + | |
715 | - | ; mpred_rem_support(P,(Fact,_))), |
715 | + | |
716 | ||
717 | mpred_blast(F):- | |
718 | mpred_remove_supports(F), | |
719 | mpred_undo(F). | |
720 | ||
721 | ||
722 | % removes any remaining supports for fact F, complaining as it goes. | |
723 | ||
724 | mpred_remove_supports(F):- | |
725 | mpred_rem_support(F,S), | |
726 | mpred_warn("~p was still supported by ~p",[F,S]), | |
727 | fail. | |
728 | mpred_remove_supports(_). | |
729 | ||
730 | mpred_remove_supports_quietly(F):- | |
731 | mpred_rem_support(F,_), | |
732 | fail. | |
733 | mpred_remove_supports_quietly(_). | |
734 | ||
735 | %% mpred_undo(X) undoes X. | |
736 | % | |
737 | % - a positive or negative trigger. | |
738 | % - an action by finding a method and successfully executing it. | |
739 | % - or a random fact, printing out the trace, if relevant. | |
740 | % | |
741 | mpred_undo(actn(A)):- | |
742 | % undo an action by finding a method and successfully executing it. | |
743 | !, | |
744 | mpred_undo_action(actn(A)). | |
745 | ||
746 | mpred_undo(pt(Key,Head,Body)):- | |
747 | % undo a positive trigger. | |
748 | % | |
749 | !, | |
750 | (show_success(retract_u(pt(Key,Head,Body))) | |
751 | -> mpred_unfwc(pt(Head,Body)) | |
752 | ; mpred_warn("Trigger not found to undo: ~p",[pt(Head,Body)])). | |
753 | ||
754 | mpred_undo(pt(Head,Body)):- fail, | |
755 | % undo a positive trigger. | |
756 | % | |
757 | !, | |
758 | (show_success(retract_u(pt(Head,Body))) | |
759 | -> mpred_unfwc(pt(Head,Body)) | |
760 | ; mpred_warn("Trigger not found to undo: ~p",[pt(Head,Body)])). | |
761 | ||
762 | mpred_undo(nt(Head,Condition,Body)):- | |
763 | % undo a negative trigger. | |
764 | !, | |
765 | (show_success(retract_u(nt(Head,Condition,Body))) | |
766 | -> mpred_unfwc(nt(Head,Condition,Body)) | |
767 | ; mpred_warn("Trigger not found to undo: ~p",[nt(Head,Condition,Body)])). | |
768 | ||
769 | mpred_undo(Fact):- | |
770 | % undo a random fact, printing out the trace, if relevant. | |
771 | retract_u(Fact), | |
772 | mpred_trace_op(rem,Fact), | |
773 | mpred_unfwc(Fact). | |
774 | ||
775 | ||
776 | ||
777 | %% mpred_unfwc(+P) | |
778 | % | |
779 | % "un-forward-chains" from fact P. That is, fact P has just | |
780 | % been removed from the database, so remove all support relations it | |
781 | - | mpred_get_trigger_quick(pt(F,Body)), |
781 | + | |
782 | % should stayuser in the database or should also be removed. | |
783 | % | |
784 | mpred_unfwc(F):- | |
785 | mpred_retract_supported_relations(F), | |
786 | mpred_unfwc1(F). | |
787 | ||
788 | - | % mpred_get_trigger_quick(pt(presently(F),Body)), |
788 | + | |
789 | mpred_unfwc_check_triggers(F), | |
790 | % is this really the right place for mpred_run<? | |
791 | mpred_run. | |
792 | ||
793 | ||
794 | mpred_unfwc_check_triggers(F):- | |
795 | - | spft(X,_,nt(F,Condition,Body)), |
795 | + | |
796 | copy_term(F,Fcopy), | |
797 | lookup_u(nt(Fcopy,Condition,Action)), | |
798 | \+ call_u(Condition), | |
799 | mpred_eval_lhs(Action,((\+F),nt(F,Condition,Action))), | |
800 | fail. | |
801 | mpred_unfwc_check_triggers(_). | |
802 | ||
803 | mpred_retract_supported_relations(Fact):- | |
804 | mpred_db_type(Fact,Type), | |
805 | (Type=trigger -> mpred_rem_support_if_exists(P,(_,Fact)) | |
806 | ; mpred_rem_support_if_exists(P,(Fact,_))), | |
807 | nonvar(P), | |
808 | remove_if_unsupported(P), | |
809 | fail. | |
810 | - | mpred_warn("rule: ~p",[Parent_rule]), |
810 | + | |
811 | ||
812 | ||
813 | ||
814 | % remove_if_unsupported(+Ps) checks to see if all Ps are supported and removes | |
815 | % it from the DB if they are not. | |
816 | remove_if_unsupported(P):- | |
817 | mpred_supported(P) -> true ; mpred_undo(P). | |
818 | ||
819 | ||
820 | ||
821 | ||
822 | ||
823 | ||
824 | %% mpred_fwc(+X) | |
825 | % | |
826 | % forward chains from a fact or a list of facts X. | |
827 | % | |
828 | ||
829 | ||
830 | mpred_fwc([H|T]):- !, mpred_fwc1(H), mpred_fwc(T). | |
831 | mpred_fwc([]):- !. | |
832 | - | (call(Test) -> mpred_eval_lhs(Body,Support)), |
832 | + | |
833 | ||
834 | % mpred_fwc1(+P) forward chains for a single fact. | |
835 | ||
836 | mpred_fwc1(Fact):- | |
837 | mpred_do_rule(Fact), | |
838 | copy_term(Fact,F), | |
839 | % check positive triggers | |
840 | mpred_do_fcpt(Fact,F), | |
841 | % check negative triggers | |
842 | mpred_do_fcnt(Fact,F). | |
843 | ||
844 | ||
845 | % | |
846 | % mpred_ain_rule_if_rule(P) does some special, built in forward chaining if P is | |
847 | % a rule. | |
848 | % | |
849 | ||
850 | mpred_do_rule((P==>Q)):- | |
851 | !, | |
852 | process_rule(P,Q,(P==>Q)). | |
853 | mpred_do_rule((Name::::P==>Q)):- | |
854 | !, | |
855 | process_rule(P,Q,(Name::::P==>Q)). | |
856 | mpred_do_rule((P<==>Q)):- | |
857 | !, | |
858 | process_rule(P,Q,(P<==>Q)), | |
859 | process_rule(Q,P,(P<==>Q)). | |
860 | mpred_do_rule((Name::::P<==>Q)):- | |
861 | !, | |
862 | process_rule(P,Q,((Name::::P<==>Q))), | |
863 | process_rule(Q,P,((Name::::P<==>Q))). | |
864 | ||
865 | mpred_do_rule(('<-'(P,Q))):- | |
866 | !, | |
867 | mpred_define_bc_rule(P,Q,('<-'(P,Q))). | |
868 | ||
869 | mpred_do_rule(_). | |
870 | ||
871 | ||
872 | mpred_do_fcpt(Fact,F):- | |
873 | lookup_u(pt(F,Body)), | |
874 | mpred_trace_msg('~N~n\tFound positive trigger: ~p~n\t\tbody: ~p~n', | |
875 | [F,Body]), | |
876 | mpred_eval_lhs(Body,(Fact,pt(F,Body))), | |
877 | fail. | |
878 | ||
879 | %mpred_do_fcpt(Fact,F):- | |
880 | % lookup_u(pt(presently(F),Body)), | |
881 | % mpred_eval_lhs(Body,(presently(Fact),pt(presently(F),Body))), | |
882 | % fail. | |
883 | ||
884 | mpred_do_fcpt(_,_). | |
885 | ||
886 | mpred_do_fcnt(_ZFact,F):- | |
887 | lookup_u(spft(X,_,nt(F,Condition,Body))), | |
888 | Condition, | |
889 | mpred_withdraw(X,(_,nt(F,Condition,Body))), | |
890 | fail. | |
891 | mpred_do_fcnt(_,_). | |
892 | ||
893 | ||
894 | % | |
895 | % mpred_define_bc_rule(+Head,+Body,+Parent_rule) - defines a backeard | |
896 | - | call(Action), |
896 | + | |
897 | % | |
898 | ||
899 | mpred_define_bc_rule(Head,_ZBody,Parent_rule):- | |
900 | (\+ mpred_literal(Head)), | |
901 | mpred_warn("Malformed backward chaining rule. ~p not atomic.",[Head]), | |
902 | mpred_error("rule: ~p",[Parent_rule]), | |
903 | !, | |
904 | fail. | |
905 | ||
906 | mpred_define_bc_rule(Head,Body,Parent_rule):- | |
907 | get_source_ref1(U), | |
908 | copy_term(Parent_rule,Parent_ruleCopy), | |
909 | build_rhs(Head,Rhs), | |
910 | foreachl_do(mpred_nf(Body,Lhs), | |
911 | (build_trigger(Lhs,rhs(Rhs),Trigger), | |
912 | mpred_ain(bt(Head,Trigger),(Parent_ruleCopy,U)))). | |
913 | ||
914 | ||
915 | ||
916 | ||
917 | % | |
918 | % eval something on the LHS of a rule. | |
919 | % | |
920 | ||
921 | ||
922 | mpred_eval_lhs((Test->Body),Support):- | |
923 | !, | |
924 | (call_u(Test) -> mpred_eval_lhs(Body,Support)), | |
925 | !. | |
926 | ||
927 | mpred_eval_lhs(rhs(X),Support):- | |
928 | !, | |
929 | mpred_eval_rhs(X,Support), | |
930 | !. | |
931 | ||
932 | mpred_eval_lhs(X,Support):- | |
933 | - | mpred_BC(P):-mpred_BC_CACHE(P),mpred_CALL(mpred_BC, P). |
933 | + | |
934 | !, | |
935 | mpred_ain_trigger_reprop(X,Support), | |
936 | !. | |
937 | - | bt(P,Trigger), |
937 | + | |
938 | %mpred_eval_lhs(snip(X),Support):- | |
939 | % snip(Support), | |
940 | % mpred_eval_lhs(X,Support). | |
941 | ||
942 | - | mpred_CALL(F):- mpred_CALL(mpred_CALL, Cut, F), (var(Cut)->true;(Cut=cut(Cut)->(!,Cut);Cut)). |
942 | + | |
943 | mpred_warn("Unrecognized item found in trigger body, namely ~p.",[X]). | |
944 | - | mpred_CALL(How,F):- mpred_CALL(How, Cut, F), (var(Cut)->true;(Cut=cut(Cut)->(!,Cut);Cut)). |
944 | + | |
945 | ||
946 | % | |
947 | % eval something on the RHS of a rule. | |
948 | % | |
949 | ||
950 | - | (clause_u(F,Condition),mpred_CALL(How,Cut,Condition),(var(Cut)->true;(Cut=cut(Cut)->(!,Cut);Cut))); |
950 | + | |
951 | mpred_eval_rhs([Head|Tail],Support):- | |
952 | mpred_eval_rhs1(Head,Support), | |
953 | mpred_eval_rhs(Tail,Support). | |
954 | ||
955 | ||
956 | mpred_eval_rhs1({Action},Support):- | |
957 | % evaluable Prolog code. | |
958 | !, | |
959 | fc_eval_action(Action,Support). | |
960 | - | current_predicate(_,F),!, call(F). |
960 | + | |
961 | mpred_eval_rhs1(P,_ZSupport):- | |
962 | % predicate to remove. | |
963 | mpred_negated_literal(P), | |
964 | !, | |
965 | mpred_withdraw(P). | |
966 | ||
967 | mpred_eval_rhs1([X|Xrest],Support):- | |
968 | % embedded sublist. | |
969 | - | action_is_undoable(A):- do_and_undo(A,_). |
969 | + | |
970 | mpred_eval_rhs([X|Xrest],Support). | |
971 | ||
972 | mpred_eval_rhs1(Assertion,Support):- | |
973 | % an assertion to be added. | |
974 | mpred_post1(Assertion,Support). | |
975 | ||
976 | ||
977 | mpred_eval_rhs1(X,_):- | |
978 | mpred_warn("Malformed rhs of a rule: ~p",[X]). | |
979 | ||
980 | ||
981 | ||
982 | %% fc_eval_action(+Action,+Support) | |
983 | % | |
984 | % evaluate an action found on the rhs of a rule. | |
985 | % | |
986 | ||
987 | fc_eval_action(Action,Support):- | |
988 | call_u(Action), | |
989 | (action_is_undoable(Action) | |
990 | -> mpred_ain_actiontrace(Action,Support) | |
991 | ; true). | |
992 | ||
993 | ||
994 | % | |
995 | % | |
996 | % | |
997 | ||
998 | trigger_trigger(Trigger,Body,_ZSupport):- | |
999 | trigger_trigger1(Trigger,Body). | |
1000 | trigger_trigger(_,_,_). | |
1001 | ||
1002 | ||
1003 | %trigger_trigger1(presently(Trigger),Body):- | |
1004 | % !, | |
1005 | % copy_term(Trigger,TriggerCopy), | |
1006 | % mpred_BC(Trigger), | |
1007 | % mpred_eval_lhs(Body,(presently(Trigger),pt(presently(TriggerCopy),Body))), | |
1008 | % fail. | |
1009 | ||
1010 | trigger_trigger1(Trigger,Body):- | |
1011 | copy_term(Trigger,TriggerCopy), | |
1012 | mpred_BC(Trigger), | |
1013 | mpred_eval_lhs(Body,(Trigger,pt(TriggerCopy,Body))), | |
1014 | fail. | |
1015 | ||
1016 | ||
1017 | ||
1018 | %% mpred_BC(F) is det. | |
1019 | % | |
1020 | % is true iff F is a fact available for forward chaining | |
1021 | % (or from the backchaining store) | |
1022 | % Note that this has the side effect of catching unsupported facts and | |
1023 | % assigning them support from God. | |
1024 | % | |
1025 | mpred_BC(P):-mpred_CALL(mpred_BC_w_cache, P). | |
1026 | ||
1027 | mpred_BC_w_cache(P):- mpred_BC_CACHE(P),mpred_CALL(P). | |
1028 | mpred_BC_CACHE(P):- | |
1029 | ignore(( | |
1030 | % trigger any bc rules. | |
1031 | lookup_u(bt(P,Trigger)), | |
1032 | mpred_get_support(bt(P,Trigger),S), | |
1033 | mpred_eval_lhs(Trigger,S), | |
1034 | fail)). | |
1035 | ||
1036 | mpred_CALL(F):- mpred_CALL(mpred_CALL, Cut, F), (var(Cut)->true;(Cut=cut(Cut)->(!,Cut);call_u(Cut))). | |
1037 | ||
1038 | mpred_CALL(How,F):- mpred_CALL(How, Cut, F), (var(Cut)->true;(Cut=cut(Cut)->(!,Cut);call_u(Cut))). | |
1039 | ||
1040 | mpred_CALL(How,SCut, F):- | |
1041 | % this is probably not advisable due to extreme inefficiency. | |
1042 | var(F) -> mpred_fact(F) ; | |
1043 | predicate_property(F,built_in) -> F ; | |
1044 | predicate_property(F,number_of_clauses(_)) -> | |
1045 | (clause_u(F,Condition),mpred_CALL(How,Cut,Condition),(var(Cut)->true;(Cut=cut(Cut)->(!,Cut);call_u(Cut)))); | |
1046 | mpred_CALL_MI(How,SCut,F). | |
1047 | ||
1048 | mpred_CALL_MI(_How, cut(true), !):- !. | |
1049 | mpred_CALL_MI(How, Cut, (P1,P2)):- !, mpred_CALL(How, Cut, P1), mpred_CALL(How, Cut, P2). | |
1050 | mpred_CALL_MI(How, Cut, (P1;P2)):- !, mpred_CALL(How, Cut, P1); mpred_CALL(How, Cut, P2). | |
1051 | mpred_CALL_MI(How, Cut, (P1->P2)):- !, mpred_CALL(How, Cut, P1)-> mpred_CALL(How, Cut, P2). | |
1052 | mpred_CALL_MI(How, Cut, (P1*->P2)):- !, mpred_CALL(How, Cut, P1)*-> mpred_CALL(How, Cut, P2). | |
1053 | mpred_CALL_MI(_How,_, F):- | |
1054 | % we really need to check for system predicates as well. | |
1055 | must(current_predicate(_,M:F)),!, M:F. | |
1056 | ||
1057 | ||
1058 | ||
1059 | ||
1060 | %% action_is_undoable(?A) | |
1061 | % | |
1062 | % an action is action_is_undoable if there exists a method for undoing it. | |
1063 | % | |
1064 | action_is_undoable(A):- lookup_u(do_and_undo(A,_)). | |
1065 | ||
1066 | ||
1067 | ||
1068 | %% mpred_nf(+In,-Out) | |
1069 | % | |
1070 | % maps the LHR of a Pfc rule In to one normal form | |
1071 | % Out. It also does certmpred_ain optimizations. Backtracking into this | |
1072 | % predicate will produce additional clauses. | |
1073 | % | |
1074 | ||
1075 | mpred_nf(LHS,List):- | |
1076 | mpred_nf1(LHS,List2), | |
1077 | mpred_nf_negations(List2,List). | |
1078 | ||
1079 | ||
1080 | %% mpred_nf1(+In,-Out) | |
1081 | % | |
1082 | % maps the LHR of a Pfc rule In to one normal form | |
1083 | % Out. Backtracking into this predicate will produce additional clauses. | |
1084 | ||
1085 | % handle a variable. | |
1086 | ||
1087 | mpred_nf1(P,[P]):- var(P), !. | |
1088 | ||
1089 | % these next two rules are here for upward compatibility and will go | |
1090 | % away eventually when the P/Condition form is no longer used anywhere. | |
1091 | ||
1092 | mpred_nf1(P/Cond,[(\+P)/Cond]):- mpred_negated_literal(P), !. | |
1093 | ||
1094 | mpred_nf1(P/Cond,[P/Cond]):- mpred_literal(P), !. | |
1095 | ||
1096 | % handle a negated form | |
1097 | ||
1098 | mpred_nf1(NegTerm,NF):- | |
1099 | mpred_negation(NegTerm,Term), | |
1100 | !, | |
1101 | mpred_nf1_negation(Term,NF). | |
1102 | ||
1103 | % disjunction. | |
1104 | ||
1105 | mpred_nf1((P;Q),NF):- | |
1106 | !, | |
1107 | (mpred_nf1(P,NF) ; mpred_nf1(Q,NF)). | |
1108 | ||
1109 | ||
1110 | % conjunction. | |
1111 | ||
1112 | mpred_nf1((P,Q),NF):- | |
1113 | !, | |
1114 | mpred_nf1(P,NF1), | |
1115 | mpred_nf1(Q,NF2), | |
1116 | append(NF1,NF2,NF). | |
1117 | ||
1118 | % handle a random literal. | |
1119 | ||
1120 | mpred_nf1(P,[P]):- | |
1121 | mpred_literal(P), | |
1122 | !. | |
1123 | ||
1124 | %=% shouln't we have something to catch the rest as errors? | |
1125 | mpred_nf1(Term,[Term]):- | |
1126 | mpred_warn("mpred_nf doesn't know how to normalize ~p",[Term]),!,fail. | |
1127 | ||
1128 | ||
1129 | %% mpred_nf1_negation( ?P, ?P) is semidet. | |
1130 | % | |
1131 | % mpred_nf1_negation(P,NF) is true if NF is the normal form of \+P. | |
1132 | % | |
1133 | mpred_nf1_negation((P/Cond),[(\+(P))/Cond]):- !. | |
1134 | ||
1135 | mpred_nf1_negation((P;Q),NF):- | |
1136 | !, | |
1137 | mpred_nf1_negation(P,NFp), | |
1138 | mpred_nf1_negation(Q,NFq), | |
1139 | append(NFp,NFq,NF). | |
1140 | ||
1141 | mpred_nf1_negation((P,Q),NF):- | |
1142 | % this code is not correct! twf. | |
1143 | !, | |
1144 | mpred_nf1_negation(P,NF) | |
1145 | ; | |
1146 | (mpred_nf1(P,Pnf), | |
1147 | mpred_nf1_negation(Q,Qnf), | |
1148 | append(Pnf,Qnf,NF)). | |
1149 | ||
1150 | mpred_nf1_negation(P,[\+P]). | |
1151 | ||
1152 | ||
1153 | %% mpred_nf_negations(List2,List) is det. | |
1154 | % | |
1155 | % sweeps through List2 to produce List, | |
1156 | % changing -{...} to {\+...} | |
1157 | % % ? is this still needed? twf 3/16/90 | |
1158 | ||
1159 | %% mpred_nf_negations( :TermX, :TermX) is semidet. | |
1160 | % | |
1161 | % PFC Normal Form Negations. | |
1162 | % | |
1163 | mpred_nf_negations(X,X) :- !. % I think not! twell_founded_0 3/27/90 | |
1164 | ||
1165 | mpred_nf_negations([],[]). | |
1166 | ||
1167 | mpred_nf_negations([H1|T1],[H2|T2]):- | |
1168 | mpred_nf_negation(H1,H2), | |
1169 | mpred_nf_negations(T1,T2). | |
1170 | ||
1171 | ||
1172 | %% mpred_nf_negation( ?X, ?X) is semidet. | |
1173 | % | |
1174 | % PFC Normal Form Negation. | |
1175 | % | |
1176 | mpred_nf_negation(Form,{\+ X}):- | |
1177 | nonvar(Form), | |
1178 | Form=(-({X})), | |
1179 | !. | |
1180 | mpred_nf_negation(X,X). | |
1181 | ||
1182 | ||
1183 | ||
1184 | %% build_rhs(+Conjunction,-Rhs) | |
1185 | % | |
1186 | ||
1187 | build_rhs(X,[X]):- | |
1188 | var(X), | |
1189 | !. | |
1190 | ||
1191 | build_rhs((A,B),[A2|Rest]):- | |
1192 | !, | |
1193 | mpred_compile_rhs_term(A,A2), | |
1194 | build_rhs(B,Rest). | |
1195 | ||
1196 | build_rhs(X,[X2]):- | |
1197 | mpred_compile_rhs_term(X,X2). | |
1198 | ||
1199 | ||
1200 | mpred_compile_rhs_term((P/C),((P:-C))):- !. | |
1201 | mpred_compile_rhs_term(P,P). | |
1202 | ||
1203 | ||
1204 | ||
1205 | %% mpred_negation( ?N, ?P) is semidet. | |
1206 | % | |
1207 | % is true if N is a negated term and P is the term | |
1208 | % with the negation operator stripped. | |
1209 | % | |
1210 | mpred_negation((-P),P). | |
1211 | mpred_negation((\+(P)),P). | |
1212 | ||
1213 | ||
1214 | ||
1215 | %% mpred_negated_literal( ?P) is semidet. | |
1216 | % | |
1217 | % PFC Negated Literal. | |
1218 | % | |
1219 | mpred_negated_literal(P):- | |
1220 | - | mpred_conjoin((mpred_BC(T)),Testmid,Testout). |
1220 | + | |
1221 | mpred_positive_literal(Q). | |
1222 | ||
1223 | mpred_literal(X):- mpred_negated_literal(X). | |
1224 | mpred_literal(X):- mpred_positive_literal(X). | |
1225 | ||
1226 | mpred_positive_literal(X):- is_ftNonvar(X), | |
1227 | functor(X,F,_), | |
1228 | \+ mpred_connective(F). | |
1229 | ||
1230 | ||
1231 | %% mpred_connective( ?VALUE1) is semidet. | |
1232 | % | |
1233 | % PFC Connective. | |
1234 | % | |
1235 | mpred_connective(';'). | |
1236 | mpred_connective(','). | |
1237 | mpred_connective('/'). | |
1238 | mpred_connective('|'). | |
1239 | mpred_connective(('==>')). | |
1240 | mpred_connective(('<-')). | |
1241 | mpred_connective('<==>'). | |
1242 | ||
1243 | mpred_connective('-'). | |
1244 | % mpred_connective('-'). | |
1245 | mpred_connective('\\+'). | |
1246 | ||
1247 | ||
1248 | %% process_rule( ?Lhs, ?Rhs, ?Parent_rule) is semidet. | |
1249 | % | |
1250 | % Process Rule. | |
1251 | % | |
1252 | process_rule(Lhs,Rhs,Parent_rule):- | |
1253 | get_source_ref1(U), | |
1254 | copy_term(Parent_rule,Parent_ruleCopy), | |
1255 | build_rhs(Rhs,Rhs2), | |
1256 | foreachl_do(mpred_nf(Lhs,Lhs2), | |
1257 | build_rule(Lhs2,rhs(Rhs2),(Parent_ruleCopy,U))). | |
1258 | ||
1259 | ||
1260 | %% build_rule( ?Lhs, ?Rhs, ?Support) is semidet. | |
1261 | % | |
1262 | % Build Rule. | |
1263 | % | |
1264 | build_rule(Lhs,Rhs,Support):- | |
1265 | build_trigger(Lhs,Rhs,Trigger), | |
1266 | mpred_eval_lhs(Trigger,Support). | |
1267 | ||
1268 | build_trigger([],Consequent,Consequent). | |
1269 | ||
1270 | build_trigger([V|Triggers],Consequent,pt(V,X)):- | |
1271 | var(V), | |
1272 | !, | |
1273 | build_trigger(Triggers,Consequent,X). | |
1274 | ||
1275 | build_trigger([(T1/Test)|Triggers],Consequent,nt(T2,Test2,X)):- | |
1276 | mpred_negation(T1,T2), | |
1277 | !, | |
1278 | build_neg_test(T2,Test,Test2), | |
1279 | build_trigger(Triggers,Consequent,X). | |
1280 | ||
1281 | build_trigger([(T1)|Triggers],Consequent,nt(T2,Test,X)):- | |
1282 | mpred_negation(T1,T2), | |
1283 | !, | |
1284 | build_neg_test(T2,true,Test), | |
1285 | build_trigger(Triggers,Consequent,X). | |
1286 | ||
1287 | build_trigger([{Test}|Triggers],Consequent,(Test->X)):- | |
1288 | !, | |
1289 | build_trigger(Triggers,Consequent,X). | |
1290 | ||
1291 | build_trigger([T/Test|Triggers],Consequent,pt(T,X)):- | |
1292 | !, | |
1293 | build_test(Test,Test2), | |
1294 | build_trigger([{Test2}|Triggers],Consequent,X). | |
1295 | ||
1296 | ||
1297 | %build_trigger([snip|Triggers],Consequent,snip(X)):- | |
1298 | % !, | |
1299 | % build_trigger(Triggers,Consequent,X). | |
1300 | ||
1301 | build_trigger([T|Triggers],Consequent,pt(T,X)):- | |
1302 | !, | |
1303 | build_trigger(Triggers,Consequent,X). | |
1304 | ||
1305 | % | |
1306 | % build_neg_test(+,+,-). | |
1307 | % | |
1308 | % builds the test used in a negative trigger (nt/3). This test is a | |
1309 | % conjunction of the check than no matching facts are in the db and any | |
1310 | % additional test specified in the rule attached to this - term. | |
1311 | % | |
1312 | ||
1313 | build_neg_test(T,Testin,Testout):- | |
1314 | build_test(Testin,Testmid), | |
1315 | %% | |
1316 | mpred_conjoin((call_u(T)),Testmid,Testout). | |
1317 | ||
1318 | ||
1319 | % this just strips away any currly brackets. | |
1320 | ||
1321 | build_test({Test},Test):- !. | |
1322 | build_test(Test,Test). | |
1323 | ||
1324 | ||
1325 | ||
1326 | ||
1327 | % simple typeing for Pfc objects | |
1328 | ||
1329 | mpred_db_type(Var,Type):- var(Var),!, Type=fact(_FT). | |
1330 | mpred_db_type(~_,Type):- !, Type=fact(_FT). | |
1331 | mpred_db_type(('==>'(_,_)),Type):- !, Type=rule. | |
1332 | - | % restore, reset, etc.0 |
1332 | + | |
1333 | mpred_db_type(('<-'(_,_)),Type):- !, Type=rule. | |
1334 | mpred_db_type(pt(_,_,_),Type):- !, Type=trigger. | |
1335 | mpred_db_type(pt(_,_),Type):- !, Type=trigger. | |
1336 | mpred_db_type(nt(_,_,_),Type):- !, Type=trigger. | |
1337 | mpred_db_type(bt(_,_),Type):- !, Type=trigger. | |
1338 | mpred_db_type(actn(_),Type):- !, Type=action. | |
1339 | mpred_db_type((('::::'(_,X))),Type):- !, mpred_db_type(X,Type). | |
1340 | mpred_db_type(((':'(_,X))),Type):- !, mpred_db_type(X,Type). | |
1341 | mpred_db_type(_,fact(_FT)):- | |
1342 | % if it''s not one of the above, it must be a fact! | |
1343 | !. | |
1344 | ||
1345 | mpred_assert_w_support(P,Support):- | |
1346 | (mpred_clause_u(P) ; assert_u(P)), | |
1347 | !, | |
1348 | mpred_add_support(P,Support). | |
1349 | ||
1350 | mpred_asserta_w_support(P,Support):- | |
1351 | (mpred_clause_u(P) ; asserta_u(P)), | |
1352 | !, | |
1353 | mpred_add_support(P,Support). | |
1354 | ||
1355 | mpred_assertz_w_support(P,Support):- | |
1356 | (mpred_clause_u(P) ; assertz_u(P)), | |
1357 | !, | |
1358 | mpred_add_support(P,Support). | |
1359 | ||
1360 | ||
1361 | ||
1362 | %% mpred_clause_u( ?Head) is semidet. | |
1363 | % | |
1364 | % PFC Clause For Internal Interface. | |
1365 | % | |
1366 | mpred_clause_u((Head:- Body)):- | |
1367 | !, | |
1368 | copy_term((Head:-Body),(Head_copy:-Body_copy)), | |
1369 | clause_u(Head,Body), | |
1370 | variant(Head,Head_copy), | |
1371 | variant(Body,Body_copy). | |
1372 | - | mpred_warn("Couldn't retract_user ~p.~n",[X]). |
1372 | + | |
1373 | mpred_clause_u(Head):- | |
1374 | % find a unit clause identical to Head by finding one which unifies, | |
1375 | % and then checking to see if it is identical | |
1376 | copy_term(Head,Head_copy), | |
1377 | clause_u(Head_copy,true), | |
1378 | variant(Head,Head_copy). | |
1379 | ||
1380 | ||
1381 | ||
1382 | %% foreachl_do( ?Binder, ?Body) is semidet. | |
1383 | % | |
1384 | % Foreachl Do. | |
1385 | % | |
1386 | foreachl_do(Binder,Body):- Binder,pfcl_do(Body),fail. | |
1387 | foreachl_do(_,_). | |
1388 | ||
1389 | ||
1390 | %% pfcl_do( ?X) is semidet. | |
1391 | % | |
1392 | % executes X once and always succeeds. | |
1393 | % | |
1394 | pfcl_do(X):- X,!. | |
1395 | pfcl_do(_). | |
1396 | ||
1397 | ||
1398 | %% mpred_union(L1,L2,L3) is semidet. | |
1399 | % | |
1400 | % true if set L3 is the result of appending sets | |
1401 | % L1 and L2 where sets are represented as simple lists. | |
1402 | % | |
1403 | mpred_union([],L,L). | |
1404 | mpred_union([Head|Tail],L,Tail2):- | |
1405 | - | call(C). |
1405 | + | |
1406 | !, | |
1407 | mpred_union(Tail,L,Tail2). | |
1408 | mpred_union([Head|Tail],L,[Head|Tail2]):- | |
1409 | mpred_union(Tail,L,Tail2). | |
1410 | ||
1411 | ||
1412 | % mpred_conjoin(+Conjunct1,+Conjunct2,?Conjunction). | |
1413 | % arg3 is a simplified expression representing the conjunction of | |
1414 | % args 1 and 2. | |
1415 | ||
1416 | mpred_conjoin(true,X,X):- !. | |
1417 | mpred_conjoin(X,true,X):- !. | |
1418 | mpred_conjoin(C1,C2,(C1,C2)). | |
1419 | ||
1420 | ||
1421 | ||
1422 | % File : pfcdb.pl | |
1423 | % Author : Tim Finin, finin@prc.unisys.com | |
1424 | % Author : Dave Matuszek, dave@prc.unisys.com | |
1425 | % Author : Dan Corpron | |
1426 | % Updated: 10/11/87, ... | |
1427 | % Purpose: predicates to manipulate a Pfc database (e.g. save, | |
1428 | % restore, reset, etc.) | |
1429 | ||
1430 | % mpred_database_term(P/A) is true iff P/A is something that Pfc adds to | |
1431 | % the database and should not be present in an empty Pfc database | |
1432 | ||
1433 | - | mpred_trace_mpred_ain(P):- |
1433 | + | |
1434 | - | % this is here for upward compat. - should go away eventually. |
1434 | + | |
1435 | - | mpred_trace_mpred_ain(P,(o,o)). |
1435 | + | |
1436 | mpred_database_term(nt/3). | |
1437 | mpred_database_term(qu/1). | |
1438 | - | mpred_ain_special_support(Fact,Support):- fail, |
1438 | + | |
1439 | - | Support = (How,pt(How2,rhs([Fact]))), |
1439 | + | |
1440 | - | ignore(((mpred_ain_trigger_reprop(nt(How,(mpred_CALL(How2)),rhs([Fact])),(How==>Fact,How)),fail))), |
1440 | + | |
1441 | - | dmsg('~n \\\\^ Extra ^// ~n',[]), |
1441 | + | |
1442 | mpred_database_term('~'/1). | |
1443 | - | mpred_ain_special_support(P,S):-mpred_trace_mpred_ain(P,S),!. |
1443 | + | |
1444 | %% mpred_reset() is det. | |
1445 | - | mpred_trace_mpred_ain(P,S):- |
1445 | + | |
1446 | - | notrace(( |
1446 | + | |
1447 | - | mpred_trace_add_print(P,S), |
1447 | + | |
1448 | - | mpred_trace_break(P,S))). |
1448 | + | |
1449 | clause_u(spft(P,F,Trigger),true), | |
1450 | mpred_retract_i_or_warn(P), | |
1451 | - | mpred_trace_add_print(P,S):- |
1451 | + | |
1452 | - | mpred_is_tracing_pred(P), !, |
1452 | + | |
1453 | mpred_reset:- | |
1454 | - | \+ \+ |
1454 | + | |
1455 | mpred_error("Pfc database not empty after mpred_reset, e.g., ~p.~n",[T]). | |
1456 | - | -> wdmsg("~NAdding (~p) ~p",[U,P]) |
1456 | + | |
1457 | - | ; wdmsg("~NAdding (:) ~p~NSupported By: ~p",[P,S]))),!. |
1457 | + | |
1458 | % true if there is some Pfc crud still in the database. | |
1459 | mpred_database_item(Term):- | |
1460 | mpred_database_term(P/A), | |
1461 | - | mpred_trace_add_print(_,_). |
1461 | + | |
1462 | clause_u(Term,_). | |
1463 | ||
1464 | - | mpred_trace_break(P,_ZS):- |
1464 | + | |
1465 | - | mpred_is_spying_pred(P,add) -> |
1465 | + | |
1466 | - | (wdmsg("~NBreaking on mpred_ain(~p)",[P]), |
1466 | + | |
1467 | - | break) |
1467 | + | |
1468 | - | ; true. |
1468 | + | mpred_warn("Couldn't retract_u ~p.~n",[X]). |
1469 | ||
1470 | ||
1471 | ||
1472 | - | mpred_trace_rem(pt(_,_)):- |
1472 | + | |
1473 | - | % hack for now - never trace triggers. |
1473 | + | |
1474 | % Author : Tim Finin, finin@prc.unisys.com | |
1475 | - | mpred_trace_rem(nt(_,_)):- |
1475 | + | |
1476 | - | % hack for now - never trace triggers. |
1476 | + | |
1477 | % Purpose: provides predicates for examining the database and debugginh | |
1478 | % for Pfc. | |
1479 | /* | |
1480 | - | mpred_trace_rem(P):- |
1480 | + | |
1481 | - | (mpred_is_tracing_pred(P) |
1481 | + | |
1482 | - | -> wdmsg('~NRemoving ~p.',[P]) |
1482 | + | |
1483 | - | ; true), |
1483 | + | |
1484 | - | (mpred_is_spying_pred(P,mpred_withdraw) |
1484 | + | |
1485 | - | -> (wdmsg("~NBreaking on mpred_withdraw(~p)",[P]), |
1485 | + | |
1486 | - | break) |
1486 | + | |
1487 | - | ; true). |
1487 | + | |
1488 | % mpred_fact(P) is true if fact P was asserted into the database via add. | |
1489 | ||
1490 | mpred_fact(P):- mpred_fact(P,true). | |
1491 | ||
1492 | % mpred_fact(P,C) is true if fact P was asserted into the database via | |
1493 | % add and contdition C is satisfied. For example, we might do: | |
1494 | % | |
1495 | % mpred_fact(X,mpred_userFact(X)) | |
1496 | % | |
1497 | ||
1498 | mpred_fact(P,C):- | |
1499 | mpred_get_support(P,_), | |
1500 | mpred_db_type(P,fact(_FT)), | |
1501 | call_u(C). | |
1502 | ||
1503 | % mpred_facts(-ListofPmpred_facts) returns a list of facts added. | |
1504 | ||
1505 | mpred_facts(L):- mpred_facts(_,true,L). | |
1506 | ||
1507 | mpred_facts(P,L):- mpred_facts(P,true,L). | |
1508 | ||
1509 | % mpred_facts(Pattern,Condition,-ListofPmpred_facts) returns a list of facts added. | |
1510 | ||
1511 | %% mpred_facts( ?P, ?C, ?L) is semidet. | |
1512 | % | |
1513 | % PFC Facts. | |
1514 | % | |
1515 | mpred_facts(P,C,L):- setof(P,mpred_fact(P,C),L). | |
1516 | ||
1517 | ||
1518 | %% brake( ?X) is semidet. | |
1519 | % | |
1520 | % Brake. | |
1521 | % | |
1522 | brake(X):- X, break. | |
1523 | ||
1524 | ||
1525 | % | |
1526 | % predicates providing a simple tracing facility | |
1527 | % | |
1528 | ||
1529 | % this is here for upward compat. - should go away eventually. | |
1530 | mpred_trace_op(Add,P):- | |
1531 | mpred_trace_op(Add,P,(o,o)). | |
1532 | ||
1533 | ||
1534 | mpred_trace_op(Add,P,S):- | |
1535 | mpred_trace_maybe_print(Add,P,S), | |
1536 | - | mpred_trace_msg(MsgArgs):-mpred_trace_msg('~p',[MsgArgs]). |
1536 | + | mpred_trace_maybe_break(Add,P,S). |
1537 | ||
1538 | - | mpred_trace_msg(Msg,Args):- notrace((tracing,in_cmt(wdmsg(Msg, Args)))),!. |
1538 | + | |
1539 | - | mpred_trace_msg(Msg,Args):- |
1539 | + | mpred_trace_maybe_print(Add,P,S):- |
1540 | - | mpred_is_tracing_exec, |
1540 | + | \+ lookup_u(mpred_is_tracing_pred(P)) -> true; |
1541 | - | !, |
1541 | + | |
1542 | - | in_cmt(wdmsg(Msg, Args)). |
1542 | + | |
1543 | -> wdmsg("~NOP: ~p (~p) ~p",[Add,U,P]) | |
1544 | - | mpred_trace_msg(_ZMsg,_ZArgs). |
1544 | + | ; wdmsg("~NOP: ~p (:) ~p~N\tSupported By: ~p",[Add,P,S]))),!. |
1545 | ||
1546 | ||
1547 | mpred_trace_maybe_break(Add,P,_ZS):- | |
1548 | \+ lookup_u(mpred_is_spying_pred(P,Add)) -> true; | |
1549 | (wdmsg("~NBreaking on ~p(~p)",[Add,P]), | |
1550 | break). | |
1551 | - | mpred_error(Msg):- mpred_error(Msg,[]). |
1551 | + | |
1552 | ||
1553 | - | mpred_error(Msg,Args):- |
1553 | + | |
1554 | - | dmsg("~NERROR/Pfc: ",[]), |
1554 | + | |
1555 | - | dmsg(Msg,Args). |
1555 | + | |
1556 | ||
1557 | - | mpred_test(\+ G):-!, ( \+ G -> wdmsg(passed_mpred_test(\+ G)) ; (wdmsg(failed_mpred_test(\+ G)),!,ignore(pfc_why(G)),!,fail)). |
1557 | + | |
1558 | - | mpred_test(G):- (G -> must(mpred_why(G)) ; (wdmsg(failed_mpred_test(G)),!,fail)). |
1558 | + | |
1559 | ||
1560 | ||
1561 | - | mpred_load_term(:- module(_,L)):-!, maplist(export,L). |
1561 | + | |
1562 | - | mpred_load_term(:- TermO):-call(TermO). |
1562 | + | |
1563 | % | |
1564 | % PFC Trace. | |
1565 | % | |
1566 | mpred_trace(Form,Condition):- | |
1567 | assert_u((mpred_is_tracing_pred(Form):- Condition)). | |
1568 | ||
1569 | mpred_spy(Form):- mpred_spy(Form,[add,rem],true). | |
1570 | ||
1571 | mpred_spy(Form,Modes):- mpred_spy(Form,Modes,true). | |
1572 | ||
1573 | mpred_spy(Form,[add,rem],Condition):- | |
1574 | !, | |
1575 | mpred_spy1(Form,add,Condition), | |
1576 | mpred_spy1(Form,mpred_withdraw,Condition). | |
1577 | ||
1578 | mpred_spy(Form,Mode,Condition):- | |
1579 | mpred_spy1(Form,Mode,Condition). | |
1580 | ||
1581 | mpred_spy1(Form,Mode,Condition):- | |
1582 | assert_u((mpred_is_spying_pred(Form,Mode):- Condition)). | |
1583 | ||
1584 | mpred_nospy:- mpred_nospy(_,_,_). | |
1585 | ||
1586 | mpred_nospy(Form):- mpred_nospy(Form,_,_). | |
1587 | ||
1588 | mpred_nospy(Form,Mode,Condition):- | |
1589 | clause_u(mpred_is_spying_pred(Form,Mode), Condition, Ref), | |
1590 | erase(Ref), | |
1591 | fail. | |
1592 | mpred_nospy(_,_,_). | |
1593 | ||
1594 | - | mpred_warn(Msg):- mpred_warn(Msg,[]). |
1594 | + | |
1595 | mpred_untrace:- mpred_untrace(_). | |
1596 | - | mpred_warn(Msg,Args):- |
1596 | + | |
1597 | - | format(string(S),Msg,Args), |
1597 | + | |
1598 | - | (mpred_warnings(true) -> wdmsg(warn(mpred_,S)) ; mpred_trace_msg('WARNING/PFC: ~s',[S])),!. |
1598 | + | |
1599 | ||
1600 | ||
1601 | % if the correct flag is set, trace exection of Pfc | |
1602 | mpred_trace_msg(Info):- notrace(((lookup_u(mpred_is_tracing_exec);tracing)->in_cmt(wdmsg(Info));true)). | |
1603 | mpred_trace_msg(Format,Args):- notrace((format_to_message(Format,Args,Info),mpred_trace_msg(Info))). | |
1604 | ||
1605 | mpred_warn(Info):- notrace((lookup_u(mpred_warnings(true));tracing) -> wdmsg(warn(mpred,Info)) ; mpred_trace_msg('WARNING/PFC: ~p',[Info])). | |
1606 | mpred_warn(Format,Args):- notrace((format_to_message(Format,Args,Info),mpred_warn(Info))). | |
1607 | ||
1608 | mpred_error(Info):- notrace(tracing -> wdmsg(error(pfc,Info)) ; mpred_warn(error(Info))). | |
1609 | mpred_error(Format,Args):- notrace((format_to_message(Format,Args,Info),mpred_error(Info))). | |
1610 | ||
1611 | ||
1612 | mpred_watch:- assert_u(mpred_is_tracing_exec). | |
1613 | mpred_trace_exec:- assert_u(mpred_is_tracing_exec). | |
1614 | ||
1615 | mpred_noWatch:- retractall_u(mpred_is_tracing_exec). | |
1616 | ||
1617 | mpred_test(G):- must(mpred_test_fok(G)). | |
1618 | ||
1619 | mpred_test_fok(\+ G):-!, ( \+ call_u(G) -> wdmsg(passed_mpred_test(\+ G)) ; (wdmsg(failed_mpred_test(\+ G)),!,ignore(mpred_why(G)),!,fail)). | |
1620 | mpred_test_fok(G):- (call_u(G) -> sanity(mpred_why(G)) ; (wdmsg(failed_mpred_test(G)),!,fail)). | |
1621 | ||
1622 | ||
1623 | mpred_load_term(:- module(_,L)):-!, call_u(maplist(export,L)). | |
1624 | mpred_load_term(:- TermO):- call_u(TermO). | |
1625 | mpred_load_term(TermO):-mpred_ain_object(TermO). | |
1626 | ||
1627 | mpred_load(PLNAME):- % unload_file(PLNAME), | |
1628 | open(PLNAME, read, In, []), | |
1629 | repeat, | |
1630 | line_count(In,_Lineno), | |
1631 | % double_quotes(_DQBool) | |
1632 | Options = [variables(_Vars),variable_names(VarNames),singletons(_Singletons),comment(_Comment)], | |
1633 | catchv((read_term(In,Term,[syntax_errors(error)|Options])),E,(dmsg(E),fail)), | |
1634 | b_setval('$variable_names',VarNames),expand_term(Term,TermO),mpred_load_term(TermO), | |
1635 | Term==end_of_file, | |
1636 | close(In). | |
1637 | ||
1638 | % | |
1639 | % These control whether or not warnings are printed at all. | |
1640 | % mpred_warn. | |
1641 | % nompred_warn. | |
1642 | % | |
1643 | % These print a warning message if the flag mpred_warnings is set. | |
1644 | % mpred_warn(+Message) | |
1645 | % mpred_warn(+Message,+ListOfArguments) | |
1646 | % | |
1647 | ||
1648 | mpred_warn:- | |
1649 | retractall_u(mpred_warnings(_)), | |
1650 | assert_u(mpred_warnings(true)). | |
1651 | ||
1652 | nompred_warn:- | |
1653 | retractall_u(mpred_warnings(_)), | |
1654 | assert_u(mpred_warnings(false)). | |
1655 | ||
1656 | ||
1657 | %% mpred_set_warnings(+TF) is det. | |
1658 | % true = sets flag to cause Pfc warning messages to print. | |
1659 | % false = sets flag to cause Pfc warning messages not to print. | |
1660 | % | |
1661 | mpred_set_warnings(True):- | |
1662 | retractall_u(mpred_warnings(_)), | |
1663 | assert_u(mpred_warnings(True)). | |
1664 | mpred_set_warnings(false):- | |
1665 | retractall_u(mpred_warnings(_)). | |
1666 | ||
1667 | % File : pfcjust.pl | |
1668 | % Author : Tim Finin, finin@prc.unisys.com | |
1669 | % Author : Dave Matuszek, dave@prc.unisys.com | |
1670 | % Updated: | |
1671 | % Purpose: predicates for accessing Pfc mpred_justification_S. | |
1672 | % Status: more or less working. | |
1673 | % Bugs: | |
1674 | ||
1675 | % *** predicates for exploring supports of a fact ***** | |
1676 | ||
1677 | ||
1678 | :- use_module(library(lists)). | |
1679 | ||
1680 | mpred_justification(F,J):- supporters_list(F,J). | |
1681 | ||
1682 | mpred_justification_S(F,Js):- bagof(J,mpred_justification(F,J),Js). | |
1683 | ||
1684 | ||
1685 | ||
1686 | %% mpred_basis_list(+P,-L) | |
1687 | % | |
1688 | % is true iff L is a list of "base" facts which, taken | |
1689 | % together, allows us to deduce P. A mpred "based on" list fact is an axiom (a fact | |
1690 | % added by the user or a raw Prolog fact (i.e. one w/o any support)) | |
1691 | % or an assumption. | |
1692 | % | |
1693 | mpred_basis_list(F,[F]):- (mpred_axiom(F) ; mpred_assumption(F)),!. | |
1694 | ||
1695 | mpred_basis_list(F,L):- | |
1696 | % i.e. (reduce 'append (map 'mpred_basis_list (mpred_justification f))) | |
1697 | mpred_justification(F,Js), | |
1698 | bases_union(Js,L). | |
1699 | ||
1700 | ||
1701 | %% bases_union(+L1,+L2). | |
1702 | % | |
1703 | % is true if list L2 represents the union of all of the | |
1704 | % facts on which some conclusion in list L1 is based. | |
1705 | % | |
1706 | bases_union([],[]). | |
1707 | bases_union([X|Rest],L):- | |
1708 | mpred_basis_list(X,Bx), | |
1709 | bases_union(Rest,Br), | |
1710 | mpred_union(Bx,Br,L). | |
1711 | ||
1712 | mpred_axiom(F):- | |
1713 | mpred_get_support(F,(U,U)). | |
1714 | ||
1715 | %% mpred_assumption(P) | |
1716 | % | |
1717 | % an mpred_assumption is a failed goal, i.e. were assuming that our failure to | |
1718 | % prove P is a proof of not(P) | |
1719 | % | |
1720 | mpred_assumption(P):- mpred_negation(P,_). | |
1721 | ||
1722 | ||
1723 | %% mpred_assumptions( +X, +AsSet) is semidet. | |
1724 | % | |
1725 | % true if AsSet is a set of assumptions which underly X. | |
1726 | % | |
1727 | mpred_assumptions(X,[X]):- mpred_assumption(X). | |
1728 | mpred_assumptions(X,[]):- mpred_axiom(X). | |
1729 | mpred_assumptions(X,L):- | |
1730 | mpred_justification(X,Js), | |
1731 | do_assumpts(Js,L). | |
1732 | ||
1733 | ||
1734 | %% do_assumpts(+Set1,?Set2) is semidet. | |
1735 | % | |
1736 | % Assumptions Secondary Helper. | |
1737 | % | |
1738 | do_assumpts([],[]). | |
1739 | do_assumpts([X|Rest],L):- | |
1740 | mpred_assumptions(X,Bx), | |
1741 | do_assumpts(Rest,Br), | |
1742 | mpred_union(Bx,Br,L). | |
1743 | ||
1744 | ||
1745 | % mpred_proofTree(P,T) the proof tree for P is T where a proof tree is | |
1746 | % of the form | |
1747 | % | |
1748 | % [P , J1, J2, ;;; Jn] each Ji is an independent P justifier. | |
1749 | % ^ and has the form of | |
1750 | % [J11, J12,... J1n] a list of proof trees. | |
1751 | ||
1752 | ||
1753 | %% mpred_child(+P,?Q) is semidet. | |
1754 | % | |
1755 | % is true iff P is an immediate justifier for Q. | |
1756 | % | |
1757 | - | spft(P,Fact,Trigger). |
1757 | + | |
1758 | mpred_get_support(Q,(P,_)). | |
1759 | ||
1760 | mpred_child(P,Q):- | |
1761 | mpred_get_support(Q,(_,Trig)), | |
1762 | mpred_db_type(Trig,trigger), | |
1763 | mpred_child(P,Trig). | |
1764 | ||
1765 | ||
1766 | %% mpred_children( ?P, ?L) is semidet. | |
1767 | % | |
1768 | % PFC Children. | |
1769 | % | |
1770 | - | nonvar(Fact), |
1770 | + | |
1771 | ||
1772 | ||
1773 | ||
1774 | %% mpred_descendant( ?P, ?Q) is semidet. | |
1775 | % | |
1776 | % mpred_descendant(P,Q) is true iff P is a justifier for Q. | |
1777 | % | |
1778 | mpred_descendant(P,Q):- | |
1779 | mpred_descendant1(P,Q,[]). | |
1780 | ||
1781 | ||
1782 | %% mpred_descendant1( ?P, ?Q, ?Seen) is semidet. | |
1783 | % | |
1784 | - | spft(P,F,T). |
1784 | + | |
1785 | % | |
1786 | mpred_descendant1(P,Q,Seen):- | |
1787 | mpred_child(X,Q), | |
1788 | (\+ member(X,Seen)), | |
1789 | (P=X ; mpred_descendant1(P,X,[X|Seen])). | |
1790 | ||
1791 | ||
1792 | %% mpred_descendants( ?P, ?L) is semidet. | |
1793 | % | |
1794 | % PFC Descendants. | |
1795 | % | |
1796 | mpred_descendants(P,L):- | |
1797 | bagof(Q,mpred_descendant1(P,Q,[]),L). | |
1798 | ||
1799 | bagof_or_nil(T,G,B):- (bagof(T,G,B) *-> true; B=[]). | |
1800 | ||
1801 | % | |
1802 | % predicates for manipulating support relationships | |
1803 | % | |
1804 | ||
1805 | % mpred_add_support(+Fact,+Support) | |
1806 | mpred_add_support(P,(Fact,Trigger)):- | |
1807 | (Trigger= nt(F,Condition,Action) -> | |
1808 | (mpred_trace_msg('~N~n\tAdding mpred_do_fcnt via support~n\t\ttrigger: ~p~n\t\tcond: ~p~n\t\taction: ~p~n\t from: ~p~N', | |
1809 | [F,Condition,Action,mpred_add_support(P,(Fact,Trigger))]));true), | |
1810 | assert_u(spft(P,Fact,Trigger)). | |
1811 | ||
1812 | mpred_get_support(P,(Fact,Trigger)):- | |
1813 | lookup_u(spft(P,Fact,Trigger)). | |
1814 | ||
1815 | ||
1816 | ||
1817 | mpred_rem_support_if_exists(P,(Fact,Trigger)):- | |
1818 | SPFT = spft(P,Fact,Trigger), | |
1819 | lookup_u(SPFT), | |
1820 | - | pp_supports. |
1820 | + | mpred_retract_i_or_warn(SPFT). |
1821 | ||
1822 | ||
1823 | ||
1824 | % There are three of these to try to efficiently handle the cases | |
1825 | % where some of the arguments are not bound but at least one is. | |
1826 | ||
1827 | mpred_rem_support(P,(Fact,Trigger)):- | |
1828 | mpred_retract_i_or_warn(spft(P,Fact,Trigger)). | |
1829 | ||
1830 | ||
1831 | - | dmsg("~N~nUser added facts:",[]), |
1831 | + | |
1832 | bagof(Tripple, mpred_support_relation(Tripple), Tripples), | |
1833 | - | dmsg("~N~nPfc added facts:",[]), |
1833 | + | |
1834 | mpred_collect_supports([]). | |
1835 | ||
1836 | mpred_support_relation((P,F,T)):- | |
1837 | lookup_u(spft(P,F,T)). | |
1838 | ||
1839 | mpred_make_supports((P,S1,S2)):- | |
1840 | mpred_add_support(P,(S1,S2)), | |
1841 | - | dmsg("~N ~p",[H]), |
1841 | + | |
1842 | !. | |
1843 | ||
1844 | %% mpred_trigger_key(+Trigger,-Key) | |
1845 | % | |
1846 | % Arg1 is a trigger. Key is the best term to index it on. | |
1847 | % | |
1848 | % Get a key from the trigger that will be used as the first argument of | |
1849 | % the trigger base clause that stores the trigger. | |
1850 | ||
1851 | mpred_trigger_key(X,X):- var(X), !. | |
1852 | mpred_trigger_key(pt(Key,_),Key). | |
1853 | mpred_trigger_key(pt(Key,_,_),Key). | |
1854 | mpred_trigger_key(nt(Key,_,_),Key). | |
1855 | mpred_trigger_key(Key,Key). | |
1856 | ||
1857 | % For chart parser | |
1858 | mpred_trigger_key(chart(word(W),_ZL),W):- !. | |
1859 | mpred_trigger_key(chart(stem([Char1|_ZRest]),_ZL),Char1):- !. | |
1860 | mpred_trigger_key(chart(Concept,_ZL),Concept):- !. | |
1861 | - | dmsg("~NRules...~n",[]), |
1861 | + | |
1862 | ||
1863 | ||
1864 | ||
1865 | %%%%%%%%%%%%%%%%%% 99999999999999999999999999999999999999999999 | |
1866 | ||
1867 | %%%%%%%%%%%%%%%%%% 99999999999999999999999999999999999999999999 | |
1868 | ||
1869 | pp_DB:- | |
1870 | - | dmsg("~NPositive triggers...~n",[]), |
1870 | + | must_det_l(( |
1871 | - | bagof_or_nil(pt(T,B),mpred_get_trigger_quick(pt(T,B)),Pts), |
1871 | + | |
1872 | pp_rules, | |
1873 | - | dmsg("~NNegative triggers...~n",[]), |
1873 | + | |
1874 | - | bagof_or_nil(nt(A,B,C),mpred_get_trigger_quick(nt(A,B,C)),Nts), |
1874 | + | pp_supports)). |
1875 | ||
1876 | - | dmsg("~NGoal triggers...~n",[]), |
1876 | + | |
1877 | - | bagof_or_nil(bt(A,B),mpred_get_trigger_quick(bt(A,B)),Bts), |
1877 | + | |
1878 | pp_facts:- ignore(pp_facts(_,true)). | |
1879 | ||
1880 | pp_facts(Pattern):- pp_facts(Pattern,true). | |
1881 | ||
1882 | - | dmsg("~NSupports...~n",[]), |
1882 | + | |
1883 | mpred_facts(P,C,L), | |
1884 | mpred_classifyFacts(L,User,Pfc,_ZRule), | |
1885 | format("~N~nUser added facts:",[]), | |
1886 | pp_items(User), | |
1887 | format("~N~nPfc added facts:",[]), | |
1888 | pp_items(Pfc). | |
1889 | ||
1890 | % printitems clobbers it''s arguments - beware! | |
1891 | ||
1892 | pp_items([]). | |
1893 | pp_items([H|T]):- | |
1894 | numbervars(H,0,_), | |
1895 | format("~N ~p",[H]), | |
1896 | pp_items(T). | |
1897 | ||
1898 | mpred_classifyFacts([],[],[],[]). | |
1899 | ||
1900 | mpred_classifyFacts([H|T],User,Pfc,[H|Rule]):- | |
1901 | mpred_db_type(H,rule), | |
1902 | !, | |
1903 | mpred_classifyFacts(T,User,Pfc,Rule). | |
1904 | ||
1905 | mpred_classifyFacts([H|T],[H|User],Pfc,Rule):- | |
1906 | get_source_ref(UU), | |
1907 | mpred_get_support(H,UU), | |
1908 | !, | |
1909 | mpred_classifyFacts(T,User,Pfc,Rule). | |
1910 | ||
1911 | - | in_cmt((mpred_whyBrouse(P,Js))). |
1911 | + | |
1912 | mpred_classifyFacts(T,User,Pfc,Rule). | |
1913 | ||
1914 | pp_rules:- | |
1915 | - | in_cmt((mpred_whyBrouse(P,Js))). |
1915 | + | format("~NRules...~n",[]), |
1916 | bagof_or_nil((P==>Q),clause_u((P==>Q),true),R1), | |
1917 | pp_items(R1), | |
1918 | bagof_or_nil((P<==>Q),clause_u((P<==>Q),true),R2), | |
1919 | - | mpred_pp_justifications(P,Js), !. |
1919 | + | |
1920 | bagof_or_nil((P<-Q),clause_u((P<-Q),true),R3), | |
1921 | pp_items(R3). | |
1922 | ||
1923 | pp_triggers:- | |
1924 | format("~NPositive triggers...~n",[]), | |
1925 | bagof_or_nil(pt(T,B),lookup_u(pt(T,B)),Pts), | |
1926 | pp_items(Pts), | |
1927 | format("~NNegative triggers...~n",[]), | |
1928 | bagof_or_nil(nt(A,B,C),lookup_u(nt(A,B,C)),Nts), | |
1929 | pp_items(Nts), | |
1930 | - | dmsg("~N |
1930 | + | format("~NGoal triggers...~n",[]), |
1931 | bagof_or_nil(bt(A,B),lookup_u(bt(A,B)),Bts), | |
1932 | pp_items(Bts). | |
1933 | ||
1934 | pp_supports:- | |
1935 | % temporary hack. | |
1936 | format("~NSupports...~n",[]), | |
1937 | setof((P >= S), mpred_get_support(P,S),L), | |
1938 | pp_items(L). | |
1939 | - | floactn(N), |
1939 | + | |
1940 | ||
1941 | % File : mpred_why.pl | |
1942 | % Author : Tim Finin, finin@prc.unisys.com | |
1943 | % Updated: | |
1944 | % Purpose: predicates for interactively exploring Pfc mpred_justification_S. | |
1945 | ||
1946 | % ***** predicates for brousing mpred_justification_S ***** | |
1947 | ||
1948 | :- use_module(library(lists)). | |
1949 | ||
1950 | mpred_why:- | |
1951 | - | dmsg("~N~p is a yet unimplemented command.",[N]), |
1951 | + | |
1952 | mpred_why(P). | |
1953 | ||
1954 | mpred_why(N):- | |
1955 | - | dmsg("~N~p is an unrecognized command, enter h. for help.",[X]), |
1955 | + | |
1956 | !, | |
1957 | why_buffer(P,Js), | |
1958 | mpred_handle_why_command(N,P,Js). | |
1959 | - | dmsg("~NJustifications for ~p:",[P]), |
1959 | + | |
1960 | - | mpred_pp_justification1(Js,1). |
1960 | + | |
1961 | mpred_why(P):- | |
1962 | mpred_justification_S(P,Js), | |
1963 | retractall_u(why_buffer(_,_)), | |
1964 | assert_u(why_buffer(P,Js)), | |
1965 | mpred_whyBrouse(P,Js). | |
1966 | ||
1967 | mpred_why1(P):- | |
1968 | mpred_justification_S(P,Js), | |
1969 | mpred_whyBrouse(P,Js). | |
1970 | ||
1971 | % non-interactive | |
1972 | mpred_whyBrouse(P,Js):- | |
1973 | must(notrace(in_cmt((mpred_pp_justifications(P,Js))))), !. | |
1974 | ||
1975 | % Interactive | |
1976 | mpred_whyBrouse(P,Js):- | |
1977 | - | dmsg("~N ~p.~p ~p",[JustNo,StepNo,CCopy]), |
1977 | + | |
1978 | mpred_prompt_ask(' >> ',Answer), | |
1979 | mpred_handle_why_command(Answer,P,Js). | |
1980 | ||
1981 | - | mpred_prompt_ask(Msg,Ans):- |
1981 | + | |
1982 | - | dmsg("~N~p",[Msg]), |
1982 | + | |
1983 | !, | |
1984 | format("~N | |
1985 | Justification Brouser Commands: | |
1986 | q quit. | |
1987 | N focus on Nth mpred_justification. | |
1988 | N.M brouse step M of the Nth mpred_justification | |
1989 | user up a level ~n", | |
1990 | []). | |
1991 | ||
1992 | mpred_handle_why_command(N,_ZP,Js):- | |
1993 | float(N), | |
1994 | !, | |
1995 | mpred_select_justification_node(Js,N,Node), | |
1996 | mpred_why1(Node). | |
1997 | ||
1998 | - | tms(Mode), |
1998 | + | |
1999 | % u=up | |
2000 | !. | |
2001 | ||
2002 | mpred_unhandled_command(N,_,_):- | |
2003 | integer(N), | |
2004 | !, | |
2005 | format("~N~p is a yet unimplemented command.",[N]), | |
2006 | fail. | |
2007 | ||
2008 | mpred_unhandled_command(X,_,_):- | |
2009 | format("~N~p is an unrecognized command, enter h. for help.",[X]), | |
2010 | fail. | |
2011 | ||
2012 | mpred_pp_justifications(P,Js):- | |
2013 | must(notrace(( format("~NJustifications for ~p:",[P]), | |
2014 | mpred_pp_justification1(Js,1)))). | |
2015 | ||
2016 | mpred_pp_justification1([],_). | |
2017 | ||
2018 | mpred_pp_justification1([J|Js],N):- | |
2019 | % show one mpred_justification and recurse. | |
2020 | nl, | |
2021 | mpred_pp_justifications2(J,N,1), | |
2022 | N2 is N+1, | |
2023 | mpred_pp_justification1(Js,N2). | |
2024 | ||
2025 | mpred_pp_justifications2([],_,_). | |
2026 | ||
2027 | mpred_pp_justifications2([C|Rest],JustNo,StepNo):- | |
2028 | (StepNo==1->fmt('~N~n',[]);true), | |
2029 | copy_term(C,CCopy), | |
2030 | numbervars(CCopy,0,_), | |
2031 | format("~N ~p.~p ~p",[JustNo,StepNo,CCopy]), | |
2032 | StepNext is 1+StepNo, | |
2033 | mpred_pp_justifications2(Rest,JustNo,StepNext). | |
2034 | ||
2035 | mpred_prompt_ask(Info,Ans):- | |
2036 | format("~N~p",[Info]), | |
2037 | read(Ans). | |
2038 | ||
2039 | mpred_select_justification_node(Js,Index,Step):- | |
2040 | JustNo is integer(Index), | |
2041 | nth1(JustNo,Js,Justification), | |
2042 | StepNo is 1+ integer(Index*10 - JustNo*10), | |
2043 | nth1(StepNo,Justification,Step). | |
2044 | ||
2045 | ||
2046 | %% mpred_supported(+P) is semidet. | |
2047 | % | |
2048 | % succeeds if P is "supported". What this means | |
2049 | % depends on the TMS mode selected. | |
2050 | % | |
2051 | mpred_supported(P):- | |
2052 | get_tms_mode(P,Mode), | |
2053 | mpred_supported(Mode,P). | |
2054 | ||
2055 | get_tms_mode(_P,Mode):- lookup_u(tms(Mode)),!. | |
2056 | get_tms_mode(_P,Mode):- must(Mode=local). | |
2057 | ||
2058 | %% mpred_supported(+TMS,+P) is semidet. | |
2059 | % | |
2060 | % succeeds if P is "supported". What this means | |
2061 | % depends on the TMS mode supplied. | |
2062 | % | |
2063 | mpred_supported(local,P):- !, mpred_get_support(P,_). | |
2064 | mpred_supported(cycles,P):- !, well_founded(P). | |
2065 | mpred_supported(_,_):- true. | |
2066 | - | :- source_location(S,_),prolog_load_context(module,M),forall(source_file(M:H,S),(functor(H,F,A),M:module_transparent(M:F/A))). |
2066 | + | |
2067 | - | :- source_location(S,_),forall(source_file(H,S),(functor(H,F,A),pfc:module_transparent(pfc:F/A))). |
2067 | + | |
2068 | %% well_founded(+Fact) is semidet. | |
2069 | - | %end_of_file. |
2069 | + | |
2070 | % a fact is well founded if it is supported by the user | |
2071 | % or by a set of facts and a rules, all of which are well founded. | |
2072 | % | |
2073 | well_founded(Fact):- with_each_item(well_founded_0,Fact,[]). | |
2074 | ||
2075 | well_founded_0(F,_):- | |
2076 | % supported by user (mpred_axiom) or an "absent" fact (mpred_assumption). | |
2077 | (mpred_axiom(F) ; mpred_assumption(F)), | |
2078 | !. | |
2079 | ||
2080 | well_founded_0(F,Descendants):- | |
2081 | % first make sure we aren't in a loop. | |
2082 | (\+ memberchk(F,Descendants)), | |
2083 | - | :- dynamic((current_ooZz/1,default_ooZz/1,if_mooZz/2)). |
2083 | + | |
2084 | supporters_list(F,Supporters), | |
2085 | % all of whose members are well founded. | |
2086 | well_founded_list(Supporters,[F|Descendants]), | |
2087 | !. | |
2088 | ||
2089 | %% well_founded_list(+List,-Decendants) is det. | |
2090 | - | :- mpred_ain((if_mooZz(Missing,Create) ==> |
2090 | + | |
2091 | - | ( ( \+ Missing/(Missing\=@=Create)) ==> Create))). |
2091 | + | |
2092 | % | |
2093 | well_founded_list([],_). | |
2094 | well_founded_list([X|Rest],L):- | |
2095 | well_founded_0(X,L), | |
2096 | well_founded_list(Rest,L). | |
2097 | ||
2098 | %% supporters_list(+F,-ListofSupporters) is det. | |
2099 | - | :- pp_DB. |
2099 | + | |
2100 | % where ListOfSupports is a list of the | |
2101 | % supports for one mpred_justification for fact F -- i.e. a list of facts which, | |
2102 | % together allow one to deduce F. One of the facts will typically be a rule. | |
2103 | % The supports for a user-defined fact are: [u]. | |
2104 | % | |
2105 | supporters_list(F,[Fact|MoreFacts]):- | |
2106 | mpred_get_support(F,(Fact,Trigger)), | |
2107 | triggerSupports(Trigger,MoreFacts). | |
2108 | ||
2109 | triggerSupports(U,[]):- get_source_ref1(U),!. | |
2110 | triggerSupports(Trigger,[Fact|MoreFacts]):- | |
2111 | mpred_get_support(Trigger,(Fact,AnotherTrigger)), | |
2112 | triggerSupports(AnotherTrigger,MoreFacts). | |
2113 | ||
2114 | ||
2115 | % :- mpred_set_default(mpred_warnings(_), mpred_warnings(true)). | |
2116 | :- asserta(mpred_warnings(true)). | |
2117 | ||
2118 | ||
2119 | :- module_transparent((mpred_clause_u)/1). | |
2120 | :- module_transparent((mpred_remove1)/2). | |
2121 | :- module_transparent((mpred_te)/2). | |
2122 | :- module_transparent((mpred_te)/0). | |
2123 | - | :- mpred_test(current_ooZz(booZz)). |
2123 | + | :- module_transparent((mpred_current_db)/1). |
2124 | :- module_transparent((isSlot)/1). | |
2125 | :- module_transparent((listing_u)/1). | |
2126 | :- module_transparent((mpred_test_fok)/1). | |
2127 | :- module_transparent((mpred_test)/1). | |
2128 | :- module_transparent((set_umt)/1). | |
2129 | :- module_transparent((get_umt)/1). | |
2130 | :- module_transparent((get_source_ref1)/1). | |
2131 | :- module_transparent((get_source_ref)/1). | |
2132 | :- module_transparent((setup_mpred_ops)/0). | |
2133 | :- module_transparent((mpred_load_term)/1). | |
2134 | :- module_transparent((call_u)/1). | |
2135 | :- module_transparent((mpred_BC)/1). | |
2136 | :- module_transparent((mpred_BC_w_cache)/1). | |
2137 | ||
2138 | ||
2139 | ||
2140 | ||
2141 | :- source_location(S,_),prolog_load_context(module,M),forall(source_file(M:H,S),ignore((functor(H,F,A), | |
2142 | \+ predicate_property(M:H,transparent), | |
2143 | dmsg('~N:- M:module_transparent(~q:(~q)/~q).~n',[M,F,A]), | |
2144 | M:module_transparent(M:F/A)))). | |
2145 | %:- source_location(S,_),forall(source_file(H,S),(functor(H,F,A),pfc:module_transparent(pfc:F/A))). | |
2146 | ||
2147 | :- must(mpred_reset). | |
2148 | ||
2149 | % end_of_file. | |
2150 | ||
2151 | :- use_module(library(logicmoo_utils)). | |
2152 | :- use_listing_vars. | |
2153 | ||
2154 | % local_testing | |
2155 | % end_of_file. | |
2156 | ||
2157 | % local_testing | |
2158 | % :- use_module(library(pfc)). | |
2159 | ||
2160 | :- mpred_reset. | |
2161 | ||
2162 | ||
2163 | :- get_umt(M),M:dynamic((current_ooZz/1,default_ooZz/1,if_mooZz/2)). | |
2164 | ||
2165 | :- mpred_trace. | |
2166 | :- mpred_watch. | |
2167 | ||
2168 | ||
2169 | % this should have been ok | |
2170 | % (if_mooZz(Missing,Create) ==> ((\+ Missing/(Missing\==Create), \+ Create , \+ ~(Create)) ==> Create)). | |
2171 | :- ((mpred_ain((if_mooZz(Missing,Create) ==> | |
2172 | ( ( \+ Missing/(Missing\=@=Create)) ==> Create))))). | |
2173 | ||
2174 | :- mpred_ain((default_ooZz(X) ==> if_mooZz(current_ooZz(_),current_ooZz(X)))). | |
2175 | ||
2176 | :- mpred_ain(default_ooZz(booZz)). | |
2177 | ||
2178 | :- mpred_test(current_ooZz(booZz)). | |
2179 | ||
2180 | % :- pp_DB. | |
2181 | ||
2182 | :- (mpred_ain(current_ooZz(fooZz))). | |
2183 | ||
2184 | :- mpred_test(\+current_ooZz(booZz)). | |
2185 | ||
2186 | :- (mpred_ain(\+ current_ooZz(fooZz))). | |
2187 | ||
2188 | :- mpred_test(current_ooZz(booZz)). | |
2189 | ||
2190 | :- (mpred_withdraw( default_ooZz(booZz) )). | |
2191 | ||
2192 | :- listing([current_ooZz,default_ooZz]). | |
2193 | ||
2194 | :- mpred_test( \+current_ooZz(booZz)). | |
2195 | ||
2196 | :- mpred_ain(~ current_ooZz(fooZz)). | |
2197 | ||
2198 | % :- pp_DB. | |
2199 | ||
2200 | :- mpred_test(~current_ooZz(fooZz)). | |
2201 | ||
2202 | :- mpred_ain(default_ooZz(booZz)). | |
2203 | ||
2204 | :- mpred_test(current_ooZz(booZz)). | |
2205 | ||
2206 | :- mpred_reset. |