API tools faq
paste
Advertisement
logicmoo

mpred_pfc

logicmoo
Nov 19th, 2015
353
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 62.83 KB | None | 0 0
raw download clone embed print report diff
  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.   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,
  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_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_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,
  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_descendants/2,mpred_enqueue/2,mpred_error/1,mpred_error/2,mpred_eval_lhs/2,mpred_eval_rhs/2,mpred_fact/1,
  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_nospy/0,mpred_nospy/1,mpred_nospy/3,mpred_positive_literal/1,mpred_post/2,lqu/0,mpred_undo_action/1,
  38.   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,
  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.   mpred_unfwc_check_triggers/1,mpred_union/3,mpred_unique_u/1,mpred_untrace/0,mpred_untrace/1,mpred_warn/0,mpred_warn/1,
  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.   nompred_warn/0,pfcl_do/1,pp_DB/0,pp_facts/0,pp_facts/1,pp_facts/2,pp_items/1,
  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.   mpred_post1/2,mpred_withdraw/1,mpred_withdraw/2,mpred_remove/1,mpred_remove/2,mpred_pp_justification1/2,mpred_pp_justifications2/3,mpred_spy1/3,
  58.   mpred_unfwc1/1,mpred_why1/1,mpred_blast/1,trigger_trigger1/2  ]).
  59.  
  60.  :- meta_predicate
  61.       get_umt(-),
  62.       with_each_item(2,+,+),
  63.       with_each_item(1,+),
  64.       pfcl_do(0),
  65.       mpred_get_support(+,-),
  66.       mpred_fact(?,0),
  67.       mpred_CALL_MI(1,-,+),
  68.       mpred_CALL(1,-,+),
  69.       mpred_CALL(1,+),
  70.       mpred_CALL(+),
  71.       mpred_BC(+),
  72.       mpred_BC_CACHE(+),
  73.       foreachl_do(0,-),
  74.       fc_eval_action(0,-),
  75.       clause_u(+,+,-),
  76.       call_u(+),
  77.       call_u2(+),
  78.       brake(0),
  79.       bagof_or_nil(?,^,-).
  80.  
  81. :- module_transparent(mpred_pfc_d:(call_u)/1).
  82.  
  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.  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.                         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.                         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.  
  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.   call_u/1,asserta_u/1,assert_u/1,assertz_u/1,retract_u/1,retractall_u/1,clause_u/2,clause_u/3,
  126.  
  127.                         mpred_run/0,mpred_test/1,mpred_test_fok/1,
  128.  
  129.   stop_trace/1,
  130.   select_next_fact/1,supporters_list/2,triggerSupports/2,trigger_trigger/3,well_founded/1,well_founded_list/2,
  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.   mpred_post1/2,mpred_withdraw/1,mpred_withdraw/2,mpred_remove/1,mpred_remove/2,mpred_pp_justification1/2,mpred_pp_justifications2/3,mpred_spy1/3,
  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.  
  138. :- thread_local(t_l:c_umt/1).
  139.  
  140. set_umt(M):- must(atom(M)),
  141.  (
  142.   '$set_source_module'(_,M),'$module'(_,M)),
  143.     % add_import_module(M,pfc,end),
  144.    forall(mpred_database_term(F/A),(M:dynamic(M:F/A),M:discontiguous(M:F/A),M:multifile(M:F/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.                  (::::)/2, (<-)/2, (<==>)/2, (==>)/2,  (==>)/1,  (~)/1, do_and_undo/2, % mined from program database
  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.         )),
  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. setup_mpred_ops:-
  172.           op(500,fx,'-'),
  173.           op(300,fx,'~'),
  174.           op(1050,xfx,('==>')),
  175.           op(1050,xfx,'<==>'),
  176.           op(1050,xfx,('<-')),
  177.           op(1100,fx,('==>')),
  178.           op(1150,xfx,('::::')),
  179.           op(500,fx,user:'-'),
  180.           op(300,fx,user:'~'),
  181.           op(1050,xfx,(user:'==>')),
  182.           op(1050,xfx,user:'<==>'),
  183.           op(1050,xfx,(user:'<-')),
  184.           op(1100,fx,(user:'==>')),
  185.           op(1150,xfx,(user:'::::')).
  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. asserta_u(A0):- strip_module(A0,_,A), get_umt(M),asserta(M:A).
  210. assertz_u(A0):- strip_module(A0,_,A), get_umt(M),assertz(M:A).
  211. retract_u(M:(H:-B)):- atom(M),!, clause_u(H,B,R),erase(R).
  212. retract_u((H:-B)):-!, clause_u(H,B,R),erase(R).
  213. retract_u(H0):- strip_module(H0,_,H),!, clause_u(H,true,R),erase(R).
  214. retractall_u(H):- forall(clause_u(H,_,R),erase(R)).
  215. clause_u(H,B):- clause_u(H,B,_).
  216.  
  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. lookup_u(Trigger):-  clause_u(Trigger,B),call(B).
  221. lookup_u(Trigger,Ref):-  clause_u(Trigger,B,Ref),call(B).
  222.  
  223. call_u(G0):-
  224.   strip_module(G0,_,G),functor(G,F,A),
  225.   (memberchk(F/A,[(',')/2])->
  226.   mpred_CALL(call_u,G);
  227.   call_u2(G0)).
  228.  
  229. call_u2(G0):-
  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.   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. 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.  
  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. 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_set_default/1 initialized a global assertion.
  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. %% mpred_aina( ?G, ?S) is semidet.
  351. %
  352. % PFC Aina.
  353. %
  354. mpred_aina(G,S):-mpred_ain(G,S).
  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. % tries to add a fact to the database, and, if it succeeded,
  386. % adds an entry to the Pfc queue for subsequent forward chaining.
  387. % It always succeeds.
  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.  
  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. %
  419. % PFC Unique For Internal Interface.
  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. mpred_unique_u(P):- !, \+ clause_u(P,true).
  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. mpred_enqueue(P,S):-
  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.  
  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. %
  445. mpred_remove_old_version((Identifier::::Body)):-
  446.   % this should never happen.
  447.   var(identifier),
  448.   !,
  449.   mpred_warn("variable used as an  rule name in ~p :::: ~p",
  450.           [Identifier,Body]).
  451.  
  452.  
  453. mpred_remove_old_version((Identifier::::Body)):-
  454.   nonvar(Identifier),
  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.   select_next_fact(P),
  498.   remove_selection(P).
  499.  
  500. remove_selection(P):-
  501.   lookup_u(qu(P)),
  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. format_to_message(Format,Args,Info):-
  514.    is_list(Args)->
  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_halt:-  mpred_halt(anonymous(mpred_halt)).
  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. 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_unique_u(X),
  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. remlist([H|T]):-
  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. mpred_remove(P,S):- with_each_item(mpred_remove1,P,S).
  707. mpred_remove1(P,S):-
  708.   mpred_withdraw(P,S),
  709.   mpred_BC(P)
  710.      -> mpred_blast(P)
  711.       ; true.
  712.  
  713. %
  714. %  mpred_blast(+F) retracts fact F from the DB and removes any dependent facts
  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. %  participates in and check the things that they support to see if they
  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_unfwc1(F):-
  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.   mpred_db_type(F,fact(_FT)),
  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_retract_supported_relations(_).
  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. mpred_fwc(P):- mpred_fwc1(P).
  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. %  chaining rule and adds the corresponding bt triggers to the database.
  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_db_type(X,trigger),
  934.   !,
  935.   mpred_ain_trigger_reprop(X,Support),
  936.   !.
  937.  
  938. %mpred_eval_lhs(snip(X),Support):-
  939. %  snip(Support),
  940. %  mpred_eval_lhs(X,Support).
  941.  
  942. mpred_eval_lhs(X,_):-
  943.   mpred_warn("Unrecognized item found in trigger body, namely ~p.",[X]).
  944.  
  945.  
  946. %
  947. %  eval something on the RHS of a rule.
  948. %
  949.  
  950. mpred_eval_rhs([],_):- !.
  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.  
  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.  !,
  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_negation(P,Q),
  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. mpred_db_type(('<==>'(_,_)),Type):- !, Type=rule.
  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.  
  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.  memberchk(Head,L),
  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_database_term(spft/3).
  1434. mpred_database_term(pt/2).
  1435. mpred_database_term(bt/2).
  1436. mpred_database_term(nt/3).
  1437. mpred_database_term(qu/1).
  1438. mpred_database_term('==>'/2).
  1439. mpred_database_term('<==>'/2).
  1440. mpred_database_term('<-'/2).
  1441. mpred_database_term('==>'/1).
  1442. mpred_database_term('~'/1).
  1443.  
  1444. %% mpred_reset() is det.
  1445. %
  1446. % removes all forward chaining rules and mpred_justification_S from db.
  1447. %
  1448. mpred_reset:-
  1449.  clause_u(spft(P,F,Trigger),true),
  1450.  mpred_retract_i_or_warn(P),
  1451.  mpred_retract_i_or_warn(spft(P,F,Trigger)),
  1452.  fail.
  1453. mpred_reset:-
  1454.  mpred_database_item(T),
  1455.  mpred_error("Pfc database not empty after mpred_reset, e.g., ~p.~n",[T]).
  1456. mpred_reset.
  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.  functor(Term,P,A),
  1462.  clause_u(Term,_).
  1463.  
  1464. mpred_retract_i_or_warn(X):- retract_u(X), !.
  1465. mpred_retract_i_or_warn(X):- X=hs(_),!.
  1466. mpred_retract_i_or_warn(X):- X=spft(_,hs(_),_),!.
  1467. mpred_retract_i_or_warn(X):-
  1468.  mpred_warn("Couldn't retract_u ~p.~n",[X]).
  1469.  
  1470.  
  1471.  
  1472.  
  1473. %   File   : pfcdebug.pl
  1474. %   Author : Tim Finin, finin@prc.unisys.com
  1475. %   Author :  Dave Matuszek, dave@prc.unisys.com
  1476. %   Updated:
  1477. %   Purpose: provides predicates for examining the database and debugginh
  1478. %   for Pfc.
  1479. /*
  1480. :- dynamic mpred_is_tracing_pred/1.
  1481. :- dynamic mpred_is_spying_pred/2.
  1482. :- dynamic mpred_is_tracing_exec/0.
  1483. :- dynamic mpred_warnings/1.
  1484. */
  1485. :- mpred_set_default(mpred_warnings(_), mpred_warnings(true)).
  1486.  
  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_maybe_break(Add,P,S).
  1537.    
  1538.  
  1539. mpred_trace_maybe_print(Add,P,S):-
  1540.   \+ lookup_u(mpred_is_tracing_pred(P)) -> true;
  1541.   (
  1542.    (S=(U,U)
  1543.        -> wdmsg("~NOP: ~p (~p) ~p",[Add,U,P])
  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.    
  1552.  
  1553.  
  1554.  
  1555. mpred_trace:- mpred_trace(_).
  1556.  
  1557. mpred_trace(Form):-
  1558.   assert_u(mpred_is_tracing_pred(Form)).
  1559.  
  1560.  
  1561.  
  1562. %% mpred_trace( ?Form, ?Condition) is semidet.
  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_noTrace:- mpred_untrace.
  1595. mpred_untrace:- mpred_untrace(_).
  1596. mpred_untrace(Form):- retractall_u(mpred_is_tracing_pred(Form)).
  1597.  
  1598. % needed:  mpred_trace_rule(Name)  ...
  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. mpred_child(P,Q):-
  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. mpred_children(P,L):- bagof(C,mpred_child(P,C),L).
  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. % PFC Descendant Secondary Helper.
  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.   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. mpred_collect_supports(Tripples):-
  1832.   bagof(Tripple, mpred_support_relation(Tripple), Tripples),
  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.   (mpred_ain_object(P); true),
  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. mpred_trigger_key(X,X).
  1862.  
  1863.  
  1864.  
  1865. %%%%%%%%%%%%%%%%%% 99999999999999999999999999999999999999999999
  1866.  
  1867. %%%%%%%%%%%%%%%%%% 99999999999999999999999999999999999999999999
  1868.  
  1869. pp_DB:-
  1870.  must_det_l((
  1871.   pp_facts,
  1872.   pp_rules,
  1873.   pp_triggers,
  1874.   pp_supports)).
  1875.  
  1876. %  pp_facts ...
  1877.  
  1878. pp_facts:- ignore(pp_facts(_,true)).
  1879.  
  1880. pp_facts(Pattern):- pp_facts(Pattern,true).
  1881.  
  1882. pp_facts(P,C):-
  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. mpred_classifyFacts([H|T],User,[H|Pfc],Rule):-
  1912.   mpred_classifyFacts(T,User,Pfc,Rule).
  1913.  
  1914. pp_rules:-
  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.   pp_items(R2),
  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.   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.  
  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.   why_buffer(P,_),
  1952.   mpred_why(P).
  1953.  
  1954. mpred_why(N):-
  1955.   number(N),
  1956.   !,
  1957.   why_buffer(P,Js),
  1958.   mpred_handle_why_command(N,P,Js).
  1959.  
  1960. mpred_why(M:P):-atom(M),!,mpred_why(P).
  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.   mpred_pp_justifications(P,Js),
  1978.   mpred_prompt_ask(' >> ',Answer),
  1979.   mpred_handle_why_command(Answer,P,Js).
  1980.  
  1981. mpred_handle_why_command(q,_,_):- !.
  1982. mpred_handle_why_command(h,_,_):-
  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. mpred_handle_why_command(u,_,_):-
  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.  
  2067.  
  2068. %% well_founded(+Fact) is semidet.
  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.   % find a mpred_justification.
  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. %
  2091. % simply maps well_founded over the list.
  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. %
  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. :- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!