/* File: flrbtdbop.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 append/3 from basics.
:- import
flora_fdb_storage_name/2,
flora_check_module_name/1,
flora_decode_module_name/2,
flora_is_flogic_wrapper/3,
flora_setup_flogic_fact_wrapper/1,
flora_flogic_fact_wrapper/2
from flrwrapper.
:- import flora_list2conjunct/2 from flrutils.
:- import
flora_storage_check_module_name/1,
flora_storage_check_deletepredicate/2,
flora_storage_convertlist/3,
flora_storage_is_negation_symbol/1,
flora_storage_check_existence/1
from flrstorageutils.
:- import
flora_db_insert_base_bt/2,
flora_db_delete_base_bt/2,
flora_db_find_base/2
from flrstoragebase.
:- import
get_canonical_form/2,
convert_to_head_literal/2
from flrcanon.
:- import flora_refresh_tables/1 from flrtables.
:- import flora_abort/0, flora_abort/1 from flrutils.
:- import flora_decode_goal_as_atom/2 from flrdecode.
/*********************************************************************
This file is for the following backtrackable FLORA database operations:
btinsert, btinsertall, btdelete, btdeleteall, bterase, bteraseall.
*********************************************************************/
/*****************************************************************************
fllibbtinsert(+List)
*****************************************************************************/
FLLIBBTINSERT(List) :- FLLIBBTINSERT(List,true).
/*****************************************************************************
fllibbtinsert(+List,+Condition)
*****************************************************************************/
FLLIBBTINSERT(List,Condition) :-
call(Condition),
flora_storage_insertfacts_bt(List).
/*****************************************************************************
flora_storage_insertfacts_bt(+List)
*****************************************************************************/
flora_storage_insertfacts_bt([]) :- !.
flora_storage_insertfacts_bt([P|_T]) :-
var(P),
!,
flora_abort('Uninstantiated argument in btinsert{...}').
flora_storage_insertfacts_bt([FLSYSDBUPDATE(P,StorageName,Module)|T]) :-
!,
flora_storage_check_existence(Module),
flora_internal_db_insert_bt(StorageName,P),
flora_storage_insertfacts_bt(T).
flora_storage_insertfacts_bt([FLLIBMODLIT(F,Args,ModuleName)|T]) :-
!,
flora_storage_check_module_name(ModuleName),
get_canonical_form(FLLIBMODLIT(F,Args,ModuleName), (_,_,_,P)),
flora_fdb_storage_name(ModuleName,StorageName),
flora_internal_db_insert_bt(StorageName,P),
flora_storage_insertfacts_bt(T).
flora_storage_insertfacts_bt([FLLIBMODOBJ(F,Args,ModuleName,O)|T]) :-
!,
flora_check_module_name(ModuleName),
FLLIBMODOBJ(F,Args,ModuleName,O),
flora_storage_insertfacts_bt(T).
flora_storage_insertfacts_bt([','(C1,C2)|T]) :-
!,
%% Break up conjunction, although insertion of conjunction is not
%% allowed in XSB.
flora_storage_insertfacts_bt([C1,C2|T]).
flora_storage_insertfacts_bt([P|T]) :-
%% This is a meta programming feature, since a variable can appear
%% in the list of literals to be updated.
functor(P,F,N),
( flora_decode_module_name(P,ModuleName) ->
flora_storage_check_module_name(ModuleName),
flora_fdb_storage_name(ModuleName,StorageName),
convert_to_head_literal(P,HeadP),
flora_internal_db_insert_bt(StorageName,HeadP),
flora_storage_insertfacts_bt(T)
; N == 2, F == ';' ->
flora_decode_goal_as_atom(P,PA),
flora_abort(['Insertion of disjunctive information is not allowed, ',
PA])
; N == 1, flora_storage_is_negation_symbol(F) ->
flora_decode_goal_as_atom(P,PA),
flora_abort(['Insertion of negative information is not allowed, ',
PA])
;
flora_decode_goal_as_atom(P,PA),
( F == WRAP_HILOG ->
flora_abort(['Attempt to insert a HiLog term (non-fact), ',
PA])
;
flora_abort(['Attempt to insert a Prolog term (non-fact), ',
PA])
)
).
/*****************************************************************************
fllibbtinsertall(+List)
*****************************************************************************/
FLLIBBTINSERTALL(List) :- FLLIBBTINSERT(List).
/*****************************************************************************
fllibbtinsertall(+List,+Condition)
*****************************************************************************/
FLLIBBTINSERTALL(List,Condition) :-
findall(List,Condition,FsList),
!,
flora_btinsertall_facts(FsList).
/*****************************************************************************
flora_btinsertall_facts(+FactsList)
Note: This predicate always succeeds.
*****************************************************************************/
flora_btinsertall_facts([]) :- !.
flora_btinsertall_facts([Fs|FL]) :-
flora_storage_insertfacts_bt(Fs),
flora_btinsertall_facts(FL).
/*****************************************************************************
fllibbtdelete(+List)
*****************************************************************************/
FLLIBBTDELETE(List) :- FLLIBBTDELETE(List,true).
/*****************************************************************************
fllibbtdelete(+List,+Condition)
The semantics is such that all the literals in "List" must be base facts
in the storage to be deleted.
*****************************************************************************/
FLLIBBTDELETE([P],true) :-
var(P),
!,
flora_abort('Uninstantiated argument in btdelete{...}').
FLLIBBTDELETE([FLSYSDBUPDATE(P,StorageName,Module)],true) :-
!,
flora_storage_check_existence(Module),
flora_db_find_base(StorageName,P),
flora_internal_db_delete_bt(StorageName,P).
FLLIBBTDELETE([FLLIBMODLIT(F,Args,ModuleName)],true) :-
!,
flora_storage_check_module_name(ModuleName),
get_canonical_form(FLLIBMODLIT(F,Args,ModuleName), (_,_,_,P)),
flora_fdb_storage_name(ModuleName,StorageName),
!,
flora_db_find_base(StorageName,P),
flora_internal_db_delete_bt(StorageName,P).
FLLIBBTDELETE(List,Condition) :-
flora_storage_convertlist(List,CallList,FactList),
flora_list2conjunct([Condition|CallList],Goal),
!,
call(Goal),
flora_storage_deletelist_bt(FactList).
/*****************************************************************************
flora_storage_deletelist_bt(+List)
*****************************************************************************/
flora_storage_deletelist_bt([]) :- !.
flora_storage_deletelist_bt([FLSYSDBUPDATE(P,StorageName)|L]) :-
!,
convert_to_head_literal(P,HeadP),
flora_internal_db_delete_bt(StorageName,HeadP),
flora_storage_deletelist_bt(L).
flora_storage_deletelist_bt([H|L]) :-
!,
flora_storage_deletelist_bt(H),
flora_storage_deletelist_bt(L).
/*****************************************************************************
flora_storage_deleteall_bt(+Predicate,+StorageName)
Note: This predicate always succeeds.
*****************************************************************************/
flora_storage_deleteall_bt(P,StorageName) :-
findall(FLSYSDBUPDATE(P,StorageName),flora_db_find_base(StorageName,P),L),
!,
flora_storage_deletelist_bt(L).
/*****************************************************************************
fllibbtdeleteall(+List)
*****************************************************************************/
FLLIBBTDELETEALL(List) :- FLLIBBTDELETEALL(List,true).
/*****************************************************************************
fllibbtdeleteall(+List,+Condition)
The semantics is such that all the literals in "List" must be base facts
in the storage to be deleted. This call always succeeds.
*****************************************************************************/
FLLIBBTDELETEALL([P],true) :-
var(P),
!,
flora_abort('Uninstantiated argument in btdeleteall{...}').
FLLIBBTDELETEALL([FLSYSDBUPDATE(P,StorageName,Module)],true) :-
!,
flora_storage_check_existence(Module),
flora_storage_deleteall_bt(P,StorageName).
FLLIBBTDELETEALL([FLLIBMODLIT(F,Args,ModuleName)],true) :-
!,
flora_storage_check_module_name(ModuleName),
get_canonical_form(FLLIBMODLIT(F,Args,ModuleName), (_,_,_,P)),
flora_fdb_storage_name(ModuleName,StorageName),
!,
flora_storage_deleteall_bt(P,StorageName).
FLLIBBTDELETEALL(List,Condition) :-
flora_storage_convertlist(List,CallList,FactList),
flora_list2conjunct([Condition|CallList],Goal),
findall(FactList,Goal,FsList),
!,
flora_btdeleteall_facts(FsList).
/*****************************************************************************
flora_btdeleteall_facts(+FactList,-DeletedFactList)
Note: This predicate always succeeds.
*****************************************************************************/
flora_btdeleteall_facts([]) :- !.
flora_btdeleteall_facts([Fs|FL]) :-
flora_storage_deletelist_bt(Fs),
flora_btdeleteall_facts(FL).
/*****************************************************************************
fllibbterase(+List)
*****************************************************************************/
FLLIBBTERASE(List) :- FLLIBBTERASE(List,true).
/*****************************************************************************
fllibbterase(+List,+Condition)
*****************************************************************************/
FLLIBBTERASE(List,Condition) :-
flora_storage_convertlist(List,CallList,FactList),
flora_list2conjunct([Condition|CallList],Goal),
call(Goal),
flora_storage_deletelist_bt(FactList),
flora_bterase_facts(FactList).
/*****************************************************************************
flora_bterase_facts(+List)
*****************************************************************************/
flora_bterase_facts([]) :- !.
flora_bterase_facts([FLSYSDBUPDATE(P,StorageName)|Fs]) :-
!,
flora_bterase_one_fact(P,StorageName),
flora_bterase_facts(Fs).
flora_bterase_facts([H|Fs]) :-
!,
flora_bterase_facts(H),
flora_bterase_facts(Fs).
/*****************************************************************************
flora_bterase_one_fact(+Fact,+StorageName)
Note: For an F-logic fact this predicate continues to trace links and
delete other F-logic facts. It always succeeds. Works for
Flora user modules and system modules.
*****************************************************************************/
flora_bterase_one_fact(Fact,StorageName) :-
Fact =.. [Funct|Args],
( flora_is_flogic_wrapper(Funct,ModuleName,Base) ->
( Base == WRAP_ISA -> Args=[O,_C]
; Base == WRAP_SUB -> Args=[O,_C]
; Base == WRAP_FD -> Args=[_S,_A,O]
; Base == WRAP_MVD -> Args=[_S,_A,O]
; Base == WRAP_IFD -> Args=[_S,_IA,O]
; Base == WRAP_IMVD -> Args=[_S,_IA,O]
; Base == WRAP_METH -> Args=[O,_M]
; Base == WRAP_IMETH -> Args=[O,_IM]
; Base == WRAP_EXISTS -> Args=[O]
; Base == WRAP_MVDDEF -> Args=[O,_A]
; Base == WRAP_IMVDDEF -> Args=[O,_IA]
; Base == WRAP_TRAN -> Args=[O,_T]
; Base == WRAP_FDSIG -> Args=[_S,_AS,O]
; Base == WRAP_IFDSIG -> Args=[_S,_IAS,O]
; Base == WRAP_MVDSIG -> Args=[_S,_AS,O]
; Base == WRAP_IMVDSIG -> Args=[_S,_IAS,O]
)
;
true
),
!,
( var(O) ->
true
;
flora_setup_flogic_fact_wrapper(ModuleName),
flora_bterase_objects([O],StorageName)
).
/*****************************************************************************
flora_bterase_objects(+ObjectList,+StorageName)
*****************************************************************************/
flora_bterase_objects([],_StorageName) :- !.
flora_bterase_objects([O|OList],StorageName) :-
!,
flora_flogic_fact_wrapper(WRAP_ISA,WSBisa),
flora_flogic_fact_wrapper(WRAP_SUB,WSBsub),
flora_flogic_fact_wrapper(WRAP_METH,WSBmeth),
flora_flogic_fact_wrapper(WRAP_IMETH,WSBimeth),
flora_flogic_fact_wrapper(WRAP_TRAN,WSBtran),
flora_flogic_fact_wrapper(WRAP_FD,WSBfd),
flora_flogic_fact_wrapper(WRAP_IFD,WSBifd),
flora_flogic_fact_wrapper(WRAP_FDSIG,WSBfdsig),
flora_flogic_fact_wrapper(WRAP_IFDSIG,WSBifdsig),
flora_flogic_fact_wrapper(WRAP_MVD,WSBmvd),
flora_flogic_fact_wrapper(WRAP_IMVD,WSBimvd),
flora_flogic_fact_wrapper(WRAP_MVDSIG,WSBmvdsig),
flora_flogic_fact_wrapper(WRAP_IMVDSIG,WSBimvdsig),
flora_flogic_fact_wrapper(WRAP_EXISTS,WSBexists),
flora_flogic_fact_wrapper(WRAP_MVDDEF,WSBmvddef),
flora_flogic_fact_wrapper(WRAP_IMVDDEF,WSBimvddef),
Wfd =.. [WSBfd,O,_,X],
Wifd =.. [WSBifd,O,_,X],
Wfdsig =.. [WSBfdsig,O,_,X],
Wifdsig =.. [WSBifdsig,O,_,X],
Wmvd =.. [WSBmvd,O,_,X],
Wimvd =.. [WSBimvd,O,_,X],
Wmvdsig =.. [WSBmvdsig,O,_,X],
Wimvdsig =.. [WSBimvdsig,O,_,X],
findall(X,( flora_db_find_base(StorageName,Wfd)
; flora_db_find_base(StorageName,Wifd)
; flora_db_find_base(StorageName,Wfdsig)
; flora_db_find_base(StorageName,Wifdsig)
; flora_db_find_base(StorageName,Wmvd)
; flora_db_find_base(StorageName,Wimvd)
; flora_db_find_base(StorageName,Wmvdsig)
; flora_db_find_base(StorageName,Wimvdsig)
),
AddedOList
),
append(OList,AddedOList,NewOList),
sort(NewOList,NextOList),
Pisa =.. [WSBisa,O,_],
Psub =.. [WSBsub,O,_],
Pmeth =.. [WSBmeth,O,_],
Pimeth =.. [WSBimeth,O,_],
Ptran =.. [WSBtran,O,_],
Pfd =.. [WSBfd,O,_,_],
Pifd =.. [WSBifd,O,_,_],
Pfdsig =.. [WSBfdsig,O,_,_],
Pifdsig =.. [WSBifdsig,O,_,_],
Pmvd =.. [WSBmvd,O,_,_],
Pimvd =.. [WSBimvd,O,_,_],
Pmvdsig =.. [WSBmvdsig,O,_,_],
Pimvdsig =.. [WSBimvdsig,O,_,_],
Pexists =.. [WSBexists,O],
Pmvddef =.. [WSBmvddef,O,_],
Pimvddef =.. [WSBimvddef,O,_],
!,
flora_storage_deleteall_bt(Pisa,StorageName),
flora_storage_deleteall_bt(Psub,StorageName),
flora_storage_deleteall_bt(Pmeth,StorageName),
flora_storage_deleteall_bt(Pimeth,StorageName),
flora_storage_deleteall_bt(Ptran,StorageName),
flora_storage_deleteall_bt(Pfd,StorageName),
flora_storage_deleteall_bt(Pifd,StorageName),
flora_storage_deleteall_bt(Pfdsig,StorageName),
flora_storage_deleteall_bt(Pifdsig,StorageName),
flora_storage_deleteall_bt(Pmvd,StorageName),
flora_storage_deleteall_bt(Pimvd,StorageName),
flora_storage_deleteall_bt(Pmvdsig,StorageName),
flora_storage_deleteall_bt(Pimvdsig,StorageName),
flora_storage_deleteall_bt(Pexists,StorageName),
flora_storage_deleteall_bt(Pmvddef,StorageName),
flora_storage_deleteall_bt(Pimvddef,StorageName),
flora_bterase_objects(NextOList,StorageName).
/*****************************************************************************
fllibbteraseall(+List)
*****************************************************************************/
FLLIBBTERASEALL(List) :- FLLIBBTERASEALL(List,true).
/*****************************************************************************
fllibbteraseall(+List,+Condition)
*****************************************************************************/
FLLIBBTERASEALL(List,Condition) :-
flora_storage_convertlist(List,CallList,FactList),
flora_list2conjunct([Condition|CallList],Goal),
findall(FactList,Goal,FsList),
!,
flora_btdeleteall_facts(FsList),
flora_bteraseall_facts(FsList).
/*****************************************************************************
flora_bteraseall_facts(+FactList)
Note: This predicate always succeeds.
*****************************************************************************/
flora_bteraseall_facts([]) :- !.
flora_bteraseall_facts([Fs|FL]) :-
!,
flora_bterase_facts(Fs),
flora_bteraseall_facts(FL).
flora_internal_db_insert_bt(StorageName,Call) :-
flora_db_insert_base_bt(StorageName,Call),
flora_refresh_tables(Call).
flora_internal_db_delete_bt(StorageName,Call) :-
flora_db_delete_base_bt(StorageName,Call),
flora_refresh_tables(Call).
syntax highlighted by Code2HTML, v. 0.9.1