1/* ************************************************************** */
    2/* Operators                                                      */
    3/* ************************************************************** */
    4
    5/*  propositional operators are: */
    6
    7:-op(140, fy, ~).    8:-op(160, xfy, and).    9:-op(160, xfy, or).   10:-op(180, xfy, =>).   11
   12/*  unary temporal operators are: */
   13
   14:-op(140, fy, sometimes).   15:-op(140, fy, always).   16:-op(140, fy, next).   17
   18/*  binary temporal operators are: */
   19
   20:-op(160, xfy, until).   21:-op(160, xfy, unless).   22
   23/*  knowledge operator: */
   24
   25:-op(140, fy, k).   26
   27/**********************************************/
   28/*                                            */
   29/*  Modal Literals                            */
   30/*                                            */
   31/**********************************************/
   32
   33is_new(new(_)).
   34
   35is_snl_literal(unknown(_)).
   36
   37is_snl_literal(~ unknown(_)).
   38
   39is_modal(k L):-
   40  is_literal(L).
   41
   42is_modal(~ k L):-
   43  is_literal(L).
   44
   45is_modal_literal(L):-
   46  is_modal(L).
   47
   48is_modal_literal(L):-
   49  is_literal(L).
   50
   51/*****************************************************************************/
   52/* is_literal(X).                                                            */
   53/*                                                                           */
   54/* Returns true if X is a proposition or negation of a proposition.          */
   55/*****************************************************************************/
   56
   57is_literal([_]):- !,fail.       % The exclusion of lists is needed for some predicates 
   58                                % in ntempres.pl (eg includes_or).
   59is_literal([_|_]):-!,fail.
   60
   61is_literal(~ X):-
   62  is_literal(X).
   63
   64is_literal(X):-
   65  is_proposition(X).
   66
   67is_literal(X):-
   68  is_constant(X).
   69
   70is_not_literal(~ X):- !,
   71   is_not_proposition(X).
   72
   73is_not_literal(X):-
   74   is_not_proposition(X).
   75
   76
   77/**********************************************/
   78/*                                            */
   79/* Constants                                  */
   80/*                                            */
   81/**********************************************/
   82
   83is_constant(true).
   84is_constant(false).
   85is_constant(start).
   86
   87/*****************************************************************************/
   88/* is_proposition(X).                                                        */
   89/*                                                                           */
   90/* Returns true if X is a proposition.                                       */
   91/*****************************************************************************/
   92
   93is_proposition(Formula) :- 
   94   \+(is_not_proposition(Formula)).
   95
   96/*****************************************************************************/
   97/* is_not_proposition(X).                                                    */
   98/*                                                                           */
   99/* Returns true if X is not a proposition ie. X is a formula which includes  */
  100/* temporal operators, boolean operators, or are true or false.              */
  101/*****************************************************************************/
  102
  103is_not_proposition([]).
  104is_not_proposition(X) :- is_constant(X).
  105is_not_proposition(_ and _).
  106is_not_proposition(_ or _).
  107is_not_proposition(~ _).
  108is_not_proposition(sometimes _).
  109is_not_proposition(always _).
  110is_not_proposition(_ => _).
  111is_not_proposition(next _).
  112is_not_proposition(k _).
  113is_not_proposition(_ until _).
  114is_not_proposition(_ unless _).
  115
  116/*****************************************************************************/
  117/*  conjunctive(X) :- X is an alpha formula                                  */
  118/*                                                                           */
  119/*****************************************************************************/
  120
  121conjunctive(_ and _).
  122conjunctive(~(_ or _)).
  123conjunctive(~(_ => _)).
  124
  125/*****************************************************************************/
  126/* disjunctive(X) :- X is a beta formula                                     */
  127/*                                                                           */
  128/*****************************************************************************/
  129
  130disjunctive(~(_ and _)).
  131disjunctive(_ or _).
  132disjunctive(_ => _).
  133
  134/**********************************************/
  135/*                                            */
  136/*  Counters: definitions, functions          */
  137/*                                            */
  138/**********************************************/
  139
  140/* for renaming predicates */
  141
  142:-dynamic predcount/1. /* for sicstus only */
  143
  144/* for skolem functions/constants */
  145
  146:-dynamic rulecount/1. /* for sicstus only */
  147
  148:-dynamic clear/0.     /* for sicstus only */
  149
  150/* predcount(N) :- N is the current Skolem function index */
  151
  152predcount(1).
  153rulecount(1).
  154
  155clear :-retract(predcount(_)), 
  156        assert(predcount(1)).
  157
  158
  159/*****************************************************************************/
  160/*        newpredcount(N)                                                    */
  161/*                                                                           */
  162/*        N is the current new predicate index, and as a                     */
  163/*        side effect, the remembered value is incremented.                  */
  164/*                                                                           */
  165/*****************************************************************************/
  166
  167newpredcount(N) :- predcount(N),
  168	           retract(predcount(N)),
  169		   M is N+1,
  170		   assert(predcount(M)).
  171
  172startrulecount(N) :- rulecount(N),
  173                     retract(rulecount(N)),
  174                     assert(rulecount(1)).
  175startrulecount(1).
  176
  177newrulecount(N) :- rulecount(N),
  178	          retract(rulecount(N)),
  179		  M is N+1,
  180		  assert(rulecount(M)).
  181
  182/********************************************************/
  183/* New propositions                                     */
  184/********************************************************/
  185
  186new_temp_prop(V):- newpredcount(N),
  187                   term_to_atom(N,NN),
  188                   string_concat('tmpp',NN,NV),
  189                   atom_to_term(NV,V,_).
  190
  191new_dontknow_prop(X,X):- is_snl_literal(X).
  192new_dontknow_prop(V,X):- V=.. [unknown|[X]].
  193
  194new_conj_prop(V,true):-V=[true].
  195new_conj_prop(V,X):- V=.. [new|[X]].
  196
  197/* ************************************************************** */
  198/* OUTPUT UTILITIES FOR CLAUSES                                   */
  199/* ************************************************************** */
  200
  201/* Remove comments if you do not wish a very verbose output */
  202
  203% my_writef(_X,_Y):-true,!.
  204% my_write(_X):-true,!.
  205% write_ruleset(_X):-true,!.
  206
  207/* For very verbose output */
  208
  209 my_writef(X,Y):-writef(X,Y).
  210 my_write(X):-write(X).
  211
  212/* ************************************************************** */
  213/* Formatted output of the prover: lists of clauses               */
  214/* ************************************************************** */
  215
  216write_ruleset((Initial,Literal,Modal,Temporal)) :-
  217        nl,write('Initial Clauses'),nl, 
  218	write('['), nl, write_ruleset1(Initial),!, write(']'), nl,
  219        nl,write('Literal Clauses'),nl, 
  220	write('['), nl, write_ruleset1(Literal),!, write(']'), nl,
  221        nl,write('Modal Clauses'),nl, 
  222	write('['), nl, write_ruleset1(Modal),!, write(']'), nl,
  223        nl,write('Temporal Clauses'),nl, 
  224	write('['), nl, write_ruleset1(Temporal),!, write(']'), nl.
  225
  226write_ruleset(Ruleset) :- 
  227	write('['), nl, write_ruleset1(Ruleset),!, write(']'), nl.
  228
  229write_ruleset1([Rule | Rest]) :- 
  230	write('  '), write_form(Rule), nl, write_ruleset1(Rest).
  231
  232write_ruleset1([]).
  233
  234/* ************************************************************** */
  235/* Formatted output of the prover: clauses                        */
  236/* ************************************************************** */
  237
  238write_form(r(X,Y,false)) :- 
  239        write(X), 
  240        write(' '), 
  241        write(Y), 
  242        write(' '), 
  243        write(' false ').
  244
  245write_form(r(X,Y,P)) :-
  246        write(X), 
  247        write(' '), 
  248        write(Y), 
  249        write(' '), 
  250        write_form(P).
  251
  252write_form(P => F) :- 
  253        write_form(P), 
  254        write(' => '), 
  255        write_form(F).
  256
  257%write_form(neg X) :- write('~'), !, write_form(X).
  258write_form(~ X) :- 
  259        write('~'), !, 
  260        write_form(X).
  261write_form(- X) :- 
  262        write('~'), !, 
  263        write_form(X).
  264
  265
  266write_form(X and Y) :-
  267	write('('),
  268	!,
  269	write_form(X), 
  270	write(' & '),
  271	write_form(Y),
  272	write(')').
  273
  274write_form(X or Y) :- 
  275	write('('),
  276	!,
  277	write_form(X),
  278	write(' | '),
  279	write_form(Y),
  280	write(')').
  281
  282write_form(X until Y) :- 
  283	write('('),
  284	!,
  285	write_form(X),
  286	write(' U '),
  287	write_form(Y),
  288	write(')').
  289
  290write_form(X unless Y) :- 
  291	write('('),
  292	!,
  293	write_form(X),
  294	write(' W '),
  295	write_form(Y),
  296	write(')').
  297
  298write_form(next X) :- write('O'), !, write_form(X).
  299write_form(sometimes X) :- write('<>'), !, write_form(X).
  300write_form(always X) :- write('[]'), !, write_form(X).
  301write_form(k X) :- write('k'), !, write_form(X).
  302write_form(new(X)) :- write('new('),!,write_form(X),write(')').
  303write_form(unknown(X)) :- write('unknown('),!,write_form(X),write(')').
  304write_form(X) :- write(X).
  305
  306
  307/**********************************************************************/
  308/* write_otter_rules(Rules)                                           */
  309/*                                                                    */
  310/* Takes a list of clauses (Rules) of the Prolog form r(No,List,Rule) */
  311/* where Rule is true => F or P => next F and rewrites              */
  312/* them in an Otter format i.e. if F is a or b in the above two rules */
  313/* the first rules would be output as s_a | s_b. and the second as    */
  314/* -slast_P | s_a | s_b.                                              */
  315/*                                                                    */
  316/**********************************************************************/
  317
  318write_otter_rules(X,Y,Z):-
  319  write_otter_rules(X),
  320  write_otter_rules(Y),
  321  write_otter_rules(Z).
  322
  323write_otter_rules(X,Y):-
  324  write_otter_rules(X),
  325  write_otter_rules(Y).
  326
  327write_otter_rules([]).
  328
  329write_otter_rules([r(_,_,Rule)|RRest]):-
  330  write_otter_rule(Rule),
  331  write_otter_rules(RRest).
  332
  333write_otter_rules([Rule|RRest]):-
  334  write_otter_rule(Rule),
  335  write_otter_rules(RRest).
  336
  337/**********************************************************************/
  338/* write_otter_rule(Rule)                                             */
  339/*                                                                    */
  340/* Takes a claue (Rule) of the Prolog form r(No,List,Rule) where Rule */
  341/* is true => F or P => next F and rewrites them in an              */
  342/* Otter format i.e. if F is a or b in the above two rules the first  */
  343/* rules would be output as s_a | s_b.                                */
  344/* and the second as -slast_P | s_a | s_b.                            */
  345/*                                                                    */
  346/**********************************************************************/
  347
  348write_otter_rule(B):-
  349  disjunction_of_literals(B),!,
  350  write_otter_disjunct(B),
  351  write('.'),nl.
  352
  353write_otter_rule(A => next B):-
  354  write_otter_conjunct(A),
  355  write(' | '),
  356  write_otter_disjunct(B),
  357  write('.'),nl.
  358
  359/**********************************************************************/
  360/* write_otter_conjunct(Conj)                                         */
  361/*                                                                    */
  362/* Takes a literal or conjunction of literals (Conj) of the Prolog    */
  363/* form a and b and c from the lhs of global rules and rewrites them  */
  364/* as -slast_a | -slast_b | -slast_c.                                 */
  365/*                                                                    */
  366/**********************************************************************/
  367
  368write_otter_conjunct(false):-
  369  write('$F').
  370
  371write_otter_conjunct(tmp_p(X)):-
  372  write('-slast_tmp_p_'),
  373  write(X).
  374
  375write_otter_conjunct(~ A):-
  376  write('-slast_neg_'),
  377  write(A).
  378
  379write_otter_conjunct(new(X)):-
  380  trace,
  381  write('-slast_new_'),
  382  write_otter_and_proposition(X).
  383
  384write_otter_conjunct(unknown(X)):-
  385  write('-slast_nkn_'),
  386  write_otter_proposition(X).
  387
  388write_otter_conjunct(A):-
  389  is_literal(A),
  390  write('-slast_'),
  391  write(A).
  392
  393write_otter_conjunct(A and B):-
  394  write_otter_conjunct(A),
  395  write(' | '),
  396  write_otter_conjunct(B).
  397
  398
  399/**********************************************************************/
  400/* write_otter_disjunct(Disj)                                         */
  401/*                                                                    */
  402/* Takes a literal or disjunction of literals (Disj) of the Prolog    */
  403/* form a or b or ~ c from the rhs of step clauses and rewrites them*/
  404/* as s_a | s_b | -s_c. We are assuming the disjunct is from the rhs  */
  405/* of a step clause or a literal clause.                              */
  406/*                                                                    */
  407/**********************************************************************/
  408
  409write_otter_disjunct(false):-
  410  write('$F').
  411
  412write_otter_disjunct(~ A):-
  413  write('-'),
  414  write_otter_disjunct(A).
  415
  416write_otter_disjunct(tmp_p(X)):-
  417  write('s_tmp_p_'),
  418  write(X).
  419
  420write_otter_disjunct(new(X)):-
  421  write('s_new_'),
  422  write_otter_and_proposition(X).
  423
  424write_otter_disjunct(unknown(X)):-
  425  write('s_nkn_'),
  426  write_otter_proposition(X).
  427
  428write_otter_disjunct(A):-
  429  is_literal(A),
  430  write('s_'),
  431  write(A).
  432
  433write_otter_disjunct(A or B):-
  434  write_otter_disjunct(A),
  435  write(' | '),
  436  write_otter_disjunct(B).
  437
  438/*********************************************/
  439/* Write the different kind of propositions  */
  440/* in the Otter format                       */
  441/*********************************************/
  442
  443write_otter_proposition(~ X):-
  444  write('neg_'),
  445  write_otter_proposition(X).
  446
  447write_otter_proposition(new(X)):-
  448  write('new_'),
  449  write_otter_and_proposition(X).
  450
  451write_otter_proposition(unknown(X)):-
  452  write('nkn_'),
  453  write_otter_proposition(X).
  454
  455write_otter_proposition(X):-
  456  is_literal(X),
  457  write(X).
  458
  459/************************************************/
  460/* The following is needed in order to write    */
  461/* the conjunctions that label the propositions */
  462/* that rename conjunctions                     */
  463/************************************************/
  464
  465write_otter_and_proposition(tmp_p(X) and B):-
  466  write_otter_and_proposition(B and tmp_p(X)).
  467
  468write_otter_and_proposition(A and B):-
  469  write_otter_and_proposition(A),
  470  write('_'),
  471  write_otter_and_proposition(B).
  472
  473write_otter_and_proposition(A):-
  474  write_otter_proposition(A).
  475
  476/*****************************************************************************/
  477/* write_list(ERulePaths)                                                    */
  478/*                                                                           */
  479/* Takes a list comprising of eventualites paired with a list of loop paths  */
  480/* already found (ERulePaths). It writes out the eventuality and the paths   */
  481/* already found.                                                            */
  482/*****************************************************************************/
  483
  484write_list([]).
  485
  486write_list([[Rule,Path]|Rest]):-
  487   write('     ['),
  488   write_form(Rule),
  489   write(', '),
  490   write(Path),
  491   write('     ]\n'),
  492   write_list(Rest).
  493
  494
  495/*****************************************************************************/
  496/*  number_rules(RuleList,FromList,NewRuleList).                             */
  497/*                                                                           */
  498/*  Takes the Rulelist and makes it into the format Number,From,Text)        */
  499/*  and stuffs it in NewRuleList.                                            */
  500/*****************************************************************************/
  501
  502number_rules([],_FromList,[]):-!.
  503
  504number_rules([Rule|Rest],FromList,[NewRule|NewRest]):-
  505   number_rule(Rule,FromList,NewRule),
  506   number_rules(Rest,FromList,NewRest).
  507
  508number_rule(r(N1,N2,Clause),_,r(N1,N2,Clause)).
  509number_rule(Rule,FromList,r(N,FromList,Rule)):-
  510   newrulecount(N).
  511
  512/****************************************************************************/
  513/*                                                                          */
  514/* because of the new normal form, modal subsumption takes place if:        */
  515/*                                                                          */
  516/* (1) a modal literal is implied by true                                   */
  517/* (2) the clauses are exactly the same                                     */
  518/* (3) a literal clause is a unit clause                                    */
  519/*     and the negated literal is the antecedent of the modal clause        */
  520/*                                                                          */
  521/****************************************************************************/
  522
  523dis_implies(true => B, _C => B):-!.
  524dis_implies(_A => B, true => B):-!.
  525dis_implies(A => B, A => B):-!.
  526
  527/* 
  528   this only fails: 
  529   cut introduced to prevent redo 
  530   there will never be a modal literal in a literal clause 
  531*/
  532
  533dis_implies(_A => _B, _C):-fail,!.
  534
  535dis_implies(A, NegA => _C):-
  536  is_literal(A),!,
  537  snff_negate(A,NegA).
  538
  539/* literal subsumption takes place as usual */
  540
  541dis_implies(A,B):-!,
  542  list_strip_or(A,A1),
  543  list_strip_or(B,B1),
  544  subset(A1,B1).
  545
  546/***************************************************/
  547   
  548set_implies([],_):-!.
  549
  550set_implies(X,X):-!.
  551
  552set_implies(_,[[true]]):-!.
  553
  554set_implies(_,[true]):-!.
  555
  556set_implies([[false]],_):-!.
  557
  558set_implies([false],_):-!.
  559
  560set_implies([H|Tail],[H1]):-
  561    is_literal(H1),
  562    is_literal(H),!,
  563    member(H1,[H|Tail]).
  564
  565set_implies([H1|Tail1],[H2|Tail2]):-
  566    is_literal(H1),
  567    is_literal(H2),!,
  568    subset([H2|Tail2],[H1|Tail1]).
  569
  570set_implies([H1],[H|Tail]):-
  571    is_modal_literal(H1),
  572    is_modal_literal(H),!,
  573    modal_member(H1,[H|Tail]).
  574
  575set_implies([H1|Tail1],[H2|Tail2]):-
  576    is_modal_literal(H1),
  577    is_modal_literal(H2),!,
  578    modal_subset([H1|Tail1],[H2|Tail2]).
  579
  580set_implies([H1],[H2|Tail2]):-
  581    is_literal(H1),!,
  582    is_superset_of_member_of_list([H1],[H2|Tail2]).
  583
  584set_implies([H1|Tail1],[H2|Tail2]):-
  585    is_literal(H1),!,
  586    is_superset_of_member_of_list([H1|Tail1],[H2|Tail2]).
  587
  588set_implies([H1|Tail1],[H2|Tail2]):-
  589    is_literal(H2),!,
  590    set_implies(H1,[H2|Tail2]),
  591    set_implies(Tail1,[H2|Tail2]).
  592
  593set_implies([H1|List1],List2):-
  594    set_implies(H1,List2),
  595    set_implies(List1,List2).
  596
  597/*******************************************************************************/
  598/* strip(Clause, List)                                                         */
  599/*                                                                             */
  600/*   This predicate removes all ands or ors from the clause (they should be    */
  601/*   all ands or all ors) and sticks remaining propositions in a list.         */
  602/*******************************************************************************/
  603
  604strip(X or Y, AList):-
  605   strip(X, XList),
  606   strip(Y, YList),
  607   append(XList, YList, AList), !. % Added cuts to stop choosing alternative rules on failure
  608
  609strip(X and Y, AList):-
  610   strip(X, XList),
  611   strip(Y, YList),
  612   append(XList, YList, AList), !. % Added cuts to stop choosing alternative rules on failure
  613
  614strip(X, [X]).
  615
  616/******************************************************************************/
  617
  618list_strip_or(X or Y,NewXY):-
  619  list_strip_or(X,NewX),
  620  list_strip_or(Y,NewY),
  621  append(NewX,NewY,NewXY),!.
  622
  623list_strip_or(X,[NewX]):-
  624  simplify_and(X,NewX).
  625
  626/*******************************************************************************/
  627/* strip_or(Clause, List)                                                      */
  628/*                                                                             */
  629/*   This predicate removes all ands or ors from Clause which is disjunctive   */
  630/*   and puts them on a bracketed List eg (a and b) or c would be [[a,b],[c]]  */
  631/*******************************************************************************/
  632
  633strip_or(X or Y, NewXY):-
  634  strip_or(X, NewX),
  635  strip_or(Y, NewY),
  636  append(NewX, NewY, NewXY),!.
  637
  638strip_or(X and Y, [NewXY]):-
  639   strip(X and Y, NewXY),!.
  640
  641strip_or(X,[[X]]) :- !.
  642
  643/*******************************************************************************/
  644/* strip_and(Clause, List)                                                     */
  645/*                                                                             */
  646/*   This predicate removes all ands or ors from Clause which is disjunctive   */
  647/*   and puts them on a bracketed List eg (a and b) or c would be [[a,b],[c]]  */
  648/*******************************************************************************/
  649
  650strip_and(X and Y, NewXY):-
  651  strip_and(X, NewX),
  652  strip_and(Y, NewY),
  653  append(NewX, NewY, NewXY),!.
  654
  655strip_and(X or Y, [NewXY]):-
  656   strip(X or Y, NewXY),!.
  657
  658strip_and(X,[[X]]) :- !.
  659
  660/**************************************************************************/
  661
  662member_of_2nd_is_subset_of_1st([],List1,[_|Tail2]):-
  663    member_of_2nd_is_subset_of_1st(List1,List1,Tail2),!.
  664
  665member_of_2nd_is_subset_of_1st([H1|_],_,[H2|_]):-
  666    subset(H2,H1),!.
  667
  668member_of_2nd_is_subset_of_1st([_|Tail1],List1, [H2|Tail2]):-
  669    member_of_2nd_is_subset_of_1st(Tail1,List1, [H2|Tail2]),!.
  670
  671/********************************************************************************/
  672
  673modal_subset([],_):-!.
  674
  675modal_subset(X, X):-!.
  676
  677modal_subset([H |Tail], BList) :-
  678   modal_member(H, BList),!,
  679   modal_subset(Tail, BList).
  680
  681/* modal_member(Item, List) :- Item occurs in List. */
  682/* Note X must be instantiated for this to work otherwise we will just
  683   return the head of our clause.
  684*/
  685
  686modal_member(X, [X | _]):- !.
  687
  688modal_member(X, [sometimes X|_]):- !.
  689
  690modal_member(X, [~ always ~ X|_]):- !.
  691
  692modal_member(X, [_ | Tail]) :- modal_member(X, Tail).
  693
  694/* ******************
  695   * SIMPLIFICATION *
  696   ****************** */
  697
  698/******************************************************************************/
  699/*   simplify(Rules, NewRules)                                                */
  700/*                                                                            */
  701/*  Looks at every rule in Rules and performs standard simplification ie.     */
  702/*            1. replacing a conjunction with complementary literals by false */
  703/*            2. replacing a disjunction with complementary literals by true  */
  704/*            3. removing true from a list of conjuncts                       */
  705/*            4. removing false from a list of conjuncts                      */
  706/******************************************************************************/
  707
  708simplify([],[]).
  709simplify([Rule | Rest], NewRules) :-
  710	simplify_rule(Rule, SRule),
  711	simplify(Rest, NewRest),
  712	append(SRule, NewRest, NewRules).
  713
  714/*****************************************************************************/
  715/* simplify_rule (Rule, NewRules)                                            */
  716/*                                                                           */ 
  717/* Performs various simplifications on Rule. These are                       */
  718/*   - dealing with true and false in conjunctions/disjunctions              */
  719/*   - removing duplicate literals                                           */
  720/*   - dealing with complemetary literals                                    */
  721/*   - getting rid of rules which are always true                            */
  722/*   - expanding rules of the form slast P => false                         */
  723/*****************************************************************************/
  724
  725simplify_rule(r(N1,N2,X => Y),[r(N1,N2,NewR)]):-
  726        is_modal_rule(X => Y),
  727        snff_negate(X, NegX),
  728        simplify_rule(r(N1,N2,NegX or Y),[r(N1,N2,R)]),
  729        change_form(R,[NewR]).
  730
  731simplify_rule(r(N1,N2,R), FinalSet) :-
  732	simplify_true_false(R,U),
  733	remove_true_rules(r(N1,N2,U),RuleSet),   % Ruleset can either be empty, 
  734                                                 % or the single rule as a list
  735	expand_false_rules(RuleSet, FinalSet).   
  736
  737/*****************************************************************************/
  738/*  simplify_rule(Rule, NewRule)                                             */ 
  739/*                                                                           */ 
  740/*  Simplifies Rule by                                                       */
  741/*   - dealing with true and false in conjunctions/disjunctions              */
  742/*   - removing duplicate literals                                           */
  743/*   - dealing with complemetary literals                                    */
  744/*****************************************************************************/
  745
  746simplify_true_false(P => next F, NewP => next NewF ) :-
  747        simplify_and(P, NewishP),
  748        simplify_and_dup(NewishP, NewP),
  749	simplify_or(F,NewishF),
  750        simplify_or_dup(NewishF, NewList),
  751        disjoin(NewList,NewF).
  752
  753simplify_true_false(F, NewF) :-
  754        disjunction_of_modal_literals(F),
  755	simplify_or(F,NewishF),
  756        simplify_or_dup(NewishF, NewerF),
  757        simplify_or_modal(NewerF,NewList),
  758        disjoin(NewList, NewF).
  759
  760/***********************************************************************/
  761/*    simplify_and(Conj,NewConj)                                       */
  762/*                                                                     */ 
  763/*   Takes a conjunction Conj and if true is a conjunct it removes it  */
  764/*   or if false is a conjunct false is returned in NewConj, otherwise */
  765/*   NewConj returns what is left.                                     */
  766/***********************************************************************/
  767
  768simplify_and(A and true, NewA) :- simplify_and(A, NewA),!.
  769
  770simplify_and(true and A, NewA) :- simplify_and(A, NewA),!.
  771
  772simplify_and(_ and false, false):-!.
  773
  774simplify_and(false and _, false):-!.
  775
  776simplify_and(A and _, false) :- simplify_and(A, false),!.
  777
  778simplify_and(_ and B, false) :- simplify_and(B, false),!.
  779
  780simplify_and(A and B, NewB) :- 
  781	simplify_and(A, true),!,
  782	simplify_and(B, NewB).
  783
  784simplify_and(A and B, NewA) :- 
  785	simplify_and(B, true),!,
  786	simplify_and(A, NewA).
  787
  788simplify_and(A and B, NewA and NewB) :- 
  789	simplify_and(A, NewA),
  790	simplify_and(B, NewB),!.
  791
  792simplify_and(~ ~ P, NewP):-
  793        simplify_and(P, NewP).
  794
  795simplify_and(~ true,false).
  796
  797simplify_and(~ false,true).
  798
  799simplify_and(P, P).
  800
  801
  802/*************************************************************************/
  803/*  simplify_and_dup(OldConj,NewConj)                                    */
  804/*                                                                       */ 
  805/*   Takes a conjunction, removes and duplicate literals or              */
  806/*   complementary literals and returns the remaining conjunction in     */
  807/*   NewConj.                                                            */
  808/*************************************************************************/
  809
  810simplify_and_dup(A, false):-   % If we have complementary literals in a conjunct return false
  811   strip(A, AList),
  812   comp_lits_and(AList),!.
  813
  814simplify_and_dup(A, NewA):-
  815   strip(A, AList),
  816   remove_duplicate(AList, NewList),
  817   conjoin(NewList, NewA).
  818
  819/***********************************************************************/
  820/*  remove_duplicate(List, NewList)                                    */
  821/*                                                                     */ 
  822/*  Takes a list of nodes (List) of the form [a,b,c,d] and returns a   */
  823/*  second list with any duplicates removed.                           */
  824/***********************************************************************/
  825
  826remove_duplicate(false,false):- !.
  827
  828remove_duplicate(List1,List2):-
  829  list_to_set(List1,List2).
  830
  831
  832/***********************************************************************/
  833/*    simplify_or(Disj,NewDisj)                                        */
  834/*                                                                     */ 
  835/*   Takes a disjunction Disj and if false is a disjunct it removes it */
  836/*   or if true is a disjunct true is returned in NewDisj, otherwise   */
  837/*   NewDisj returns what is left.                                     */
  838/***********************************************************************/
  839
  840simplify_or(A or false, NewA) :- simplify_or(A, NewA).
  841
  842simplify_or(false or A, NewA) :- simplify_or(A, NewA).
  843
  844simplify_or(_ or true, true).
  845
  846simplify_or(true or _, true).
  847
  848simplify_or(A or _, true) :- simplify_or(A, true).
  849
  850simplify_or(_ or B, true) :- simplify_or(B, true).
  851
  852simplify_or(A or B, NewB) :- 
  853	simplify_or(A, false),
  854	simplify_or(B, NewB).
  855
  856simplify_or(A or B, NewA) :- 
  857	simplify_or(B, false),
  858	simplify_or(A, NewA).
  859
  860simplify_or(A or B, NewA or NewB) :- 
  861	simplify_or(A, NewA),
  862	simplify_or(B, NewB).
  863
  864simplify_or(~ ~ P, NewP):-
  865        simplify_or(P,NewP).
  866
  867simplify_or(~ true,false).
  868
  869simplify_or(~ false,true).
  870
  871simplify_or(P, P).
  872
  873/*************************************************************************/
  874/*  simplify_or_dup(OldDisj,NewDisj)                                     */
  875/*                                                                       */ 
  876/*   Takes a disjunction, OldDisj removes and duplicate literals, deals  */
  877/*   with complementary literals and returns the remaining disjunction   */
  878/*   in NewDisj.                                                         */
  879/*************************************************************************/
  880
  881simplify_or_dup(A, [true]):-        % If we have complementary literals in a disjunct return true.
  882   strip(A, AList),
  883   check_comp_lits(AList).
  884
  885simplify_or_dup(A, [true]):-        % If we have complementary literals in a disjunct return true.
  886   strip(A, AList),
  887   check_modal_lits(AList).
  888
  889simplify_or_dup(A, NewList):-
  890   strip(A, AList),
  891   remove_duplicate(AList, NewList).
  892
  893/****************************************************/
  894
  895check_comp_lits(AList):-
  896   comp_lits_and(AList).
  897
  898/***************************************************/
  899
  900check_modal_lits(AList):-
  901   modal_lits_and(AList).
  902
  903/**************************************************/
  904
  905simplify_or_modal([],[]):-!.
  906
  907simplify_or_modal([~ k ~ L|Rest],[~ k ~ L |Final]):-
  908   remove_member(L,Rest, NewerRest), !,          % Because p -> ~K~p
  909   remove_member(k L,NewerRest, NewestRest),     % Because K p -> p
  910   simplify_or_modal(NewestRest,Final).         
  911
  912simplify_or_modal([k L|Rest],Final):-
  913   member(L,Rest), !,                            % Because K p -> p
  914   simplify_or_modal(Rest,Final).            
  915
  916simplify_or_modal([k L|Rest],Final):-
  917   member(~ k ~ L,Rest), !,                  % Because K p -> ~K~p
  918   simplify_or_modal(Rest,Final).            
  919
  920simplify_or_modal([k L|Rest],[k L|Final]):-
  921   simplify_or_modal(Rest,Final).            
  922
  923simplify_or_modal([L|Rest],Final):-
  924   member(~ k ~ L,Rest), !,            % Because p -> ~K~p
  925   remove_member(k L,Rest, NewerRest),     % Because K p -> p
  926   simplify_or_modal(NewerRest,Final).            
  927
  928simplify_or_modal([L|Rest],[L|Final]):-
  929   remove_member(k L,Rest, NewerRest),     % Because K p -> p
  930   simplify_or_modal(NewerRest,Final).            
  931
  932simplify_or_modal([L|Rest],[L|Final]):-
  933   simplify_or_modal(Rest,Final).
  934
  935/**********************************************/
  936
  937comp_lits(X,Y):-
  938  negate_modal_lit(X,Y).
  939
  940/***************************************************************/
  941/*  comp_lits_and(List)                                        */
  942/*                                                             */ 
  943/* Returns true if complementary literals are found in List    */
  944/***************************************************************/
  945
  946comp_lits_and([H|Tail]):-
  947    negate_modal_lit(H, NegH),
  948    member(NegH,Tail).
  949
  950comp_lits_and([_|Tail]):-
  951  comp_lits_and(Tail).
  952
  953/**************************************************************/
  954
  955modal_lits_and([sometimes X|List]):- !,
  956  negate_modal_lit(X,NegX),
  957  member(NegX,List).
  958
  959modal_lits_and([always _|List]):- !,
  960  modal_lits_and(List).
  961
  962modal_lits_and([X|List]):- !,
  963  negate_modal_lit(X,NegX),
  964  member(sometimes NegX,List).
  965
  966modal_lits_and([_|List]):- !,
  967   modal_lits_and(List).
  968
  969/***************************************************************/
  970/*  comp_lits_or(List)                                         */
  971/*                                                             */ 
  972/* Returns true if complementary literals are found in List    */
  973/***************************************************************/
  974
  975comp_lits_or([H|Tail]):-
  976     negate_all(H, NegH),
  977     node_is_member_of(NegH,Tail).
  978
  979comp_lits_or([_|Tail]):-
  980  comp_lits_or(Tail).
  981
  982/***************************************************************/
  983/*  negate_all(OldList,NewList)                                */
  984/*                                                             */ 
  985/* Negate all takes a list OldList which represents part of a  */
  986/* disjunct and negates all its members which are returned in  */
  987/* NewList.                                                    */
  988/***************************************************************/
  989
  990negate_all([],[]).
  991
  992negate_all([H|Tail],[NegH|NewTail]):-
  993   negate_modal_lit(H, NegH),
  994   negate_all(Tail,NewTail).
  995
  996/*****************************************************************/
  997/* remove_true_rules(Rule,NewRule)                               */
  998/*                                                               */
  999/* Takes a rule in the form r(Number,FromList,Text) and if it is */
 1000/* always true ie of the form ...=> next true                   */
 1001/*                       or   ...=> true                        */
 1002/* NewRule is return with the Text set to [], otherwise the rule */
 1003/* is returned as it is.                                         */
 1004/*****************************************************************/
 1005
 1006remove_true_rules( r(N1,N2,_ => true), r(N1,N2,[])).
 1007remove_true_rules( r(N1,N2,_ => next true), r(N1,N2,[])).
 1008remove_true_rules( r(N1,N2,true),r(N1,N2,[])).
 1009remove_true_rules( R, [R] ).
 1010
 1011/**********************************************************************/
 1012/*  expand_false_rules(Rules, NewRules)                               */
 1013/*                                                                    */
 1014/* Takes the ruleset ie rules to be simplified which is currently     */
 1015/* either a rule of the form r(_,_,[]) ie the text bit is empty as    */
 1016/* rule has been removed as it is always true or it is a list with a  */
 1017/* single rule in. If the rule is of the form                         */
 1018/*               P => next false                                     */
 1019/* then this is rewritten into two new rules                          */
 1020/*               true => next ~P                                     */
 1021/*               start => ~P                                         */
 1022/* The FromList of the original rule is just copied into the FromList */
 1023/* of these two new rules to avoid having to save the rule which is   */
 1024/* going to disappear. Otherwise the rule remains as it is.           */
 1025/**********************************************************************/
 1026
 1027expand_false_rules(r(_,_,[]),[]):-!.
 1028
 1029expand_false_rules([],[]):-!.
 1030
 1031expand_false_rules( [r(_,N2, P => next false)|Rest ], [r(NewR1,N2,NegP)|NewRules ] ) :-
 1032       snff_negate(P, NegP),
 1033       newrulecount(NewR1),
 1034       expand_false_rules(Rest, NewRules).
 1035
 1036expand_false_rules( [ Other | Rest ], [ Other | NewRest ] ) :-
 1037	expand_false_rules(Rest, NewRest).
 1038
 1039/*********************************************************/
 1040/* disjoin(List, Disjunction)                            */
 1041/*                                                       */ 
 1042/* Takes a list of nodes (List) eg [a,b,c] and returns   */
 1043/* them separated by or eg a or b or c in Disjunction    */
 1044/*********************************************************/
 1045
 1046disjoin([], false):-!.
 1047disjoin(List, Form) :- disjoin2(List, Form).
 1048
 1049/*********************************************************/
 1050
 1051disjoin2([F|[]], F):-!.
 1052disjoin2([F | Rest], F or NewForm) :- disjoin2(Rest, NewForm).
 1053
 1054/*********************************************************/
 1055/* conjoin(List, Conjunction)                            */
 1056/*                                                       */ 
 1057/* Takes a list of nodes (List) eg [a,b,c] and returns   */
 1058/* them separated by "and" eg a and b and c in           */
 1059/* Conjunction.                                          */
 1060/*********************************************************/
 1061
 1062conjoin([], true):-!.
 1063conjoin(List, Form) :- conjoin2(List, Form).
 1064
 1065/********************************************************/
 1066
 1067conjoin2([F|[]],F):-!.
 1068conjoin2([F | Rest], F and NewForm) :- conjoin2(Rest, NewForm).
 1069
 1070/*****************************************************************************/
 1071/* is_superset_of__member_of_list(Node, List)                                */ 
 1072/*                                                                           */
 1073/* Returns true if one of List is a subset of Node. Usful for detecting      */
 1074/* conjunctions on the rhs of a rule given we are trying to generate a       */
 1075/* node.                                                                     */
 1076/*                                                                           */
 1077/*****************************************************************************/
 1078
 1079is_superset_of_member_of_list(Node, [H|_]):-
 1080   subset(H, Node).
 1081
 1082is_superset_of_member_of_list(Node, [_|List]):-
 1083   is_superset_of_member_of_list(Node, List).
 1084
 1085/*****************************************************************************/
 1086/* node_is_member_of(NewNode, ListofNodes)                                   */ 
 1087/*                                                                           */
 1088/* Similar to node_is_superset_of_list but returns true if the new node and  */
 1089/* one of the nodes from list of nodes are the same (set wise) ie the        */
 1090/* predicate would return true if new node was [a,b] and either [a, b] or    */
 1091/* [b,a] were found in ListOfNodes.                                          */
 1092/*                                                                           */
 1093/*****************************************************************************/
 1094
 1095node_is_member_of(NewNode, [Node|_]):-
 1096   same(NewNode, Node), !.
 1097
 1098node_is_member_of(NewNode, [_|OldNodes]):-
 1099   node_is_member_of(NewNode, OldNodes).
 1100
 1101/*****************************************************************************/
 1102/* same(NodeX,NodeY)                                                         */
 1103/*                                                                           */
 1104/* Takes two nodes and returns true if they are equivalent ie [a] and [a]    */
 1105/* would return true, also [a,b] and [b,a], but [a,b,c] and [b,c] would not. */
 1106/*                                                                           */
 1107/*****************************************************************************/
 1108
 1109same(X,X) :- !.
 1110
 1111same(X,Y):-
 1112  subset(X,Y),!,
 1113  subset(Y,X).
 1114
 1115/*****************************************************************************/
 1116/* remove_duplicate_nodes(NodeList, NewNodes).                               */
 1117/*                                                                           */
 1118/* Takes a list of nodes (NodeList) and removes any duplicate nodes which    */
 1119/* may exist, ie it returns the set of nodes obtained from the list of nodes.*/
 1120/*                                                                           */
 1121/*****************************************************************************/
 1122
 1123remove_duplicate_nodes([],[]):-!.
 1124
 1125remove_duplicate_nodes([Node|NodeList], NewNodes):-
 1126   node_is_member_of(Node, NodeList), !,
 1127   remove_duplicate_nodes(NodeList, NewNodes).
 1128
 1129remove_duplicate_nodes([Node|NodeList], [Node|NewNodes]):-
 1130   remove_duplicate_nodes(NodeList, NewNodes).
 1131
 1132/***************************************************************************/
 1133
 1134remove_member(X,[X|Rest],NewList):-
 1135   remove_member(X,Rest,NewList).
 1136
 1137remove_member(X,[Y|Rest],[Y|NewList]):-
 1138   remove_member(X,Rest,NewList).
 1139
 1140remove_member(_,[],[]).
 1141
 1142/*********************************************************************************************/
 1143/*  rewrite_and_or(List,Disjunction)                                                         */
 1144/*                                                                                           */
 1145/* Takes a list in the form [[...],[..],[...],[....]] and conjoins all the [..] bits ie      */
 1146/* sticks and between the literals and replaces the , in the original lis by or.             */
 1147/*********************************************************************************************/
 1148
 1149rewrite_and_or([H], NewH):-
 1150   conjoin(H,NewH).
 1151 
 1152rewrite_and_or([H|Tail], NewH or NewTail):-
 1153  conjoin(H, NewH),
 1154  rewrite_and_or(Tail, NewTail).
 1155
 1156/******************************************************************************************/
 1157
 1158negate_modal_lit(~ k ~ X, k ~ X).
 1159
 1160negate_modal_lit(k ~ X, ~ k ~ X).
 1161
 1162negate_modal_lit(~ k X, k X).
 1163
 1164negate_modal_lit(k X, ~ k X).
 1165
 1166negate_modal_lit(~ X, X).
 1167
 1168negate_modal_lit(X, ~ X).
 1169
 1170
 1171/* snff(Initial, Final) :- The Initial set of rules, is transformed to the
 1172                           Final set, which are in DSNF_K form. */
 1173
 1174/********************************************/
 1175/* The Final set of rules is in DSNF_K form */
 1176/********************************************/
 1177
 1178snff([],[]).
 1179
 1180snff(Final, Final) :-
 1181        snff_in_form_list(Final).    
 1182
 1183snff(Initial, Final) :-
 1184        snff_anchor_to_start(Initial,Anchored),
 1185        snff_rewrite_list(Anchored,Final).
 1186
 1187/****************************************************************/
 1188/* Anchor formulae to start if it is not already in DSNF_K form */
 1189/****************************************************************/
 1190
 1191snff_anchor_to_start([],[]):-!.
 1192
 1193snff_anchor_to_start([H|Tail], [H|NewRest]):-
 1194        in_form(H),
 1195        snff_anchor_to_start(Tail,NewRest).
 1199snff_anchor_to_start([H|Tail], [start => V, V => (H)|NewRest]):-
 1200        new_temp_prop(V),
 1201        snff_anchor_to_start(Tail, NewRest).
 1202
 1203/*************************************************/
 1204/* Rewrite rules, so they are in the DSNF_K form */
 1205/*************************************************/
 1206
 1207snff_rewrite_list([],[]):-!.
 1208snff_rewrite_list([Rule|Rest],[Rule|NewRest]):-
 1209         in_form(Rule),
 1210         snff_rewrite_list(Rest,NewRest).
 1211
 1212snff_rewrite_list([Rule|Rest],Other):-
 1213         snff_rewrites(Rule,NewRule, NewInform),
 1214         snff_rewrite_list(NewRule,NewerRule),
 1215         append(NewInform,NewerRule,FinalRule),
 1216         snff_rewrite_list(Rest,NewRest),
 1217         append(FinalRule,NewRest,Other).
 1218
 1219/*************************************************/
 1220/* Rewrite a given clause                        */
 1221/*************************************************/
 1222
 1223snff_rewrites(X => (A and B),[X => A, X => B],[]).
 1224
 1225snff_rewrites(X => ~(A and B),[X => ~ A or ~ B],[]).
 1226
 1227snff_rewrites(X => (A => B),[X => ~ A or B],[]).
 1228
 1229snff_rewrites(X => ~ (A => B),[X => A, X => ~ B],[]).
 1230
 1231snff_rewrites(X => ~ ~ A ,[X => A],[]).
 1232
 1233snff_rewrites(X => k A,[X => ~ V],[V => k A, ~ V => k A]):-
 1234        is_literal(A),
 1235        simplify_and(~ A,NewA),
 1236        new_dontknow_prop(V,NewA).
 1237
 1238snff_rewrites(X => k A ,[V => A],[X => k V]):-
 1239        is_not_literal(A),
 1240        new_temp_prop(V).
 1241
 1242snff_rewrites(X => ~ k A ,[X => V],[V => ~ k A, ~ V => k A]):-
 1243        is_literal(A),
 1244        simplify_and(~ A, NewA),
 1245        new_dontknow_prop(V,NewA).
 1246
 1247snff_rewrites(X => ~ k A ,[X => ~ k ~ V, V => ~ A],[]):-
 1248        is_not_literal(A),
 1249        new_temp_prop(V).
 1250
 1251snff_rewrites(X => A or B, Rest,[NegX or NewA or NewB]):-
 1252        snff_negate(X,NegX),
 1253        check_dnf(A, NewA, ARest),
 1254        check_dnf(B, NewB, BRest),
 1255        append(ARest,BRest,Rest).
 1256
 1257snff_rewrites(X => next A ,[V => A],[X => next V]):-
 1258%        is_not_literal(A),
 1259        new_temp_prop(V).
 1260
 1261snff_rewrites(X => ~ next A,[X => next ~ A],[]).
 1262
 1263snff_rewrites(X => (A until B),[X => V until B, V => A],[]):-
 1264        is_not_literal(A),
 1265        new_temp_prop(V).
 1266
 1267snff_rewrites(X => (A until B),[X => A until V, V => B],[]):-
 1268        is_not_literal(B),
 1269        new_temp_prop(V).
 1270
 1271snff_rewrites(X => (A until B),[],[~ X or B or A, ~ X or B or V, V => next (B or A), V => next (B or V), X => sometimes B]):-
 1272        is_literal(A),
 1273        is_literal(B),
 1274        new_temp_prop(V).
 1275
 1276snff_rewrites(X => ~ (A until B),[X => ((~ B) unless (~ A and ~ B))],[]).
 1277
 1278snff_rewrites(X => (A unless B),[X => V unless B, V => A],[]):-
 1279        is_not_literal(A),
 1280        new_temp_prop(V).
 1281
 1282snff_rewrites(X => (A unless B) ,[X => A unless V, V => B],[]):-
 1283        is_not_literal(B),
 1284        new_temp_prop(V).
 1285
 1286snff_rewrites(X => (A unless B) ,[],[~ X or B or A, ~ X or B or V, V => next (B or A), V => next (B or V)]):-
 1287        is_literal(A),
 1288        is_literal(B),
 1289        new_temp_prop(V).
 1290
 1291snff_rewrites(X => ~ (A unless B) ,[X => ((~ B) until (~ A and ~ B))],[]).
 1292
 1293snff_rewrites(X => (sometimes A) ,[V => A],[X => sometimes V]):-
 1294        is_not_literal(A),
 1295        new_temp_prop(V).
 1296
 1297snff_rewrites(X => (~ sometimes A) ,[X => always ~ A],[]).
 1298
 1299snff_rewrites(X => (always A) ,[X => always V , V => A],[]):-
 1300        is_not_literal(A),
 1301        new_temp_prop(V).
 1302
 1303snff_rewrites(X => (always A) ,[],[~ X or A, V => next A, ~ X or V, V => next V]):-
 1304        is_literal(A),
 1305        new_temp_prop(V).
 1306
 1307snff_rewrites(X => (~ always A) ,[X => sometimes ~ A ],[]).
 1308
 1309snff_rewrites(X => (Y),[],[~ X or Y]):-
 1310      conjunction_of_literals(X),
 1311      disjunction_of_modal_literals(Y).
 1312
 1313/***********************************/
 1314/* check if rule is in DSNF_K form */
 1315/***********************************/
 1316
 1317snff_in_form_list([]):-!.
 1318
 1319snff_in_form_list([H|Tail]):-
 1320      in_form(H),
 1321      snff_in_form_list(Tail).        
 1322
 1323/**********************************/
 1324/* Normal Form                    */
 1325/**********************************/
 1326
 1327in_form(start => X):-
 1328      disjunction_of_literals(X).
 1329
 1330in_form(X):-
 1331      disjunction_of_literals(X).
 1332
 1333in_form(X => k A):-
 1334      is_literal(X),
 1335      is_literal(A).
 1336
 1337in_form(X => ~ k A):-
 1338      is_literal(X),
 1339      is_literal(A).
 1340
 1341in_form(X => sometimes Y):-
 1342       conjunction_of_literals(X),
 1343       is_literal(Y).
 1344
 1345in_form(X => next(Y)):-
 1346      conjunction_of_literals(X),
 1347      disjunction_of_literals(Y).
 1348
 1349/************************************/
 1350/* Disjunction of literals          */
 1351/************************************/
 1352
 1353disjunction_of_literals(X):-
 1354       strip_or(X,StrippedX),
 1355       is_literal_list(StrippedX).
 1356
 1357/**********************************/
 1358/* Disjucntion of modal literals  */
 1359/**********************************/
 1360
 1361disjunction_of_modal_literals(X):-
 1362       strip_or(X,StrippedX),
 1363       is_modal_literal_list(StrippedX).
 1364
 1365/***********************************/
 1366/* Conjunction of literals         */
 1367/***********************************/
 1368
 1369conjunction_of_literals(X):-
 1370       strip_and(X,StrippedX),
 1371       is_literal_list(StrippedX).
 1372
 1373/**************************************************/
 1374/* Verifies if a given list is a list of literals */
 1375/**************************************************/
 1376
 1377is_literal_list([[H]|Tail]):-
 1378      is_literal(H),
 1379      is_literal_list(Tail).
 1380      
 1381is_literal_list([]).       
 1382
 1383/********************************************************/
 1384/* Verifies if a given list is a list of modal literals */
 1385/********************************************************/
 1386
 1387is_modal_literal_list([]).
 1388
 1389is_modal_literal_list([[k H]|Tail]):-
 1390      is_literal(H),
 1391      is_modal_literal_list(Tail).
 1392
 1393is_modal_literal_list([[~ k H]|Tail]):-
 1394      is_literal(H),
 1395      is_modal_literal_list(Tail).
 1396
 1397is_modal_literal_list([[H]|Tail]):-
 1398      is_literal(H),
 1399      is_modal_literal_list(Tail).
 1400
 1401/******************** **************/
 1402/* Check if subformulae are in DNF */
 1403/***********************************/           
 1404
 1405check_dnf(A or B, NewA or NewB, Rest):-
 1406        check_dnf(A, NewA, ARest),
 1407        check_dnf(B, NewB, BRest),
 1408        append(ARest,BRest,Rest).
 1409
 1410check_dnf(A => B, NewAll, Rest):-
 1411        check_dnf(~ A or B, NewAll, Rest).
 1412
 1413check_dnf(A, A, []):-
 1414       is_literal(A).
 1415
 1416check_dnf(k A, ~ V, [V => ~ k A, ~ V => k A]):-
 1417        is_literal(A),
 1418        snff_negate(A,NegA),
 1419        new_dontknow_prop(V,NegA).
 1420
 1421check_dnf(~ k A, V, [V => ~ k A, ~ V => k A]):-
 1422        is_literal(A),
 1423        snff_negate(A,NegA),
 1424        new_dontknow_prop(V,NegA).
 1425
 1426check_dnf(A, V, [V => A]):-
 1427        new_temp_prop(V). 
 1429/*******************************/
 1430/* Form to NNF_Form            */
 1431/*******************************/
 1432
 1433snff_negate(~ X, X):- !.
 1434
 1435snff_negate(X and Y, NotX or NotY):- 
 1436        !, 
 1437        snff_negate(X, NotX),
 1438        snff_negate(Y, NotY).
 1439
 1440snff_negate(X or Y, NotX and NotY):- 
 1441        !, 
 1442        snff_negate(X, NotX), 
 1443	snff_negate(Y, NotY).
 1444
 1445snff_negate(true, false).
 1446
 1447snff_negate(false, true).
 1448
 1449snff_negate(X, ~ X):- 
 1450       is_proposition(X).
 1451
 1452
 1453/**************************************************************************/
 1454/*
 1455   This program is an implementation of nontemporal resolution. 
 1456The predicates related to substitution have been written by Michael, 
 1457non temporal resolution predicates are based on those written by Michael, 
 1458and subsumtion predicates are written by Clare.
 1459
 1460The following procedures are necessary :-
 1461
 1462        1. Check for false
 1463        2. Simplification ie x => next false converted to
 1464                             true => ~x  
 1465        3. Subsumption
 1466        4. Non temporal resolution
 1467        5. Provides new real resolvents
 1468        6. Repeat 1 to 5 until false found or no new resolvents
 1469
 1470Note :-
 1471======
 1472The predicate
 1473                fullmres(OldRules,NewRules)
 1474
 1475sets the non temporal resolution in progress and expects a set of clauses derived 
 1476from translation to SNF (OldRules),which have been numbered and rewritten to the form
 1477
 1478                r(Number,FromList,Text)
 1479
 1480where Number is the number of the clause, FromList, will originally be empty, and Text 
 1481is the actual clause itself. It returns NewRules ie what has been derived from non 
 1482temporal resolution. This predicate is called from fullres.pl as part of the main cycle.
 1483
 1484     A predicate cyclemres is called which recurs on itself until no new resolvents have 
 1485been derived or false has been derived. This predicate and the predicates it calls maintains 
 1486a distinction round each cycle of the Old ruleset and those newly derived from resolution, 
 1487so simpilfication may just be done on the new ruleset, subsumption may be done between the 
 1488new ruleset and the old ruleset, and then non temporal resolution may be done between the 
 1489new ruleset and the old ruleset,before combining the two and starting again around the cycle.
 1490
 1491********************************************************************************/
 1492
 1493/*******************************************************************************/
 1494/*  mres(LiteralRules,
 1495         ModalRules,
 1496         InitialRules,
 1497         NewLRules,
 1498         NewMRules)                                                            */
 1499
 1500
 1501/* This sets the nontemporal resolution off, the first three arguments,        */
 1502/* containing literal, modal and initial clauses,                              */
 1503/* derived from SNF which have been rewriten into the form                     */
 1504/* r(Number,FromList,Text), where currently FromList will be empty.            */
 1505/* NewLRules and NewMRules will contain the new ruleset after no more          */
 1506/* non temporal resolution can take place, or false if false has been derived. */
 1507/*******************************************************************************/
 1508
 1509mres(LiteralRules,ModalRules,Initial,NewLRules,NewMRules):-
 1510     cyclemres(1,[],[],LiteralRules,ModalRules,Initial,NewLRules,NewMRules).    
 1511
 1512% Leave 2nd and 3rd arguments empty so as to treat the original ruleset as "new" resolvents.
 1513
 1514/*****************************************************************************/
 1515/*                                                                           */
 1516/* This predicate is called from fullres.pl during the full resolution       */
 1517/* process. OldRules are in the form r(Number,FromList,Text), where          */
 1518/* Number is the ruless number, FromList contains the numbers of the rules   */
 1519/* which were the parents of this resolvent, and Text is the rule itself     */
 1520/* (in SNF). NewishRules contain the new resolvents obtained from the        */
 1521/* last temporal resolution step. SRules contains a rules which have been    */
 1522/* subsumed on previous cycles round the non-temporal resolution process.    */
 1523/* NewRules will contain the new ruleset                                     */
 1524/* after no more non temporal resolution can take place, or false if a       */
 1525/* contradiction has been derived. NewSRules contains SRules plus any new    */
 1526/* rules which ahve been subsumed.                                           */
 1527/*****************************************************************************/
 1528
 1529mres(OldLiteral,OldModal,NewishLiteral,NewishModal,Initial,NewLiteral,NewModal):-
 1530   cyclemres(1,OldLiteral,OldModal,NewishLiteral,NewishModal,Initial,NewLiteral,NewModal).
 1531
 1532/*****************************************************************************/
 1533/*  cyclemres(Count,
 1534              OldLiteral,
 1535              OldModal,
 1536              NewishLiteral,
 1537              NewishModal,
 1538              Initial,
 1539              NewLiteral,
 1540              NewModal
 1541              )                                                              */
 1542/*                                                                           */
 1543/*  Cycles around the non temporal resolution cycle, checking for false and  */
 1544/*  if found returning false, otherwise performing simplification,           */
 1545/*  subsumption, nontemporal resolution and then recurring on itself until   */
 1546/*  false or an empty set of resolvents is detected. Count is the current    */
 1547/*  cycle we are on, OldRules are rules from previous cyles rounds the       */
 1548/*  non-temporal resolution processes. NewishResolvents are the new          */
 1549/*  resolvents generated during the last cycle of non-temporal resolution    */
 1550/*  and SRules are the store of rules which have been subsumed which may need*/
 1551/*  to be kept to generate a proof if false is derived. NewRules is the      */
 1552/*  final ruleset after no more non-temporal resolution can be done and      */
 1553/*  NewSRules is the new set of subsumed rules.                              */
 1554/*****************************************************************************/
 1555
 1556cyclemres(_,[],[],[],[],_,[],[]).
 1557%:-my_write('\ncyclemres ==> (1)\n').                     % No new resolvents.
 1558
 1559cyclemres(_,LRules,MRules,[],[],_,LRules,MRules):-
 1560%    my_write('\ncyclemres ==> (2)\n'),
 1561    my_write('Have generated no new resolvents,current literal/modal clauses are :-\n'),
 1562    write_ruleset(LRules),                   % Terminate non temporal resolution
 1563    write_ruleset(MRules).                   % as no new Rules have been derived.
 1564
 1565cyclemres(_,_,_,NewLRules,_,[r(_,_,X)],[r(0,[],false)],_):-
 1566%    my_write('\ncyclemres ==> (2.5)\n'),
 1567    snff_negate(X,NegX),
 1568    test_member(NegX,NewLRules),
 1569    simplify(NewLRules,SNewLRules),
 1570    self_subsumption(SNewLRules,SubNewLRules),
 1571    flatten(SubNewLRules,FSubNewLRules),
 1572    my_write('\nNew literal clauses include (~ start).\n'),
 1573    write_ruleset(FSubNewLRules),      % Terminate non temporal resolution as false
 1574    write('\nHave generated false in initial clauses.\n').
 1575
 1576cyclemres(_,_OldLRules,OldMRules,NewLRules,_,_,[r(0,[],false)],OldMRules):-
 1577%    my_write('\ncyclemres ==> (3)\n'),
 1578    test_member(false,NewLRules),
 1579    my_write('\nNew literal clauses include false.\n'),
 1580    write_ruleset(NewLRules),      % Terminate non temporal resolution as false
 1581    write('\nHave generated false in literal clauses.\n').
 1582
 1583cyclemres(_,_OldLRules,_OldMRules,_,NewMRules,_,[r(0,[],false)],[r(0,[],false)]):-
 1584%    my_write('\ncyclemres ==> (4)\n'),
 1585    test_member(false,NewMRules),
 1586    my_write('\nNewModal clauses include false.\n'),
 1587    write_ruleset(NewMRules),   % Terminate non temporal resolution as false
 1588    write('\nHave generated false in modal clauses.\n').
 1589
 1590% Occasionally ran out of space during non-temporal resolution so have hadded a specific garbage collect.
 1591
 1592cyclemres(Count,OldLRules,OldMRules,NewLRules,NewMRules,Initial,NewerLRules,NewerMRules):-
 1593%   my_write('\ncyclemres ==> (5)\n'),
 1594%   garbage_collect,
 1595   writef('\nCycle Number%t.',[Count]),
 1596   my_k_to_literal(NewMRules,KRules),
 1597   append(KRules,NewLRules,AddedNewLRules),
 1598   simplify(AddedNewLRules,SimplifiedLRules),
 1599   simplify(NewMRules,SimplifiedMRules),
 1600   garbage_collect,
 1601   subsumption(OldLRules,SimplifiedLRules,SubOldLRules,SubNewLRules1),
 1602   trim_stacks,
 1603   subsumption(OldMRules,SubNewLRules1,SubOldMRules1,SubNewLRules2),
 1604   trim_stacks,
 1605   subsumption(SimplifiedMRules,SubNewLRules2,SubNewMRules1,SubNewLRules),
 1606   trim_stacks,
 1607   subsumption(SubOldMRules1,SubNewMRules1,SubOldMRules,SubNewMRules),
 1608   trim_stacks,
 1609   my_write('\nOld Literal Clauses\n'),
 1610   write_ruleset(SubOldLRules),
 1611   my_write('\nOld Modal Clauses\n'),
 1612   write_ruleset(SubOldMRules),
 1613   my_write('\nNew Literal Clauses\n'),
 1614   write_ruleset(SubNewLRules),
 1615   my_write('\nNew Modal Clauses\n'),
 1616   write_ruleset(SubNewMRules),
 1617   do_mres(SubOldLRules,SubOldMRules,SubNewLRules,SubNewMRules,ResLRules,ResMRules,NewOldLRules,NewOldMRules),
 1618   NewCount is Count + 1,!,garbage_collect,
 1619   cyclemres(NewCount,NewOldLRules,NewOldMRules,ResLRules,ResMRules,Initial,NewerLRules,NewerMRules).
 1620
 1621/* ************************ */
 1622/* SUBSUMPTION              */
 1623/* ************************ */
 1624
 1625/**********************************************************************************/
 1626/*  subsumption(Old_Rules,New_Rules,SRules,New_Old_Rules,New_New_Rules,NewSRules) */
 1627/*                                                                                */
 1628/*   This predicate takes every rule in New_Rules and attempts subsumption        */
 1629/*   between every rule and every other in this list. Then subsumption is         */
 1630/*   performed between everything in the subsumed version of New_Rules and        */
 1631/*   Old_Rules. New_Old_Rules is then the subsumed version of Old_Rules and       */
 1632/*   New_New_Rules is the subsumed version of New_Rules. SRules contains rules    */
 1633/*   which have been subsumed on previous cycles and NewSRules contain            */
 1634/*   SRules plus any rules subsumed on this cycle.                                */
 1635/**********************************************************************************/
 1636
 1637subsumption(Old_Rules,New_Rules,New_Old_Rules,FNew_New_Rules) :-
 1638  self_subsumption(New_Rules,Newish_Rules),
 1639  flatten(Newish_Rules,FNewish_Rules),!,
 1640  subsumption2(Old_Rules,FNewish_Rules,New_Old_Rules,New_New_Rules),
 1641  flatten(New_New_Rules,FNew_New_Rules),!.
 1642
 1643/******************************************************************************/
 1644/*  self_subsumption([R | Rest],SRules,New_Rules,NewSRules)                   */
 1645/*                                                                            */
 1646/*  Attempts subsumption between R and Rest, recurrs on Rest and outputs      */
 1647/*  subsumed list in New_Rules. SRules are the rules which have been subsumed */
 1648/*  on previous cycles and any new ones subsumed are added to NewSRules.      */
 1649/******************************************************************************/
 1650
 1651self_subsumption([],[]):-!.
 1652
 1653self_subsumption([R|Rest],[NewR|NewRules]):-
 1654  subsume_rule(Rest,R,Remain_Rest,NewR),!,
 1655  self_subsumption(Remain_Rest,NewRules).
 1656
 1657
 1658/***********************************************************************************/
 1659/*  subsumption2(OldRules,[R | Rest],SRules,New_Old_Rules,New_New_Rules,NewSRules) */
 1660/*                                                                                 */
 1661/*  Attempts subsumption between R and OldRules, recurrs on Rest and outputs       */
 1662/*  lists after subsumption in New_Old_Rules and New_New_Rules. SRules are the     */
 1663/*  rules which have been subsumed on previous cycles and any new ones             */
 1664/*  subsumed are added to NewSRules.                                               */
 1665/***********************************************************************************/
 1666
 1667subsumption2(Old_Rules,[],Old_Rules,[]):-!.
 1668
 1669subsumption2([],NewRules,[],NewRules):-!.
 1670
 1671subsumption2(Old_Rules,[R|Rest],New_Old_Rules,[NewR|New_Rules]):-
 1672   subsume_rule(Old_Rules,R,Newish_Old_Rules,NewR),!,
 1673   subsumption2(Newish_Old_Rules,Rest,New_Old_Rules,New_Rules).
 1674
 1675/*******************************************************************************/
 1676/* subsume_rule(Old_Rules,ThisRule,SRules,New_Old_Rules,New_ThisRule,NewSRules)*/
 1677/*                                                                             */
 1678/*   This predicate compares ThisRule with every rule in Old_Rules. Rules are  */
 1679/*   in the format r(Number,FromList,Text). If ThisRule is subsumed by a       */
 1680/*   rule in Old_Rules then Old_rules are returned and New_ThisRule will be    */
 1681/*   and empty list but if ThisRule subsumes a Rule in Old_Rules, the rule     */
 1682/*   that has been subsumed is removed from Old_Rules and the predicate the    */
 1683/*   attempts subsumption between ThisRule and the rest of Old_Rules.          */
 1684/*   It is important that the predicates are in the order they appear in, as   */
 1685/*   if there are duplicate rules ie Rule1 subsumes Rule2 and vice versa we    */
 1686/*   want to remove ThisRule and return an empty list as New_ThisRule          */
 1687/*   rather than the other way around for we are depending upon no new         */
 1688/*   resolvents to be derived for our non-temporal resolution process to       */
 1689/*   terminate. SRules contains any rules which have been subsumed previously  */
 1690/*   NewSRules will also contain rules subsumed on this cycle.                 */
 1691/*******************************************************************************/
 1692
 1693% Firstly looking at cases of strong last implies something
 1694
 1695subsume_rule([],r(N1,N2,G),[],[r(N1,N2,G)]):-!.
 1696subsume_rule([],R,[],[R]):-!.
 1697
 1698subsume_rule([r(N1,N2,F) | Rules],r(_,_,G),[r(N1,N2,F) | Rules],[]) :-
 1699             dis_implies(F,G),!.                                % P => F
 1700
 1701subsume_rule([r(_,_,F) | Rules],r(N1,N2,G),New_Old_Rules,New_New_Rules) :-
 1702            dis_implies(G ,F),!,                        % Q => G subsumes P => F
 1703	    subsume_rule(Rules,r(N1,N2,G),New_Old_Rules,New_New_Rules).
 1704
 1705% default behaviour: ie no subsumption takes place
 1706
 1707subsume_rule([ R | Rules],r(N1,N2,G),[ R | New_Rules],New_New_Rules) :-
 1708	subsume_rule(Rules,r(N1,N2,G),New_Rules,New_New_Rules).
 1709
 1710% default behaviour to catch any of the cases not mentioned above
 1711
 1712subsume_rule([ R1 | Rules],R2,[ R1 | New_Old_Rules],New_New_Rules) :-
 1713   subsume_rule(Rules,R2,New_Old_Rules,New_New_Rules).
 1714
 1715
 1716/* ************************* */
 1717/* NON-TEMPORAL RESOLUTION * */
 1718/* ************************* */
 1719
 1720/*********************************************************************************/
 1721/* mres(OrigRules,[Rule|Rest],NewRules,Final)                                    */
 1722/*                                                                               */
 1723/*   Michaels code changed slightly to do non temporal resolution between        */
 1724/*   two lists OrigRules and [Rule|Rest] (new rules derived from resolution last */
 1725/*   time round the loop). After resolving Rule with every rule in OrigRules it  */
 1726/*   is added to OrigRules, and the first rule from Rest is resolved with all    */
 1727/*   rules in OrigRules + Rule, and so on. When Rest is empty, OrigRules which   */
 1728/*   now has all of [Rule|Rest] attached is copied to NewOrig and resolvents     */
 1729/*   found built up in Final. The first time round the loop ie after             */
 1730/*   initial conversion to SNF OrigRules will be empty, so gradually [Rule|Rest] */
 1731/*   will be copied into it and effectively resolved on itself. Rules are in the */
 1732/*   form r(Number,FromList,Text) . When resolution takes place a new            */
 1733/*   number for the rule is placed in Number and FromList will have the two rule */
 1734/*   numbers of the parents of the new rule.                                     */
 1735/*********************************************************************************/
 1736
 1737
 1738do_mres(LNewOrig,MOrigRules,LNew,RNew,FinalL,FinalM,NewOrigL2,NewOrigM2):-
 1739%    my_write('\ndo_mres ==> (2)\n'),
 1740    do_mres(LNewOrig,MOrigRules,LNew,FinalL1,FinalM1,NewOrigL1,NewOrigM1),
 1741    do_mres(NewOrigL1,NewOrigM1,RNew,FinalL2,FinalM2,NewOrigL2,NewOrigM2),
 1742    append(FinalL1,FinalL2,FinalL),
 1743    append(FinalM1,FinalM2,FinalM).
 1744
 1745do_mres(LNewOrig,MNewOrig,[],[],[],LNewOrig,MNewOrig).
 1746%:-my_write('\ndo_mres ==> (1).\n').
 1747
 1748do_mres(LOrigRules,MOrigRules,[Rule|Rest],FinalL,FinalM,NewOrigL,NewOrigM) :-
 1749%        my_write('\ndo_mres ==> (3).\n'),
 1750	mresolve(Rule,LOrigRules,MOrigRules,RulesL1,RulesM1),
 1751        add_to_set(LOrigRules,MOrigRules,Rule,Rest,RulesL1,RulesM1,FinalL,FinalM,NewOrigL,NewOrigM).
 1752
 1753/*************************************************************************************************/
 1754
 1755add_to_set(LOrigRules,MOrigRules,Rule,Rest,RulesL1,RulesM1,FinalL,FinalM,NewOrigL,NewOrigM) :-
 1756%        my_write('\nadd_to_set ==> (1)\n'),
 1757        is_modal_rule(Rule),!,
 1758	do_mres(LOrigRules,[Rule|MOrigRules],Rest,NewRulesL,NewRulesM,NewOrigL,NewOrigM),
 1759	append(RulesL1,NewRulesL,FinalL),
 1760	append(RulesM1,NewRulesM,FinalM).
 1761
 1762add_to_set(LOrigRules,MOrigRules,Rule,Rest,RulesL1,RulesM1,FinalL,FinalM,NewOrigL,NewOrigM) :-
 1763%        my_write('\nadd_to_set ==> (2)\n'),
 1764	do_mres([Rule|LOrigRules],MOrigRules,Rest,NewRulesL,NewRulesM,NewOrigL,NewOrigM),
 1765	append(RulesL1,NewRulesL,FinalL),
 1766	append(RulesM1,NewRulesM,FinalM).
 1767
 1768/*********************************************************************************/
 1769/*  mresolve(Rule,OrigRules,NewRules)                                            */
 1770/*                                                                               */
 1771/*  Takes a rule of the form r(Number,FromList,Text) and tries resolution        */
 1772/*  between the Text of this rule and the Text of all the other rules in         */
 1773/*  OrigRules. Any new resolvents derived are put into new rules where the       */
 1774/*  Number of the new resolvent is the next new rule number, and FromList is     */
 1775/*  filled with the rule numbers of the parents of the resolvent.                */
 1776/*********************************************************************************/
 1777
 1778/* First,the cases where resolution cannot take place */
 1779
 1780mresolve(_,[],[],[],[]).
 1781% :-my_write('\nmresolve ==> (1)\n').
 1782
 1783/* Next,resolution of initial rules: */
 1784
 1785mresolve(r(N1,N2,F),[r(N3,_,G) | Rest],Other,LFinal,MFinal) :-
 1786%        my_write('\nmresolve ==> (2)\n'),
 1787        basic_nt_resolve(F,G,Resolvent,[],[]),
 1788	mresolve(r(N1,N2,F),Rest,Other,NewLRules,NewMRules),
 1789	generate_new_resolvent([N1,N3],Resolvent,NewLRules,NewMRules,LFinal,MFinal).
 1790
 1791mresolve(Rule,[_ | Rest],Other,NewLRules,NewMRules) :-
 1792%        my_write('\nmresolve ==> (3)\n'),
 1793	mresolve(Rule,Rest,Other,NewLRules,NewMRules).
 1794
 1795mresolve(r(N1,N2,F),[],[r(N3,_,G) | Rest],LFinal,MFinal) :-
 1796%        my_write('\nmresolve ==> (4)\n'),
 1797        basic_nt_resolve(F,G,Resolvent,[],[]),
 1798	mresolve(r(N1,N2,F),[],Rest,NewLRules,NewMRules),
 1799	generate_new_resolvent([N1,N3],Resolvent,NewLRules,NewMRules,LFinal,MFinal).
 1800
 1801mresolve(Rule,[],[_ | Rest],NewLRules,NewMRules) :-
 1802%        my_write('\nmresolve ==> (5)\n'),
 1803	mresolve(Rule,[],Rest,NewLRules,NewMRules).
 1804
 1805/*****************************************************************************/
 1806/*  generate_new_resolvent(FromList,ResolventList,Rules,NewRules             */
 1807/*                                                                           */
 1808/* If Resolvent is empty this just returns Rules as they are, otherwise a    */
 1809/* new rule is created and added to the front of Rules.                      */
 1810/*****************************************************************************/
 1811
 1812generate_new_resolvent(_,[],LR,MR,LR,MR).
 1813
 1814generate_new_resolvent(FromList,[Resolvent],LRules,MRules,FinalLRules,FinalMRules):-
 1815      is_modal_disjunct(Resolvent),!,
 1816      simplify_rule(r(_,FromList,Resolvent),[r(_,FromList,SimpRule)]),
 1817      change_form(SimpRule,RulesList),
 1818      number_rules(RulesList,FromList,NumberedRules),
 1819      simplify(NumberedRules,SimpRules),
 1820      separate_rules(SimpRules,_ERules,_Initial,NewLRules,NewMRules,_Temporal),
 1821      append(LRules,NewLRules,FinalLRules),
 1822      append(MRules,NewMRules,FinalMRules).
 1823
 1824generate_new_resolvent(FromList,[Resolvent],LRules,MRules,[SimpRule | LRules],MRules):-
 1825      newrulecount(N),
 1826      simplify_rule(r(N,FromList,Resolvent),[SimpRule]).
 1827
 1828/******************************************************************************/
 1829/*  basic_nt_resolve(Disj1,Disj2,Resolvent,S1,S2) :-                          */
 1830/*                                                                            */
 1831/*      Tries to resolve the clauses Disj1 and Disj2 together.                */
 1832/*      If it fails, Resolvent is [], if it succeeds,                         */
 1833/*	resolvent is [resolvent]. S1 is a list recording what is left          */
 1834/*	of Disj1, while S2 is what is left of Disj2.                           */
 1835/******************************************************************************/ 
 1836
 1837basic_nt_resolve(A => B,Disj2,Resolvent,S1,S2):- 
 1838        snff_negate(A,NegA),!,
 1839        basic_nt_resolve(NegA or B,Disj2,Resolvent,S1,S2).        
 1840
 1841basic_nt_resolve(Disj1,A => B,Resolvent,S1,S2):-
 1842        snff_negate(A,NegA),!,
 1843        basic_nt_resolve(Disj1,NegA or B,Resolvent,S1,S2).
 1844
 1845basic_nt_resolve(A or B,Disj2,Resolvent,S1,S2) :-
 1846	basic_nt_resolve(A,Disj2,Resolvent,[B|S1],S2).
 1847
 1848basic_nt_resolve(A or B,Disj2,Resolvent,S1,S2) :-
 1849	basic_nt_resolve(B,Disj2,Resolvent,[A|S1],S2).
 1850
 1851basic_nt_resolve(_ or _, _,_,_,_) :- fail.
 1852
 1853basic_nt_resolve(A,Disj2,Resolvent,S1,S2) :-
 1854	internal_nt_resolve(A,Disj2,Resolvent,S1,S2).
 1855
 1856/*****************************************************************************/
 1857/*  internal_nt_resolve(L,Disj, Resolvent,S1,S2)                             */
 1858/*                                                                           */
 1859/*  Attempts to resolve L which is now a proposition or negated proposition  */
 1860/*  with Disj. S1 and S2 have what remains of the original two disjuncts     */
 1861/*  we were trying to resolve. The resolvent created is returned in          */
 1862/*  Resolvent                                                                */
 1863/*****************************************************************************/
 1864
 1865internal_nt_resolve(L,A or B, Resolvent,S1,S2) :-
 1866	internal_nt_resolve(L,A,Resolvent,S1,[B|S2]).
 1867
 1868internal_nt_resolve(L,A or B,Resolvent,S1,S2) :- 
 1869	internal_nt_resolve(L,B,Resolvent,S1,[A|S2]).
 1870
 1871internal_nt_resolve(_,_ or _,_,_,_) :- fail.
 1872
 1873internal_nt_resolve(L,M,[Resolvent],S1,S2) :-
 1874        resolveable(L,M,S1,S2,NewS1,NewS2),
 1875	append(NewS1,NewS2,NewLst),
 1876	disjoin(NewLst,Resolvent).
 1877
 1878/*********************/
 1879/* Basic Resolution  */
 1880/*********************/
 1881
 1882resolveable(L,M,S1,S2,S1,S2):-
 1883  comp_lits(L,M).
 1884
 1885/********************/
 1886/* Modal Resolution */
 1887/********************/
 1888
 1889resolveable(L,M,S1,S2,NewS1,NewS2):-
 1890  sometime_rule(L,M,S1,S2,NewS1,NewS2). 
 1891
 1892resolveable(L,M,S1,S2,NewS1,NewS2):- 
 1893  always_rule(L,M,S1,S2,NewS1,NewS2). 
 1894
 1895/**********/ 
 1896/* MRES 2 */ 
 1897/**********/ 
 1898
 1899sometime_rule(k L,k M,S1,S2,S1,S2):-
 1900  comp_lits(L,M). 
 1901
 1902/**********/ 
 1903/* MRES 3 */ 
 1904/**********/ 
 1905
 1906sometime_rule(k L,M,S1,S2,S1,S2):-
 1907  comp_lits(L,M).
 1908
 1909sometime_rule(L,k M,S1,S2,S1,S2):-
 1910  comp_lits(L,M).
 1911
 1912/**********/ 
 1913/* MRES 4 */ 
 1914/**********/ 
 1915
 1916always_rule(~ k L,L,S1,S2,S1,NewS2):-
 1917  change_resolvent(S2,NewS2).
 1918
 1919always_rule(L,~ k L,S1,S2,NewS1,S2):-
 1920  change_resolvent(S1,NewS1).
 1921
 1922always_rule(~ k ~ L,M,S1,S2,S1,NewS2):-
 1923  comp_lits(L,M), 
 1924  change_resolvent(S2,NewS2). 
 1925
 1926always_rule(L,~ k ~ M,S1,S2,NewS1,S2):- 
 1927  comp_lits(L,M), 
 1928  change_resolvent(S1,NewS1). 
 1929
 1930/****************/ 
 1931/* MOD FUNCTION */ 
 1932/****************/ 
 1933
 1934change_resolvent([A or B|Rest], NewAll):-
 1935  change_resolvent(A or B,NewAB),
 1936  change_resolvent(Rest, NewRest), 
 1937  append(NewAB,NewRest, NewAll).
 1938
 1939change_resolvent(A or B, NewAB):-
 1940  change_resolvent(A, NewA),
 1941  change_resolvent(B, NewB),
 1942  append(NewA, NewB, NewAB).
 1943
 1944change_resolvent([A|Rest],NewAll):-
 1945  change_resolvent(A,NewA),
 1946  change_resolvent(Rest,NewRest),
 1947  append(NewA,NewRest,NewAll).
 1948
 1949change_resolvent([],[]).
 1950
 1951change_resolvent(X,[X]):-is_snl_literal(X).
 1952
 1953change_resolvent(~ k L,[~ k L]):-is_literal(L).
 1954
 1955change_resolvent(k L,[k L]):-is_literal(L).
 1956
 1957change_resolvent(k ~ L,[k ~ L]):-is_literal(L).        % Clare is this right?
 1958
 1959change_resolvent(~ k ~ L,[~ k ~ L]):-is_literal(L).
 1960
 1961change_resolvent(~ L,[~ k L]):-is_literal(L).
 1962
 1963change_resolvent(L,[~ k ~ L]):-is_literal(L). 
 1964
 1965/**********************************/ 
 1966
 1967is_modal_rule(r(_,_,Y => X)):- 
 1968   is_modal_rule(Y => X). 
 1969
 1970is_modal_rule(_Y => X):- 
 1971  is_modal_disjunct(X). 
 1972
 1973/**********************************/ 
 1974
 1975is_modal_disjunct(k _). 
 1976
 1977is_modal_disjunct(~ k _). 
 1978
 1979is_modal_disjunct(A or _):- 
 1980  is_modal_disjunct(A). 
 1981
 1982is_modal_disjunct(_ or B):- 
 1983  is_modal_disjunct(B). 
 1984
 1985/***************************************/
 1986
 1987is_list_of_only_modals(A or B):-
 1988  is_modal(A), 
 1989  is_list_of_only_modals(B).
 1990
 1991is_list_of_only_modals(A):-
 1992  is_modal(A).
 1993
 1994is_list_of_only_literals(A or B):-
 1995  is_literal(A), 
 1996  is_list_of_only_literals(B).
 1997
 1998is_list_of_only_literals(A):-
 1999   is_literal(A). 
 2000
 2001/*****************************************************************/
 2002/* The following returns a modal clause in the new normal form   */
 2003/*****************************************************************/ 
 2004
 2005change_form(true,[true]).
 2006
 2007change_form(Disjunction,[true => Disjunction]):-
 2008  is_modal(Disjunction).
 2009
 2010change_form(~ k X or Disj1, [Disj2 => ~ k X]):-
 2011  is_literal(Disj1),!,
 2012  snff_negate(Disj1,Disj2).
 2013
 2014change_form(k X or Disj1, [Disj2 => k X]):-
 2015  is_literal(Disj1),!,
 2016  snff_negate(Disj1,Disj2).
 2017
 2018change_form(Disj1 or ~ k X, [Disj2 => ~ k X] ):-
 2019  is_literal(Disj1),!,
 2020  snff_negate(Disj1,Disj2).
 2021
 2022change_form(Disj1 or k X, [Disj2 => k X]):-
 2023  is_literal(Disj1),!,
 2024  snff_negate(Disj1,Disj2).
 2025
 2026change_form(Disjunction,[Disjunction]):-
 2027   is_list_of_only_literals(Disjunction).
 2028
 2029change_form(Disjunction,List):- 
 2030  is_list_of_only_modals(Disjunction), 
 2031  snl_form(Disjunction,Literals,Modals),
 2032  append([Literals],Modals,List). 
 2033
 2034change_form(Disj1 or Disj2,Rest):-
 2035  is_literal(Disj1), 
 2036  snff_rewrite_list([~ Disj1 => (Disj2)],Rest).
 2037
 2038change_form(Disj1 or Disj2,Rest):- 
 2039  is_not_literal(Disj1),!, 
 2040  change_order(Disj1 or Disj2, NewDisj),
 2041  change_form(NewDisj,Rest). 
 2042
 2043/************************************************/ 
 2044
 2045change_order(A or B,NewOrder):- 
 2046  strip_or(A,NewA), 
 2047  strip_or(B,NewB), 
 2048  flatten(NewA,FlatA), 
 2049  flatten(NewB,FlatB), 
 2050  append(FlatB,FlatA,New), 
 2051  disjoin(New,NewOrder). 
 2052
 2053
 2054/*********************************************************************/
 2055/* The following returns the SNL literals and definition clauses     */
 2056/* from a given formula                                              */
 2057/*                                                                   */
 2058/* (1) the SNL literal itself                                        */
 2059/* (2) the disjunction of SNL literals                               */
 2060/* (3) the SNL(NEW), in case of a conjunction                        */
 2061/* (4) SNL(literal), in case of a non SNL literal                    */
 2062/*                                                                   */
 2063/*********************************************************************/
 2064
 2065snl(Formula,Formula,_,[],[]):- 
 2066   is_snl_literal(Formula). 
 2067
 2068snl(NewLiteralA or NewLiteralB,A or B,N,Literals,Modals):- 
 2069   snl(NewLiteralA,A,N,Literals1,Modals1), 
 2070   snl(NewLiteralB,B,N,Literals2,Modals2), 
 2071   append(Literals1,Literals2,Literals), 
 2072   append(Modals1,Modals2,Modals). 
 2073
 2074snl(NewLiteral,A and B,N,Literals,Modals):- 
 2075  snl_conjunction(NewLiteral,A and B,N,Literals,Modals). 
 2076
 2077snl(NewLiteral,Formula,N,[],[Rule1,Rule2]):- 
 2078   is_literal(Formula),!, 
 2079   new_dontknow_prop(NewLiteral,Formula), 
 2080   snff_negate(Formula, NegF), 
 2081   snff_negate(NewLiteral, NegNewLiteral), 
 2082   number_rule(NewLiteral => ~ k NegF,N,Rule1), 
 2083   number_rule(NegNewLiteral => k NegF,N,Rule2). 
 2084
 2085/****************************************************************/ 
 2086/* The following takes a formula and returns the corresponding  */
 2087/* SNL definition clauses.                                      */
 2088/****************************************************************/ 
 2089
 2090
 2091snl_form(k L,[NegNewProp],[NewProp => ~ k L, NegNewProp => k L]):- 
 2092   snff_negate(L,NegL), 
 2093   new_dontknow_prop(NewProp, NegL), 
 2094   snff_negate(NewProp,NegNewProp). 
 2095
 2096snl_form(~ k L,[NewProp],[NewProp => ~ k L, NegNewProp => k L]):- 
 2097   snff_negate(L,NegL), 
 2098   new_dontknow_prop(NewProp, NegL), 
 2099   snff_negate(NewProp,NegNewProp). 
 2100
 2101snl_form(A or B,Literals,Modals):- 
 2102   snl_form(A,Literals1,Modals1), 
 2103   snl_form(B,Literals2,Modals2), 
 2104   append(Literals1,Literals2,LiteralList), 
 2105   disjoin(LiteralList,Literals), 
 2106   append(Modals1,Modals2,Modals). 
 2107
 2108/************************************************************/ 
 2109/* The following deals with conjunctions of literals        */
 2110/* and returns the new proposition renaming the conjunction */
 2111/* as well as its corresponding definition clauses          */
 2112/************************************************************/
 2116snl_conjunction(SimpSNL,Conjunction,_,[],[]):-
 2117  strip_and(Conjunction,List), 
 2118  flatten(List,FList), 
 2119  remove_news(FList,NewList),
 2120  separate_snl_literals(NewList,NewishList,OldSNLList),
 2121  subset(NewishList,[]), 
 2122  conjoin(OldSNLList,OldSNL),      
 2123  simplify_and(OldSNL,SimpSNL). 
 2127snl_conjunction(NewConj,Conjunction,N,[],[Rule1,Rule2]):- 
 2128  strip_and(Conjunction,List),
 2129  flatten(List,FList),
 2130  remove_news(FList,NewList),
 2131  separate_snl_literals(NewList,NewishList,OldSNLList),
 2132  test_conjunction(NewishList,Prop), 
 2133  conjoin(OldSNLList,OldSNL), 
 2134  new_dontknow_prop(NewSNL,Prop), 
 2135  simplify_and(OldSNL and NewSNL,NewConj), 
 2136  snff_negate(Prop,NegProp), 
 2137  snff_negate(NewSNL,NegNewSNL), 
 2138  number_rule(NewSNL => ~ k NegProp,N,Rule1), 
 2139  number_rule(NegNewSNL => k NegProp,N,Rule2). 
 2143snl_conjunction(NewConj,Conjunction,N,Literals,SimplifiedRules):-
 2144  strip_and(Conjunction,List),
 2145  flatten(List,FList),
 2146  remove_news(FList,NewList),
 2147  separate_snl_literals(NewList,NewishList,OldSNLList),
 2148  conjoin(OldSNLList,OldSNL),
 2149  conjoin(NewishList,Formula),
 2150  simplify_and(Formula,SFormula),
 2151  new_conj_prop(NewProp,SFormula),
 2152  snff_negate(SFormula,NFormula),
 2153  number_rule(NewProp or NFormula,N,Definition),
 2154  simplify([Definition],Literals),  
 2155  new_dontknow_prop(NewSNL,NewProp),
 2156  generate_new_modals(NewSNL,N,NewishList,NewModals),
 2157  simplify_and(OldSNL and NewSNL,NewConj),
 2158  snff_negate(NewProp,NegNewProp),
 2159  snff_negate(NewSNL,NegNewSNL),
 2160  number_rule(NewSNL => ~ k NegNewProp,N,Rule1),
 2161  number_rule(NegNewSNL => k NegNewProp,N,Rule2),
 2162  append([Rule1],[Rule2],Definitions),
 2163  append(Definitions,NewModals,Rules),
 2164  simplify(Rules,SimplifiedRules).
 2165
 2166/* generate new modals for conjunctions */
 2167
 2168generate_new_modals(_,_,[],[]).
 2169
 2170generate_new_modals(NewSNL,N,[Head|Tail],[Definition|NewModals]):-
 2171  snff_negate(NewSNL,NegNewSNL),
 2172  snff_negate(Head,NegHead),
 2173  number_rule(NegNewSNL => k NegHead,N,Definition),
 2174  generate_new_modals(NewSNL,N,Tail,NewModals).
 2175
 2176test_conjunction([Head|Tail],Head):- 
 2177  subset(Tail,[]). 
 2178
 2179/* takes a new proposition and returns its label */
 2180
 2181remove_news([],[]). 
 2182
 2183remove_news([new(X)|List],[X|NewList]):- 
 2184  remove_news(List,NewList). 
 2185
 2186remove_news([X|List],[X|NewList]):- 
 2187  remove_news(List,NewList). 
 2188
 2189/* remove SNL literals from a list of conjuncts */
 2190
 2191separate_snl_literals(List,Literals,SNLLiterals):-
 2192  sublist(is_snl_literal,List,SNLLiterals),
 2193  subtract(List,SNLLiterals,Lit),
 2194  sort(Lit,Literals).
 2195
 2196/* My implementation of MRES5                    */
 2197
 2198my_k_to_literal([],[]):- !. 
 2199
 2200my_k_to_literal([r(N,_M,X => k Y)|Rest],[Rule|NewRest]):-!, 
 2201  snff_negate(X,NegX),
 2202  number_rule(NegX or Y,[N,mres5],Rule),
 2203  my_k_to_literal(Rest,NewRest).
 2204 
 2205my_k_to_literal([r(_,_,_ => ~ k _)|Rest],NewRest):-!, 
 2206  my_k_to_literal(Rest,NewRest).
 2207
 2208/*
 2209This program controls the temporal resolution part of the temporal resolution
 2210theorem prover. To use the theorem prover start up sicstus by typing
 2211"sicstus" and at the promt type [rules, snff, nontemp, tempres, fullres].
 2212(or whatever the programs are called at this moment) which will load the
 2213programs.
 2214
 2215This program is called from fullres.pl which drives the resolution cycle of
 2216             1. Translation to SNF
 2217             2. Non temporal resolution
 2218             3. Temporal resolution
 2219*/
 2220
 2221/*****************************************************************************/
 2222/* tempres(Rules, ERulePaths, NewERule, RelatedRules,RulesUsed, LoopPath).   */
 2223/*                                                                           */
 2224/* Takes a list of rules output by SNF (Rules), which have been subsequently */
 2225/* numbered and have a record of the numbers oftheir parent resolvents,      */
 2226/* ie. they are in the form          r(Number, FromList, Text)          and  */
 2227/* after attempts at non temporal resolution have been exhausted, tries      */
 2228/* temporal resolution. ERulePaths contains a list made up of sublists. Each */
 2229/* sublist has an eventuality which has been taken from the global and       */
 2230/* initial sometimes rules and a list of previous paths detected. Thus       */
 2231/* ERulePaths is of the form [[p,[]],[~ q,[]]] if we have only two         */
 2232/* sometimes rules which may be  a => sometimes ~ p and               */
 2233/* wlast false => sometimes q, say.                                          */
 2234/* Currently in this example no loops have been found so the list containing */
 2235/* paths previously detected in each case is empty. The program attempts to  */
 2236/* find a loop in an eventuality form this list. It first tries to look for  */
 2237/* a loop for the first eventuality in the ERulePaths list (in our example p)*/
 2238/* If the program detects a loop which has not been found before it returns  */
 2239/* the eventuality (p) in the variable NewERule and the loop it has found in */
 2240/* LoopPath. If no new loops are found in the first eventuality in the       */
 2241/* ERulePaths list the progam looks for loops in the second, third etc until */
 2242/* a new loop is found or no new loops can be found.                         */
 2243/* RelatedRules are the set of rules of the form  R => next p, where p is   */
 2244/* the current eventuality, and RulesUsed contains a list of the numbers of  */
 2245/* rules used in this loop.                                                  */
 2246/*                                                                           */
 2247/*****************************************************************************/
 2248
 2249/* Related rules are the new clauses generated by temporal resolution */
 2250
 2251tempres(Rules,[[ERule,PrevPath]|ERulePaths],NewERule,RelatedRules,RulesUsed,LoopPath):-
 2252  temp_resolution(ERule,ERulePaths,Rules,PrevPath,NewERule,RelatedRules,RulesUsed,LoopPath).
 2253
 2254
 2255/*****************************************************************************/
 2256/* temp_resolution(ERule, ERulePaths, Rules, PrevPaths, NewERule,            */
 2257/*                                        RelatedRules,RulesUsed, LoopPath)  */
 2258/*                                                                           */
 2259/* Takes an eventuality ERule (say p), a list of loops previously found for  */
 2260/* this eventuality (PrevPaths), a list of the remaining eventualities       */
 2261/* paired with loops which have been found previously (ERulePaths), and the  */
 2262/* list of rules (Rules) which have been output from previous cycles of      */
 2263/* temporal and non temporal resolution. The global box rules are extracted  */
 2264/* from Rules and then the program looks for new loops in ERule from these   */
 2265/* global box rules. If a new loop is found in ERule the loop is returned in */
 2266/* LoopPath and the eventuality it matches is returned in NewERule. If no    */
 2267/* loop is found for this ERule the first eventuality and list of previous   */
 2268/* paths is stripped from the front of ERulePaths and a new loop is looked   */
 2269/* in this new eventuality.                                                  */
 2270/* RelatedRules are the set of rules of the form  R => next p, where p is   */
 2271/* the current eventuality, and RulesUsed contains a list of the numbers of  */
 2272/* rules used in this loop.                                                  */
 2273/*                                                                           */
 2274/*****************************************************************************/
 2275
 2276temp_resolution(ERule,ERulePaths,Rules,PrevPaths,NewERule,RelatedRules,RulesUsed,NewLoopPath):-
 2277  my_writef('Attempting temporal resolution with %t.\n',[ERule]),
 2278  resolve_eventuality(ERule, Rules, RelatedRules1,RulesUsed1,LoopPath),   
 2279  test_path(ERule,ERulePaths,Rules,PrevPaths,LoopPath,NewERule,RelatedRules1,RulesUsed1,RelatedRules,RulesUsed,NewLoopPath).
 2280
 2281/*****************************************************************************/
 2282/*   test_path(ERule,ERulePaths, Rules, PrevPaths, LoopPath, NewERule,       */
 2283/*         RelatedRules1,RulesUsed1, RelatedRules,RulesUsed, NewLoopPath).   */
 2284/*                                                                           */
 2285/* Checks to see whether we need to do any more temporal resolution or not.  */
 2286/* We terminate without having found a loop (NewLoopPath is empty) if there  */
 2287/* are no more eventualities to deal with (ERulePaths is empty) and if we    */
 2288/* detected a loop this time (LoopPath is empty) or we have detected a loop  */
 2289/* which is the same a a previous loop. Otherwise we recursively call        */
 2290/* temp_resolution with the next eventuality on the ERulePaths list          */
 2291/* with a loop if we detect a loop that is not the same as a loop we have    */
 2292/* before for this eventuality.                                              */
 2293/*                                                                           */
 2294/*****************************************************************************/
 2295
 2296                       % Last loop detected was empty and there are no eventualities
 2297                       % left to process.
 2298
 2299test_path(_,[],_Rules,_,[],_NewERule,_,_,[],[],[]):- !.
 2300
 2301                       % Last loop detected was empty so look for loops for the
 2302                       % next eventuality.
 2303
 2304test_path(_,[[ERule,PrevPath]|ERulePaths], Rules,_,[],NewERule,_,_,RelatedRules,RulesUsed,LoopPath):- !,
 2305   temp_resolution(ERule,ERulePaths,Rules,PrevPath,NewERule,RelatedRules,RulesUsed,LoopPath).
 2306
 2307                       % Last loop was the same as one we found previously and
 2308                       % there are no eventualities left to process.
 2309
 2310test_path(_,[],_Rules,PrevPath1,LoopPath,_NewERule,_,_,[],[],[]):-
 2311   same_node_in_list(PrevPath1,LoopPath),!.
 2312
 2313                       % Last loop found was the same as one we found previously
 2314                       % so look for loops for the next eventuality.
 2315
 2316test_path(_,[[ERule,PrevPath]|ERulePaths],Rules,PrevPath1,LoopPath,NewERule,_,_,RelatedRules,RulesUsed,NewLoopPath):-
 2317   same_node_in_list(PrevPath1,LoopPath),!,
 2318   temp_resolution(ERule,ERulePaths,Rules,PrevPath,NewERule,RelatedRules,RulesUsed,NewLoopPath).
 2319
 2320                       % We have found a new loop that is not empty and is not the
 2321                       % same as a loop we have found earlier for this eventuality
 2322                       % so return this new loop.
 2323
 2324test_path(ERule,_, _, _, LoopPath,ERule,RelatedRules,RulesUsed,RelatedRules,RulesUsed,LoopPath).
 2325
 2326
 2327/*****************************************************************************/
 2328/* same_node_in_list(PrevLoops,LoopPath)                                     */
 2329/*                                                                           */
 2330/* This checks to see whether The new loop we have found LoopPath is the     */
 2331/* as any of the loops we have found already PrevLoops.                      */ 
 2332/*                                                                           */
 2333/*****************************************************************************/
 2334
 2335same_node_in_list([PrevLoop|_],LoopPath):-
 2336   same_node(PrevLoop,LoopPath),!.
 2337
 2338same_node_in_list([_|PrevLoops],LoopPath):-
 2339   same_node_in_list(PrevLoops,LoopPath).
 2340
 2341/*****************************************************************************/
 2342/* resolve_eventuality(Eventuality, Rules, RelatedRules,RulesUsed, LoopPath) */
 2343/*                                                                           */
 2344/* Takes a single eventuality (Eventuality), and a list of Global Box Rules  */
 2345/* (Rules), negates the eventuality (Eventuality), and finds a list of rules */
 2346/* which imply this proposition. The lhs of these rules are added as initial */
 2347/* nodes in graph, and a loop through the graph is searched for starting     */
 2348/* from the top node which is the simplified disjunction of the left hand    */
 2349/* sides of these initial nodes. A graph is built by looking for the largest */
 2350/* set of rules (or combinations of rules whose left hand side imply the     */
 2351/* previous node and whose right hand side imply the top node.               */
 2352/* RelatedRules are the set of rules of the form  R => p, where p is   */
 2353/* the current eventuality, and RulesUsed should contain a list of the       */
 2354/* numbers of rules used in this loop. Unfortunately this has not yet been   */
 2355/* coded properly but has been left in returning [] in the hope that it will */
 2356/* be fixed. All the related rules are for is for generating the proof at the*/
 2357/* end.                                                                      */
 2358/*                                                                           */
 2359/*****************************************************************************/
 2360
 2361                       % Note RulesUsed is set to [] !
 2362
 2363resolve_eventuality(F,Others, RelatedRules,[], LoopList):-      
 2364   snff_negate(F, NewF),                  % Negates F (ie ~F  --> F, and F --> ~F)
 2365   relatedrules(NewF, Others, RelatedRules, NewOthers),   
 2366   write_ruleset(RelatedRules),
 2367   write_ruleset(NewOthers),
 2368   add_initial(RelatedRules, OrigNodes), !,                
 2369   simplify_top_node(F,OrigNodes,SimplerOrig),
 2370   build_graph(F,Others, SimplerOrig,SimplerOrig, LoopList).       
 2371
 2372/*****************************************************************************/
 2373/* related_rules(Prop, [Rule|RuleList], RelatedRules, RemainingRules)        */
 2374/*                                                                           */
 2375/* This predicate takes a proposition, the negation of the proposition,      */
 2376/* relating to the current eventuality, and a list of rules which are global */
 2377/* box rules. It searches these rules for rules implying the eventuality,    */
 2378/* returning them in RelatedRules.                                           */
 2379/* Note relatedrules will not include rules which have Prop as part of a     */
 2380/* disjunction on the rhs of the implication, or those which have            */
 2381/* wlast false on the lhs of the implication ie wlast false => Prop.         */
 2382/*****************************************************************************/
 2383
 2384relatedrules(Prop, [r(N1,N2,P => next Prop)|RuleList], [r(N1,N2, P => next Prop)|RelatedRules], RemainingRules):- !,
 2385   relatedrules(Prop, RuleList, RelatedRules, RemainingRules).
 2386
 2387relatedrules(Prop, [r(N1,N2,Prop)|RuleList], [r(N1,N2, Prop)|RelatedRules], RemainingRules):- 
 2388   disjunction_of_literals(Prop),!,
 2389   relatedrules(Prop, RuleList, RelatedRules, RemainingRules).
 2390
 2391relatedrules(Prop, [Rule|RuleList], RelatedRules, [Rule|RemainingRules]):-
 2392   relatedrules(Prop, RuleList, RelatedRules, RemainingRules).
 2393
 2394relatedrules(_,[],[],[]).        
 2395
 2396/*****************************************************************************/
 2397/* add_initial(Rules, Nodes)                                                 */
 2398/*                                                                           */
 2399/* Takes a list of rules which imply the negation of the current eventuality */
 2400/* and returns a list with the rhs of these rules as a list of nodes.        */
 2401/* eg a list of rules [ a => p,  b => next p,  a & c => next p]           */
 2402/* would return a node list of the form [[a], [b], [a,c]]                    */
 2403/*                                                                           */
 2404/*****************************************************************************/
 2405
 2406add_initial([r(_,_, F => next _)|Rules], [StrippedF |Nodes]):-
 2407   strip(F, StrippedF),
 2408   add_initial(Rules, Nodes).
 2409
 2410add_initial([r(_,_, F)|Rules], [[true] |Nodes]):-
 2411   disjunction_of_literals(F),
 2412   add_initial(Rules, Nodes).
 2413
 2414add_initial([], []).
 2415
 2416/*****************************************************************************/
 2417/* build_graph(F,Rules, OrigNodes, RulesUsed,Solution)                         */
 2418/*                                                                           */
 2419/* Takes current set of Rules (will be Global Box Rules without rules        */
 2420/* implying current eventuality), the set of OrigNodes (the Original Nodes   */
 2421/* the graph), the negation of the current eventuality (OurP). It returns    */
 2422/* and returns the loop detected if one has been found in Solution and       */
 2423/* should store the numbers of the rules it used to detect the loop in       */
 2424/* RulesUsed but this is not implemented correctly yet. Build graph          */
 2425/* when either the new node is "true", the last two nodes are equivalent, or */
 2426/* the new node is empty.                                                    */
 2427/*                                                                           */
 2428/*****************************************************************************/
 2429
 2430                    % Top node has been simplified to "true"
 2431      
 2432build_graph(_,_,_,[[true]],[[true]]):- !.
 2433
 2434build_graph(F,Rules, PrevNode, TopNode,FinalNode):- 
 2435      writef('\nThe New Node is %t.\n',[PrevNode]),
 2436      build_node(F,Rules, PrevNode,TopNode,NewNode),!,
 2437      test_newnode(F,Rules, PrevNode, TopNode,NewNode,FinalNode).
 2438
 2439/*****************************************************************************/
 2440/* test_newnode(Rules, PrevNode, TopNode,NewNode,FinalNode).                 */
 2441/*                                                                           */
 2442/* Checks termination conditions for build graph. We stop recalling          */
 2443/* build_graph if the new node (NewNode) is empty returning with an empty    */
 2444/* loop. We terminate if our new node has been simplified to "true" or if    */
 2445/* our new node is equivalent to our previous node.                          */
 2446/*                                                                           */
 2447/*****************************************************************************/
 2448
 2449test_newnode(_,_,_,_,[],[]):- !.              % Empty node.
 2450
 2451test_newnode(_,_,_,_,[[true]],[[true]]):-!.   % Node equivalent to "true"
 2452
 2453test_newnode(_,_, PrevNode, _,NewNode,NewNode):-
 2454      same_node(PrevNode,NewNode),!.          % Node equivalent to the previous node.
 2455
 2456test_newnode(F,Rules, _, TopNode,NewNode,FinalNode):-
 2457      build_graph(F,Rules, NewNode, TopNode,FinalNode).
 2458                                              % Try and build a new node
 2459
 2460/*****************************************************************************/
 2461/* build_node(F,Rules, PrevNode, TopNode,NewNode).                             */
 2462/*                                                                           */
 2463/* To build a new node we take each rule from our global box rules (Rules)   */
 2464/* in turn and check whether its rhs implies the previous node (PrevNode)    */
 2465/* and its lhs implies the top node (TopNode). If the former is the case but */
 2466/* not the latter then the rule is combined with the initial rules (obtained */
 2467/* from TopNode) so the latter holds also. If the rules may be used if       */
 2468/* combined with others they are stored in a separate list and combined at   */
 2469/* the end. The lhs of all the rules which satisfy the above two criteria    */
 2470/* are disjoined and simplified to  create the new node (NewNode).           */
 2471/*                                                                           */
 2472/*****************************************************************************/
 2473
 2474build_node(F,Rules, PrevNode, TopNode,FinalNode):-
 2475      flatten(PrevNode,FlatPrev),
 2476      get_relevant_rules(Rules,PrevNode,FlatPrev,TopNode, Useful,[],NewishNode),
 2477      combine_useful_rules(Useful,PrevNode,FlatPrev,TopNode,NewishNode,NewThisNode),
 2478      simplify_new_node(F,NewThisNode,FinalNode).
 2479
 2480/*****************************************************************************/
 2481/* combine_useful_rules(Rules, [D1|DRest], PrevNode,TopNode, ThisNode,FinalNode) */
 2482/*                                                                           */
 2483/* Takes all the rules that we think we may be able to combine together so   */
 2484/* the rhs implies the previous node (PrevNode) and its lhs implies the top  */
 2485/* node (TopNode). For disjunct (D1) we separate out all the rules that may  */
 2486/* combine together to give us a D1 on the rhs and then do the same with the */
 2487/* remaining disjuncts. These combined rules are tested to see if the rhs    */
 2488/* implies the previous node (PrevNode) and its lhs implies the top node     */
 2489/* (TopNode) and if so the lhs is returned in FinalNode.                     */
 2490/*                                                                           */
 2491/*****************************************************************************/
 2492
 2493combine_useful_rules([],_,_,_, FinalNode,FinalNode):- !.    % We have no useful rules.
 2494
 2495combine_useful_rules(Rules, PrevNode,FlatPrev,TopNode,ThisNode,FinalNode):- !,
 2496    split_into_sublists(Rules,FlatPrev,SplitRules),
 2497    combine_for_disjuncts(PrevNode,SplitRules,PrevNode,TopNode,ThisNode,FinalNode).
 2498
 2499/*****************************************************************************/
 2500/* get_relevant_rules(Rules,PrevNode,FlatPrev,TopNode,ThisNode,Useful,NewNode). */
 2501/*                                                                           */
 2502/* Takes the set of global box rules (Rules) and extracts rules whose right  */
 2503/* hand sides imply the previous node. If the left hand side of this rule    */
 2504/* also implies the top node then the lhs is added as a disjunct of NewNode. */
 2505/* If the lhs does not it is combined with the lhs of each initial           */
 2506/* rule. Also rules are searched for where the propositions on the rhs of the*/
 2507/* rule are a subset of the proposition in the previous node but the rhs     */
 2508/* does not imply the previous node. Subsets of these are combined in an     */
 2509/* attempt that their rhs will imply the previous node.                      */
 2510/*                                                                           */
 2511/*****************************************************************************/
 2512
 2513get_relevant_rules([r(_,_, P => next Q)|Rest],PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode):-
 2514       strip_or(Q,StrippedQ),            % Rhs => PrevNode & lhs => TopNode
 2515       set_implies(StrippedQ,PrevNode),  % Add lhs to the list for the new node.
 2516       strip_or(P,[StrippedP]),
 2517       set_implies([StrippedP],TopNode),!,
 2518       remove_subsumed(StrippedP,ThisNode,NewThisNode),
 2519       get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,NewThisNode,FinalNode).
 2520
 2521get_relevant_rules([r(_,_,P => next Q)|Rest],PrevNode,FlatPrev,TopNode,Useful,ThisNode, FinalNode):-
 2522       strip_or(Q,StrippedQ),             % Rhs => PrevNode & not (lhs => TopNode)
 2523       set_implies(StrippedQ,PrevNode),!, % combine lhs with initial nodes and add.
 2524       strip_or(P,StrippedP),
 2525       combine_lhs_with_initial(StrippedP,TopNode,NewDisjuncts),
 2526       remove_subsumed_list(NewDisjuncts,ThisNode,NewThisNode),
 2527       get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,NewThisNode,FinalNode).
 2528
 2529get_relevant_rules([r(N1,N2,P => next Q)|Rest],PrevNode,FlatPrev,TopNode,[r(N1,N2,P => next Q)|Useful],ThisNode,FinalNode):-
 2530       strip(Q,StrippedQ),
 2531       subset(StrippedQ,FlatPrev),!,      % in the previous node. Save for combining.
 2532       get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode).
 2533
 2534get_relevant_rules([r(_,_,Q)|Rest],PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode):-
 2535       disjunction_of_literals(Q),
 2536       strip_or(Q,StrippedQ),             % Rhs => PrevNode & not (lhs => TopNode)
 2537       set_implies(StrippedQ,PrevNode),!, % combine lhs with initial nodes and add.
 2538       remove_subsumed_list(TopNode,ThisNode,NewThisNode),
 2539       get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,NewThisNode,FinalNode).
 2540
 2541get_relevant_rules([r(N1,N2,Q)|Rest],PrevNode,FlatPrev,TopNode,[r(N1,N2,Q)|Useful],ThisNode,FinalNode):-
 2542       disjunction_of_literals(Q),
 2543       strip(Q,StrippedQ),
 2544       subset(StrippedQ,FlatPrev),!,      % in the previous node. Save for combining.
 2545       get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode).
 2546
 2547get_relevant_rules([_|Rest],PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode):- !,
 2548        get_relevant_rules(Rest,PrevNode,FlatPrev,TopNode,Useful,ThisNode,FinalNode).
 2549                                        % Not useful.
 2550
 2551get_relevant_rules([],_,_,_,[],FinalNode,FinalNode).        % Recursion base case.
 2552
 2553/*****************************************************************************/
 2554/* combine_lhs_with_initial(Lhs,TopNode,NewDisjuncts)                        */
 2555/*                                                                           */
 2556/* Takes the left hand side of a rule (Lhs) and the top node and combines    */
 2557/* Lhs with each disjunct of Top Node storing output on NewDisjuncts.        */
 2558/*                                                                           */
 2559/*****************************************************************************/
 2560                                         % This fires if our Conj is just a
 2561                                         % literal and saves doing append. 
 2562
 2563combine_lhs_with_initial([[Conj]],[H|Tail],[NewDisjunct|NewDisjuncts]):- !,
 2564     simplify_a_disjunct([Conj|H],NewDisjunct),       
 2565     combine_lhs_with_initial([[Conj]],Tail,NewDisjuncts).
 2566
 2567combine_lhs_with_initial([Conj],[H|Tail],[NewDisjunct|NewDisjuncts]):-
 2568     append(Conj,H,NewConj),
 2569     simplify_a_disjunct(NewConj,NewDisjunct),       
 2570     combine_lhs_with_initial([Conj],Tail,NewDisjuncts).
 2571
 2572combine_lhs_with_initial(_,[],[]).
 2573
 2574/*****************************************************************************/
 2575/* same_node(N1,N2).                                                         */
 2576/*                                                                           */
 2577/* N1 and N2 are lists made up of sublists that represent a formula in DNF.  */
 2578/* To check that N1 and N2 are equivalent we must make sure that N1 => N2    */
 2579/* and N2 => N1 (remembering that we have lists and sublists.                */
 2580/*                                                                           */
 2581/*****************************************************************************/
 2582
 2583same_node([],[]):-!.
 2584
 2585same_node(List1,List2):-
 2586     set_implies(List1,List2),
 2587     set_implies(List2,List1).
 2588   
 2589/*****************************************************************************/
 2590/* combine_for_disjunct(Rules, D1,PrevNode,TopNode, ThisNode,FinalNode)      */
 2591/*                                                                           */
 2592/* Takes a disjunct D1 from the previous node (PrevNode) and finds all the   */
 2593/* rules from Rules (which is a subset of the set of global box rules of     */
 2594/* rules that do not satisfy our two criteria on the lhs and rhs of rules but*/
 2595/* may be combined together to satisfy these criteria) that may be combined  */
 2596/* together to give us D1. These are then combined together and the left     */
 2597/* hand sides of rules that do satisfy our criteria are returned in          */
 2598/* NewDisjuncts.                                                             */
 2599/*                                                                           */
 2600/*****************************************************************************/
 2601
 2602combine_for_disjuncts([D1|Disjuncts],Rules,PrevNode,TopNode,ThisNode,FinalNode):-
 2603     get_rules_for_disjunct(Rules,D1,NewRules),
 2604     combine_rules(Rules,NewRules,D1,PrevNode,TopNode,ThisNode,NewerNode,NewerRules),
 2605     combine_for_disjuncts(Disjuncts, NewerRules,PrevNode,TopNode,NewerNode,FinalNode).
 2606
 2607combine_for_disjuncts([], _Rules, _PrevNode, _TopNode, FinalNode,FinalNode).
 2608
 2609/*****************************************************************************/
 2610/* get_rules_for_disjunct(Rules, Disjunct,NewRules)                          */
 2611/*                                                                           */
 2612/* Takes the set of rules we think we may be able to combine together (Rules)*/
 2613/* and a disjunct (Disjunct) and we extract the rules that may give us this  */
 2614/* disjunct at least by looking for rules that have a literal or literals on */
 2615/* their rhs in common with the disjunct.                                    */
 2616/*                                                                           */
 2617/*****************************************************************************/
 2618
 2619get_rules_for_disjunct([[Lit]|Rest],[Lit|Disjuncts],[NewRest]):- !,   % No rules for Lit
 2620     get_rules_for_disjunct(Rest,Disjuncts,NewRest).
 2621
 2622get_rules_for_disjunct([[Lit,Rules]|Rest],[Lit|Disjuncts],[Rules|NewRest]):- !,
 2623     get_rules_for_disjunct(Rest,Disjuncts,NewRest).
 2624
 2625get_rules_for_disjunct([[Lit,Rules]|Rest],Disjuncts,[Rules|NewRest]):-
 2626     member(Lit,Disjuncts),!,
 2627     get_rules_for_disjunct(Rest,Disjuncts,NewRest).
 2628
 2629get_rules_for_disjunct([[_,_]|Rest],Disjuncts,NewRest):-
 2630     get_rules_for_disjunct(Rest,Disjuncts,NewRest).
 2631
 2632get_rules_for_disjunct(_,[],[]).           % Recursion base case.
 2633
 2634get_rules_for_disjunct([],_,[]).           % Recursion base case.
 2635
 2636/*****************************************************************************/
 2637/* combine_rules(NewRules, PrevNode, TopNode,ThisNode,FinalNode)    */
 2638/*                                                                           */
 2639/* Takes the set of rules that we think we can combine to give us one of the */
 2640/* disjuncts Disjunct, splits them into sublists, one for each literal of the*/
 2641/* disjunct and does the combination by combining one rule form each sublist.*/
 2642/* Each combined rule is checked to see whether its rhs implies the previous */
 2643/* node and its left hands side implies the top node and if so its lhs is    */
 2644/* returned in NewDisjuncts.                                                 */
 2645/*                                                                           */
 2646/*****************************************************************************/
 2647
 2648combine_rules(Rules,SplitRules, D1,PrevNode, TopNode,ThisNode,FinalNode,NewRules):-
 2649    combine_sublists(SplitRules,Combined),
 2650    get_relevant_combined(Combined,Rules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules).
 2651
 2652/*****************************************************************************/
 2653/* split_into_sublists(NewRules,Disjunct,SplitRules)                         */
 2654/*                                                                           */
 2655/* Takes the set of rules that we think we can combine to give us one of the */
 2656/* disjuncts Disjunct, splits them into sublists, one for each literal of the*/
 2657/* disjunct, returning the sublists in SplitRules.                           */
 2658/*                                                                           */
 2659/*****************************************************************************/
 2660
 2661split_into_sublists(Rules,[C1|Conjuncts],[[C1,C1Rules]|RestRules]):-
 2662   rules_that_give_a_conjunct(C1,Rules,C1Rules),
 2663   split_into_sublists(Rules,Conjuncts,RestRules).
 2664
 2665split_into_sublists(_,[],[]).
 2666
 2667/*****************************************************************************/
 2668/* rules_that_give_a_conjunct(C1,Rules,C1Rules)                              */
 2669/*                                                                           */
 2670/* Takes a conjunct C1 from one of the disjuncts of our previous node and    */
 2671/* returns C1Rules, a subset of the rules we give it (Rules) where C1 is a   */
 2672/* member of the set of literals formed from the rhs of a rule.              */
 2673/*                                                                           */
 2674/*****************************************************************************/
 2675
 2676rules_that_give_a_conjunct(C1,[r(N1,N2,P => next Q)|Rest],[r(N1,N2,P => next Q)|NewRest]):-
 2677   strip(Q,StrippedQ),
 2678   member(C1,StrippedQ),!,
 2679   rules_that_give_a_conjunct(C1,Rest,NewRest).
 2680
 2681rules_that_give_a_conjunct(C1,[r(N1,N2,Q)|Rest],[r(N1,N2,Q)|NewRest]):-
 2682   disjunction_of_literals(Q),
 2683   strip(Q,StrippedQ),
 2684   member(C1,StrippedQ),!,
 2685   rules_that_give_a_conjunct(C1,Rest,NewRest).
 2686
 2687rules_that_give_a_conjunct(C1,[_|Rest],NewRest):-
 2688   rules_that_give_a_conjunct(C1,Rest,NewRest).
 2689
 2690rules_that_give_a_conjunct(_,[],[]).
 2691
 2692/*****************************************************************************/
 2693/* combine_sublists(SplitRules,Combined)                                     */
 2694/*                                                                           */
 2695/* Takes a list split into sublists (SplitRules) and combines the rules      */
 2696/* so as to take one from each sublist returning the combined rules in       */
 2697/* Combined.                                                                 */
 2698/*                                                                           */
 2699/*****************************************************************************/
 2700
 2701combine_sublists([_],[]):-!.               % Only one sublist
 2702
 2703combine_sublists([L1|[L2]],L12):- !,       % Two sublists
 2704   combine_two_sublists(L1,L2,L12).
 2705
 2706combine_sublists([L1|L2],NewL1L2):- !,     % More than two sublists
 2707   combine_sublists(L2,NewL2),
 2708   combine_two_sublists(L1,NewL2,NewL1L2).
 2709
 2710combine_sublists([],[]).                   % No sublists
 2711/*****************************************************************************/
 2712/* combine_two_sublists(L1,L2,NewL1L2).                                      */
 2713/*                                                                           */
 2714/* Takes two sublists L1 and L2 an combines every rule in L1 with every rule */
 2715/* in L2, returning the combined rules in NewL1L2.                           */
 2716/*                                                                           */
 2717/*****************************************************************************/
 2718
 2719combine_two_sublists([H1|Tail1],List2,NewList):-
 2720   combine_element_with_all(H1,List2,H1List2),
 2721   combine_two_sublists(Tail1,List2,Tail1List2),
 2722   append(H1List2,Tail1List2,NewList).
 2723
 2724combine_two_sublists([],_,[]).
 2725
 2726/*****************************************************************************/
 2727/* combine_element_with_all(H1,List2,H1List2)                                */
 2728/*                                                                           */
 2729/* Takes a rule H1 and combines it with every rule in List2 to give H1List2. */
 2730/*                                                                           */
 2731/*****************************************************************************/
 2732
 2733combine_element_with_all(H1,[H2|Tail2],FinalList):-
 2734  combine_two_rules(H1,H2,H1H2),
 2735  test_combine_rules(H1H2,H1,Tail2,FinalList).
 2736
 2737combine_element_with_all(_,[],[]).
 2738
 2739/****************************************************************************/
 2740
 2741test_combine_rules(r(_,_,false => next _),H1,Tail2,H1Tail2):- !,
 2742  combine_element_with_all(H1,Tail2,H1Tail2).
 2743
 2744test_combine_rules(Rule,H1,Tail2,[Rule|H1Tail2]):-
 2745  combine_element_with_all(H1,Tail2,H1Tail2).
 2746
 2747/*****************************************************************************/
 2748/* get_relevant_combined(Combined,PrevNode,TopNode,ThisNode,FinalNode).      */
 2749/*                                                                           */
 2750/* Does the same as get_relevent_rules but for those we have combined. We    */
 2751/* search for rules from Combined whose right hand sides imply the previous  */
 2752/* node PrevNode). If the left hand side of the rule also implies the top    */
 2753/* node (TopNode) then the lhs is added as a disjunct of NewDisjuncts.       */
 2754/* If the lhs does not it is combined with the lhs of each initial           */
 2755/* rule and then added to NewDisjuncts.                                      */
 2756/*                                                                           */
 2757/*****************************************************************************/
 2758
 2759get_relevant_combined(_,Rules,_,_,_,[[true]],[[true]],Rules):-!.
 2760
 2761get_relevant_combined([r(_,_,P => next Q)|Rest],Rules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules):-
 2762       strip_or(Q,StrippedQ),             % Rhs => PrevNode & lhs => TopNode
 2763       set_implies(StrippedQ,PrevNode),   % Add lhs to the list for the new node.
 2764       strip_or(P,[StrippedP]),
 2765       set_implies([StrippedP],TopNode),!,
 2766       remove_subsumed(StrippedP,ThisNode,NewerThisNode),
 2767       get_relevant_combined(Rest,Rules,D1,PrevNode,TopNode,NewerThisNode,FinalNode,NewRules).
 2768
 2769
 2770get_relevant_combined([r(_,_,P => next Q)|Rest],Rules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules):-
 2771       strip_or(Q,StrippedQ),             % Rhs => PrevNode & not (lhs => TopNode)
 2772       set_implies(StrippedQ,PrevNode),!,   % combine lhs with initial nodes and add.
 2773       strip_or(P,StrippedP),
 2774       combine_lhs_with_initial(StrippedP,TopNode,NewDisjuncts),
 2775       remove_subsumed_list(NewDisjuncts,ThisNode,NewerThisNode),
 2776       get_relevant_combined(Rest,Rules,D1,PrevNode,TopNode,NewerThisNode,FinalNode,NewRules).
 2777
 2778get_relevant_combined([r(_,_,Q)|Rest],Rules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules):-
 2779       disjunction_of_literals(Q),
 2780       strip_or(Q,StrippedQ),             % Rhs => PrevNode & not (lhs => TopNode)
 2781       set_implies(StrippedQ,PrevNode),!,   % combine lhs with initial nodes and add.
 2782       remove_subsumed_list(TopNode,ThisNode,NewerThisNode),
 2783       get_relevant_combined(Rest,Rules,D1,PrevNode,TopNode,NewerThisNode,FinalNode,NewRules).
 2784
 2785get_relevant_combined([Rule|Rest],Rules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules):- !,
 2786       add_combined_to_rules(Rule,Rules,D1,PrevNode,NewerRules),
 2787       get_relevant_combined(Rest,NewerRules,D1,PrevNode,TopNode,ThisNode,FinalNode,NewRules).
 2788                                        % Not useful.
 2789
 2790get_relevant_combined([],Rules,_,_,_,FinalNode,FinalNode,Rules).         % Recursion base case.
 2791/*****************************************************************************/
 2792/* combine_two_rules(R1,R2,NewRule).                                         */
 2793/*                                                                           */
 2794/* Takes two rules R1 and R2, combines them and simplifies them to give      */
 2795/* NewRule.                                                                  */
 2796/*                                                                           */
 2797/*****************************************************************************/
 2798
 2799combine_two_rules(r(N1,_,P => next F), r(N3,_,Q => next G), r(N1,[N1,N3],NewLHS => next RHS)):-
 2800           simplify_and(P and Q, NewerLHS),
 2801           simplify_and_dup(NewerLHS, NewLHS),       
 2802	   simplify_dnf(F and G, RHS).
 2803
 2804combine_two_rules(r(N1,_,F), r(N3,_,Q => next G), r(N1,[N1,N3],Q => next RHS)):-
 2805           disjunction_of_literals(F),
 2806	   simplify_dnf(F and G, RHS).
 2807
 2808combine_two_rules(r(N1,_,P => next F), r(N3,_,G), r(N1,[N1,N3],P => next RHS)):-
 2809           disjunction_of_literals(G),
 2810	   simplify_dnf(F and G, RHS).
 2811
 2812combine_two_rules(r(N1,_,F), r(N3,_,G), r(N1,[N1,N3],RHS)):-
 2813           disjunction_of_literals(F),
 2814           disjunction_of_literals(G),
 2815	   simplify_dnf(F and G, RHS).
 2816
 2817/*****************************************************************************/
 2818/*   simplify_dnf(X,Y)                                                       */
 2819/*                                                                           */
 2820/* Called during the combinations coding (combine_two_rules), as when two    */
 2821/* are combined eg  A => B, and  X => Y, we will get                       */
 2822/*  (A and X) => (B and Y). If B or Y were previously disjunctive           */
 2823/* then the right hand side will need to be converted to DNF and simplified. */
 2824/* This predicate converts to disjunctive normal form, checks for            */
 2825/* complementary literals, or duplicated literals, and removes "false" from  */
 2826/* disjunction.                                                              */
 2827/*                                                                           */
 2828/*****************************************************************************/
 2829
 2830simplify_dnf(X,Y):-
 2831  cnf_to_dnf(X,NewX),
 2832  simplifylist(NewX,SimplerX),
 2833  simplify_in_dnf(SimplerX,SimplerDNF),
 2834  simplify_dnf1(SimplerDNF,Y).
 2835
 2836/****************************************************************************/
 2837
 2838cnf_to_dnf(X,NewX):-
 2839  strip_cnf(X,StrippedX),
 2840  combine_sublists_in_dnf(StrippedX,NewX).
 2841
 2842/*****************************************************************************/
 2843/* simply_dnf1(X,Y)                                                          */
 2844/*                                                                           */
 2845/* If the list X is empty returns false otherwise removes duplicate          */
 2846/* disjuncts, and returns Y which has the relevant and and or included.      */                           
 2847/*                                                                           */
 2848/*****************************************************************************/
 2849
 2850simplify_dnf1([],false):-!.
 2851
 2852simplify_dnf1([true],true):-!.
 2853
 2854simplify_dnf1(SimpleX,Y):-
 2855  rewrite_and_or(SimpleX,Y).
 2856
 2857/*****************************************************************************/
 2858/* simplify_a_disjunct(Dis,SimpleDis).                                       */
 2859/*                                                                           */
 2860/* Simplifies a single disjunct i.e. removes true, replaces false by false   */
 2861/* removes duplicate literals and replaces complementary literals by false.  */
 2862/*                                                                           */
 2863/*****************************************************************************/
 2864
 2865simplify_a_disjunct(Dis,NewDis):-
 2866   simplifylist([Dis],[NewDis]).
 2867
 2868/*****************************************************************************/
 2869/*                                                                           */
 2870/*  simplifylist(X,SimplerX)                                                 */
 2871/*  Takes a list X which is of the form [[a,a],[b,a]] (representing dnf on   */
 2872/*  (a or b) and a, which gives us (a and a) or (a and b). It searches each  */
 2873/*  member of the list (ie [a,a] and then [b,a]) for complementary literals  */
 2874/*  and replaces them with false, otherwise it looks for duplicate literals  */
 2875/*  and removes any duplicates. SimplerX is the list which is returned.      */                        
 2876/*                                                                           */
 2877/*****************************************************************************/
 2878
 2879simplifylist([H|Tail],[[false]|NewTail]):-
 2880        simplify_and_false(H),!,
 2881        simplifylist(Tail,NewTail).
 2882
 2883simplifylist([H|Tail], [[false]|NewTail]):-
 2884        comp_lits_and(H),!,
 2885        simplifylist(Tail, NewTail).
 2886
 2887simplifylist([H|Tail], [NewerH|NewTail]):-
 2888        remove_duplicate(H, NewH),!,
 2889        simplify_and_true(NewH,NewerH),
 2890        simplifylist(Tail, NewTail).
 2891
 2892simplifylist([],[]).
 2893
 2894/*****************************************************************************/
 2895/*    remove_true(X,NewX),                                                   */
 2896/*                                                                           */
 2897/* Takes (X) a list of lists of disjuncts eg [[a],[a,b]] which has had any   */
 2898/* sublists containing complementary literals replaced by "false" and any    */
 2899/* sublists containing occurances of duplicate literals replaced by just a   */
 2900/* single instance of that one instance. It checks X and if it finds "true"  */
 2901/* as a member of the list returns "true" otherwise it returns X.            */
 2902/*                                                                           */
 2903/*****************************************************************************/
 2904
 2905remove_true(List,[[true]]):-
 2906    member([true],List),!.
 2907
 2908remove_true(List,[[true]]):-
 2909    member([],List),!.
 2910
 2911remove_true(List,List):-!.
 2912
 2913/*****************************************************************************/
 2914/*    remove_false(X,NewX),                                                  */
 2915/*                                                                           */
 2916/* Takes (X) a list of lists of disjuncts eg [[a],[a,b]] which has had any   */
 2917/* sublists containing complementary literals replaced by "false" and any    */
 2918/* sublists containing occurances of duplicate literals replaced by just a   */
 2919/* single instance of that one instance. It checks X and removes occurances  */
 2920/* of false.                                                                 */
 2921/* N.B. In the case where X is [[false],[false],[false]] the removal of all  */
 2922/* the falses will leave us with the empty list ([]). This is replaced       */
 2923/* by false in simply_dnf1 above.                                            */
 2924/*                                                                           */
 2925/*****************************************************************************/
 2926
 2927remove_false([[true]],[[true]]):-!.
 2928
 2929remove_false([false|Rest],NewRest):-
 2930   !,remove_false(Rest,NewRest).
 2931
 2932remove_false([[false]|Rest],NewRest):-
 2933   !,remove_false(Rest,NewRest).
 2934
 2935remove_false([Nodelist|Rest],[Nodelist|NewRest]):-
 2936   !,remove_false(Rest,NewRest).
 2937
 2938remove_false([],[]).
 2939
 2940/*****************************************************************************/
 2941/* simplify_and_false(List).                                                 */
 2942/*                                                                           */
 2943/* Called from simplifylist. List will be a list of literals (or false) which*/
 2944/* make up a disjunct as part of the right hand side of a (combined) rule    */
 2945/* of the form [a,b,c,~ d,false,f]. If false is a member of this list then */
 2946/* the whole list reduces to false so this predicate succeeds.               */
 2947/*                                                                           */
 2948/*****************************************************************************/
 2949
 2950simplify_and_false([false|_]):- !.
 2951
 2952simplify_and_false([_|Rest]):-
 2953   simplify_and_false(Rest).
 2954
 2955/*****************************************************************************/
 2956/* simplify_and_true(List).                                                  */
 2957/*                                                                           */
 2958/* Called from simplifylist. List will be a list of literals (or false) which*/
 2959/* make up a disjunct as part of the right hand side of a (combined) rule    */
 2960/* of the form [a,b,c,~ d,false,f]. If false is a member of this list then */
 2961/* the whole list reduces to false so this predicate succeeds.               */
 2962/*                                                                           */
 2963/*****************************************************************************/
 2964
 2965simplify_and_true([true|Rest],NewRest):- !,
 2966   simplify_and_true(Rest,NewRest).
 2967
 2968simplify_and_true([H|Rest],[H|NewRest]):- !,
 2969   simplify_and_true(Rest,NewRest).
 2970
 2971simplify_and_true([],[]).
 2972
 2973/*****************************************************************************/
 2974/* simplify_top_node(F,ListofDisjuncts,SimplifiedDNF).                         */
 2975/*                                                                           */
 2976/* Simplifies our nodes given that ListofDisjuncts is of the form            */
 2977/* [[..],[..],[..]] where each ... is a list of literal and are supposed to  */
 2978/* conjoined together.                                                       */
 2979/*                                                                           */
 2980/*****************************************************************************/
 2981
 2982simplify_top_node(_,[],[]):-!.   % Need this in case initial node is empty.
 2983
 2984simplify_top_node(_,[[true]],[[true]]):-!.   
 2985                                 % Need this in case initial node is true.
 2986
 2987simplify_top_node(F,ListofDisjuncts,FinalDNF):-
 2988  simplifylist(ListofDisjuncts,SimpleDisjuncts),
 2989  simplify_in_dnf(SimpleDisjuncts,SimplerDNF),
 2990  simplify_comp_lits_in_dnf(SimplerDNF,SimplifiedDNF1),
 2991  simplify_in_dnf(SimplifiedDNF1,SimplifiedDNF),
 2992  remove_bad_disjuncts(F,SimplifiedDNF,FinalDNF).
 2993
 2994/*****************************************************************************/
 2995/* simplify_new_node(F,ListofDisjuncts,SimplifiedDNF).                         */
 2996/*                                                                           */
 2997/* Simplifies our nodes given that ListofDisjuncts is of the form            */
 2998/* [[..],[..],[..]] where each ... is a list of literal and are supposed to  */
 2999/* conjoined together.                                                       */
 3000/*                                                                           */
 3001/*****************************************************************************/
 3002
 3003simplify_new_node(_,[],[]):-!.   % Need this in case initial node is empty.
 3004
 3005simplify_new_node(F,SimplerDNF,FinalDNF):-
 3006  simplify_comp_lits_in_dnf(SimplerDNF,SimplifiedDNF1),
 3007  simplify_in_dnf(SimplifiedDNF1,SimplifiedDNF),
 3008  remove_bad_disjuncts(F,SimplifiedDNF,FinalDNF).
 3009
 3010
 3011/*****************************************************************************/
 3012/*  remove_bad_disjuncts(F,SimplifiedDNF,FinalDNF).                          */
 3013/*                                                                           */
 3014/*  Takes the eventuality we are resolving with F and the current node in    */
 3015/*  DNF. If any of the disjuncts contain our eventuality then we will never  */
 3016/*  be able to build a rule which has both the eventuality and its negation  */
 3017/*  on the RHS to extend this node so we can just delete this disjunct.      */
 3018/*****************************************************************************/
 3019
 3020remove_bad_disjuncts(_,[],[]).
 3021
 3022remove_bad_disjuncts(F,[H|Tail],NewTail):-
 3023   member(F,H),!,
 3024   remove_bad_disjuncts(F,Tail,NewTail).
 3025
 3026remove_bad_disjuncts(F,[H|Tail],[H|NewTail]):-
 3027   remove_bad_disjuncts(F,Tail,NewTail).
 3028
 3029/*****************************************************************************/
 3030/* simplify_in_dnf(List,NewList)                                             */
 3031/*                                                                           */
 3032/* Takes a list of disjuncts each of which have been simplified (removing    */
 3033/* true from conjuncts, making false disjuncts that have false as a conjunct */
 3034/* deleting duplicate literals in variables and replacing complementary      */
 3035/* by false) and simplifies the complete disjunction. This is done by        */
 3036/* replacing the whole disjunction by true is one of the disjuncts is true,  */
 3037/* deleting disjuncts that are false and removing any disjuncts D2 where     */
 3038/* D2 => D1, where D1 is another disjunct.                                   */
 3039/*                                                                           */
 3040/*****************************************************************************/
 3041
 3042simplify_in_dnf(List,NewList):-
 3043     remove_true(List,NewerList),
 3044     remove_false(NewerList,NoFalseList),
 3045     order_node(NoFalseList,OrderedList),
 3046     remove_sublists(OrderedList,NewList).
 3047
 3048/*****************************************************************************/
 3049/* order_node(Node,NewNode).                                                 */
 3050/*                                                                           */
 3051/* Takes a list made up from sublists (Node) and orders it dependent on the  */
 3052/* length of the sublist. This is to make it easier to remove disjuncts D2   */
 3053/* where D2 => D1.                                                           */
 3054/*                                                                           */
 3055/*****************************************************************************/
 3056order_node([[true]],[[true]]):-!.   % If we have a node (a v ~a) we need this case.
 3057
 3058order_node([[false]],[[false]]):-!.
 3059
 3060order_node([],[[false]]):-!.
 3061
 3062order_node(Node,NewNode):-
 3063   give_length_key_list(Node,KeyList),
 3064   keysort(KeyList,Sorted),
 3065   take_key(Sorted,NewNode).
 3066
 3067/*****************************************************************************/
 3068/* give_length_key_list(Node,KeyList)                                        */
 3069/*                                                                           */
 3070/* Gives a key which is the length of the sublist to each sublist.           */
 3071/*                                                                           */
 3072/*****************************************************************************/
 3073
 3074give_length_key_list([H|Tail],[Key-H|NewTail]):-
 3075  give_key_length(H,Key),
 3076  give_length_key_list(Tail,NewTail).
 3077
 3078give_length_key_list([],[]).
 3079/*****************************************************************************/
 3080/* give_key_length(H,Key)                                                    */
 3081/*                                                                           */
 3082/* Takes a sublist H and calculates its length returning the value in Key.   */    
 3083/*                                                                           */
 3084/*****************************************************************************/
 3085give_key_length([_|Tail],NewKey):-
 3086   give_key_length(Tail,Key),
 3087   NewKey is Key + 1.
 3088
 3089give_key_length([],0).
 3090/*****************************************************************************/
 3091/* take_key(List, NewList).                                                  */
 3092/*                                                                           */
 3093/* Takes a list with keys attached for ordering (List) removes the key and   */
 3094/* returns the list in NewList.                                              */
 3095/*                                                                           */
 3096/*****************************************************************************/
 3097
 3098take_key([_-H|Tail],[H|NewTail]):-
 3099  take_key(Tail,NewTail).
 3100
 3101take_key([],[]).
 3102
 3103/*****************************************************************************/
 3104/* remove_sublists(OrderedList,NewList).                                     */
 3105/*                                                                           */
 3106/* Looks for sublists S1 and S2 of OrderedList where S1 is a subset of S2    */
 3107/* deletes S2 from OrderedList until this can be done no more.               */
 3108/*                                                                           */
 3109/*****************************************************************************/
 3110
 3111remove_sublists([H|Tail],[H|NewTail]):-
 3112   remove_sublist(H,Tail,NewerTail),
 3113   remove_sublists(NewerTail,NewTail).
 3114
 3115remove_sublists([],[]).
 3116
 3117/*****************************************************************************/
 3118/*    remove_sublist(H,Tail,NewerTail)                                       */
 3119/*                                                                           */
 3120/* Takes a sublist H and the remaining sublists the same length or longer    */
 3121/* than it, looks for sublists of which H is a subset and deletes them from  */
 3122/* Tail to give NewerTail.                                                   */
 3123/*                                                                           */
 3124/*****************************************************************************/
 3125
 3126remove_sublist(H,[H1|Tail],NewTail):-
 3127    subset(H,H1),!,
 3128    remove_sublist(H,Tail,NewTail).
 3129
 3130remove_sublist(H,[H1|Tail],[H1|NewTail]):-
 3131    remove_sublist(H,Tail,NewTail).
 3132
 3133remove_sublist(_,[],[]).
 3134
 3135/*****************************************************************************/
 3136/* simplify_comp_lits_in_dnf(SimplerDNF,SimplifiedDNF1)                      */
 3137/*                                                                           */
 3138/* Looks for literals in a node (in DNF) which are complementary and adds    */
 3139/* new disjuncts that occur if we write from DNF into CNF and back to DNF.   */
 3140/* For example if we have [[s,a],[t,~a]] we add the disjunct [s,t].          */
 3141/*                                                                           */
 3142/*****************************************************************************/
 3143
 3144simplify_comp_lits_in_dnf(DNFList,NewList):-
 3145     get_comp_list(DNFList,CompLits),
 3146     add_extra_disjuncts(DNFList,CompLits,NewList).
 3147
 3148/*****************************************************************************/
 3149/* get_comp_list(DNFList,CompLits)                                           */
 3150/*                                                                           */
 3151/* Takes all the literals of DNFList and searches for literals where both    */
 3152/* l and ~l are in the list and returns one of this pair in CompLits.        */
 3153/*                                                                           */
 3154/*****************************************************************************/
 3155
 3156get_comp_list(DNFList,CompLits):-
 3157   flatten(DNFList,FlatList),
 3158   find_comp_lits(FlatList,CompLits).
 3159
 3160/*****************************************************************************/
 3161/*    find_comp_lits(ShortList,CompLits).                                    */
 3162/*                                                                           */
 3163/* Takes a list of literals and their negations. Looks at the each member of */
 3164/* this list in turn and then for its negation in the remainder of the list. */
 3165/* If its negation is found then the literal is added to CompLits.           */
 3166/*                                                                           */
 3167/*****************************************************************************/
 3168
 3169find_comp_lits([H|Tail],[H|NewTail]):-
 3170   is_comp_lit(H,Tail),!,
 3171   find_comp_lits(Tail,NewTail).
 3172
 3173find_comp_lits([_|Tail],NewTail):-
 3174   find_comp_lits(Tail,NewTail).
 3175
 3176find_comp_lits([],[]).
 3177/*****************************************************************************/
 3178/*    is_comp_lit(H,Tail).                                                   */
 3179/*                                                                           */
 3180/* Returns true if the negation of H is a member of Tail.                    */
 3181/*                                                                           */
 3182/*****************************************************************************/
 3183
 3184is_comp_lit(H,Tail):-
 3185  snff_negate(H,NegH),
 3186  member(NegH,Tail),!.
 3187
 3188/*****************************************************************************/
 3189/* add_extra_disjuncts(DNFList,CompLits,CompLits,NewList).                   */
 3190/*                                                                           */
 3191/* For each pair of complementary literals adds a new disjuncts that occurs  */
 3192/* if we write from DNF into CNF and back to DNF.                            */
 3193/* For example if we have [[s,a],[t,~a]] we add the disjunct [s,t].          */
 3194/*                                                                           */
 3195/*****************************************************************************/
 3196
 3197add_extra_disjuncts(List,[H|Tail],NewList):-
 3198   solve_for_comp_lit(H, List, List, NewerList),
 3199   add_extra_disjuncts(NewerList,Tail,NewList).
 3200
 3201add_extra_disjuncts(List,[],List).
 3202
 3203/*****************************************************************************/
 3204/* solve_for_comp_lit(H, List, NewerList)                                    */
 3205/*                                                                           */
 3206/* Takes a complementary literal, H, the node we have built, List, which is  */
 3207/* in DNF, searches for the first disjuncts from List that have either H or  */
 3208/* ~H as a member. Then the rest of the list is searched for a sublist with  */
 3209/* either ~H or H depending on what our first literal was and adds a new     */
 3210/* disjunct that is the remaining literals from the sublist with the H or ~H */
 3211/* in it and the sublist with the ~H or H in it. This is repeated on the     */
 3212/* remains of the list (after we found the first sublist with H or ~H in).   */
 3213/*                                                                           */
 3214/*****************************************************************************/
 3215
 3216solve_for_comp_lit(Comp,[D1|DRest],List,NewestRest):-
 3217    member(Comp,D1),!,
 3218    remove_member(Comp,D1,NewD1),
 3219    snff_negate(Comp,NegComp),
 3220    solve_for_second_comp(NegComp,DRest,List,NewD1,NewList),
 3221    solve_for_comp_lit(Comp,DRest,NewList,NewestRest).
 3222
 3223solve_for_comp_lit(Comp,[D1|DRest],List,NewestRest):-
 3224    snff_negate(Comp,NegComp),
 3225    member(NegComp,D1),!,
 3226    remove_member(NegComp,D1,NewD1),
 3227    solve_for_second_comp(Comp,DRest,List,NewD1,NewList),
 3228    solve_for_comp_lit(Comp,DRest,NewList,NewestRest).
 3229
 3230solve_for_comp_lit(Comp,[_|DRest],List,NewRest):-
 3231    solve_for_comp_lit(Comp,DRest,List,NewRest).
 3232
 3233solve_for_comp_lit(_,[],List,List).
 3234
 3235/*****************************************************************************/
 3236/* solve_for_second_comp(Comp,DRest,NewD1,NewerRest)                         */
 3237/*                                                                           */
 3238/* Having found a sublist with ~Comp in we look for the sublist form DRest   */
 3239/* that includes Comp. On finding this sublist we remove Comp from the list  */
 3240/* and append the remaining literals with those remaining from the sublist   */
 3241/* with ~Comp and use this a s a new disjuncts. This is repeated searching   */
 3242/* for any other sublists that may include Comp as a member.                 */
 3243/*                                                                           */
 3244/*****************************************************************************/
 3245
 3246solve_for_second_comp(Comp,[[Comp]|_],_,[],[[true]]):- !.
 3247                                   % We have found a literal and its negation.
 3248
 3249solve_for_second_comp(Comp,[D1|DRest],All,OldConjuncts,NewestRest):-
 3250    member(Comp,D1),!,
 3251    remove_member(Comp,D1,NewD1),
 3252    append(OldConjuncts,NewD1,NewerConjuncts),
 3253    simplify_a_disjunct(NewerConjuncts,NewConjuncts),
 3254    remove_subsumed(NewConjuncts,All,NewAll),
 3255    solve_for_second_comp(Comp,DRest,NewAll,OldConjuncts,NewestRest).
 3256
 3257solve_for_second_comp(Comp,[_|DRest],All,OldConjuncts,NewRest):-
 3258    solve_for_second_comp(Comp,DRest,All,OldConjuncts,NewRest).
 3259    
 3260solve_for_second_comp(_,[],All,_,All).
 3261
 3262/******************************************************************************/
 3263
 3264remove_subsumed_list([H|Tail],All,FinalAll):-
 3265  remove_subsumed(H,All,NewAll),
 3266  remove_subsumed_list(Tail,NewAll,FinalAll).
 3267
 3268remove_subsumed_list([],FinalAll,FinalAll).
 3269
 3270/*****************************************************************************/
 3271
 3272remove_subsumed([true],_,[[true]]):-!.
 3273
 3274remove_subsumed([false],All,All):-!.
 3275
 3276remove_subsumed(Dis,[H|Tail],[H|Tail]):-
 3277  subset(H,Dis),!.
 3278
 3279remove_subsumed(Dis,[H|Tail],NewTail):-
 3280  subset(Dis,H), !,
 3281  remove_subsumed(Dis, Tail,NewTail).
 3282
 3283remove_subsumed(Dis,[H|Tail],[H|NewTail]):-
 3284   remove_subsumed(Dis,Tail,NewTail).
 3285    
 3286remove_subsumed(Dis,[],[Dis]).
 3287
 3288/*******************************************************************************/
 3289/* strip_cnf(Clause, List)                                                      */
 3290/*                                                                             */
 3291/*   This predicate removes all ands or ors from Clause which is disjunctive   */
 3292/*   and puts them on a bracketed List eg (a and b) or c would be [[a,b],[c]]  */
 3293/*******************************************************************************/
 3294
 3295strip_cnf(A and B,NewAB):- !,
 3296   strip_cnf(A,NewA),
 3297   strip_cnf(B,NewB),
 3298   append(NewA,NewB,NewAB).
 3299
 3300strip_cnf(A or B,[NewAB]):- !,
 3301   strip_or(A or B, NewAB).
 3302
 3303strip_cnf(A,[[[A]]]).
 3304
 3305/*****************************************************************************/
 3306/* combine_sublists_in_dnf(SplitRules,Combined)                              */
 3307/*                                                                           */
 3308/* Takes a list split into sublists (SplitRules) and combines the rules      */
 3309/* so as to take one from each sublist returning the combined rules in       */
 3310/* Combined.                                                                 */
 3311/*                                                                           */
 3312/*****************************************************************************/
 3313
 3314combine_sublists_in_dnf([_],[]):-!.               % Only one sublist
 3315
 3316combine_sublists_in_dnf([L1|[L2]],L12):- !,       % Two sublists
 3317   combine_two_sublists_in_dnf(L1,L2,L12).
 3318
 3319combine_sublists_in_dnf([L1|L2],NewL1L2):- !,     % More than two sublists
 3320   combine_sublists_in_dnf(L2,NewL2),
 3321   combine_two_sublists_in_dnf(L1,NewL2,NewL1L2).
 3322
 3323combine_sublists_in_dnf([],[]).                   % No sublists
 3324
 3325/*****************************************************************************/
 3326/* combine_two_sublists_in_dnf(L1,L2,NewL1L2).                               */
 3327/*                                                                           */
 3328/* Takes two sublists L1 and L2 an combines every rule in L1 with every rule */
 3329/* in L2, returning the combined rules in NewL1L2.                           */
 3330/*                                                                           */
 3331/*****************************************************************************/
 3332
 3333combine_two_sublists_in_dnf([H1|Tail1],List2,NewList):-
 3334   combine_element_with_all_in_dnf(H1,List2,H1List2),
 3335   combine_two_sublists_in_dnf(Tail1,List2,Tail1List2),
 3336   append(H1List2,Tail1List2,NewList).
 3337
 3338combine_two_sublists_in_dnf([],_,[]).
 3339
 3340/*****************************************************************************/
 3341/* combine_element_with_all_in_dnf(H1,List2,H1List2)                         */
 3342/*                                                                           */
 3343/* Takes a rule H1 and combines it with every rule in List2 to give H1List2. */
 3344/*                                                                           */
 3345/*****************************************************************************/
 3346
 3347combine_element_with_all_in_dnf(H1,[H2|Tail2],[H1H2|H1Tail2]):-
 3348  append(H1,H2,H1H2),
 3349  combine_element_with_all_in_dnf(H1,Tail2,H1Tail2).
 3350
 3351combine_element_with_all_in_dnf(_,[],[]).
 3352
 3353/**********************************************************************/
 3354
 3355add_combined_to_rules(r(_,_,false => next _),Rules,_,_,Rules):- !.
 3356
 3357add_combined_to_rules(r(_,_, _ => next false),Rules,_,_,Rules):- !.
 3358
 3359add_combined_to_rules(r(_,_, true => false),Rules,_,_,Rules):- !.
 3360
 3361add_combined_to_rules(r(N1,N2,P => next Q),Rules,_D1,PrevNode,NewRules):-
 3362   strip_or(Q,StrippedQ),
 3363   remove_ok_disjuncts(StrippedQ,PrevNode,NewStrippedQ),
 3364   flatten(NewStrippedQ,FinalQ),
 3365   add_combined_to_rule(r(N1,N2,P => next Q),FinalQ,Rules,NewRules).
 3366
 3367add_combined_to_rules(r(N1,N2,Q),Rules,_D1,PrevNode,NewRules):-
 3368   disjunction_of_literals(Q),
 3369   strip_or(Q,StrippedQ),
 3370   remove_ok_disjuncts(StrippedQ,PrevNode,NewStrippedQ),
 3371   flatten(NewStrippedQ,FinalQ),
 3372   add_combined_to_rule(r(N1,N2,Q),FinalQ,Rules,NewRules).
 3373
 3374add_combined_to_rule(r(N1,N2,P => next Q),StrippedQ,[[Lit,LitRules]|Rest],[[Lit,NewLitRules]|NewRest]):-
 3375   member(Lit,StrippedQ),!,
 3376   add_combined_rule(r(N1,N2,P => next Q),LitRules,NewLitRules),
 3377   add_combined_to_rule(r(N1,N2,P => next Q),StrippedQ,Rest,NewRest).
 3378
 3379add_combined_to_rule(r(N1,N2,Q),StrippedQ,[[Lit,LitRules]|Rest],[[Lit,NewLitRules]|NewRest]):-
 3380   disjunction_of_literals(Q),
 3381   member(Lit,StrippedQ),!,
 3382   add_combined_rule(r(N1,N2,Q),LitRules,NewLitRules),
 3383   add_combined_to_rule(r(N1,N2,Q),StrippedQ,Rest,NewRest).
 3384
 3385add_combined_to_rule(r(N1,N2,P => next Q),StrippedQ,[[Lit,LitRules]|Rest],[[Lit,LitRules]|NewRest]):- !,
 3386   add_combined_to_rule(r(N1,N2,P => next Q),StrippedQ,Rest,NewRest).
 3387
 3388add_combined_to_rule(r(N1,N2,Q),StrippedQ,[[Lit,LitRules]|Rest],[[Lit,LitRules]|NewRest]):- 
 3389   disjunction_of_literals(Q),
 3390   add_combined_to_rule(r(N1,N2,Q),StrippedQ,Rest,NewRest).
 3391
 3392add_combined_to_rule(r(_,_, _ => next _),_,[],[]).
 3393
 3394add_combined_to_rule(r(_,_,_),_,[],[]).
 3395
 3396/***********************************************************************************/
 3397
 3398add_combined_rule(r(_,_,P1 => next Q1),[r(M1,M2,P2 => next Q2)|LitRest],[r(M1,M2,P2 => next Q2)|LitRest]):-  
 3399 strip_or(Q1,StrippedQ1),
 3400 strip_or(Q2,StrippedQ2),
 3401 same_node(StrippedQ1,StrippedQ2),
 3402 strip(P1,StrippedP1),
 3403 strip(P2,StrippedP2),
 3404 set_implies(StrippedP1,StrippedP2),!.
 3405
 3406add_combined_rule(r(_,_,Q1),[r(M1,M2,P2 => next Q2)|LitRest],[r(M1,M2,P2 => next Q2)|LitRest]):-
 3407 disjunction_of_literals(Q1),  
 3408 strip_or(Q1,StrippedQ1),
 3409 strip_or(Q2,StrippedQ2),
 3410 same_node(StrippedQ1,StrippedQ2),
 3411 strip(P2,StrippedP2),
 3412 set_implies([true],StrippedP2),!.
 3413
 3414add_combined_rule(r(_,_,_ => next Q1),[r(M1,M2,Q2)|LitRest],[r(M1,M2,Q2)|LitRest]):-  
 3415 disjunction_of_literals(Q2),
 3416 strip_or(Q1,StrippedQ1),
 3417 strip_or(Q2,StrippedQ2),
 3418 same_node(StrippedQ1,StrippedQ2),!.
 3419
 3420add_combined_rule(r(_,_,Q1),[r(M1,M2,Q2)|LitRest],[r(M1,M2,Q2)|LitRest]):-
 3421 disjunction_of_literals(Q1),
 3422 disjunction_of_literals(Q2),  
 3423 strip_or(Q1,StrippedQ1),
 3424 strip_or(Q2,StrippedQ2),
 3425 same_node(StrippedQ1,StrippedQ2),!.
 3426
 3427add_combined_rule(r(N1,N2,P1 => next Q1),[r(_,_,P2 => next Q2)|LitRest],NewLitRest):-  
 3428 strip_or(Q1,StrippedQ1),
 3429 strip_or(Q2,StrippedQ2),
 3430 same_node(StrippedQ1,StrippedQ2),
 3431 strip(P1,StrippedP1),
 3432 strip(P2,StrippedP2),
 3433 set_implies(StrippedP2,StrippedP1),!,
 3434 add_combined_rule(r(N1,N2,P1 => next Q1),LitRest,NewLitRest).  
 3435
 3436add_combined_rule(r(N1,N2,P1 => next Q1),[r(_,_,Q2)|LitRest], NewLitRest):-  
 3437 disjunction_of_literals(Q2),
 3438 strip_or(Q1,StrippedQ1),
 3439 strip_or(Q2,StrippedQ2),
 3440 same_node(StrippedQ1,StrippedQ2),
 3441 strip(P1,StrippedP1),
 3442 set_implies([true],StrippedP1),!,
 3443 add_combined_rule(r(N1,N2,P1 => next Q1),LitRest,NewLitRest).  
 3444
 3445add_combined_rule(r(N1,N2,Q1),[r(_,_,_ => next Q2)|LitRest], NewLitRest):-
 3446 disjunction_of_literals(Q1),  
 3447 strip_or(Q1,StrippedQ1),
 3448 strip_or(Q2,StrippedQ2),
 3449 same_node(StrippedQ1,StrippedQ2),
 3450 add_combined_rule(r(N1,N2,Q1),LitRest,NewLitRest).  
 3451  
 3452add_combined_rule(r(N1,N2,P1 => next Q1),[r(M1,M2,P2 => next Q2)|LitRest],[r(M1,M2,P2 => next Q2)|NewLitRest]):-  
 3453 add_combined_rule(r(N1,N2,P1 => next Q1),LitRest,NewLitRest).  
 3454
 3455add_combined_rule(r(N1,N2,P1 => next Q1),[r(M1,M2,Q2)|LitRest],[r(M1,M2, Q2)|NewLitRest]):-
 3456 disjunction_of_literals(Q2),  
 3457 add_combined_rule(r(N1,N2,P1 => next Q1),LitRest,NewLitRest).  
 3458
 3459add_combined_rule(r(N1,N2,Q1),[r(M1,M2,P2 => next Q2)|LitRest],[r(M1,M2, P2 => next Q2)|NewLitRest]):-  
 3460 disjunction_of_literals(Q1),
 3461 add_combined_rule(r(N1,N2,Q1),LitRest,NewLitRest).  
 3462
 3463add_combined_rule(r(N1,N2,Q1),[r(M1,M2,Q2)|LitRest],[r(M1,M2,Q2)|NewLitRest]):- 
 3464 disjunction_of_literals(Q1),
 3465 disjunction_of_literals(Q2), 
 3466 add_combined_rule(r(N1,N2,true => next Q1),LitRest,NewLitRest).  
 3467
 3468add_combined_rule(r(N1,N2,P1 => next Q1),[],[r(N1,N2,P1 => next Q1)]).
 3469                              
 3470add_combined_rule(r(N1,N2,Q1),[],[r(N1,N2,Q1)]):-
 3471 disjunction_of_literals(Q1).
 3472
 3473/*********************************************************************************************/
 3474
 3475remove_ok_disjuncts([H|Rest],Node,NewRest):-
 3476  set_implies(H,Node),!,
 3477  remove_ok_disjuncts(Rest,Node,NewRest).
 3478
 3479remove_ok_disjuncts([H|Rest],Node,[H|NewRest]):-
 3480  remove_ok_disjuncts(Rest,Node,NewRest).
 3481
 3482remove_ok_disjuncts([],_,[]).
 3483
 3484
 3485/* Predicates for collecting statistics */
 3486
 3487collect_statistics((CPUTime,Inferences,LocalUsed,GlobalUsed,TrailUsed)):-
 3488  statistics(cputime,CPUTime),
 3489  statistics(inferences,Inferences),
 3490  statistics(localused,LocalUsed),
 3491  statistics(globalused,GlobalUsed),
 3492  statistics(trailused,TrailUsed).
 3493
 3494calculate_statistics((CPUTime1,Inferences1,LocalUsed1,GlobalUsed1,TrailUsed1),
 3495		     (CPUTime2,Inferences2,LocalUsed2,GlobalUsed2,TrailUsed2)):-
 3496  write('\n\nStatistics\n\n'),
 3497  CPUTime is CPUTime2 - CPUTime1,
 3498  writef('CPUTime:%w\n',[CPUTime]),
 3499  Inferences is Inferences2 - Inferences1,
 3500  writef('Inferences:%w\n',[Inferences]),
 3501  LocalUsed is LocalUsed2 - LocalUsed1,
 3502  writef('Local Stack:%t\n',[LocalUsed]),
 3503  GlobalUsed is GlobalUsed2 - GlobalUsed1,
 3504  writef('Global Stack:%t\n',[GlobalUsed]),
 3505  TrailUsed is TrailUsed2 - TrailUsed1,
 3506  writef('Trail Stack:%t\n',[TrailUsed]).
 3507
 3508/* Predicate that invokes the other predicates that will perform resolution */
 3509     
 3510otres(Rules):-
 3511  clear,
 3512  collect_statistics(X),
 3513  otres_allres(Rules,_),
 3514  collect_statistics(Y),
 3515  calculate_statistics(X,Y),
 3516  newrulecount(N),
 3517  Counter is N - 1,
 3518  writef('\nNumber of clauses generated: %t\n',[Counter]).
 3519
 3520/************************************************************/
 3521/* First call to the predicates that perform resolution.    */
 3522/* It takes a formula, transform it into the snf, set the   */
 3523/* initial literal to be unique, number and separate rules, */
 3524/* generate the SNL clauses and call modal resolution.      */
 3525/************************************************************/
 3526
 3527otres_allres(Rules,AllNewRules):-
 3528   startrulecount(_),
 3529   snff(Rules,SNFRules),
 3530   check_initial(SNFRules,NewSNFRules),
 3531   number_rules(NewSNFRules,[],NumberedSNF),
 3532   separate_and_format_rules(NumberedSNF,ERules,ERulePaths,OtherRules),
 3533   generate_snl(OtherRules,NOtherRules),
 3534   simplify_lists(NOtherRules,(Initial,Literal,Modal,Temporal)),
 3535   my_write('\nSet of clauses after translation to SNF :\n'),
 3536   write_ruleset((Initial,Literal,Modal,Temporal)),
 3537   mres(Literal,Modal,Initial,NewerLiteral,NewerModal),
 3538   write('\notres_allres (1) ==> Usable rules are \n'),
 3539   write_otter_rules(NewerLiteral),nl,
 3540   write('\notres_allres (1) ==> Rules in the SoS are \n'),
 3541   write_otter_rules(Temporal),nl,
 3542   read(OtterRules),
 3543   otres_test_otter_output(OtterRules,(Initial,NewerLiteral,NewerModal,Temporal),ERulePaths,ERules,AllNewRules).
 3544
 3545/* predicate called after temporal resolution takes place */
 3546
 3547otres_allres(OldRules,NewRules,ERulePaths,ERules,AllNewRules):-
 3548   number_rules(NewRules,[],NumberedRules),
 3549   simplify(NumberedRules,SimpleRules),
 3550   split_temp_lit_rules(SimpleRules,NewLiteral,NewTemporal),
 3551   my_write('otres_allres (2) ==> New literal rules are \n'),write_ruleset(NewLiteral),
 3552   my_write('otres_allres (2) ==> New temporal rules are \n'),write_ruleset(NewTemporal),
 3553   step_resolution(NewLiteral,NewTemporal,OldRules,ERules,ERulePaths,AllNewRules).
 3554
 3555/************************************************************************************/
 3556/* the next predicates are  renaming possible disjunctions on the rhs of initial    */
 3557/* clauses. This is because in this program, the initial resolution is NOT          */
 3558/* implemented. Instead, you have a simple check: if ~ X (in the literal clauses) */
 3559/* is generated, checks if X is in the initial set, generating false in the literal */
 3560/* set of clauses.                                                                  */
 3561/************************************************************************************/
 3562
 3563check_initial(Initial,Final):-
 3564   new_temp_prop(V),
 3565   change_initial(Initial,V,NewList),
 3566   append([start => V],NewList,Final).
 3567
 3568change_initial([],_,[]):-!.
 3569
 3570change_initial([start => X|Rest],V,[~ V or X|NewRest]):-
 3571   change_initial(Rest,V,NewRest).
 3572
 3573change_initial([H|Rest],V,[H|NewRest]):-
 3574   change_initial(Rest,V,NewRest).
 3575
 3576/********************************************************************************/
 3577/* The following generates the SNL clauses and definitions from a given set of  */
 3578/* step clauses.                                                                */
 3579/********************************************************************************/
 3580
 3581generate_snl((Initial,Literal,Modal,Temporal),(Initial,NewLiteral,NewModal,NewTemporal)):-
 3582   my_write('\nGenerating SNL Clauses\n'),
 3583   my_write('\nTemporal Clauses are \n'),
 3584   write_ruleset(Temporal),
 3585   generate_snl(Temporal,Literal,Modal,NewTemporal,NewLiteral,NewModal),
 3586   my_write('\nNew Temporal Clauses are \n'),
 3587   write_ruleset(NewTemporal).
 3588
 3589generate_snl([],Literal,Modal,[],Literal,Modal).
 3590
 3591generate_snl([r(N1,M,X => next Y)|List],OldLiteral,OldModal,
 3592 [r(N1,M,X => next Y),r(N2,[N1],NewX => next NewY)|NewList],NewerLiteral,NewerModal):-
 3593   newrulecount(N2),
 3594   snl(NewX,X,[N1],NewLiterals1,NewModals1),
 3595   snl(NewY,Y,[N1],NewLiterals2,NewModals2),
 3596   append(NewLiterals1,NewLiterals2,NewLiteral),
 3597   append(NewLiteral,OldLiteral,Literal),
 3598   append(NewModals1,NewModals2,NewModal),
 3599   append(NewModal,OldModal,Modal),
 3600   generate_snl(List,Literal,Modal,NewList,NewerLiteral,NewerModal).
 3601
 3602generate_snl([X|List],OldLiteral,OldModal,[X|NewList],NewerLiteral,NewerModal):-
 3603   generate_snl(List,OldLiteral,OldModal,NewList,NewerLiteral,NewerModal).
 3604
 3605/********************************************************************************/
 3606/* The following generates the SNL clauses and definitions from a given set of  */
 3607/* step clauses, after resolution has been performed.                           */
 3608/********************************************************************************/
 3609
 3610generate_otter_snl(OldRules,NewOldRules,NewishLiteral,OldModal,SNewModal):-
 3611   generate_snl(OldRules,[],OldModal,NewOldRules,NewLiteral,NewModal),
 3612   remove_duplicate_rules(NewLiteral,NewerLiteral),
 3613   remove_already_existing(NewerLiteral,NewOldRules,NewishLiteral),
 3614   get_new_modal_rules(OldModal,NewModal,NewerModal),
 3615   remove_duplicate_rules(NewerModal,SNewModal).
 3616
 3617/* Remove already existing clauses */
 3618
 3619remove_already_existing([],_,[]).
 3620
 3621remove_already_existing([r(_,_,Rule)|Tail],OldRules,ReallyNew):-
 3622   test_member(Rule,OldRules),!,
 3623   remove_already_existing(Tail,OldRules,ReallyNew).
 3624
 3625remove_already_existing([Head|Tail],OldRules,[Head|ReallyNew]):-   
 3626   remove_already_existing(Tail,OldRules,ReallyNew).
 3627
 3628/**********************************************************************************/
 3629
 3630separate_and_format_rules(Rules,ERules,ERulePaths,(InitialRules,LiteralRules,ModalRules,TemporalRules)):-
 3631   separate_rules(Rules,AllERules,InitialRules,LiteralRules,ModalRules,TemporalRules),
 3632   remove_duplicate_erules(AllERules, ERules),
 3633   my_write('\n\nThe list of eventuality rules is \n\n'),
 3634   write_ruleset(ERules),
 3635   process_eventualities(ERules, ERulePaths).
 3636
 3637/*****************************************************************************/
 3638/* separate_rules(Rules, ERules Others)                                      */
 3639/*                                                                           */
 3640/* This predicate takes a list of rules and splits it into two lists one     */
 3641/* containing the separate_rules which have to be solved and the other       */
 3642/* containg the remaining rules which are global box rules ie                */
 3643/*           slast P => F,                                                  */
 3644/* where P is a conjunction and F a disjunction, any other rules being       */
 3645/* disregarded.                                                              */
 3646/*                                                                           */
 3647/*****************************************************************************/
 3648
 3649separate_rules([],[],[],[],[],[]):-!.
 3650
 3651separate_rules([r(N1,N2, F => sometimes G)|Rules],
 3652               [r(N1,N2, F => sometimes G)|ERules],InitialRules,LiteralRules,ModalRules,TemporalRules) :- !,
 3653    separate_rules(Rules,ERules,InitialRules, LiteralRules, ModalRules, TemporalRules).
 3654% Add sometimes clause to ERules
 3655
 3656
 3657separate_rules([r(N1,N2,P => next F)|Rules],
 3658                ERules,InitialRules, LiteralRules, ModalRules,[r(N1,N2, P => next F)|TemporalRules]) :- !,
 3659   separate_rules(Rules,ERules, InitialRules, LiteralRules, ModalRules, TemporalRules).
 3660% Add step clauses to TemporalRules
 3661
 3662separate_rules([r(N1,N2,start => F)|Rules],
 3663               ERules,[r(N1,N2,F)|InitialRules],LiteralRules, ModalRules,TemporalRules) :- !,
 3664   separate_rules(Rules,ERules,InitialRules, LiteralRules,ModalRules, TemporalRules).
 3665% Add initial clauses to InitialRules
 3666
 3667separate_rules([r(N1,N2,X => k A)|Rules],
 3668               ERules,InitialRules,LiteralRules, [r(N1,N2, X => k A)|ModalRules],TemporalRules) :-!,
 3669   separate_rules(Rules,ERules, InitialRules, LiteralRules, ModalRules, TemporalRules).
 3670% Add modal clause to ModalRules
 3671
 3672separate_rules([r(N1,N2,X => ~ k A)|Rules],
 3673               ERules,InitialRules, LiteralRules, [r(N1,N2, X => ~ k A)|ModalRules],TemporalRules) :-!,
 3674   separate_rules(Rules,ERules, InitialRules, LiteralRules,ModalRules, TemporalRules).
 3675% Add modal clause to ModalRules
 3676
 3677separate_rules([r(N1,N2,F)|Rules],
 3678               ERules,InitialRules,[r(N1,N2,F)|LiteralRules], ModalRules,TemporalRules) :-
 3679   disjunction_of_literals(F),!,
 3680   separate_rules(Rules,ERules, InitialRules, LiteralRules,ModalRules, TemporalRules).
 3681% Add literal clause to LiteralRules
 3682
 3683separate_rules([_|Rules],ERules,InitialRules, LiteralRules, ModalRules,TemporalRules) :- 
 3684   separate_rules(Rules,ERules, InitialRules, LiteralRules, ModalRules,TemporalRules).
 3685% Ignore other rules.
 3686
 3687/*****************************************************************************/
 3688/* remove_duplicate_erules(OldList, NewList).                                */
 3689/*                                                                           */
 3690/* Takes old list and removes duplicates to give NewList.                    */
 3691/* N.B. Only works with  with initial and global eventuality rules and NOT   */
 3692/* initial and global box rules.                                             */
 3693/*                                                                           */
 3694/* Two predicates have been maintained as the one above is called frequently */
 3695/* during nontemporal resolution where as this one is only called            */
 3696/* occasionally.                                                             */
 3697/*****************************************************************************/
 3698
 3699remove_duplicate_rules([],[]).
 3700
 3701remove_duplicate_rules([r(_,_,Rule)|Rest], NewRules):-
 3702   test_member(Rule, Rest),!,
 3703   remove_duplicate_rules(Rest, NewRules).
 3704
 3705remove_duplicate_rules([Rule|Rest], [Rule|NewRules]):-
 3706   remove_duplicate_rules(Rest, NewRules).
 3707
 3708/*******************************************************/
 3709
 3710remove_duplicate_erules([],[]).
 3711
 3712remove_duplicate_erules([Rule|Rest], NewRules):-
 3713   erule_in_list(Rule, Rest),!,
 3714   remove_duplicate_erules(Rest, NewRules).
 3715
 3716remove_duplicate_erules([Rule|Rest], [Rule|NewRules]):-
 3717   remove_duplicate_erules(Rest, NewRules).
 3718
 3719/*****************************************************************************/
 3720/* erule_in_list(Rule, List)                                                 */
 3721/*                                                                           */
 3722/* Takes a rule which is either an initial or global eventuality rule and    */
 3723/* tests whether it is a member of List.                                     */
 3724/*****************************************************************************/
 3725
 3726erule_in_list(r(_,_, P => sometimes F), [r(_,_,Q => sometimes F)|_]):-
 3727   strip(P, StrippedP),
 3728   strip(Q, StrippedQ),
 3729   same(StrippedP, StrippedQ).
 3730
 3731erule_in_list(r(N1,N2, P => sometimes F), [_|Rest]):-
 3732   erule_in_list(r(N1,N2, P => sometimes F), Rest).
 3733
 3734/*********************************************************************************************/
 3735/* process_eventualities(EList, ShortEList)                                                  */
 3736/*                                                                                           */
 3737/* Takes a list of eventualities EList removes the eventaulity with no duplicates and stores */
 3738/* in a structured list as below.                                                            */
 3739/*********************************************************************************************/
 3740
 3741process_eventualities(EList, ShortEList):-
 3742   extract_eventualities(EList, NewEList),
 3743   remove_duplicate(NewEList, NewerEList),
 3744   eventualities_paths(NewerEList,ShortEList).
 3745
 3746/*********************************************************************************************/
 3747/* extract_eventualites(EList, ShortEList)                                                   */
 3748/*                                                                                           */
 3749/* Takes a list of eventualities EList removes the eventuality with no duplicates            */
 3750/*********************************************************************************************/
 3751
 3752extract_eventualities([],[]).
 3753
 3754extract_eventualities([r(_,_, _ => sometimes F)|Rest], [F|NewRest]):-
 3755    extract_eventualities(Rest, NewRest).
 3756
 3757/********************************************************************************************/
 3758/*   eventualities_paths(EList,NewEList).                                                    */
 3759/*                                                                                           */
 3760/* Takes a list of eventuality rules (EList), and makes it into a list whose members are     */
 3761/* sublists of the form [ERule, []]...etc where the [] is for filling with the previous paths*/
 3762/* found for that eventuality.                                                               */
 3763/*                                                                                           */
 3764/*********************************************************************************************/
 3765
 3766eventualities_paths([],[]).
 3767
 3768eventualities_paths([H|Tail],[[H,[]]|NewTail]):-
 3769  eventualities_paths(Tail,NewTail).
 3770
 3771/*****************************************************************************************/
 3772
 3773simplify_lists((Initial,Literal,Modal,Temporal),(SInitial,SLiteral,SModal,STemporal)):-
 3774    simplify(Initial,SInitial),
 3775    simplify(Literal,SLiteral),
 3776    simplify(Modal,SModal),
 3777    simplify(Temporal,STemporal).
 3778
 3779/*****************************************************************************************/
 3780
 3781step_resolution(NewerLiteral,NewerTemporal,(Initial,Literal,Modal,Temporal),ERules,ERulePaths,AllNewRules):-
 3782   mres(Literal,Modal,NewerLiteral,[],Initial,NewLiteral,NewModal),
 3783   do_step_resolution(NewerLiteral,NewerTemporal,(Initial,Literal,Modal,Temporal),ERules,ERulePaths,AllNewRules,NewLiteral,NewModal).
 3784
 3785do_step_resolution(_,_,_,_,_,_,[r(0,[],false)],_):-
 3786   otres_test_new_rules(_,r(0,[],false),_,_,_,_).
 3787
 3788do_step_resolution(NewerLiteral,NewerTemporal,(Initial,Literal,_,Temporal),ERules,ERulePaths,AllNewRules,NewLiteral,NewModal):-
 3789%   write(Literal),nl,write(Modal),nl,write(NewerLiteral),nl,write(NewLiteral),nl,
 3790   my_write('step_resolution ==> New temporal rules are\n'),write_ruleset(NewerTemporal),
 3791   get_new_literal_rules(Literal,NewLiteral,ExtraLiteral),
 3792   my_write('step_resolution ==> New literal rules are\n'),write_ruleset(ExtraLiteral),
 3793   write('\nstep_resolution ==> Usable rules are \n'),
 3794   write_otter_rules(Literal,Temporal),nl,
 3795   write('\nstep_resolution ==>Rules in the SoS are \n'),
 3796   write_otter_rules(NewerTemporal,ExtraLiteral),nl,
 3797   read(OtterRules),
 3798   otres_test_otter_output(OtterRules,(Initial,NewerLiteral,NewModal,Temporal),ERulePaths,ERules,AllNewRules).
 3799
 3800/**********************************************************************/
 3801
 3802otres_test_otter_output([true => next false],(_,_,_,_),_,_,NewAllRules):-
 3803   write('\nHave generated false (1).\n'),
 3804   otres_test_new_rules(_,r(0,[],false),_,_,_,NewAllRules).
 3805
 3806otres_test_otter_output([false],(_,_,_,_),_,_,NewAllRules):-
 3807   write('\nHave generated false (2).\n'),
 3808   otres_test_new_rules(_,r(0,[],false),_,_,_,NewAllRules).
 3809
 3810otres_test_otter_output(OldOtterRules,([r(_,_,X)],Literal,_,Temporal),_,_,NewAllRules):-
 3811   test_member(~ X,OldOtterRules),
 3812   rewrite_rules(OldOtterRules,NewOldRules,NewOtterRules),
 3813   give_rules_old_numbers(NewOldRules,Literal,Temporal,NewishOldRules),
 3814   sort(NewishOldRules,SortedRules),
 3815   my_write('\nOutput from otter ==> New literal rules are \n'),write_ruleset(NewOtterRules),
 3816   my_write('\nOutput from otter ==> Remaining rules are\n'),write_ruleset(SortedRules),
 3817   write('\nHave generated false (3).\n'),
 3818   otres_test_new_rules(_,r(0,[],false),_,_,_,NewAllRules).
 3819
 3820otres_test_otter_output(OldOtterRules,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules):-
 3821   rewrite_rules(OldOtterRules,NewOldRules,NewOtterRules),
 3822   give_rules_old_numbers(NewOldRules,Literal,Temporal,NewishOldRules),
 3823%   my_write('\nOldOtterRules - All Rules coming from otter\n'),write_ruleset(OldOtterRules),
 3824%   my_write('\n\nNewOtterRules - Simplified Rules (p => next false\n'),write_ruleset(NewOtterRules),
 3825%   my_write('\n\nNewOldRules - Remaining rules\n'),write_ruleset(NewishOldRules),
 3826    generate_otter_snl(NewishOldRules,SNLNewOldRules,NewLiteral,Modal,NewModal),
 3827    append(NewOtterRules,NewLiteral,NewerOtterRules),
 3828    my_write('\nOutput from otter ==> New literal rules (A => next false) are \n'),write_ruleset(NewerOtterRules),
 3829    my_write('\nOutput from otter ==> Remaining rules (after snl) are\n'),write_ruleset(SNLNewOldRules),
 3830    my_write('\nOutput from snl   ==> New modal rules are\n'),write_ruleset(NewModal),
 3831    run_tempres_or_otter(SNLNewOldRules,NewerOtterRules,NewModal,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules).
 3832
 3833/**********************************************************************/
 3834
 3835/**********************************************************************/
 3836
 3837run_tempres_or_otter(NonTempRules,[],NewModal,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules):-
 3838   my_write('\nrun_tempres_or_otter ==> (1)\n'),
 3839   split_temp_lit_rules(NonTempRules,NewLiteral,NewTemporal),
 3840%   my_write('NonTempRules - All rules coming from otter\n'),write_ruleset(NonTempRules),
 3841%   my_write('NewLiteral - Literal rules coming from otter\n'),write_ruleset(NewLiteral),
 3842%   my_write('NewTemporal - Temporal rules coming from otter\n'),write_ruleset(NewTemporal),
 3843   get_new_literal_rules_after_temporal(Literal,NewLiteral,SmallNewLiteral),
 3844   my_write('Literal - Old Literal clauses\n'),write_ruleset(Literal),
 3845   my_write('NewLiteral - All Literal clauses coming from otter\n'),write_ruleset(NewLiteral),
 3846   my_write('SmallNewLiteral - the really new clauses generated by otter\n'),write_ruleset(SmallNewLiteral),
 3847   run_tempres_or_modal(SmallNewLiteral,NewLiteral,NewModal,NonTempRules,NewTemporal,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules).
 3848
 3849run_tempres_or_otter(NonTempRules,[],_,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules):-
 3850   my_write('\nrun_tempres_or_otter ==> (2)\n'),
 3851   write_ruleset(NonTempRules),
 3852   my_write('Attempting Breadth-First Temporal Resolution \n'),
 3853   full_tempres(NonTempRules,ERulePaths, ERules, MoreRules,NewERulePaths,_RulesUsed),
 3854   otres_test_new_rules(NonTempRules,MoreRules,(Initial,Literal,Modal,Temporal),NewERulePaths,ERules,AllNewRules).
 3855
 3856run_tempres_or_otter(UsableRules,SoSRules,_,(Initial,Literal,Modal,Temporal),ERulePaths,ERules,AllNewRules):-
 3857   my_write('\nrun_tempres_or_otter ==> (3)\n'),
 3858   write('\nrun_tempres_or_otter ==> Usable rules are \n'),
 3859   write_otter_rules(UsableRules),nl,
 3860   write('\nrun_tempres_or_otter ==> Rules in the SoS are \n'),
 3861   write_otter_rules(SoSRules),nl,
 3862   read(OtterRules),
 3863   otres_test_otter_output(OtterRules,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules).
 3864
 3865/**********************************************************************/
 3866
 3867run_tempres_or_modal([],NewLiteral,_,AllTemporal,NewTemporal,(Initial,_Literal,Modal,_Temporal),ERulePaths, ERules,AllNewRules):-
 3868   my_write('\nrun_tempres_or_modal ==> (1)\n'),
 3869   my_write('Attempting Breadth-First Temporal Resolution \n'),
 3870   full_tempres(AllTemporal,ERulePaths, ERules, MoreRules,NewERulePaths,_RulesUsed),
 3871   otres_test_new_rules(AllTemporal,MoreRules,(Initial,NewLiteral,Modal,NewTemporal),NewERulePaths, ERules,AllNewRules).
 3872
 3873
 3874run_tempres_or_modal(ExtraLiteral,NewLiteral,NewModal,_,NewTemporal,(Initial,Literal,Modal,_Temporal),
 3875                                   ERulePaths, ERules,AllNewRules):-
 3876   my_write('\nrun_tempres_or_modal ==> (2)\n'),
 3877   mres(Literal,Modal,ExtraLiteral,NewModal,Initial,FinalLiteral,FinalModal),
 3878   get_new_literal_rules(Literal,NewLiteral,ExtraLiteral1),
 3879%   my_write('\nLiteral'),
 3880%   write_ruleset(Literal),
 3881%   my_write('\nNewLiteral'),
 3882%   write_ruleset(NewLiteral),
 3883%   my_write('\nExtraLiteral1'),
 3884%   write_ruleset(ExtraLiteral1),
 3885   run_tempres_or_temporal(ExtraLiteral1,FinalLiteral,(Initial,Literal,FinalModal,NewTemporal),ERulePaths, ERules,AllNewRules).
 3886
 3887/**********************************************************************/
 3888
 3889run_tempres_or_temporal(_,[r(_,_,false)],_,_,_,_):-
 3890   otres_test_new_rules(_,r(_,_,false),_,_,_,_).
 3891
 3892run_tempres_or_temporal([],NewLiteral,(Initial,_Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules):-
 3893   my_write('\nrun_tempres_or_temporal ==> (1)\n'),
 3894   my_write('Attempting Breadth-First Temporal Resolution \n'),
 3895   append(Temporal,NewLiteral,AllTemporal),
 3896   full_tempres(AllTemporal,ERulePaths, ERules,MoreRules,NewERulePaths,_RulesUsed),
 3897   otres_test_new_rules(AllTemporal,MoreRules,(Initial,NewLiteral,Modal,Temporal),NewERulePaths, ERules,AllNewRules).
 3898
 3899run_tempres_or_temporal(ExtraLiteral,NewLiteral,(Initial,Literal,Modal,Temporal),ERulePaths, ERules,AllNewRules):-
 3900   my_write('\nrun_tempres_or_temporal ==> (2)\n'),
 3901%   k_to_literal(Modal,Kliteral),
 3902   write('\nrun_tempres_or_temporal ==> Usable rules are \n'),
 3903   write_otter_rules(Literal,Temporal),nl,
 3904   write('\nrun_tempres_or_temporal ==> Rules in the SoS are \n'),
 3905   write_otter_rules(ExtraLiteral),nl,
 3906   read(OtterRules),
 3907   otres_test_otter_output(OtterRules,(Initial,NewLiteral,Modal,Temporal),ERulePaths, ERules,AllNewRules).
 3908
 3909/*************************************************************************************/
 3910
 3911otres_test_new_rules(_,r(N1,N2,false),_,_,_,r(N1,N2,false)):-
 3912   write('Formula is unsatisfiable (1).\n').
 3913
 3914otres_test_new_rules(_,[],_,_,_,[]):-
 3915   write('Formula is satisfiable (2).\n').    % Note this really is satisfiable        
 3916                     
 3917otres_test_new_rules(OldRules,NewRules,(Initial,_,Modal,_),ERulePaths, ERules,NewAllRules):-
 3918   split_temp_lit_rules(OldRules,Literal,Temporal),
 3919   otres_allres((Initial,Literal,Modal,Temporal),NewRules,ERulePaths,ERules,NewAllRules).
 3920
 3921/**********************************************************************/
 3922/* rewrite_rules(OtterRules,OrdinaryRules,ImpFalseRules)              */
 3923/*                                                                    */
 3924/* Goes through the list of rules output by Otter and rewrites        */
 3925/* rules of the form slast A => false to their correct form and adds */
 3926/* them to ImpFalseRules and after numbering copies the rest to       */
 3927/* OrdinaryRules.                                                     */
 3928/*                                                                    */
 3929/**********************************************************************/
 3930
 3931rewrite_rules([],[],[]).
 3932
 3933rewrite_rules([false|_],[false],[]):-!.
 3934
 3935rewrite_rules([P => next false|Rules],NewOldRules,[NewRule1|NewRules]):- !,
 3936  snff_negate(P, NegP),
 3937  number_rule(NegP,[],NewRule1),
 3938  rewrite_rules(Rules,NewOldRules,NewRules).
 3939
 3940rewrite_rules([Rule|Rest],NewOldRules,NewRest):-
 3941  number_rule(Rule,[],NRule),
 3942  simplify_rule(NRule, SRule),
 3943  test_add_rule(SRule,Rest,NewOldRules,NewRest).
 3944
 3945/********************************************************************************************/
 3946
 3947test_add_rule([],Rest,NewOldRules,NewRest):- !,
 3948  rewrite_rules(Rest,NewOldRules,NewRest).
 3949  
 3950test_add_rule([Rule],Rest,[Rule|NewOldRules],NewRest):- 
 3951  rewrite_rules(Rest,NewOldRules,NewRest).
 3952  
 3953/*********************************************************************************************/
 3954/* full_tempres(Rules, ERulePaths, ERules, NewRules,NewERulePaths)                           */
 3955/*                                                                                           */
 3956/* Takes the current ruleset (Rules), a list of the eventualities with previous loop paths   */
 3957/* found (ERulePaths), a list of the sometimes rules (ERules) and attempts temporal          */
 3958/* between one of the eventualities and Rules. The path detected (LoopPath) is stored with   */
 3959/* the appropriate eventuality, NewERule in ERulePaths, new resolvents from this loop path   */
 3960/* and the eventuality are generated and stored in NewRules.                                 */
 3961/*********************************************************************************************/
 3962
 3963full_tempres(r(N1,N2,false), _, _, r(N1,N2,false), _,_).
 3964
 3965full_tempres(_,[],ERules,NewRules,[],_):-
 3966   write('\nfull_tempres (1) ==> No previous loop paths.\n'),
 3967   process_path([],_,_,[],_,ERules,NewRules, _).
 3968
 3969full_tempres(Rules,ERulePaths,ERules,NewRules,NewERulePaths,RulesUsed):-
 3970   write('\nfull_tempres (2) ==> Previous loop paths.\n'),
 3971   tempres(Rules,ERulePaths,NewERule,RelatedRules,RulesUsed,LoopPath),
 3972   process_path(LoopPath,RelatedRules,RulesUsed,ERulePaths,NewERule,ERules,NewRules,NewERulePaths).
 3973
 3974/*********************************************************************************************/
 3975/*  process_path(LoopPath,RelatedRules,RulesUsed,ERulePaths,ERule,ERules, NewRules,          */
 3976/*                                                           RotatedERulePaths).             */
 3977/*                                                                                           */
 3978/* Takes a loop found through a set of rules (LoopPath), a list of the rules which imply the */
 3979/* current eventuality (RelatedRules), a list of the rule numbers which have been use in the */
 3980/* loop we have found (RulesUsed), the list which stores each                                */
 3981/* eventuality and the list of loops already found (ERulePaths), an eventuality (ERule) which*/
 3982/* relates to this loop and a list of the sometimes rules (ERules). The new loop for this    */
 3983/* ERule is addeded to ERulePaths. The ERulePaths list is rotated so the head is the         */
 3984/* eventuality which followed ERule ie the new loop and ERule will now appear at the end of  */
 3985/* the list. This is done in an attempt to find "easy" rules first. If the ERulePaths list   */
 3986/* is cycled round then then one loop is found for each eventuality rule (if one exists) and */
 3987/* so on rather than trying to find all the loops for each eventuality in turn. The new      */
 3988/* resolvents are generated from this loop path to give NewRules and the updated and rotated */
 3989/* ERulePathsare returned in RotatedERulePaths.                                              */
 3990/*********************************************************************************************/
 3991
 3992process_path([],_,_,_,_ERule,_, [], _):-
 3993   my_write('No more loop paths.\n').
 3994
 3995process_path(LoopPath,RelatedRules,RulesUsed,ERulePaths,ERule,ERules, NewRules, RotatedERulePaths):-
 3996   write('The eventuality (for possibly several rules) being considered is '),
 3997   write_form(ERule),nl,
 3998   write('New Loop detected is '),
 3999   write(LoopPath),nl,
 4000   write('Loops previously detected are \n'), write('    [\n'),
 4001   write_list(ERulePaths),
 4002   write('    ]\n'),
 4003   add_new_path_to_found_previously(ERule,LoopPath,ERulePaths,NodePath,NewERulePaths),
 4004   rotate_rule(ERule,NewERulePaths,RotatedERulePaths),
 4005   new_rules(ERule,LoopPath,ERules,RulesUsed,RelatedRules,NodePath,NewRules),
 4006   write_ruleset(NewRules).
 4007
 4008/*********************************************************************************************/
 4009/*  rotate_rule(ERule,ERulePaths,NewList)                                                    */
 4010/*                                                                                           */
 4011/* Take an eventuality ERule, and a list of eventualities paired with previous loop paths    */
 4012/* found (ERulePaths). It searches for ERule in ERulePaths and makes the eventuality         */
 4013/* following ERule in the list the head and the portion of the list from the front to where  */
 4014/* ERule was located to the end of the new list (NewList). This was an attempt to find all   */
 4015/* "easy" loops first. Rotating the eventuality rules in this manner means that the temporal */
 4016/* resolution process will try to find a loop for each eventuality (if one exists) and then  */
 4017/* a second, and third etc.                                                                  */
 4018/*********************************************************************************************/
 4019
 4020rotate_rule(ERule,ERulePaths,NewList):-
 4021     split_list(ERule,ERulePaths,FirstBit, LastBit),
 4022     append(LastBit,FirstBit,NewList).
 4023
 4024/*********************************************************************************************/
 4025/*   split_list(ERule,ERulePaths,FirstBit, LastBit)                                          */
 4026/*                                                                                           */
 4027/* Takes an eventuality ERule, and a list of eventualities paired with loop paths previously */
 4028/* found (ERulePaths). It searches down ERulePaths looking for an ERule in the list. It      */
 4029/* stores all the things before this and including this as FirstBit, and all the remaining   */
 4030/* stuff as LastBit. The aim is the rotate the eventualities and lists in ERulePaths to try  */
 4031/* attempt to find a loop for each eventuality in turn.                                      */
 4032/*********************************************************************************************/
 4033
 4034split_list(ERule,[[ERule,PrevPath]|Rest],[[ERule,PrevPath]], Rest).
 4035
 4036split_list(ERule,[[AnERule,PrevPath]|Rest],[[AnERule,PrevPath]|FirstBit], LastBit):-
 4037   split_list(ERule,Rest,FirstBit,LastBit).
 4038
 4039/*********************************************************************************************/
 4040/*  new_rules(ERule, CycleRules, ERules, RulesUsed,RelatedRules,NodePath, NewRules)          */
 4041/*                                                                                           */
 4042/*  Takes the eventuality (ERule) we have detected a loop for, and a list of rules           */
 4043/*  (CycleRules) which have been generated from the the loop detected, and the complete      */
 4044/*  list of eventuality rules (ERules) and returns a list of new resolvents (NewRules).      */
 4045/*                                                                                           */
 4046/*********************************************************************************************/
 4047
 4048new_rules(ERule, CycleRules, ERules, RuleNoUsed_A,RelatedRules,NodePath,NewRules):-
 4049  get_rel_rules(ERule, ERules, RelRules),
 4050  generate_new_rules(RelRules, CycleRules, RuleNoUsed_A,RelatedRules,NodePath,NewRules).
 4051
 4052/*********************************************************************************************/
 4053/* add_new_path_to_found_previously(ERule,NewPath,ERulePaths,NodePath,NewERulePaths)         */
 4054/*                                                                                           */
 4055/* The new loop path NewPath found for the current eventuality ERule is added                */
 4056/* to the list ERulePaths which contains a list of eventualities and the                     */
 4057/* previously discovered.                                                                    */
 4058/*                                                                                           */
 4059/*********************************************************************************************/
 4060
 4061add_new_path_to_found_previously(ERule,NewPath,[[ERule, OldPaths]|Rest],_NodePath,[[ERule,[NewPath|OldPaths]]|Rest]).
 4062
 4063add_new_path_to_found_previously(ERule,NewPath,[ERulePath|Rest],NodePath,[ERulePath|NewRest]):-
 4064   add_new_path_to_found_previously(ERule,NewPath,Rest,NodePath,NewRest).
 4065
 4066/*********************************************************************************************/
 4067/* get_rel_rules(Eventuality, ERules, RelRules)                                              */
 4068/*                                                                                           */
 4069/* Takes the eventuality (Eventuality) for which a loop has been found, and the list of      */
 4070/* rules with eventualities (ERules) and picks out the rules related to the current          */
 4071/* eventuality.                                                                              */
 4072/*********************************************************************************************/
 4073
 4074get_rel_rules(_, [], []).
 4075
 4076get_rel_rules(F, [r(N1,N2,P => sometimes F)|Rest], [r(N1,N2,P => sometimes F)|NewRest]):-
 4077    get_rel_rules(F, Rest, NewRest).
 4078
 4079get_rel_rules(F, [_|Rest], NewRest):-
 4080    get_rel_rules(F, Rest, NewRest).
 4081
 4082/*********************************************************************************************/
 4083/* generate_new_rules(RelRules, CycleRules, RuleNoUsed,RelatedRules,NodePath,NewRules)       */
 4084/*                                                                                           */
 4085/* Takes a list of eventuality rules (RelRules) which are related to the eventuality in      */
 4086/* question, and a list of rules (CycleRules) which have generated from the loop detected    */
 4087/* from the eventuality in question, a list of the numbers of the rules used in the loop     */
 4088/* detected (RuleNoUsed), a list of rules of the form slast R => p, where "p" is the        */
 4089/* eventuality being currently considered (RelatedRules), a list of the nodes used in the    */
 4090/* loop ( and unstructured list) (NodePath) and produces a list of new resolvents.           */
 4091/*********************************************************************************************/
 4092
 4093generate_new_rules([],_,_,_,_,[]).
 4094
 4095generate_new_rules([RelRule|Rest],CycleRules, _RuleNoUsed,RelatedRules,NodePath,AllNewRules):-
 4096   generate_new_rule(RelRule, CycleRules, AllRulesUsed_ANON ,SomeNewRules),
 4097   generate_new_rules(Rest, CycleRules, AllRulesUsed_ANON ,RelatedRules, NodePath,OtherNewRules),
 4098   append(SomeNewRules, OtherNewRules, AllNewRules).
 4099
 4100/*********************************************************************************************/
 4101/*   generate_new_rule(RelRule, CycleRules, RuleNoUsed, SomeNewRules)                        */
 4102/*                                                                                           */
 4103/* Takes an eventuality rule (RelRule), a set of rules we have found a loop in               */
 4104/* (CycleRules), and a list of the rule numbers used in the loop detected (RuleNoUsed) and   */
 4105/* generates the new resolvents, (SomeNewRules).                                             */
 4106/*********************************************************************************************/
 4107
 4108generate_new_rule(r(N1,_, A => sometimes F), [[true]],_RuleNoUsed,[r(0,[N1],NegA or F)]):-
 4109      snff_negate(A,NegA).
 4110
 4111generate_new_rule(r(N1,_,true => sometimes F), [[NegF]],_RuleNoUsed,[r(0,[N1],F)]):-
 4112      disjunction_of_literals(F),
 4113      snff_negate(F, NegF).
 4114
 4115generate_new_rule(r(_N1,_,P => sometimes F),DisjunctList,_RuleNoUsed,NewRules):-
 4116      neg_cycle_list(DisjunctList,NewList),
 4117      construct_new_rules(P,NewList,F,NewRules).
 4118
 4119/***************************************************************************************/
 4120
 4121construct_new_rules(P, List, Eventuality,[V => next (V or Eventuality), NegP or V or Eventuality |Rest]):-
 4122      snff_negate(P, NegP),
 4123      new_temp_prop(V),
 4124      build_rules(NegP,Eventuality,V,List,Rest). 
 4125
 4126/********************************************************************************************/
 4127
 4128build_rules(NegP,Eventuality,V,[H|Tail],[NegP or Eventuality or H, V => next (H or Eventuality)|Rest]):-
 4129      build_rules(NegP,Eventuality,V,Tail,Rest).
 4130
 4131build_rules(_NegP,_Eventuality,_V,[],[]).
 4132
 4133/*********************************************************************************************/
 4134/*       neg_cycle_list(List,NewList).                                                       */
 4135/*                                                                                           */
 4136/* Takes a list (List) which is made up of sublists where the sublists are conjuncts and the */
 4137/* main list is disjunctive. This predicate negates each item in the sublists and disjoins   */
 4138/* them. The sublists are then conjoined together and returned in a NewList.                 */
 4139/*********************************************************************************************/
 4140
 4141neg_cycle_list([[P]],[NegP]):-
 4142     snff_negate(P,NegP).
 4143
 4144neg_cycle_list([List],[NegP]):-
 4145     snff_negate_list(List,NegP).
 4146
 4147neg_cycle_list([List|Lists], [NegP| Rest]):-
 4148     snff_negate_list(List,NegP),
 4149     neg_cycle_list(Lists,Rest).
 4150
 4151/**************************************************************************************/
 4152
 4153snff_negate_list([H],NegH):-
 4154   snff_negate(H,NegH).
 4155
 4156snff_negate_list([H|Rest],NegH or NewRest):-
 4157   snff_negate(H,NegH),
 4158   snff_negate_list(Rest,NewRest).
 4159
 4160/**************************************************************************************/
 4161
 4162split_temp_lit_rules([r(N,M,A => next B)|Rest],Literal,[r(N,M,A => next B)|Temporal]):-
 4163   split_temp_lit_rules(Rest,Literal,Temporal).
 4164
 4165split_temp_lit_rules([r(N,M,B)|Rest],[r(N,M,B)|Literal],Temporal):-
 4166   disjunction_of_literals(B),
 4167   split_temp_lit_rules(Rest,Literal,Temporal).
 4168
 4169split_temp_lit_rules([A => next B|Rest],Literal,[A => next B|Temporal]):-
 4170   split_temp_lit_rules(Rest,Literal,Temporal).
 4171
 4172split_temp_lit_rules([B|Rest],[B|Literal],Temporal):-
 4173   disjunction_of_literals(B),
 4174   split_temp_lit_rules(Rest,Literal,Temporal).
 4175
 4176split_temp_lit_rules([],[],[]).
 4177
 4178/*******************************************************************************/
 4179
 4180get_new_modal_rules(Modal,[r(N,_,_)|NewModal],Other):-
 4181   rule_member(N,Modal),!,
 4182   get_new_modal_rules(Modal,NewModal,Other).
 4183
 4184get_new_modal_rules(Modal,[r(_,_,Rule)|NewModal],Other):-
 4185   test_member(Rule,Modal),
 4186   get_new_modal_rules(Modal,NewModal,Other).
 4187   
 4188get_new_modal_rules(Modal,[r(N,M,Rule)|NewModal],[r(N,M,Rule)|Other]):-
 4189   get_new_modal_rules(Modal,NewModal,Other).
 4190
 4191get_new_modal_rules(_,[],[]).
 4192
 4193/******************************************************************************/
 4194
 4195get_new_literal_rules(Literal,[r(N,_,_)|NewLiteral],Other):-
 4196   rule_member(N,Literal),!,
 4197   get_new_literal_rules(Literal,NewLiteral,Other).
 4198
 4199get_new_literal_rules(Literal,[r(N,M,Rule)|NewLiteral],[r(N,M,Rule)|Other]):-
 4200   get_new_literal_rules(Literal,NewLiteral,Other).
 4201
 4202get_new_literal_rules(_,[],[]).
 4203
 4204/********************************************************************************/
 4205
 4206get_new_literal_rules_after_temporal(Literal,[r(_,_,Rule)|NewLiteral],Other):-
 4207   rule_in_list(Rule,Literal),!,
 4208   get_new_literal_rules_after_temporal(Literal,NewLiteral,Other).
 4209
 4210get_new_literal_rules_after_temporal(Literal,[r(N,M,Rule)|NewLiteral],[r(N,M,Rule)|Other]):-
 4211   get_new_literal_rules_after_temporal(Literal,NewLiteral,Other).
 4212
 4213get_new_literal_rules_after_temporal(_,[],[]).
 4214
 4215/**************************************************/
 4216
 4217rule_in_list(Rule,[r(_,_,Rule)|_]):- !.
 4218
 4219rule_in_list(D,[r(_,_,E)|_]):-
 4220    strip(D,SD),
 4221    strip(E,SE),
 4222    same(SD,SE),!.
 4223
 4224rule_in_list(D,[_|Rest]):-!,
 4225    rule_in_list(D,Rest).
 4226
 4227/*******************************************/
 4228
 4229rule_member(N,[r(N,_,_)|_]):- !.
 4230
 4231rule_member(N,[_|Rest]):- 
 4232   rule_member(N,Rest).
 4233
 4234rule_member(_,[]):-!,fail.
 4235
 4236/*****************************************/
 4237
 4238test_member(X,[X|_]).
 4239
 4240test_member(X,[r(_,_,X)|_]).
 4241
 4242test_member(X,[_|Rest]):-
 4243    test_member(X,Rest).
 4244
 4245/**********************************************************/
 4246/* Gives the clauses coming from Otter their old numbers. */
 4247/* Previously, clauses were just renumbered, making the   */
 4248/* reading of the proof difficult.                        */
 4249/**********************************************************/
 4250
 4251give_rules_old_numbers([],_,_,[]).
 4252
 4253give_rules_old_numbers([r(N1,N2,X => next Y)|Tail],Literal,Temporal,[NRule|NewishOldRules]):-
 4254  find_same_rule(r(N1,N2,X => next Y),Temporal,NRule),
 4255  give_rules_old_numbers(Tail,Literal,Temporal,NewishOldRules).
 4256
 4257give_rules_old_numbers([r(N1,N2,X)|Tail],Literal,Temporal,[NRule|NewishOldRules]):-
 4258  find_same_rule(r(N1,N2,X),Literal,NRule),
 4259  give_rules_old_numbers(Tail,Literal,Temporal,NewishOldRules).
 4260
 4261find_same_rule(r(N1,N2,Clause),List,r(N1,N2,Clause)):-
 4262   \+ (member(r(_,_,Clause),List)).
 4263
 4264find_same_rule(r(N1,N2,Clause),List,r(N5,N6,Clause)):-
 4265   sublist(same_rule(r(N1,N2,Clause)),List,SameList),
 4266   sort(SameList,Sorted),
 4267   nth1(1,Sorted,r(N3,N4,Clause)),
 4268   test_number(N1,N2,N3,N4,N5,N6).
 4269
 4270same_rule(r(_,_,X),r(_,_,Y)):-
 4271   strip_or(X,SX),
 4272   strip_or(Y,SY),
 4273   flatten(SX,FX),
 4274   flatten(SY,FY),
 4275   subset(FX,FY),
 4276   subset(FY,FX).
 4277
 4278test_number(N1,N2,N3,_N4,N1,N2):- N1 < N3.
 4279test_number(_N1,_N2,N3,N4,N3,N4).
 4280
 4281% :-[definitions,output,rules,mysnff,mres,mytempres,fullres].
 4282ex354:-otres([start => x,
 4283              x => sometimes p,
 4284              ~ x or ~ p,
 4285              x => next y,
 4286              ~ y or ~ p,
 4287              ~ y or t,
 4288              t => next ~ p,
 4289              t => next t]).
 4290
 4291ex5211:-otres([start => x,
 4292               x => k y,
 4293               y => sometimes p,
 4294               x => k ~ p,
 4295               x => ~ k ~ z,
 4296               z => next w,
 4297               ~ w or ~ p,
 4298               ~ w or t,
 4299               t => next ~ p,
 4300               t => next t]).
 4301
 4302ex5212:-otres([start => x,
 4303               x => sometimes y,
 4304               y => k p,
 4305               x => k ~ p,
 4306               x => next z,
 4307               ~ z or w,
 4308               ~ z or t,
 4309               t => next w,
 4310               t => next t,
 4311               w => ~ k p]).
 4312
 4313ex621:-otres([start => x,
 4314              x => k y,
 4315              y => next p,
 4316              x => next z,
 4317              z => ~ k p]).
 4318
 4319ex7121:-otres([start => x,
 4320               x => next y,
 4321               y => k p,
 4322               x => ~ k ~ z,
 4323               z => next ~ p]).
 4324
 4325ex7122:-otres([start => x,
 4326               x => next y,
 4327               y => k p,
 4328               x => ~ k ~ v,
 4329               ~ v or t,
 4330               ~ v or u,
 4331               t => next (w or ~ p),
 4332               u => next (~ w or ~ p)]).
 4333
 4334ex7123:-otres([start => x,
 4335               ~ x or z or y,
 4336               ~ x or z or w,
 4337               w => next (z or y),
 4338               w => next (z or w),
 4339               x => sometimes z,
 4340               z => k p2,
 4341               y => k p1,
 4342               x => ~ k ~ r,
 4343               ~ r or t or s,
 4344               ~ r or t or u,
 4345               u => next (t or s),
 4346               u => next (t or u),
 4347               t => ~ k p1,
 4348               t => ~ k p2,
 4349               s => ~ k p2]).
 4350
 4351ex81:-otres([~(k always p => always k p)]).
 4352ex82:-otres([~(always k p => k always p)]).
 4353ex83:-otres([(k sometimes p and k ~ p) => k next sometimes p]).
 4354
 4355ex84:-otres([start => x,
 4356             ~ x or y,
 4357             ~ x or a,
 4358             ~ x or b,
 4359             a and b => next y,
 4360             a => next a,
 4361             b => next b,
 4362             y => k p,
 4363             x => ~ k ~ w,
 4364             w => sometimes ~ p]).
 4365
 4366ex85:-otres([start => x,
 4367             ~ x or y,
 4368             ~ x or a,
 4369             ~ x or b,
 4370             a => next y,
 4371             b => next y,
 4372             a => next a,
 4373             b => next b,
 4374             y => k p,
 4375             x => ~ k ~ w,
 4376             w => sometimes ~ p]).
 4377
 4378
 4379ex86:-otres([start => x,
 4380             ~ x or y,
 4381             ~ x or a,
 4382             ~ x or b,
 4383             a => next (c or y),
 4384             b => next (~ c or y),
 4385             a => next a,
 4386             b => next b,
 4387             y => k p,
 4388             x => ~ k ~ w,
 4389             w => sometimes ~ p]).
 4390
 4391ex87:-otres([start => y,
 4392             ~ y or a,
 4393             ~ y or b,
 4394             ~ y or l,
 4395             x => next l,
 4396             a => next l,
 4397             b => next (c or d),
 4398             c => next a,
 4399             d => next a,
 4400             a => next x,
 4401             x => next b,
 4402             y => sometimes ~ l])