% File: kassert.pl
% Author: Peter Clark
% Purpose: Implementation of an assertn-like predicate in Prolog (!)
% Date: revised Feb 1992, tidied June 1992

:- ensure_loaded([utils]).

/* 
Implementation of an assert-like db, but also supporting an assertn-like pred.

NOTE: 
-----
   1. It is not necessary to understand this code in order to understand LPE.
      All you need to know is that mentioned under "the kassert database" in 
      lpe.doc.
   2. For completeness, this file also defines a few extra predicates not used
      by LPE.

Layout of the kassert.pl:
-------------------------
This file contains two `layers'
       1. Implementation of doubly-linked lists in Prolog
       2. Predicates defining a kassert database, analagous to Prolog's
          assert database, but supporting kassertn as well as kasserta and
          kassertz. This uses the doubly-linked lists.
See kassert.doc for detailed documentation.

% ======================================================================
%		LAYER ONE: DOUBLY-LINKED LISTS IN PROLOG
% ======================================================================
Predicates:
   new_chain(+StartKey)		   Create a new `anchor' link with key Key
   start_chain(+StartKey)	   Same, but no error if anchor already exists
   follow_chain(+StartKey, -Key, -Data).      Look for Data from StartKey on
   insert_before(+Key, +Term)      insert Term before the Term with Key
   insert_after(+Key, +Term)       insert Term after the Term with Key
   link_data(?Key, ?Data)	   find the Data with key Key
   delete_link(+Key, ?Data)        delete Data with key Key from the list
   show_chain_and_keys(+StartKey)  write out the entire linked list
   show_chain(+StartKey)    	   same, but just display the data items
   delete_chain(+StartKey)	   delete the chain starting with StartKey
*/

:- dynamic link/4.

