/* File:      flrhilogtable.P
**
** Author(s): Chang Zhao
**
** Contact:   flora-users@lists.sourceforge.net
**
** Copyright (C) The Research Foundation of SUNY, 1999-2001
** 
** FLORA-2 is free software; you can redistribute it and/or modify it under the
** terms of the GNU Library General Public License as published by the Free
** Software Foundation; either version 2 of the License, or (at your option)
** any later version.
** 
** FLORA-2 is distributed in the hope that it will be useful, but WITHOUT ANY
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
** FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
** more details.
** 
** You should have received a copy of the GNU Library General Public License
** along with FLORA-2; if not, write to the Free Software Foundation,
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**
** $Id: flrhilogtable.P,v 1.3 2003/06/18 07:01:37 kifer Exp $
**
*/


:- compiler_options([xpp_on]).


#include "flora_terms.flh"
#include "flora_exceptions.flh"

/****************************************************************************
  flora_reset_hilogtable/0
****************************************************************************/
flora_reset_hilogtable :-
	retractall(flora_hilogtable(_,_)),
	retractall(flora_not_tabled_head(_,_)).

/****************************************************************************
  flora_reset_table_registries(+ModuleName)
****************************************************************************/
flora_reset_table_registries(Module) :-
	retractall(flora_tabled_registry(Module,_,_)),
	retractall(flora_not_tabled_registry(Module,_,_)).


/****************************************************************************
  flora_define_hilogtable(+Functor,+Arity)
****************************************************************************/
flora_define_hilogtable(Functor,Arity) :-
    (var(Functor) ->
	    assert(flora_hilogtable(Functor,Arity))
    ;
	    (flora_hilogtable(Functor,Arity), ! ;
	    assert(flora_hilogtable(Functor,Arity)))
    ).

/****************************************************************************
  flora_shdefine_hilogtable(+Module,+Functor,+Arity)
****************************************************************************/
flora_shdefine_hilogtable(Module,Functor,Arity) :-
	flora_storage_check_module_name(Module),
	( flora_check_not_tabled_registry(Module,Functor,Arity) ->
	    flora_error_line('Unable to table predicates that already appear in rule heads'),
	    flora_abort
	;
	    flora_enter_tabled_registry(Module,Functor,Arity)
	).

/****************************************************************************
  flora_define_not_tabled_head(+Functor,+Arity)
****************************************************************************/
flora_define_not_tabled_head(Functor,Arity) :-
    ( var(Functor) ->
	    assert(flora_not_tabled_head(Functor,Arity))
    ;
	    (flora_not_tabled_head(Functor,Arity), ! ;
	    assert(flora_not_tabled_head(Functor,Arity)))
    ).

/****************************************************************************
  flora_check_tabled_registry(+ModuleName,+Functor,+Arity)
****************************************************************************/
flora_check_tabled_registry(Module,Pred,N) :-
    var(Pred), flora_tabled_registry(Module,P,N),var(P),!.
flora_check_tabled_registry(Module,Pred,N) :-
    atom(Pred), flora_tabled_registry(Module,Pred,N),!.
flora_check_tabled_registry(Module,_Pred,FL_SLASH(_M,N)) :-
    flora_check_tabled_registry(Module,_,N).

/****************************************************************************
  flora_check_not_tabled_registry(+ModuleName,+Functor,+Arity)
****************************************************************************/
flora_check_not_tabled_registry(Module,Pred,N) :-
    atom(Pred), flora_not_tabled_registry(Module,P,N), P==Pred, !.

flora_check_not_tabled_registry(Module,Pred,N) :-
    var(Pred), flora_not_tabled_registry(Module,Pred,N), !.

flora_check_not_tabled_registry(Module,Pred,N) :-
    var(Pred),
    flora_not_tabled_registry(Module,_P,FL_SLASH(_M,N1)),
    match(N,N1).

