| 1 | % (c) 2009-2025 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_interpreter_check,[imply_test_boolean_expression/7, | |
| 6 | equiv_test_boolean_expression/7, | |
| 7 | equiv_bidrectional_test_boolean_expression/7, | |
| 8 | get_priority_of_boolean_expression/2, get_priority_of_boolean_expression2/2, | |
| 9 | b_check_boolean_expression/5,b_check_boolean_expression/7, | |
| 10 | b_force_check_boolean_expression/5, | |
| 11 | ||
| 12 | /* some lower-level propagation predicates */ | |
| 13 | imply/3, imply_true/2, | |
| 14 | b_check_forall_wf/8, b_check_exists_wf/7, | |
| 15 | ||
| 16 | reify_closure_with_small_cardinality/5, | |
| 17 | ||
| 18 | register_predicate/6, | |
| 19 | norm_pred_check/2, norm_expr_check/2, norm_check/2, | |
| 20 | ||
| 21 | conjoin/6, disjoin/6, | |
| 22 | check_less_than_equal/3 | |
| 23 | ]). | |
| 24 | ||
| 25 | /* A version for checking the truth value of boolean-expressions, | |
| 26 | the result is instantiated with pred_true/pred_false as soon as the result is known */ | |
| 27 | /* Warning: does not cover all expressions */ | |
| 28 | /* It provides SMT-like performance, for predicates involving arithmetic comparisons (<,...), | |
| 29 | equality, disequality and membership/not_membership | |
| 30 | It is not restricted to CNF | |
| 31 | */ | |
| 32 | ||
| 33 | :- meta_predicate wd_delay(0,-,-,-). | |
| 34 | :- meta_predicate wd_delay_block(0,-,-,-,-,-). | |
| 35 | :- meta_predicate wd_delay_until_needed(-,0). | |
| 36 | :- meta_predicate wd_delay_until_needed_block(-,-,0). | |
| 37 | ||
| 38 | :- use_module(debug). | |
| 39 | :- use_module(self_check). | |
| 40 | :- use_module(error_manager). | |
| 41 | :- use_module(b_interpreter,[b_compute_expression/5, b_not_test_boolean_expression/6, b_test_boolean_expression/6, b_test_boolean_expression/4]). | |
| 42 | :- use_module(kernel_waitflags). | |
| 43 | :- use_module(performance_messages). | |
| 44 | :- use_module(translate,[print_bexpr/1, convert_and_ajoin_ids/2]). | |
| 45 | ||
| 46 | ||
| 47 | :- use_module(kernel_objects,[less_than_direct/2, less_than_equal_direct/2]). | |
| 48 | ||
| 49 | :- use_module(kernel_equality). | |
| 50 | ||
| 51 | :- use_module(tools). | |
| 52 | ||
| 53 | :- use_module(module_information,[module_info/2]). | |
| 54 | :- module_info(group,interpreter). | |
| 55 | :- module_info(description,'This module provides a reified interpreter for certain predicates.'). | |
| 56 | ||
| 57 | ||
| 58 | ||
| 59 | ||
| 60 | :- block imply_test_boolean_expression(-, ?,?,?,?,?,?). % TO DO: pass at least Ai to it | |
| 61 | imply_test_boolean_expression(PredRes1,PredRes2, RHS,LocalState,State,WF,Ai) :- | |
| 62 | (PredRes1=PredRes2 | |
| 63 | -> b_test_boolean_expression(RHS,LocalState,State,WF,Ai,_) | |
| 64 | ; true | |
| 65 | ). | |
| 66 | ||
| 67 | :- block equiv_test_boolean_expression(-, ?,?,?,?,?,?). | |
| 68 | equiv_test_boolean_expression(PredRes,PredRes, RHS,LocalState,State,WF,Ai) :- !, | |
| 69 | b_test_boolean_expression(RHS,LocalState,State,WF,Ai,_). | |
| 70 | equiv_test_boolean_expression(_PredRes,_, RHS,LocalState,State,WF,Ai) :- | |
| 71 | b_not_test_boolean_expression(RHS,LocalState,State,WF,Ai,_). | |
| 72 | ||
| 73 | equiv_bidrectional_test_boolean_expression(PredResLHS,PredResRHS, _LHS,_RHS,_LocalState,_State,WF) :- | |
| 74 | PredResLHS=PredResRHS, | |
| 75 | (var(PredResLHS) | |
| 76 | -> % create a choice point to enumerate two possible solutions | |
| 77 | % important, e.g., for not((y > 0 & y * y > 20) <=> (y * y > 25 & y > 0)) | |
| 78 | get_last_wait_flag(equivalence,WF,LWF), | |
| 79 | enum_bool(PredResLHS,LWF) | |
| 80 | ; true). | |
| 81 | :- block enum_bool(-,-). | |
| 82 | enum_bool(pred_true,_). | |
| 83 | enum_bool(pred_false,_). | |
| 84 | /* | |
| 85 | :- block equiv_bidrectional_test_boolean_expression(-,-, ?,?,?,?,?). | |
| 86 | equiv_bidrectional_test_boolean_expression(PredResLHS,PredResRHS, LHS,RHS,LocalState,State,WF) :- | |
| 87 | ( PredResLHS == pred_true -> b_test_boolean_expression(RHS,LocalState,State,WF) | |
| 88 | ; PredResLHS == pred_false -> b_not_test_boolean_expression(RHS,LocalState,State,WF) | |
| 89 | ; PredResRHS == pred_true -> b_test_boolean_expression(LHS,LocalState,State,WF) | |
| 90 | ; PredResRHS == pred_false -> b_not_test_boolean_expression(LHS,LocalState,State,WF) | |
| 91 | ; add_error_fail(equiv,'Illegal values: ',equiv_bidrectional_test_boolean_expression(PredResLHS,PredResRHS)) | |
| 92 | ). | |
| 93 | */ | |
| 94 | ||
| 95 | % return starting priority for binary choice points; should be power of 2 | |
| 96 | get_priority_of_boolean_expression(priority(P),Prio) :- !, | |
| 97 | % case generated for disjoin by contains_fd_element, and not_in_difference_set_wf,not_in_intersection_set_wf,in_union_set_wf | |
| 98 | Prio=P. | |
| 99 | get_priority_of_boolean_expression(b(Expr,_,_Infos),Prio) :- !, | |
| 100 | % try to estimate a priority for performing a case split upon a predicate | |
| 101 | % i.e., forcing a predicate Expr to be true/false | |
| 102 | get_priority_of_boolean_expression2(Expr,Prio). | |
| 103 | get_priority_of_boolean_expression(E,Prio) :- | |
| 104 | add_internal_error('Boolean expression not properly wrapped: ',get_priority_of_boolean_expression(E,Prio)), | |
| 105 | get_priority_of_boolean_expression2(E,Prio). | |
| 106 | ||
| 107 | :- use_module(bsyntaxtree). | |
| 108 | get_priority_of_boolean_expression2(truth,1) :- !. %, nl,nl,print('TRUTH in disjunct/conjunct'),nl. | |
| 109 | get_priority_of_boolean_expression2(falsity,1) :- !. %, nl,nl,print('FALSITY in disjunct/conjunct'),nl. | |
| 110 | get_priority_of_boolean_expression2(_,R) :- | |
| 111 | preferences:preference(data_validation_mode,true), % in data validation mode we want to drive enumeration from data values only | |
| 112 | !, R=4096. | |
| 113 | get_priority_of_boolean_expression2(_,R) :- !, R=4. % force SMT style case-splitting; was 3 before using get_binary_choice_wait_flag_exp_backoff; raising this to 4 makes test 1358, 49 behave better (baload_R07 recognised possible) | |
| 114 | ||
| 115 | ||
| 116 | ||
| 117 | ||
| 118 | count_number_of_conjuncts(b(Expr,_,_Infos),Prio) :- !, | |
| 119 | count_number_of_conjuncts2(Expr,Prio). | |
| 120 | count_number_of_conjuncts(priority(_),Prio) :- !, Prio=1. | |
| 121 | count_number_of_conjuncts(B,Prio) :- | |
| 122 | add_internal_error('Expression not wrapped: ',count_number_of_conjuncts(B,Prio)),Prio=1. | |
| 123 | count_number_of_conjuncts2(conjunct(A,B),Nr) :- !, count_number_of_conjuncts(A,NA), | |
| 124 | count_number_of_conjuncts(B,NB), Nr is NA+NB. | |
| 125 | count_number_of_conjuncts2(norm_conjunct(_,RHS),Res) :- length(RHS,Len),!, | |
| 126 | Res is Len+1. | |
| 127 | count_number_of_conjuncts2(negation(A),Nr) :- !, count_number_of_disjuncts(A,Nr). | |
| 128 | count_number_of_conjuncts2(_,1). | |
| 129 | ||
| 130 | :- public count_number_of_disjuncts/2. %currently commented out above | |
| 131 | count_number_of_disjuncts(b(Expr,_,_Infos),Prio) :- !, | |
| 132 | count_number_of_disjuncts2(Expr,Prio). | |
| 133 | count_number_of_disjuncts(priority(_),Prio) :- !, Prio=1. | |
| 134 | count_number_of_disjuncts(B,Prio) :- | |
| 135 | add_internal_error('Expression not wrapped: ',count_number_of_disjuncts(B,Prio)),Prio=1. | |
| 136 | count_number_of_disjuncts2(disjunct(A,B),Nr) :- !, count_number_of_disjuncts(A,NA), | |
| 137 | count_number_of_disjuncts(B,NB), Nr is NA+NB. | |
| 138 | count_number_of_disjuncts2(norm_disjunct(_,RHS),Res) :- length(RHS,Len),!, | |
| 139 | Res is Len+1. | |
| 140 | count_number_of_disjuncts2(negation(A),Nr) :- !, count_number_of_conjuncts(A,Nr). | |
| 141 | count_number_of_disjuncts2(_,1). | |
| 142 | ||
| 143 | ||
| 144 | ||
| 145 | % we need to ensure that b_check_boolean_expression does not create a choice point on its own | |
| 146 | ||
| 147 | b_check_boolean_expression(b(Expr,_,Infos),LS,S,WF,Res) :- | |
| 148 | (composed(Expr) -> empty_avl(Ai) | |
| 149 | ; Ai = no_avl), % simple expression: no sharing is possible: no need to register expressions | |
| 150 | create_wfwd_needed(WF,WFD), | |
| 151 | b_check_boolean_expression2(Expr,Infos,LS,S,WFD,Res,Ai,_). | |
| 152 | ||
| 153 | composed(negation(_)). | |
| 154 | composed(conjunct(_,_)). | |
| 155 | composed(disjunct(_,_)). | |
| 156 | composed(implication(_,_)). | |
| 157 | composed(equivalence(_,_)). | |
| 158 | composed(let_predicate(_,_,_)). | |
| 159 | composed(lazy_let_pred(_,_,_)). | |
| 160 | ||
| 161 | b_check_boolean_expression(E,LS,S,WF,Res,Ai,Ao) :- | |
| 162 | % WFD adds information about WD context: wfwd(WF_store, ExpectedVal, Val,Infos) | |
| 163 | % when Val becomes nonvar: if Val==ExpectedVal we need the value of E, otherwise it should be discarded | |
| 164 | create_wfwd_needed(WF,WFD), | |
| 165 | b_check_boolean_expression1(E,LS,S,WFD,Res,Ai,Ao). | |
| 166 | ||
| 167 | b_check_boolean_expression0(WDE,WDV,Expr,LS,S,WF,Res,Ai,Ao) :- | |
| 168 | create_wfwd(WF,WDE,WDV,WFD), | |
| 169 | b_check_boolean_expression1(Expr,LS,S,WFD,Res,Ai,Ao). | |
| 170 | ||
| 171 | ||
| 172 | b_check_boolean_expression1(b(Expr,_,Infos),LS,S,WFD,Res,Ai,Ao) :- get_wd(WFD,WDE,WDV),!, | |
| 173 | % print('check : '), translate:print_bexpr(b(Expr,pred,Infos)),nl, | |
| 174 | (nonvar(WDV),WDE \= WDV % the expression Expr is not needed | |
| 175 | -> Ai=Ao, | |
| 176 | (var(Res) | |
| 177 | -> Res=pred_false % set it to false, value does not matter; note: predicate is not reused | |
| 178 | ; true) | |
| 179 | ; b_check_boolean_expression2(Expr,Infos,LS,S,WFD,Res,Ai,Ao)). | |
| 180 | b_check_boolean_expression1(E,LS,S,WFD,Res,Ai,Ao) :- | |
| 181 | add_internal_error('Boolean expression not properly wrapped: ',b_check_boolean_expression1(E,LS,S,WFD,Res,Ai,Ao)), | |
| 182 | b_check_boolean_expression2(E,[],LS,S,WFD,Res,Ai,Ao). | |
| 183 | ||
| 184 | % normalise conjunction into flat list of conjuncts | |
| 185 | normalise_conjunct(b(E,_,Info)) --> normalise_conjunct2(E,Info). | |
| 186 | normalise_conjunct2(conjunct(A,B),_) --> !,normalise_conjunct(A),normalise_conjunct(B). | |
| 187 | normalise_conjunct2(F,Info) --> [b(F,pred,Info)]. | |
| 188 | ||
| 189 | construct_norm_conjunct(A,b(B,pred,Info)) :- construct_norm_conjunct2(A,B,Info). | |
| 190 | construct_norm_conjunct2([],truth,[]). | |
| 191 | construct_norm_conjunct2([H|T],Res,Info) :- | |
| 192 | (T==[] -> H=b(Res,pred,Info) ; Res=norm_conjunct(H,T),Info=[]). | |
| 193 | % TO DO: build up member(contains_wd_condition,Infos) | |
| 194 | ||
| 195 | ||
| 196 | % normalise disjunction into flat list of disjuncts | |
| 197 | normalise_disjunct(b(E,_,Info)) --> normalise_disjunct2(E,Info). | |
| 198 | normalise_disjunct2(disjunct(A,B),_) --> !,normalise_disjunct(A),normalise_disjunct(B). | |
| 199 | normalise_disjunct2(F,Info) --> [b(F,pred,Info)]. | |
| 200 | ||
| 201 | construct_norm_disjunct(A,b(B,pred,Info)) :- construct_norm_disjunct2(A,B,Info). | |
| 202 | construct_norm_disjunct2([],falsity,[]). | |
| 203 | construct_norm_disjunct2([H|T],Res,Info) :- | |
| 204 | (T==[] -> H=b(Res,pred,Info) ; Res=norm_disjunct(H,T),Info=[]). | |
| 205 | ||
| 206 | can_negate_expression(b(Expr,pred,I),b(NExpr,pred,I)) :- can_negate2(Expr,NExpr). | |
| 207 | can_negate2(equal(A,B),not_equal(A,B)). | |
| 208 | can_negate2(not_equal(A,B),equal(A,B)). | |
| 209 | can_negate2(member(A,B),not_member(A,B)). | |
| 210 | can_negate2(not_member(A,B),member(A,B)). | |
| 211 | can_negate2(subset(A,B),not_subset(A,B)). | |
| 212 | can_negate2(not_subset(A,B),subset(A,B)). | |
| 213 | can_negate2(subset_strict(A,B),not_subset_strict(A,B)). | |
| 214 | can_negate2(not_subset_strict(A,B),subset_strict(A,B)). | |
| 215 | can_negate2(greater_equal(A,B),less(A,B)). | |
| 216 | can_negate2(less(A,B),greater_equal(A,B)). | |
| 217 | can_negate2(less_equal(A,B),greater(A,B)). | |
| 218 | can_negate2(greater(A,B),less_equal(A,B)). | |
| 219 | can_negate2(less_real(A,B),less_equal_real(B,A)). | |
| 220 | can_negate2(less_equal_real(A,B),less_real(B,A)). | |
| 221 | ||
| 222 | b_check_boolean_expression2(truth,_,_,_,_WFD,Res,Ai,Ao) :- !,Res=pred_true, Ai=Ao. | |
| 223 | b_check_boolean_expression2(falsity,_,_,_,_WFD,Res,Ai,Ao) :- !,Res=pred_false, Ai=Ao. | |
| 224 | b_check_boolean_expression2(negation(BExpr),_,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 225 | (can_negate_expression(BExpr,NBExpr) | |
| 226 | -> /* avoid introducing negate propagator; maybe not necessary */ | |
| 227 | b_check_boolean_expression1(NBExpr,LocalState,State,WFD,Res,Ai,Ao) | |
| 228 | ; negate(NR,Res), | |
| 229 | b_check_boolean_expression1(BExpr,LocalState,State,WFD,NR,Ai,Ao)). | |
| 230 | b_check_boolean_expression2(conjunct(LHS,RHS),CInfo,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 231 | normalise_conjunct2(conjunct(LHS,RHS),CInfo,NormRes,[]), | |
| 232 | construct_norm_conjunct2(NormRes,NC,Info), | |
| 233 | b_check_boolean_expression2(NC,Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 234 | b_check_boolean_expression2(norm_conjunct(LHS,RHS),_,LocalState,State,wfwd(WF,WDE,WDV,_),Res,Ai,Ao) :- !, | |
| 235 | construct_norm_conjunct(RHS,NC), | |
| 236 | conjoin(LR,RR,Res,LHS,NC,WF), | |
| 237 | create_wfwd(WF,WDE,WDV,WFD), | |
| 238 | b_check_boolean_expression1(LHS,LocalState,State,WFD,LR,Ai,Aii), | |
| 239 | propagagate_wfwd(WDE,WDV,GuardFlag,LR,pred_false), % if WDE/=WDV then set GuardFlag to pred_false; indicating to RHS that it is not needed also | |
| 240 | b_check_boolean_expression0(pred_true,GuardFlag,NC,LocalState,State,WF,RR,Aii,Ao). | |
| 241 | b_check_boolean_expression2(implication(LHS,RHS),_,LocalState,State,wfwd(WF,WDE,WDV,_),Res,Ai,Ao) :- !, | |
| 242 | imply(LR,RR,Res), | |
| 243 | create_wfwd(WF,WDE,WDV,WFD), | |
| 244 | b_check_boolean_expression1(LHS,LocalState,State,WFD,LR,Ai,Aii), | |
| 245 | propagagate_wfwd(WDE,WDV,GuardFlag,LR,pred_false), | |
| 246 | b_check_boolean_expression0(pred_true,GuardFlag,RHS,LocalState,State,WF,RR,Aii,Ao). | |
| 247 | b_check_boolean_expression2(equivalence(LHS,RHS),_,LocalState,State,WFD,Res,Ai,Ao) :- !, equiv(LR,RR,Res), | |
| 248 | b_check_boolean_expression1(LHS,LocalState,State,WFD,LR,Ai,Aii), | |
| 249 | b_check_boolean_expression1(RHS,LocalState,State,WFD,RR,Aii,Ao). | |
| 250 | b_check_boolean_expression2(disjunct(LHS,RHS),CInfo,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 251 | normalise_disjunct2(disjunct(LHS,RHS),CInfo,NormRes,[]), | |
| 252 | construct_norm_disjunct2(NormRes,NC,Info), | |
| 253 | b_check_boolean_expression2(NC,Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 254 | b_check_boolean_expression2(norm_disjunct(LHS,RHS),_,LocalState,State,wfwd(WF,WDE,WDV,_),Res,Ai,Ao) :- !, | |
| 255 | construct_norm_disjunct(RHS,NC), | |
| 256 | disjoin(LR,RR,Res,LHS,NC,WF), | |
| 257 | create_wfwd(WF,WDE,WDV,WFD), | |
| 258 | b_check_boolean_expression1(LHS,LocalState,State,WFD,LR,Ai,Aii), | |
| 259 | propagagate_wfwd(WDE,WDV,GuardFlag,LR,pred_true), | |
| 260 | b_check_boolean_expression0(pred_false,GuardFlag,NC,LocalState,State,WF,RR,Aii,Ao). | |
| 261 | b_check_boolean_expression2(let_predicate(Ids,AssignmentExprs,Pred),_Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 262 | wd_set_up_localstate_for_let(Ids,AssignmentExprs,LocalState,State,LetState,WFD), | |
| 263 | Ao=Ai, % anything cached inside the LET may depend on Ids and should not be reused outside of LET, see test 2397 | |
| 264 | empty_avl(InnerAi), % we can only reuse predicates inside if Ids are fresh, see test 2398 | |
| 265 | b_check_boolean_expression1(Pred,LetState,State,WFD,Res,InnerAi,_). | |
| 266 | b_check_boolean_expression2(lazy_let_pred(Id,AssignmentExpr,Pred),_I,LocalState,State,wfwd(WF,WDE,WDV,_),Res,Ai,Ao) :- !, | |
| 267 | set_up_localstate([Id],[(Trigger,IdValue)],LocalState,LetState), | |
| 268 | b_interpreter:lazy_compute_expression(Trigger,AssignmentExpr,LocalState,State,IdValue,WF,Ai), | |
| 269 | create_wfwd(WF,WDE,WDV,WFD), | |
| 270 | b_check_boolean_expression1(Pred,LetState,State,WFD,Res,Ai,Ao). % Lazy lets always unique, we can pass Ai | |
| 271 | b_check_boolean_expression2(lazy_lookup_pred(Id),Info,LocalState,_State,WFD,Res,Ai,Ao) :- !, Ai=Ao, | |
| 272 | store:lookup_value_for_existing_id(Id,LocalState,(Trigger,Value)), % should normally only occur in LocalState; value introduced by lazy_let | |
| 273 | wd_delay(((Trigger,Value) = (pred_true,Res)), | |
| 274 | Res,b(lazy_lookup_pred(Id),pred,Info),WFD). | |
| 275 | b_check_boolean_expression2(value(V),_Info,_LocalState,_State,_WFD,Res,Ai,Ao) :- !, % this can occur when lazy_lookup_pred gets compiled by b_compiler | |
| 276 | Res=V,Ai=Ao. | |
| 277 | b_check_boolean_expression2(not_equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 278 | (negate_equal_false(LHS,RHS,LHS1,RHS1) | |
| 279 | -> /* X/=FALSE equivalent to X=TRUE */ | |
| 280 | b_check_boolean_expression3_pos(equal(LHS1,RHS1),Info,LocalState,State,WFD,Res,Ai,Ao) | |
| 281 | ; b_check_boolean_expression3_neg(equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) | |
| 282 | ). | |
| 283 | b_check_boolean_expression2(equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 284 | (negate_equal_false(LHS,RHS,LHS1,RHS1) | |
| 285 | -> RHS1=b(boolean_true,boolean,[]), /* X/=FALSE equivalent to X=TRUE */ | |
| 286 | b_check_boolean_expression3_neg(equal(LHS1,RHS1),Info,LocalState,State,WFD,Res,Ai,Ao) | |
| 287 | ; b_check_boolean_expression3_pos(equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) | |
| 288 | ). | |
| 289 | b_check_boolean_expression2(not_member(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 290 | b_check_boolean_expression3_neg(member(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 291 | b_check_boolean_expression2(not_subset(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 292 | b_check_boolean_expression3_neg(subset(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 293 | b_check_boolean_expression2(not_subset_strict(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 294 | b_check_boolean_expression3_neg(subset_strict(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 295 | b_check_boolean_expression2(greater(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 296 | b_check_boolean_expression3_pos(less(RHS,LHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 297 | b_check_boolean_expression2(greater_equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 298 | b_check_boolean_expression3_neg(less(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 299 | b_check_boolean_expression2(less_equal(LHS,RHS),Info,LocalState,State,WFD,Res,Ai,Ao) :- !, | |
| 300 | b_check_boolean_expression3_neg(less(RHS,LHS),Info,LocalState,State,WFD,Res,Ai,Ao). | |
| 301 | b_check_boolean_expression2(Pred,Infos,LocalState,State,WFD,Res,Ai,Ao) :- | |
| 302 | b_check_boolean_expression3_pos(Pred,Infos,LocalState,State,WFD,Res,Ai,Ao). | |
| 303 | ||
| 304 | ||
| 305 | % check whether one of the two arguments is FALSE | |
| 306 | % translate X/=FALSE -> X=TRUE for normalisation purposes | |
| 307 | negate_equal_false(b(boolean_false,boolean,_),E,E,b(boolean_true,boolean,[])). | |
| 308 | negate_equal_false(E,b(boolean_false,boolean,_),E,b(boolean_true,boolean,[])). | |
| 309 | ||
| 310 | b_check_boolean_expression3_pos(Pred,Infos,LocalState,State,WFD,Res,Ai,Ao) :- | |
| 311 | %print(register_predicate(WFD)),nl,portray_avl(Ai),nl, | |
| 312 | register_predicate_wfd(WFD,Pred,Infos,Res,Reused,Ai,Ai2), | |
| 313 | (Reused=true | |
| 314 | -> Ao=Ai2 % , print(reused_pred(Res,WFD,Infos)),nl | |
| 315 | ; b_check_boolean_expression4(Pred,Infos,LocalState,State,WFD,Ok,Res), | |
| 316 | (Ok=ok_to_store -> Ao=Ai2 ; Ao=Ai) | |
| 317 | ). | |
| 318 | ||
| 319 | b_check_boolean_expression3_neg(Pred,Infos,LocalState,State,WFD,NegRes,Ai,Ao) :- | |
| 320 | %print(register_neg_predicate(WFD,Infos,Pred)),nl, | |
| 321 | register_predicate_wfd(WFD,Pred,Infos,Res,Reused,Ai,Ai2), negate(Res,NegRes), | |
| 322 | (Reused=true | |
| 323 | -> Ao=Ai2 | |
| 324 | ; b_check_boolean_expression4(Pred,Infos,LocalState,State,WFD,Ok,Res), | |
| 325 | (Ok=ok_to_store -> Ao=Ai2 ; Ao=Ai) | |
| 326 | ). | |
| 327 | ||
| 328 | % Register a new predicate in the AVL tree if either forced or non-WD condition inside | |
| 329 | register_predicate_wfd(_,_,_,_,false,Ai,Ao) :- Ai = no_avl,!, Ai=Ao. | |
| 330 | register_predicate_wfd(_,_Pred,_Infos,_,false,Ai,Ao) :- | |
| 331 | preferences:preference(use_common_subexpression_elimination,true), | |
| 332 | preferences:preference(use_common_subexpression_also_for_predicates,true), | |
| 333 | preferences:preference(disprover_mode,false), % there are still a few things detected here that CSE does not detect (=FALSE,=TRUE,...) | |
| 334 | !, % CSE already statically detects these ( all of the time !?) | |
| 335 | Ai=Ao. | |
| 336 | register_predicate_wfd(WFWD,Pred,Infos,PredTruthVar,Reused,Ai,Ao) :- | |
| 337 | get_wd(WFWD,A,B), | |
| 338 | (A==B -> register_predicate_aux(Pred,PredTruthVar,Reused,Ai,Ao) % it will be evaluated; we can share it | |
| 339 | ; nonmember(contains_wd_condition,Infos) -> register_predicate_aux(Pred,PredTruthVar,Reused,Ai,Ao) | |
| 340 | % Pred is not guaranteed to be evaluated: WD-condition + not in forced WFD context (beware of exists!) | |
| 341 | ; register_predicate_aux(Pred,PredTruthVar,true,Ai,Ao) -> Reused=true % the predicate is already stored | |
| 342 | % Note: as predicate is already stored; no problem with WD; relevant for test 1959 | |
| 343 | ; Ai=Ao, Reused=false % not guaranteed to be evaluated: WD-condition + not in forced WFD context | |
| 344 | % ,print('NOT REGISTERING: '), translate:print_bexpr(Pred),nl | |
| 345 | ). | |
| 346 | ||
| 347 | :- assert_must_succeed((E=empty, %avl:empty_avl(E), | |
| 348 | A=b(value(_VAR),integer,[]), | |
| 349 | b_interpreter_check:register_predicate(equal(A,A),[],pred_true,Reused,E,A1), | |
| 350 | Reused==false, A1==empty)). % ensure we do not store non-var expressions | |
| 351 | :- assert_must_succeed((E=empty, %avl:empty_avl(E), | |
| 352 | A=b(value(int(1)),integer,[]), | |
| 353 | b_interpreter_check:register_predicate(equal(A,A),[],pred_true,Reused,E,A1), | |
| 354 | Reused==false, A1 \= empty, B=b(value(_),integer,[]), | |
| 355 | b_interpreter_check:register_predicate(equal(B,B),[],pred_true,Reuse2,A1,A2), | |
| 356 | Reuse2==false, A2==A1)). % ensure we do not look up non-var expressions | |
| 357 | :- assert_must_succeed((E=empty, %avl:empty_avl(E), | |
| 358 | A=b(value(int(1)),integer,[]), | |
| 359 | b_interpreter_check:register_predicate(equal(A,A),[info1],pred_true,Reused,E,A1), | |
| 360 | Reused==false, | |
| 361 | b_interpreter_check:register_predicate(equal(A,A),[info2],pred_true,Reuse2,A1,A2), | |
| 362 | Reuse2==true, A2==A1)). % ensure registering works | |
| 363 | ||
| 364 | % Register a new predicate in the AVL tree (for outside callers like b_interpreter.pl) | |
| 365 | register_predicate(Pred,_Infos,NegPredTruthVar,Reused,Ai,Ao) :- negate_pred(Pred,NegPred),!, | |
| 366 | %print(negating),nl, | |
| 367 | negate(PredTruthVar,NegPredTruthVar), | |
| 368 | register_predicate_aux(NegPred,PredTruthVar,Reused,Ai,Ao). | |
| 369 | register_predicate(Pred,_Infos,PredTruthVar,Reused,Ai,Ao) :- | |
| 370 | register_predicate_aux(Pred,PredTruthVar,Reused,Ai,Ao). | |
| 371 | ||
| 372 | negate_typed_pred(b(A,pred,_),NegA) :- negate_pred(A,NegA). | |
| 373 | negate_pred(equal(A,B),equal(AA,TRUE)) :- negate_equal_false(A,B,AA,TRUE). | |
| 374 | negate_pred(not_equal(A,B),equal(A,B)). % TO DO: we should check negate_equal_false | |
| 375 | negate_pred(not_member(A,B),member(A,B)). | |
| 376 | negate_pred(not_subset(A,B),subset(A,B)). | |
| 377 | negate_pred(not_subset_strict(A,B),subset_strict(A,B)). | |
| 378 | negate_pred(greater_equal(A,B),less(A,B)). | |
| 379 | negate_pred(less_equal(A,B),less(B,A)). | |
| 380 | negate_pred(negation(b(A,pred,_)),A). | |
| 381 | ||
| 382 | % to do: detect convert_bool(Pred) = X and register Pred? | |
| 383 | register_predicate_aux(Pred,_PredTruthVar,Reused,Ai,Ao) :- do_not_store_pred(Pred), | |
| 384 | !, | |
| 385 | Ai=Ao, Reused=false. | |
| 386 | register_predicate_aux(Pred,PredTruthVar,Reused,Ai,Ao) :- check_pred_truth_var(PredTruthVar), | |
| 387 | norm_pred_check(Pred,NPred), % We could store this information in the info field computed by ast_cleanup ? | |
| 388 | (%too_simple(NPred) -> Reused=false, Ao=Ai ; %% even for simple equalities it actually pays off ! | |
| 389 | reuse_predicate(NPred,Var,Ai) | |
| 390 | -> % nl,print(reusing(NPred,Var)),nl, %% | |
| 391 | PredTruthVar=Var,Ao=Ai, Reused=true | |
| 392 | ; add_predicate(NPred,PredTruthVar,Ai,Ao), Reused=false | |
| 393 | %,nl,print(not_reusing(NPred)),nl | |
| 394 | ). | |
| 395 | ||
| 396 | check_pred_truth_var(X) :- var(X),!. | |
| 397 | check_pred_truth_var(pred_true) :- !. | |
| 398 | check_pred_truth_var(pred_false) :- !. | |
| 399 | check_pred_truth_var(X) :- add_internal_error('Illegal Predicate Truth Value: ',check_pred_truth_var(X)). | |
| 400 | ||
| 401 | :- use_module(kernel_tools,[ground_bexpr/1]). | |
| 402 | do_not_store_pred(external_pred_call(_P,_)) :- !. % expcept maybe LESS, CHOOSE,... we could check performs_io | |
| 403 | do_not_store_pred(B) :- | |
| 404 | (ground_bexpr(b(B,pred,[])) | |
| 405 | % TO DO: improve performance: marking bexpr with potential non-ground value(.) terms inside | |
| 406 | % maybe avoid registering predicates with very large values inside | |
| 407 | % avoid registering predicate if it is the only one in a closure | |
| 408 | -> fail | |
| 409 | ; true %print('-> Not storing: '),translate:print_bexpr(b(B,pred,[])),nl | |
| 410 | ). | |
| 411 | ||
| 412 | ||
| 413 | % Quantifier Expansion | |
| 414 | ||
| 415 | b_check_forall_wf(Parameters,LHS,RHS,Info,LocalState,State,WF,PredRes) :- | |
| 416 | create_wfwd_needed(WF,WFD), % we expect it to be in a context where the value will be needed | |
| 417 | b_check_forall_wfwd(Parameters,LHS,RHS,Info,LocalState,State,WFD,PredRes). | |
| 418 | b_check_forall_wfwd(_Parameters,LHS,RHS,_Info,_LocalState,_State,_WFD,PredRes) :- | |
| 419 | (is_falsity(LHS) ; is_truth(RHS)),!, % quantifier always true | |
| 420 | PredRes = pred_true. | |
| 421 | b_check_forall_wfwd(Parameters,LHS,RHS,Info,LocalState,State,WFD,PredRes) :- | |
| 422 | small_quantifier_cardinality(Parameters,LHS,LHS1,LHSRest), | |
| 423 | %print(expand(forall(Parameters))),nl, | |
| 424 | expand_quantifier(Parameters,LHS1,List,forall,Info), %print(List),nl, | |
| 425 | Body = b(implication(LHSRest,RHS),pred,Info),% translate:print_bexpr(Body),nl, | |
| 426 | get_wf(WFD,WF), | |
| 427 | check_expanded_forall_quantifier(List,Body, LocalState, State,WF,WFD,PredRes). | |
| 428 | % TO DO: if not small_quantifier_cardinality: b_check_boolean_expression4_delay | |
| 429 | ||
| 430 | ||
| 431 | b_check_exists_wf(Parameters,Body,Info,LocalState,State,WF,PredRes) :- | |
| 432 | create_wfwd_needed(WF,WFD), % we expect it to be in a context where the value will be needed | |
| 433 | b_check_exists_wfwd(Parameters,Body,Info,LocalState,State,WFD,_,PredRes). | |
| 434 | b_check_exists_wfwd(Parameters,Body,Info,LocalState,State,WFD,ok_to_store,PredRes) :- | |
| 435 | % could be generalised to take into consideration domain as restricted by Body | |
| 436 | small_quantifier_cardinality(Parameters,Body,LHS,RHS),!, | |
| 437 | % print(expanding_check_exists(_Card,Parameters)),nl, % portray_waitflags(WF), | |
| 438 | expand_quantifier(Parameters,LHS,List,exists,Info), | |
| 439 | % now compute a priority for the disjunction based on the number of case splits | |
| 440 | % relevant for tests 1358, 1746 | |
| 441 | length(List,Len), % Note: if Len=1: the body must be true; no disjoin will be set up | |
| 442 | get_pow2_binary_choice_priority(Len,Prio), | |
| 443 | % if Len=2 -> we actually have just two possibilities T,_ and F,T; but we want Prio to start at 4 ? | |
| 444 | % if Len=3 -> we have T,_,_ ; F,T,_ ; F,F,T less possibilites if disjoin enumerated from left-to-right; TO DO: should we lower the priority taking this into account ? | |
| 445 | % TO DO: maybe we could directly set up an n-ary disjoin predicate; | |
| 446 | % if one disjunct true; remove case-splits on other disjuncts | |
| 447 | get_wf(WFD,WF), | |
| 448 | check_expanded_exists_quantifier(List,Prio,RHS, LocalState, State,WF,WFD,PredRes). | |
| 449 | b_check_exists_wfwd(Parameters,Body,Infos,LocalState,State,wfwd(WF,WDE,WDV,ContextInfo),do_not_store,PredRes) :- | |
| 450 | % the above reification has not worked; we now "pretend" that reification worked | |
| 451 | % and introduce a delayed choice point | |
| 452 | % do_not_store means that the predicate result should not be re-used somewhere else, because | |
| 453 | % as the predicate evaluation is delayed it may later not be needed and not evaluated, cf test 2404 | |
| 454 | ContextInfo \= outer_wfwd_context, % at the outer-level interpreter expects reification succeeds only if | |
| 455 | % at least top-level operator was reified deterministically, | |
| 456 | % important for tests 1074, 1338, 1358, 1915 with this clause enabled | |
| 457 | % test 305 #x.(x + x = 1000) now works, but not 1739 (timeout) | |
| 458 | reify_inner_exists_non_deterministically, % hence we currently only use it in data validation mode | |
| 459 | % here we enumerate reification variables with a much lower priority (data driven enumeration) | |
| 460 | % (see get_binary_choice_wait_flag_exp_backoff) | |
| 461 | % this clause relevant for 0323/CCSL/TYPES_AUTORISES_RVF3_GEN__MRGA.mch | |
| 462 | Pred = exists(Parameters,Body), | |
| 463 | perfmessage(reify,reifiying_inner_exists_non_deterministically(Parameters),Infos), | |
| 464 | b_check_boolean_expression4_delay(WDE,WDV,Pred,Infos,LocalState,State,WF,PredRes). | |
| 465 | ||
| 466 | % true if we allow reification of exists which cannot be expanded | |
| 467 | % by delayed non-det enumeration (of pred_false, pred_true) if exists is not at top-level | |
| 468 | reify_inner_exists_non_deterministically :- preferences:preference(data_validation_mode,true). | |
| 469 | ||
| 470 | ||
| 471 | :- use_module(b_enumerate, [b_tighter_enumerate_values_in_ctxt/3]). | |
| 472 | expand_quantifier(Parameters,Pred,ListOfNewLocalStates,QuantKind,Span) :- | |
| 473 | % at the moment LS,State not really needed; only necessary if non-compiled Pred can be used | |
| 474 | % also: feeding in any non-bound variables in LocalState or State would cause problems in findall ! | |
| 475 | findall(ParLocalState, | |
| 476 | (b_interpreter:set_up_typed_localstate(Parameters,ParaValues,ParamTypedVals, | |
| 477 | [],ParLocalState,all_solutions), | |
| 478 | kernel_waitflags:init_wait_flags_with_call_stack(WF, | |
| 479 | [quantifier_call(QuantKind,Parameters,ParaValues,Span)]), | |
| 480 | b_test_boolean_expression(Pred,[],ParLocalState,WF), | |
| 481 | b_tighter_enumerate_values_in_ctxt(ParamTypedVals,Pred,WF), | |
| 482 | kernel_waitflags:ground_wait_flags(WF)), | |
| 483 | ListOfNewLocalStates). | |
| 484 | ||
| 485 | % a version which ensures that we have unique solutions of the bindings | |
| 486 | expand_quantifier_normalised(Parameters,Pred,ListOfNewLocalStates,QuantKind,Span) :- | |
| 487 | expand_quantifier(Parameters,Pred,List,QuantKind,Span), | |
| 488 | normalise_local_states(List,NList), | |
| 489 | sort(NList,ListOfNewLocalStates). % will remove duplicates | |
| 490 | ||
| 491 | normalise_local_states([],[]). | |
| 492 | normalise_local_states([State|T],[NS|NT]) :- | |
| 493 | convert_bindings_to_avl(State,NS), | |
| 494 | normalise_local_states(T,NT). | |
| 495 | ||
| 496 | :- use_module(custom_explicit_sets,[convert_to_avl/2]). | |
| 497 | convert_bindings_to_avl([],[]). | |
| 498 | convert_bindings_to_avl([bind(Var,Val)|T],[bind(Var,NVal)|NT]) :- | |
| 499 | (convert_to_avl(Val,NVal) -> true ; add_internal_error('Cannot normalise:',Val),fail), | |
| 500 | convert_bindings_to_avl(T,NT). | |
| 501 | ||
| 502 | check_expanded_forall_quantifier([], _Body, _LS, _State,_WF,_WFD,Res) :- | |
| 503 | Res=pred_true. | |
| 504 | check_expanded_forall_quantifier([LS1|TLS], Body, LS, State,WF,WFD,Res) :- | |
| 505 | conjoin(Res1,TRes,Res,Body,Body,WF), | |
| 506 | empty_avl(InnerAi), % TO DO: maybe use no_avl ? | |
| 507 | append(LS1,LS,InnerLS), | |
| 508 | % Note: we do not need to guard against wd-definition from other instances inside a quantified expression | |
| 509 | % either all conjuncts can be evaluated or none | |
| 510 | % print(expand_forall(WFD)), translate:print_bexpr(Body),nl, | |
| 511 | b_check_boolean_expression1(Body,InnerLS,State,WFD,Res1,InnerAi,_Aii), | |
| 512 | %instantiate_wfwd_result(WDE,WDV,Res1), | |
| 513 | check_expanded_forall_quantifier(TLS,Body,LS,State,WF,WFD,TRes). | |
| 514 | ||
| 515 | /* | |
| 516 | :- block instantiate_wfwd_result(?,-,-). | |
| 517 | % instantiate a boolean variable in case it is no longer needed and not set by something else | |
| 518 | instantiate_wfwd_result(WDE,WDV,Res) :- | |
| 519 | (nonvar(Res) -> true | |
| 520 | ; WDE==WDV -> true | |
| 521 | ; Res = pred_false). */ | |
| 522 | ||
| 523 | check_expanded_exists_quantifier([], _, _Body, _LS, _State,_WF,_WFD,Res) :- | |
| 524 | Res=pred_false. | |
| 525 | check_expanded_exists_quantifier([LS1|TLS], Priority, Body, LS, State,WF,WFD,Res) :- | |
| 526 | (TLS = [] -> Res=Res1 | |
| 527 | ; disjoin(Res1,TRes,Res,priority(Priority),priority(Priority),WF)), % was using Body instead of priority(Priority) | |
| 528 | empty_avl(InnerAi), % TO DO: maybe use no_avl ? | |
| 529 | append(LS1,LS,InnerLS), | |
| 530 | b_check_boolean_expression1(Body,InnerLS,State,WFD,Res1,InnerAi,_Aii), | |
| 531 | % Note: we do not need to guard against wd-definition from other instances inside a quantified expression | |
| 532 | check_expanded_exists_quantifier(TLS,Priority,Body,LS,State,WF,WFD,TRes). | |
| 533 | ||
| 534 | ||
| 535 | % try and convert a closure into a list of 0/1 variables for each potential element | |
| 536 | reify_closure_with_small_cardinality(P,T,Body, WF,ReifiedList) :- %print(try(P)),nl, | |
| 537 | create_typed_ids(P,T,Parameters), | |
| 538 | small_quantifier_cardinality(Parameters,Body,LHS,RHS,350,25000), % TO DO: how to choose these parameters ? | |
| 539 | % for card({x|x:1..n & x mod 3=0})=c & n=24000 -> 340 ms with reification; 320 ms without; n=74000 : 1020 ms without, 1160 with reification | |
| 540 | % but there is a big difference for card({x|x:1..n & x mod 3=0 & x<10}) with n=74000 : 0 ms without reification, 1580 with; n=500: 20 ms with reification; n=250: 10 ms with reification | |
| 541 | expand_quantifier_normalised(Parameters,LHS,List,comprehension_set,Body), | |
| 542 | % important to normalise and have unique solutions for cardinality reification, | |
| 543 | % see tests 639, 640 for card(POW(SS)-{{}}) with SS full set | |
| 544 | create_wfwd_needed(WF,WFD), % is this ok ?? | |
| 545 | reifiy_list(List,RHS,WFD,ReifiedList). | |
| 546 | ||
| 547 | ||
| 548 | ||
| 549 | reifiy_list([], _Body,_WFD,[]). | |
| 550 | reifiy_list([LS1|TLS], Body,WFD,[Res_01|TRes]) :- | |
| 551 | empty_avl(InnerAi), | |
| 552 | b_check_boolean_expression1(Body,LS1,[],WFD,Res1_pred,InnerAi,_Aii), | |
| 553 | prop_pred_01(Res1_pred,Res_01), | |
| 554 | %format(' reify ~w : ~w~n',[Res_01,LS1]), | |
| 555 | % Note: we do not need to guard against wd-definition from other instances inside a quantified expression | |
| 556 | reifiy_list(TLS,Body,WFD,TRes). | |
| 557 | ||
| 558 | ||
| 559 | ||
| 560 | :- use_module(library(lists),[select/3]). | |
| 561 | ||
| 562 | % check if Body produces a small cardinality for the paramters Par | |
| 563 | % if yes: the predicates constraining Par are put into LHS, the rest into RHS | |
| 564 | % also: LHS must ensure that ground values are produced for Par and that we can enumerate with a separate WF (in expand_quantifier) | |
| 565 | small_quantifier_cardinality(Par,Body,LHS,RHS) :- | |
| 566 | %preferences:preference(solver_strength,SS), NL is 10+SS, SMTL is 40+SS, | |
| 567 | NL=10,SMTL=40, | |
| 568 | small_quantifier_cardinality(Par,Body,LHS,RHS,NL,SMTL). % was 10,35; raising it to 10,41 makes tests 1441, 1442 fail due to expansion of exists; raising it to 16,50 makes test 1112 fail; TO DO: investigate | |
| 569 | small_quantifier_cardinality(Par,Body,LHS,RHS,NormalLimit,SMTLimit) :- | |
| 570 | conjunction_to_list(Body,BodyList), | |
| 571 | def_get_texpr_ids(Par,AllParas), | |
| 572 | small_quantifier_cardinality_aux(Par,AllParas,BodyList,_UpBoundOnSize,LLHS,LRHS,NormalLimit,SMTLimit), | |
| 573 | conjunct_predicates_with_pos_info(LLHS,LHS), | |
| 574 | conjunct_predicates_with_pos_info(LRHS,RHS). | |
| 575 | ||
| 576 | is_membership_or_eq(b(P,pred,Info),TLHS,RHS,Info) :- is_mem_aux(P,TLHS,RHS). | |
| 577 | is_mem_aux(member(TLHS,b(RHS,_,_)),TLHS,RHS). | |
| 578 | %is_mem_aux(subset(SONE,b(RHS,_,_)),TLHS,RHS) :- singleton_set_extension(SONE,TLHS). | |
| 579 | is_mem_aux(equal(TLHS,b(value(V),_,_)),TLHS,value([V])). % x = V is the same as x:{V} | |
| 580 | %TODO: use :- use_module(bsyntaxtree,[is_membership_or_equality/3]). % will create set_extension | |
| 581 | ||
| 582 | % do not rely on size for anything: it is just an upper bound on the size; the actual size could be smaller | |
| 583 | small_quantifier_cardinality_aux([],_,Body,Size,LHS,RHS,_,_) :- !, | |
| 584 | LHS=[],RHS=Body,Size=1. | |
| 585 | small_quantifier_cardinality_aux(Parameters,AllParas,[LHS|TBody],FullSize,FullLHS,FullRHS,NormalLimit,SMTLimit) :- | |
| 586 | is_membership_or_eq(LHS,SID,MemRHS,Info), | |
| 587 | constrains_ID(SID,AllParas,Parameters,RestParameters,SkelVal,SkelToUnify,BindList), % we could check RestParameters /= Parameters | |
| 588 | % TO DO: we could also allow parameter to be constrained twice x: 1..100 & x: {...} ? | |
| 589 | (is_small_set(MemRHS,Size,NormalLimit,SMTLimit,Info) % we have a small set of ground values: we can evaluate LHS to expand the quantifier/set_comprehension for the parameters occuring in LHS | |
| 590 | -> FullLHS = [LHS|RestLHS],FullRHS = RestRHS | |
| 591 | ; infer_ground_membership(MemRHS,SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit, Size,InferredLHS) -> | |
| 592 | % we have inferred a superset InferredLHS of MemRHS which is small and known | |
| 593 | FullLHS = [InferredLHS|RestLHS], % we have added an inferred membership constraint | |
| 594 | FullRHS = [LHS|RestRHS]), % the original membership LHS still needs to be checked later, after expansion of the quantifier | |
| 595 | !, | |
| 596 | % we select LHS to be included in FullLHS and mark parameter ID as constrained | |
| 597 | small_quantifier_cardinality_aux(RestParameters,AllParas,TBody,RestSize,RestLHS,RestRHS,NormalLimit,SMTLimit), | |
| 598 | FullSize is Size*RestSize, | |
| 599 | is_small_size(FullSize,NormalLimit,SMTLimit, Parameters). | |
| 600 | small_quantifier_cardinality_aux(Parameters,AllParas,[H|Rest],FullSize,RestLHS,[H|RestRHS],NormalLimit,SMTLimit) :- !, | |
| 601 | % skip the conjunct H | |
| 602 | small_quantifier_cardinality_aux(Parameters,AllParas,Rest,FullSize,RestLHS,RestRHS,NormalLimit,SMTLimit). | |
| 603 | small_quantifier_cardinality_aux(Parameters,_AllParas,Body,ParCard,[],Body,NormalLimit,SMTLimit) :- | |
| 604 | % if the remaining parameter type cardinality is small: just use "truth" as body; will instantiate parameters | |
| 605 | b_interpreter:parameter_list_cardinality(Parameters,ParCard), | |
| 606 | is_small_size(ParCard,NormalLimit,SMTLimit, Parameters). | |
| 607 | ||
| 608 | % try and extract a ground superset (InferredLHS) of the RHS (ID:RHS) which constrains ID | |
| 609 | infer_ground_membership(value(List),SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit, Size,InferredLHS) :- | |
| 610 | !, | |
| 611 | % the List is probably not ground; let's try and see if we can extract ground matches for the parameters at least; see test 1627 (s=1..20 & x: s-->BOOL & card({t|t|->TRUE:x}):18..19) | |
| 612 | extract_bind_list(BindList,LHSTerm,RHSValue), | |
| 613 | has_bounded_ground_matches(List,SkelVal,SkelToUnify,RHSValue,MatchedValues,1,NrMatches), % TO DO: provide SMTLimit as upper limit | |
| 614 | NrMatches = Size, | |
| 615 | is_small_size(Size,NormalLimit,SMTLimit, SID), | |
| 616 | get_texpr_type(LHSTerm,LHSTermType), | |
| 617 | InferredLHS = b(member(LHSTerm,b(value(MatchedValues),set(LHSTermType),[])),pred,[generated]). | |
| 618 | infer_ground_membership(Set,SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit,Size,InferredLHS) :- | |
| 619 | superset(Set,SuperSet), | |
| 620 | % e.g., if ID: {1} /\ x -> InferredLHS = {1} and we will add ID : {1} to the LHS of the quantifier and keep ID : {1} /\ x as the RHS | |
| 621 | infer_ground_mem_aux(SuperSet,SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit,Size,InferredLHS). | |
| 622 | ||
| 623 | ||
| 624 | superset(intersection(A,B),Set) :- (Set=A ; Set=B). % Set /\ X <: Set | |
| 625 | superset(set_subtraction(Set,_),Set). % Set \ X <: Set | |
| 626 | superset(domain_restriction(_,Set),Set). % X <| Set <: Set | |
| 627 | superset(domain_subtraction(_,Set),Set). % X <<| Set <: Set | |
| 628 | superset(range_subtraction(Set,_),Set). % Set |> X <: Set | |
| 629 | superset(range_restriction(Set,_),Set). % Set |>> X <: Set | |
| 630 | ||
| 631 | infer_ground_mem_aux(b(Set,T,I),SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit, Size,InferredLHS) :- | |
| 632 | (is_small_set(Set,Size,NormalLimit,SMTLimit,I) | |
| 633 | -> InferredLHS = b(member(SID,b(Set,T,I)),pred,[generated]) | |
| 634 | ; infer_ground_membership(Set,SID,SkelVal,SkelToUnify,BindList,NormalLimit,SMTLimit, Size,InferredLHS)). | |
| 635 | ||
| 636 | :- use_module(bsyntaxtree, [create_couple/3]). | |
| 637 | % extract result of constrains_ID BindList into an Expression-Tuple for new membership constraint and a value that will be put into a value(List) | |
| 638 | extract_bind_list([TID/Val],TID,Val) :- !. | |
| 639 | extract_bind_list([TID/Val|BList],Couple,(Val,RestVal)) :- | |
| 640 | create_couple(TID,RestExpr,Couple), | |
| 641 | extract_bind_list(BList,RestExpr,RestVal). | |
| 642 | ||
| 643 | :- use_module(kernel_tools,[can_match/2]). | |
| 644 | % check if we can find a bounded / fixed number of ground matches for Skeleton Value in List | |
| 645 | has_bounded_ground_matches(Var,_,_,_, _,_,_) :- var(Var),!. | |
| 646 | has_bounded_ground_matches([],_SkelVal,_SkelToUnify,_,[],LenAcc,LenAcc). | |
| 647 | has_bounded_ground_matches([H|T],SkelVal,SkelToUnify,ValueToStore,Matches,LenAcc,LenRes) :- | |
| 648 | (can_match(H,SkelVal) -> copy_term((SkelToUnify,ValueToStore),(H,HValueToStore)), | |
| 649 | ground_value(HValueToStore), | |
| 650 | Matches = [HValueToStore|MT], | |
| 651 | A1 is LenAcc+1 ; Matches=MT,A1=LenAcc), | |
| 652 | has_bounded_ground_matches(T,SkelVal,SkelToUnify,ValueToStore,MT,A1,LenRes). | |
| 653 | ||
| 654 | % check if the Expr contains ID, i.e., matching Expr with an element of a set will also instantiate and determine TID | |
| 655 | % TO DO: also accept other patterns: records, sets?,.... | |
| 656 | ||
| 657 | % SkeletonToUnify: a skeleton that can be used to unify with any value and extracts value in BindList | |
| 658 | constrains_ID(b(E,_,_),AllParas,Parameters,RestParameters,SkeletonValue,SkeletonToUnify,BindList) :- | |
| 659 | constrains_ID_aux(E,AllParas,Parameters,RestParameters,SkeletonValue,SkeletonToUnify,BindList). | |
| 660 | constrains_ID_aux(couple(A,B),AllParas,Parameters,RestParameters,(V1,V2),(Skel1,Skel2),Bind) :- | |
| 661 | constrains_ID(A,AllParas,Parameters,Rest1,V1,Skel1,Bind1), | |
| 662 | constrains_ID(B,AllParas,Rest1,RestParameters,V2,Skel2,Bind2), | |
| 663 | append(Bind1,Bind2,Bind). % TO DO: use DCGs | |
| 664 | constrains_ID_aux(rec(F),AllParas,Parameters,RestParameters,record(SkelV),record(SkelU),Bind) :- | |
| 665 | constrains_ID_fields(F,AllParas,Parameters,RestParameters,SkelV,SkelU,Bind). | |
| 666 | constrains_ID_aux(identifier(ID),AllParas,Parameters,RestParameters,_SkelV,SkelU,Bind) :- | |
| 667 | % TO DO: allow same id to appear multiple times in expression + allow to re-use parameters in another conjunct | |
| 668 | ? | (select(TID,Parameters,RestParameters), get_texpr_id(TID,ID) |
| 669 | -> Bind = [TID/SkelU] | |
| 670 | ; member(ID,AllParas), % we have already used/bound ID; we will use first occurence for skeleton/bind; this one is simply ignored | |
| 671 | % TO DO: we could try and see whether using the second occurence gives a better result | |
| 672 | RestParameters=Parameters, Bind=[] | |
| 673 | ). | |
| 674 | constrains_ID_aux(value(V),_AllParas,P,P,V,_,[]) :- ground_value(V).% if not ground value we may not be able to compute all possible values for ID | |
| 675 | constrains_ID_aux(boolean_true,_AllParas,P,P,pred_true,pred_true,[]). % needed ?? everything is compiled anway ? | |
| 676 | constrains_ID_aux(boolean_false,_AllParas,P,P,pred_false,pred_false,[]). % needed ?? everything is compiled anway ? | |
| 677 | % Below: allow any other expression as long as it only uses AllParas | |
| 678 | % e.g. x+1 in : s: 1..20 --> (BOOL*(1..20)) & card({x|x|->(TRUE|->x):s})=10 & card({x|x|->(FALSE|->x+1):s})=10 | |
| 679 | constrains_ID_aux(add(A,B),AllParas,P,P,_,_,[]) :- % basically allow other Parameters or ground values | |
| 680 | constrains_ID(A,AllParas,[],[],_,_,_), constrains_ID(B,AllParas,[],[],_,_,_). | |
| 681 | constrains_ID_aux(minus(A,B),AllParas,P,P,_,_,[]) :- % TO DO: allow other binary/unary operators ? | |
| 682 | constrains_ID(A,AllParas,[],[],_,_,_), constrains_ID(B,AllParas,[],[],_,_,_). | |
| 683 | %constrains_ID_aux(Other,All,P,P,_,_,[]) :- print(other(Other)),nl,fail. | |
| 684 | ||
| 685 | constrains_ID_fields([],_AllParas,P,P,[],[],[]). | |
| 686 | constrains_ID_fields([field(Field,Val)|TF],AllParas,Parameters,RestParameters, | |
| 687 | [field(Field,SkelVal)|TSkelV],[field(Field,SkelUnify)|TSkelU],Bind) :- | |
| 688 | constrains_ID(Val,AllParas,Parameters,Rest1,SkelVal,SkelUnify,Bind1), | |
| 689 | constrains_ID_fields(TF,AllParas,Rest1,RestParameters,TSkelV,TSkelU,Bind2), | |
| 690 | append(Bind1,Bind2,Bind). % TO DO: use DCGs | |
| 691 | ||
| 692 | :- use_module(custom_explicit_sets,[efficient_card_for_set/3]). | |
| 693 | ||
| 694 | ||
| 695 | is_small_set(Val,Size,NormalLimit,SMTLimit,SrcLoc) :- | |
| 696 | get_small_set_size(Val,Size), | |
| 697 | is_small_size(Size,NormalLimit,SMTLimit,SrcLoc). | |
| 698 | ||
| 699 | :- use_module(kernel_card_arithmetic,[safe_mul/3]). | |
| 700 | :- use_module(kernel_tools,[ground_value/1]). | |
| 701 | get_small_set_size(value(S),Size) :- !, | |
| 702 | ground_value(S), % otherwise we could have S=[X] and expand_quantifier will erroneously create multiple solutions for parameter=X | |
| 703 | efficient_card_for_set(S,Size,C), | |
| 704 | call(C). | |
| 705 | get_small_set_size(interval(From,To),Size) :- !, | |
| 706 | custom_explicit_sets:is_interval_with_integer_bounds(interval(From,To),Low,Up), | |
| 707 | number(Low), number(Up), | |
| 708 | (Low > Up -> Size = 1 ; Size is 1+Up-Low). | |
| 709 | % we provide dom/ran here explicitly as this is often used {i|i:dom(f) ...} | |
| 710 | get_small_set_size(bool_set,Size) :- !, Size=2. | |
| 711 | get_small_set_size(domain(b(Val,_,_)),Size) :- !, | |
| 712 | get_small_domain_set_size(Val,Size). % this is only an upper bound on the size !! | |
| 713 | get_small_set_size(range(b(Val,_,_)),Size) :- !, | |
| 714 | get_small_set_size(Val,Size). % this is only an upper bound on the size !! | |
| 715 | get_small_set_size(cartesian_product(b(A,_,_),b(B,_,_)),Size) :- !, | |
| 716 | get_small_set_size(A,SizeA), number(SizeA), | |
| 717 | get_small_set_size(B,SizeB), number(SizeB), | |
| 718 | safe_mul(SizeA,SizeB,Size), number(Size). | |
| 719 | ||
| 720 | %get_small_set_size(set_extension(L),Size,_,_,_) :- !, length(L,Size), is_small_size(Size). what if elements itself notknown ?? probably the case as otherwise this would have been compiled into a value | |
| 721 | %get_small_set_size(sequence_extension(L),Size,_,_,_) :- !, length(L,Size), is_small_size(Size). ditto | |
| 722 | %get_small_set_size(interval... | |
| 723 | %get_small_set_size(domain(value([....]))... | |
| 724 | % for this to work efficiently one should call b_compiler:compile on the predicates before sending them | |
| 725 | % to b_interpreter_check; otherwise the sets will not yet be in value(_) form | |
| 726 | ||
| 727 | % TO DO: the same for range or find more principled solution | |
| 728 | %get_small_domain_set_size(value(S),Size) :- var(S), frozen(S,Frozen), print(var_value(S,Frozen)),nl,fail. | |
| 729 | get_small_domain_set_size(value(Val),Size) :- nonvar(Val), Val=[H|T],!, | |
| 730 | efficient_card_for_set([H|T],Size,C), | |
| 731 | ground_domain([H|T]), % rather than requiring ground of entire list; we only require ground for domain (see test 1272) | |
| 732 | call(C). | |
| 733 | get_small_domain_set_size(Val,Size) :- | |
| 734 | get_small_set_size(Val,Size). | |
| 735 | ground_domain(V) :- var(V),!,fail. | |
| 736 | ground_domain([]). | |
| 737 | ground_domain([H|T]) :- | |
| 738 | nonvar(H), H=(D,_), | |
| 739 | ground_value(D), ground_domain(T). | |
| 740 | ||
| 741 | is_small_size(Size,NormalLimit,SMTLimit,SrcLoc) :- number(Size), %Size \= inf, | |
| 742 | (Size < NormalLimit -> true | |
| 743 | ; preferences:preference(use_smt_mode,true) | |
| 744 | -> preference(solver_strength,SS), | |
| 745 | (Size < SMTLimit + SS | |
| 746 | -> true | |
| 747 | ; perfmessage(reify,'Not reifiying quantifier, try increasing SOLVER_STRENGTH: ','>'(Size,'+'(SMTLimit,SS)),SrcLoc), | |
| 748 | fail | |
| 749 | ) | |
| 750 | ; perfmessage(reify,'Not reifiying quantifier, try setting SMT preference: ','>'(Size,limit(NormalLimit)),SrcLoc), | |
| 751 | fail | |
| 752 | ). | |
| 753 | ||
| 754 | % ------------------------------------- | |
| 755 | % EXPRESSIONS | |
| 756 | ||
| 757 | :- use_module(store,[set_up_localstate/4]). | |
| 758 | ||
| 759 | wd_set_up_localstate_for_let(Ids,Exprs,LocalState,State,LetState,WFD) :- | |
| 760 | set_up_localstate(Ids,Vars,LocalState,LetState), | |
| 761 | wd_compute_let_expressions(Exprs,Vars,LetState,State,WFD). | |
| 762 | wd_compute_let_expressions([],[],_,_,_). | |
| 763 | wd_compute_let_expressions([Expr|RestExprs],[Var|RestVars],LocalState,State,WFD) :- | |
| 764 | b_wd_compute_expression(Expr,LocalState,State,Value,WFD), | |
| 765 | kernel_objects:equal_object_optimized(Var,Value,compute_let_expressions), | |
| 766 | wd_compute_let_expressions(RestExprs,RestVars,LocalState,State,WFD). | |
| 767 | ||
| 768 | ||
| 769 | % compute a Prolog list of expressions: | |
| 770 | b_wd_compute_expressions([], _, _, [],_WFD). | |
| 771 | b_wd_compute_expressions([EXPRsHd|EXPRsTl],LocalState,State,[ValHd|ValTl],WFD) :- | |
| 772 | b_wd_compute_expression(EXPRsHd,LocalState,State,ValHd,WFD), | |
| 773 | b_wd_compute_expressions(EXPRsTl,LocalState,State,ValTl,WFD). | |
| 774 | ||
| 775 | % we have to avoid trying to compute certain expressions: evaluation can fail if not well-defined ! | |
| 776 | b_wd_compute_expression(Expr,LocalState,State,Value,wfwd(WF,WDE,WDV,_)) :- !, | |
| 777 | (nonvar(WDV) | |
| 778 | -> (WDE==WDV | |
| 779 | -> % print('REQUIRED: '), translate:print_bexpr(Expr),nl, | |
| 780 | if(b_compute_expression(Expr,LocalState,State,Value,WF), % TO DO: we could use fresh variable for Value | |
| 781 | true, | |
| 782 | (kernel_objects:unbound_value(Value), % we have a WD error, if nonvar it could be because we expect a wrong value | |
| 783 | add_wd_error_span('Well-definedness error evaluating expression: ',Expr,span_predicate(Expr,LocalState,State),WF) | |
| 784 | %Value = term(undefined), | |
| 785 | ) | |
| 786 | ) | |
| 787 | ; instantiate_to_any_value(Value,Expr,WF)) | |
| 788 | ; always_wd_no_fail_nor_error(Expr) | |
| 789 | -> % print('ALWAYS WD: '), translate:print_bexpr(Expr),nl, % | |
| 790 | b_compute_expression(Expr,LocalState,State,Value,WF) | |
| 791 | ; b_compiler:b_optimize(Expr,[],LocalState,State,CExpr,WF), | |
| 792 | % try compiling; this will inline values and may make the expression well_defined; relevant for test 2013 | |
| 793 | (always_wd_no_fail_nor_error(CExpr) | |
| 794 | % it is important that this computation cannot fail and cannot raise any errors | |
| 795 | % an example showing this is :wde f=[2,4] & xx:1..3 & (xx=1 or f(xx-1)=4) with -p TRY_FIND_ABORT TRUE | |
| 796 | % even though the whole expression is well-defined, the function call f(xx-1) does lead | |
| 797 | % to an error with xx=1 | |
| 798 | -> b_compute_expression(CExpr,LocalState,State,Value,WF) | |
| 799 | ; % print('DELAYING DUE TO WD: '), translate:print_bexpr(CExpr),nl, %% | |
| 800 | b_compute_expression_delay(WDE,WDV, CExpr,LocalState,State,Value,WF) | |
| 801 | ) | |
| 802 | ). | |
| 803 | b_wd_compute_expression(Expr,LocalState,State,Value,WFD) :- | |
| 804 | add_internal_error('Illegal WFD value: ', b_wd_compute_expression(Expr,LocalState,State,Value,WFD)),fail. | |
| 805 | ||
| 806 | ||
| 807 | always_wd_no_fail_nor_error(Expr) :- | |
| 808 | always_well_defined(Expr). | |
| 809 | % should not use always_well_defined_or_disprover_mode or WD discharged information! | |
| 810 | ||
| 811 | :- block b_compute_expression_delay(?,-, ?,?,?,?,?). | |
| 812 | b_compute_expression_delay(WDE,WDV,Expr,LocalState,State,Value,WF) :- | |
| 813 | (WDE==WDV | |
| 814 | -> % print('WD Evaluation: '), print(WDE),print(' =?= '), print(WDV), print(' '),translate:print_bexpr(Expr),nl, | |
| 815 | b_compute_expression(Expr,LocalState,State,Value,WF) | |
| 816 | ; %print(instantiate_to_any_value(Value,Expr)),nl, | |
| 817 | instantiate_to_any_value(Value,Expr,WF) % does not matter anyway; but there can be pending co-routines :-( | |
| 818 | ). | |
| 819 | ||
| 820 | % WARNING: the variable could be used in another context, where it is relevant ! | |
| 821 | ||
| 822 | ||
| 823 | wd_delay(WDCall,Res, Expr,wfwd(WF,WDExpected,WDV,_)) :- | |
| 824 | (WDExpected==WDV -> call(WDCall) % WDV truth value on left is ok: we can evaluate | |
| 825 | ; nonvar(WDV) -> instantiate_to_any_value(Res,Expr,WF) % truth value not ok; we do not need the value | |
| 826 | ; always_wd_no_fail_nor_error(Expr) -> call(WDCall) | |
| 827 | ; wd_delay_block(WDCall,Res,Expr,WDExpected,WDV,WF)). | |
| 828 | :- block wd_delay_block(?,?,?,?,-,?). | |
| 829 | wd_delay_block(WDCall,Res,Expr,WDExpected,WDV,WF) :- | |
| 830 | (WDExpected==WDV -> call(WDCall) | |
| 831 | ; instantiate_to_any_value(Res,Expr,WF)). | |
| 832 | ||
| 833 | ||
| 834 | :- use_module(typing_tools,[any_value_for_type/2]). | |
| 835 | :- use_module(kernel_tools,[ground_value_check/2]). | |
| 836 | %instantiate_to_any_value(V,E,_) :- print(instantiate_to_any_value(V)),nl,translate:print_bexpr(E),nl,nl,fail. | |
| 837 | instantiate_to_any_value(V,_,_) :- ground_value(V),!. | |
| 838 | instantiate_to_any_value(V,b(_B,TYPE,_I),WF) :- | |
| 839 | get_enumeration_finished_wait_flag(WF,EWF), | |
| 840 | ground_value_check(V,GV), | |
| 841 | blocking_any_value_for_type(EWF,GV,TYPE,V). | |
| 842 | ||
| 843 | :- block blocking_any_value_for_type(-,-,?,?). | |
| 844 | blocking_any_value_for_type(_,_,TYPE,V) :- any_value_for_type(TYPE,V). % , print(inst2(TYPE,V)),translate:print_bexpr(b(_B,TYPE,_I)),nl. | |
| 845 | ||
| 846 | ||
| 847 | :- block propagagate_wfwd(-,?,?,-,?), propagagate_wfwd(?,-,?,-,?). | |
| 848 | % propagate expected and actual value guarding left with actual predicate value obtained for left | |
| 849 | propagagate_wfwd(WDE,WDV,Res,F1,F2) :- | |
| 850 | (F1==F2 -> Res=F1 % then value of WDE does not matter at all; Res always the same | |
| 851 | ; propagagate_wfwd2(WDE,WDV,Res,F1,F2)). | |
| 852 | ||
| 853 | :- block propagagate_wfwd2(-,?,?,?,?), propagagate_wfwd2(?,-,?,?,?). | |
| 854 | propagagate_wfwd2(WDE,WDV,Res,F1,F2) :- (WDE==WDV -> Res=F1 ; Res=F2). | |
| 855 | ||
| 856 | :- use_module(external_functions,[external_fun_has_wd_condition/1]). | |
| 857 | :- use_module(preferences). | |
| 858 | b_check_boolean_expression4(exists(Parameters,Body),Info,LocalState,State,WFD,OkToStore,Res) :- !, | |
| 859 | if(b_check_exists_wfwd(Parameters,Body,Info,LocalState,State,WFD,OkToStore,Res),true, | |
| 860 | (perfmessagecall(reify,cannot_reify_exists(Parameters),translate:print_bexpr(Body),Body), | |
| 861 | fail)). | |
| 862 | b_check_boolean_expression4(Pred,Infos,LocalState,State,WFD,ok_to_store,Res) :- | |
| 863 | b_check_boolean_expression4_ok(Pred,Infos,LocalState,State,WFD,Res). | |
| 864 | ||
| 865 | b_check_boolean_expression4_ok(equal(LHS,RHS),_,LocalState,State,WFD,EqRes) :- !, | |
| 866 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 867 | b_wd_compute_expression(RHS,LocalState,State,RHValue,WFD), | |
| 868 | get_texpr_type(LHS,Type), get_wf(WFD,WF), | |
| 869 | equality_objects_with_type_wf(Type,LHValue,RHValue,EqRes,WF). | |
| 870 | % we may need to improve not_member for closure to invert symbolic operators | |
| 871 | b_check_boolean_expression4_ok(member(LHS,RHS),Info,LocalState,State,WFD,Res) :- | |
| 872 | %member_check_should_be_reified(LHS,RHS), % no longer need this: symbolic operators will be kept as closures if large ?! | |
| 873 | !, | |
| 874 | get_texpr_expr(RHS,ERHS), | |
| 875 | b_check_member_expression(ERHS,RHS,LHS,Info,LocalState,State,WFD,Res). | |
| 876 | % TO DO: compile forall, exists + setup choice point if expansion fails + remove compile calls in b_interpreter | |
| 877 | b_check_boolean_expression4_ok(forall(Parameters,LHS,RHS),Info,LocalState,State,WFD,Res) :- !, | |
| 878 | if(b_check_forall_wfwd(Parameters,LHS,RHS,Info,LocalState,State,WFD,Res),true, | |
| 879 | (perfmessages_bexpr_call(reify,['Cannot reify forall over ', Pids, ': '],LHS, | |
| 880 | convert_and_ajoin_ids(Parameters,Pids)), | |
| 881 | fail)). | |
| 882 | b_check_boolean_expression4_ok(subset(LHS,RHS),_,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 883 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 884 | b_wd_compute_expression(RHS,LocalState,State,RHValue,WFD), | |
| 885 | subset_test(LHValue,RHValue,Res,WF). | |
| 886 | b_check_boolean_expression4_ok(subset_strict(LHS,RHS),_,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 887 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 888 | b_wd_compute_expression(RHS,LocalState,State,RHValue,WFD), | |
| 889 | subset_strict_test(LHValue,RHValue,Res,WF). | |
| 890 | b_check_boolean_expression4_ok(external_pred_call(FunName,Args),Info,LocalState,State,WFD,Res) :- | |
| 891 | !, | |
| 892 | (external_fun_has_wd_condition(FunName) | |
| 893 | -> wd_delay_until_needed(WFD,b_check_external_pred_call(FunName,Args,Info,LocalState,State,WFD,Res)) | |
| 894 | ; b_check_external_pred_call(FunName,Args,Info,LocalState,State,WFD,Res)). | |
| 895 | b_check_boolean_expression4_ok(freetype_case(FT,IsCase,Expr),_Infos,LocalState,State,WFD,Res) :- !, | |
| 896 | b_wd_compute_expression(Expr,LocalState,State,freeval(FT,ActualCase,_A),WFD), | |
| 897 | eq_atomic(IsCase,ActualCase,freeval_case,Res). | |
| 898 | b_check_boolean_expression4_ok(finite(Expr),_Infos,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 899 | b_wd_compute_expression(Expr,LocalState,State,ExprVal,WFD), | |
| 900 | kernel_objects:test_finite_set_wf(ExprVal,Res,WF). | |
| 901 | b_check_boolean_expression4_ok(partition(Expr,ListOfSets),_Infos,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 902 | b_wd_compute_expression(Expr,LocalState,State,ExprVal,WFD), | |
| 903 | b_wd_compute_expressions(ListOfSets,LocalState,State,PartitionList,WFD), % arg is a Prolog list, not a set | |
| 904 | kernel_objects:test_partition_wf(ExprVal,PartitionList,Res,WF). | |
| 905 | b_check_boolean_expression4_ok(Pred,_,LocalState,State,WFD,Res) :- | |
| 906 | arithmetic_op(Pred,Op,LHS,RHS),!, | |
| 907 | b_wd_compute_expression(LHS,LocalState,State,int(LHValue),WFD), | |
| 908 | b_wd_compute_expression(RHS,LocalState,State,int(RHValue),WFD), | |
| 909 | check_arithmetic_operator(Op,LHValue,RHValue,Res). | |
| 910 | b_check_boolean_expression4_ok(Pred,_,LocalState,State,WFD,Res) :- | |
| 911 | real_arithmetic_op(Pred,Op,LHS,RHS),!, | |
| 912 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 913 | b_wd_compute_expression(RHS,LocalState,State,RHValue,WFD), | |
| 914 | get_wf(WFD,WF), | |
| 915 | real_comp_wf(Op,LHValue,RHValue,Res,WF). | |
| 916 | % TO DO ???: use idea of b_artihmetic_expression to avoid intermediate CLPFD variables | |
| 917 | % TO DO: add other operators, ... | |
| 918 | /* use_smt_mode = full is never set; at some point we should enable the following clause by default | |
| 919 | b_check_boolean_expression4_ok(Pred,Infos,LocalState,State,wfwd(WF,WDE,WDV,ContextInfos),Res) :- | |
| 920 | % preferences:preference(use_smt_mode,full), %% comment out to enable check testing of complicated predicates inside; | |
| 921 | % caused slowdowns of cbtc/actions_cbtc.mch (test 1751); but no longer the case | |
| 922 | functor(Pred,F,N),format('~n Cannot reify ~w/~w~n~n',[F,N]),fail, | |
| 923 | %ContextInfo \= outer_wfwd_context, | |
| 924 | b_check_boolean_expression4_delay(WDE,WDV,Pred,Infos,LocalState,State,WF,Res). | |
| 925 | */ | |
| 926 | ||
| 927 | :- use_module(library(lists),[maplist/3]). | |
| 928 | % TO DO: add member(,pow_subset, fin_subset) --> subset_test | |
| 929 | % we could distribute RHS=union -> disjunction, LHS=intersection -> conjunction ,... ? | |
| 930 | %b_check_member_expression(EHRS,_RHS,_LHS,_,_LocalState,_State,_WFD,_Res) :- | |
| 931 | % print('member : '), print(EHRS),nl,fail. | |
| 932 | %b_check_member_expression(union(A,B),LHS,_,LocalState,State,WFD,Res) :- | |
| 933 | b_check_member_expression(pow_subset(RHS),_,LHS,_Info,LocalState,State,WFD,Res) :- !, | |
| 934 | b_check_boolean_expression4_ok(subset(LHS,RHS),[],LocalState,State,WFD,Res). | |
| 935 | %b_check_member_expression(NotContainingEmptySet,_TRHS,LHS,LocalState,State,WFD,Res) :- | |
| 936 | % non_empty_set_version_of(NotContainingEmptySet,RHS_With_EmptySet), | |
| 937 | % % translate x:seq1(RHS) -> x /= {} & x:seq(RHS), ... | |
| 938 | % % this improves propagation, in particular in light of WD issues | |
| 939 | % % TO DO: avoid computing LHS twice ! | |
| 940 | % !, | |
| 941 | % get_texpr_type(LHS,LType), | |
| 942 | % EMPTYVERSION = b(member(LHS,b(RHS_With_EmptySet,set(LType),[])),pred,[]), | |
| 943 | % NOTEMPTYPRED = b(not_equal(LHS,b(empty_set,LType,[])),pred,[]), | |
| 944 | % print('Translating : '), translate:print_bexpr(EMPTYVERSION), print(' & '), translate:print_bexpr(NOTEMPTYPRED),nl, | |
| 945 | % empty_avl(Ai), Infos=[], % Infos not important for conjunction | |
| 946 | % b_check_boolean_expression2(conjunct(EMPTYVERSION,NOTEMPTYPRED),Infos,LocalState,State,WFD,Res,Ai,_). | |
| 947 | b_check_member_expression(interval(Low,Up),_,LHS,_Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 948 | % to do: should we also match interval value closure | |
| 949 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 950 | b_wd_compute_expression(Low,LocalState,State,LowValue,WFD), | |
| 951 | b_wd_compute_expression(Up,LocalState,State,UpValue,WFD), | |
| 952 | kernel_objects:test_in_nat_range_wf(LHValue,LowValue,UpValue,Res,WF). | |
| 953 | b_check_member_expression(set_extension(SetExt),_RHS,LHS,_Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 954 | % rewrite x:{a,b,c} into x=a or x=b or x=c (is the opposite of rewrite_disjunct_to_member) | |
| 955 | % The rewrite_disjunct_to_member is good when we know a membership to be true; the disjunct is better for reification | |
| 956 | % Note: the problem is in particular when the result of the membership is not needed and an uninstantiated | |
| 957 | % variable is used in the set extension, example y:dom(f) => (x:{f(y),0} or f(y)=0) | |
| 958 | % print(mem_check_set_extension),print(' '),translate:print_bexpr(b(member(LHS,_RHS),pred,[])),nl, | |
| 959 | b_wd_compute_expressions(SetExt,LocalState,State,SetExtValues,WFD), | |
| 960 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 961 | get_texpr_type(LHS,Type), | |
| 962 | NewLHS = b(value(LHValue),Type,[]), | |
| 963 | (ground_value(SetExtValues) | |
| 964 | -> % better to use normal treatment, we can compute the entire set and translate it into an AVL tree | |
| 965 | maplist(construct_value(Type),SetExtValues,Vals), | |
| 966 | b_wd_compute_expression(b(set_extension(Vals),set(Type),[]),LocalState,State,RHValue,WFD), | |
| 967 | membership_test_wf(RHValue,LHValue,Res,WF), | |
| 968 | force_membership_test(Res,LHValue,RHValue,WF) | |
| 969 | ; maplist(construct_equality(NewLHS,Type),SetExtValues,Disjuncts), | |
| 970 | construct_norm_disjunct2(Disjuncts,NC,InfoNC), | |
| 971 | empty_avl(Ai), | |
| 972 | b_check_boolean_expression2(NC,InfoNC,LocalState,State,WFD,Res,Ai,_) | |
| 973 | ). | |
| 974 | b_check_member_expression(closure(Relation),_RHS,LHS,Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 975 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 976 | b_wd_compute_expression(Relation,LocalState,State,RelValue,WFD), | |
| 977 | opt_push_wait_flag_call_stack_info(WF,b_operator_call(member, | |
| 978 | [LHValue,b_operator(closure,[RelValue])],Info),WF2), % this is closure1 | |
| 979 | bsets_clp:in_closure1_membership_test_wf(LHValue,RelValue,Res,WF2). | |
| 980 | b_check_member_expression(partial_function(Dom,Range),_RHS,LHS,Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 981 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 982 | b_wd_compute_expression(Dom,LocalState,State,DomValue,WFD), | |
| 983 | b_wd_compute_expression(Range,LocalState,State,RangeValue,WFD), | |
| 984 | opt_push_wait_flag_call_stack_info(WF,b_operator_call(member, | |
| 985 | [LHValue,b_operator(partial_function,[DomValue,RangeValue])],Info),WF2), | |
| 986 | bsets_clp:partial_function_test_wf(LHValue,DomValue,RangeValue,Res,WF2). | |
| 987 | b_check_member_expression(total_function(Dom,Range),_RHS,LHS,Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 988 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 989 | b_wd_compute_expression(Dom,LocalState,State,DomValue,WFD), | |
| 990 | b_wd_compute_expression(Range,LocalState,State,RangeValue,WFD), | |
| 991 | opt_push_wait_flag_call_stack_info(WF,b_operator_call(member, | |
| 992 | [LHValue,b_operator(total_function,[DomValue,RangeValue])],Info),WF2), | |
| 993 | bsets_clp:total_function_test_wf(LHValue,DomValue,RangeValue,Res,WF2). | |
| 994 | b_check_member_expression(partial_surjection(Dom,Range),_RHS,LHS,Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 995 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 996 | b_wd_compute_expression(Dom,LocalState,State,DomValue,WFD), | |
| 997 | b_wd_compute_expression(Range,LocalState,State,RangeValue,WFD), | |
| 998 | opt_push_wait_flag_call_stack_info(WF,b_operator_call(member, | |
| 999 | [LHValue,b_operator(partial_surjection,[DomValue,RangeValue])],Info),WF2), | |
| 1000 | bsets_clp:partial_surjection_test_wf(LHValue,DomValue,RangeValue,Res,WF2). | |
| 1001 | b_check_member_expression(seq1(SeqType),_RHS,LHS,Info,LocalState,State,WFD,Res) :- !, get_wf(WFD,WF), | |
| 1002 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 1003 | b_wd_compute_expression(SeqType,LocalState,State,SeqTValue,WFD), | |
| 1004 | opt_push_wait_flag_call_stack_info(WF,b_operator_call(member, | |
| 1005 | [LHValue,b_operator(seq1,[SeqTValue])],Info),WF2), | |
| 1006 | bsets_clp:test_finite_non_empty_sequence(LHValue,SeqTValue,Res,WF2). | |
| 1007 | % TODO: more sequence checks | |
| 1008 | b_check_member_expression(_Arg,RHS,LHS,_Info,LocalState,State,WFD,Res) :- get_wf(WFD,WF), | |
| 1009 | b_wd_compute_expression(LHS,LocalState,State,LHValue,WFD), | |
| 1010 | b_wd_compute_expression(RHS,LocalState,State,RHValue,WFD), | |
| 1011 | membership_test_wf(RHValue,LHValue,Res,WF), | |
| 1012 | %(var(Res) -> add_message(reify,member,LHS,_Info) ; true), | |
| 1013 | force_membership_test(Res,LHValue,RHValue,WF). | |
| 1014 | ||
| 1015 | % ------------------------- | |
| 1016 | ||
| 1017 | % wfwd/4 add information about WD context to a WF store: wfwd(WF_store, ExpectedVal, Val,Infos) | |
| 1018 | % when Val becomes nonvar: if Val==ExpectedVal we need the value of E, otherwise it should be discarded | |
| 1019 | ||
| 1020 | % get WF store from WFD record | |
| 1021 | get_wf(wfwd(WF,_,_,_),Res) :- !, Res=WF. | |
| 1022 | get_wf(WFD,WF) :- add_internal_error('Illegal WFD store: ',get_wf(WFD,WF)), | |
| 1023 | WF = no_wf_available. | |
| 1024 | ||
| 1025 | % get expected PredicateResult and actual value; if both identical the associated expression is needed | |
| 1026 | get_wd(wfwd(_,WDExpected,WDVal,_),WDE,WDV) :- !, (WDExpected,WDVal)=(WDE,WDV). | |
| 1027 | get_wd(WFWD,WDE,WDV) :- add_internal_error('Illegal WFWD info:',get_wd(WFWD,WDE,WDV)), WDE=pred_true,WDV=pred_true. | |
| 1028 | ||
| 1029 | % create a WFWF construct for an expression that is needed and where reification should only succeed | |
| 1030 | % if the top-level construct at least can be fully reified (without non-determinism) | |
| 1031 | create_wfwd_needed(WF,wfwd(WF,pred_true,pred_true,outer_wfwd_context)). | |
| 1032 | ||
| 1033 | create_wfwd(WF,WDExpected,WDVal,wfwd(WF,WDExpected,WDVal,inner_wfwd_context)). | |
| 1034 | ||
| 1035 | :- public portray_wfwd/1. | |
| 1036 | portray_wfwd(wfwd(_,WDExpected,WDVal,Ctxt)) :- | |
| 1037 | format('Sub-formula required if ~w is expected ~w (ctxt: ~w)~n',[WDVal,WDExpected,Ctxt]). | |
| 1038 | ||
| 1039 | % ---------------------- | |
| 1040 | ||
| 1041 | construct_value(Type,Val,b(value(Val),Type,[])). | |
| 1042 | ||
| 1043 | :- use_module(bsyntaxtree, [safe_create_texpr/3]). | |
| 1044 | construct_equality(NewLHS,Type,ElementV,Equality) :- | |
| 1045 | Element = b(value(ElementV),Type,[]), | |
| 1046 | safe_create_texpr(equal(NewLHS,Element),pred,Equality). %, translate:print_bexpr(Equality),nl. | |
| 1047 | ||
| 1048 | %non_empty_set_version_of(seq1(RHS),seq(RHS)). | |
| 1049 | %non_empty_set_version_of(iseq1(RHS),iseq(RHS)). | |
| 1050 | %non_empty_set_version_of(fin1_subset(RHS),fin_subset(RHS)). | |
| 1051 | %non_empty_set_version_of(pow1_subset(RHS),pow_subset(RHS)). | |
| 1052 | ||
| 1053 | % check a boolean expression without reification attempt: wait until result is known or waitflag triggered | |
| 1054 | % can be useful for predicates which we know cannot be reified | |
| 1055 | b_force_check_boolean_expression(b(Pred,pred,Infos),LocalState,State,WF,Res) :- | |
| 1056 | b_check_boolean_expression4_delay(pred_true,pred_true,Pred,Infos,LocalState,State,WF,Res). | |
| 1057 | ||
| 1058 | :- block b_check_boolean_expression4_delay(?,-,?,?,?,?,?,?). | |
| 1059 | % currently only used for existential quantified predicates in data_validation_mode | |
| 1060 | b_check_boolean_expression4_delay(WDE,WDV,_Pred,_Infos,_,_,_WF,Res) :- WDE \= WDV, | |
| 1061 | % no need to check reify_inner_exists_non_deterministically, as we have marked _Pred as do_not_store | |
| 1062 | % ignoring (not evaluating) predicate | |
| 1063 | !, | |
| 1064 | Res=pred_false. % does not matter here (but Res could have been in another context, see above and test 2404) | |
| 1065 | b_check_boolean_expression4_delay(_WDE,_WDV,Pred,Infos,LocalState,State,WF,Res) :- | |
| 1066 | % we currently have not yet implemented a way to check the Pred; wait until Result is known | |
| 1067 | (preferences:preference(use_smt_mode,false) | |
| 1068 | -> get_last_wait_flag(b_check_test_boolean_expression,WF,WF2) | |
| 1069 | ; get_binary_choice_wait_flag(b_check_test_boolean_expression,WF,WF2) | |
| 1070 | ), | |
| 1071 | (debug:debug_mode(on) -> print(' Check Testing: '),translate:print_bexpr(Pred),nl ; true), | |
| 1072 | b_check_test_boolean_expression(Res,WF2,b(Pred,pred,Infos),LocalState,State,WF). | |
| 1073 | ||
| 1074 | :- block b_check_test_boolean_expression(-,-,?,?,?,?). | |
| 1075 | %b_check_test_boolean_expression(P,LWF,Pred,LocalState,State,WF) :- write(check_test4(P,LWF)),nl,fail. | |
| 1076 | b_check_test_boolean_expression(pred_true,_,Pred,LocalState,State,WF) :- | |
| 1077 | b_test_boolean_expression(Pred,LocalState,State,WF). | |
| 1078 | b_check_test_boolean_expression(pred_false,_,Pred,LocalState,State,WF) :- | |
| 1079 | b_interpreter:b_not_test_boolean_expression(Pred,LocalState,State,WF). | |
| 1080 | ||
| 1081 | ||
| 1082 | /* | |
| 1083 | :- use_module(kernel_mappings). | |
| 1084 | member_check_should_be_reified(_,b(RHS,_,_)) :- functor(RHS,BOP,Arity), print(check(BOP,Arity)),nl,!. | |
| 1085 | member_check_should_be_reified(_,_) :- \+ preferences:preference(use_smt_mode,false),!. | |
| 1086 | member_check_should_be_reified(_LHS,b(RHS,_,_)) :- functor(RHS,BOP,Arity), | |
| 1087 | % check if we have optimized treatments available, for which we do not yet have reified versions | |
| 1088 | (Arity=1 -> \+ kernel_mappings:unary_in_boolean_type(BOP,_) | |
| 1089 | ; Arity=2 -> \+ kernel_mappings:binary_in_boolean_type(BOP,_) | |
| 1090 | ; Arity=0 -> \+ kernel_mappings:cst_in_boolean_type(BOP,_) | |
| 1091 | ; true). | |
| 1092 | */ | |
| 1093 | ||
| 1094 | ||
| 1095 | :- block force_membership_test(-,?,?,?). | |
| 1096 | % currently required for ensuring that following fails: | |
| 1097 | % kernel_objects:union(closure(['_zzzz_unit_tests'],[integer],b(member(b(identifier('_zzzz_unit_tests'),integer,[generated]),b(value([int(3),int(4)]),set(integer),[])),pred,[])),closure(['_zzzz_unit_tests'],[integer],b(member(b(identifier('_zzzz_unit_tests'),integer,[generated]),b(value([int(2),int(1)]),set(integer),[])),pred,[])),[int(1),int(3),int(2)]) | |
| 1098 | % Reason: membership_test does not on its own enumerate | |
| 1099 | force_membership_test(pred_true,X,Set,WF) :- | |
| 1100 | Set \= [], | |
| 1101 | (ground_value(X) -> true | |
| 1102 | ; nonvar(Set),no_use_forcing(Set) -> true % no use in forcing membership, will call same element_of_avl_set_wf | |
| 1103 | ; kernel_objects:check_element_of_wf(X,Set,WF) | |
| 1104 | ). | |
| 1105 | force_membership_test(pred_false,_X,_Set,_WF). | |
| 1106 | ||
| 1107 | % forcing is sometimes useful because we can transmit a WF, currently some of the reification predicates | |
| 1108 | % do not have a WF-Store and can thus do limited enumeration ! in particular true for CLPFD = FALSE mode | |
| 1109 | no_use_forcing(avl_set(_)) :- preferences:preference(use_clpfd_solver,true). | |
| 1110 | no_use_forcing(global_set(_)). | |
| 1111 | %no_use_forcing(closure(_,_,B)) :- preferences:preference(use_clpfd_solver,true). | |
| 1112 | ||
| 1113 | ||
| 1114 | ||
| 1115 | :- use_module(external_functions,[call_external_predicate/8, do_not_evaluate_args/1]). | |
| 1116 | b_check_external_pred_call(FunName,Args,Info,LocalState,State,WFD,Res) :- | |
| 1117 | get_wf(WFD,WF), | |
| 1118 | (do_not_evaluate_args(FunName) -> EvaluatedArgs=[] | |
| 1119 | ; b_wd_compute_expressions(Args, LocalState,State, EvaluatedArgs, WFD)), | |
| 1120 | push_wait_flag_call_stack_info(WF,external_call(FunName,EvaluatedArgs,Info),WF2), | |
| 1121 | call_external_predicate(FunName,Args,EvaluatedArgs,LocalState,State,Res,Info,WF2). | |
| 1122 | ||
| 1123 | wd_delay_until_needed(WFWD,Call) :- | |
| 1124 | get_wd(WFWD,WDExpected,WDV), | |
| 1125 | wd_delay_until_needed_block(WDExpected,WDV,Call). | |
| 1126 | :- block wd_delay_until_needed_block(-,?,?), wd_delay_until_needed_block(?,-,?). | |
| 1127 | wd_delay_until_needed_block(WDExpected,WDV,Call) :- WDExpected==WDV,!, | |
| 1128 | call(Call). | |
| 1129 | wd_delay_until_needed_block(_,_,_). % first call not needed | |
| 1130 | ||
| 1131 | ||
| 1132 | :- use_module(library(avl)). | |
| 1133 | reuse_predicate(_,_,no_avl) :- !,fail. | |
| 1134 | reuse_predicate(Pred,Var,AVL) :- | |
| 1135 | avl_fetch(Pred,AVL,Var),!. %pred_var(Var)). | |
| 1136 | reuse_predicate(Pred,Var,AVL) :- %print(check(Pred)),nl, portray_avl(AVL),nl, | |
| 1137 | preferences:preference(use_smt_mode,true), % it does not seem very expensive; we could always enable it | |
| 1138 | implied_by(Pred,Val,OtherPred,OVal), | |
| 1139 | avl_fetch(OtherPred,AVL,OVar), OVar==OVal,!, | |
| 1140 | %print(reused_due_to_implication(Pred)),nl,nl, | |
| 1141 | Var=Val. | |
| 1142 | ||
| 1143 | add_predicate(_Pred,_Var,no_avl,NewAVL) :- !, NewAVL=no_avl. | |
| 1144 | add_predicate(Pred,Var,AVL,NewAVL) :- | |
| 1145 | % we could compute terms:term_hash(Pred,H) and add pred(H,Pred) to AVL to avoid comparing terms during avl_fetch | |
| 1146 | (avl_store(Pred,AVL,Var,NewAVL) -> true ; NewAVL=no_avl). %pred_var(Var),NewAVL). | |
| 1147 | ||
| 1148 | % detect whether predicate implied by some registered predicate | |
| 1149 | % detects inconsistency in x:INTEGER & x>y & y>x | |
| 1150 | % very lightweight propagation also achieved by CHR for less | |
| 1151 | implied_by(less(A,B),pred_false,less(B,A),pred_true). % A>B => not( A<B ) <=> A>=B | |
| 1152 | implied_by(subset_strict(A,B),pred_false,subset_strict(B,A),pred_true). % B <<: A => not( A<<:B ) | |
| 1153 | implied_by(subset_strict(A,B),pred_false,subset(B,A),pred_true). % B <: A => not( A<<:B ) | |
| 1154 | implied_by(subset(A,B),pred_false,subset_strict(B,A),pred_true). % B <<: A => not( A<:B ) | |
| 1155 | % TO DO: add more rules; e.g., less(x,10) implied by less(x,9) | |
| 1156 | ||
| 1157 | % normalises a typed predicate by removing position information and ordering commutative operators in a canonical way | |
| 1158 | norm_pred_check(B,Res) :- | |
| 1159 | ( norm_pred(B,Res) | |
| 1160 | -> true | |
| 1161 | ; bget_functor(B,F,N), | |
| 1162 | print(norm_pred_failed(F/N)), nl, | |
| 1163 | print_bexpr(B), nl, | |
| 1164 | Res=B | |
| 1165 | ). | |
| 1166 | ||
| 1167 | bget_functor(b(B,_,_),F,N) :- functor(B,F,N). | |
| 1168 | bget_functor(B,F,N) :- functor(B,F,N). | |
| 1169 | ||
| 1170 | %% :-(+List, -UntypedConj). | |
| 1171 | conjunct_untyped([], Res) :- !, Res=truth. | |
| 1172 | conjunct_untyped([P|Rest],Result) :- conjunct2(Rest,P,Result). | |
| 1173 | conjunct2([],P,P). | |
| 1174 | conjunct2([Q|Rest],P,Result) :- conjunct2(Rest,conjunct(P,Q),Result). | |
| 1175 | ||
| 1176 | %% disjunct_untyped(+List, -UntypedDisj). | |
| 1177 | disjunct_untyped([], Res) :- !, Res=falsity. | |
| 1178 | disjunct_untyped([P|Rest],Result) :- disjunct2(Rest,P,Result). | |
| 1179 | disjunct2([],P,P). | |
| 1180 | disjunct2([Q|Rest],P,Result) :- disjunct2(Rest,disjunct(P,Q),Result). | |
| 1181 | ||
| 1182 | :- assert_must_succeed((I=b(identifier(i),integer,[]),P1=b(greater_equal(I,I),pred,[]),norm_pred(P1,N1), | |
| 1183 | P2=b(greater_equal(I,I),pred,[info]),norm_pred(P2,N2), N2==N1)). % info ignored | |
| 1184 | :- assert_must_succeed((I1=b(identifier(i1),integer,[]),I2=b(identifier(i2),integer,[]), | |
| 1185 | P1=b(equal(I1,I2),pred,[]),norm_pred(P1,N1), | |
| 1186 | P2=b(equal(I2,I1),pred,[info]),norm_pred(P2,N2), N2==N1)). % equal re-ordered | |
| 1187 | :- assert_must_succeed((I1=b(identifier(i1),integer,[]),I2=b(identifier(i2),integer,[]), | |
| 1188 | P1=b(greater_equal(I1,I2),pred,[]),norm_pred(P1,N1), | |
| 1189 | P2=b(less_equal(I2,I1),pred,[info]),norm_pred(P2,N2), N2==N1)). % <= and >= re-ordered | |
| 1190 | :- assert_must_succeed((I1=b(identifier(i1),integer,[]),I2=b(identifier(i2),integer,[]), | |
| 1191 | P1=b(greater(I1,I2),pred,[]),norm_pred(P1,N1), | |
| 1192 | P2=b(less(I2,I1),pred,[info]),norm_pred(P2,N2), N2==N1)). % < and > re-ordered | |
| 1193 | :- assert_must_succeed((I1=b(identifier(i1),integer,[]),I2=b(identifier(i2),integer,[]), | |
| 1194 | P1=b(greater(I1,I2),pred,[]),norm_pred(P1,N1), | |
| 1195 | P2=b(less_equal(I2,I1),pred,[]),norm_pred(P2,N2), N2 \= N1)). % > and <= not made equal | |
| 1196 | :- assert_must_succeed((I=b(identifier(i),integer,[]),P1=b(greater_equal(I,I),pred,[was(test1)]), | |
| 1197 | P2=b(not_equal(I,I),pred,[was(test2)]), | |
| 1198 | conjunct_predicates_with_pos_info([P1,P2],C1),norm_pred(C1,N1), | |
| 1199 | conjunct_predicates_with_pos_info([P2,P1],C2),norm_pred(C2,N2), N2==N1)). % conjunct re-ordered | |
| 1200 | :- assert_must_succeed((I=b(identifier(i),integer,[]),P1=b(greater_equal(I,I),pred,[was(test1)]), | |
| 1201 | P2=b(not_equal(I,I),pred,[was(test2)]), P3=b(equal(I,I),pred,[was(test3)]), | |
| 1202 | conjunct_predicates_with_pos_info([P1,P2,P3],C1),norm_pred(C1,N1), | |
| 1203 | conjunct_predicates_with_pos_info([P2,P3,P1],C2),norm_pred(C2,N2), N2==N1)). | |
| 1204 | ||
| 1205 | %% norm_pred(+AstOrExpr, -Norm). | |
| 1206 | norm_pred(X,Res) :- var(X),!,Res=X. | |
| 1207 | norm_pred(b(B,_,_),Res) :- !, norm_pred(B,Res). | |
| 1208 | norm_pred(falsity,Res) :- !, Res=falsity. | |
| 1209 | norm_pred(truth,Res) :- !, Res=truth. | |
| 1210 | norm_pred(conjunct(A,B),Res) :- | |
| 1211 | !, | |
| 1212 | flatten_conjunctions([A,B],CList), | |
| 1213 | % sort nested conjunctions and disjunctions instead of only single ones | |
| 1214 | % e.g., difference for '#i.(i : NATURAL & (i > `max`(self) & num′ = num <+ {self |-> i}))' if removing nested parentheses | |
| 1215 | l_norm_pred(CList, NormedList), | |
| 1216 | sort(NormedList,SortedList), % better to sort after normalisation | |
| 1217 | conjunct_untyped(SortedList, Res). | |
| 1218 | norm_pred(disjunct(A,B),Res) :- | |
| 1219 | !, | |
| 1220 | disjunction_to_list(b(disjunct(A,B),pred,[]), CList), % it would be more efficient not to re-construct the b/3 term | |
| 1221 | l_norm_pred(CList, NormedList), | |
| 1222 | sort(NormedList,SortedList), | |
| 1223 | disjunct_untyped(SortedList, Res). | |
| 1224 | norm_pred(equal(A,B),Res) :- !,norm_expr(A,AA),norm_expr(B,BB), | |
| 1225 | (BB @< AA -> Res = equal(AA,BB) ; Res= equal(BB,AA)). | |
| 1226 | norm_pred(equivalence(A,B),Res) :- !, norm_pred(A,AA), norm_pred(B,BB), | |
| 1227 | (BB @< AA -> Res = equivalence(AA,BB) ; Res= equivalence(BB,AA)). | |
| 1228 | norm_pred(exists(A,B),Res) :- !, Res=exists(AA,BB),l_norm_expr(A,AA), norm_pred(B,BB). | |
| 1229 | norm_pred(finite(A),finite(AA)) :- !,norm_expr(A,AA). | |
| 1230 | norm_pred(forall(A,B,C),Res) :- !, Res=forall(AA,BB,CC),l_norm_expr(A,AA), norm_pred(B,BB), norm_pred(C,CC). | |
| 1231 | norm_pred(greater(A,B),Less) :- !,norm_expr(A,AA),norm_expr(B,BB), norm_less(BB,AA,Less). | |
| 1232 | norm_pred(greater_equal(A,B),Leq) :- !,norm_expr(A,AA),norm_expr(B,BB), norm_less_equal(BB,AA,Leq). | |
| 1233 | norm_pred(implication(A,B),Res) :- !, % we could rewrite this to disjunct(not(A),B); but check ok for WD prover | |
| 1234 | Res=implication(AA,BB),norm_pred(A,AA), norm_pred(B,BB). | |
| 1235 | norm_pred(less(A,B),Less) :- !,norm_expr(A,AA),norm_expr(B,BB), norm_less(AA,BB,Less). | |
| 1236 | norm_pred(less_real(A,B),less_real(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1237 | norm_pred(less_equal(A,B),Leq) :- !,norm_expr(A,AA),norm_expr(B,BB), norm_less_equal(AA,BB,Leq). | |
| 1238 | norm_pred(less_equal_real(A,B),less_equal_real(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1239 | norm_pred(let_predicate(A,B,C),Res) :- !, | |
| 1240 | Res=let_predicate(AA,BB,CC), | |
| 1241 | l_norm_expr(A,AA), l_norm_expr(B,BB),norm_pred(C,CC). | |
| 1242 | norm_pred(lazy_let_pred(A,B,C),Res) :- !, | |
| 1243 | Res = lazy_let_pred(AA,BB,CC), | |
| 1244 | norm_expr(A,AA), | |
| 1245 | norm_pred_or_expr(B,BB),norm_pred(C,CC). | |
| 1246 | norm_pred(lazy_lookup_pred(A),Res) :- !, Res = lazy_lookup_pred(A). | |
| 1247 | norm_pred(member(A,B),member(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1248 | norm_pred(negation(A),Res) :- !, | |
| 1249 | (negate_typed_pred(A,NegA) -> norm_pred(NegA,Res) | |
| 1250 | ; Res=negation(AA), norm_pred(A,AA)). | |
| 1251 | norm_pred(not_equal(A,B),Res) :- !,norm_expr(A,AA),norm_expr(B,BB), | |
| 1252 | (BB @< AA -> Res = not_equal(AA,BB) ; Res= not_equal(BB,AA)). | |
| 1253 | norm_pred(not_member(A,B),not_member(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1254 | norm_pred(not_subset(A,B),not_subset(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1255 | norm_pred(not_subset_strict(A,B),not_subset_strict(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1256 | norm_pred(partition(A,L),partition(AA,LL)) :- !,norm_expr(A,AA),l_norm_expr(L,LL). | |
| 1257 | norm_pred(subset(A,B),subset(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1258 | norm_pred(subset_strict(A,B),subset_strict(AA,BB)) :- !,norm_expr(A,AA),norm_expr(B,BB). | |
| 1259 | norm_pred(freetype_case(Type,Case,A),freetype_case(Type,Case,AA)) :- !,norm_expr(A,AA). | |
| 1260 | norm_pred(X,X). % :- print(norm_pred(X)),nl. | |
| 1261 | ||
| 1262 | ||
| 1263 | l_norm_pred([],[]). | |
| 1264 | l_norm_pred([H|T],[NH|NT]) :- norm_pred(H,NH), l_norm_pred(T,NT). | |
| 1265 | ||
| 1266 | norm_pred_or_expr(b(B,pred,_),Res) :- norm_pred(B,Res). | |
| 1267 | norm_pred_or_expr(B,Res) :- norm_expr(B,Res). | |
| 1268 | ||
| 1269 | norm_less(unary_minus(A),MB,Res) :- apply_unary_minus(MB,B), !,norm_less(B,A,Res). % -A < -B => A > B | |
| 1270 | % we could also move unary_minus to B if not present | |
| 1271 | norm_less(MA,unary_minus(B),Res) :- apply_unary_minus(MA,A), !,norm_less(B,A,Res). | |
| 1272 | norm_less(A,B,less(A,B)). | |
| 1273 | ||
| 1274 | apply_unary_minus(unary_minus(A),A). | |
| 1275 | apply_unary_minus(Nr,MNr) :- number(Nr), MNr is -Nr. | |
| 1276 | ||
| 1277 | norm_less_equal(unary_minus(A),MB,Res) :- apply_unary_minus(MB,B), !,norm_less_equal(B,A,Res). % -A <= -B => A >= B | |
| 1278 | norm_less_equal(MA,unary_minus(B),Res) :- apply_unary_minus(MA,A), !,norm_less_equal(B,A,Res). | |
| 1279 | norm_less_equal(A,B,less_equal(A,B)). | |
| 1280 | ||
| 1281 | % --------------------- | |
| 1282 | ||
| 1283 | % generic normalisation predicate | |
| 1284 | norm_check(BExpr,Res) :- BExpr = b(_,pred,_),!, norm_pred_check(BExpr,Res). | |
| 1285 | norm_check(BExpr,Res) :- norm_expr_check(BExpr,Res). | |
| 1286 | ||
| 1287 | % normalise expressions and check for failure | |
| 1288 | norm_expr_check(X,Res) :- var(X),!,Res=X. | |
| 1289 | norm_expr_check(b(B,_,_),Res) :- !, norm_expr_check2(B,Res). | |
| 1290 | norm_expr_check(X,X). | |
| 1291 | ||
| 1292 | norm_expr_check2(B,Res) :- | |
| 1293 | (norm_expr2(B,Res) -> true | |
| 1294 | ; functor(B,F,N),print(norm_expr2_failed(F/N)),nl, | |
| 1295 | Res=B). | |
| 1296 | ||
| 1297 | norm_expr(X,Res) :- var(X),!,Res=X. | |
| 1298 | norm_expr(b(B,_,_),Res) :- !, norm_expr2(B,Res). | |
| 1299 | %norm_expr_check2(B,Res). %% comment in to obtain details about failed normalisation for expressions | |
| 1300 | norm_expr(X,X). % :- add_internal_error('Expr not wrapped:',norm_expr(X,X)). | |
| 1301 | ||
| 1302 | norm_expr2(assertion_expression(Cond,E,Expr),assertion_expression(AA,E,BB)) :- norm_pred(Cond,AA),norm_expr(Expr,BB). | |
| 1303 | norm_expr2(add(A,B),Res) :- norm_expr(A,AA), norm_expr(B,BB), (BB @< AA -> Res = add(AA,BB) ; Res= add(BB,AA)). | |
| 1304 | norm_expr2(add_real(A,B),add_real(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1305 | norm_expr2(bag_items(A),bag_items(AA)) :- norm_expr(A,AA). | |
| 1306 | norm_expr2(boolean_false,boolean_false). | |
| 1307 | norm_expr2(boolean_true,boolean_true). | |
| 1308 | norm_expr2(bool_set,bool_set). | |
| 1309 | norm_expr2(card(A),card(AA)) :- norm_expr(A,AA). | |
| 1310 | norm_expr2(cartesian_product(A,B),cartesian_product(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1311 | norm_expr2(closure(A),closure(AA)) :- norm_expr(A,AA). % this is closure1 | |
| 1312 | norm_expr2(compaction(A),compaction(AA)) :- norm_expr(A,AA). | |
| 1313 | norm_expr2(composition(A,B),composition(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1314 | norm_expr2(comprehension_set(A,B),comprehension_set(AA,BB)) :- l_norm_expr(A,AA), norm_pred(B,BB). | |
| 1315 | norm_expr2(concat(A,B),concat(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1316 | norm_expr2(convert_bool(A),convert_bool(AA)) :- norm_pred_check(A,AA). | |
| 1317 | norm_expr2(convert_real(A),convert_real(AA)) :- norm_expr(A,AA). | |
| 1318 | norm_expr2(convert_int_floor(A),convert_int_floor(AA)) :- norm_expr(A,AA). | |
| 1319 | norm_expr2(convert_int_ceiling(A),convert_int_ceiling(AA)) :- norm_expr(A,AA). | |
| 1320 | norm_expr2(couple(A,B),couple(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1321 | norm_expr2(direct_product(A,B),direct_product(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1322 | norm_expr2(div(A,B),div(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1323 | norm_expr2(div_real(A,B),div_real(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1324 | norm_expr2(floored_div(A,B),floored_div(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1325 | norm_expr2(domain_restriction(A,B),domain_restriction(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1326 | norm_expr2(domain_subtraction(A,B),domain_subtraction(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1327 | norm_expr2(domain(A),domain(AA)) :- norm_expr(A,AA). | |
| 1328 | norm_expr2(empty_sequence,empty_sequence). | |
| 1329 | norm_expr2(empty_set,empty_set). | |
| 1330 | norm_expr2(event_b_identity,event_b_identity). | |
| 1331 | norm_expr2(external_function_call(A,B),external_function_call(A,BB)) :- l_norm_expr(B,BB). | |
| 1332 | norm_expr2(fin_subset(A),fin_subset(AA)) :- norm_expr(A,AA). | |
| 1333 | norm_expr2(fin1_subset(A),fin1_subset(AA)) :- norm_expr(A,AA). | |
| 1334 | norm_expr2(first(A),first(AA)) :- norm_expr(A,AA). | |
| 1335 | norm_expr2(first_of_pair(A),first_of_pair(AA)) :- norm_expr(A,AA). | |
| 1336 | norm_expr2(first_projection(A,B),first_projection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1337 | norm_expr2(float_set,float_set). | |
| 1338 | norm_expr2(front(A),front(AA)) :- norm_expr(A,AA). | |
| 1339 | norm_expr2(function(A,B),function(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1340 | norm_expr2(general_concat(A),general_concat(AA)) :- norm_expr(A,AA). | |
| 1341 | norm_expr2(general_intersection(A),general_intersection(AA)) :- norm_expr(A,AA). | |
| 1342 | norm_expr2(general_product(A,B,C),Res) :- !, | |
| 1343 | Res=general_product(AA,BB,CC),l_norm_expr(A,AA), norm_pred(B,BB), norm_expr(C,CC). | |
| 1344 | norm_expr2(general_sum(A,B,C),Res) :- !, | |
| 1345 | Res=general_sum(AA,BB,CC),l_norm_expr(A,AA), norm_pred(B,BB), norm_expr(C,CC). | |
| 1346 | norm_expr2(general_union(A),general_union(AA)) :- norm_expr(A,AA). | |
| 1347 | norm_expr2(identifier(A),'$'(A)). % need wrapper to avoid confusion with other terms ! | |
| 1348 | norm_expr2(identity(A),identity(AA)) :- norm_expr(A,AA). | |
| 1349 | norm_expr2(if_then_else(P,A,B),if_then_else(PP,AA,BB)) :- norm_pred(P,PP),norm_expr(A,AA), norm_expr(B,BB). | |
| 1350 | norm_expr2(image(A,B),image(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1351 | norm_expr2(insert_front(A,B),insert_front(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1352 | norm_expr2(insert_tail(A,B),insert_tail(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1353 | norm_expr2(integer_set(A),A). | |
| 1354 | norm_expr2(integer(A),A). % integer represented as number | |
| 1355 | norm_expr2(intersection(A,B),Res) :- norm_expr(A,AA), norm_expr(B,BB), | |
| 1356 | (BB @< AA -> Res = intersection(AA,BB) ; Res= intersection(BB,AA)). | |
| 1357 | norm_expr2(interval(A,B),interval(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1358 | norm_expr2(iseq(A),iseq(AA)) :- norm_expr(A,AA). | |
| 1359 | norm_expr2(iseq1(A),iseq1(AA)) :- norm_expr(A,AA). | |
| 1360 | norm_expr2(iteration(A,B),iteration(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1361 | norm_expr2(last(A),last(AA)) :- norm_expr(A,AA). | |
| 1362 | norm_expr2(lazy_let_expr(A,B,C),lazy_let_expr(AA,BB,CC)) :- | |
| 1363 | norm_expr(A,AA),norm_pred_or_expr(B,BB),norm_expr(C,CC). | |
| 1364 | norm_expr2(lazy_lookup_expr(A),lazy_lookup_expr(A)) :- !. | |
| 1365 | norm_expr2(let_expression(A,B,C),let_expression(AA,BB,CC)) :- l_norm_expr(A,AA), l_norm_expr(B,BB),norm_expr(C,CC). | |
| 1366 | norm_expr2(let_expression_global(A,B,C),let_expression_global(AA,BB,CC)) :- l_norm_expr(A,AA), l_norm_expr(B,BB),norm_pred(C,CC). | |
| 1367 | norm_expr2(max(A),max(AA)) :- norm_expr(A,AA). | |
| 1368 | norm_expr2(max_real(A),max_real(AA)) :- norm_expr(A,AA). | |
| 1369 | norm_expr2(max_int,max_int). | |
| 1370 | norm_expr2(min(A),min(AA)) :- norm_expr(A,AA). | |
| 1371 | norm_expr2(min_real(A),min_real(AA)) :- norm_expr(A,AA). | |
| 1372 | norm_expr2(min_int,min_int). | |
| 1373 | norm_expr2(minus(A,B),minus(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1374 | norm_expr2(minus_or_set_subtract(A,B),minus_or_set_subtract(AA,BB)) :- write(cannot_normalise_minus_or_set_subtract),nl, | |
| 1375 | norm_expr(A,AA), norm_expr(B,BB). % should have been removed by cleanup_pre !! | |
| 1376 | norm_expr2(minus_real(A,B),minus_real(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1377 | norm_expr2(modulo(A,B),modulo(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1378 | norm_expr2(mu(A),mu(AA)) :- norm_expr(A,AA). | |
| 1379 | norm_expr2(multiplication(A,B),Res) :- | |
| 1380 | norm_expr(A,AA), norm_expr(B,BB), (BB @< AA -> Res = multiplication(AA,BB) ; Res= multiplication(BB,AA)). | |
| 1381 | norm_expr2(mult_or_cart(A,B),mult_or_cart(AA,BB)) :- write(cannot_normalise_mult_or_cart),nl, | |
| 1382 | norm_expr(A,AA), norm_expr(B,BB). % should have been removed by cleanup_pre !! | |
| 1383 | norm_expr2(multiplication_real(A,B),multiplication_real(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1384 | norm_expr2(operation_call_in_expr(A,B),operation_call_in_expr(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1385 | norm_expr2(overwrite(A,B),overwrite(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1386 | norm_expr2(parallel_product(A,B),parallel_product(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1387 | norm_expr2(partial_bijection(A,B),partial_bijection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1388 | norm_expr2(partial_function(A,B),partial_function(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1389 | norm_expr2(partial_injection(A,B),partial_injection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1390 | norm_expr2(partial_surjection(A,B),partial_surjection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1391 | norm_expr2(perm(A),perm(AA)) :- norm_expr(A,AA). | |
| 1392 | norm_expr2(power_of(A,B),power_of(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1393 | norm_expr2(power_of_real(A,B),power_of_real(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1394 | norm_expr2(pow_subset(A),pow_subset(AA)) :- norm_expr(A,AA). | |
| 1395 | norm_expr2(pow1_subset(A),pow1_subset(AA)) :- norm_expr(A,AA). | |
| 1396 | norm_expr2(predecessor,predecessor). | |
| 1397 | % quantified_intersection, quantified_union : should be removed by ast_cleanup | |
| 1398 | norm_expr2(range_restriction(A,B),range_restriction(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1399 | norm_expr2(range_subtraction(A,B),range_subtraction(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1400 | norm_expr2(range(A),range(AA)) :- norm_expr(A,AA). | |
| 1401 | norm_expr2(real(Atom),real(Atom)). % we could use the atom? or convert it to a real number using construct_real | |
| 1402 | norm_expr2(real_set,real_set). | |
| 1403 | norm_expr2(rec(A),rec(AA)) :- norm_fields(A,AA). | |
| 1404 | norm_expr2(record_field(A,Field),record_field(AA,Field)) :- norm_expr(A,AA). | |
| 1405 | norm_expr2(relations(A,B),relations(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1406 | norm_expr2(restrict_front(A,B),restrict_front(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1407 | norm_expr2(restrict_tail(A,B),restrict_tail(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1408 | norm_expr2(reflexive_closure(A),reflexive_closure(AA)) :- norm_expr(A,AA). % this is rewritten in ast_cleanup | |
| 1409 | norm_expr2(rev(A),rev(AA)) :- norm_expr(A,AA). | |
| 1410 | norm_expr2(reverse(A),reverse(AA)) :- norm_expr(A,AA). | |
| 1411 | norm_expr2(second_of_pair(A),second_of_pair(AA)) :- norm_expr(A,AA). | |
| 1412 | norm_expr2(second_projection(A,B),second_projection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1413 | norm_expr2(seq(A),seq(AA)) :- norm_expr(A,AA). | |
| 1414 | norm_expr2(seq1(A),seq1(AA)) :- norm_expr(A,AA). | |
| 1415 | norm_expr2(sequence_extension(L),sequence_extension(NL)) :- l_norm_expr(L,NL). | |
| 1416 | norm_expr2(set_extension(L),set_extension(NL)) :- l_norm_expr(L,NL). | |
| 1417 | norm_expr2(set_subtraction(A,B),set_subtraction(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). % set difference | |
| 1418 | norm_expr2(size(A),size(AA)) :- norm_expr(A,AA). | |
| 1419 | norm_expr2(string(A),string(A)). % need wrapper to avoid confusion with other terms ! | |
| 1420 | norm_expr2(string_set,string_set). | |
| 1421 | norm_expr2(struct(A),struct(AA)) :- norm_expr(A,AA). | |
| 1422 | norm_expr2(successor,successor). | |
| 1423 | norm_expr2(surjection_relation(A,B),surjection_relation(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1424 | norm_expr2(tail(A),tail(AA)) :- norm_expr(A,AA). | |
| 1425 | norm_expr2(total_bijection(A,B),total_bijection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1426 | norm_expr2(total_function(A,B),total_function(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1427 | norm_expr2(total_injection(A,B),total_injection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1428 | norm_expr2(total_relation(A,B),total_relation(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1429 | norm_expr2(total_surjection(A,B),total_surjection(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1430 | norm_expr2(total_surjection_relation(A,B),total_surjection_relation(AA,BB)) :- norm_expr(A,AA), norm_expr(B,BB). | |
| 1431 | norm_expr2(typeset,typeset). | |
| 1432 | ||
| 1433 | norm_expr2(unary_minus(A),unary_minus(AA)) :- norm_expr(A,AA). | |
| 1434 | norm_expr2(unary_minus_real(A),unary_minus_real(AA)) :- norm_expr(A,AA). | |
| 1435 | norm_expr2(union(A,B),Res) :- norm_expr(A,AA), norm_expr(B,BB), (BB @< AA -> Res = union(AA,BB) ; Res= union(BB,AA)). | |
| 1436 | norm_expr2(value(A),NA) :- norm_value(A,NA). | |
| 1437 | ||
| 1438 | norm_expr2(freetype_set(T),freetype_set(T)). | |
| 1439 | norm_expr2(freetype_constructor(FT,Case,A), freetype_constructor(FT,Case,AA)) :- norm_expr(A,AA). | |
| 1440 | norm_expr2(freetype_destructor(FT,Case,A),freetype_destructor(FT,Case,AA)) :- norm_expr(A,AA). | |
| 1441 | norm_expr2(recursive_let(A,B),recursive_let(AA,BB)) :- norm_expr(A,AA),norm_expr(B,BB). | |
| 1442 | ||
| 1443 | ||
| 1444 | norm_fields([],[]). | |
| 1445 | norm_fields([field(Name,H)|T],[field(Name,NH)|NT]) :- norm_expr(H,NH), norm_fields(T,NT). | |
| 1446 | ||
| 1447 | l_norm_expr([],[]). | |
| 1448 | l_norm_expr([H|T],[NH|NT]) :- norm_expr(H,NH), l_norm_expr(T,NT). | |
| 1449 | ||
| 1450 | :- use_module(closures,[is_member_closure/5]). | |
| 1451 | norm_value(V,R) :- var(V),!,R=value(V). | |
| 1452 | norm_value(int(Nr),R) :- number(Nr),!,R=Nr. | |
| 1453 | norm_value([],R) :- !, R=empty_set. | |
| 1454 | norm_value(pred_false,R) :- !, R=boolean_false. | |
| 1455 | norm_value(pred_true,R) :- !, R=boolean_true. | |
| 1456 | norm_value(closure(P,T,B),R) :- | |
| 1457 | (is_member_closure(P,T,B,_,Set) % peel useless member closure wrapper, see test 2483 | |
| 1458 | -> !, norm_expr_check2(Set,R) | |
| 1459 | ; norm_pred_check(B,NB) | |
| 1460 | -> !, % normalising relevant for test 1544 with position info added by construct_member_closure | |
| 1461 | R=value(closure(P,T,NB)) | |
| 1462 | ). | |
| 1463 | norm_value((A,B),R) :- !, R=(NA,NB), norm_value(A,NA), norm_value(B,NB). | |
| 1464 | norm_value(rec(Fields),rec(NFields)) :- !, norm_field_values(Fields,NFields). | |
| 1465 | norm_value(V,value(V)). % we could normalise AVL, or pairs | |
| 1466 | ||
| 1467 | norm_field_values([],[]). | |
| 1468 | norm_field_values([field(Name,H)|T],[field(Name,NH)|NT]) :- norm_inner_value(H,NH), norm_field_values(T,NT). | |
| 1469 | ||
| 1470 | % norm inside values; e.g., getting rid of info fields of closures, see test 2483 | |
| 1471 | norm_inner_value((A,B),R) :- !, R=(NA,NB), norm_inner_value(A,NA), norm_inner_value(B,NB). | |
| 1472 | norm_inner_value(rec(Fields),rec(NFields)) :- !, norm_field_values(Fields,NFields). | |
| 1473 | norm_inner_value(closure(P,T,B),R) :- norm_pred_check(B,NB),!, | |
| 1474 | R=closure(P,T,NB). | |
| 1475 | % TODO: inside sets ? but AVL sets contain no closures | |
| 1476 | norm_inner_value(V,V). | |
| 1477 | ||
| 1478 | ||
| 1479 | arithmetic_op(less(LHS,RHS),'<',LHS,RHS). | |
| 1480 | arithmetic_op(less_equal(LHS,RHS),'<=',LHS,RHS). | |
| 1481 | arithmetic_op(greater(LHS,RHS),'<',RHS,LHS). | |
| 1482 | arithmetic_op(greater_equal(LHS,RHS),'<=',RHS,LHS). | |
| 1483 | ||
| 1484 | :- use_module(probsrc(kernel_reals),[real_comp_wf/5]). | |
| 1485 | % these two predicates can be checked by real_comp_wf: | |
| 1486 | real_arithmetic_op(less_real(LHS,RHS),'<',LHS,RHS). | |
| 1487 | real_arithmetic_op(less_equal_real(LHS,RHS),'=<',LHS,RHS). | |
| 1488 | ||
| 1489 | :- use_module(clpfd_interface). | |
| 1490 | :- use_module(library(clpfd), [(#<=>)/2]). | |
| 1491 | check_arithmetic_operator('<',X,Y,Res) :- check_less(X,Y,Res), | |
| 1492 | (nonvar(Res) -> true | |
| 1493 | ; clpfd_interface:try_post_constraint((X#<Y) #<=> R01), prop_pred_01(Res,R01)). | |
| 1494 | check_arithmetic_operator('<=',X,Y,Res) :- check_less_than_equal(X,Y,Res), | |
| 1495 | (nonvar(Res) -> true | |
| 1496 | ; clpfd_interface:try_post_constraint((X#=<Y) #<=> R01), prop_pred_01(Res,R01)). | |
| 1497 | ||
| 1498 | ||
| 1499 | :- block prop_pred_01(-,-). | |
| 1500 | prop_pred_01(A,B) :- B==1,!,A=pred_true. % cut ok: either pred_true or 1 set | |
| 1501 | prop_pred_01(pred_true,1). | |
| 1502 | prop_pred_01(pred_false,0). | |
| 1503 | ||
| 1504 | :- block check_less(-,?,-), check_less(?,-,-). | |
| 1505 | check_less(X,Y,Res) :- nonvar(Res),!, /* truth value known: enforce it */ | |
| 1506 | (Res=pred_true -> less_than_direct(X,Y) ; less_than_equal_direct(Y,X)). | |
| 1507 | check_less(X,Y,Res) :- | |
| 1508 | X < Y,!,/* we could call safe_less_than(X,Y), */ | |
| 1509 | Res=pred_true. | |
| 1510 | check_less(_,_,pred_false). | |
| 1511 | :- block check_less_than_equal(-,?,-), check_less_than_equal(?,-,-). | |
| 1512 | check_less_than_equal(X,Y,Res) :- nonvar(Res),!, /* truth value known: enforce it */ | |
| 1513 | (Res=pred_true -> less_than_equal_direct(X,Y) ; less_than_direct(Y,X)). | |
| 1514 | check_less_than_equal(X,Y,Res) :- X =< Y,!,Res=pred_true. | |
| 1515 | check_less_than_equal(_,_,pred_false). | |
| 1516 | ||
| 1517 | ||
| 1518 | ||
| 1519 | :- use_module(bool_pred). | |
| 1520 | ||
| 1521 | :- use_module(kernel_objects,[exhaustive_kernel_check_wf/2, | |
| 1522 | exhaustive_kernel_check/1, exhaustive_kernel_check/2, exhaustive_kernel_fail_check/1]). | |
| 1523 | ||
| 1524 | :- assert_must_succeed(exhaustive_kernel_check_wf(b_interpreter_check:conjoin(pred_false,pred_false,pred_false,b(truth,pred,[]),b(truth,pred,[]),WF),WF)). | |
| 1525 | :- assert_must_succeed(exhaustive_kernel_check_wf(b_interpreter_check:conjoin(pred_false,pred_true,pred_false,b(truth,pred,[]),b(truth,pred,[]),WF),WF)). | |
| 1526 | :- assert_must_succeed(exhaustive_kernel_check_wf(b_interpreter_check:conjoin(pred_true,pred_false,pred_false,b(truth,pred,[]),b(truth,pred,[]),WF),WF)). | |
| 1527 | :- assert_must_succeed(exhaustive_kernel_check_wf(b_interpreter_check:conjoin(pred_true,pred_true,pred_true,b(truth,pred,[]),b(truth,pred,[]),WF),WF)). | |
| 1528 | :- assert_must_fail(b_interpreter_check:conjoin(pred_true,pred_false,pred_true,b(truth,pred,[]),b(truth,pred,[]),_WF)). | |
| 1529 | :- assert_must_fail(b_interpreter_check:conjoin(pred_true,pred_true,pred_false,b(truth,pred,[]),b(truth,pred,[]),_WF)). | |
| 1530 | ||
| 1531 | ||
| 1532 | % same as and_equality/3 but for pred_false/pred_true rather than eq_obj/pred_false | |
| 1533 | :- block conjoin(-,-,-,?,?,?). | |
| 1534 | conjoin(X,Y,Res,LHS,RHS,WF) :- % print(conjoin(X,Y,Res)),nl, translate:print_bexpr(LHS),nl,% | |
| 1535 | ( Res==pred_true -> X=pred_true,Y=pred_true % on SWI these propagations happen one after the other, see test 2202 | |
| 1536 | ; X==pred_true -> Res=Y | |
| 1537 | ; X==pred_false -> Res=pred_false | |
| 1538 | ; Y==pred_true -> Res=X | |
| 1539 | ; Y==pred_false -> Res=pred_false | |
| 1540 | ? | ; Res==pred_false -> conjoin_false0(X,Y,LHS,RHS,WF) |
| 1541 | ; add_error_fail(conjoin,'Illegal values: ', conjoin(X,Y,Res,LHS,RHS,WF)) | |
| 1542 | ). | |
| 1543 | conjoin_false0(X,Y,_LHS,_RHS,_WF) :- X==Y,!, | |
| 1544 | %print(conjoin_false_eqeq(X,Y)),nl, translate:print_bexpr(_LHS),nl, | |
| 1545 | X=pred_false. | |
| 1546 | conjoin_false0(X,Y,_LHS,_RHS,_WF) :- % X & not(X) -> always false | |
| 1547 | bool_negate_check(X,Y),! | |
| 1548 | . %,print(conjoin_false_neqeq(X,Y)),nl,translate:print_bexpr(_LHS),nl. | |
| 1549 | conjoin_false0(X,Y,LHS,RHS,WF) :- | |
| 1550 | %%Prio=1, %% | |
| 1551 | %%(preferences:preference(use_smt_mode,full) -> FullPrio=1.5 ; | |
| 1552 | get_priority_of_boolean_expression(LHS,Prio), | |
| 1553 | (preferences:preference(use_clpfd_solver,true) -> | |
| 1554 | % relevant for tests 349, 362: | |
| 1555 | count_number_of_conjuncts(RHS,NrC), | |
| 1556 | FullPrio is Prio+(NrC-1)/10, | |
| 1557 | get_wait_flag(FullPrio,conjoin,WF,LWF) %% | |
| 1558 | ; % in non-clpfd mode: much less propagation going on, avoid explosion of choice points | |
| 1559 | % tests 349, 362 fail with the following for CLPFD: TO DO investigate and use this also in CLPFD mode | |
| 1560 | get_binary_choice_wait_flag_exp_backoff(Prio,not_conjunct,WF,LWF) | |
| 1561 | ), | |
| 1562 | ? | conjoin_false(X,Y,LHS,RHS,LWF). |
| 1563 | % missing rule: if X==Y -> X=pred_true | |
| 1564 | :- block conjoin_false(-,-,?,?,-). | |
| 1565 | conjoin_false(X,Y,LHS,_RHS,_LWF) :- | |
| 1566 | ( X==pred_true -> pred_false=Y | |
| 1567 | ; X==pred_false -> true | |
| 1568 | ; Y==pred_true -> pred_false=X | |
| 1569 | ; Y==pred_false -> true | |
| 1570 | ; useless_to_force(LHS) -> | |
| 1571 | ( % print(forcing_conjoin_rhs_false(X,Y,_LWF)), translate:print_bexpr(_RHS), print(' == FALSE '),nl, | |
| 1572 | Y=pred_false | |
| 1573 | ; | |
| 1574 | (Y,X)=(pred_true,pred_false) | |
| 1575 | ) | |
| 1576 | ; ( % print(forcing_conjoin_lhs_false(X,Y,_LWF)), translate:print_bexpr(LHS), print(' == FALSE '),nl, | |
| 1577 | X=pred_false | |
| 1578 | ; % print(forcing_conjoin_rhs_false(X,Y,_LWF)), translate:print_bexpr(LHS), print(' == TRUE ; '), nl, | |
| 1579 | (X,Y)=(pred_true,pred_false) | |
| 1580 | ) | |
| 1581 | ). | |
| 1582 | ||
| 1583 | % determine when forcing a predicate to true/false does not really help; better choose something else | |
| 1584 | useless_to_force(b(B,T,I)) :- useless_to_force3(B,T,I). | |
| 1585 | useless_to_force3(finite(_),_,_). % forcing finite to be false usually not a good idea; we cannot propagate this | |
| 1586 | % what are other predicates useless to force: some foralls/exists ? some external_pred_call | |
| 1587 | % in principle a conjunction of useless predicates is also useless: but could be more expensive to check | |
| 1588 | ||
| 1589 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:disjoin(pred_false,pred_false,pred_false,_,_,_WF))). | |
| 1590 | :- assert_must_succeed(exhaustive_kernel_check([commutative],b_interpreter_check:disjoin(pred_false,pred_true,pred_true,_,_,_WF))). | |
| 1591 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:disjoin(pred_true,pred_true,pred_true,_,_,_WF))). | |
| 1592 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:disjoin(pred_true,pred_true,pred_false,_,_,_WF))). | |
| 1593 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:disjoin(pred_true,pred_false,pred_false,_,_,_WF))). | |
| 1594 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:disjoin(pred_false,pred_true,pred_false,_,_,_WF))). | |
| 1595 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:disjoin(pred_false,pred_false,pred_true,_,_,_WF))). | |
| 1596 | ||
| 1597 | :- block disjoin(-,-,-,?,?,?). | |
| 1598 | disjoin(X,Y,Res,LHS,RHS,WF) :- | |
| 1599 | %print(disjoin(X,Y,Res,WF)),nl, %% translate:print_bexpr(LHS),print(' or '),translate:print_bexpr(RHS),nl,%% | |
| 1600 | ( Res==pred_false -> X=pred_false,Y=pred_false | |
| 1601 | ; X==pred_true -> Res=pred_true | |
| 1602 | ; X==pred_false -> Res=Y | |
| 1603 | ; Y==pred_true -> Res=pred_true | |
| 1604 | ; Y==pred_false -> Res=X | |
| 1605 | ? | ; Res==pred_true -> disjoin_true0(X,Y,LHS,RHS,WF) |
| 1606 | ; add_error_fail(disjoin,'Illegal values: ',disjoin(X,Y,Res,LHS,RHS,WF)) | |
| 1607 | ). | |
| 1608 | disjoin_true0(X,Y,_LHS,_RHS,_WF) :- X==Y,!, | |
| 1609 | X=pred_true. | |
| 1610 | %disjoin_true0(X,Y,LHS,_,WF) :- !, disjoin_true(X,Y,_). | |
| 1611 | disjoin_true0(X,Y,_LHS,_RHS,_WF) :- % X or not(X) -> always true | |
| 1612 | bool_negate_check(X,Y),!. | |
| 1613 | ||
| 1614 | disjoin_true0(X,Y,LHS,_RHS,WF) :- | |
| 1615 | %%(preferences:preference(use_smt_mode,full) -> FullPrio=2.5 ; | |
| 1616 | % poses problem for test 1096: | |
| 1617 | % count_number_of_disjuncts(RHS,NrC), | |
| 1618 | %FullPrio is Prio+(NrC-1)/10, | |
| 1619 | %get_wait_flag(FullPrio,disjoin,WF,LWF), %% | |
| 1620 | get_priority_of_boolean_expression(LHS,StartPrio), | |
| 1621 | get_binary_choice_wait_flag_exp_backoff(StartPrio,disjunct,WF,LWF), | |
| 1622 | % TO DO: extract FD information from LHS and RHS and assert, e.g. x:1..2 or x:4..5 | |
| 1623 | ? | disjoin_true(X,Y,LHS,LWF). |
| 1624 | % missing rule: if X==Y -> X=pred_true ; if X==~Y -> no need to setup choice point | |
| 1625 | :- block disjoin_true(-,-,?,-). | |
| 1626 | disjoin_true(X,Y,LHS,_LWF) :- | |
| 1627 | ( X==pred_true -> true | |
| 1628 | ; X==pred_false -> pred_true=Y | |
| 1629 | ; Y==pred_true -> true | |
| 1630 | ; Y==pred_false -> pred_true=X | |
| 1631 | ; useless_to_force(LHS) -> | |
| 1632 | ( %% print(forcing_disjoin_true(X,Y,_LWF)),nl, %% | |
| 1633 | Y=pred_true | |
| 1634 | ; | |
| 1635 | %%print(forcing_disjoin_false(X,Y,_LWF)),nl, | |
| 1636 | (Y,X) = (pred_false,pred_true) % these two unifications will happen atomically ! | |
| 1637 | ) | |
| 1638 | ; ( %% print(forcing_disjoin_true(X,Y,_LWF)),nl, %% | |
| 1639 | X=pred_true | |
| 1640 | ; | |
| 1641 | %%print(forcing_disjoin_false(X,Y,_LWF)),nl, | |
| 1642 | (X,Y) = (pred_false,pred_true) % these two unifications will happen atomically ! | |
| 1643 | ) | |
| 1644 | %add_error_fail(disjoin_true,'Illegal values: ',disjoin_true(X,Y)) | |
| 1645 | ). | |
| 1646 | ||
| 1647 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:imply(pred_false,pred_false,pred_true))). | |
| 1648 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:imply(pred_false,pred_true,pred_true))). | |
| 1649 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:imply(pred_true,pred_false,pred_false))). | |
| 1650 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:imply(pred_true,pred_true,pred_true))). | |
| 1651 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:imply(pred_false,pred_false,pred_false))). | |
| 1652 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:imply(pred_false,pred_true,pred_false))). | |
| 1653 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:imply(pred_true,pred_false,pred_true))). | |
| 1654 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:imply(pred_true,pred_true,pred_false))). | |
| 1655 | ||
| 1656 | imply(X,Y,Res) :- | |
| 1657 | (var(X),var(Y),var(Res) -> bool_equality(X,Y,EqXY) ; true /* impl4 will not block anyway */), | |
| 1658 | impl4(X,Y,EqXY,Res). | |
| 1659 | :- block impl4(-,-,-,-). | |
| 1660 | impl4(X,Y,EqXY,Res) :- | |
| 1661 | ( Res==pred_false -> X=pred_true,Y=pred_false | |
| 1662 | ; Res==pred_true -> imply_true3(X,Y,EqXY) | |
| 1663 | ; X==pred_false -> Res=pred_true | |
| 1664 | ; X==pred_true -> Res=Y | |
| 1665 | ; Y==pred_true -> Res=pred_true | |
| 1666 | ; Y==pred_false -> negate(X,Res) | |
| 1667 | ; EqXY==pred_true -> Res=pred_true % X => X is always true | |
| 1668 | ; EqXY==pred_false -> Y=Res % not(Y) => Y is true iff Y is true | |
| 1669 | ; add_error_fail(impl,'Illegal values: ',imply(X,Y,EqXY,Res)) | |
| 1670 | ). | |
| 1671 | ||
| 1672 | % assert X=pred_true => Y=pred_true | |
| 1673 | imply_true(X,Y) :- | |
| 1674 | (var(X),var(Y) -> bool_equality(X,Y,EqXY) ; true /* imply_true will not block anyway */), | |
| 1675 | imply_true3(X,Y,EqXY). | |
| 1676 | :- block imply_true3(-,-,-). | |
| 1677 | imply_true3(X,Y,EqXY) :- | |
| 1678 | ( X==pred_false -> true | |
| 1679 | ; X==pred_true -> Y=pred_true | |
| 1680 | ; Y==pred_true -> true | |
| 1681 | ; Y==pred_false -> X=pred_false | |
| 1682 | ; EqXY==pred_true -> true | |
| 1683 | ; EqXY==pred_false -> X=pred_false % X => not(X) ===> X=pred_false | |
| 1684 | ; add_error_fail(imply_true,'Illegal values: ',imply_true3(X,Y,EqXY)) | |
| 1685 | ). | |
| 1686 | ||
| 1687 | ||
| 1688 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:equiv(pred_false,pred_false,pred_true))). | |
| 1689 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:equiv(pred_false,pred_true,pred_false))). | |
| 1690 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:equiv(pred_true,pred_false,pred_false))). | |
| 1691 | :- assert_must_succeed(exhaustive_kernel_check(b_interpreter_check:equiv(pred_true,pred_true,pred_true))). | |
| 1692 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:equiv(pred_false,pred_false,pred_false))). | |
| 1693 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:equiv(pred_false,pred_true,pred_true))). | |
| 1694 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:equiv(pred_true,pred_false,pred_true))). | |
| 1695 | :- assert_must_succeed(exhaustive_kernel_fail_check(b_interpreter_check:equiv(pred_true,pred_true,pred_false))). | |
| 1696 | ||
| 1697 | % b_interpreter_check:equiv(X,Y,Res),X=Y, Res==pred_true | |
| 1698 | equiv(X,Y,Res) :- | |
| 1699 | bool_equality(X,Y,Res). | |
| 1700 | ||
| 1701 |