% File : pfc % Author : Tim Finin, finin@umbc.edu % Updated: 10/11/87, ... % Purpose: consult system file for ensure user:file_search_path(pack,'/devel/PrologMUD/pack'). :- attach_packs. :- 'lmcode':ensure_loaded(logicmoo(logicmoo_utils)). % not(P):- \+ P. :- kill_term_expansion. %:- include(prologmud(mud_header)). :- thread_local t_l:pfcExpansion. :- thread_local t_l:pfcExpansionWas. :- dynamic p. :- dynamic x. :- dynamic q. :- dynamic fly/1. :- dynamic old_clausedb/0. :- dynamic old_assert/0. :- dynamic old_call/0. :- dynamic bugger_assert/0. % old_clausedb. % old_assert. old_call. % bugger_assert:- current_predicate(ain/1). db_retractall(X):-old_assert,!,retractall(X). db_retractall(X):-invoke_modify(retract(all),X). db_retract(X):- old_assert,!,retract(X). db_retract(X):-invoke_modify(retract(one),X). db_assertz(X):-old_assert,!,assertz(X). db_assertz(X):-invoke_modify(assert(z),X). db_asserta(X):-old_assert,!,asserta(X). db_asserta(X):-invoke_modify(assert(a),X). db_assert(X):-old_assert,!,assert(X). db_assert(X):-invoke_modify(assert(z),X). db_clause(X,Y,Ref):-old_clausedb,!,clause(X,Y,Ref). db_clause(X,Y,Ref):-invoke_check(clause(_),clause_asserted(X,Y,Ref)). db_clause(X,Y):-old_clausedb,!,clause(X,Y). db_clause(X,Y):-invoke_check(clause(_),clause_asserted(X,Y)). db_call(Y):-db_call(nonPfc,Y). db_call(_,Y):-old_call,!,predicate_property(Y,_),!, call(Y). db_call(What,X):-invoke_call(call(What),X). ain(X):-ain(X). rem(X):-pfcRem(X). invoke_call(_, B ):- var(B),!,fail. invoke_call(A, not(B)):- !, not(invoke_call(A,B)). invoke_call(A,\+(B)):- !, not(invoke_call(A,B)). invoke_call(A, call(B)):- !, invoke_call(A,B). invoke_call(_A, X ):- !, current_predicate(_,X),!,call(X). invoke_call(A, B ):- (invoke_op0(A,B)). invoke_modify(A,B):-(invoke_op0(A,B)). invoke_check(A,B):-(invoke_op0(A,B)). invoke_op0(assert(z),X):- bugger_assert,!,ainz(X). invoke_op0(assert(a),X):- bugger_assert,!,ain(X). invoke_op0(assert(_),X):- bugger_assert,!,ain(X). invoke_op0(assert(z),X):-!,assertz(X). invoke_op0(assert(a),X):-!,asserta(X). invoke_op0(assert(_),X):-!,assert(X). invoke_op0(retract(all),X):-!,retractall(X). invoke_op0(retract(_),X):-!,retract(X). invoke_op0(clause(_),(X)):-clause(X,true). invoke_op0(clause(_),clause_asserted(X,Y)):-!,clause(X,Y). invoke_op0(clause(_),clause_asserted(X,Y,Ref)):-!,clause(X,Y,Ref). invoke_op0(_,X):-nonvar(X),current_predicate(_,X),!,call(X). % :- set_prolog_flag(unknown,fail). :- dynamic(go/0). pfcVersion(1.2). % pfcFile('pfcsyntax'). % operator declarations. % File : pfcsyntax.pl % Author : Tim Finin, finin@prc.unisys.com % Purpose: syntactic sugar for Pfc - operator definitions and term expansions. :- op(500,fx,'~'). :- op(1050,xfx,('==>')). :- op(1050,xfx,'<==>'). :- op(1050,xfx,('<-')). :- op(1100,fx,('==>')). :- op(1150,xfx,('::::')). :- multifile('mpred_term_expansion'/2). mpred_term_expansion((P==>Q),(:- ain((P==>Q)))). %mpred_term_expansion((P==>Q),(:- ain(('<-'(Q,P))))). % speed-up attempt mpred_term_expansion(('<-'(P,Q)),(:- ain(('<-'(P,Q))))). mpred_term_expansion((P<==>Q),(:- ain((P<==>Q)))). mpred_term_expansion((RuleName :::: Rule),(:- ain((RuleName :::: Rule)))). mpred_term_expansion((==>P),(:- ain(P))). :- multifile(term_expansion/2). term_expansion(A,B):- once(true ; t_l:pfcExpansion), once(mpred_term_expansion(A,B)),A\=@=B. :- asserta(t_l:pfcExpansion). % pfcFile('pfccore'). % core of Pfc. % File : pfccore.pl % Author : Tim Finin, finin@prc.unisys.com % Updated: 10/11/87, ... % 4/2/91 by R. McEntire: added calls to valid_dbref as a % workaround for the Quintus 3.1 % bug in the recorded database. % Purpose: core Pfc predicates. :- use_module(library(lists)). :- dynamic ('==>')/2. :- dynamic ('::::')/2. :- dynamic '<==>'/2. :- dynamic '<-'/2. :- dynamic 'pt'/2. :- dynamic 'nt'/3. :- dynamic 'bt'/2. :- dynamic pfcUndoMethod/2. :- dynamic (mpred_action)/1. %:- dynamic pfcTmsMode/1. :- dynamic mpred_queue/1. :- dynamic pfcDatabase/1. :- dynamic mpred_haltSignal/0. %:- dynamic pfcDebugging/0. %:- dynamic mpred_select/1. %:- dynamic mpred_search/1. %%% initialization of global assertons %% mpred_default/1 initialized a global assertion. %% mpred_default(P,Q) - if there is any fact unifying with P, then do %% nothing, else db_assert Q. mpred_default(GeneralTerm,Default) :- db_clause(GeneralTerm,true) -> true ; db_assert(Default). %% pfcTmsMode is one of {none,local,cycles} and controles the tms alg. :- mpred_default(mpred_settings(tmsMode,_), mpred_settings(tmsMode,cycles)). % Pfc Search strategy. mpred_settings(searchMode,X) where X is one of {direct,depth,breadth} :- mpred_default(mpred_settings(searchMode,_), mpred_settings(searchMode,direct)). % %% add/2 and pfcPost/2 are the main ways to db_assert new clauses into the %% database and have forward reasoning done. %% ain(P,S) asserts P into the dataBase with support from S. ain(P) :- ain(P,(pcfUser,pcfUser)). ain((==>P),S) :- ain(P,S). ain(P,S) :- pfcPost(P,S), pfcRun. %ain(_,_). %ain(P,S) :- mpred_warn("ain(~w,~w) failed",[P,S]). % pfcPost(+Ps,+S) tries to add a fact or set of fact to the database. For % each fact (or the singelton) pfcPost1 is called. It always succeeds. pfcPost([H|T],S) :- !, pfcPost1(H,S), pfcPost(T,S). pfcPost([],_) :- !. pfcPost(P,S) :- pfcPost1(P,S). % pfcPost1(+P,+S) tries to add a fact to the database, and, if it succeeded, % adds an entry to the pfc queue for subsequent forward chaining. % It always succeeds. pfcPost1(P,S) :- %% db ainDbToHead(P,P2), % pfcRemoveOldVersion(P), ainSupport(P,S), pfcUnique(P), db_assert(P), pfcTraceAdd(P,S), !, pfcEnqueue(P,S), !. pfcPost1(_,_). %%pfcPost1(P,S) :- mpred_warn("ain(~w,~w) failed",[P,S]). %% %% ainDbToHead(+P,-NewP) talkes a fact P or a conditioned fact %% (P:-C) and adds the Db context. %% ainDbToHead(P,NewP) :- pfcCurrentDb(Db), (Db=true -> NewP = P; P=(Head:-Body) -> NewP = (Head :- (Db,Body)); otherwise -> NewP = (P :- Db)). % pfcUnique(X) is true if there is no assertion X in the prolog db. pfcUnique((Head:-Tail)) :- !, \+ db_clause(Head,Tail). pfcUnique(P) :- !, \+ db_clause(P,true). pfcEnqueue(P,S) :- mpred_settings(searchMode,Mode) -> (Mode=direct -> pfcFwd(P) ; Mode=depth -> pfcAsserta(mpred_queue(P),S) ; Mode=breadth -> pfcAssert(mpred_queue(P),S) ; else -> mpred_warn("Unrecognized mpred_search mode: ~w", Mode)) ; mpred_warn("No mpred_search mode"). % if there is a rule of the form Identifier ::: Rule then delete it. pfcRemoveOldVersion((Identifier::::Body)) :- % this should never happen. var(identifier), !, mpred_warn("variable used as an rule name in ~w :::: ~w", [Identifier,Body]). pfcRemoveOldVersion((Identifier::::Body)) :- nonvar(Identifier), db_clause((Identifier::::OldBody),_), \+(Body=OldBody), pfcRem((Identifier::::OldBody)), !. pfcRemoveOldVersion(_). % % pfcRun compute the deductive closure of the current database. % How this is done depends on the searching mode: % direct - fc has already done the job. % depth or breadth - use the mpred_queue mechanism. pfcRun :- ( \+ mpred_settings(searchMode,direct)), mpred_step, pfcRun. pfcRun. % mpred_step removes one entry from the mpred_queue and reasons from it. mpred_step :- % if mpred_haltSignal is true, reset it and fail, thereby stopping inferencing. pfcRetract(mpred_haltSignal), !, fail. mpred_step :- % draw immediate conclusions from the next fact to be considered. % fails iff the queue is empty. get_next_fact(P), pfcdo(pfcFwd(P)), !. get_next_fact(P) :- %identifies the nect fact to fc from and removes it from the queue. select_next_fact(P), remove_selection(P). remove_selection(P) :- pfcRetract(mpred_queue(P)), pfcRemoveSupportsQuietly(mpred_queue(P)), !. remove_selection(P) :- brake(format("~Npfc:get_next_fact - selected fact not on Queue: ~w", [P])). % select_next_fact(P) identifies the next fact to reason from. % It tries the pcfUser defined predicate first and, failing that, % the default mechanism. select_next_fact(P) :- mpred_select(P), !. select_next_fact(P) :- defaultmpred_select(P), !. % the default selection predicate takes the item at the froint of the queue. defaultmpred_select(P) :- mpred_queue(P),!. % mpred_halt stops the forward chaining. mpred_halt :- mpred_halt("",[]). mpred_halt(Format) :- mpred_halt(Format,[]). mpred_halt(Format,Args) :- format(Format,Args), mpred_haltSignal -> mpred_warn("mpred_halt finds mpred_haltSignal already set") ; db_assert(mpred_haltSignal). %% %% %% predicates for manipulating triggers %% ainTrigger(pt(Trigger,Body),Support) :- !, mpred_trace_msg('~n Adding positive trigger ~q~n', [pt(Trigger,Body)]), pfcAssert(pt(Trigger,Body),Support), copy_term(pt(Trigger,Body),Tcopy), pfcBC(Trigger), pfcEvalLHS(Body,(Trigger,Tcopy)), fail. ainTrigger(nt(Trigger,Test,Body),Support) :- !, mpred_trace_msg('~n Adding negative trigger: ~q~n test: ~q~n body: ~q~n', [Trigger,Test,Body]), copy_term(Trigger,TriggerCopy), pfcAssert(nt(TriggerCopy,Test,Body),Support), \+Test, pfcEvalLHS(Body,(( \+Trigger),nt(TriggerCopy,Test,Body))). ainTrigger(bt(Trigger,Body),Support) :- !, pfcAssert(bt(Trigger,Body),Support), pfcBtPtCombine(Trigger,Body). ainTrigger(X,_Support) :- mpred_warn("Unrecognized trigger to aintrigger: ~w",[X]). pfcBtPtCombine(Head,Body,Support) :- %% a backward trigger (bt) was just added with head and Body and support Support %% find any pt's with unifying heads and add the instantied bt body. pfcGetTriggerQuick(pt(Head,_PtBody)), pfcEvalLHS(Body,Support), fail. pfcBtPtCombine(_,_,_) :- !. pfcGetTriggerQuick(Trigger) :- db_clause(Trigger,true). pfcGetTrigger(Trigger):-pfcGetTriggerQuick(Trigger). %% %% %% predicates for manipulating action traces. %% ainActionTrace(Action,Support) :- % adds an action trace and it's support. ainSupport(mpred_action(Action),Support). pfcRemActionTrace(mpred_action(A)) :- pfcUndoMethod(A,M), M, !. %% %% predicates to remove pfc facts, triggers, action traces, and queue items %% from the database. %% pfcRetract(X) :- %% db_retract an arbitrary thing. mpred_db_type(X,Type), pfcRetractType(Type,X), !. pfcRetractType(fact,X) :- %% db ainDbToHead(X,X2), db_retract(X2). db_retract(X). pfcRetractType(rule,X) :- %% db ainDbToHead(X,X2), db_retract(X2). db_retract(X). pfcRetractType(trigger,X) :- db_retract(X) -> unFc(X) ; mpred_warn("Trigger not found to db_retract: ~w",[X]). pfcRetractType(action,X) :- pfcRemActionTrace(X). %% ainSome(X) adds item X to some database ainSome(X) :- % what type of X do we have? mpred_db_type(X,Type), % db_call the appropriate predicate. ainType(Type,X). ainType(fact,X) :- pfcUnique(X), db_assert(X),!. ainType(rule,X) :- pfcUnique(X), db_assert(X),!. ainType(trigger,X) :- db_assert(X). ainType(action,_Action) :- !. %% pfcRem(P,S) removes support S from P and checks to see if P is still supported. %% If it is not, then the fact is retreactred from the database and any support %% relationships it participated in removed. pfcRem(List) :- % iterate down the list of facts to be pfcRem'ed. nonvar(List), List=[_|_], pfcRem_L(List). pfcRem(P) :- % pfcRem/1 is the pcfUser's interface - it withdraws pcfUser support for P. pfcRem(P,(pcfUser,pcfUser)). pfcRem_L([H|T]) :- % pfcRem each element in the list. pfcRem(H,(pcfUser,pcfUser)), pfcRem_L(T). pfcRem(P,S) :- % pfcDebug(format("~Nremoving support ~w from ~w",[S,P])), mpred_trace_msg('~n Removing support: ~q from ~q~n',[S,P]), pfcRemSupport(P,S) -> pcfRemoveIfUnsupported(P) ; mpred_warn("pfcRem/2 Could not find support ~w to remove from fact ~w", [S,P]). %% %% mpred_rem2 is like pfcRem, but if P is still in the DB after removing the %% pcfUser's support, it is retracted by more forceful means (e.g. remove). %% mpred_rem2(P) :- % mpred_rem2/1 is the pcfUser's interface - it withdraws pcfUser support for P. mpred_rem2(P,(pcfUser,pcfUser)). mpred_rem2(P,S) :- pfcRem(P,S), pfcBC(P) -> remove(P) ; true. %% %% remove(+F) retracts fact F from the DB and removes any dependent facts */ %% remove(F) :- pfcRemoveSupports(F), pfcUndo(F). % removes any remaining supports for fact F, complaining as it goes. pfcRemoveSupports(F) :- pfcRemSupport(F,S), mpred_warn("~w was still supported by ~w",[F,S]), fail. pfcRemoveSupports(_). pfcRemoveSupportsQuietly(F) :- pfcRemSupport(F,_), fail. pfcRemoveSupportsQuietly(_). % pfcUndo(X) undoes X. pfcUndo(mpred_action(A)) :- % undo an action by finding a method and successfully executing it. !, pfcRemActionTrace(mpred_action(A)). pfcUndo(pfcPT3(Key,Head,Body)) :- % undo a positive trigger. % !, (db_retract(pfcPT3(Key,Head,Body)) -> unFc(pt(Head,Body)) ; mpred_warn("Trigger not found to db_retract: ~w",[pt(Head,Body)])). pfcUndo(nt(Head,Condition,Body)) :- % undo a negative trigger. !, (db_retract(nt(Head,Condition,Body)) -> unFc(nt(Head,Condition,Body)) ; mpred_warn("Trigger not found to db_retract: ~w",[nt(Head,Condition,Body)])). pfcUndo(Fact) :- % undo a random fact, printing out the trace, if relevant. db_retract(Fact), pfcTraceRem(Fact), unFc1(Fact). %% unFc(P) "un-forward-chains" from fact f. That is, fact F has just %% been removed from the database, so remove all support relations it %% participates in and check the things that they support to see if they %% should stayu in the database or should also be removed. unFc(F) :- pfcRetractSupportRelations(F), unFc1(F). unFc1(F) :- pfcUnFcCheckTriggers(F), % is this really the right place for pfcRun pfcRemSupport(P,(_,Fact)) ; pfcRemSupport(P,(Fact,_))), pcfRemoveIfUnsupported(P), fail. pfcRetractSupportRelations(_). %% pcfRemoveIfUnsupported(+P) checks to see if P is supported and removes %% it from the DB if it is not. pcfRemoveIfUnsupported(P) :- mpred_tms_supported(P) -> true ; pfcUndo(P). %% mpred_tms_supported(+P) succeeds if P is "supported". What this means %% depends on the TMS mode selected. mpred_tms_supported(P) :- mpred_settings(tmsMode,Mode), mpred_tms_supported(Mode,P). mpred_tms_supported(local,P) :- !, pfcGetSupport(P,_). mpred_tms_supported(cycles,P) :- !, wellFounded(P). mpred_tms_supported(_,_P) :- true. %% %% a fact is well founded if it is supported by the pcfUser %% or by a set of facts and a rules, all of which are well founded. %% wellFounded(Fact) :- pfcWFF(Fact,[]). pfcWFF(F,_) :- % supported by pcfUser (pfcAxiom) or an "absent" fact (pfcAssumptionBase). (pfcAxiom(F) ; pfcAssumptionBase(F)), !. pfcWFF(F,Descendants) :- % first make sure we aren't in a loop. ( \+ memberchk(F,Descendants)), % find a pfcJustificationDB. supports(F,Supporters), % all of whose members are well founded. pfcWFF_L(Supporters,[F|Descendants]), !. %% pfcWFF_L(L) simply maps pfcWFF over the list. pfcWFF_L([],_). pfcWFF_L([X|Rest],L) :- pfcWFF(X,L), pfcWFF_L(Rest,L). % supports(+F,-ListofSupporters) where ListOfSupports is a list of the % supports for one pfcJustificationDB for fact F -- i.e. a list of facts which, % together allow one to deduce F. One of the facts will typically be a rule. % The supports for a pcfUser-defined fact are: [pcfUser]. supports(F,[Fact|MoreFacts]) :- pfcGetSupport(F,(Fact,Trigger)), triggerSupports(Trigger,MoreFacts). triggerSupports(pcfUser,[]) :- !. triggerSupports(Trigger,[Fact|MoreFacts]) :- pfcGetSupport(Trigger,(Fact,AnotherTrigger)), triggerSupports(AnotherTrigger,MoreFacts). %% %% %% pfcFwd(X) forward chains from a fact or a list of facts X. %% pfcFwd([H|T]) :- !, pfcFwd1(H), pfcFwd(T). pfcFwd([]) :- !. pfcFwd(P) :- pfcFwd1(P). % pfcFwd1(+P) forward chains for a single fact. % pfcFwd1(Fact) :- map_if_list(pfcFwd1,List),!. pfcFwd1(Fact) :- fc_rule_check(Fact), copy_term(Fact,F), % check positive triggers pfcRunPT(Fact,F), % check negative triggers pfcRunNT(Fact,F). %% %% fc_rule_check(P) does some special, built in forward chaining if P is %% a rule. %% fc_rule_check((P==>Q)) :- !, pfcProcessRule(P,Q,(P==>Q)). fc_rule_check((Name::::P==>Q)) :- !, pfcProcessRule(P,Q,(Name::::P==>Q)). fc_rule_check((P<==>Q)) :- !, pfcProcessRule(P,Q,(P<==>Q)), pfcProcessRule(Q,P,(P<==>Q)). fc_rule_check((Name::::P<==>Q)) :- !, pfcProcessRule(P,Q,((Name::::P<==>Q))), pfcProcessRule(Q,P,((Name::::P<==>Q))). fc_rule_check(('<-'(P,Q))) :- !, pfcDefineBcRule(P,Q,('<-'(P,Q))). fc_rule_check(_). pfcRunPT(Fact,F) :- pfcGetTriggerQuick(pt(F,Body)), mpred_trace_msg('~n Found positive trigger: ~q~n body: ~q~n', [F,Body]), pfcEvalLHS(Body,(Fact,pt(F,Body))), fail. %pfcRunPT(Fact,F) :- % pfcGetTriggerQuick(pt(presently(F),Body)), % pfcEvalLHS(Body,(presently(Fact),pt(presently(F),Body))), % fail. pfcRunPT(_,_). pfcRunNT(_Fact,F) :- support3(nt(F,Condition,Body),X,_), Condition, pfcRem(X,(_,nt(F,Condition,Body))), fail. pfcRunNT(_,_). %% %% pfcDefineBcRule(+Head,+Body,+ParentRule) - defines a backeard %% chaining rule and adds the corresponding bt triggers to the database. %% pfcDefineBcRule(Head,_Body,ParentRule) :- ( \+ mpred_literal(Head)), mpred_warn("Malformed backward chaining rule. ~w not atomic.",[Head]), mpred_warn("rule: ~w",[ParentRule]), !, fail. pfcDefineBcRule(Head,Body,ParentRule) :- copy_term(ParentRule,ParentRuleCopy), pfcBuildRhs(Head,Rhs), foreach(mpred_nf(Body,Lhs), (pfcBuildTrigger(Lhs,rhs(Rhs),Trigger), ain(bt(Head,Trigger),(ParentRuleCopy,pcfUser)))). %% %% %% eval something on the LHS of a rule. %% pfcEvalLHS((Test->Body),Support) :- !, (db_call(nonPfC,Test) -> pfcEvalLHS(Body,Support)), !. pfcEvalLHS(rhs(X),Support) :- !, mpred_eval_rhs(X,Support), !. pfcEvalLHS(X,Support) :- mpred_db_type(X,trigger), !, ainTrigger(X,Support), !. %pfcEvalLHS(snip(X),Support) :- % snip(Support), % pfcEvalLHS(X,Support). pfcEvalLHS(X,_) :- mpred_warn("Unrecognized item found in trigger body, namely ~w.",[X]). %% %% eval something on the RHS of a rule. %% mpred_eval_rhs([],_) :- !. mpred_eval_rhs([Head|Tail],Support) :- mpred_eval_rhs1(Head,Support), mpred_eval_rhs(Tail,Support). mpred_eval_rhs1({Action},Support) :- % evaluable Prolog code. !, pfcEvalAction(Action,Support). mpred_eval_rhs1(P,_Support) :- % predicate to remove. pfcNegatedLiteral(P), !, pfcRem(P). mpred_eval_rhs1([X|Xrest],Support) :- % embedded sublist. !, mpred_eval_rhs([X|Xrest],Support). mpred_eval_rhs1(Assertion,Support) :- % an assertion to be added. pfcPost1(Assertion,Support). mpred_eval_rhs1(X,_) :- mpred_warn("Malformed rhs of a rule: ~w",[X]). %% %% evaluate an action found on the rhs of a rule. %% pfcEvalAction(Action,Support) :- db_call(nonPfC,Action), (pfcUndoable(Action) -> ainActionTrace(Action,Support) ; true). %% %% %% mpred_trigger_the_trigger(Trigger,Body,_Support) :- trigger_trigger1(Trigger,Body). mpred_trigger_the_trigger(_,_,_). %trigger_trigger1(presently(Trigger),Body) :- % !, % copy_term(Trigger,TriggerCopy), % pfcBC(Trigger), % pfcEvalLHS(Body,(presently(Trigger),pt(presently(TriggerCopy),Body))), % fail. trigger_trigger1(Trigger,Body) :- copy_term(Trigger,TriggerCopy), pfcBC(Trigger), pfcEvalLHS(Body,(Trigger,pt(TriggerCopy,Body))), fail. %% %% pfcBC(F) is true iff F is a fact available for forward chaining. %% Note that this has the side effect of catching unsupported facts and %% assigning them support from God. %% pfcBC(P) :- % trigger any bc rules. bt(P,Trigger), pfcGetSupport(bt(P,Trigger),S), pfcEvalLHS(Trigger,S), fail. pfcBC(F) :- %% this is probably not advisable due to extreme inefficiency. var(F) -> pfcFact(F) ; otherwise -> db_clause(F,Condition),db_call(nonPfC,Condition). %%pfcBC(F) :- %% %% we really need to check for system predicates as well. %% % current_predicate(_,F) -> db_call(nonPfC,F). %% db_clause(F,Condition),db_call(nonPfC,Condition). % an action is pfcUndoable if there exists a method for undoing it. pfcUndoable(A) :- pfcUndoMethod(A,_). %% %% %% defining fc rules %% %% mpred_nf(+In,-Out) maps the LHR of a pfc rule In to one normal form %% Out. It also does certain optimizations. Backtracking into this %% predicate will produce additional clauses. mpred_nf(LHS,List) :- mpred_nf1(LHS,List2), mpred_nf_negations(List2,List). %% mpred_nf1(+In,-Out) maps the LHR of a pfc rule In to one normal form %% Out. Backtracking into this predicate will produce additional clauses. % handle a variable. mpred_nf1(P,[P]) :- var(P), !. % these next two rules are here for upward compatibility and will go % away eventually when the P/Condition form is no longer used anywhere. mpred_nf1(P/Cond,[( \+P)/Cond]) :- pfcNegatedLiteral(P), !. mpred_nf1(P/Cond,[P/Cond]) :- mpred_literal(P), !. %% handle a negated form mpred_nf1(NegTerm,NF) :- mpred_negation(NegTerm,Term), !, mpred_nf1_negation(Term,NF). %% disjunction. mpred_nf1((P;Q),NF) :- !, (mpred_nf1(P,NF) ; mpred_nf1(Q,NF)). %% conjunction. mpred_nf1((P,Q),NF) :- !, mpred_nf1(P,NF1), mpred_nf1(Q,NF2), append(NF1,NF2,NF). %% handle a random atom. mpred_nf1(P,[P]) :- mpred_literal(P), !. %%% shouln't we have something to catch the rest as errors? mpred_nf1(Term,[Term]) :- mpred_warn("mpred_nf doesn't know how to normalize ~w",[Term]). %% mpred_nf1_negation(P,NF) is true if NF is the normal form of \+P. mpred_nf1_negation((P/Cond),[( \+(P))/Cond]) :- !. mpred_nf1_negation((P;Q),NF) :- !, mpred_nf1_negation(P,NFp), mpred_nf1_negation(Q,NFq), append(NFp,NFq,NF). mpred_nf1_negation((P,Q),NF) :- % this code is not correct! twf. !, mpred_nf1_negation(P,NF) ; (mpred_nf1(P,Pnf), mpred_nf1_negation(Q,Qnf), append(Pnf,Qnf,NF)). mpred_nf1_negation(P,[\+P]). %% mpred_nf_negations(List2,List) sweeps through List2 to produce List, %% changing ~{...} to {\+...} %%% ? is this still needed? twf 3/16/90 mpred_nf_negations(X,X) :- !. % I think not! twf 3/27/90 mpred_nf_negations([],[]). mpred_nf_negations([H1|T1],[H2|T2]) :- mpred_nf_negation(H1,H2), mpred_nf_negations(T1,T2). mpred_nf_negation(Form,{\+ X}) :- nonvar(Form), Form=(~({X})), !. mpred_nf_negation(X,X). %% %% pfcBuildRhs(+Conjunction,-Rhs) %% pfcBuildRhs(X,[X]) :- var(X), !. pfcBuildRhs((A,B),[A2|Rest]) :- !, pfcCompileRhsTerm(A,A2), pfcBuildRhs(B,Rest). pfcBuildRhs(X,[X2]) :- pfcCompileRhsTerm(X,X2). pfcCompileRhsTerm((P/C),((P:-C))) :- !. pfcCompileRhsTerm(P,P). %% mpred_negation(N,P) is true if N is a negated term and P is the term %% with the negation operator stripped. mpred_negation((~P),P). mpred_negation((-P),P). mpred_negation(( \+(P)),P). pfcNegatedLiteral(P) :- mpred_negation(P,Q), pfcPositiveAtom(Q). mpred_literal(X) :- pfcNegatedLiteral(X). mpred_literal(X) :- pfcPositiveAtom(X). pfcPositiveAtom(X) :- functor(X,F,_), \+ pfcConnective(F). pfcConnective(';'). pfcConnective(','). pfcConnective('/'). pfcConnective('|'). pfcConnective(('==>')). pfcConnective(('<-')). pfcConnective('<==>'). pfcConnective('-'). pfcConnective('~'). pfcConnective(('\\+')). pfcProcessRule(Lhs,Rhs,ParentRule) :- copy_term(ParentRule,ParentRuleCopy), pfcBuildRhs(Rhs,Rhs2), foreach(mpred_nf(Lhs,Lhs2), pfcBuild1Rule(Lhs2,rhs(Rhs2),(ParentRuleCopy,pcfUser))). pfcBuild1Rule(Lhs,Rhs,Support) :- pfcBuildTrigger(Lhs,Rhs,Trigger), pfcEvalLHS(Trigger,Support). pfcBuildTrigger([],Consequent,Consequent). pfcBuildTrigger([V|Triggers],Consequent,pt(V,X)) :- var(V), !, pfcBuildTrigger(Triggers,Consequent,X). pfcBuildTrigger([(T1/Test)|Triggers],Consequent,nt(T2,Test2,X)) :- mpred_negation(T1,T2), !, pfcBuildNtTest(T2,Test,Test2), pfcBuildTrigger(Triggers,Consequent,X). pfcBuildTrigger([(T1)|Triggers],Consequent,nt(T2,Test,X)) :- mpred_negation(T1,T2), !, pfcBuildNtTest(T2,true,Test), pfcBuildTrigger(Triggers,Consequent,X). pfcBuildTrigger([{Test}|Triggers],Consequent,(Test->X)) :- !, pfcBuildTrigger(Triggers,Consequent,X). pfcBuildTrigger([T/Test|Triggers],Consequent,pt(T,X)) :- !, pfcBuildTest(Test,Test2), pfcBuildTrigger([{Test2}|Triggers],Consequent,X). %pfcBuildTrigger([snip|Triggers],Consequent,snip(X)) :- % !, % pfcBuildTrigger(Triggers,Consequent,X). pfcBuildTrigger([T|Triggers],Consequent,pt(T,X)) :- !, pfcBuildTrigger(Triggers,Consequent,X). %% %% pfcBuildNtTest(+,+,-). %% %% builds the test used in a negative trigger (nt/3). This test is a %% conjunction of the check than no matching facts are in the db and any %% additional test specified in the rule attached to this ~ term. %% pfcBuildNtTest(T,Testin,Testout) :- pfcBuildTest(Testin,Testmid), pfcConjoin((pfcBC(T)),Testmid,Testout). % this just strips away any currly brackets. pfcBuildTest({Test},Test) :- !. pfcBuildTest(Test,Test). %% %% simple typeing for pfc objects mpred_db_type(('==>'(_,_)),Type) :- !, Type=rule. mpred_db_type(('<==>'(_,_)),Type) :- !, Type=rule. mpred_db_type(('<-'(_,_)),Type) :- !, Type=rule. mpred_db_type(pfcPT3(_,_,_),Type) :- !, Type=trigger. mpred_db_type(pt(_,_),Type) :- !, Type=trigger. mpred_db_type(nt(_,_,_),Type) :- !, Type=trigger. mpred_db_type(bt(_,_),Type) :- !, Type=trigger. mpred_db_type(mpred_action(_),Type) :- !, Type=action. mpred_db_type((('::::'(_,X))),Type) :- !, mpred_db_type(X,Type). mpred_db_type(_,fact) :- %% if it's not one of the above, it must be a fact! !. pfcAssert(P,Support) :- (mpred_clause(P) ; db_assert(P)), !, ainSupport(P,Support). pfcAsserta(P,Support) :- (mpred_clause(P) ; db_asserta(P)), !, ainSupport(P,Support). pfcAssertz(P,Support) :- (mpred_clause(P) ; db_assertz(P)), !, ainSupport(P,Support). mpred_clause((Head :- Body)) :- !, copy_term(Head,Head_copy), copy_term(Body,Body_copy), db_clause(Head,Body), variant(Head,Head_copy), variant(Body,Body_copy). mpred_clause(Head) :- % find a unit db_clause identical to Head by finding one which unifies, % and then checking to see if it is identical copy_term(Head,Head_copy), db_clause(Head_copy,true), variant(Head,Head_copy). foreach(Binder,Body) :- Binder,pfcdo(Body),fail. foreach(_,_). % pfcdo(X) executes X once and always succeeds. pfcdo(X) :- X,!. pfcdo(_). %% pfcUnion(L1,L2,L3) - true if set L3 is the result of appending sets %% L1 and L2 where sets are represented as simple lists. pfcUnion([],L,L). pfcUnion([Head|Tail],L,Tail2) :- memberchk(Head,L), !, pfcUnion(Tail,L,Tail2). pfcUnion([Head|Tail],L,[Head|Tail2]) :- pfcUnion(Tail,L,Tail2). %% pfcConjoin(+Conjunct1,+Conjunct2,?Conjunction). %% arg3 is a simplified expression representing the conjunction of %% args 1 and 2. pfcConjoin(true,X,X) :- !. pfcConjoin(X,true,X) :- !. pfcConjoin(C1,C2,(C1,C2)). % pfcFile('pfcsupport'). % support maintenance %% %% %% predicates for manipulating support relationships %% %:-dynamic(support2/3). :- dynamic(spft/3). :- dynamic(support3/3). %% ainSupport(+Fact,+Support) ainSupport(P,(Fact,Trigger)) :- db_assert(spft(P,Fact,Trigger)), %db_assert(support2(Fact,Trigger,P)), db_assert(support3(Trigger,P,Fact)). pfcGetSupport(P,(Fact,Trigger)) :- nonvar(P) -> spft(P,Fact,Trigger) % ; nonvar(Fact) -> support2(Fact,Trigger,P) ; nonvar(Trigger) -> support3(Trigger,P,Fact) ; otherwise -> spft(P,Fact,Trigger). % There are three of these to try to efficiently handle the cases % where some of the arguments are not bound but at least one is. pfcRemSupport(P,(Fact,Trigger)) :- nonvar(P), !, pfcRetractOrWarn(spft(P,Fact,Trigger)), %pfcRetractOrWarn(support2(Fact,Trigger,P)), pfcRetractOrWarn(support3(Trigger,P,Fact)). pfcRemSupport(P,(Fact,Trigger)) :- nonvar(Fact), !, %pfcRetractOrWarn(support2(Fact,Trigger,P)), pfcRetractOrWarn(spft(P,Fact,Trigger)), pfcRetractOrWarn(support3(Trigger,P,Fact)). pfcRemSupport(P,(Fact,Trigger)) :- pfcRetractOrWarn(support3(Trigger,P,Fact)), pfcRetractOrWarn(spft(P,Fact,Trigger)). % pfcRetractOrWarn(support2(Fact,Trigger,P)). mpred_collect_supports(Tripples) :- bagof(Tripple, mpred_support_relation(Tripple), Tripples), !. mpred_collect_supports([]). mpred_support_relation((P,F,T)) :- spft(P,F,T). mpred_make_supports((P,S1,S2)) :- ainSupport(P,(S1,S2),_), (ainSome(P); true), !. %% pfcTriggerKey(+Trigger,-Key) %% %% Arg1 is a trigger. Key is the best term to index it on. pfcTriggerKey(pt(Key,_),Key). pfcTriggerKey(pfcPT3(Key,_,_),Key). pfcTriggerKey(nt(Key,_,_),Key). pfcTriggerKey(Key,Key). %%^L %% Get a key from the trigger that will be used as the first argument of %% the trigger pfcBase1 db_clause that stores the trigger. %% mpred_trigger_key(X,X) :- var(X), !. mpred_trigger_key(chart(word(W),_L),W) :- !. mpred_trigger_key(chart(stem([Char1|_Rest]),_L),Char1) :- !. mpred_trigger_key(chart(Concept,_L),Concept) :- !. mpred_trigger_key(X,X). % pfcFile('t_l'). % predicates to manipulate database. % File : t_l.pl % Author : Tim Finin, finin@prc.unisys.com % Author : Dave Matuszek, dave@prc.unisys.com % Author : Dan Corpron % Updated: 10/11/87, ... % Purpose: predicates to manipulate a pfc database (e.g. save, %% restore, reset, etc.0 % pfcDatabaseTerm(P/A) is true iff P/A is something that pfc adds to % the database and should not be present in an empty pfc database pfcDatabaseTerm(spft/3). %pfcDatabaseTerm(support2/3). pfcDatabaseTerm(support3/3). pfcDatabaseTerm(pt/2). pfcDatabaseTerm(bt/2). pfcDatabaseTerm(nt/3). pfcDatabaseTerm('==>'/2). pfcDatabaseTerm('<==>'/2). pfcDatabaseTerm('<-'/2). pfcDatabaseTerm(mpred_queue/1). % removes all forward chaining rules and pfcJustification_L from db. pfcReset :- db_clause(spft(P,F,Trigger),true), pfcRetractOrWarn(P), pfcRetractOrWarn(spft(P,F,Trigger)), % pfcRetractOrWarn(support2(F,Trigger,P)), pfcRetractOrWarn(support3(Trigger,P,F)), fail. pfcReset :- pfcDatabaseItem(T), pfcError("Pfc database not empty after pfcReset, e.g., ~p.~n",[T]). pfcReset. % true if there is some pfc crud still in the database. pfcDatabaseItem(Term) :- pfcDatabaseTerm(P/A), functor(Term,P,A), db_clause(Term,_). pfcRetractOrWarn(X) :- db_retract(X), !. pfcRetractOrWarn(X) :- mpred_warn("Couldn't db_retract ~p.",[X]). % pfcFile('pfcdebug'). % debugging aids (e.g. tracing). % File : pfcdebug.pl % Author : Tim Finin, finin@prc.unisys.com % Author : Dave Matuszek, dave@prc.unisys.com % Updated: % Purpose: provides predicates for examining the database and debugginh % for Pfc. :- dynamic mpred_settings/2. :- dynamic mpred_settings/3. :- mpred_default(mpred_settings(warnings,_), mpred_settings(warnings,true)). %% predicates to examine the state of pfc mpred_queue :- listing(mpred_queue/1). pfcPrintDB :- pfcPrintFacts, pfcPrintRules, pfcPrintTriggers, pfcPrintSupports, mpred_queue,!. pfcPrintDB :- must_det_l([ pfcPrintFacts, pfcPrintRules, pfcPrintTriggers, pfcPrintSupports, mpred_queue]). %% pfcPrintFacts .. pfcPrintFacts :- pfcPrintFacts(_,true). pfcPrintFacts(Pattern) :- pfcPrintFacts(Pattern,true). pfcPrintFacts(P,C) :- pfcFacts(P,C,L), pfcClassifyFacts(L,User,Pfc,_Rule), format("~n~nUser added facts:",[]), pfcPrintitems(User), format("~n~nPfc added facts:",[]), pfcPrintitems(Pfc). %% printitems clobbers it's arguments - beware! pfcPrintitems([]). pfcPrintitems([H|T]) :- numbervars(H,0,_), format("~n ~w",[H]), pfcPrintitems(T). pfcClassifyFacts([],[],[],[]). pfcClassifyFacts([H|T],User,Pfc,[H|Rule]) :- mpred_db_type(H,rule), !, pfcClassifyFacts(T,User,Pfc,Rule). pfcClassifyFacts([H|T],[H|User],Pfc,Rule) :- pfcGetSupport(H,(pcfUser,pcfUser)), !, pfcClassifyFacts(T,User,Pfc,Rule). pfcClassifyFacts([H|T],User,[H|Pfc],Rule) :- pfcClassifyFacts(T,User,Pfc,Rule). pfcPrintRules :- bagof((P==>Q),db_clause((P==>Q),true),R1), pfcPrintitems(R1), bagof((P<==>Q),db_clause((P<==>Q),true),R2), pfcPrintitems(R2), bagof((P<-Q),db_clause((P<-Q),true),R3), pfcPrintitems(R3). pfcPrintTriggers :- format("Positive triggers...~n",[]), bagof(pt(T,B),pfcGetTrigger(pt(T,B)),Pts), pfcPrintitems(Pts), format("Negative triggers...~n",[]), bagof(nt(A,B,C),pfcGetTrigger(nt(A,B,C)),Nts), pfcPrintitems(Nts), format("Goal triggers...~n",[]), bagof(bt(A,B),pfcGetTrigger(bt(A,B)),Bts), pfcPrintitems(Bts). pfcPrintSupports :- % temporary hack. setof((S > P), pfcGetSupport(P,S),L), pfcPrintitems(L). %% pfcFact(P) is true if fact P was asserted into the database via add. pfcFact(P) :- pfcFact(P,true). %% pfcFact(P,C) is true if fact P was asserted into the database via %% add and contdition C is satisfied. For example, we might do: %% %% pfcFact(X,mpred_user_fact(X)) %% pfcFact(P,C) :- pfcGetSupport(P,_), mpred_db_type(P,fact), db_call(nonPfC,C). %% pfcFacts(-ListofPfcFacts) returns a list of facts added. pfcFacts(L) :- pfcFacts(_,true,L). pfcFacts(P,L) :- pfcFacts(P,true,L). %% pfcFacts(Pattern,Condition,-ListofPfcFacts) returns a list of facts added. pfcFacts(P,C,L) :- setof(P,pfcFact(P,C),L). brake(X) :- X, break. %% %% %% predicates providing a simple tracing facility %% pfcTraceAdd(P) :- % this is here for upward compat. - should go away eventually. pfcTraceAdd(P,(o,o)). pfcTraceAdd(pt(_,_),_) :- % hack for now - never trace triggers. !. pfcTraceAdd(nt(_,_),_) :- % hack for now - never trace triggers. !. pfcTraceAdd(P,S) :- pfcTraceAddPrint(P,S), pfcTraceBreak(P,S). pfcTraceAddPrint(P,S) :- mpred_settings(traced,P), !, copy_term(P,Pcopy), numbervars(Pcopy,0,_), (S=(pcfUser,pcfUser) -> format("~nAdding (u) ~w",[Pcopy]) ; format("~nAdding (g) ~w",[Pcopy])). pfcTraceAddPrint(_,_). pfcTraceBreak(P,_S) :- mpred_settings(spied,P,add) -> (copy_term(P,Pcopy), numbervars(Pcopy,0,_), format("~nBreaking on ain(~w)",[Pcopy]), break) ; true. pfcTraceRem(pt(_,_)) :- % hack for now - never trace triggers. !. pfcTraceRem(nt(_,_)) :- % hack for now - never trace triggers. !. pfcTraceRem(P) :- (mpred_settings(traced,P) -> format('~nRemoving ~w.',[P]) ; true), (mpred_settings(spied,P,pfcRem) -> (format("~nBreaking on pfcRem(~w)",[P]), break) ; true). mpred_trace :- mpred_trace(_). mpred_trace(Form) :- db_assert(mpred_settings(traced,Form)). mpred_trace(Form,Condition) :- db_assert((mpred_settings(traced,Form) :- Condition)). mpred_spy(Form) :- mpred_spy(Form,[add,pfcRem],true). mpred_spy(Form,Modes) :- mpred_spy(Form,Modes,true). mpred_spy(Form,[add,pfcRem],Condition) :- !, mpred_spy1(Form,add,Condition), mpred_spy1(Form,pfcRem,Condition). mpred_spy(Form,Mode,Condition) :- mpred_spy1(Form,Mode,Condition). mpred_spy1(Form,Mode,Condition) :- db_assert((mpred_settings(spied,Form,Mode) :- Condition)). pfcNospy :- pfcNospy(_,_,_). pfcNospy(Form) :- pfcNospy(Form,_,_). pfcNospy(Form,Mode,Condition) :- db_clause(mpred_settings(spied,Form,Mode), Condition, Ref), erase(Ref), fail. pfcNospy(_,_,_). pfcNoTrace :- pfcUntrace. pfcUntrace :- pfcUntrace(_). pfcUntrace(Form) :- db_retractall(mpred_settings(traced,Form)). % needed: pfcTraceRule(Name) ... % if the correct flag is set, trace exection of Pfc mpred_trace_msg(Msg,Args) :- mpred_settings(trace_exec,true), !, format(user_output, Msg, Args). mpred_trace_msg(_Msg,_Args). pfcWatch :- db_assert(mpred_settings(trace_exec,true)). pfcNoWatch :- db_retractall(mpred_settings(trace_exec,true)). pfcError(Msg) :- pfcError(Msg,[]). pfcError(Msg,Args) :- format("~nERROR/Pfc: ",[]), format(Msg,Args). %% %% These control whether or not warnings are printed at all. %% mpred_warn. %% nompred_warn. %% %% These print a warning message if the flag mpred_warnings is set. %% mpred_warn(+Message) %% mpred_warn(+Message,+ListOfArguments) %% mpred_warn :- db_retractall(mpred_settings(warnings,_)), db_assert(mpred_settings(warnings,true)). nompred_warn :- db_retractall(mpred_settings(warnings,_)), db_assert(mpred_settings(warnings,false)). mpred_warn(Msg) :- mpred_warn(Msg,[]). mpred_warn(Msg,Args) :- mpred_settings(warnings,true), !, format("~nWARNING/Pfc: ",[]), format(Msg,Args). mpred_warn(_,_). %% %% mpred_warnings/0 sets flag to cause pfc warning messages to print. %% pfcNoWarnings/0 sets flag to cause pfc warning messages not to print. %% mpred_warnings :- db_retractall(mpred_settings(warnings,_)), db_assert(mpred_settings(warnings,true)). pfcNoWarnings :- db_retractall(mpred_settings(warnings,_)). % pfcFile('pfcjust'). % predicates to manipulate pfcJustification_L. % File : pfcjust.pl % Author : Tim Finin, finin@prc.unisys.com % Author : Dave Matuszek, dave@prc.unisys.com % Updated: % Purpose: predicates for accessing Pfc Justifications. % Status: more or less working. % Bugs: %% *** predicates for exploring supports of a fact ***** :- use_module(library(lists)). pfcJustificationDB(F,J) :- justSupports(F,J). pfcJustification_L(F,Js) :- bagof(J,pfcJustificationDB(F,J),Js). % justSupports(F,J):- support2(F,J). %% pfcBase1(P,L) - is true iff L is a list of "pfcBase1" facts which, taken %% together, allows us to deduce P. A pfcBase1 fact is an pfcAxiom (a fact %% added by the pcfUser or a raw Prolog fact (i.e. one w/o any support)) %% or an pfcAssumptionBase. pfcBase1(F,[F]) :- (pfcAxiom(F) ; pfcAssumptionBase(F)),!. pfcBase1(F,L) :- % i.e. (reduce 'append (map 'pfcBase1 (pfcJustificationDB f))) pfcJustificationDB(F,Js), pfcBases(Js,L). %% pfcBases(L1,L2) is true if list L2 represents the union of all of the %% facts on which some conclusion in list L1 is based. pfcBases([],[]). pfcBases([X|Rest],L) :- pfcBase1(X,Bx), pfcBases(Rest,Br), pfcUnion(Bx,Br,L). pfcAxiom(F) :- pfcGetSupport(F,(pcfUser,pcfUser)); pfcGetSupport(F,(pfcGod,pfcGod)). %% an pfcAssumptionBase is a failed goal, i.e. were assuming that our failure to %% prove P is a proof of not(P) pfcAssumptionBase(P) :- mpred_negation(P,_). %% pfcAssumptionsSet(X,As) if As is a set of pfcAssumptionsSet which underly X. pfcAssumptionsSet(X,[X]) :- pfcAssumptionBase(X). pfcAssumptionsSet(X,[]) :- pfcAxiom(X). pfcAssumptionsSet(X,L) :- pfcJustificationDB(X,Js), pfcAssumption1(Js,L). pfcAssumption1([],[]). pfcAssumption1([X|Rest],L) :- pfcAssumptionsSet(X,Bx), pfcAssumption1(Rest,Br), pfcUnion(Bx,Br,L). %% pfcProofTree(P,T) the proof tree for P is T where a proof tree is %% of the form %% %% [P , J1, J2, ;;; Jn] each Ji is an independent P justifier. %% ^ and has the form of %% [J11, J12,... J1n] a list of proof trees. % pfcChild(P,Q) is true iff P is an immediate justifier for Q. % mode: pfcChild(+,?) pfcChild(P,Q) :- pfcGetSupport(Q,(P,_)). pfcChild(P,Q) :- pfcGetSupport(Q,(_,Trig)), mpred_db_type(Trig,trigger), pfcChild(P,Trig). pfcChildren(P,L) :- bagof(C,pfcChild(P,C),L). % pfcDescendant(P,Q) is true iff P is a justifier for Q. pfcDescendant(P,Q) :- pfcDescendant1(P,Q,[]). pfcDescendant1(P,Q,Seen) :- pfcChild(X,Q), ( \+ member(X,Seen)), (P=X ; pfcDescendant1(P,X,[X|Seen])). pfcDescendants(P,L) :- bagof(Q,pfcDescendant1(P,Q,[]),L). % pfcFile('pfcwhy'). % interactive exploration of pfcJustification_L. % File : pfcwhy.pl % Author : Tim Finin, finin@prc.unisys.com % Updated: % Purpose: predicates for interactively exploring Pfc pfcJustification_L. % ***** predicates for brousing pfcJustification_L ***** :- use_module(library(lists)). pfcWhy :- pfcWhyMemory1(P,_), pfcWhy(P). pfcWhy(N) :- number(N), !, pfcWhyMemory1(P,Js), pfcWhyCommand(N,P,Js). pfcWhy(P) :- pfcJustification_L(P,Js), db_retractall(pfcWhyMemory1(_,_)), db_assert(pfcWhyMemory1(P,Js)), pfcWhyBrouse(P,Js). pfcWhy1(P) :- pfcJustification_L(P,Js), pfcWhyBrouse(P,Js). pfcWhyBrouse(P,Js) :- mpred_showJustifications(P,Js), pfcAskUser(' >> ',Answer), pfcWhyCommand(Answer,P,Js). pfcWhyCommand(q,_,_) :- !. pfcWhyCommand(h,_,_) :- !, format("~n Justification Brouser Commands: q quit. N focus on Nth pfcJustificationDB. N.M brouse step M of the Nth pfcJustificationDB u up a level ",[]). pfcWhyCommand(N,_P,Js) :- float(N), !, mpred_selectJustificationNode(Js,N,Node), pfcWhy1(Node). pfcWhyCommand(u,_,_) :- % u=up !. pfcCommand(N,_,_) :- integer(N), !, format("~n~w is a yet unimplemented command.",[N]), fail. pfcCommand(X,_,_) :- format("~n~w is an unrecognized command, enter h. for help.",[X]), fail. mpred_showJustifications(P,Js) :- format("~nJustifications for ~w:",[P]), mpred_showJustification1(Js,1). mpred_showJustification1([],_). mpred_showJustification1([J|Js],N) :- % show one pfcJustificationDB and recurse. nl, mpred_showJustifications2(J,N,1), N2 is N+1, mpred_showJustification1(Js,N2). mpred_showJustifications2([],_,_). mpred_showJustifications2([C|Rest],JustNo,StepNo) :- copy_term(C,CCopy), numbervars(CCopy,0,_), format("~n ~w.~w ~w",[JustNo,StepNo,CCopy]), StepNext is 1+StepNo, mpred_showJustifications2(Rest,JustNo,StepNext). pfcAskUser(Msg,Ans) :- format("~n~w",[Msg]), read(Ans). mpred_selectJustificationNode(Js,Index,Step) :- JustNo is integer(Index), nth(JustNo,Js,Justification), StepNo is 1+ integer(Index*10 - JustNo*10), nth(StepNo,Justification,Step). :- mpred_trace. :- ain([(faz(X), ~baz(Y)/{X=:=Y} ==> fazbaz(X)), (fazbaz(X), go ==> found(X)), (found(X), {X>=100} ==> big(X)), (found(X), {X>=10,X<100} ==> medium(X)), (found(X), {X<10} ==> little(X)), faz(1), goAhead, baz(2), baz(1) ]). :- include(mpred_tests). :- run_tests.