| 1 | % (c) 2014-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | ||
| 5 | :- module(mcdc_coverage,[get_mcdc_coverage_criterion/4, mcdc_true/4, mcdc_false/4, | |
| 6 | tcltk_compute_mcdc_operation_coverage/2, tcltk_compute_mcdc_operation_coverage/1, | |
| 7 | tcltk_compute_mcdc_invariant_coverage/2, tcltk_compute_mcdc_invariant_coverage/1, | |
| 8 | construct_mcdc_operation_criteria/1, | |
| 9 | check_criteria/2]). | |
| 10 | ||
| 11 | :- use_module(module_information,[module_info/2]). | |
| 12 | :- module_info(group,test_generation). | |
| 13 | :- module_info(description,'A module to construct MC/DC coverage criterion predicates and check them in the state space'). | |
| 14 | ||
| 15 | ||
| 16 | :- use_module(library(lists)). | |
| 17 | :- use_module(predicate_debugger,[get_operation_enabling_condition/7]). | |
| 18 | %:- use_module(b_ast_cleanup, [clean_up/3]). | |
| 19 | :- use_module(b_interpreter_components,[construct_optimized_exists/3]). | |
| 20 | :- use_module(probsrc(bsyntaxtree)). | |
| 21 | :- use_module(probsrc(error_manager)). | |
| 22 | :- use_module(tools_strings,[ajoin/2]). | |
| 23 | :- use_module(b_interpreter,[b_test_boolean_expression_wf/3]). | |
| 24 | :- use_module(specfile,[state_corresponds_to_initialised_b_machine/2]). | |
| 25 | ||
| 26 | % not yet finished: | |
| 27 | /* | |
| 28 | vacuous_guard_component(OpName,Result) :- trace, | |
| 29 | get_mcdc_coverage_criterion(1,OpName,RequiredCoverageCriterion,Tree), | |
| 30 | translate:translate_bexpression_with_limit(GuardPart,GuardTS), | |
| 31 | format('Checking vor vacuity: ~w -> ~w : ~w~n',[OpName,CoverageMsg,GuardTS]), | |
| 32 | %translate:print_bexpr(Neg),nl, | |
| 33 | (test_boolean_expression_in_node(ResID,RequiredCoverageCriterion) | |
| 34 | -> print(criterion_satisfied_in(ResID)),nl,nl, | |
| 35 | fail | |
| 36 | ; print(' *** VACUOUS GUARD COMPONENT *** '),nl,nl, | |
| 37 | ajoin([OpName,' : ',CoverageMsg,' : ',GuardTS],Result) | |
| 38 | ). | |
| 39 | */ | |
| 40 | :- use_module(state_space,[visited_expression/2]). | |
| 41 | test_boolean_expression_in_node(ResID,BoolExpr) :- | |
| 42 | visited_expression(ResID,CurState), | |
| 43 | state_corresponds_to_initialised_b_machine(CurState,CurBState), | |
| 44 | b_test_boolean_expression_wf(BoolExpr,[],CurBState). | |
| 45 | ||
| 46 | ||
| 47 | %:- use_module(probsrc(mcdc_coverage)), construct_mcdc_operation_criteria(1), check_criteria(Nr,Result). | |
| 48 | ||
| 49 | % store list of criteria | |
| 50 | :- dynamic criteria/4, nr_of_criteria/1. | |
| 51 | nr_of_criteria(0). | |
| 52 | ||
| 53 | reset_criteria :- retractall(criteria(_,_,_,_)), | |
| 54 | retractall(nr_of_criteria(_)), assert(nr_of_criteria(0)). | |
| 55 | ||
| 56 | add_criteria(Op,Pred,InfoTree) :- | |
| 57 | retract(nr_of_criteria(Nr)), N1 is Nr+1, | |
| 58 | assert(nr_of_criteria(N1)), | |
| 59 | assert(criteria(N1,Op,Pred,InfoTree)). | |
| 60 | ||
| 61 | % generate MCDC criteria for a certain nesting level | |
| 62 | % level 0 -> only enabling/disabling, ... | |
| 63 | construct_mcdc_operation_criteria(Level) :- | |
| 64 | get_mcdc_coverage_criterion(Level,OpName,RequiredCoverageCriterionPred,Tree), | |
| 65 | add_criteria(OpName,RequiredCoverageCriterionPred,Tree), | |
| 66 | fail. | |
| 67 | construct_mcdc_operation_criteria(_) :- nr_of_criteria(Nr), format('Nr of MC/DC criteria: ~w~n',[Nr]). | |
| 68 | ||
| 69 | ||
| 70 | construct_mcdc_invariant_criteria(Level) :- | |
| 71 | get_mcdc_invariant_coverage_criterion(Level,InvName,RequiredCoverageCriterionPred,Tree), | |
| 72 | add_criteria(InvName,RequiredCoverageCriterionPred,Tree), | |
| 73 | fail. | |
| 74 | construct_mcdc_invariant_criteria(_) :- nr_of_criteria(Nr), format('Nr of MC/DC INV criteria: ~w~n',[Nr]). | |
| 75 | ||
| 76 | % check a given criteria | |
| 77 | check_criteria(Nr,Result) :- | |
| 78 | criteria(Nr,OpName,Pred,InfoTree), | |
| 79 | translate:translate_bexpression_with_limit(Pred,TS), | |
| 80 | format('~nChecking: ~w : ~w~n',[OpName,TS]), | |
| 81 | explain(InfoTree,0), | |
| 82 | %translate:print_bexpr(Neg),nl, | |
| 83 | (test_boolean_expression_in_node(ResID,Pred) | |
| 84 | -> print(criterion_satisfied_in(ResID)),nl,nl, | |
| 85 | Result = ResID | |
| 86 | ; Result = uncovered | |
| 87 | ). | |
| 88 | ||
| 89 | :- use_module(preferences, [get_preference/2]). | |
| 90 | ||
| 91 | tcltk_compute_mcdc_invariant_coverage(Res) :- | |
| 92 | get_preference(mc_dc_default_level,Level), | |
| 93 | tcltk_compute_mcdc_invariant_coverage(Level,Res). | |
| 94 | tcltk_compute_mcdc_operation_coverage(Res) :- | |
| 95 | get_preference(mc_dc_default_level,Level), | |
| 96 | tcltk_compute_mcdc_operation_coverage(Level,Res). | |
| 97 | ||
| 98 | tcltk_compute_mcdc_invariant_coverage(Level,list([list(['Nr','Invariant','Path to Condition', 'Condition', 'Result', 'Source'])|Result])) :- | |
| 99 | reset_criteria, | |
| 100 | construct_mcdc_invariant_criteria(Level), | |
| 101 | findall(list([Nr,Operation,CriterionMsg,PredS,Result,Source]), | |
| 102 | get_individual_criteria(Nr,Operation,CriterionMsg,PredS,Result,Source), | |
| 103 | Result). | |
| 104 | tcltk_compute_mcdc_operation_coverage(Level,list([list(['Nr','Operation','Path to Condition', 'Condition', 'Result', 'Source'])|Result])) :- | |
| 105 | reset_criteria, | |
| 106 | construct_mcdc_operation_criteria(Level), | |
| 107 | findall(list([Nr,Operation,CriterionMsg,PredS,Result,Source]), | |
| 108 | get_individual_criteria(Nr,Operation,CriterionMsg,PredS,Result,Source), | |
| 109 | Result). | |
| 110 | ||
| 111 | get_individual_criteria(Nr,OpName,CriterionMsg,PredS,Result,Source) :- | |
| 112 | get_criteria_info(Nr,OpName,CriterionMsg,PredS,Source), | |
| 113 | check_criteria(Nr,Result). | |
| 114 | ||
| 115 | :- use_module(translate,[translate_bexpression_with_limit/3]). | |
| 116 | get_criteria_info(Nr,OpName,CritMsg,PredS,Source) :- | |
| 117 | criteria(Nr,OpName,_Pred,InfoTree), | |
| 118 | get_criteria_tree_info(InfoTree,CritMsg,Pred,Source), | |
| 119 | translate_bexpression_with_limit(Pred,40,PredS). | |
| 120 | ||
| 121 | get_mcdc_coverage_criterion(Level,OpName,RequiredCoverageCriterionPred,Tree) :- | |
| 122 | get_operation_enabling_condition(OpName,Parameters,EnablingCondition,_BecomesSuchVars,_Precise,false,true), | |
| 123 | % TO DO: partition; avoid lifting becomes_such_that conditions | |
| 124 | % (in EventB the feasibility PO will ensure that Guard => BecomeSuchThat is ok) | |
| 125 | dif(OpName, '$initialise_machine'), | |
| 126 | (mcdc_true(Level,EnablingCondition,TargetPred,Tree) ; | |
| 127 | mcdc_false(Level,EnablingCondition,TargetPred,Tree) ), | |
| 128 | construct_optimized_exists(Parameters,TargetPred,RequiredCoverageCriterionPred), | |
| 129 | translate:print_bexpr(RequiredCoverageCriterionPred),nl. | |
| 130 | ||
| 131 | :- use_module(bmachine,[b_get_invariant_from_machine/1]). | |
| 132 | get_mcdc_invariant_coverage_criterion(Level,InvName,TargetPred,Tree) :- | |
| 133 | b_get_invariant_from_machine(InvPred), | |
| 134 | mcdc_true(Level,InvPred,TargetPred,Tree), % we do not expect an INVARIANT to be false: only call mcdc_true | |
| 135 | get_invariant_name(Tree,InvName). | |
| 136 | ||
| 137 | get_invariant_name(conjunct_true(PosNr,SinglePred,_InnerTree),Name) :- !, | |
| 138 | (bsyntaxtree:get_texpr_label(SinglePred,Name) -> true | |
| 139 | ; ajoin(['INV',PosNr],Name)). | |
| 140 | get_invariant_name(_,'INV'). | |
| 141 | ||
| 142 | %:- use_module(probsrc(mcdc_coverage)), get_mcdc_coverage_criterion(OpName,RequiredCoverageCriterionPred,_,_). | |
| 143 | ||
| 144 | select_pred(List, Rest1, Pred, Rest2, PosNr) :- | |
| 145 | append(Rest1,[Pred|Rest2],List), length(Rest1,L1), PosNr is L1+1. | |
| 146 | ||
| 147 | % mcdc_true(Level, PredicateToCover, TargetPredicate, TreeOfMDCCriterion) | |
| 148 | mcdc_true(0,Predicate,TargetPred, ResTree) :- !, ResTree=true(TargetPred), TargetPred=Predicate. | |
| 149 | mcdc_true(Level,Predicate,TargetPred, conjunct_true(PosNr,SinglePred,InnerTree)) :- Level>1, | |
| 150 | is_a_conjunct(Predicate,_,_), | |
| 151 | !, L1 is Level-1, | |
| 152 | % select every conjunct and check that we can make it true (with the rest also true) and cover its inner MCDC criteria | |
| 153 | conjunction_to_list(Predicate,List), | |
| 154 | select_pred(List, Rest1, SinglePred, Rest2, PosNr), | |
| 155 | mcdc_true(L1,SinglePred, InnerTargetPred, InnerTree), % compute inner MCDC criteria for selected conjunct SinglePred | |
| 156 | append(Rest1,[InnerTargetPred|Rest2],TargetList), | |
| 157 | conjunct_predicates(TargetList,TargetPred). | |
| 158 | mcdc_true(Level,Predicate,TargetPred, disjunct_true(PosNr,SinglePred,InnerTree)) :- | |
| 159 | is_a_disjunct(Predicate,_,_), | |
| 160 | !, L1 is Level-1, | |
| 161 | % check that every disjunct can be set individually to true: | |
| 162 | % A1 or ... Ai or ... Ak ----------> not(A1) & not(A2) ... Ai & ... not(Ak) | |
| 163 | disjunction_to_list(Predicate,DisjList), | |
| 164 | select_pred(DisjList, Rest1, SinglePred, Rest2, PosNr), | |
| 165 | mcdc_true(L1,SinglePred, InnerTargetPred, InnerTree), | |
| 166 | maplist(create_negation,Rest1,NRest1), | |
| 167 | maplist(create_negation,Rest2,NRest2), | |
| 168 | append(NRest1,[InnerTargetPred|NRest2],TargetList), | |
| 169 | conjunct_predicates(TargetList,TargetPred). | |
| 170 | mcdc_true(Level,Predicate,TargetPred, implication_true(Pos,Pred,InnerTree)) :- | |
| 171 | is_an_implication(Predicate,LHS,RHS), | |
| 172 | !, L1 is Level-1, | |
| 173 | ( mcdc_false(L1,LHS,InnerTargetPred,InnerTree), | |
| 174 | Pos = lhs_false, Pred = LHS, | |
| 175 | create_negation(RHS,NRHS), | |
| 176 | % check not(LHS) & not(RHS) -> relevant that LHS is false, otherwise implication false | |
| 177 | conjunct_predicates([InnerTargetPred,NRHS],TargetPred) | |
| 178 | ; | |
| 179 | mcdc_true(L1,RHS,InnerTargetPred,InnerTree), | |
| 180 | Pos = rhs_true, Pred = RHS, | |
| 181 | % check LHS & RHS -> relevant that RHS is true, otherwise implication false | |
| 182 | conjunct_predicates([LHS,InnerTargetPred],TargetPred) | |
| 183 | ). | |
| 184 | mcdc_true(Level,Predicate,TargetPred, equivalence_true(Pos,Pred,InnerTree)) :- | |
| 185 | is_an_equivalence(Predicate,LHS,RHS), | |
| 186 | !, L1 is Level-1, | |
| 187 | ( /* focus on LHS */ % We try and create TRUE <=> TRUE; we could decide based upon structure of LHS/RHS | |
| 188 | mcdc_true(L1,LHS,InnerTargetPred,InnerTree), | |
| 189 | Pos = lhs_true, Pred = LHS, | |
| 190 | conjunct_predicates([InnerTargetPred,RHS],TargetPred) | |
| 191 | ;/* focus on RHS */ | |
| 192 | mcdc_false(L1,RHS,InnerTargetPred,InnerTree), % we could generate mcdc_true(L1,RHS) also | |
| 193 | Pos = rhs_false, Pred = RHS, | |
| 194 | create_negation(LHS,NLHS), | |
| 195 | conjunct_predicates([NLHS,InnerTargetPred],TargetPred) | |
| 196 | ). | |
| 197 | mcdc_true(Level,Predicate,TargetPred, negation(InnerTree)) :- | |
| 198 | is_a_negation(Predicate,NPred), | |
| 199 | !, | |
| 200 | mcdc_false(Level,NPred,TargetPred, InnerTree). | |
| 201 | mcdc_true(_,Predicate,Predicate,true(Predicate)). | |
| 202 | % TO DO: add implication and equivalence and maybe quantifiers | |
| 203 | ||
| 204 | mcdc_false(0,Predicate,TargetPred,false(Predicate)) :- !, create_negation(Predicate,TargetPred). | |
| 205 | mcdc_false(Level,Predicate,TargetPred, conjunct_false(PosNr,SinglePred,InnerTree)) :- | |
| 206 | is_a_conjunct(Predicate,_,_), | |
| 207 | !, L1 is Level-1, | |
| 208 | % check that every conjunct can be set individually to false: | |
| 209 | % A1 & ... Ai & ... Ak ----------> A1 & A2 ... not(Ai) & ... Ak | |
| 210 | conjunction_to_list(Predicate,List), | |
| 211 | select_pred(List, Rest1, SinglePred, Rest2, PosNr), | |
| 212 | mcdc_false(L1,SinglePred, InnerTargetPred, InnerTree), | |
| 213 | append(Rest1,[InnerTargetPred|Rest2],NewConj), % TO DO: better treatment for well-definedness !? | |
| 214 | % if SinglePred is a WD-Guard for Rest2: do not require to analyse Rest2 ?! | |
| 215 | conjunct_predicates(NewConj,TargetPred). | |
| 216 | mcdc_false(Level,Predicate,TargetPred, disjunct_false(PosNr,SinglePred,InnerTree)) :- Level>1, | |
| 217 | is_a_disjunct(Predicate,_,_), | |
| 218 | !, L1 is Level-1, | |
| 219 | % select every disjunct and check that we can make it false (with the rest also false) and cover its inner MCDC criteria | |
| 220 | disjunction_to_list(Predicate,List), | |
| 221 | select_pred(List, Rest1, SinglePred, Rest2, PosNr), | |
| 222 | maplist(create_negation,Rest1,NRest1), maplist(create_negation,Rest2,NRest2), % negate all other disjuncts | |
| 223 | mcdc_false(L1,SinglePred, InnerTargetPred, InnerTree), % compute inner MCDC criteria for selected conjunct SinglePred | |
| 224 | append(NRest1,[InnerTargetPred|NRest2],TargetList), | |
| 225 | conjunct_predicates(TargetList,TargetPred). | |
| 226 | mcdc_false(Level,Predicate,TargetPred, implication_false(Pos,Pred,InnerTree)) :- Level>1, | |
| 227 | is_an_implication(Predicate,LHS,RHS), | |
| 228 | % check LHS & not(RHS) and generate MCDC criteria for LHS and RHS if Level>1 | |
| 229 | !, L1 is Level-1, | |
| 230 | ( mcdc_true(L1,LHS,InnerTargetPred,InnerTree), % TRUE <=> TRUE with focus on LHS | |
| 231 | Pos = lhs_true, Pred = LHS, | |
| 232 | create_negation(RHS,NRHS), | |
| 233 | conjunct_predicates([InnerTargetPred,NRHS],TargetPred) | |
| 234 | ; | |
| 235 | mcdc_false(L1,RHS,InnerTargetPred,InnerTree), % FALSE <=> FALSE with focus on RHS | |
| 236 | Pos = rhs_false, Pred = RHS, | |
| 237 | conjunct_predicates([LHS,InnerTargetPred],TargetPred) | |
| 238 | ). | |
| 239 | mcdc_false(Level,Predicate,TargetPred, equivalence_false(Pos,Pred,InnerTree)) :- | |
| 240 | is_an_equivalence(Predicate,LHS,RHS), | |
| 241 | !, L1 is Level-1, | |
| 242 | ( /* focus on LHS */ % We create FALSE <=> TRUE and focus on LHS | |
| 243 | mcdc_false(L1,LHS,InnerTargetPred,InnerTree), | |
| 244 | Pos = lhs_false, Pred = LHS, | |
| 245 | conjunct_predicates([InnerTargetPred,RHS],TargetPred) | |
| 246 | ;/* focus on RHS */ | |
| 247 | mcdc_true(L1,RHS,InnerTargetPred,InnerTree), % we generate FALSE <=> TRUE and focus on RHS | |
| 248 | Pos = rhs_false, Pred = RHS, | |
| 249 | create_negation(LHS,NLHS), | |
| 250 | conjunct_predicates([NLHS,InnerTargetPred],TargetPred) | |
| 251 | ). | |
| 252 | mcdc_false(Level,Predicate,TargetPred, negation(InnerTree)) :- | |
| 253 | is_a_negation(Predicate,NPred), | |
| 254 | !, | |
| 255 | mcdc_true(Level,NPred,TargetPred, InnerTree). | |
| 256 | mcdc_false(_,Predicate,TargetPred,false(Predicate)) :- !, create_negation(Predicate,TargetPred). | |
| 257 | ||
| 258 | :- use_module(translate,[print_bexpr/1]). | |
| 259 | explain(true(Pred),L) :- !, indent(L), print('TRUE: '),print_bexpr(Pred),nl. | |
| 260 | explain(false(Pred),L) :- !, indent(L), print('FALSE: '),print_bexpr(Pred),nl. | |
| 261 | explain(conjunct_true(PosNr,Pred,InnerTree),L) :- !, | |
| 262 | indent(L), format('Conjunct ~w TRUE: ',[PosNr]), print_bexpr(Pred), | |
| 263 | nl, | |
| 264 | L1 is L+1, explain(InnerTree,L1). | |
| 265 | explain(conjunct_false(PosNr,Pred,InnerTree),L) :- !, | |
| 266 | get_position_info(Pred,PI), | |
| 267 | indent(L), format('Conjunct ~w~w individually FALSE: ',[PosNr,PI]), %print_bexpr(Pred), | |
| 268 | nl, | |
| 269 | L1 is L+1, explain(InnerTree,L1). | |
| 270 | explain(disjunct_true(PosNr,Pred,InnerTree),L) :- !, | |
| 271 | get_position_info(Pred,PI), | |
| 272 | indent(L), format('Disjunct ~w~w individually TRUE: ',[PosNr,PI]), %print_bexpr(Pred), | |
| 273 | nl, | |
| 274 | L1 is L+1, explain(InnerTree,L1). | |
| 275 | explain(disjunct_false(PosNr,Pred,InnerTree),L) :- !, | |
| 276 | get_position_info(Pred,PI), | |
| 277 | indent(L), format('Disjunct ~w~w FALSE: ',[PosNr,PI]), print_bexpr(Pred), | |
| 278 | nl, | |
| 279 | L1 is L+1, explain(InnerTree,L1). | |
| 280 | explain(implication_true(lhs_false,Pred,InnerTree),L) :- !, | |
| 281 | get_position_info(Pred,PI), | |
| 282 | indent(L), format('Implication LHS~w individually FALSE: ',[PI]), %print_bexpr(Pred), | |
| 283 | nl, | |
| 284 | L1 is L+1, explain(InnerTree,L1). | |
| 285 | explain(implication_true(rhs_true,Pred,InnerTree),L) :- !, | |
| 286 | get_position_info(Pred,PI), | |
| 287 | indent(L), format('Implication RHS~w individually TRUE: ',[PI]), %print_bexpr(Pred), | |
| 288 | nl, | |
| 289 | L1 is L+1, explain(InnerTree,L1). | |
| 290 | explain(equivalence_true(rhs_false,Pred,InnerTree),L) :- !, | |
| 291 | get_position_info(Pred,PI), | |
| 292 | indent(L), format('Equivalence RHS~w FALSE: ',[PI]), %print_bexpr(Pred), | |
| 293 | nl, | |
| 294 | L1 is L+1, explain(InnerTree,L1). | |
| 295 | explain(equivalence_true(lhs_true,Pred,InnerTree),L) :- !, | |
| 296 | get_position_info(Pred,PI), | |
| 297 | indent(L), format('Equivalence LHS~w TRUE: ',[PI]), %print_bexpr(Pred), | |
| 298 | nl, | |
| 299 | L1 is L+1, explain(InnerTree,L1). | |
| 300 | explain(equivalence_false(Pos,Pred,InnerTree),L) :- !, | |
| 301 | get_position_info(Pred,PI), | |
| 302 | indent(L), format('Equivalence ~w ~w: ',[Pos,PI]), %print_bexpr(Pred), | |
| 303 | nl, | |
| 304 | L1 is L+1, explain(InnerTree,L1). | |
| 305 | explain(negation(InnerTree),L) :- !, | |
| 306 | indent(L), print('NEGATION'), | |
| 307 | nl, | |
| 308 | L1 is L+1, explain(InnerTree,L1). | |
| 309 | explain(implication_false(lhs_true,Pred,InnerTree),L) :- !, | |
| 310 | get_position_info(Pred,PI), | |
| 311 | indent(L), format('Implication F with LHS~w TRUE: ',[PI]), %print_bexpr(Pred), | |
| 312 | nl, | |
| 313 | L1 is L+1, explain(InnerTree,L1). | |
| 314 | explain(implication_false(rhs_false,Pred,InnerTree),L) :- !, | |
| 315 | get_position_info(Pred,PI), | |
| 316 | indent(L), format('Implication F with RHS~w FALSE: ',[PI]), %print_bexpr(Pred), | |
| 317 | nl, | |
| 318 | L1 is L+1, explain(InnerTree,L1). | |
| 319 | explain(Term,L) :- indent(L), print(Term),nl, | |
| 320 | add_internal_error('Uncovered Info Tree: ', explain(Term,L)). | |
| 321 | % TO DO: generate a string that can be used e.g. by Tcl/Tk to put into a dialog box ? | |
| 322 | ||
| 323 | indent(0) :- print('+--> '). | |
| 324 | indent(N) :- N>0, print('+--'), N1 is N-1, indent(N1). | |
| 325 | ||
| 326 | get_position_info(Expr,PosStr) :- extract_line_col(Expr,StartRow,StartCol,EndRow,EndCol), !, | |
| 327 | % extract_subsidiary_tail_file_name | |
| 328 | ajoin([' at line ',StartRow,':',StartCol,' - ', EndRow, ':', EndCol],PosStr). | |
| 329 | get_position_info(Expr,PosStr) :- | |
| 330 | bsyntaxtree:get_texpr_labels(Expr,Names),!, | |
| 331 | ajoin([' @', Names],PosStr). | |
| 332 | get_position_info(_,''). | |
| 333 | ||
| 334 | use_position_info_if_not_defined('',Expr,PosStr) :- !, get_position_info(Expr,PosStr). | |
| 335 | use_position_info_if_not_defined(PosStr,_,PosStr). | |
| 336 | ||
| 337 | ||
| 338 | % extract information from criteria tree term | |
| 339 | get_criteria_tree_info(true(Pred),'TRUE',Pred,PosInfo) :- !, get_position_info(Pred,PosInfo). | |
| 340 | get_criteria_tree_info(false(Pred),'FALSE',Pred,PosInfo) :- !, get_position_info(Pred,PosInfo). | |
| 341 | get_criteria_tree_info(conjunct_true(PosNr,CPred,InnerTree),Msg,Pred,Source) :- !, | |
| 342 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 343 | use_position_info_if_not_defined(ISource,CPred,Source), | |
| 344 | ajoin(['&(',PosNr,')T; ',IMsg],Msg). | |
| 345 | get_criteria_tree_info(conjunct_false(PosNr,CPred,InnerTree),Msg,Pred,Source) :- !, | |
| 346 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 347 | use_position_info_if_not_defined(ISource,CPred,Source), | |
| 348 | ajoin(['&(',PosNr,')F; ',IMsg],Msg). | |
| 349 | get_criteria_tree_info(disjunct_true(PosNr,DPred,InnerTree),Msg,Pred,Source) :- !, | |
| 350 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 351 | use_position_info_if_not_defined(ISource,DPred,Source), | |
| 352 | ajoin(['or(',PosNr,')T; ',IMsg],Msg). | |
| 353 | get_criteria_tree_info(disjunct_false(PosNr,DPred,InnerTree),Msg,Pred,Source) :- !, | |
| 354 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 355 | use_position_info_if_not_defined(ISource,DPred,Source), | |
| 356 | ajoin(['or(',PosNr,')F; ',IMsg],Msg). | |
| 357 | get_criteria_tree_info(implication_true(PosLR,ImpPred,InnerTree),Msg,Pred,Source) :- !, | |
| 358 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 359 | use_position_info_if_not_defined(ISource,ImpPred,Source), | |
| 360 | ajoin(['=>(',PosLR,')T; ',IMsg],Msg). | |
| 361 | get_criteria_tree_info(implication_false(PosLR,ImpPred,InnerTree),Msg,Pred,Source) :- !, | |
| 362 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 363 | use_position_info_if_not_defined(ISource,ImpPred,Source), | |
| 364 | ajoin(['=>(',PosLR,')F; ',IMsg],Msg). | |
| 365 | get_criteria_tree_info(equivalence_true(PosLR,ImpPred,InnerTree),Msg,Pred,Source) :- !, | |
| 366 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 367 | use_position_info_if_not_defined(ISource,ImpPred,Source), | |
| 368 | ajoin(['<=>(',PosLR,')T; ',IMsg],Msg). | |
| 369 | get_criteria_tree_info(equivalence_false(PosLR,ImpPred,InnerTree),Msg,Pred,Source) :- !, | |
| 370 | get_criteria_tree_info(InnerTree,IMsg,Pred,ISource), | |
| 371 | use_position_info_if_not_defined(ISource,ImpPred,Source), | |
| 372 | ajoin(['<=>(',PosLR,')F; ',IMsg],Msg). | |
| 373 | get_criteria_tree_info(negation(X),Msg,Pred,Source) :- !, | |
| 374 | get_criteria_tree_info(X,IMsg,Pred,Source), | |
| 375 | ajoin(['neg: ',IMsg],Msg). | |
| 376 | get_criteria_tree_info(T,'UNKNOWN',error,'') :- add_internal_error('Unknown Info Tree: ',T). |