API tools faq
paste
Advertisement
logicmoo

pfc as module

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