| 1 | % (c) 2014-2024 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(b_simplifier, [simplify_b_predicate/2, tcltk_simplify_b_predicate/2, tcltk_simplify_b_predicate_error/2]). | |
| 6 | ||
| 7 | /* Modules and Infos for the code coverage analysis */ | |
| 8 | :- use_module(probsrc(module_information)). | |
| 9 | :- module_info(group,model_checker). | |
| 10 | :- module_info(description,'This module provides predicates for simplifying B predicates'). | |
| 11 | ||
| 12 | % Classical B prolog modules | |
| 13 | :- use_module(probsrc(bsyntaxtree), [get_texpr_expr/2, get_texpr_type/2, create_texpr/4, | |
| 14 | same_texpr/2, different_texpr_values/2, | |
| 15 | is_truth/1, is_falsity/1, is_negation_of/2, | |
| 16 | is_a_conjunct/3, is_a_disjunct/3, is_an_implication/3, | |
| 17 | conjunct_predicates/2, disjunct_predicates/2, | |
| 18 | %% extract_info/3, | |
| 19 | create_negation/2, | |
| 20 | create_implication/3, create_equivalence/3, | |
| 21 | create_forall/3, create_or_merge_exists/3]). | |
| 22 | :- use_module(probsrc(bmachine),[b_parse_machine_predicate/2]). | |
| 23 | :- use_module(probsrc(kernel_objects),[element_of_global_set/2]). | |
| 24 | ||
| 25 | %% :- use_module(probsrc(parsercall), [parse_predicate/2]). | |
| 26 | ||
| 27 | :- use_module(probsrc(preferences),[temporary_set_preference/3, reset_temporary_preference/2]). | |
| 28 | :- use_module(probsrc(translate), [translate_bexpression/2, generate_typing_predicates/2]). | |
| 29 | %% :- use_module(probsrc(debug), [debug_print/2, debug_println/2, debug_mode/1]). | |
| 30 | :- use_module(probsrc(error_manager),[add_internal_error/2]). | |
| 31 | ||
| 32 | % Importing unit tests predicates | |
| 33 | :- use_module(probsrc(self_check)). | |
| 34 | ||
| 35 | % SICSTUS libraries | |
| 36 | :- use_module(library(avl)). | |
| 37 | :- use_module(library(plunit)). | |
| 38 | ||
| 39 | ||
| 40 | tcltk_simplify_b_predicate_error(String,StringResult) :- | |
| 41 | if(tcltk_simplify_b_predicate(String,StringResult),true, | |
| 42 | (StringResult = 'Error or User-Interrupt')). | |
| 43 | ||
| 44 | % exported for the Tcl/Tk interface | |
| 45 | tcltk_simplify_b_predicate(String,StringResult) :- | |
| 46 | b_parse_machine_predicate(String,Tree), | |
| 47 | simplify_b_predicate(Tree,Res), | |
| 48 | translate_bexpression(Res,StringResult). | |
| 49 | ||
| 50 | %% simplify_b_predicate(+Pred, -Res). | |
| 51 | simplify_b_predicate(Pred,Res) :- | |
| 52 | get_texpr_expr(Pred,Expr), | |
| 53 | get_texpr_type(Pred,Type), | |
| 54 | simplify_b_predicate2(Expr,Type,Res). | |
| 55 | ||
| 56 | simplify_b_predicate2(truth,Type,Res) :- !, | |
| 57 | create_texpr(truth,Type,[],Res). | |
| 58 | simplify_b_predicate2(falsity,Type,Res) :- !, | |
| 59 | create_texpr(falsity,Type,[],Res). | |
| 60 | simplify_b_predicate2(negation(BExpr),_Type,Res) :- !, | |
| 61 | simplify_negation(BExpr,Res). | |
| 62 | simplify_b_predicate2(conjunct(LHS,RHS),Type,Res) :- !, | |
| 63 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 64 | ( is_false_constant(SimplifiedLHS) -> % FALSE & f == FALSE | |
| 65 | create_texpr(falsity,Type,[],Res) | |
| 66 | ; is_true_constant(SimplifiedLHS) -> % TRUE & f == f | |
| 67 | simplify_b_predicate(RHS,Res) | |
| 68 | ; | |
| 69 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 70 | ( is_false_constant(SimplifiedRHS) -> % f & FALSE == FALSE | |
| 71 | create_texpr(falsity,Type,[],Res) | |
| 72 | ; is_true_constant(SimplifiedRHS) -> % f & TRUE == f | |
| 73 | Res = SimplifiedLHS | |
| 74 | ; same_texpr(SimplifiedLHS,SimplifiedRHS) -> % f & f == f (idempotence) | |
| 75 | Res = SimplifiedLHS | |
| 76 | ; is_absorption_rule_conjunct(SimplifiedLHS,SimplifiedRHS,Res) -> % f & (f or g) == f (absorption) | |
| 77 | true | |
| 78 | ; test_transitivity(SimplifiedLHS,SimplifiedRHS,Res) -> % (f => g) & (g => h) == (f => h) | |
| 79 | true | |
| 80 | ; | |
| 81 | conjunct_predicates([SimplifiedLHS,SimplifiedRHS],Res) | |
| 82 | ) | |
| 83 | ). | |
| 84 | simplify_b_predicate2(disjunct(LHS,RHS),Type,Res) :- !, | |
| 85 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 86 | ( is_true_constant(SimplifiedLHS) -> % TRUE or f == TRUE | |
| 87 | create_texpr(truth,Type,[],Res) | |
| 88 | ; is_false_constant(SimplifiedLHS) -> % FALSE or f == f | |
| 89 | simplify_b_predicate(RHS,Res) | |
| 90 | ; | |
| 91 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 92 | ( is_true_constant(SimplifiedRHS) -> % f or TRUE == TRUE | |
| 93 | create_texpr(truth,Type,[],Res) | |
| 94 | ; is_false_constant(SimplifiedRHS) -> % f or FALSE == f | |
| 95 | Res = SimplifiedLHS | |
| 96 | ; same_texpr(SimplifiedLHS,SimplifiedRHS) -> % f or f == f (idempotence) | |
| 97 | Res = SimplifiedLHS | |
| 98 | ; is_absorption_rule_disjunct(LHS,RHS,Res) -> % f or (f & g) == f (absorption) | |
| 99 | true | |
| 100 | ; | |
| 101 | disjunct_predicates([SimplifiedLHS,SimplifiedRHS],Res) | |
| 102 | ) | |
| 103 | ). | |
| 104 | simplify_b_predicate2(implication(LHS,RHS),_Type,Res) :- !, | |
| 105 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 106 | simplify_implication(LHS,SimplifiedRHS,Res). | |
| 107 | simplify_b_predicate2(equivalence(LHS,RHS),Type,Res) :- !, | |
| 108 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 109 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 110 | ( same_texpr(SimplifiedLHS,SimplifiedRHS) -> % f <=> f == TRUE | |
| 111 | create_texpr(truth,Type,[],Res) | |
| 112 | ; is_negation_of(SimplifiedLHS,SimplifiedRHS) -> % f <=> not(f) == FALSE | |
| 113 | create_texpr(falsity,Type,[],Res) | |
| 114 | ; | |
| 115 | create_equivalence(SimplifiedLHS,SimplifiedRHS,Res) | |
| 116 | ). | |
| 117 | simplify_b_predicate2(equal(LHS,RHS),Type,Res) :- !, | |
| 118 | print(equal(LHS,RHS)),nl, | |
| 119 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 120 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 121 | (same_texpr(SimplifiedLHS,SimplifiedRHS) -> | |
| 122 | create_texpr(truth,Type,[],Res) | |
| 123 | ; different_texpr_values(SimplifiedLHS,SimplifiedRHS) -> | |
| 124 | create_texpr(falsity,Type,[],Res) | |
| 125 | ; | |
| 126 | compare('==',SimplifiedLHS,SimplifiedRHS,equal,Type,Res) | |
| 127 | %% extract_info(SimplifiedLHS,SimplifiedRHS,Info), | |
| 128 | %% create_texpr(equal(SimplifiedLHS,SimplifiedRHS),Type,Info,Res) | |
| 129 | ). | |
| 130 | simplify_b_predicate2(not_equal(LHS,RHS),Type,Res) :- !, | |
| 131 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 132 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 133 | (same_texpr(SimplifiedLHS,SimplifiedRHS) -> | |
| 134 | create_texpr(falsity,Type,[],Res) | |
| 135 | ; different_texpr_values(SimplifiedLHS,SimplifiedRHS) -> | |
| 136 | create_texpr(truth,Type,[],Res) | |
| 137 | ; | |
| 138 | compare('=\\=',SimplifiedLHS,SimplifiedRHS,not_equal,Type,Res) | |
| 139 | %% extract_info(SimplifiedLHS,SimplifiedRHS,Info), | |
| 140 | %% create_texpr(not_equal(SimplifiedLHS,SimplifiedRHS),Type,Info,Res) | |
| 141 | ). | |
| 142 | simplify_b_predicate2(greater(LHS,RHS),Type,Res) :- !, | |
| 143 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 144 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 145 | compare('>',SimplifiedLHS,SimplifiedRHS,greater,Type,Res). | |
| 146 | simplify_b_predicate2(greater_equal(LHS,RHS),Type,Res) :- !, | |
| 147 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 148 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 149 | compare('>=',SimplifiedLHS,SimplifiedRHS,greater_equal,Type,Res). | |
| 150 | simplify_b_predicate2(less(LHS,RHS),Type,Res) :- !, | |
| 151 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 152 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 153 | compare('<',SimplifiedLHS,SimplifiedRHS,less,Type,Res). | |
| 154 | simplify_b_predicate2(less_equal(LHS,RHS),Type,Res) :- !, | |
| 155 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 156 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 157 | compare('=<',SimplifiedLHS,SimplifiedRHS,less_equal,Type,Res). | |
| 158 | /* Add more sophisticated implementations for simplifying predicates with quantifiers: | |
| 159 | E.g.: !(x).(x:S => x<21) == max(S) < 21 | |
| 160 | !(x).(x:S => x/=3) == 3/:S */ | |
| 161 | % Quantified predcates | |
| 162 | % !(x).(P => Q) | |
| 163 | simplify_b_predicate2(forall(Ids,LHS,RHS),Type,Res) :- !, | |
| 164 | simplify_b_predicate(RHS,SimplifiedRHS), | |
| 165 | (is_true_constant(SimplifiedRHS) -> | |
| 166 | create_texpr(truth,Type,[],Res) | |
| 167 | ; | |
| 168 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 169 | create_implication(SimplifiedLHS,SimplifiedRHS,ImplicationRes), | |
| 170 | create_forall(Ids,ImplicationRes,Res) | |
| 171 | ). | |
| 172 | % #(x).(P) | |
| 173 | simplify_b_predicate2(exists(Ids,Pred),Type,Res) :- !, | |
| 174 | simplify_b_predicate(Pred,SimplifiedPred), | |
| 175 | (is_true_constant(SimplifiedPred) -> | |
| 176 | create_texpr(truth,Type,[],Res) | |
| 177 | ; is_false_constant(SimplifiedPred) -> | |
| 178 | create_texpr(falsity,Type,[],Res) | |
| 179 | ; | |
| 180 | create_or_merge_exists(Ids,SimplifiedPred,Res) | |
| 181 | ). | |
| 182 | % Simplifying membership relations | |
| 183 | simplify_b_predicate2(member(Element,Set),Type,Res) :- !, | |
| 184 | simplify_membership_predicate(Element,Set,Type,Res). | |
| 185 | simplify_b_predicate2(not_member(Element,Set),Type,Res) :- !, | |
| 186 | simplify_non_membership_predicate(Element,Set,Type,Res). | |
| 187 | % TODO: do we need to safe additional information about the predicates | |
| 188 | simplify_b_predicate2(BExpr,Type,Res) :- | |
| 189 | create_texpr(BExpr,Type,[],Res). | |
| 190 | %% (debug_mode(on) -> | |
| 191 | %% print('Construct not covered yet (b_simplifier):'),nl, | |
| 192 | %% print(BExpr),nl, | |
| 193 | %% translate:print_bexpr(Res),nl | |
| 194 | %% ; true). | |
| 195 | ||
| 196 | simplify_negation(b(negation(BExpr),pred,_), Res) :- !, % double negation "not not f == f" | |
| 197 | simplify_b_predicate(BExpr, Res). | |
| 198 | simplify_negation(Impl, Res) :- | |
| 199 | Impl = b(implication(Lhs,Rhs),pred,Info), | |
| 200 | !, | |
| 201 | simplify_b_predicate(Impl, SImpl), | |
| 202 | ( SImpl \= b(implication(_,_),pred,_) | |
| 203 | -> % implication could be simplified to TRUTH, FALSITY or a single negation | |
| 204 | simplify_b_predicate(b(negation(SImpl),pred,Info), Res) | |
| 205 | ; % "not (a => b) == a and not b" | |
| 206 | NRhs = b(negation(Rhs),pred,[]), | |
| 207 | simplify_b_predicate(b(conjunct(Lhs,NRhs),pred,Info), Res) | |
| 208 | ). | |
| 209 | simplify_negation(b(conjunct(Lhs,Rhs),pred,Info), Res) :- !, | |
| 210 | NLhs = b(negation(Lhs),pred,[]), | |
| 211 | NRhs = b(negation(Rhs),pred,[]), | |
| 212 | simplify_b_predicate(b(disjunct(NLhs,NRhs),pred,Info), Res). | |
| 213 | simplify_negation(b(disjunct(Lhs,Rhs),pred,Info),Res) :- !, | |
| 214 | NLhs = b(negation(Lhs),pred,[]), | |
| 215 | NRhs = b(negation(Rhs),pred,[]), | |
| 216 | simplify_b_predicate(b(conjunct(NLhs,NRhs),pred,Info), Res). | |
| 217 | simplify_negation(b(forall(Ids,Lhs,Rhs),pred,Info),Res) :- !, | |
| 218 | simplify_b_predicate(b(negation(b(implication(Lhs,Rhs),pred,Info)),pred,[]), Body), | |
| 219 | Res = b(exists(Ids,Body),pred,Info). | |
| 220 | simplify_negation(b(exists(Ids,Body),pred,Info),Res) :- !, | |
| 221 | simplify_b_predicate(b(negation(Body),pred,[]), NBody), | |
| 222 | generate_typing_predicates(Ids, TypingList), | |
| 223 | conjunct_predicates(TypingList, Typing), | |
| 224 | Res = b(forall(Ids,Typing,NBody),pred,Info). | |
| 225 | simplify_negation(b(Node,pred,Info),Res) :- | |
| 226 | Node =.. [Functor,Lhs,Rhs], | |
| 227 | negated_binary_pred(Functor, NegFunctor), | |
| 228 | !, | |
| 229 | NegNode =.. [NegFunctor,Lhs,Rhs], | |
| 230 | simplify_b_predicate(b(NegNode,pred,Info), Res). | |
| 231 | simplify_negation(b(Node,pred,Info),Res) :- | |
| 232 | Node =.. [Functor,Lhs,Rhs], | |
| 233 | negate_and_swap(Functor, NegFunctor), | |
| 234 | !, | |
| 235 | NegNode =.. [NegFunctor,Rhs,Lhs], | |
| 236 | simplify_b_predicate(b(NegNode,pred,Info), Res). | |
| 237 | simplify_negation(BExpr, Res) :- | |
| 238 | simplify_b_predicate(BExpr, SimplifiedBExpr), | |
| 239 | % Simplifications like "not(FALSE) == TRUE" and "not(TRUE) == FALSE" will be applied by create_negation/2 | |
| 240 | create_negation(SimplifiedBExpr, Res). | |
| 241 | ||
| 242 | negated_binary_pred(member, not_member). | |
| 243 | negated_binary_pred(not_member, member). | |
| 244 | negated_binary_pred(less, greater_equal). | |
| 245 | negated_binary_pred(less_equal, greater). | |
| 246 | negated_binary_pred(greater, less_equal). | |
| 247 | negated_binary_pred(greater_equal, less). | |
| 248 | negated_binary_pred(equal, not_equal). | |
| 249 | negated_binary_pred(not_equal, equal). | |
| 250 | negated_binary_pred(subset, not_subset). | |
| 251 | negated_binary_pred(not_subset, subset). | |
| 252 | negated_binary_pred(subset_strict, not_subset_strict). | |
| 253 | negated_binary_pred(not_subset_strict, subset_strict). | |
| 254 | ||
| 255 | negate_and_swap(less_real,less_equal_real). | |
| 256 | negate_and_swap(less_equal_real,less_real). | |
| 257 | ||
| 258 | simplify_implication(_LHS,SimplifiedRHS,Res) :- | |
| 259 | is_true_constant(SimplifiedRHS),!, % f => TRUE == TRUE | |
| 260 | create_texpr(truth,pred,[],Res). | |
| 261 | simplify_implication(LHS,SimplifiedRHS,Res) :- | |
| 262 | is_false_constant(SimplifiedRHS),!, % f => FALSE == neg(f) | |
| 263 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 264 | create_negation(SimplifiedLHS,Res). | |
| 265 | simplify_implication(LHS,SimplifiedRHS,Res) :- | |
| 266 | simplify_b_predicate(LHS,SimplifiedLHS), | |
| 267 | (is_false_constant(SimplifiedLHS) -> % FALSE => f == TRUE | |
| 268 | create_texpr(truth,pred,[],Res) | |
| 269 | ; is_true_constant(SimplifiedLHS) -> % TRUE => f == f | |
| 270 | Res = SimplifiedRHS | |
| 271 | ; same_texpr(SimplifiedLHS,SimplifiedRHS) -> % f => f == TRUE | |
| 272 | create_texpr(truth,pred,[],Res) | |
| 273 | ; | |
| 274 | create_implication(SimplifiedLHS,SimplifiedRHS,Res) | |
| 275 | ). | |
| 276 | ||
| 277 | ||
| 278 | %%%%%%%%% This is too trivial, we should consider the absorption and transition rules w.r.t. the origin predicate %%%%%%%%% | |
| 279 | % P or (P & Q) == P | |
| 280 | is_absorption_rule_disjunct(LHS,RHS,Res) :- | |
| 281 | is_a_conjunct(RHS,P,Q), | |
| 282 | (same_texpr(LHS,P); same_texpr(LHS,Q)),!, | |
| 283 | Res = LHS. | |
| 284 | % (P & Q) or P == P | |
| 285 | is_absorption_rule_disjunct(LHS,RHS,Res) :- | |
| 286 | is_a_conjunct(LHS,P,Q), | |
| 287 | (same_texpr(RHS,P); same_texpr(RHS,Q)),!, | |
| 288 | Res = RHS. | |
| 289 | ||
| 290 | % P & (P or Q) == P | |
| 291 | is_absorption_rule_conjunct(LHS,RHS,Res) :- | |
| 292 | is_a_disjunct(RHS,P,Q), | |
| 293 | (same_texpr(LHS,P); same_texpr(LHS,Q)),!, | |
| 294 | Res = LHS. | |
| 295 | % (P or Q) & P == P | |
| 296 | is_absorption_rule_conjunct(LHS,RHS,Res) :- | |
| 297 | is_a_disjunct(LHS,P,Q), | |
| 298 | (same_texpr(RHS,P); same_texpr(RHS,Q)),!, | |
| 299 | Res = RHS. | |
| 300 | ||
| 301 | % (P => Q) & (Q => R) == (P => R) | |
| 302 | test_transitivity(LHS,RHS,Res) :- | |
| 303 | is_an_implication(LHS,P,Q), | |
| 304 | is_an_implication(RHS,Q1,R), | |
| 305 | same_texpr(Q,Q1),!, | |
| 306 | create_implication(P,R,Res). | |
| 307 | % (Q => R) & (P => Q) == (P => R) | |
| 308 | test_transitivity(LHS,RHS,Res) :- | |
| 309 | is_an_implication(LHS,Q,R), | |
| 310 | is_an_implication(RHS,P,Q1), | |
| 311 | same_texpr(Q,Q1),!, | |
| 312 | create_implication(P,R,Res). | |
| 313 | ||
| 314 | ||
| 315 | simplify_non_membership_predicate(Element,Set,Type,Res) :- | |
| 316 | b_integer_value(Element,IsIntValue,EX,_NewElement), | |
| 317 | IsIntValue, | |
| 318 | test_integer_membership(Set,EX,Type,Res1),!, | |
| 319 | (is_true_constant(Res1) -> | |
| 320 | create_texpr(falsity,Type,[],Res) | |
| 321 | ; is_false_constant(Res1) -> | |
| 322 | create_texpr(truth,Type,[],Res) | |
| 323 | ; | |
| 324 | add_internal_error('Internal error: Unexpected result from test_integer_membership/4 predicate in simplify_membership_predicate/4: ',Res1) | |
| 325 | ). | |
| 326 | simplify_non_membership_predicate(Element,Set,Type,Res) :- | |
| 327 | b_integer_value(Element,_IsIntValue,_EX,NewElement), | |
| 328 | create_texpr(not_member(NewElement,Set),Type,[],Res). | |
| 329 | ||
| 330 | simplify_membership_predicate(Element,Set,Type,Res) :- | |
| 331 | b_integer_value(Element,IsIntValue,EX,_NewElement), | |
| 332 | IsIntValue, | |
| 333 | test_integer_membership(Set,EX,Type,Res),!. | |
| 334 | simplify_membership_predicate(Element,Set,Type,Res) :- | |
| 335 | b_integer_value(Element,_IsIntValue,_EX,NewElement), | |
| 336 | create_texpr(member(NewElement,Set),Type,[],Res). | |
| 337 | ||
| 338 | ||
| 339 | test_integer_membership(b(empty_set,set(integer),_),_X,Type,Res) :- !, | |
| 340 | create_texpr(falsity,Type,[],Res). | |
| 341 | test_integer_membership(b(value(avl_set(AVLSet)),set(integer),_),X,Type,Res) :- !, | |
| 342 | (avl_fetch(int(X),AVLSet) -> | |
| 343 | create_texpr(truth,Type,[],Res) | |
| 344 | ; | |
| 345 | create_texpr(falsity,Type,[],Res) | |
| 346 | ). | |
| 347 | test_integer_membership(Set,X,Type,Res) :- | |
| 348 | is_interval_set(Set,Low,Up),!, | |
| 349 | ((Low=<X,X=<Up) -> | |
| 350 | create_texpr(truth,Type,[],Res) | |
| 351 | ; | |
| 352 | create_texpr(falsity,Type,[],Res) | |
| 353 | ). | |
| 354 | test_integer_membership(Set,X,Type,Res) :- | |
| 355 | is_global_integer_set(Set,GlobalSet),!, | |
| 356 | (element_of_global_set(int(X),GlobalSet) -> | |
| 357 | create_texpr(truth,Type,[],Res) | |
| 358 | ; | |
| 359 | create_texpr(falsity,Type,[],Res) | |
| 360 | ). | |
| 361 | ||
| 362 | is_interval_set(b(interval(b(Low,integer,_),b(Up,integer,_)),set(integer),_),Low,Up). | |
| 363 | ||
| 364 | is_global_integer_set(Set,GlobalSet) :- | |
| 365 | get_texpr_expr(Set,SetExpr), | |
| 366 | SetExpr = integer_set(GlobalSet), | |
| 367 | memberchk(GlobalSet,['NATURAL','NAT','INTEGER','INT']). | |
| 368 | ||
| 369 | is_true_constant(Expr) :- | |
| 370 | (is_truth(Expr); Expr=boolean_true). | |
| 371 | ||
| 372 | is_false_constant(Expr) :- | |
| 373 | (is_falsity(Expr); Expr=boolean_false). | |
| 374 | ||
| 375 | compare(Operator,LHS,RHS,Functor,Type,Res) :- | |
| 376 | b_integer_value(LHS,IsIntValueX,EX,NewLHS), | |
| 377 | b_integer_value(RHS,IsIntValueY,EY,NewRHS), | |
| 378 | ((IsIntValueX,IsIntValueY) -> | |
| 379 | (memberchk(Operator,['<','>','=<','>=','==','=\\=']) -> | |
| 380 | Call =.. [Operator,EX,EY], | |
| 381 | (Call -> create_texpr(truth,Type,[],Res); create_texpr(falsity,Type,[],Res)) | |
| 382 | ; | |
| 383 | add_internal_error('Internal error: Unexpected arithmetic comparison Operator: ', Operator), | |
| 384 | BExpr =.. [Functor,NewLHS,NewRHS], | |
| 385 | create_texpr(BExpr,Type,[],Res) | |
| 386 | ) | |
| 387 | ; | |
| 388 | BExpr =.. [Functor,NewLHS,NewRHS], | |
| 389 | create_texpr(BExpr,Type,[],Res) | |
| 390 | ). | |
| 391 | ||
| 392 | b_integer_value(BExpr,IsIntValue,Res,NewBExpr) :- | |
| 393 | b_arithmetic_expression(BExpr,X),!, | |
| 394 | Res is X,IsIntValue=true, | |
| 395 | create_texpr(integer(Res),integer,[],NewBExpr). | |
| 396 | b_integer_value(BExpr,IsIntValue,Res,NewBExpr) :- | |
| 397 | Res = BExpr,IsIntValue=false, | |
| 398 | NewBExpr=BExpr. | |
| 399 | ||
| 400 | b_arithmetic_expression(BExpr,Res) :- | |
| 401 | get_texpr_expr(BExpr,Expr), | |
| 402 | get_texpr_type(BExpr,integer), % only an integer expression | |
| 403 | b_arithmetic_expression1(Expr,Res). | |
| 404 | ||
| 405 | b_arithmetic_expression1(integer(X),X) :- !, | |
| 406 | number(X). | |
| 407 | b_arithmetic_expression1(unary_minus(E),Res) :- !, | |
| 408 | b_arithmetic_expression(E,ERes), | |
| 409 | Res = '-'(ERes). | |
| 410 | b_arithmetic_expression1(add(E1,E2),Res) :- !, | |
| 411 | b_arithmetic_expression(E1,E1Res), | |
| 412 | b_arithmetic_expression(E2,E2Res), | |
| 413 | Res = '+'(E1Res,E2Res). | |
| 414 | b_arithmetic_expression1(minus(E1,E2),Res) :- !, | |
| 415 | b_arithmetic_expression(E1,E1Res), | |
| 416 | b_arithmetic_expression(E2,E2Res), | |
| 417 | Res = '-'(E1Res,E2Res). | |
| 418 | b_arithmetic_expression1(multiplication(E1,E2),Res) :- !, | |
| 419 | b_arithmetic_expression(E1,E1Res), | |
| 420 | b_arithmetic_expression(E2,E2Res), | |
| 421 | Res = '*'(E1Res,E2Res). | |
| 422 | % it is not the same div as in Prolog X/Y will be rounded down | |
| 423 | %% b_arithmetic_expression1(div(E1,E2),Res) :- !, | |
| 424 | %% b_arithmetic_expression(E1,E1Res), | |
| 425 | %% b_arithmetic_expression(E2,E2Res), | |
| 426 | %% Res = '//'(E1Res,E2Res). | |
| 427 | ||
| 428 | ||
| 429 | :- begin_tests(simplify_b_predicate). | |
| 430 | ||
| 431 | test(simplify_neg_conj, [all(Simplified = [b(less_equal(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,[])])]) :- | |
| 432 | IntOne = b(integer(1),integer,[]), | |
| 433 | Id = b(identifier(x),integer,[]), | |
| 434 | Greater = b(greater(Id,IntOne),pred,[]), | |
| 435 | Pred = b(negation(b(conjunct(Greater,Greater),pred,[])),pred,[]), | |
| 436 | simplify_b_predicate(Pred, Simplified), | |
| 437 | ground(Simplified). | |
| 438 | ||
| 439 | test(simplify_neg_disj, [all(Simplified = [b(less_equal(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,[])])]) :- | |
| 440 | IntOne = b(integer(1),integer,[]), | |
| 441 | Id = b(identifier(x),integer,[]), | |
| 442 | Greater = b(greater(Id,IntOne),pred,[]), | |
| 443 | Pred = b(negation(b(disjunct(Greater,Greater),pred,[])),pred,[]), | |
| 444 | simplify_b_predicate(Pred, Simplified), | |
| 445 | ground(Simplified). | |
| 446 | ||
| 447 | test(simplify_neg_equal, [all(Simplified = [b(not_equal(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,_)])]) :- | |
| 448 | IntOne = b(integer(1),integer,[]), | |
| 449 | Id = b(identifier(x),integer,[]), | |
| 450 | Pred = b(negation(b(equal(Id,IntOne),pred,[])),pred,[]), | |
| 451 | simplify_b_predicate(Pred, Simplified), | |
| 452 | ground(Simplified). | |
| 453 | ||
| 454 | test(simplify_neg_not_equal, [all(Simplified = [b(equal(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,_)])]) :- | |
| 455 | IntOne = b(integer(1),integer,[]), | |
| 456 | Id = b(identifier(x),integer,[]), | |
| 457 | Pred = b(negation(b(not_equal(Id,IntOne),pred,[])),pred,[]), | |
| 458 | simplify_b_predicate(Pred, Simplified), | |
| 459 | ground(Simplified). | |
| 460 | ||
| 461 | test(simplify_impl_to_truth, [all(Simplified = [b(truth,pred,[])])]) :- | |
| 462 | IntOne = b(integer(1),integer,[]), | |
| 463 | Id = b(identifier(x),integer,[]), | |
| 464 | Greater = b(greater(Id,IntOne),pred,[]), | |
| 465 | Pred = b(implication(Greater,Greater),pred,[]), | |
| 466 | simplify_b_predicate(Pred, Simplified), | |
| 467 | ground(Simplified). | |
| 468 | ||
| 469 | test(simplify_impl_to_falsity, [all(Simplified = [b(falsity,pred,[])])]) :- | |
| 470 | IntOne = b(integer(1),integer,[]), | |
| 471 | Id = b(identifier(x),integer,[]), | |
| 472 | Greater = b(greater(Id,IntOne),pred,[]), | |
| 473 | Pred = b(negation(b(implication(Greater,Greater),pred,[])),pred,[]), | |
| 474 | simplify_b_predicate(Pred, Simplified), | |
| 475 | ground(Simplified). | |
| 476 | ||
| 477 | test(simplify_impl_same, [all(Simplified = [b(implication(b(greater(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,[]),b(less(b(identifier(y),integer,[]),b(integer(1),integer,[])),pred,[])),pred,[])])]) :- | |
| 478 | IntOne = b(integer(1),integer,[]), | |
| 479 | Id1 = b(identifier(x),integer,[]), | |
| 480 | Id2 = b(identifier(y),integer,[]), | |
| 481 | Greater = b(greater(Id1,IntOne),pred,[]), | |
| 482 | Less = b(less(Id2,IntOne),pred,[]), | |
| 483 | Pred = b(implication(Greater,Less),pred,[]), | |
| 484 | simplify_b_predicate(Pred, Simplified), | |
| 485 | ground(Simplified). | |
| 486 | ||
| 487 | test(simplify_neg_impl, [all(Simplified = [b(conjunct(b(greater(b(identifier(x),integer,[]),b(integer(1),integer,[])),pred,[]),b(greater_equal(b(identifier(y),integer,[]),b(integer(1),integer,[])),pred,[])),pred,[])])]) :- | |
| 488 | IntOne = b(integer(1),integer,[]), | |
| 489 | Id1 = b(identifier(x),integer,[]), | |
| 490 | Id2 = b(identifier(y),integer,[]), | |
| 491 | Greater = b(greater(Id1,IntOne),pred,[]), | |
| 492 | Less = b(less(Id2,IntOne),pred,[]), | |
| 493 | Pred = b(negation(b(implication(Greater,Less),pred,[])),pred,[]), | |
| 494 | simplify_b_predicate(Pred, Simplified), | |
| 495 | ground(Simplified). | |
| 496 | ||
| 497 | :- end_tests(simplify_b_predicate). | |
| 498 |