:- use_module(dbug).
:- dynamic ifAdded/2, ifRemoved/2.

% define  =>  and   =/>  to be infix operators.

:- op(1050,xfx,'=>').
:- op(1050,xfx,'=/>').


% add(P) adds assertion P to database and triggers forward chaining rules.

add(P) :- clause(P,true), !.

add(P) :- 
  dbug("Adding ~p.~n",[P]),
  assert(P), 
  foreach(ifAdded(P,Actions), fcDo(Actions)).

fcDo(P) :- call(P).

% remove(P) removes P from database and triggers ifRemoved rules.

remove(P) :- 
  dbug("Removing ~p.~n",[P]),
  retract(P), 
  foreach(ifRemoved(P,Actions), call(Actions)).


% A=>B adds a forward chaining rule that will satisfy B whenever the
%  assertions in A have all been added to the database.

((P1,P2)=>Q) :- 
  !,
  (P1=>(P2=>Q)).


((P1;P2)=>Q) :- 
  !, 
  (P1=>Q), 
  (P2=>Q).


(P=>Q) :- 
  ifAdded(P,Q), 
  !.

(P=>Q) :- 
  assert(ifAdded(P,Q)),
  foreach(clause(P,true),fcDo(Q)).

% A=/>B adds a ifRemoved rule that will satisfy B whenever the
%  assertions in A have all been removed from the database.

((P1,P2)=/>Q) :- 
  !, 
  (P1=/>(P2=/>Q)).

((P1;P2)=/>Q) :- 
  !, 
  (P1=/>Q), 
  (P2=/>Q).

(P=/>Q) :- assert(ifRemoved(P,Q)).

foreach(Binder,Body) :- 
  call(Binder),
  once(Body),
  fail.
foreach(_,_).

% once(P) executes P only once. 
once(P) :- 
  call(P), 
  !.
