API tools faq
paste
Advertisement
logicmoo

PFC - module

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