% MPR: Meta Prolog which Reorders clauses using
% user supplied preference rules.

:- use_module(library(lists)).
:- use_module(dbug).

:- op(1150,xfy,'if'),
   op(1100,xfy,'or'),
   op(1000,xfy,'and'),
   op(900,fy,'~').

% true succeeds.
demo(true) :- !.

% false fails.
demo(false) :- !,fail.

% conjunction
demo((P and Q)) :-
  !,
  reorder((P and Q),(R and S)),
  demo(R),
  demo(S).

% disjunction
demo((P or Q)) :-
  !,
  reorder((P or Q),(R or S)),
  (demo(R);demo(S)).

% negation 
demo(~P) :- demo(P),!,fail.
demo(~_) :- !.

% apply a rule
demo(P) :-
  bagof((P if Q),(P if Q),Rules),
  applyRules(P,Rules).

applyRules(P,Rules) :-
    bestRule(Rules,Best,Rest),
    (applyRule(P,Best) ; applyRules(P,Rest)).

applyRule(P,(P if Body)) :- demo(Body).

bestRule([(P if Q)|Rest],(P if Q),Rest) :-
  forall(member((_ if Q2), Rest), prefer(Q,Q2)),
  !.

bestRule([First|Rest],Best,[First|Rest2]) :-
 bestRule(Rest,Best,Rest2),
 dbug("I prefer the rule ~p over ~p.~n",[Best,[First|Rest2]]).

forall(P,Q) :- \+((P, \+Q)).

% fall through to prolog
demo(P) :- 
  builtin(P),
  !,
  call(P).

% succeeds if P is a builtin predicate (i.e., there
% are no pclause rules for P).
builtin(P) :- 
  functor(P,Predicate,Arity),  
  functor(P2,Predicate,Arity),
  \+((P2 if _)).

% reorder(T1,T2) takes a conjunction or disjunction T1
% and 'moves' the best term to the beginning.
reorder(T1,T2) :-
  straighten(T1,T1s),
  reorder1(T1s,T2).

reorder1((P and Q),(R and S)) :- pickAnd(P,Q,R,S).
reorder1((P or Q),(R or S)) :- pickOr(P,Q,R,S).

% pick(BestSoFar,Rest,UltimateBest,UltimateRest)

pickAnd(P,(Q and R),Best,(Loser and Rest)) :-
   !,
   order2(P,Q,Winner,Loser),
   pickAnd(Winner,R,Best,Rest).
pickAnd(P,Q,Winner,Loser) :-
   !,
   order2(P,Q,Winner,Loser).

pickOr(P,(Q or R),Best,(Loser or Rest)) :-
   !,
   order2(P,Q,Winner,Loser),
   pickOr(Winner,R,Best,Rest).
pickOr(P,Q,Winner,Loser) :-
   !,
   order2(P,Q,Winner,Loser).

% order2(P,Q,Best,SecondBest)
order2(P,Q,P,Q) :- prefer(P,Q),!.
order2(P,Q,Q,P) :- 
  prefer(Q,P),
  !,
  dbug("I prefer ~p to ~p.~n",[Q,P]).
order2(P,Q,P,Q).

% put conjunction or disjunction in right-branching form.
straighten(((P and Q) and R), X) :- 
  !,
  straighten((P and (Q and R)), X).
straighten(((P or Q) or R), X) :- 
  !,
  straighten((P or (Q or R)), X).
straighten(X,X).