:- ensure_loaded(common).
cvs_id('$Id: persistence.pl,v 1.5 2004/09/15 19:30:15 sandro Exp $').
/*

  Make some prolog predicates persistent, backed by library(db).

  Use like:

        :- persistent(my_pred/4).

        :- persistent(my_pred(term, term, int)).

        special forms:  key is c_string, value is int

  and probably:

       ?? persistence_set(home('/tmp')).   # not very persistent!

pl -g '[config_data, app_config, argv], handle_argv, [persistence], app_db_init, persistent_term_index_open.' -- --sandbox /home/sandro/semwalker/sandbox

   persistent(foo/2).
   passert(foo(a,b)).
   foo(X,Y).
  
  
*/

%:- module(persistence,
%	  [ persistent/1,           % +Predicate/Arity
%	    persistent/2,           % +Predicate/Arity, [Options]
%	                            %     Options:  [duplicates(true)]
%	    close_all/0
%	  ]).


%   SOMEONE ELSE NEEDS TO INIT THESE ANYWAY.....
% :- ensure_loaded(persistent_term_index).
% :- ensure_loaded(db).

:- thread_local(handle_state/3).
:- dynamic(persistence_options/3).
:- multifile(persistence_options/3).

persistent(Predicate/Arity) :-
	persistent(Predicate/Arity, []).

persistent(Predicate/1, Options) :-
	p_types(Options, KeyType, ValueType, interned_term, c_long, O2),
	assert(persistence_options(Predicate, 1, O2)),
	Head =.. [Predicate, Key],
	assert(( Head :- persistent_predicate(Predicate, 1, Key, 1, KeyType, ValueType) )). 
persistent(Predicate/2, Options) :-
	p_types(Options, KeyType, ValueType),
	assert(persistence_options(Predicate, 2, Options)),
	Head =.. [Predicate, Key, Value],
	assert(( Head :- persistent_predicate(Predicate, 2, Key, Value, KeyType, ValueType) )).
persistent(Predicate/Arity, Options) :-
	p_types(Options, KeyType, ValueType),
	assert(persistence_options(Predicate, Arity, Options)),
	Arity > 2,
	length(Args, Arity),
	Head =.. [Predicate | Args],
	Args = [Key | Values],
	Value =.. [values | Values],
	assert(( Head :- persistent_predicate(Predicate, Arity, Key, Value, KeyType, ValueType) )).

% using  compile_predicates([Predicate/Arity]). would be nice, but
% I run afoul of the "logical update view", I think.

persistent_predicate(Predicate, Arity, Key, Value, KeyType, ValueType) :-
	var(Key),
	!,
	persistence_handle(Predicate, Arity, D),
	db_enum(D, KeyStored, ValueStored),
	% repeated, but db_enum traps us.  we need dn_enum_keys
	p_map_type(Key, KeyStored, KeyType),
	p_map_type(Value, ValueStored, ValueType).
persistent_predicate(Predicate, Arity, Key, Value, KeyType, ValueType) :-
	ground(Key),
	!,
	persistence_handle(Predicate, Arity, D),
	p_map_type(Key, KeyStored, KeyType),
	db_get(D, KeyStored, ValueStored),
	p_map_type(Value, ValueStored, ValueType).

persistence_handle(Predicate, Arity, DatabaseHandle) :-
	(   handle_state(Predicate, Arity, DatabaseHandle)
	->  true
	;   persistence_options(Predicate, Arity, Options),
	    app_db_init,
	    concat_atom([Predicate, Arity], '__', PredicateFile),
	    p_types(Options, _KeyType, _ValueType,
		    interned_term, interned_term, Options2),
	    maplist(types_for_db, Options2, Options3),
	    db_open(PredicateFile, update, DatabaseHandle, Options3),
	    debug(pers, '~q', [db_open(PredicateFile, update, DatabaseHandle, Options3)]),
	    assert(handle_state(Predicate, Arity, DatabaseHandle))
	).