% new_chain(+StartKey). 
% Creates the initial `anchor' link for a chain indexed by StartKey
new_chain(StartKey) :-
	link(StartKey, _, _, _),
	!,
	write('ERROR! Start key '),write(StartKey),write(' is already used!'), 
	nl, fail.
new_chain(StartKey) :-
	gensym(k, NextKey),
	assertz( link(StartKey,nil,NextKey,start) ),
	!.

% --------------------

% start_chain(+StartKey).
% Checks that a chain anchored by StartKey exists, and if not creates one
start_chain(StartKey) :-
	link(StartKey, _, _, _),
	!.
start_chain(StartKey) :-
	gensym(k, NextKey),
	assertz( link(StartKey,nil,NextKey,start) ),
	!.

% --------------------

% follow_chain(+StartKey, -Key, -Data)
% The main predicate for accessing the linked list data.
% Follow the chain from StartKey, returning the Data and Key of items
% encountered. On backtracking, look further down the chain.

follow_chain(StartKey, FoundKey, Data) :-
	link(StartKey, _, NextKey, _),
	follow_chain2(NextKey, FoundKey, Data).

follow_chain2(Key, FoundKey, FoundData) :-
	link(Key, _, NextKey, Data),
	( FoundKey = Key, FoundData = Data
	; follow_chain2(NextKey, FoundKey, FoundData) ).

% ======================================================================
%	INSERTION OF NEW ITEMS IN THE MIDDLE OF THE LINKED LIST
% ======================================================================

/* insert_before(+Key, +Term)      insert Term before the Term with Key
   insert_after(+Key, +Term)       insert Term after the Term with Key

eg.    insert_before(k2, newd)   } equivalent
       insert_after( k1, newd)   }		

NOTE: Rather than simply assigning a new key to the new data, we are a bit
more sophisticated: the new data *steals* the key KNext of the data D 
immediately following the insertion point, and a new key is created for D 
instead. This is done to preserve the link from KPrev to KNext, "remembered" 
by follow_chain/3, so that follow_chain/3 has correct behaviour on 
backtracking.
         OLD LINKED LIST                        NEW LINKED LIST
   k1-d1, k2-d2, k3-d3, k4-d4  =>  k1-d1, k2-newd, newk-d2, k3-d3, k4-d4
*/

insert_after(Key, Data) :-
	link(Key, _, NKey, _), !,
	insert_between(Key, NKey, Data).
insert_after(Key, _) :-
	write('ERROR! No such link '), write(Key), write('!'), nl, fail.

insert_before(NKey, Data) :-
	link(Key, _, NKey, _), !,
	insert_between(Key, NKey, Data).
insert_before(NKey, _) :-
	write('ERROR! No predecessor of link '), write(NKey), write('!'), nl,
	fail.

% below P=previous, N=next, eg. above PKey,NKey,NNKey,NNNKey = k1,k2,k3,k4
insert_between(PKey, NKey, Data) :-
	gensym(k, NewKey),
	( retract( link(NKey,PKey,NNKey,NData) ) -> % maybe change NextKey..
	  assertz( link(NewKey,NKey,NNKey,NData) ),
	  ( retract( link(NNKey,NKey,NNNKey,NNData) ) ->  % and NextNextKey
	    assertz( link(NNKey,NewKey,NNNKey,NNData) ) 
	  ; true )
        ; true ),
	assertz( link(NKey,PKey,NewKey,Data) ).

% --------------------

% link_data(?Key, ?Data).    Find the Data with key Key
link_data(Key, Data) :- link(Key, _, _, Data).

% --------------------

% delete_link(+Key, ?Data)	
% Delete the data Data with key Key in the linked list
delete_link(Key, Data) :-
	retract( link(Key,PrevKey,NextKey,Data) ),
	!,
	retract( link(PrevKey,PrevPrevKey,    Key,PrevData) ),
	assertz( link(PrevKey,PrevPrevKey,NextKey,PrevData) ),
	( retract( link(NextKey,    Key,NextNextKey,NextData) ) ->
	  assertz( link(NextKey,PrevKey,NextNextKey,NextData) ) ; true ).
delete_link(Key, _) :-
	write('ERROR! No such link '), write(Key), 
	write(' to delete!'), nl, fail.	

% --------------------

delete_chain(StartKey) :-
	retract( link(StartKey,_,NextKey,_) ),
	!,
	delete_chain(NextKey).
delete_chain(_).

% -------------------- Display routines --------------------

% show_chain_and_keys(+StartKey)
show_chain_and_keys(StartKey) :-
	follow_chain(StartKey, Key, Data),
	write(Key), write('	'), pretty_write(Data), write('.'), nl,
	fail.
show_chain_and_keys(_).

show_chain(StartKey) :-
	follow_chain(StartKey, _, Data),
	pretty_write(Data), write('.'), nl,
	fail.
show_chain(_).

% ======================================================================
%	LAYER TWO: DEFINITIONS FOR THE KASSERT DATABASE
% ======================================================================

/*
                ========================================
   kcall(+Term)		       % call Term
   kcall(+Term, -Key)	       % call Term, returning Key of succeeding clause

   kclause(?Head, ?Body)       % look up clausen in db
   kclause(?Head, ?Body, ?Key) % look up clausen with key Key in db
   kclause(?Head, ?Body, +StartKey, -Key) %look up clausen, starting from (but
    				         % *not* including clause at) StartKey

   next_kclause(+Key, -NextKey) % get key of clause following clause with Key

   kassertm(+Clause, +Key)	% assert Clause before the clause with Key
   kassertn(+Clause, +Key)	% assert Clause after the clause with Key
   kasserta(+Clause)		% assert Clause at start of k-db

   kretract(+Clause).		% retract Clause (Clause can contain vars)
   kretract(?Clause, +Key)	% retract the Clause with Key
   klisting(Funct/Ar)		% list clauses for Goal of given functor/arity
   kabolish(Funct/Ar)		% delete all clauses for Goal of functor/arity
                ========================================
*/

% (Find out the Key of clause then retract it)
kretract((H:-B)) :- !, kclause(H,    B, Key), kretract((H:-B), Key).
kretract( H    ) :- !, kclause(H, true, Key), kretract( H    , Key).
	
kretract((H:-B), Key) :- !, delete_link(Key, (H:-   B)).
kretract( H    , Key) :-    delete_link(Key, (H:-true)).

kassertm((H:-B), Key) :- !, insert_before(Key, (H:-   B)).
kassertm( H    , Key) :-    insert_before(Key, (H:-true)).

kassertn((H:-B), Key) :- !, insert_after(Key, (H:-   B)).
kassertn( H    , Key) :-    insert_after(Key, (H:-true)).

% (Find the startkey of clauses for H, then insert the clause at the start)
kasserta((H:-B)):- !,
	kstartkey(H, Key), start_chain(Key), insert_after(Key, (H:-   B)).
kasserta( H    ):-  
	kstartkey(H, Key), start_chain(Key), insert_after(Key, (H:-true)).

kcall(Term)      :- kcall(Term, _).
kcall(Term, Key) :- kclause(Term, Body, Key), call(Body).

kclause(Head, Body) :- kclause(Head, Body, _).

% [1]: directly look up link with Key
% [2]: follow the chain, returning each Head-Body-Key triple on backtracking
kclause(Head, Body, Key) :- nonvar(Key), !, link_data(Key, (Head:-Body)). %[1]
kclause(Head, Body, Key) :- kstartkey(Head, StartKey), 			  %[2]
			    kclause(Head, Body, StartKey, Key).

kclause(Head, Body, StartKey, Key) :- follow_chain(StartKey,Key,(Head:-Body)).

next_kclause(Key, NextKey) :- link(Key, _, NextKey, _).

% kstartkey(+Head, -Key): 
% Generate key to index the start of clauses for Head. Here the Key is
% the functor and arity of Head.
% This can be user re-defined if it suits him/her. (Quite useful for CSPs)
kstartkey(Head, F/A) :- functor(Head, F, A).

klisting(Key) :- show_chain(Key).
klisting_and_keys(Key) :- show_chain_and_keys(Key).
kabolish(Key) :- delete_chain(Key), start_chain(Key).

% --------------------

kassert_demo :-
	demo_goals([
		kabolish(f/1),
		kasserta(f(a)),
		kasserta(f(b)),
		klisting(f/1),
		kcall(f(X)) - [X/'X'] - allsolns,
		kcall(f(X),Key) - [X/'X',Key/'Key'] - allsolns,
		kclause(f(X),Body,Key) - [X/'X',Body/'Body',Key/'Key'] 
	    							- allsolns,
		klisting(f/1),
		( kclause(f(b),true,Key), kassertn(f(c),Key) ),
		klisting(f/1),
		( kclause(f(c),true,Key2), kassertn((f(d):-f(e)),Key2) ),
		klisting(f/1),
		kretract(f(b)),
		klisting(f/1),
		( kclause(f(d),_,Key4), kretract((f(c):-Body)),
			kassertn((f(c):-Body),Key4) ),
		klisting(f/1)
	]),
	write('End of demo!!'), nl, nl.