/* File:      flrstorage.P
**
** Author(s): Guizhen Yang 
**
** 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.
** 
** 
*/


:- compiler_options([xpp_on]).

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


:- import
	flora_error_line/1,
	flora_error_line/2,
	flora_error_heading/0,
	flora_stderr_string/1,
	flora_stderr_nl/0
   from flrprint.

:- import flora_display_error/1 from flrdisplay.

:- import
	flora_module_name/3,
	flora_module_name_error/1,
	flora_fdb_storage_name/2,
	flora_decode_module_name/2,
	flora_module_predicate/4
   from flrwrapper.

:- import
	FLSYSDBUPDATE/2,
	FLLIBMODLIT/3,
	FLLIBMODOBJ/4
   from usermod.

:- export
	flora_storage_check_module_name/1,
	flora_storage_check_deletepredicate/2,
	flora_storage_convertlist/3,
	flora_storage_is_negation_symbol/1.


/*****************************************************************************
  flora_storage_check_module_name(+ModuleName)

  The procedure is called to checks if a module name is valid during an update
  operation. Note that updating a Flora system module is not allowed.
*****************************************************************************/
flora_storage_check_module_name(ModuleName) :-
	flora_module_name(ModuleName,Type,WS),
	!,
	( Type == invalid ->
	    flora_module_name_error(ModuleName),
	    throw(FLORA_ABORT)

	; Type == systemmodule ->
	    flora_error_line("Updates to system modules (~w) are not allowed",
	                     [WS]),
	    throw(FLORA_ABORT)
	;
	  true
	).


/*****************************************************************************
  flora_storage_check_deletepredicate(+P,-UpdateStruct)

  It is used to call a predicate in the list of literals to be deleted.
  It supports the meta-programming feature of delete where a variable is
  used to pass the predicate.

  Note: If the variable is bound to a conjunction, then it will be broken up
        accordingly into a nested list structure. This feature is defferent
        from Prolog which does not treat conjunction any diferently from
        other builtin predicates. However, deletion of disjunction or negation
        is not allowed.
*****************************************************************************/
flora_storage_check_deletepredicate(P,_UpdateStruct) :-
	var(P),
	!,
	flora_error_line('uninstantiated argument of delete operation'),
	throw(FLORA_ABORT).

flora_storage_check_deletepredicate(','(C1,C2),[P1,P2]) :-
	!,
	%% Break up conjunction, although deletion of conjunction is not
	%% allowed in XSB.
	flora_storage_check_deletepredicate(C1,P1),
	flora_storage_check_deletepredicate(C2,P2).

flora_storage_check_deletepredicate(P,FLSYSDBUPDATE(P,StorageName)) :-
	%% This is a meta programming feature.
	functor(P,F,N),
	( flora_decode_module_name(F,ModuleName) ->
	    flora_storage_check_module_name(ModuleName),
	    flora_fdb_storage_name(ModuleName,StorageName),
	    FLORA_DB_FIND(StorageName,P)

	; N == 2, F == ';' ->
	    flora_error_line('Deletion of disjunction is not allowed!'),
	    throw(FLORA_ABORT)

	; N == 1, flora_storage_is_negation_symbol(F) ->
	    flora_error_line('Deletion of negated facts is not allowed!'),
	    throw(FLORA_ABORT)
	;
	  flora_error_heading,
	  flora_stderr_string('Deletion of '),
	  ( F == WRAP_HILOG ->
	      flora_stderr_string('HiLog term ')
	  ;
	    flora_stderr_string('Prolog term ')
	  ),
	  flora_display_error(P),
	  flora_stderr_string(' is not allowed!'),
	  flora_stderr_nl,
          throw(FLORA_ABORT)
	).


/*****************************************************************************
  flora_storage_convertlist(+List,-CallList,-FactList)
*****************************************************************************/
flora_storage_convertlist([],[],[]) :- !.

flora_storage_convertlist([P|Fs],
	                  [flora_storage_check_deletepredicate(P,UpdateStruct)|CL],
			  [UpdateStruct|FL]) :-
	var(P),
	!,
	%% This is a meta-programming feature.
	flora_storage_convertlist(Fs,CL,FL).

flora_storage_convertlist([FLSYSDBUPDATE(P,StorageName)|Fs],
                          [FLORA_DB_FIND(StorageName,P)|CL],
			  [FLSYSDBUPDATE(P,StorageName)|FL]) :-
	!,
	flora_storage_convertlist(Fs,CL,FL).

flora_storage_convertlist([FLLIBMODLIT(F,Args,ModuleName)|Fs],
                          [flora_storage_check_module_name(ModuleName),
			   flora_module_predicate(F,Args,ModuleName,P),
			   flora_fdb_storage_name(ModuleName,StorageName),
                           FLORA_DB_FIND(StorageName,P)|CL
			  ],
			  [FLSYSDBUPDATE(P,StorageName)|FL]) :-
	!,
	flora_storage_convertlist(Fs,CL,FL).

flora_storage_convertlist([FLLIBMODOBJ(F,Args,ModuleName,O)|Fs],
                          [( flora_check_module_name(ModuleName) ->
			       flora_module_predicate(F,Args,ModuleName,O)
			   ;
			     throw(FLORA_ABORT)
			   )|CL],
			  FL) :-
	!,
	flora_storage_convertlist(Fs,CL,FL).

flora_storage_convertlist([P|Fs],
	                  [flora_storage_check_deletepredicate(P,UpdateStruct)|CL],
			  [UpdateStruct|FL]) :-
	%% This is a meta-programming feature.
	flora_storage_convertlist(Fs,CL,FL).


/*****************************************************************************
  flora_storage_is_negation_symbol(+Functor)
*****************************************************************************/
flora_storage_is_negation_symbol('\+').
flora_storage_is_negation_symbol(not).
flora_storage_is_negation_symbol(tnot).
flora_storage_is_negation_symbol(FLORA_TNOT_PREDICATE).