types_for_db(key(interned_term), key(c_long)) :- !.
types_for_db(value(interned_term), value(c_long)) :- !.
types_for_db(X, X).

persistence_close_all :-
	(
	  retract(handle_state(_Predicate, _Arity, DatabaseHandle)),
	  db_close(DatabaseHandle),
	  fail
	; true
	).


%%
%%  Intercept assert/1, retract/1, retractall/1 when operating
%%  on persistent predicates.
%%
%%      ==> not sure how to get this to work; the syntax
%%          "system:assert" actually means to assert into
%%          the "system" module.
%%          

/*
:- redefine_system_predicate(assert(_)).
:- redefine_system_predicate(retract(_)).
:- redefine_system_predicate(retractall(_)).

assert(Clause) :-
	functor(Clause, Functor, Arity),
	(   persistence_options(Functor, Arity, _)
	->  persistence_predicate_assert(Clause)
	;   system:assert(Clause)
	).

retract(Clause) :-
	functor(Clause, Functor, Arity),
	(   persistence_options(Functor, Arity, _)
	->  persistence_predicate_retract(Clause)
	;   system:retract(Clause)
	).


retractall(Clause) :-
	functor(Clause, Functor, Arity),
	(   persistence_options(Functor, Arity, _)
	->  persistence_predicate_retractall(Clause)
	;   system:retractall(Clause)
	).
*/

passert(Clause) :-
	functor(Clause, Predicate, Arity),
	persistence_options(Predicate, Arity, Options),
	Clause =.. [Predicate, Key | Values],
	(   Arity = 1
	->  Value = 1
	;   (   Arity = 2
	    ->  [Value] = Values
	    ;   Value =.. [values | Values]
	    )
	),
	p_types(Options, KeyType, ValueType),
	p_map_type(Value, ValueStored, ValueType),
	p_map_type(Key, KeyStored, KeyType),
	persistence_handle(Predicate, Arity, D),
	db_put(D, KeyStored, ValueStored).

pretractall(Clause) :-
	functor(Clause, Predicate, Arity),
	persistence_options(Predicate, Arity, Options),
	Clause =.. [Predicate, Key | Values],
	(   Arity = 1
	->  Value = 1
	;   (   Arity = 2
	    ->  [Value] = Values
	    ;   Value =.. [values | Values]
	    )
	),
	p_types(Options, KeyType, ValueType),
	p_map_type(Key, KeyStored, KeyType),
	persistence_handle(Predicate, Arity, D),
	(   var(KeyStored)
	->  forall( (   db_enum(D, KeyStored, ValueStored),
			p_map_type(Value, ValueStored, ValueType)
		    ),
		    db_del(D, KeyStored, ValueStored)
		  )
	;   db_delall(D, KeyStored, _)
	).
 
p_map_type(V, V, _) :-
	\+ ground(V).
p_map_type(Term, Stored, interned_term) :-
	!, 
	persistent_term_index(Term, Stored).
p_map_type(X, X, Type) :-
	Type \= term.


p_types(Options, KeyType, ValueType) :-
	p_types(Options, KeyType, ValueType, interned_term, interned_term, _).

p_types(Options, KeyType, ValueType, KeyTypeDefault, ValueTypeDefault, OptionsOut) :-
	(   memberchk(key(KeyType), Options)
	->  O1 = Options
	;   KeyType=KeyTypeDefault,
	    O1 = [key(KeyType) | Options]
	),
	(   memberchk(value(ValueType), Options)
	->  OptionsOut = O1
	;   ValueType=ValueTypeDefault,
	    OptionsOut = [value(ValueType) | Options]
	).

persistence_delete_file(Predicate/Arity) :-
	db_dir(DB_Dir),
	concat_atom([DB_Dir, '/', Predicate, '__', Arity], Filename),
	(   exists_file(Filename)
        ->  delete_file(Filename)
        ;   true
        ).

%%   See test_persistence.pl for test cases