match(N,N) :- !.
match(N,FL_SLASH(_M,N1)) :- match(N,N1).

/****************************************************************************
  flora_enter_tabled_registry(+ModuleName,+Functor,+Arity)
****************************************************************************/
flora_enter_tabled_registry(Module,Pred,N) :-
	( var(Pred) ->
	    assert(flora_tabled_registry(Module,Pred,N))
	;
	    ( flora_tabled_registry(Module,Pred,N), !;
	      assert(flora_tabled_registry(Module,Pred,N)))
	).

/****************************************************************************
  flora_enter_not_tabled_registry(+ModuleName,+Functor,+Arity)
****************************************************************************/
flora_enter_not_tabled_registry(Module,Pred,N) :-
	( atom(Pred),flora_not_tabled_registry(Module,P,N),P==Pred ->
	    true
	;
	    ( var(Pred), no_matching_in_not_tabled_registry(Module,Pred,N) ->
		assert(flora_not_tabled_registry(Module,Pred,N))
	    ;
		true
	    )
	).

no_matching_in_not_tabled_registry(Module,Pred,N) :-
        flora_not_tabled_registry(Module,Pred,N),
        !,
        fail.

no_matching_in_not_tabled_registry(_M,_P,_N).

/****************************************************************************
  flora_table_info(+TermList)
  dump info about hilog predicates which are
	1) tabled
	2) not tabled and appear in some rule head
  to FTBFile
****************************************************************************/
flora_table_info(TermList) :-
	nl,
	writeln('%%%% Hilog table registries %%%%'),
	writeln(':- import flora_enter_tabled_registry/3, flora_enter_not_tabled_registry/3,flora_reset_table_registries/1 from flrhilogtable.'),
	writeln('?- flora_reset_table_registries(FLORA_THIS_MODULE_NAME).'),
	flora_write_entries(TermList),
	writeln('%%%% Hilog table registries end%%%%'),
	nl.

flora_write_entries([]) :- !.
flora_write_entries([H|L]) :-
	flora_write_entry(H),
	flora_write_entries(L).

flora_write_entry(Term) :-
        ( is_prdirective(Term,Direct), is_prtable(Direct,P,A) ->
            flora_write_atom('?- flora_enter_tabled_registry(FLORA_THIS_MODULE_NAME,'),
	    ( atom(P) ->
            flora_write_quoted_atom(P)
	    ;
		    write(_)
	    ),
            put(0',),
            write(A),
            flora_write_atom(').'),
            nl
	;
	    ( is_prrule(Term,Head,_Body) ->
		flora_write_rulehead(Head)
	    ;
		true
	    )
	).

flora_write_rulehead(Term) :-
	is_pratomlit(Term,A,_Index),
	!,
	( (flora_hilogtable(A,0);flora_not_tabled_head(A,0)) ->
	    true
	;
	    flora_define_not_tabled_head(A,0),
            flora_write_atom('?- flora_enter_not_tabled_registry(FLORA_THIS_MODULE_NAME,'),
            flora_write_quoted_atom(A),
            put(0',),
            write(0),
            flora_write_atom(').'),
            nl
	).
		 
flora_write_rulehead(Term) :-
	is_prtermlit(Term,FObj,M,_ObjList),
	!,
	get_fingerprint(FObj,M,WF,F,N,_VL),
	( check_tabled(F,N) ->
	    true
	;
	    ( atom(F),flora_not_tabled_head(F1,N),F1==F ->
		true
	    ;
		( var(F),flora_not_tabled_head(F,N) ->
		    true
		;

		    flora_define_not_tabled_head(F,N),
            	    flora_write_atom('?- flora_enter_not_tabled_registry(FLORA_THIS_MODULE_NAME,'),
            	    flora_write_struct(WF,FLBODYPREFIX),
            	    put(0',),
            	    write(N),
            	    flora_write_atom(').'),
            	    nl
	        )
	    )
	).

flora_write_rulehead(_Term) :- !.