/* File: flrdependency.P -- the dependency checker
**
** Author(s): Chang Zhao
**
** Contact: flora-users@lists.sourceforge.net
**
** Copyright (C) The Research Foundation of SUNY, 2002
**
** 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: flrdependency.P,v 1.12 2003/06/18 07:01:37 kifer Exp $
**
*/
%%%% Check dependency of tabled predicates on updates or procedural methods.
%%%% Such dependency is considered a likely error and warning is issued.
%%%%
%%%% Usage: check_for_dependencies(+CodeList,-ErrWarnList)
%%%% generate_rules(+CodeList)
%%%% depend(+Sk1,+Sk2,+Option).
:- compiler_options([xpp_on]).
#include "flora_terms.flh"
#include "flora_errors.flh"
#define MAXDEPTH 3
#define STARTPOINT 1
#define DEFAULT_WORKSPACE ''
#mode save
#mode nostring "\!#'"
#define PREFIXING(X) FLORA_USER_MODULE_PREFIX'''#1'
#mode restore
#define PREFIXED_WRAP_ISA PREFIXING(WRAP_ISA)
#define PREFIXED_WRAP_SUB PREFIXING(WRAP_SUB)
#define PREFIXED_WRAP_FD PREFIXING(WRAP_FD)
#define PREFIXED_WRAP_IFD PREFIXING(WRAP_IFD)
#define PREFIXED_WRAP_METH PREFIXING(WRAP_METH)
#define PREFIXED_WRAP_IMETH PREFIXING(WRAP_IMETH)
#define PREFIXED_WRAP_FDSIG PREFIXING(WRAP_FDSIG)
#define PREFIXED_WRAP_MVDSIG PREFIXING(WRAP_MVDSIG)
#define PREFIXED_WRAP_IFDSIG PREFIXING(WRAP_IFDSIG)
#define PREFIXED_WRAP_IMVDSIG PREFIXING(WRAP_IMVDSIG)
#define PREFIXED_WRAP_MVD PREFIXING(WRAP_MVD)
#define PREFIXED_WRAP_IMVD PREFIXING(WRAP_IMVD)
#define PREFIXED_WRAP_EXISTS PREFIXING(WRAP_EXISTS)
#define PREFIXED_WRAP_FDDEF PREFIXING(WRAP_FDDEF)
#define PREFIXED_WRAP_IFDDEF PREFIXING(WRAP_IFDDEF)
#define PREFIXED_WRAP_MVDDEF PREFIXING(WRAP_MVDDEF)
#define PREFIXED_WRAP_IMVDDEF PREFIXING(WRAP_IMVDDEF)
#define PREFIXED_WRAP_OBJEQL PREFIXING(WRAP_OBJEQL)
#define PREFIXED_WRAP_TRAN PREFIXING(WRAP_TRAN)
#define PREFIXED_WRAP_HILOG PREFIXING(WRAP_HILOG)
/****************************************************************************
utilities
****************************************************************************/
default_tabled(PREFIXED_WRAP_ISA,2).
default_tabled(PREFIXED_WRAP_SUB,2).
default_tabled(PREFIXED_WRAP_FD,3).
default_tabled(PREFIXED_WRAP_IFD,3).
default_tabled(PREFIXED_WRAP_METH,2).
default_tabled(PREFIXED_WRAP_IMETH,2).
default_tabled(PREFIXED_WRAP_FDSIG,3).
default_tabled(PREFIXED_WRAP_MVDSIG,3).
default_tabled(PREFIXED_WRAP_IFDSIG,3).
default_tabled(PREFIXED_WRAP_IMVDSIG,3).
default_tabled(PREFIXED_WRAP_MVD,3).
default_tabled(PREFIXED_WRAP_IMVD,3).
default_tabled(PREFIXED_WRAP_EXISTS,1).
default_tabled(PREFIXED_WRAP_FDDEF,2).
default_tabled(PREFIXED_WRAP_IFDDEF,2).
default_tabled(PREFIXED_WRAP_MVDDEF,2).
default_tabled(PREFIXED_WRAP_IMVDDEF,2).
default_tabled(PREFIXED_WRAP_OBJEQL,2).
procedural(PREFIXED_WRAP_TRAN,2).
dboperation(FLLIBINSERT,1).
dboperation(FLLIBINSERTALL,1).
dboperation(FLLIBBTINSERT,1).
dboperation(FLLIBBTINSERTALL,1).
dboperation(FLLIBDELETE,1).
dboperation(FLLIBDELETEALL,1).
dboperation(FLLIBBTDELETE,1).
dboperation(FLLIBBTDELETEALL,1).
dboperation(FLLIBERASE,1).
dboperation(FLLIBERASEALL,1).
dboperation(FLLIBBTERASE,1).
dboperation(FLLIBBTERASEALL,1).
dboperation(FLLIBINSERT,2).
dboperation(FLLIBINSERTALL,2).
dboperation(FLLIBBTINSERT,2).
dboperation(FLLIBBTINSERTALL,2).
dboperation(FLLIBDELETE,2).
dboperation(FLLIBDELETEALL,2).
dboperation(FLLIBBTDELETE,2).
dboperation(FLLIBBTDELETEALL,2).
dboperation(FLLIBERASE,2).
dboperation(FLLIBERASEALL,2).
dboperation(FLLIBBTERASE,2).
dboperation(FLLIBBTERASEALL,2).
is_upd(FLLIBINSERT(List,Condition),insert,List,Condition) :- !.
is_upd(FLLIBBTINSERT(List,Condition),btinsert,List,Condition) :- !.
is_upd(FLLIBDELETE(List,Condition),delete,List,Condition) :- !.
is_upd(FLLIBBTDELETE(List,Condition),btdelete,List,Condition) :- !.
is_upd(FLLIBERASE(List,Condition),erase,List,Condition) :- !.
is_upd(FLLIBBTERASE(List,Condition),bterase,List,Condition) :- !.
is_updall(FLLIBINSERTALL(List,Condition),insertall,List,Condition) :- !.
is_updall(FLLIBBTINSERTALL(List,Condition),btinsertall,List,Condition) :- !.
is_updall(FLLIBDELETEALL(List,Condition),deleteall,List,Condition) :- !.
is_updall(FLLIBBTDELETEALL(List,Condition),btdeleteall,List,Condition) :- !.
is_updall(FLLIBERASEALL(List,Condition),eraseall,List,Condition) :- !.
is_updall(FLLIBBTERASEALL(List,Condition),bteraseall,List,Condition) :- !.
is_upd(FLLIBINSERT(List),insert,List,_) :- !.
is_upd(FLLIBBTINSERT(List),btinsert,List,_) :- !.
is_upd(FLLIBDELETE(List),delete,List,_) :- !.
is_upd(FLLIBBTDELETE(List),btdelete,List,_) :- !.
is_upd(FLLIBERASE(List),erase,List,_) :- !.
is_upd(FLLIBBTERASE(List),bterase,List,_) :- !.
is_updall(FLLIBINSERTALL(List),insertall,List,_) :- !.
is_updall(FLLIBBTINSERTALL(List),btinsertall,List,_) :- !.
is_updall(FLLIBDELETEALL(List),deleteall,List,_) :- !.
is_updall(FLLIBBTDELETEALL(List),btdeleteall,List,_) :- !.
is_updall(FLLIBERASEALL(List),eraseall,List,_) :- !.
is_updall(FLLIBBTERASEALL(List),bteraseall,List,_) :- !.
is_agg(FLLIBMIN(Var,Group,Cond,Result),min,Var,Group,Cond,Result) :- !.
is_agg(FLLIBMAX(Var,Group,Cond,Result),max,Var,Group,Cond,Result) :- !.
is_agg(FLLIBSUM(Var,Group,Cond,Result),sum,Var,Group,Cond,Result) :- !.
is_agg(FLLIBAVG(Var,Group,Cond,Result),avg,Var,Group,Cond,Result) :- !.
is_agg(FLLIBCOUNT(Var,Group,Cond,Result),count,Var,Group,Cond,Result) :- !.
is_agg(FLLIBCOLLECTSET(Var,Group,Cond,Result),collectset,Var,Group,Cond,Result)
:- !.
is_agg(FLLIBCOLLECTBAG(Var,Group,Cond,Result),collectbag,Var,Group,Cond,Result)
:- !.
is_control(FLLIBIFTHEN(If,Then),FLLIBIFTHEN,[If,Then]) :- !.
is_control(FLLIBIFTHENELSE(If,Then,Else),FLLIBIFTHENELSE,[If,Then,Else]) :- !.
is_constraint(PRCONSTRAINT(Constr),Constr).
/****************************************************************************
cut_off(+Term_before_cutoff,-Term_after_cutoff)
cut off a term whose depth is greater than MAXDEPTH
****************************************************************************/
cut_off(T1,T2) :- cut_off(T1,T2,1).
cut_off(T1,T2,N) :-
( N>MAXDEPTH ->
writeln('Too deep'),
fail
;
( (atomic(T1); var(T1)) ->
T2=T1,
!
;
( N=MAXDEPTH ->
functor(T1,Func,Nargs),
functor(T2,Func,Nargs)
;
NewN is N+1,
T1 =.. [Func|Args],
cut_off_list(Args,NewArgs,NewN),
T2 =.. [Func|NewArgs]
)
)
).
cut_off_list([],[],_) :- !.
cut_off_list([H|T],[NewH|NewT],N) :-
cut_off(H,NewH,N),
cut_off_list(T,NewT,N).
/****************************************************************************
depth(+Term,-Depth_of_the_term)
compute the depth of a term
****************************************************************************/
depth(X,0) :- atomic(X), !.
depth(X,0) :- var(X), !.
depth(X,N1) :-
!,
X =.. [_F|Y],
param_depth(Y,N),
N1 is N+1.
/****************************************************************************
param_depth(+ParamList,-MaxDepth)
given a list of parameters, returns the max depth of all params
****************************************************************************/
param_depth([X],N) :- depth(X,N),!.
param_depth([H|T],N) :-
depth(H,N1),
param_depth(T,N2),
( (N1>N2) ->
N = N1
;
N = N2
).
/****************************************************************************
depend(+Sk1,+Sk2,-T1,-T2,+Option)
possible options: u -- depends on update
a -- depends on aggregation
n -- depends negatively
p -- depends positively
arb -- arbitrary
check whether Sk1 depends on Sk2 with given option, T1 and T2 are
instantiations of Sk1 and Sk2, respectively
****************************************************************************/
depend(Sk1,Sk2,T1,T2,Opt) :-
retractall(dependency(_,_,_,_)),
depend(Sk1,Sk2),
dependency((T1,_IT1),(T2,_IT2),anu(A,N,U),_),
( (Opt=u, atom(U))
; (Opt=a, atom(A))
; (Opt=n, atom(N))
; (Opt=p, var(N))
; (Opt=arb)
).
/****************************************************************************
depend(+Sk1,+Sk2,+Option)
decides whether Sk1 dependes on Sk2 without caring about the
instantiations
****************************************************************************/
depend(Sk1,Sk2,Opt) :-
depend(Sk1,Sk2,_IT1,_IT2,Opt).
/****************************************************************************
depend(+Sk1,+Sk2)
decide whether term skeleton Sk1 depends on Sk2
and whether the dependency is through aggregation, negation, update
dependency/4 will be asserted for each path pattern from Sk1 to Sk2
****************************************************************************/
depend(Sk1,Sk2) :-
retractall(target(_)),
( is_list(Sk2) ->
list_to_targets(Sk2)
;
assert(target(Sk2))
),
findall((RuleHead),match_rule(Sk1,RuleHead,_,_),HeadList),
remove_dup(HeadList,NewHeadList),
depend_list(NewHeadList).
list_to_targets([]) :- !.
list_to_targets([H|T]) :-
assert(target(H)),
list_to_targets(T).
remove_dup([],[]) :- !.
remove_dup([H|T],NewList) :-
( member(H,T) ->
remove_dup(T,NewList)
;
remove_dup(T,InterList),
NewList = [H|InterList]
).
depend_list([]) :- !.
depend_list([(H)|T]) :-
retractall(dependency(_,_,_)),
depend_detail(H),
findall((Body,anu(A,N,U),Templete),
dependency(Body,anu(A,N,U),Templete),
DependencyList),
assert_dependency_list(H,DependencyList),
depend_list(T).
assert_dependency_list(_,[]) :- !.
assert_dependency_list(Term,[(Body,anu(A,N,U),Templete)|T]) :-
assert(dependency(Term,Body,anu(A,N,U),Templete)),
assert_dependency_list(Term,T).
depend_detail((_Sk1,IndSk1)) :-
retractall(checked(_)),
findall((RuleBody,anu(A,N,U)),
same_rule(IndSk1,_RuleHead,RuleBody,anu(A,N,U)), BodyList),
my_append([],BodyList,L,STARTPOINT,_Template),
traversal(L).
/****************************************************************************
traversal(+List)
BFS for all possible dependencies from Sk1 to Sk2. Originally List only
contains terms that Sk1 directly depends on. Sk2 is asserted by target(Sk2).
Each time the first element of the list is taken out. We find the rules
whose heads can unify with this element and consider the bodies of those
rules. If
1) the rule body unifies with Sk2, then we have found a dependency
2) we have checked the body (asserted by checked/1) with the same (A,N,U)
and Template value, then it will be discarded
3) otherwise, the body and its cut-off form will be put to the end of List
****************************************************************************/
traversal([]) :- !.
traversal([Head|Tail]) :-
Head = (Term,(T,IndTerm),anu(A,N,U),Times,Template),
compare_with_target(Term,(T,IndTerm),anu(A,N,U),Template),
( (checked((CT,anu(A1,N1,U1),Template1)),
subsumes(CT,Term),
variant((A1,N1,U1,Template1),(A,N,U,Template))) ->
NewList=Tail
;
assert(checked((Term,anu(A,N,U),Template))),
findall((RuleBody,anu(A,N,U)),
match_rule(Term,_RuleHead,RuleBody,anu(A,N,U)),
BodyList),
NewTimes is Times+1,
my_append(Tail,BodyList,NewList,NewTimes,Template)
),
traversal(NewList).
my_append(List,[],List,_,_) :- !.
my_append(List,[Head|Tail],NewList,Times,Template) :-
Head = ((RuleBody,IndRuleBody),anu(A,N,U)),
( (depth((RuleBody),Depth),Depth>MAXDEPTH) ->
cut_off(RuleBody,NewBody),
TT=tt
;
NewBody=RuleBody,
TT=Template
),
NewTerm = (NewBody,(RuleBody,IndRuleBody),anu(A,N,U),Times,TT),
TempList=[NewTerm|List],
my_append(TempList,Tail,NewList,Times,Template).
compare_with_target(Term,(T,IndTerm),anu(A,N,U),Template) :-
target(Sk2),
Term=Sk2,
assert(dependency((T,IndTerm),anu(A,N,U),Template)),
fail.
compare_with_target(_Term,(_T,_IndTerm),anu(_A,_N,_U),_Template).
/****************************************************************************
match_rule(+Term,-Head,-Body,?anu(A,N,U))
find rules whose heads unify with Term
****************************************************************************/
match_rule(T,(H,IH),B,anu(A,N,U)) :-
rule((H,IH),B,anu(A,N,U)),
T=H.
/****************************************************************************
same_rule(+IndTerm,-Head,-Body,?anu(A,N,U))
find rules whose heads unify with Term
****************************************************************************/
same_rule(IT,(H,IH),B,anu(A,N,U)) :-
rule((H,IH),B,anu(A,N,U)),
IT=IH.
/****************************************************************************
generate_rules(+CodeList)
generate rules from intermediate code
****************************************************************************/
generate_rules([]) :- !.
generate_rules(CodeList) :-
retractall(rule(_,_,_)),
parse_codelist(CodeList).
/****************************************************************************
parse_codelist(+CodeList)
generate rules from a list of intermediate code
****************************************************************************/
parse_codelist([T]) :-
!,
parse_code(T).
parse_codelist([T|L]) :-
parse_code(T),
parse_codelist(L).
parse_code(Term) :-
( is_prrule(Term,Head,Body) ->
parse_rule(Head,Body)
;
true
).
parse_rule(Head,Body) :-
flora_build_struct(Head,DEFAULT_WORKSPACE,FLBODYPREFIX,VarList,HeadCode,HCI),
flora_build_struct(Body,DEFAULT_WORKSPACE,FLBODYPREFIX,VarList,BodyCode,BCI),
assert_rule((HeadCode,HCI),BodyCode,BCI,anu(_,_,_)).
assert_rule(_H,BodyCode,_BI,_) :-
var(BodyCode),
!.
assert_rule(HeadCode,BodyCode,(BCI,_I),anu(A,N,U)) :-
(BodyCode=','(Body1,Body2); BodyCode=';'(Body1,Body2)),
(BCI=','(BCI1,BCI2); BCI=';'(BCI1,BCI2)),
!,
assert_rule(HeadCode,Body1,BCI1,anu(A,N,U)),
assert_rule(HeadCode,Body2,BCI2,anu(A,N,U)).
assert_rule(HeadCode,BodyCode,(BCI,_I),anu(A,_,U)) :-
(BodyCode=not(NewBody); BodyCode=tnot(NewBody)),
(BCI=not(NewBCI); BCI=tnot(NewBCI)),
!,
assert_rule(HeadCode,NewBody,NewBCI,anu(A,n,U)).
assert_rule(_HeadCode,BodyCode,(_BCI,_I),anu(_A,_N,_U)) :-
is_constraint(BodyCode,_),
!.
assert_rule(HeadCode,BodyCode,(BCI,Index),anu(A,N,U)) :-
is_upd(BodyCode,_,List,Cond),
!,
is_upd(BCI,_,(ListI,_I),CondI),
assert(rule(HeadCode,(BodyCode,(BCI,Index)),anu(A,N,u))),
assert_rule(HeadCode,Cond,CondI,anu(A,N,U)),
assert_rules(HeadCode,List,ListI,anu(A,N,u)).
assert_rule(HeadCode,BodyCode,(BCI,Index),anu(A,N,U)) :-
is_updall(BodyCode,_,List,Cond),
!,
is_updall(BCI,_,(ListI,_I),CondI),
assert(rule(HeadCode,(BodyCode,(BCI,Index)),anu(a,N,u))),
assert_rule(HeadCode,Cond,CondI,anu(A,N,U)),
assert_rules(HeadCode,List,ListI,anu(A,N,u)).
assert_rule(HeadCode,BodyCode,(BCI,Index),anu(_,N,U)) :-
is_agg(BodyCode,_,_,_,Condition,_),
!,
is_agg(BCI,_,_,_,ConditionI,_),
assert(rule(HeadCode,(BodyCode,(BCI,Index)),anu(a,N,U))),
assert_rule(HeadCode,Condition,ConditionI,anu(a,N,U)).
assert_rule(HeadCode,BodyCode,(BCI,_I),anu(A,N,U)) :-
is_control(BodyCode,_,Args),
!,
is_control(BCI,_,ArgsI),
assert_rules(HeadCode,Args,ArgsI,anu(A,N,U)).
assert_rule(HeadCode,BodyCode,(BCI,_I),anu(A,N,U)) :-
BodyCode = flsysdbupdate(NewBody,_,_),
!,
BCI = flsysdbupdate(NewBCI,_,_),
assert_rule(HeadCode,NewBody,NewBCI,anu(A,N,U)).
assert_rule(HeadCode,BodyCode,BCwithIndex,anu(A,N,U)) :-
assert(rule(HeadCode,(BodyCode,BCwithIndex),anu(A,N,U))).
assert_rules(_,[],_,_) :- !.
assert_rules(HeadCode,[H|T],[HI|TI],anu(A,N,U)) :-
assert_rule(HeadCode,H,HI,anu(A,N,U)),
assert_rules(HeadCode,T,TI,anu(A,N,U)).
/****************************************************************************
check_for_dependencies(+CodeList,-WarnList)
check whether tabled predicates depend on procedural/database operations.
****************************************************************************/
check_for_dependencies(CodeList,WarnList) :-
retractall(program_tabled(_,_)),
retrieve_program_tabled(CodeList),
generate_rules(CodeList),
findall((Func1,Arity1), default_tabled(Func1,Arity1), TabledList1),
findall((Func1,Arity1,PREFIXED_WRAP_HILOG), program_tabled(Func1,Arity1), TabledList2),
append(TabledList1,TabledList2,TabledList),
findall((Func2,Arity2),
(procedural(Func2,Arity2);dboperation(Func2,Arity2)),
ProcList),
retractall(warning_seen(_,_,_,_,_)),
checking_list(TabledList,ProcList),
generate_warnings(WarnList),
!.
check_for_dependencies(_CodeList,[error(UNKNOWN_ERROR)]).
/****************************************************************************
checking_list(+TabledPredicateList,+TargetList)
****************************************************************************/
checking_list([],_) :- !.
checking_list([H|T],OpList) :-
checking(H,OpList),
checking_list(T,OpList).
/****************************************************************************
checking(+(Func,Arity),+TargetList)
****************************************************************************/
checking(_,[]) :- !.
checking((Func1,Arity1,Wrapper),Ops) :-
!,
construct_sk(Func1,Arity1,Wrapper,TabledPred),
setup_targets(Ops,Targets),
( depend(TabledPred,Targets,arb) ->
aggregate_warnings
;
true
).
checking((Func1,Arity1),Ops) :-
functor(TabledPred,Func1,Arity1),
setup_targets(Ops,Targets),
( depend(TabledPred,Targets,arb) ->
aggregate_warnings
;
true
).
construct_sk(F,A,Wrapper,Pred) :-
number(A),
!,
length(L,A),
Pred =.. [Wrapper,F|L].
construct_sk(F,A,Wrapper,Pred) :-
A=FL_SLASH(A1,A2),
construct_sk(F,A1,Wrapper,TP),
length(L,A2),
Pred =.. [Wrapper,TP|L].
/****************************************************************************
setup_targets(+ListOfFuncArity,-TargetList)
****************************************************************************/
setup_targets([],[]) :- !.
setup_targets([(Func,Arity)|T],[OpPred|NewT]) :-
functor(OpPred,Func,Arity),
setup_targets(T,NewT).
/****************************************************************************
aggregate_warnings
find all asserted dependency/4, generate warnings and aggregate them
****************************************************************************/
aggregate_warnings :-
findall(((T1,IT1),(T2,IT2),anu(A,N,U),Temp),
dependency((T1,IT1),(T2,IT2),anu(A,N,U),Temp),
DependencyList
),
aggregate_warnings(DependencyList).
aggregate_warnings([]) :- !.
aggregate_warnings([((T1,IT1),(T2,IT2),_,_)|T]) :-
flora_set_counter(min_ind,0),
flora_set_counter(next_min_ind,0),
to_string(T1,IT1,Str1,RuleID),
flora_get_counter(min_ind,HMinInd),
flora_get_counter(next_min_ind,HNMinInd),
flora_set_counter(min_ind,0),
flora_set_counter(next_min_ind,0),
to_string(T2,IT2,Str2,_RID),
flora_get_counter(min_ind,BMinInd),
( T2=PREFIXED_WRAP_TRAN(_,_) ->
Type = 'procedural method'
;
Type = ' db operation'
),
fmt_write_string(WarnMsg,"Tabled literal in the head of rule that starts with %s depends on %s %s",
args(Str1,Type,Str2)),
( warning_seen(RuleID,HInd1,HInd2,BMinInd,_) ->
( (HInd1<HMinInd;HInd1=HMinInd),(HInd2<HNMinInd;HInd2=HNMinInd) ->
true
;
retract(warning_seen(RuleID,HInd1,HInd2,BMinInd,_)),
assert(warning_seen(RuleID,HMinInd,HNMinInd,BMinInd,WarnMsg))
)
;
assert(warning_seen(RuleID,HMinInd,HNMinInd,BMinInd,WarnMsg))
),
aggregate_warnings(T).
/****************************************************************************
retrieve_program_table(+IntermediateCodeList)
****************************************************************************/
retrieve_program_tabled([]) :- !.
retrieve_program_tabled([H|T]) :-
( is_prdirective(H,Direct) ->
(is_prtable(Direct,Functor,Arity) ->
assert(program_tabled(Functor,Arity))
;
true
)
;
true
),
retrieve_program_tabled(T).
/****************************************************************************
to_string(+Term,+IndexedTerm,-Str,-RuleID)
****************************************************************************/
to_string(Term,(IT,Index),Str,RuleID) :-
rebuild_text(Term,(IT,Index),Text),
( (Index==NO_INDEX) ->
fmt_write_string(Str,"`%s'",args(Text)),
RuleID==NO_INDEX
;
flora_token_rulenum(Index,RuleID),
flora_nth_token(Index,Token),
flora_token_text(Token,_T,BL,BC,_EL,_EC),
fmt_write_string(Str,"`%s' near line(%d)/char(%d)",
args(Text,BL,BC))
).
/****************************************************************************
rebuild_text(+Term,+IndexdTerm,-Text)
return a string for the given term to construct warning message
****************************************************************************/
rebuild_text(_Term,(T,Index),Text) :-
(atomic(T);var(T)),
!,
flora_get_counter(min_ind,MinInd),
flora_get_counter(next_min_ind,NextMinInd),
( (Index<MinInd; MinInd=0) ->
flora_set_counter(next_min_ind,MinInd),
flora_set_counter(min_ind,Index)
;
( (Index<NextMinInd; NextMinInd=0) ->
flora_set_counter(next_min_ind,Index)
;
true
)
),
flora_nth_token(Index,Token),
flora_token_text(Token,Text,_BL,_BC,_EL,_EC).
rebuild_text(Term,(IndTerm,_Ind),Text) :-
Term=..['.'|_ListItems],
!,
rebuild_text_list(Term,IndTerm,ListText),
fmt_write_string(Text,"[%s]",args(ListText)).
rebuild_text(Term,(_IndT,Index),Text) :-
( is_upd(Term,_Op,_List,_Cond)
; is_updall(Term,_Op,_List,_Cond)
; is_agg(Term,_Op,_Var,_Group,_Condition,_Result)
),
!,
flora_get_counter(min_ind,MinInd),
flora_get_counter(next_min_ind,NextMinInd),
( (Index<MinInd; MinInd=0) ->
flora_set_counter(next_min_ind,MinInd),
flora_set_counter(min_ind,Index)
;
( (Index<NextMinInd; NextMinInd=0) ->
flora_set_counter(next_min_ind,Index)
;
true
)
),
flora_nth_token(Index,Token),
flora_token_text(Token,Text,_BL,_BC,_EL,_EC).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_TRAN(Var,Tran),
!,
IndT=PREFIXED_WRAP_TRAN(IndVar,IndTran),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Tran,IndTran,TranText),
fmt_write_string(Text,"%s[#%s]",args(VarText,TranText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_ISA(Var,Class),
!,
IndT=PREFIXED_WRAP_ISA(IndVar,IndClass),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Class,IndClass,ClassText),
fmt_write_string(Text,"%s:%s",args(VarText,ClassText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_SUB(Var,Class),
!,
IndT=PREFIXED_WRAP_SUB(IndVar,IndClass),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Class,IndClass,ClassText),
fmt_write_string(Text,"%s::%s",args(VarText,ClassText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_METH(Var,Meth),
!,
IndT=PREFIXED_WRAP_METH(IndVar,IndMeth),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Meth,IndMeth,MethText),
fmt_write_string(Text,"%s[%s]",args(VarText,MethText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IMETH(Var,IMeth),
!,
IndT=PREFIXED_WRAP_IMETH(IndVar,IndIMeth),
rebuild_text(Var,IndVar,VarText),
rebuild_text(IMeth,IndIMeth,IMethText),
fmt_write_string(Text,"%s[*%s]",args(VarText,IMethText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=fdskolem(Var,Meth),
!,
IndT=fdskolem(IndVar,IndMeth),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Meth,IndMeth,MethText),
fmt_write_string(Text,"%s.%s",args(VarText,MethText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=ifdskolem(Var,IMeth),
!,
IndT=ifdskolem(IndVar,IndIMeth),
rebuild_text(Var,IndVar,VarText),
rebuild_text(IMeth,IndIMeth,IMethText),
fmt_write_string(Text,"%s!%s",args(VarText,IMethText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_FD(Var,Attr,Val),
!,
IndT=PREFIXED_WRAP_FD(IndVar,IndAttr,IndVal),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
( (not(var(Val)),(Val=fdskolem(Var,Attr))) ->
fmt_write_string(Text,"%s.%s[]",args(VarText,AttrText))
;
rebuild_text(Val,IndVal,ValText),
fmt_write_string(Text,"%s[%s->%s]",args(VarText,AttrText,ValText))
).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IFD(Var,Attr,Val),
!,
IndT=PREFIXED_WRAP_IFD(IndVar,IndAttr,IndVal),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
( (not(var(Val)),(Val=ifdskolem(Var,Attr))) ->
fmt_write_string(Text,"%s!%s[]",args(VarText,AttrText))
;
rebuild_text(Val,IndVal,ValText),
fmt_write_string(Text,"%s[%s*->%s]",args(VarText,AttrText,ValText))
).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_FDSIG(Var,Attr,Type),
!,
IndT=PREFIXED_WRAP_FDSIG(IndVar,IndAttr,IndType),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Type,IndType,TypeText),
fmt_write_string(Text,"%s[%s=>%s]",args(VarText,AttrText,TypeText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IFDSIG(Var,Attr,Type),
!,
IndT=PREFIXED_WRAP_IFDSIG(IndVar,IndAttr,IndType),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Type,IndType,TypeText),
fmt_write_string(Text,"%s[%s*=>%s]",args(VarText,AttrText,TypeText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_MVD(Var,Attr,Val),
!,
IndT=PREFIXED_WRAP_MVD(IndVar,IndAttr,IndVal),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Val,IndVal,ValText),
fmt_write_string(Text,"%s[%s->>{%s}]",args(VarText,AttrText,ValText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IMVD(Var,Attr,Val),
!,
IndT=PREFIXED_WRAP_IMVD(IndVar,IndAttr,IndVal),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Val,IndVal,ValText),
fmt_write_string(Text,"%s[%s*->>{%s}]",args(VarText,AttrText,ValText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_MVDSIG(Var,Attr,Type),
!,
IndT=PREFIXED_WRAP_MVDSIG(IndVar,IndAttr,IndType),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Type,IndType,TypeText),
fmt_write_string(Text,"%s[%s=>>%s]",args(VarText,AttrText,TypeText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IMVDSIG(Var,Attr,Type),
!,
IndT=PREFIXED_WRAP_IMVDSIG(IndVar,IndAttr,IndType),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
rebuild_text(Type,IndType,TypeText),
fmt_write_string(Text,"%s[%s*=>>%s]",args(VarText,AttrText,TypeText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_EXISTS(Var),
!,
IndT=PREFIXED_WRAP_EXISTS(IndVar),
rebuild_text(Var,IndVar,VarText),
fmt_write_string(Text,"%s[]",args(VarText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_MVDDEF(Var,Attr),
!,
IndT=PREFIXED_WRAP_MVDDEF(IndVar,IndAttr),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
fmt_write_string(Text,"%s[%s->>{}]",args(VarText,AttrText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_IMVDDEF(Var,Attr),
!,
IndT=PREFIXED_WRAP_IMVDDEF(IndVar,IndAttr),
rebuild_text(Var,IndVar,VarText),
rebuild_text(Attr,IndAttr,AttrText),
fmt_write_string(Text,"%s[%s*->>{}]",args(VarText,AttrText)).
rebuild_text(Term,(IndT,_Index),Text) :-
Term=PREFIXED_WRAP_OBJEQL(O1,O2),
!,
IndT=PREFIXED_WRAP_OBJEQL(IndO1,IndO2),
rebuild_text(O1,IndO1,O1Text),
rebuild_text(O2,IndO2,O2Text),
fmt_write_string(Text,"%s:=:%s",args(O1Text,O2Text)).
rebuild_text(Term,(IndT,Index),Text) :-
Term=..[F|A],
IndT=..[_IndF|IndA],
( (F==PREFIXED_WRAP_HILOG;F==WRAP_HILOG) ->
A=[Func|Args],
IndA=[IndFunc|IndArgs],
rebuild_text(Func,IndFunc,FuncText)
;
flora_get_counter(min_ind,MinInd),
flora_get_counter(next_min_ind,NextMinInd),
( (Index<MinInd; MinInd=0) ->
flora_set_counter(next_min_ind,MinInd),
flora_set_counter(min_ind,Index)
;
( (Index<NextMinInd; NextMinInd=0) ->
flora_set_counter(next_min_ind,Index)
;
true
)
),
flora_nth_token(Index,Token),
flora_token_text(Token,FuncText,_BL,_BC,_EL,_EC),
Args=A,
IndArgs=IndA
),
( (Args==[]) ->
fmt_write_string(Text,"%s",args(FuncText))
;
rebuild_text_list(Args,IndArgs,ArgsText),
fmt_write_string(Text,"%s(%s)",args(FuncText,ArgsText))
).
/****************************************************************************
rebuild_text_list(+List,+IndexdList,-Text)
****************************************************************************/
rebuild_text_list(L,(_Var,Index),Text) :-
var(L),
!,
flora_get_counter(min_ind,MinInd),
flora_get_counter(next_min_ind,NextMinInd),
( (Index<MinInd; MinInd=0) ->
flora_set_counter(next_min_ind,MinInd),
flora_set_counter(min_ind,Index)
;
( (Index<NextMinInd; NextMinInd=0) ->
flora_set_counter(next_min_ind,Index)
;
true
)
),
flora_nth_token(Index,Token),
flora_token_text(Token,Text,_BL,_BC,_EL,_EC).
rebuild_text_list([],_,'') :- !.
rebuild_text_list([H|L],[IndH|IndL],Text) :-
( var(L) ->
rebuild_text(H,IndH,HText),
( (IndL=..['.'|_ListItems]) ->
rebuild_text_list(L,IndL,LText),
fmt_write_string(Text,"%s,%s",args(HText,LText))
;
rebuild_text(L,IndL,LText),
fmt_write_string(Text,"%s|%s",args(HText,LText))
)
;
( L==[] ->
rebuild_text(H,IndH,Text)
;
rebuild_text(H,IndH,HText),
( (IndL=..['.'|_ListItems]) ->
rebuild_text_list(L,IndL,LText),
fmt_write_string(Text,"%s,%s",args(HText,LText))
;
rebuild_text(L,IndL,LText),
fmt_write_string(Text,"%s|%s",args(HText,LText))
)
)
).
/****************************************************************************
generate_warnings(-WarnList)
****************************************************************************/
generate_warnings(WarnList) :-
findall((HInd1,BInd,WarnMsg),warning_seen(_,HInd1,_,BInd,WarnMsg),WL),
sort(WL, SortedWL),
append_warnings(SortedWL,WarnList).
append_warnings([],[]) :- !.
append_warnings([(_HInd,_BInd,WarnMsg)|T],[warning(WarnMsg)|InterWarnList]) :-
append_warnings(T,InterWarnList).
syntax highlighted by Code2HTML, v. 0.9.1