%-- libcompat.pro
%-- compatibility module, implements non-ISO predicates for (partial) compatibility
%-- with other Prologs, e.g. SICStus and (to some extent) SWI-Prolog.

%-- Written by: John Cullen
%-- © 2003 Porto Editora, Lda. All Rights Reserved.
%-- Note, code is supplied "AS IS" without warranty of any kind, either
%-- express or implied. Basically it works for me, but your km'age may vary :-)
%-- Bug reports/corrections/additions appreciated! Send them to: jjcullen@yahoo.com

:- ensure_loaded(list).
:- import(list).

%-- define the data module for holding references etc. Keeps the working database "cleaner".
:- module(data).
:- body(data).
:- end_body(data).
:- end_module(data).

:- module(libcompat).
:- export([
			if/3,
			current_predicate/2,
			memberchk/2,
			refassert/2,
			refasserta/2,
			refassertz/2,
			clause/3,
			instance/2,
			recorda/3,
			recordz/3,
			recorded/3,
			erase/1,
			abolish/2,
			on_exception/3,
			usort/2,
			undup/2,
			prolog_flag/2,
			prolog_flag/3,
			format/2,
			format/3
		  ]).

%-- reference data has the form: data__(Ref, Key, Term)
:- indexed data__(1, 1, 0).

%-- Amzi! equivalent of SICStus if/3 and SWI-Prolog *->/2;/1 backtracking IF/THEN/ELSE construct.
%-- if(+If, +Then, +Else)
if(If, Then, Else) :-
	gensym(sol, X),						% generate a tracking number so we know which if is being called
	assert(data:if3_no(X)),					% checkpoint
	if0(If, Then, Else, data:if3_no(X)).		% do the work

if0(If, Then, Else, X) :-
	call(If),
	retractall(X),						% if succeeded at least once, remove the no solution checkpoint
	call(Then).							% results.

if0(If, Then, Else, X) :-
	(X),								% if the 'no solution' checkpoint exists, the if failed.
	retract(X),
	call(Else).							% results.

% ------------------------------------------------------------------------------
% implementation of current_predicate/2 for Amzi! Prolog (JCullen, 2002-12-19).
% ------------------------------------------------------------------------------

%-- current_predicate(?Name, :Head)
%-- current_predicate(?Name, -Head)
current_predicate(Name, Head) :-
	current_module(Module),
	current_predicate(Module:Name/Arity),
	functor(Head, Name, Arity).


% ------------------------------------------------------------------------------
% memberchk/2.
% ------------------------------------------------------------------------------

memberchk(Element, [Element|_]) :- !.
memberchk(Element, [_|Rest]) :-
	memberchk(Element, Rest).


% ------------------------------------------------------------------------------
% Implementations of:
% assert(:Clause, -Ref); (as refassert/2)
% record(+Key,+Term,-Ref);
% recorded(?Key,-Term,?Ref);
% instance(+Ref,?Term);
% clause(:Head,?Body,?Ref);
% clause(?Head,?Body,+Ref).
% erase(+Ref).
% ------------------------------------------------------------------------------

% assert(:Clause,-Ref)
refassert(Term, Ref) :- refassertz(Term, Ref).
refasserta(Term, Ref) :- asserta((Term)), makeref(asserta, Ref, Term, Ref).
refassertz(Term, Ref) :- assertz((Term)), makeref(assertz, Ref, Term, Ref).

% record(+Key, ?Term, -Ref)
recorda(Key, Term, Ref) :- makeref(asserta, Key, Term, Ref).
recordz(Key, Term, Ref) :- makeref(assertz, Key, Term, Ref).

% recorded(?Key, ?Term, ?Ref) - variable Key
recorded(Key, Term, Ref) :-
	var(Key),
	data:data__(Ref, Key, Term),
	Key \= Ref.

% recorded(?Key, ?Term, ?Ref) - non-variable Key
recorded(Key, Term, Ref) :-
	nonvar(Key), functor(Key, SimpleKey, _),
	data:data__(Ref, SimpleKey, Term),
	SimpleKey \= Ref.

% makeref(+Assert, +Key, +Term, -Ref)
makeref(Assert, Key, Term, Ref) :-
	gensym(ref__, Ref),
	functor(Key, SimpleKey, _),
	Goal =.. [Assert, data:data__(Ref, SimpleKey, (Term))],
	call(Goal).

% clause(:Head,?Body,?Ref);
clause(Head, Body, Ref) :-
	nonvar(Head),
	clause(Head, Body),
	(data:data__(Ref, Ref, ((Head:-Body))) -> true;true).

% clause(?Head,?Body,+Ref).
clause(Head, Body, Ref) :-
	var(Head),
	nonvar(Ref),
	(data:data__(Ref, Ref, ((Head:-Body))) -> true;true).

% instance(+Ref, ?Term)
instance(Ref, Term) :-
	data:data__(Ref, Ref, (Term)).

% erase(+Ref)
erase(Ref) :-
	data:data__(Ref, Key, Term),
	retract(data:data__(Ref, Key, (Term))),
	(Ref == Key -> retract((Term));true).


% abolish(:Name, +Arity)
abolish(Name, Arity) :- abolish((Name/Arity)).

% on_exception(?Pattern, :ProtectedGoal, :Handler)
on_exception(Pattern, Goal, Handler) :- catch(Goal, Pattern, Handler).

% usort(+List1,?List2) - sort and remove duplicates
usort(In, Out) :-
	sort(In, Tmp),
	undup(Tmp, Out).

% undup(+List,?Pruned) - remove duplicate entries from a from a SORTED list.
% note, use remove_dups in the lists library for unsorted lists.
undup([], []).
undup([X, X1|Y], Undup) :-
   X == X1, !,
   undup([X|Y], Undup).
undup([X|Y], [X|Rest]) :-
   undup(Y, Rest).

% remove_duplicates(+List, ?Pruned)
remove_duplicates(List, Pruned) :- remove_dups(List, Pruned).

% prolog_flag(?FlagName, ?Value)
prolog_flag(FlagName, Value) :- current_prolog_flag(FlagName, Value).

% ignore undefined flags.
prolog_flag(_,_).

% prolog_flag(+FlagName, ?OldValue, ?NewValue) - note, always succeeds for undefined flags.
prolog_flag(FlagName, OldValue, NewValue) :-
	prolog_flag(FlagName, OldValue),
	catch(set_prolog_flag(FlagName, NewValue), _, true).


%-- MINIMAL implementation of SICStus format/{2,3}
format(Format, Args) :-
	current_output(Stream),
	format(Stream, Format, Args).

% convert list of atoms to an atom for printing.
format(Stream, Format, []) :-
	is_list(Format),
	!,
	atom_codes(Atom, Format),
	write(Stream, Atom).

% print a string.
format(Stream, Format, []) :-
	!,
	write(Stream, Format).

% ignore format characters and simply print.
format(Stream, Format, [Args]) :-
	!,
	format(Stream, Format, []),
	format(Stream, Args, []).


:- end_module(libcompat).