| 1 | | % (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
| 2 | | % Heinrich Heine Universitaet Duesseldorf |
| 3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
| 4 | | |
| 5 | | |
| 6 | | :- module(custom_explicit_sets,[is_set_value/2, |
| 7 | | is_custom_explicit_set/1, is_custom_explicit_set/2, is_custom_explicit_set_nonvar/1, |
| 8 | | %equal_explicit_sets/2, |
| 9 | | equal_explicit_sets_wf/3, |
| 10 | | not_equal_explicit_sets_wf/3, |
| 11 | | equality_explicit_sets_wf/4, same_texpr_body/2, same_closure/2, |
| 12 | | is_empty_explicit_set/1, is_empty_explicit_set_wf/2, is_empty_closure_wf/4, |
| 13 | | is_non_empty_explicit_set/1, is_non_empty_explicit_set_wf/2, |
| 14 | | is_non_empty_closure_wf/4, |
| 15 | | test_empty_explicit_set_wf/3, test_empty_closure_wf/5, |
| 16 | | is_definitely_maximal_set/1, |
| 17 | | explicit_set_cardinality/2, explicit_set_cardinality_wf/3, |
| 18 | | explicit_set_cardinality_for_wf/2, |
| 19 | | card_for_specific_custom_set/3, % only succeeds if we can compute it efficiently |
| 20 | | card_for_specific_closure/4, |
| 21 | | efficient_card_for_set/3, % same, but also for lists |
| 22 | | quick_custom_explicit_set_approximate_size/2, |
| 23 | | avl_approximate_size/2, avl_approximate_size/3, |
| 24 | | is_infinite_explicit_set/1, is_infinite_closure/3, |
| 25 | | is_infinite_global_set/2, is_simple_infinite_set/1, |
| 26 | | dont_expand_this_explicit_set/1, dont_expand_this_explicit_set/2, |
| 27 | | dont_expand_symbolic_explicit_set/1, |
| 28 | | definitely_expand_this_explicit_set/1, |
| 29 | | is_infinite_or_very_large_explicit_set/1, |
| 30 | | is_infinite_or_very_large_explicit_set/2, |
| 31 | | is_cartesian_product_closure/3, |
| 32 | | expand_custom_set/2, expand_custom_set_wf/4, |
| 33 | | try_expand_custom_set/2, try_expand_custom_set_with_catch/3, |
| 34 | | try_expand_custom_set_wf/4, |
| 35 | | expand_custom_set_to_list/2, expand_custom_set_to_list/4, |
| 36 | | expand_custom_set_to_list_wf/5, |
| 37 | | expand_custom_set_to_list_no_dups_wf/5, |
| 38 | | expand_custom_set_to_list_gg/4, |
| 39 | | try_expand_custom_set_to_list/4, |
| 40 | | expand_interval_closure_to_avl/3, |
| 41 | | expand_custom_set_to_list_now/2, |
| 42 | | expand_closure_to_avl_or_list/6, |
| 43 | | expand_only_custom_closure_global/4, %try_expand_only_custom_closure_global/2, |
| 44 | | expand_and_convert_to_avl_set/4, |
| 45 | | ord_list_to_avlset_direct/3, sorted_ground_normalised_list_to_avlset/3, |
| 46 | | try_expand_and_convert_to_avl/2, convert_to_avl/2, |
| 47 | | should_be_converted_to_avl_from_lists/1, should_be_converted_to_avl/1, |
| 48 | | try_expand_and_convert_to_avl_with_check/3, |
| 49 | | try_expand_and_convert_to_avl_with_check/4, |
| 50 | | try_expand_and_convert_to_avl_unless_large_wf/3, |
| 51 | | %try_expand_and_convert_to_avl_unless_large_wf/3, |
| 52 | | try_expand_and_convert_to_avl_if_smaller_than/3, |
| 53 | | is_small_specific_custom_set/2, |
| 54 | | quick_propagation_element_information/4, |
| 55 | | element_of_custom_set/2, element_of_custom_set_wf/3, |
| 56 | | element_of_closure/5, |
| 57 | | check_element_of_function_closure/6, |
| 58 | | not_element_of_custom_set_wf/3, |
| 59 | | membership_custom_set/3, membership_custom_set_wf/4, membership_avl_set_wf/4, |
| 60 | | quick_test_avl_membership/3, |
| 61 | | |
| 62 | | is_efficient_custom_set/1, |
| 63 | | remove_minimum_element_custom_set/3, |
| 64 | | |
| 65 | | is_maximal_global_set/1, quick_is_definitely_maximal_set/1, |
| 66 | | quick_definitely_maximal_set_avl/1, |
| 67 | | is_one_element_custom_set/2, singleton_set/2, construct_singleton_avl_set/2, |
| 68 | | is_one_element_avl/2, |
| 69 | | construct_one_element_custom_set/2, |
| 70 | | avl_is_interval/3, |
| 71 | | |
| 72 | | %closure0_for_explicit_set/2, |
| 73 | | closure1_for_explicit_set/2, closure1_for_explicit_set_from/3, |
| 74 | | check_in_domain_of_avlset/2, check_unique_in_domain_of_avlset/2, |
| 75 | | domain_of_explicit_set_wf/3, range_of_explicit_set_wf/3, |
| 76 | | is_avl_partial_function/1, is_not_avl_partial_function/2, |
| 77 | | is_avl_total_function_over_domain/2, |
| 78 | | quick_definitely_maximal_total_function_avl/1, |
| 79 | | is_avl_relation/1, |
| 80 | | is_avl_relation_over_domain/3, |
| 81 | | is_avl_relation_over_range/3, |
| 82 | | is_not_avl_relation_over_domain_range/4, is_not_avl_relation_over_range/3, |
| 83 | | is_avl_sequence/1, |
| 84 | | get_avl_sequence/2, |
| 85 | | is_injective_avl_relation/2, |
| 86 | | invert_explicit_set/2, union_of_explicit_set/3, |
| 87 | | union_generalized_explicit_set/3, |
| 88 | | difference_of_explicit_set_wf/4, |
| 89 | | intersection_of_explicit_set_wf/4, intersection_with_interval_closure/3, |
| 90 | | disjoint_intervals_with_inf/4, |
| 91 | | image_for_id_closure/3, image_for_explicit_set/4, |
| 92 | | rel_composition_for_explicit_set/3, |
| 93 | | element_can_be_added_or_removed_to_avl/1, |
| 94 | | add_element_to_explicit_set_wf/4, remove_element_from_explicit_set/3, |
| 95 | | delete_element_from_explicit_set/3, |
| 96 | | at_most_one_match_possible/3, |
| 97 | | apply_to_avl_set/5, try_apply_to_avl_set/3, |
| 98 | | min_of_explicit_set_wf/3, max_of_explicit_set_wf/3, |
| 99 | | sum_or_mul_of_explicit_set/3, |
| 100 | | %sum_of_range_custom_explicit_set/2, mul_of_range_custom_explicit_set/2, |
| 101 | | domain_restriction_explicit_set_wf/4, |
| 102 | | range_restriction_explicit_set_wf/4, |
| 103 | | domain_subtraction_explicit_set_wf/4, |
| 104 | | range_subtraction_explicit_set_wf/4, |
| 105 | | override_pair_explicit_set/4, |
| 106 | | direct_product_explicit_set/3, |
| 107 | | override_custom_explicit_set_wf/4, |
| 108 | | symbolic_functionality_check_closure/2, symbolic_injectivity_check_closure/2, |
| 109 | | |
| 110 | | subset_of_explicit_set/4, not_subset_of_explicit_set/4, |
| 111 | | test_subset_of_explicit_set/5, |
| 112 | | |
| 113 | | conc_custom_explicit_set/2, |
| 114 | | prefix_of_custom_explicit_set/4, suffix_of_custom_explicit_set/4, |
| 115 | | concat_custom_explicit_set/4, prepend_custom_explicit_set/3, |
| 116 | | append_custom_explicit_set/4, |
| 117 | | tail_sequence_custom_explicit_set/5, |
| 118 | | last_sequence_explicit_set/2, %first_sequence_explicit_set/2, |
| 119 | | front_sequence_custom_explicit_set/3, |
| 120 | | reverse_custom_explicit_set/2, |
| 121 | | size_of_custom_explicit_set/3, |
| 122 | | |
| 123 | | get_first_avl_elements/4, |
| 124 | | construct_avl_from_lists/2, construct_avl_from_lists_wf/3, |
| 125 | | equal_avl_tree/2, |
| 126 | | check_avl_in_interval/3, check_interval_in_custom_set/4, |
| 127 | | check_avl_subset/2, |
| 128 | | construct_closure/4, is_closure/4, % from closures |
| 129 | | construct_member_closure/5, % from closures |
| 130 | | |
| 131 | | construct_interval_closure/3, |
| 132 | | is_interval_closure/3, % checks if we have a finite interval closure Low..Up (but bounds can be variables) |
| 133 | | is_interval_closure/5, |
| 134 | | is_interval_closure_or_integerset/3, |
| 135 | | is_interval_with_integer_bounds/3, % checks that bounds are known |
| 136 | | |
| 137 | | is_powerset_closure/3, |
| 138 | | |
| 139 | | dom_range_for_specific_closure/5, |
| 140 | | dom_for_specific_closure/4, |
| 141 | | dom_for_lambda_closure/2, |
| 142 | | portray_custom_explicit_set/1, |
| 143 | | closure_occurs_check/4 |
| 144 | | ]). |
| 145 | | |
| 146 | | :- meta_predicate call_card_for_relations(-,-,0). |
| 147 | | |
| 148 | | :- use_module(error_manager). |
| 149 | | :- use_module(self_check). |
| 150 | | :- use_module(library(avl)). |
| 151 | | :- use_module(kernel_waitflags). |
| 152 | | :- use_module(kernel_tools). |
| 153 | | :- use_module(delay). |
| 154 | | :- use_module(tools). |
| 155 | | :- use_module(avl_tools). |
| 156 | | :- use_module(library(clpfd)). |
| 157 | | |
| 158 | | :- use_module(module_information,[module_info/2]). |
| 159 | | :- module_info(group,kernel). |
| 160 | | :- module_info(description,'This module provides customised operations for the custom explicit set representations of ProB (closures, avl_sets and global_sets).'). |
| 161 | | |
| 162 | | :- use_module(tools_printing,[print_term_summary/1, print_error/1]). |
| 163 | | :- use_module(preferences,[preference/2]). |
| 164 | | :- use_module(kernel_objects,[equal_object/2, equal_object/3]). |
| 165 | | :- use_module(kernel_freetypes,[enumerate_freetype_wf/4,freetype_cardinality/2, |
| 166 | | is_infinite_freetype/1, is_empty_freetype/1, |
| 167 | | is_non_empty_freetype/1, test_empty_freetype/2]). |
| 168 | | |
| 169 | | :- use_module(clpfd_interface,[try_post_constraint/1, clpfd_reify_inlist/4]). |
| 170 | | :- use_module(closures). |
| 171 | | :- use_module(b_compiler). |
| 172 | | |
| 173 | | :- load_files(library(system), [when(compile_time), imports([environ/2])]). |
| 174 | | |
| 175 | | /* These meta_predicate declarations do not seem to have the right effect; |
| 176 | | the predicates below return code, they do not get passed code |
| 177 | | :- meta_predicate card_for_specific_custom_set(*,*,0). |
| 178 | | :- meta_predicate card_for_specific_closure(*,*,0). |
| 179 | | :- meta_predicate is_a_relation(*,*,*,*,*,*,0). |
| 180 | | :- meta_predicate subset_of_explicit_set(*,*,0,*). |
| 181 | | :- meta_predicate not_subset_of_explicit_set(*,*,0,*). |
| 182 | | */ |
| 183 | | |
| 184 | | construct_avl_from_lists(S,Res) :- |
| 185 | | (convert_to_avl(S,CS) -> true ; print(convert_to_avl_failed(S,CS)),nl,CS=S), |
| 186 | | Res = CS. |
| 187 | | |
| 188 | | % version with WF to see call stack in case of virtual time-outs due to expansions |
| 189 | | construct_avl_from_lists_wf(S,Res,WF) :- |
| 190 | | (convert_to_avl_wf(S,CS,WF) -> true ; print(convert_to_avl_wf_failed(S,CS)),nl,CS=S), |
| 191 | | Res = CS. |
| 192 | | |
| 193 | | :- use_module(tools,[safe_sort/3]). |
| 194 | | :- block normalised_list_to_avl_when_ground(-,?). |
| 195 | | normalised_list_to_avl_when_ground(S,R) :- % call if you are not sure that S will be ground; e.g. after closure expansion |
| 196 | | ground_value_check(S,GS), |
| 197 | | blocking_normalised_list_to_avl(GS,S,R). |
| 198 | | :- block blocking_normalised_list_to_avl(-,?,?). |
| 199 | | blocking_normalised_list_to_avl(_,S,R) :- normalised_list_to_avl(S,R). |
| 200 | | |
| 201 | | normalised_list_to_avl(S,R) :- safe_sort(normalised_list_to_avl,S,SS), |
| 202 | | ord_list_to_avlset_direct(SS,AVL,normalised_list_to_avl), |
| 203 | | equal_object(AVL,R). % due to co-routine, R can now be instantiated |
| 204 | | |
| 205 | | %set_to_avl(List,R) :- empty_avl(A), add_to_avl(List,A,AR), R=avl_set(AR). |
| 206 | | add_to_avl([],R,R). |
| 207 | | add_to_avl([H|T],AVL,AVLOUT) :- avl_store(H,AVL,true,AVL1), |
| 208 | | add_to_avl(T,AVL1,AVLOUT). |
| 209 | | |
| 210 | | |
| 211 | | % get only the first x elements of an AVL tree |
| 212 | | get_first_avl_elements(empty,_,R,all) :- !,R=[]. |
| 213 | | get_first_avl_elements(AVL,X,FirstXEls,CutOff) :- |
| 214 | | avl_min(AVL,Min), get_first_els(X,Min,AVL,FirstXEls,CutOff). |
| 215 | | |
| 216 | | get_first_els(X,_,_AVL,R,CutOff) :- X<1,!,R=[], CutOff=not_all. |
| 217 | | get_first_els(X,Cur,AVL,[Cur|T],CutOff) :- |
| 218 | | (avl_next(Cur,AVL,Nxt) -> X1 is X-1,get_first_els(X1,Nxt,AVL,T,CutOff) |
| 219 | | ; T=[],CutOff=all). |
| 220 | | |
| 221 | | %expand_and_try_convert_to_avl(C,R) :- is_closure(C,_,_,_), expand_custom_set(C,EC), expand_and_convert_to_avl |
| 222 | | %expand_and_convert_to_avl(C,R) :- convert_to_avl(C,R). |
| 223 | | |
| 224 | | /* convert all list data-values (with all-sub-values) into avl-form */ |
| 225 | | /* assumption: the value is ground when convert_to_avl is called */ |
| 226 | | |
| 227 | | :- load_files(library(system), [when(compile_time), imports([environ/2])]). |
| 228 | | :- if(environ(prob_safe_mode,true)). |
| 229 | | convert_to_avl(X,R) :- \+ ground_value(X), !, add_error(convert_to_avl,'Non-ground argument: ',convert_to_avl(X,R)), R=X. |
| 230 | | :- endif. |
| 231 | | convert_to_avl(X,R) :- var(X), !, add_error(convert_to_avl,'Variable argument: ',convert_to_avl(X,R)), R=X. |
| 232 | ? | convert_to_avl(Term,R) :- no_conversion_necessary(Term),!, |
| 233 | | R=Term. |
| 234 | | convert_to_avl(closure(P,T,B),R) :- !, |
| 235 | | R=closure(P,T,B). |
| 236 | | convert_to_avl(avl_set(A),R) :- !,(A==empty -> add_warning(convert_to_avl,'Emtpy avl_set'), R=[] |
| 237 | | ; R=avl_set(A)). |
| 238 | | convert_to_avl((A,B),(CA,CB)) :- !,convert_to_avl(A,CA), convert_to_avl(B,CB). |
| 239 | | convert_to_avl(freetype(X),R) :- !, R=freetype(X). |
| 240 | | convert_to_avl(freeval(ID,Case,Value),R) :- !, R=freeval(ID,Case,CValue),convert_to_avl(Value,CValue). |
| 241 | | convert_to_avl(rec(Fields),R) :- !, convert_fields(Fields,CFields), R=rec(CFields). |
| 242 | | convert_to_avl(global_set(GS),R) :- !, R=global_set(GS). |
| 243 | | convert_to_avl([H|T],R) :- !, convert_cons_to_avl_inside_set_wf(H,T,R,no_wf_available). |
| 244 | | %convert_to_avl(abort(X),_R) :- print(deprecetated_convert_to_avl(abort(X))),nl,!, fail. |
| 245 | | convert_to_avl(X,R) :- add_internal_error('Unknown term: ',convert_to_avl(X,R)), R=X. |
| 246 | | |
| 247 | | % pass WF for call stack in case of expansions TODO: complete |
| 248 | | convert_to_avl_wf((A,B),(CA,CB),WF) :- !,convert_to_avl_wf(A,CA,WF), convert_to_avl_wf(B,CB,WF). |
| 249 | | convert_to_avl_wf([H|T],R,WF) :- !, convert_cons_to_avl_inside_set_wf(H,T,R,WF). |
| 250 | | convert_to_avl_wf(X,R,_) :- convert_to_avl(X,R). |
| 251 | | |
| 252 | | convert_fields(Var,R) :- var(Var),!, |
| 253 | | add_internal_error('Var arg: ',convert_fields(Var,R)),fail. |
| 254 | | convert_fields([],[]). |
| 255 | | convert_fields([field(FieldName,Value)|T],[field(FieldName,CValue)|CT]) :- |
| 256 | | convert_to_avl_inside_set(Value,CValue), |
| 257 | | convert_fields(T,CT). |
| 258 | | |
| 259 | | l_convert_to_avl_wf(Var,_,WF) :- var(Var),!, |
| 260 | | add_warning_wf(l_convert_to_avl_wf,'Cannot expand variable to avl: ',Var,unknown,WF), |
| 261 | | fail. |
| 262 | | l_convert_to_avl_wf([],[],_). |
| 263 | | l_convert_to_avl_wf(avl_set(A),R,WF) :- |
| 264 | | expand_custom_set_wf(avl_set(A),ES,l_convert_to_avl,WF), |
| 265 | | l_convert_to_avl_wf(ES,R,WF). |
| 266 | | l_convert_to_avl_wf(closure(P,T,B),R,WF) :- |
| 267 | | expand_custom_set_wf(closure(P,T,B),ES,l_convert_to_avl,WF), |
| 268 | | l_convert_to_avl_wf(ES,R,WF). |
| 269 | | l_convert_to_avl_wf([H|T],[CH-true|CT],WF) :- |
| 270 | | convert_to_avl_inside_set_wf(H,CH,WF), l_convert_to_avl_wf(T,CT,WF). |
| 271 | | |
| 272 | | :- assert_must_succeed((X=(fd(1,'Name'),fd(2,'Name')), |
| 273 | | custom_explicit_sets:convert_to_avl_inside_set(X,R), R==X)). |
| 274 | | |
| 275 | | convert_to_avl_inside_set(Var,R) :- var(Var),!, |
| 276 | | add_internal_error('Var arg: ',convert_to_avl_inside_set(Var,R)),fail. |
| 277 | | :- if(environ(prob_safe_mode,true)). |
| 278 | | convert_to_avl_inside_set(fd(A,T),R) :- var(A),!, |
| 279 | | add_error(convert_to_avl,'Non-ground FD-Term: ',convert_to_avl_inside_set(fd(A,T),R)), R=fd(A,T). |
| 280 | | convert_to_avl_inside_set(int(X),R) :- var(X),!, |
| 281 | | add_error(convert_to_avl,'Non-ground integer: ',convert_to_avl_inside_set(int(X),R)), R=int(X). |
| 282 | | convert_to_avl_inside_set(string(X),R) :- var(X),!, |
| 283 | | add_error(convert_to_avl,'Non-ground string: ',convert_to_avl_inside_set(string(X),R)), R=string(X). |
| 284 | | convert_to_avl_inside_set(term(X),R) :- (var(X) ; X=floating(F), var(F)), !, |
| 285 | | add_error(convert_to_avl,'Non-ground term: ',convert_to_avl_inside_set(term(X),R)), R=term(X). |
| 286 | | :- endif. |
| 287 | ? | convert_to_avl_inside_set(Term,R) :- no_conversion_necessary(Term),!,R=Term. |
| 288 | | convert_to_avl_inside_set(closure(P,T,B),R) :- !, |
| 289 | | % inside a set, closures need to be expanded to check against other elements |
| 290 | | expand_closure_to_avl_wf(P,T,B,R,no_wf_available). |
| 291 | | %convert_to_avl_inside_set(closure_x(_P,_T,_B,E),R) :- !, convert_to_avl_inside_set(E,R). |
| 292 | | convert_to_avl_inside_set(avl_set(A),R) :- !, normalise_avl_set(A,R). %AVL's inside other AVL's need to be normalised ! |
| 293 | | convert_to_avl_inside_set((A,B),(CA,CB)) :- !,convert_to_avl_inside_set(A,CA), convert_to_avl_inside_set(B,CB). |
| 294 | | convert_to_avl_inside_set(freetype(X),R) :- !, |
| 295 | | expand_custom_set(freetype(X),EC,check), convert_to_avl_inside_set(EC,R). |
| 296 | | convert_to_avl_inside_set(freeval(ID,Case,Value),R) :- !, |
| 297 | | R=freeval(ID,Case,CValue),convert_to_avl_inside_set(Value,CValue). |
| 298 | | convert_to_avl_inside_set(rec(Fields),R) :- !, convert_fields(Fields,CFields), R=rec(CFields). |
| 299 | | convert_to_avl_inside_set(global_set(GS),R) :- !, |
| 300 | | % first check if GS infinite integer set: in this case do not expand; there can be no confusion with finite avl_sets |
| 301 | | (is_infinite_global_set(GS,_) -> R = global_set(GS) |
| 302 | | ; expand_only_custom_closure_global(global_set(GS),EC,check,no_wf_available), convert_to_avl_inside_set(EC,R)). |
| 303 | | convert_to_avl_inside_set([H|T],R) :- !,convert_cons_to_avl_inside_set_wf(H,T,R,no_wf_available). |
| 304 | | convert_to_avl_inside_set(X,R) :- |
| 305 | | add_internal_error('Unknown or non-ground argument: ',convert_to_avl_inside_set(X,R)), |
| 306 | | fail. |
| 307 | | |
| 308 | ? | convert_to_avl_inside_set_wf(Term,R,_WF) :- no_conversion_necessary(Term),!,R=Term. |
| 309 | | convert_to_avl_inside_set_wf(closure(P,T,B),R,WF) :- !, |
| 310 | | expand_closure_to_avl_wf(P,T,B,R,WF). % inside a set, closures need to be expanded to check against other elements |
| 311 | | convert_to_avl_inside_set_wf((A,B),(CA,CB),WF) :- !, |
| 312 | | convert_to_avl_inside_set_wf(A,CA,WF), convert_to_avl_inside_set_wf(B,CB,WF). |
| 313 | | convert_to_avl_inside_set_wf([H|T],R,WF) :- !,convert_cons_to_avl_inside_set_wf(H,T,R,WF). |
| 314 | | convert_to_avl_inside_set_wf(V,CV,_WF) :- % use version without WF; TO DO: adapt fully |
| 315 | | convert_to_avl_inside_set(V,CV). |
| 316 | | |
| 317 | | % true when we have a simple value that does not need to be converted for use within an avl_set: |
| 318 | | no_conversion_necessary([]). |
| 319 | | no_conversion_necessary(pred_false). /* bool_false */ |
| 320 | | no_conversion_necessary(pred_true). /* bool_true */ |
| 321 | | no_conversion_necessary(fd(FD,_)) :- nonvar(FD). |
| 322 | | no_conversion_necessary(int(I)) :- nonvar(I). |
| 323 | | no_conversion_necessary(string(S)) :- nonvar(S). |
| 324 | ? | no_conversion_necessary(term(T)) :- nonvar(T), no_conversion_nec_term(T). |
| 325 | | |
| 326 | | no_conversion_nec_term(floating(T)) :- nonvar(T). |
| 327 | | no_conversion_nec_term(T) :- atom(T). |
| 328 | | |
| 329 | | normalise_avl_set(A,R) :- A=node(_,_,0,empty,empty), !,R=avl_set(A). |
| 330 | | normalise_avl_set(A,R) :- |
| 331 | | avl_to_list(A,L), |
| 332 | | ord_list_to_avlset_direct(L,R,convert_to_avl_inside_set). %AVL's inside other AVL's need to be normalised ! |
| 333 | | |
| 334 | | convert_cons_to_avl_inside_set_wf(H,T,R,WF) :- T==[], !, |
| 335 | | convert_to_avl_inside_set_wf(H,CH,WF), |
| 336 | | R = avl_set(node(CH,true,0,empty,empty)). |
| 337 | | convert_cons_to_avl_inside_set_wf(H,T,R,WF) :- l_convert_to_avl_wf([H|T],S,WF), |
| 338 | | sort(S,SS), |
| 339 | | ord_list_to_avlset_direct(SS,R,convert_to_avl_inside_set). |
| 340 | | |
| 341 | | construct_singleton_avl_set(Val,avl_set(node(Val,true,0,empty,empty))). |
| 342 | | |
| 343 | | |
| 344 | | is_set_value(X,Origin) :- var(X), !,print(is_set_value(Origin)),nl,fail. |
| 345 | | is_set_value([],_) :- !. |
| 346 | | is_set_value([_|_],_) :- !. |
| 347 | | is_set_value(X,_) :- is_custom_explicit_set(X). |
| 348 | | |
| 349 | | is_custom_explicit_set(X,Origin) :- var(X), !,print(var_is_custom_explicit_set(Origin)),nl,fail. |
| 350 | | is_custom_explicit_set(X,_) :- is_custom_explicit_set(X). |
| 351 | | |
| 352 | | is_custom_explicit_set(X) :- var(X), !,print(var_is_custom_explicit_set),nl,fail. |
| 353 | | is_custom_explicit_set(global_set(_)). |
| 354 | | is_custom_explicit_set(freetype(_)). |
| 355 | | %is_custom_explicit_set(integer_global_set(_)). |
| 356 | | is_custom_explicit_set(avl_set(_)). |
| 357 | | is_custom_explicit_set(closure(_Parameters,_PT,_Cond)). |
| 358 | | |
| 359 | | % use if you know the argument to be nonvar |
| 360 | | is_custom_explicit_set_nonvar(global_set(_)). |
| 361 | | is_custom_explicit_set_nonvar(freetype(_)). |
| 362 | | is_custom_explicit_set_nonvar(avl_set(_)). |
| 363 | | is_custom_explicit_set_nonvar(closure(_Parameters,_PT,_Cond)). |
| 364 | | |
| 365 | | %:- assert_must_succeed(( custom_explicit_sets:portray_custom_explicit_set(avl_set(empty)) )). % now generates error |
| 366 | | :- use_module(translate,[translate_bvalue/2]). |
| 367 | | portray_custom_explicit_set(S) :- translate_bvalue(S,A), format(A,[]),nl. |
| 368 | | |
| 369 | | /* a predicate to check equality of two custom explicit sets */ |
| 370 | | |
| 371 | | %equal_explicit_sets(A,B) :- equal_explicit_sets_wf(A,B,no_wf_available). |
| 372 | | |
| 373 | | %equal_explicit_sets(X,Y) :- print_term_summary(equal_explicit_sets(X,Y)),fail. |
| 374 | | :- block equal_explicit_sets_wf(-,?,?), equal_explicit_sets_wf(?,-,?). |
| 375 | ? | equal_explicit_sets_wf(A,B,WF) :- equal_explicit_sets4(A,B,allow_expansion,WF). |
| 376 | | |
| 377 | | equal_explicit_sets4(global_set(X),global_set(Y),_,_WF) :- !,X=Y. |
| 378 | | equal_explicit_sets4(global_set(B),avl_set(A),E,WF) :- !,equal_explicit_sets4(avl_set(A),global_set(B),E,WF). |
| 379 | | equal_explicit_sets4(freetype(X),freetype(Y),_,_WF) :- !,X=Y. |
| 380 | | equal_explicit_sets4(avl_set(A),avl_set(B),_,_WF) :- !, |
| 381 | | equal_avl_tree(A,B). % alternatively, we could normalise avl_trees and only store normalised versions |
| 382 | | equal_explicit_sets4(avl_set(A),I2,_,_WF) :- |
| 383 | | is_interval_closure_or_integerset(I2,L2,U2),!, % also covers I2=global_set(...) |
| 384 | | avl_equal_to_interval(A,L2,U2). |
| 385 | | equal_explicit_sets4(avl_set(A),global_set(B),_,WF) :- \+ b_global_sets:b_integer_set(B), !, % integersets dealt with above |
| 386 | | explicit_set_cardinality_wf(global_set(B),Card,WF), |
| 387 | | is_finite_card(Card), % Card \= inf as avl_set must be finite |
| 388 | | explicit_set_cardinality_wf(avl_set(A),Card,WF). /* the sets must be identical as global_set contains all values */ |
| 389 | | equal_explicit_sets4(avl_set(A),CPB,_,WF) :- |
| 390 | | is_cartesian_product_closure(CPB,B1,B2),!, |
| 391 | | decompose_avl_set_into_cartesian_product_wf(A,A1,A2,WF), |
| 392 | | kernel_objects:equal_object_wf(A1,B1,equal_explicit_sets4,WF), |
| 393 | | kernel_objects:equal_object_wf(A2,B2,equal_explicit_sets4,WF). |
| 394 | ? | equal_explicit_sets4(closure(P,T,B),avl_set(A),E,WF) :- !, equal_explicit_sets4(avl_set(A),closure(P,T,B),E,WF). |
| 395 | | equal_explicit_sets4(I1,I2,_,_WF) :- is_interval_closure_or_integerset(I1,L1,U1), |
| 396 | | is_interval_closure_or_integerset(I2,L2,U2), !, |
| 397 | | L1=L2, U1=U2. |
| 398 | | equal_explicit_sets4(CPA,CPB,_,WF) :- |
| 399 | ? | is_cartesian_product_closure(CPA,A1,A2), |
| 400 | | is_cartesian_product_closure(CPB,B1,B2),!, |
| 401 | | equal_cartesian_product_wf(A1,A2,B1,B2,WF). |
| 402 | | % what if both subset or relations or functions ... closure: TO DO: add support |
| 403 | | equal_explicit_sets4(S1,S2,_,WF) :- |
| 404 | | is_not_member_value_closure_or_integerset(S1,TYPE,MS1), |
| 405 | | is_not_member_value_closure_or_integerset(S2,TYPE,MS2), |
| 406 | | !, |
| 407 | | kernel_objects:equal_object_wf(MS1,MS2,equal_explicit_sets4,WF). |
| 408 | | equal_explicit_sets4(closure(P1,T1,B1),closure(P2,T2,B2),_,_WF) :- |
| 409 | | same_closure_body(P1,T1,B1,P2,T2,B2),!. |
| 410 | | %equal_explicit_sets4(X,Y) :- X==Y,!. |
| 411 | | equal_explicit_sets4(Set1,Set2,allow_expansion,WF) :- |
| 412 | | %kernel_objects:test_finite_set_wf(Set1,F1,WF), kernel_objects:test_finite_set_wf(Set2,F2,WF), equal_expansions(F1,F2,Set1,Set2) |
| 413 | | card_for_specific_custom_set(Set1,Card1,Code1), % TO DO: do not throw info away if Set2 cannot be determined |
| 414 | | card_for_specific_custom_set(Set2,Card2,Code2), |
| 415 | | !, |
| 416 | ? | call(Code1), call(Code2), |
| 417 | | % TO DO: if one of the two sets is infinite, then it would be enough to know that the other is not infinite for failure without expansion |
| 418 | | equal_expansions(Card1,Card2,Set1,Set2,WF). |
| 419 | | equal_explicit_sets4(Set1,Set2,allow_expansion,WF) :- equal_expansions(0,0,Set1,Set2,WF). |
| 420 | | |
| 421 | | |
| 422 | | :- use_module(btypechecker, [unify_types_strict/2]). |
| 423 | | % detect e.g. when one closure has seq(Type) and the other one set(integer,Type) |
| 424 | | same_types([],[]). |
| 425 | | same_types([H1|T1],[H2|T2]) :- unify_types_strict(H1,H2), same_types(T1,T2). |
| 426 | | |
| 427 | | :- block equal_expansions(-,?,?,?,?). |
| 428 | | equal_expansions(F1,F2,Set1,Set2,WF) :- (number(F1);number(F2)),!, |
| 429 | | % NOTE: sometimes we get inf for finite but very large sets |
| 430 | | F1=F2, % unify; can propagate info back to closure; e.g. prj2(BOOL,NAT) = prj2(BOOL,0..n) |
| 431 | | equal_expansions2(F1,F2,Set1,Set2,WF). |
| 432 | | equal_expansions(F1,F2,Set1,Set2,WF) :- |
| 433 | | equal_expansions2(F1,F2,Set1,Set2,WF). |
| 434 | | |
| 435 | | :- block equal_expansions2(-,?,?,?,?), equal_expansions2(?,-,?,?,?). |
| 436 | | %equal_expansions(0,0,avl_set(A),closure(P,T,B)) :- check_subset ?? in both directions ? |
| 437 | | %equal_expansions2(inf,inf,Set1,Set2,WF) :- WF \= no_wf_available, !, % symbolic treatment |
| 438 | | equal_expansions2(F,F,Set1,Set2,WF) :- |
| 439 | | % only expand if both sets have same cardinality |
| 440 | | % print_term_summary(equal_expansions3(F,Set1,Set2)),nl, |
| 441 | | equal_expansions3(F,Set1,Set2,WF). |
| 442 | | |
| 443 | | % TO DO: check if this brings something: |
| 444 | | %equal_expansions3(avl_set(A),closure(P,T,B),_WF) :- !, |
| 445 | | % expand_closure_to_avl_or_list(P,T,B,E2,check), % in case E2 is avl_set; we can use equal_avl_tree |
| 446 | | % ((nonvar(E2),E2=avl_set(B2)) |
| 447 | | % -> print(eql_avl),nl, print_term_summary(equal_avl_tree(A,B2)),nl, equal_avl_tree(A,B2) |
| 448 | | % ; print(eql_non_avl),nl,equal_object(avl_set(A),E2,equal_expansions3) |
| 449 | | % ). |
| 450 | | %:- use_module(library(lists),[perm2/4]). |
| 451 | | %equal_expansions3(F,Set1,Set2,_WF) :- number(F), F>100, % test with: {{},{TRUE},{FALSE},{TRUE,FALSE}} = /*@symbolic */ {x|x<:BOOL} or |
| 452 | | % {x|x<:POW(BOOL*BOOL) & (x={} or card(x)>0)} = /*@symbolic */ {x|x<:POW(BOOL*BOOL)} 26 sec -> 14 sec |
| 453 | | % case does not seem to appear very often |
| 454 | | % perm2(Set1,Set2,avl_set(_),Set), |
| 455 | | % is_definitely_maximal_set(Set), |
| 456 | | %Set2 is maximal and has the same cardinality as F, hence Set1 must be identical to Set2 |
| 457 | | % !, |
| 458 | | % debug_println(9,equal_to_maximal_closure(F)). |
| 459 | | equal_expansions3(F,Set1,Set2,WF) :- |
| 460 | ? | get_identity_as_equivalence(F,Set1,Set2,EQUIV), |
| 461 | | !, |
| 462 | | b_test_boolean_expression(EQUIV,[],[],WF). |
| 463 | | % Alternative could be, if difference were to be fully treated symbolically: |
| 464 | | % difference_of_explicit_set_wf(Set1,Set2,R12,WF), difference_of_explicit_set_wf(Set2,Set1,R21,WF), |
| 465 | | % kernel_objects:empty_set_wf(R12,WF), kernel_objects:empty_set_wf(R21,WF). |
| 466 | | equal_expansions3(_,Set1,Set2,WF) :- |
| 467 | | expand_custom_set_wf(Set1,E1,equal_expansions1,WF), |
| 468 | | expand_custom_set_wf(Set2,E2,equal_expansions2,WF), |
| 469 | | E1=E2. /* ensure that ordering and normalization is same for all representations ! */ |
| 470 | | |
| 471 | | |
| 472 | | get_identity_as_equivalence(F,Set1,Set2,EQUIV) :- |
| 473 | | (F=inf %; is_infinite_explicit_set(Set1) ; is_infinite_explicit_set(Set2) |
| 474 | | ; Set1 \= avl_set(_),Set2 \= avl_set(_), % if one of the two sets is an AVL Set: better compute the other set explicitly instead of using this symbolic treatment |
| 475 | ? | (dont_expand_this_explicit_set(Set1,100000) ; |
| 476 | ? | dont_expand_this_explicit_set(Set2,100000) |
| 477 | | ) |
| 478 | | % avl_test check for test 1081; TO DO: instead of test try to expand set and if this leads to enum warning use symbolic check |
| 479 | | ), |
| 480 | | get_identity_as_equivalence_aux(Set1,Set2,EQUIV). |
| 481 | | get_identity_as_equivalence_aux(Set1,Set2,EQUIV) :- |
| 482 | | kernel_objects:infer_value_type(Set1,SType), |
| 483 | | is_set_type(SType,Type), |
| 484 | | % Construct: !x.(x:Set1 <=> x:Set2) ?? |
| 485 | | get_pos_infos_for_explicit_set(Set1,I1), |
| 486 | | get_pos_infos_for_explicit_set(Set2,I2), |
| 487 | | I12 = I1, % we could merge position_info; but two sets could be very far apart |
| 488 | | TID = b(identifier('_equality_sets_'),Type,[]), |
| 489 | | EQUIV = b(forall([TID],b(truth,pred,[used_ids([])]), |
| 490 | | b(equivalence( |
| 491 | | b(member(TID,b(value(Set1),SType,I1)),pred,I1), |
| 492 | | b(member(TID,b(value(Set2),SType,I2)),pred,I2) |
| 493 | | ) ,pred,I12) |
| 494 | | ),pred,[used_ids([]),I12]). |
| 495 | | |
| 496 | | :- use_module(bsyntaxtree, [get_texpr_pos/2]). |
| 497 | | get_pos_infos_for_explicit_set(closure(_,_,Body),[Pos]) :- get_texpr_pos(Body,Pos),!. |
| 498 | | get_pos_infos_for_explicit_set(_,[]). |
| 499 | | |
| 500 | | :- use_module(kernel_equality,[eq_atomic/4, equality_objects/3, |
| 501 | | equality_objects_wf_no_enum/4, equality_objects_with_type_wf/5]). |
| 502 | | /* maybe rewrite equal_explicit_sets and not_... to use this to avoid maintaining multiple versions */ |
| 503 | | equality_explicit_sets_wf(global_set(X),global_set(Y),R,_WF) :- !, eq_atomic(X,Y,set,R). |
| 504 | | equality_explicit_sets_wf(global_set(B),avl_set(A),R,WF) :- !,equality_explicit_sets_wf(avl_set(A),global_set(B),R,WF). |
| 505 | | equality_explicit_sets_wf(freetype(X),freetype(Y),R,_) :- !, eq_atomic(X,Y,set,R). |
| 506 | | equality_explicit_sets_wf(avl_set(A),avl_set(B),R,_) :- !, |
| 507 | | (equal_avl_tree(A,B) -> R=pred_true ; R=pred_false). % alternatively, we could normalise avl_trees and only store normalised versions |
| 508 | | equality_explicit_sets_wf(avl_set(A),I2,R,WF) :- is_interval_closure_or_integerset(I2,L2,U2),!, % also covers I2=global_set(...) |
| 509 | | avl_equality_to_interval(A,L2,U2,R,WF). |
| 510 | | equality_explicit_sets_wf(avl_set(A),global_set(B),R,WF) :- \+ b_global_sets:b_integer_set(B), !, |
| 511 | | explicit_set_cardinality_wf(global_set(B),Card,WF), |
| 512 | | (is_finite_card(Card), % Card \= inf, %as avl_set must be finite |
| 513 | | explicit_set_cardinality_wf(avl_set(A),Card,WF) |
| 514 | | -> R=pred_true /* the sets must be identical as global_set contains all values */ |
| 515 | | ; R=pred_false). |
| 516 | | equality_explicit_sets_wf(avl_set(A),CPB,R,WF) :- |
| 517 | | is_cartesian_product_closure(CPB,B1,B2),!, |
| 518 | | if(decompose_avl_set_into_cartesian_product_wf(A,A1,A2,WF), % should not produce pending co-routines |
| 519 | | equality_cartesian_product_wf(A1,A2,B1,B2,R,WF), |
| 520 | | R=pred_false % no cartesian product can be equal to this avl_set |
| 521 | | ). |
| 522 | | equality_explicit_sets_wf(closure(P,T,B),avl_set(A),R,WF) :- !, |
| 523 | | equality_explicit_sets_wf(avl_set(A),closure(P,T,B),R,WF). |
| 524 | | equality_explicit_sets_wf(I1,I2,R,WF) :- is_interval_closure_or_integerset(I1,L1,U1), |
| 525 | | is_interval_closure_or_integerset(I2,L2,U2), !, |
| 526 | | equality_objects_wf_no_enum((int(L1),int(U1)),(int(L2),int(U2)),R,WF). |
| 527 | | equality_explicit_sets_wf(CPA,CPB,R,WF) :- |
| 528 | | is_cartesian_product_closure(CPA,A1,A2), is_cartesian_product_closure(CPB,B1,B2),!, |
| 529 | | equality_cartesian_product_wf(A1,A2,B1,B2,R,WF). |
| 530 | | equality_explicit_sets_wf(S1,S2,R,WF) :- |
| 531 | | is_not_member_value_closure_or_integerset(S1,TYPE,MS1), |
| 532 | | is_not_member_value_closure_or_integerset(S2,TYPE,MS2),!, |
| 533 | | equality_objects_with_type_wf(TYPE,MS1,MS2,R,WF). |
| 534 | | equality_explicit_sets_wf(closure(P,T,B),closure(P,T,B2),R,_) :- |
| 535 | | same_texpr_body(B,B2),!,R=pred_true. |
| 536 | | % TO DO: add complement sets |
| 537 | | |
| 538 | | /* Cartesian Product Comparison */ |
| 539 | | :- use_module(kernel_equality,[empty_cartesian_product_wf/4]). |
| 540 | | % A1*A2 = B1*B2 <=> (((A1={} or A2={}) & (B1={} or B2={})) or (A1=B1 & A2=B2)) |
| 541 | | equal_cartesian_product_wf(A1,A2,B1,B2,WF) :- |
| 542 | | equality_cartesian_product_wf(A1,A2,B1,B2,pred_true,WF). |
| 543 | | not_equal_cartesian_product_wf(A1,A2,B1,B2,WF) :- |
| 544 | | equality_cartesian_product_wf(A1,A2,B1,B2,pred_false,WF). |
| 545 | | |
| 546 | | equality_cartesian_product_wf(A1,A2,B1,B2,R,_WF) :- |
| 547 | | nonvar(A1), A1=closure(P,T,BdyA1), |
| 548 | | nonvar(B1), B1=closure(P,T,BdyB1), |
| 549 | | nonvar(A2), A2=closure(P2,T2,BdyA2), |
| 550 | | nonvar(B2), B2=closure(P2,T2,BdyB2), |
| 551 | | % they have the same names; probably we are comparing identical values (e.g., in bvisual2) |
| 552 | | same_texpr_body(BdyA1,BdyB1), |
| 553 | | % note: we cannot simply call equality of A2 and B2 as cartesian products can be empty, see test 2072 |
| 554 | | same_texpr_body(BdyA2,BdyB2), |
| 555 | | !, |
| 556 | | R=pred_true. |
| 557 | | equality_cartesian_product_wf(A1,A2,B1,B2,R,WF) :- |
| 558 | | empty_cartesian_product_wf(A1,A2,EmptyA,WF), |
| 559 | | equality_cart_product2(EmptyA,A1,A2,B1,B2,R,WF). |
| 560 | | :- block equality_cart_product2(-, ?,?,?,?,?,?). |
| 561 | | equality_cart_product2(pred_true,_,_,B1,B2,R,WF) :- empty_cartesian_product_wf(B1,B2,R,WF). |
| 562 | | equality_cart_product2(pred_false,A1,A2,B1,B2,R,WF) :- equality_objects_wf_no_enum((A1,A2),(B1,B2),R,WF). |
| 563 | | |
| 564 | | /* COMPARING AVL-SET with INTERVAL */ |
| 565 | | |
| 566 | | % check if an avl tree is equal to an interval range |
| 567 | | avl_equal_to_interval(_A,L2,U2) :- |
| 568 | | infinite_interval(L2,U2),!,fail. % otherwise infinite & avl_set is finite |
| 569 | | % we can now assume L2, U2 are numbers (but could not yet be instantiated) |
| 570 | | avl_equal_to_interval(A,L2,U2) :- |
| 571 | | avl_min(A,int(L2)), avl_max(A,int(U2)), |
| 572 | | Card is 1+U2-L2, |
| 573 | | explicit_set_cardinality(avl_set(A),Card). % sets are equal: same size + same lower & upper bound |
| 574 | | |
| 575 | | avl_not_equal_to_interval(A,L2,U2,WF) :- avl_equality_to_interval(A,L2,U2,pred_false,WF). |
| 576 | | |
| 577 | | avl_equality_to_interval(_A,L2,U2,R,_WF) :- |
| 578 | | infinite_interval(L2,U2),!,R=pred_false. % interval infinite & avl_set is finite |
| 579 | | % we can now assume L2, U2 are numbers (but could not yet be instantiated) |
| 580 | | avl_equality_to_interval(A,L2,U2,R,WF) :- |
| 581 | | avl_min(A,int(AL)), avl_max(A,int(AU)), |
| 582 | | Card is 1+AU-AL, |
| 583 | | explicit_set_cardinality_wf(avl_set(A),ACard,WF), |
| 584 | | equality_objects_wf_no_enum((int(ACard),(int(AL),int(AU))), |
| 585 | | (int(Card),(int(L2),int(U2))),R,WF). |
| 586 | | % sets are equal if same size + same lower & upper bound |
| 587 | | |
| 588 | | /* COMPARING TWO CLOSURES */ |
| 589 | | |
| 590 | | % a variation of equal_explicit_sets which tries not expand and just compares two closures |
| 591 | | |
| 592 | | same_closure(I1,I2) :- |
| 593 | | is_interval_closure_or_integerset(I1,L1,U1), |
| 594 | | is_interval_closure_or_integerset(I2,L2,U2), !, |
| 595 | | L1=L2, U1=U2. |
| 596 | | same_closure(CPA,CPB) :- |
| 597 | | is_cartesian_product_closure(CPA,A1,A2), |
| 598 | | is_cartesian_product_closure(CPB,B1,B2),!, |
| 599 | | equal_cartesian_product_wf(A1,A2,B1,B2,no_wf_available). % could be expensive |
| 600 | | same_closure(S1,S2) :- |
| 601 | | is_not_member_value_closure_or_integerset(S1,TYPE,MS1), |
| 602 | | is_not_member_value_closure_or_integerset(S2,TYPE,MS2), |
| 603 | | !, |
| 604 | | kernel_objects:equal_object(MS1,MS2,same_closure). % could be expensive |
| 605 | | same_closure(closure(P1,T1,B1),closure(P2,T2,B2)) :- same_closure_body_with_parameter_renaming(P1,T1,B1,P2,T2,B2). |
| 606 | | |
| 607 | | same_closure_body(P,T1, B1, P,T2,B2) :- |
| 608 | | same_types(T1,T2), |
| 609 | | same_texpr_body(B1,B2). |
| 610 | | |
| 611 | | % a version of same_closure_body which allows renaming of the parameters |
| 612 | | same_closure_body_with_parameter_renaming(P1,T1, B1, P2,T2,B2) :- |
| 613 | | same_types(T1,T2), |
| 614 | | create_renaming(P1,P2,Renaming), |
| 615 | | % TO DO: pass Renaming in AVL tree and rename on the fly |
| 616 | | rename_bt(B2,Renaming,RenamedB2), |
| 617 | | same_texpr_body(B1,RenamedB2). |
| 618 | | |
| 619 | | create_renaming([],[],[]). |
| 620 | | create_renaming([ID|T1],[ID|T2],TR) :- !, create_renaming(T1,T2,TR). |
| 621 | | create_renaming([ID1|T1],[ID2|T2],[rename(ID2,ID1)|TR]) :- |
| 622 | | create_renaming(T1,T2,TR). |
| 623 | | |
| 624 | | |
| 625 | | % check if two wrapped expressions are equal (modulo associated Info, e.g. source loc info) |
| 626 | | % and checking inserted values for equality (sometimes storing a closure will convert small inner closures into AVL sets) |
| 627 | | same_texpr_body(E1,E2) :- empty_avl(E),same_texpr_body(E1,E,E2). |
| 628 | | same_texpr_body(b(E1,Type1,_),AVL,b(E2,Type2,_)) :- |
| 629 | | unify_types_strict(Type1,Type2), % check in principle redundant |
| 630 | | same_texpr2(E1,AVL,E2). |
| 631 | | |
| 632 | | :- use_module(bsyntaxtree,[safe_syntaxelement_det/5, is_set_type/2,get_texpr_ids/2, |
| 633 | | get_texpr_expr/2, get_negated_operator_expr/2]). |
| 634 | | same_texpr2(value(V1),AVL,RHS) :- !,same_texpr_value2(RHS,AVL,V1). |
| 635 | | same_texpr2(LHS,AVL,value(V2)) :- !,same_texpr_value2(LHS,AVL,V2). |
| 636 | | same_texpr2(lazy_let_expr(ID,LHS,RHS),AVL,lazy_let_expr(ID2,LHS2,RHS2)) :- !, |
| 637 | | same_texpr_body(LHS,AVL,LHS2), |
| 638 | | avl_store(ID,AVL,ID2,NewAVL), |
| 639 | | same_texpr_body(RHS,NewAVL,RHS2). |
| 640 | | same_texpr2(lazy_let_pred(ID,LHS,RHS),AVL,lazy_let_pred(ID2,LHS2,RHS2)) :- !, |
| 641 | | same_texpr_body(LHS,AVL,LHS2), |
| 642 | | avl_store(ID,AVL,ID2,NewAVL), |
| 643 | | same_texpr_body(RHS,NewAVL,RHS2). |
| 644 | | same_texpr2(lazy_lookup(ID1), AVL,lazy_lookup(ID2)) :- !, avl_fetch(ID1,AVL,ID2). |
| 645 | | same_texpr2(E1,AVL,E2) :- % Should we only enable this for same_closure_body_with_parameter_renaming? |
| 646 | | quantifier_construct(E1,Functor,TParas1,Body1), |
| 647 | | quantifier_construct(E2,Functor,TParas2,Body2), |
| 648 | | !, |
| 649 | | same_quantified_expression(TParas1,Body1,AVL,TParas2,Body2). |
| 650 | | same_texpr2(E1,AVL,E2) :- |
| 651 | | functor(E1,F,Arity), |
| 652 | | functor(E2,F,Arity),!, |
| 653 | | safe_syntaxelement_det(E1,Subs1,_Names1,_List1,Constant1), |
| 654 | | safe_syntaxelement_det(E2,Subs2,_Names2,_List2,Constant2), |
| 655 | | Constant2==Constant1, |
| 656 | | same_sub_expressions(Subs1,AVL,Subs2). |
| 657 | | same_texpr2(E1,AVL,E2) :- same_texpr_with_rewrite(E1,AVL,E2),!. |
| 658 | | same_texpr2(E1,AVL,E2) :- same_texpr_with_rewrite(E2,AVL,E1). |
| 659 | | %same_texpr2(E1,_,E2) :- |
| 660 | | % functor(E1,F1,Arity1), |
| 661 | | % functor(E2,F2,Arity2), print(not_eq(F1,Arity1,F2,Arity2)),nl, print(E1),nl, print(E2),nl,nl,fail. |
| 662 | | % some differences: assertion_expression/3 and function/2, ... |
| 663 | | |
| 664 | | % some rewrite rules from ast_cleanup; but we cannot replicate all rules here |
| 665 | | same_texpr_with_rewrite(negation(TE1),AVL,E2) :- |
| 666 | | get_negated_operator_expr(b(E2,pred,[]),NegE2),!, |
| 667 | | get_texpr_expr(TE1,E1), |
| 668 | | same_texpr2(E1,AVL,NegE2). |
| 669 | | same_texpr_with_rewrite(member(X1,b(value(Set1),_,_)),AVL,equal(X2,b(El2,_,_))) :- |
| 670 | | singleton_set(Set1,El1), !, |
| 671 | | % X : {El} <===> X = El ; required for JSON trace replay of test 1491 |
| 672 | | same_texpr_body(X1,X2), |
| 673 | | same_texpr_value2(El2,AVL,El1). |
| 674 | | same_texpr_with_rewrite(not_member(X1,b(value(Set1),_,_)),AVL,not_equal(X2,b(El2,_,_))) :- |
| 675 | | singleton_set(Set1,El1), !, |
| 676 | | % X /: {El} <===> X /= El ; required for JSON trace replay of test 1491 |
| 677 | | same_texpr_body(X1,X2), |
| 678 | | same_texpr_value2(El2,AVL,El1). |
| 679 | | |
| 680 | | % constructs with local quantified parameters: |
| 681 | | quantifier_construct(comprehension_set(TParas,Body),comprehension_set,TParas,Body). |
| 682 | | quantifier_construct(exists(TParas,Body),exists,TParas,Body). |
| 683 | | quantifier_construct(forall(TParas,LHS,RHS),forall,TParas,Body) :- |
| 684 | | Body = b(implication(LHS,RHS),pred,[]). |
| 685 | | % TODO?: SIGMA, PI, UNION, INTER |
| 686 | | |
| 687 | | :- use_module(bsyntaxtree,[split_names_and_types/3]). |
| 688 | | same_quantified_expression(TParas1,Body1,AVL,TParas2,Body2) :- |
| 689 | | split_names_and_types(TParas1,P1,T1), |
| 690 | | split_names_and_types(TParas2,P2,T2), |
| 691 | | same_types(T1,T2), |
| 692 | | create_renaming(P1,P2,Renaming), |
| 693 | | rename_bt(Body2,Renaming,RenamedB2), % TODO: store renaming in AVL and lookup on the fly |
| 694 | | same_texpr_body(Body1,AVL,RenamedB2). |
| 695 | | |
| 696 | | same_texpr_value2(E2,_,V2) :- var(V2),!,V2==E2. |
| 697 | | same_texpr_value2(interval(Min,Max),_,avl_set(A)) :- !, % occurs in JSON trace replay for test 268 |
| 698 | | avl_equal_to_interval(A,Min,Max). % TODO: also compare the other way around above; only apply if Card not too large? |
| 699 | | same_texpr_value2(value(V2),_,V1) :- !, |
| 700 | | same_value_inside_closure(V1,V2). |
| 701 | | %(same_value_inside_closure(V1,V2) -> true ; print(not_eq_vals(V1,V2)),nl,fail). |
| 702 | | same_texpr_value2(comprehension_set(Paras,B2),AVL,closure(P,_,B1)) :- !, |
| 703 | | get_texpr_ids(Paras,P),!, |
| 704 | | same_texpr_body(B1,AVL,B2). |
| 705 | | same_texpr_value2(cartesian_product(TB1,TB2),AVL,V1) :- |
| 706 | | decompose_value_into_cartesian_product(V1,A1,A2), !, |
| 707 | | %print(cart(A1,A2)),nl, |
| 708 | | get_texpr_expr(TB1,B1), |
| 709 | | same_texpr_value2(B1,AVL,A1), |
| 710 | | get_texpr_expr(TB2,B2), |
| 711 | | same_texpr_value2(B2,AVL,A2). |
| 712 | | same_texpr_value2(StaticExpr,_,int(Nr)) :- number(Nr), |
| 713 | | b_ast_cleanup:pre_compute_static_int_expression(StaticExpr,Nr),!. |
| 714 | | % TO DO: maybe also check if both sides can be evaluated |
| 715 | | % TO DO: move pre_compute_static_int_expression to another module |
| 716 | | same_texpr_value2(E2,AVL,V1) :- rewrite_value(V1,E2,NewE1),!, |
| 717 | | same_texpr2(NewE1,AVL,E2). |
| 718 | | %same_texpr_value2(E1,_,E2) :- |
| 719 | | % functor(E1,F1,Arity1), |
| 720 | | % functor(E2,F2,Arity2), print(not_eq_val(F1,Arity1,F2,Arity2)),nl, fail,print(E1),nl, print(E2),nl,nl,fail. |
| 721 | | |
| 722 | | decompose_value_into_cartesian_product(avl_set(A),A1,A2) :- !, |
| 723 | | decompose_avl_set_into_cartesian_product_wf(A,A1,A2,no_wf_available). |
| 724 | | decompose_value_into_cartesian_product(Closure,A1,A2) :- is_cartesian_product_closure(Closure,A1,A2). |
| 725 | | |
| 726 | | |
| 727 | | % rewrite values back to AST nodes |
| 728 | | rewrite_value(value(V),OtherVal,New) :- nonvar(V), |
| 729 | | rewrite_value_aux(V,OtherVal,New). |
| 730 | | %rewrite_value(function(Lambda,Argument),assertion_expression(_,_,_),assertion_expression(Cond,Msg,Expr)) :- b_ast_cleanup:rewrite_function_application(Lambda,Argument,[],assertion_expression(Cond,Msg,Expr)). |
| 731 | | rewrite_value_aux(closure(P,T,B),_,Set) :- |
| 732 | | is_member_closure(P,T,B,_,Set). % TO DO: ensure that ast_cleanup does not generate useless member closures ? |
| 733 | | rewrite_value_aux(global_set(GS),_,AST) :- |
| 734 | | rewrite_glob_set(GS,AST). |
| 735 | | rewrite_value_aux(avl_set(A),interval(_,_),interval(TLow,TUp)) :- |
| 736 | | avl_equal_to_interval(A,Low,Up), |
| 737 | | TLow = b(integer(Low),integer,[]), TUp = b(integer(Up),integer,[]). |
| 738 | | rewrite_value_aux(int(A),integer(_),integer(A)) :- number(A). |
| 739 | | rewrite_value_aux(pred_true,_,boolean_true). |
| 740 | | rewrite_value_aux(pred_false,_,boolean_false). |
| 741 | | rewrite_value_aux(string(A),integer(_),string(A)) :- % value(string(A)) rewritten to AST node string(A) |
| 742 | | atom(A). |
| 743 | | |
| 744 | | |
| 745 | | rewrite_glob_set('REAL',real_set). |
| 746 | | rewrite_glob_set('FLOAT',float_set). |
| 747 | | rewrite_glob_set('STRING',string_set). |
| 748 | | rewrite_glob_set(I,integer_set(I)) :- |
| 749 | | kernel_objects:integer_global_set(I). |
| 750 | | |
| 751 | | allow_expansion(avl_set(_),closure(P,T,B)) :- |
| 752 | | is_small_specific_custom_set(closure(P,T,B),100). |
| 753 | | allow_expansion(closure(P,T,B),avl_set(_)) :- |
| 754 | | is_small_specific_custom_set(closure(P,T,B),100). |
| 755 | | |
| 756 | | same_sub_expressions([],_,[]). |
| 757 | | same_sub_expressions([H1|T1],AVL,[H2|T2]) :- |
| 758 | | same_texpr_body(H1,AVL,H2), |
| 759 | | same_sub_expressions(T1,AVL,T2). |
| 760 | | |
| 761 | | same_value_inside_closure(V1,V2) :- var(V1),!, V1==V2. |
| 762 | | same_value_inside_closure(_,V2) :- var(V2),!,fail. |
| 763 | | same_value_inside_closure(rec(Fields1),rec(Fields2)) :- !, |
| 764 | | % sets of records come in this form: struct(b(value(rec(FIELDS)),record(_),_)) |
| 765 | | same_fields_inside_closure(Fields1,Fields2). |
| 766 | | same_value_inside_closure(V1,V2) :- |
| 767 | | % we could attempt this only if the outer closure was large/infinite ?? |
| 768 | | is_custom_explicit_set(V1), is_custom_explicit_set(V2), |
| 769 | | !, |
| 770 | | (allow_expansion(V1,V2) -> EXP=allow_expansion ; EXP = no_expansion), |
| 771 | | equal_explicit_sets4(V1,V2,EXP,no_wf_available). % usually only sets compiled differently inside closures |
| 772 | | same_value_inside_closure([H1|T1],avl_set(A2)) :- !, % relevant for JSON trace replay for test 1263 |
| 773 | | try_convert_to_avl([H1|T1],V1), V1=avl_set(A1), |
| 774 | | equal_avl_tree(A1,A2). |
| 775 | | same_value_inside_closure(avl_set(A2),[H1|T1]) :- !, |
| 776 | | try_convert_to_avl([H1|T1],V1), V1=avl_set(A1), |
| 777 | | equal_avl_tree(A1,A2). |
| 778 | | same_value_inside_closure(V1,V2) :- V1==V2. |
| 779 | | |
| 780 | | same_fields_inside_closure(V1,V2) :- var(V1),!, V1==V2. |
| 781 | | same_fields_inside_closure(_,V2) :- var(V2),!,fail. |
| 782 | | same_fields_inside_closure([],[]). |
| 783 | | same_fields_inside_closure([field(Name,V1)|T1],[field(Name,V2)|T2]) :- |
| 784 | | same_value_inside_closure(V1,V2), |
| 785 | | same_fields_inside_closure(T1,T2). |
| 786 | | |
| 787 | | /* |
| 788 | | same_texpr_body_debug(H1,H2) :- |
| 789 | | (same_texpr_body(H1,H2) -> true |
| 790 | | ; print('FAIL: '),nl, |
| 791 | | translate:print_bexpr(H1),nl, translate:print_bexpr(H2),nl, print(H1),nl, print(H2),nl, fail). */ |
| 792 | | |
| 793 | | %test(Y2,Z2) :- empty_avl(X), avl_store(1,X,2,Y), avl_store(2,X,3,Z), |
| 794 | | % avl_store(2,Y,3,Y2), avl_store(1,Z,2,Z2), equal_avl_tree(Y2,Z2). |
| 795 | | |
| 796 | | %equal_avl_tree(A,B) :- avl_min(A,Min), avl_min(B,Min), cmp(Min,A,B). |
| 797 | | %cmp(El,A,B) :- |
| 798 | | % (avl_next(El,A,Nxt) -> (avl_next(El,B,Nxt), cmp(Nxt,A,B)) |
| 799 | | % ; \+ avl_next(El,B,Nxt) ). |
| 800 | | |
| 801 | | % The following is faster than using avl_next |
| 802 | | equal_avl_tree(A,B) :- |
| 803 | | % statistics(walltime,[WT1,_]),if(equal_avl_tree2(A,B),true,(statistics(walltime,[_,W]),print(wall(W)),nl)). |
| 804 | | %equal_avl_tree2(A,B) :- |
| 805 | | avl_min(A,Min), |
| 806 | | !, |
| 807 | | avl_min(B,Min), |
| 808 | | avl_max(A,Max), avl_max(B,Max), |
| 809 | | % maybe also check avl_height +/- factor of 1.4405 (page 460, Knuth 3) ? but it seems this would trigger only extremely rarely |
| 810 | | %avl_height(A,H1), avl_height(A,H2), log(check(Min,Max,H1,H2)), |
| 811 | | avl_domain(A,L), avl_domain(B,L). |
| 812 | | equal_avl_tree(empty,_) :- !, format(user_error,'*** Warning: empty AVL tree in equal_avl_tree~n',[]). |
| 813 | | equal_avl_tree(A,B) :- add_internal_error('Illegal AVL tree: ',equal_avl_tree(A,B)),fail. |
| 814 | | |
| 815 | | /* a predicate to check equality of two custom explicit sets */ |
| 816 | | |
| 817 | | % TO DO: deal with second set being a variable with kernel_cardinality_attr attribute |
| 818 | | :- block not_equal_explicit_sets_wf(-,?,?), not_equal_explicit_sets_wf(?,-,?). |
| 819 | | not_equal_explicit_sets_wf(global_set(X),global_set(Y),_) :- !,dif(X,Y). |
| 820 | | not_equal_explicit_sets_wf(global_set(B),avl_set(A),WF) :- !, |
| 821 | | \+ equal_explicit_sets4(avl_set(A),global_set(B),allow_expansion,WF). |
| 822 | | not_equal_explicit_sets_wf(freetype(X),freetype(Y),_) :- !,dif(X,Y). |
| 823 | | not_equal_explicit_sets_wf(avl_set(A),avl_set(B),_) :- !, |
| 824 | | \+ equal_avl_tree(A,B). |
| 825 | | %not_equal_explicit_sets_wf(X,Y,_) :- X==Y,!,fail. |
| 826 | | not_equal_explicit_sets_wf(avl_set(A),I2,WF) :- is_interval_closure_or_integerset(I2,L2,U2),!, % also covers I2=global_set(...) |
| 827 | | avl_not_equal_to_interval(A,L2,U2,WF). |
| 828 | | not_equal_explicit_sets_wf(avl_set(A),global_set(B),WF) :- !, |
| 829 | | \+ equal_explicit_sets4(avl_set(A),global_set(B),allow_expansion,WF). |
| 830 | | not_equal_explicit_sets_wf(avl_set(A),CPB,WF) :- |
| 831 | | is_cartesian_product_closure(CPB,B1,B2),!, |
| 832 | | if(decompose_avl_set_into_cartesian_product_wf(A,A1,A2,WF), % should not produce pending co-routines, but better safe |
| 833 | | kernel_objects:not_equal_object_wf((A1,A2),(B1,B2),WF), |
| 834 | | true % no cartesian product can be equal to this avl_set |
| 835 | | ). |
| 836 | | not_equal_explicit_sets_wf(closure(P,T,B),avl_set(A),WF) :- !, |
| 837 | | not_equal_explicit_sets_wf(avl_set(A),closure(P,T,B),WF). |
| 838 | | not_equal_explicit_sets_wf(I1,I2,_) :- is_interval_closure_or_integerset(I1,L1,U1), |
| 839 | | is_interval_closure_or_integerset(I2,L2,U2), !, |
| 840 | | dif((L1,U1),(L2,U2)). % maybe we should call not_equal_objects on integers (not on inf values)? |
| 841 | | not_equal_explicit_sets_wf(CPA,CPB,WF) :- |
| 842 | | is_cartesian_product_closure(CPA,A1,A2), is_cartesian_product_closure(CPB,B1,B2),!, |
| 843 | | not_equal_cartesian_product_wf(A1,A2,B1,B2,WF). |
| 844 | | not_equal_explicit_sets_wf(S1,S2,WF) :- |
| 845 | | is_not_member_value_closure_or_integerset(S1,TYPE,MS1), |
| 846 | | is_not_member_value_closure_or_integerset(S2,TYPE,MS2),!, |
| 847 | | kernel_objects:not_equal_object_wf(MS1,MS2,WF). |
| 848 | | not_equal_explicit_sets_wf(closure(P,T,B),closure(P,T,B2),_) :- |
| 849 | | same_texpr_body(B,B2),!,fail. |
| 850 | | % TO DO: maybe support interval & avl_set comparison |
| 851 | | not_equal_explicit_sets_wf(Set1,Set2,WF) :- |
| 852 | | card_for_specific_custom_set(Set1,Card1,Code1), card_for_specific_custom_set(Set2,Card2,Code2), |
| 853 | | call(Code1), call(Code2),!, |
| 854 | | not_equal_expansions(Card1,Card2,Set1,Set2,WF). |
| 855 | | not_equal_explicit_sets_wf(Set1,Set2,WF) :- not_equal_expansions(0,0,Set1,Set2,WF). |
| 856 | | |
| 857 | | |
| 858 | | :- block not_equal_expansions(-,?,?,?,?), not_equal_expansions(?,-,?,?,?). |
| 859 | | not_equal_expansions(F1,F2,_,_,_) :- F1 \= F2,!. % sets guaranteed to be different |
| 860 | | not_equal_expansions(F,F,Set1,Set2,WF) :- |
| 861 | ? | get_identity_as_equivalence(F,Set1,Set2,EQUIV), |
| 862 | | !, |
| 863 | | b_not_test_boolean_expression(EQUIV,[],[],WF). |
| 864 | | not_equal_expansions(F,F,Set1,Set2,WF) :- |
| 865 | | % only expand if both sets have same cardinality |
| 866 | | expand_custom_set_wf(Set1,E1,not_equal_expansions1,WF), |
| 867 | | expand_custom_set_wf(Set2,E2,not_equal_expansions2,WF), |
| 868 | | dif(E1,E2). /* TO DO: ensure that ordering and normalization is same for all representations ! */ |
| 869 | | |
| 870 | | |
| 871 | | |
| 872 | | |
| 873 | | :- use_module(b_global_sets,[b_empty_global_set/1, b_non_empty_global_set/1, b_global_set_cardinality/2]). |
| 874 | | is_empty_explicit_set_wf(closure(P,T,B),WF) :- !, |
| 875 | | is_empty_closure_wf(P,T,B,WF). |
| 876 | | is_empty_explicit_set_wf(S,_WF) :- is_empty_explicit_set(S). |
| 877 | | |
| 878 | | % with WF we can delay computing Card; see test 1272 / card({x|x:1..10 & x*x<i}) = 0 & i>1 |
| 879 | | % TO DO: ideally we could just write this: is_empty_closure_wf(P,T,B,WF) :- closure_cardinality(P,T,B,0,WF). ; but empty_set / not_exists optimisation not triggered in closure_cardinality (yet); would avoid duplicate code |
| 880 | | is_empty_closure_wf(P,T,B,WF) :- |
| 881 | | is_lambda_value_domain_closure(P,T,B, DomainValue,_Expr),!, |
| 882 | | kernel_objects:empty_set_wf(DomainValue,WF). |
| 883 | | is_empty_closure_wf(P,T,B,WF) :- is_cartesian_product_closure_aux(P,T,B,A1,A2),!, |
| 884 | | very_approximate_cardinality(A1,C1,WF), |
| 885 | | very_approximate_cardinality(A2,C2,WF), |
| 886 | | blocking_safe_mul(C1,C2,0). |
| 887 | | is_empty_closure_wf(P,T,B,_WF) :- |
| 888 | | card_for_specific_closure2(P,T,B,CC,Code), |
| 889 | | !, |
| 890 | | call(Code),CC=0. |
| 891 | | is_empty_closure_wf(P,T,Body,WF) :- |
| 892 | | WF \== no_wf_available, % only do this if we have a WF store; see comments for closure_cardinality ; code relevant for test 1272; card({x|x:1..10 & x*x<i}) = 0 & i>1 |
| 893 | | \+ ground_bexpr(Body), % otherwise better to use not_test_exists below (e.g., Bosch v6 Codespeed benchmark) |
| 894 | | b_interpreter_check:reify_closure_with_small_cardinality(P,T,Body, WF, ReifiedList), |
| 895 | | !, |
| 896 | | domain(ReifiedList,0,1), |
| 897 | | sum(ReifiedList,'#=',0). |
| 898 | | is_empty_closure_wf(P,T,B,WF) :- |
| 899 | | get_recursive_identifier_of_closure_body(B,TRID),!, |
| 900 | | def_get_texpr_id(TRID,RID), |
| 901 | | gen_typed_ids(P,T,TypedParas), |
| 902 | | % now add Recursive ID's value to local state: |
| 903 | | b_interpreter:b_not_test_exists(TypedParas,B,[used_ids([RID])],[bind(RID,closure(P,T,B))],[],no_compile,WF). |
| 904 | | is_empty_closure_wf(P,T,B,WF) :- !, % try and check that not(#(P).(B)); i.e., there is no solution for the Body B; solves tests 1542, detecting that {x|x>100 & x mod 102 = 2} = {} is false |
| 905 | | gen_typed_ids(P,T,TypedParas), |
| 906 | | b_interpreter:b_not_test_exists(TypedParas,B,[used_ids([])],[],[],no_compile,WF). % used_ids are empty, as all variables already compiled into values |
| 907 | | |
| 908 | | % very_approximate_cardinality: only required to return 0 for empty set, and number or inf for non-empty set, tested in 1893 |
| 909 | | :- block very_approximate_cardinality(-,?,?). |
| 910 | | very_approximate_cardinality(avl_set(A),C,_) :- !, (A=empty -> print(empty_avl),nl,C=0 ; C=1). |
| 911 | | very_approximate_cardinality([],C,_) :- !, C=0. |
| 912 | | very_approximate_cardinality([_|_],C,_) :- !, C=1. |
| 913 | | very_approximate_cardinality(Set,C,WF) :- kernel_objects:cardinality_as_int_wf(Set,int(C),WF). |
| 914 | | % TO DO: maybe call is_empty_closure or similar for closures |
| 915 | | |
| 916 | | gen_typed_ids([],[],R) :- !, R=[]. |
| 917 | | gen_typed_ids([ID|IT],[Type|TT],[b(identifier(ID),Type,[])|TTT]) :- !, |
| 918 | | % TO DO: add Info field from outer set comprehension |
| 919 | | gen_typed_ids(IT,TT,TTT). |
| 920 | | gen_typed_ids(I,T,TI) :- add_internal_error('Call failed: ',gen_typed_ids(I,T,TI)),fail. |
| 921 | | |
| 922 | | % version with WF can also deal with closures via exists ! |
| 923 | | is_empty_explicit_set(global_set(GS)) :- !, b_empty_global_set(GS). |
| 924 | | is_empty_explicit_set(freetype(ID)) :- !, is_empty_freetype(ID). |
| 925 | | is_empty_explicit_set(avl_set(A)) :- !, |
| 926 | | (var(A) -> add_warning(is_empty_explicit_set,'Variable avl_set') |
| 927 | | ; empty_avl(A), add_warning(is_empty_explicit_set,'Empty avl_set') |
| 928 | | ). |
| 929 | | is_empty_explicit_set(C) :- card_for_specific_closure(C,CC,Code),!,call(Code),CC=0. |
| 930 | | is_empty_explicit_set(ES) :- expand_custom_set(ES,[],is_empty_explicit_set). |
| 931 | | |
| 932 | | |
| 933 | | is_non_empty_explicit_set(CS) :- is_non_empty_explicit_set_wf(CS,no_wf_available). |
| 934 | | |
| 935 | | is_non_empty_explicit_set_wf(global_set(GS),_WF) :- !, b_non_empty_global_set(GS). |
| 936 | | is_non_empty_explicit_set_wf(freetype(ID),_WF) :- !, is_non_empty_freetype(ID). |
| 937 | | is_non_empty_explicit_set_wf(avl_set(A),_WF) :- !, |
| 938 | | (empty_avl(A) -> print('### Warning: empty avl_set (2)'),nl,fail |
| 939 | | ; true). |
| 940 | | is_non_empty_explicit_set_wf(closure(P,T,B),WF) :- !, is_non_empty_closure_wf(P,T,B,WF). |
| 941 | | %is_non_empty_explicit_set_wf(ES,_WF) :- expand_custom_set(ES,[_|_],is_non_empty_explicit_set). |
| 942 | | |
| 943 | | |
| 944 | | % TO DO: this code is a bit redundant with is_empty_closure_wf |
| 945 | | is_non_empty_closure_wf(P,T,B,WF) :- |
| 946 | | is_lambda_value_domain_closure(P,T,B, DomainValue,_Expr),!, |
| 947 | | kernel_objects:not_empty_set_wf(DomainValue,WF). |
| 948 | | is_non_empty_closure_wf(P,T,B,WF) :- is_cartesian_product_closure_aux(P,T,B,A1,A2),!, |
| 949 | | very_approximate_cardinality(A1,C1,WF), |
| 950 | | very_approximate_cardinality(A2,C2,WF), |
| 951 | | blocking_safe_mul(C1,C2,CC),gt0(CC). |
| 952 | | is_non_empty_closure_wf(P,T,B,_WF) :- |
| 953 | | card_for_specific_closure2(P,T,B,CC,Code),!,call(Code),gt0(CC). |
| 954 | | % TO DO: reify_closure_with_small_cardinality |
| 955 | | is_non_empty_closure_wf(P,T,B,WF) :- WF \== no_wf_available, |
| 956 | ? | get_recursive_identifier_of_closure_body(B,TRID),!, |
| 957 | | def_get_texpr_id(TRID,RID), |
| 958 | | gen_typed_ids(P,T,TypedParas), |
| 959 | | % now add Recursive ID's value to local state: |
| 960 | | b_interpreter:b_test_exists(TypedParas,B,[used_ids([RID])],[bind(RID,closure(P,T,B))],[],WF). |
| 961 | | is_non_empty_closure_wf(P,T,B,WF) :- WF \== no_wf_available, |
| 962 | | % otherwise enumeration of test_exists will behave strangely; leading to enumeration warnings,... [TO DO: ensure we always have a WF or fix this below ?] |
| 963 | | % try and check that not(#(P).(B)); i.e., there is no solution for the Body B; solves tests 1542; test 1146 also triggers this code |
| 964 | | (debug_mode(off) -> true ; print(non_empty_closure_test(P)),nl, translate:print_bexpr(B),nl), |
| 965 | | gen_typed_ids(P,T,TypedParas), |
| 966 | | !, |
| 967 | | b_interpreter:b_test_exists(TypedParas,B,[used_ids([])],[],[],WF). % used_ids are empty, as all variables already compiled into values |
| 968 | | % some rules for set_subtraction, ... closures ?? if left part infinite and right part finite it must be infinite |
| 969 | | is_non_empty_closure_wf(P,T,B,WF) :- |
| 970 | | expand_custom_set_wf(closure(P,T,B),[_|_],is_non_empty_closure_wf,WF). |
| 971 | | |
| 972 | | |
| 973 | | % TO DO: expand cart / reify and use for pf_test |
| 974 | | test_empty_closure_wf(P,T,B,Res,WF) :- |
| 975 | | is_lambda_value_domain_closure(P,T,B, DomainValue,_Expr),!, |
| 976 | | kernel_equality:empty_set_test_wf(DomainValue,Res,WF). |
| 977 | | %test_empty_closure_wf(P,T,B,WF) :- is_cartesian_product_closure_aux(P,T,B,A1,A2),!, |
| 978 | | test_empty_closure_wf(P,T,B,Res,_WF) :- |
| 979 | | card_for_specific_closure2(P,T,B,CC,Code),!,call(Code),leq0(CC,Res). |
| 980 | | test_empty_closure_wf(P,T,B,Res,WF) :- |
| 981 | | \+ is_memoization_closure(P,T,B,_MemoID), |
| 982 | | preferences:preference(use_closure_expansion_memoization,false), |
| 983 | | !, |
| 984 | | bexpr_variables(B,ClosureWaitVars), |
| 985 | | % this does not perform a few optimisations of expand_normal closure: |
| 986 | | % memoization, stored_memo_expansion, is_closure1_value_closure, is_lambda_closure |
| 987 | | % print(test_empty_closure_wf),nl, translate:print_bexpr(B),nl, |
| 988 | | when((ground(ClosureWaitVars) ; nonvar(Res)), |
| 989 | | test_empty_closure_wf2(P,T,B,Res,WF)). |
| 990 | | test_empty_closure_wf(P,T,B,Res,WF) :- % print(expand_test(P)),nl, |
| 991 | | % was expand_custom_set_wf(closure(P,T,B),ExpES,test_empty_closure_wf,WF), in turn calls expand_closure_to_list |
| 992 | | expand_normal_closure(P,T,B,ExpES,_CDone,check(test_empty_closure_wf),WF), |
| 993 | | kernel_equality:empty_set_test_wf(ExpES,Res,WF). |
| 994 | | % /*@symbolic */ {x|x:1..100000000 & x mod 22=1} = x & (x={} <=> B=TRUE) |
| 995 | | |
| 996 | | test_empty_closure_wf2(P,T,B,Res,WF) :- |
| 997 | | Res == pred_true,!, |
| 998 | | is_empty_closure_wf(P,T,B,WF). |
| 999 | | test_empty_closure_wf2(P,T,B,Res,WF) :- Res == pred_false,!, |
| 1000 | | is_non_empty_closure_wf(P,T,B,WF). |
| 1001 | | test_empty_closure_wf2(P,T,B,Res,WF) :- |
| 1002 | | (is_empty_closure_now(P,T,B,WF) % we need to force expansion here to be able to use local cut -> |
| 1003 | | % expand_normal_closure would now also expand the closure; |
| 1004 | | -> Res=pred_true |
| 1005 | | ; Res=pred_false). |
| 1006 | | |
| 1007 | | % check if closure now; ground everything except WFE |
| 1008 | | is_empty_closure_now(P,T,B,OuterWF) :- |
| 1009 | | create_inner_wait_flags(OuterWF,is_empty_closure_now,WF), |
| 1010 | | debug_opt_push_wait_flag_call_stack_info(WF, |
| 1011 | | external_call('Check if empty set',[closure(P,T,B)],unknown),WF2), |
| 1012 | | is_empty_closure_wf(P,T,B,WF2), |
| 1013 | | ground_inner_wait_flags(WF2). % does not ground WFE in case WD errors are pending |
| 1014 | | |
| 1015 | | :- block leq0(-,?). |
| 1016 | | leq0(inf,Res) :- !, Res=pred_false. |
| 1017 | | leq0(inf_overflow,Res) :- !, Res=pred_false. |
| 1018 | | leq0(CC,Res) :- (CC>0 -> Res=pred_false ; Res=pred_true). |
| 1019 | | |
| 1020 | | test_empty_explicit_set_wf(V,Res,_) :- var(V),!, |
| 1021 | | add_internal_error('Illegal call: ',test_empty_explicit_set(V,Res,_)),fail. |
| 1022 | | test_empty_explicit_set_wf(global_set(GS),Res,_WF) :- !, |
| 1023 | | (b_empty_global_set(GS) -> Res=pred_true ; Res=pred_false). |
| 1024 | | test_empty_explicit_set_wf(freetype(ID),Res,_WF) :- !, test_empty_freetype(ID,Res). |
| 1025 | | test_empty_explicit_set_wf(avl_set(A),Res,_WF) :- !, |
| 1026 | | (var(A) -> add_warning(test_empty_explicit_set_wf,'Variable avl_set'), Res=pred_true |
| 1027 | | ; empty_avl(A), add_warning(test_empty_explicit_set_wf,'Empty avl_set'), Res = pred_true |
| 1028 | | ; Res=pred_false). |
| 1029 | | test_empty_explicit_set_wf(closure(P,T,B),Res,WF) :- !, |
| 1030 | | test_empty_closure_wf(P,T,B,Res,WF). |
| 1031 | | test_empty_explicit_set_wf(ES,Res,WF) :- |
| 1032 | | expand_custom_set(ES,ExpES,test_empty_explicit_set), |
| 1033 | | kernel_equality:empty_set_test_wf(ExpES,Res,WF). |
| 1034 | | |
| 1035 | | :- block gt0(-). |
| 1036 | | gt0(CC) :- (CC=inf -> true ; CC=inf_overflow -> true ; CC>0). |
| 1037 | | |
| 1038 | | % a version to compute cardinality for |
| 1039 | | explicit_set_cardinality_for_wf(closure(P,T,B),Card) :- |
| 1040 | | (is_symbolic_closure_or_symbolic_mode(P,T,B) ; \+ ground_bexpr(B)), |
| 1041 | | !, |
| 1042 | | Card = inf. % assume card is infinite for WF computation; it may be finite! |
| 1043 | | %explicit_set_cardinality_for_wf(avl_set(AVL),Size) :- !, quick_avl_approximate_size(AVL,Size). |
| 1044 | | explicit_set_cardinality_for_wf(CS,Card) :- card_for_specific_custom_set(CS,Card,Code),!, |
| 1045 | | on_enumeration_warning(call(Code),Card=inf). % see test 1519 for relevance |
| 1046 | | explicit_set_cardinality_for_wf(_,inf). % assume card is infinite for WF computation; it may be finite! |
| 1047 | | % TO DO: maybe never expand closures here !? -> closure_cardinality can expand closure !!!!!! |
| 1048 | | %explicit_set_cardinality_for_wf(CS,Card) :- |
| 1049 | | % on_enumeration_warning( |
| 1050 | | % explicit_set_cardinality(CS,Card), |
| 1051 | | % (debug_println(assuming_inf_card_for_wf), % see test 1519 for relevance |
| 1052 | | % Card = inf)). % assume card is infinite for WF computation; it may be finite! |
| 1053 | | |
| 1054 | | explicit_set_cardinality(CS,Card) :- |
| 1055 | | % init_wait_flags(WF,[explicit_set_cardinality]), % there are a few checks for no_wf_available below |
| 1056 | | explicit_set_cardinality_wf(CS,Card,no_wf_available). |
| 1057 | | % ground_wait_flags(WF). |
| 1058 | | |
| 1059 | | explicit_set_cardinality_wf(global_set(GS),Card,_) :- !,b_global_set_cardinality(GS,Card). |
| 1060 | | explicit_set_cardinality_wf(freetype(GS),Card,_WF) :- !, freetype_cardinality(GS,Card). |
| 1061 | | explicit_set_cardinality_wf(avl_set(S),Card,_WF) :- !,avl_size(S,Card). |
| 1062 | ? | explicit_set_cardinality_wf(closure(P,T,B),Card,WF) :- closure_cardinality(P,T,B,Card,WF). |
| 1063 | | |
| 1064 | | :- use_module(performance_messages). |
| 1065 | | closure_cardinality(P,T,B,Card,WF) :- |
| 1066 | | is_lambda_value_domain_closure(P,T,B, DomainValue,_Expr),!, |
| 1067 | | kernel_objects:cardinality_as_int_wf(DomainValue,int(Card),WF). % always compute it; card_for_specific_closure will only compute it if it can be done efficiently |
| 1068 | | closure_cardinality(P,T,B,Card,WF) :- is_cartesian_product_closure_aux(P,T,B,A1,A2),!, |
| 1069 | | kernel_objects:cardinality_as_int_wf(A1,int(C1),WF), |
| 1070 | | kernel_objects:cardinality_as_int_wf(A2,int(C2),WF), |
| 1071 | | blocking_safe_mul(C1,C2,Card). |
| 1072 | | % TO DO: card_for_specific_closure2 calls is_lambda_value_domain_closure and is_cartesian_product_closure_aux again ! |
| 1073 | | closure_cardinality(P,T,B,Card,_WF) :- |
| 1074 | | card_for_specific_closure2(P,T,B,CC,Code), |
| 1075 | | !, |
| 1076 | | call(Code),Card=CC. |
| 1077 | | closure_cardinality(P,T,Body,Card,WF) :- |
| 1078 | | (WF == no_wf_available -> CBody=Body |
| 1079 | ? | ; b_compiler:b_compile(Body,P,[],[],CBody) |
| 1080 | | ), |
| 1081 | | % reify will work better if we used b_compiler:compile so that more sets can be detected as small |
| 1082 | | closure_cardinality2(P,T,CBody,Card,WF). |
| 1083 | | closure_cardinality2(P,T,Body,Card,WF) :- |
| 1084 | | WF \== no_wf_available, % only do this if we have a WF store |
| 1085 | ? | if(b_interpreter_check:reify_closure_with_small_cardinality(P,T,Body, WF, ReifiedList), |
| 1086 | | true, |
| 1087 | | (perfmessagecall(reify,reification_of_closure_for_card_failed(P),translate:print_bexpr(Body),Body),fail)), |
| 1088 | | !, |
| 1089 | | domain(ReifiedList,0,1), |
| 1090 | | sum(ReifiedList,'#=',Card), |
| 1091 | | % in this case we know card to be finite ! TO DO: ensure that check_finite propagates Card variable |
| 1092 | | debug_println(9,reified_cardinality_sum(ReifiedList,Card)). % fd_dom(Card,Dom),print(dom(Card,Dom)),nl. |
| 1093 | | % should we add a special check if Card=0 ? usually Card not instantiated at this point ! |
| 1094 | | %closure_cardinality(P,T,B,Card,WF) :- Card==0, %is_symbolic_closure(P,T,B), |
| 1095 | | % !, is_empty_closure_wf(P,T,B,WF). |
| 1096 | | closure_cardinality2(P,T,B,Card,WF) :- |
| 1097 | | % TO DO: bexpr_variables(ClosureBody,ClosureWaitVars) and wait until those are bound; if Card = 0 -> empty_set; we can try to reifiy again |
| 1098 | | expand_custom_set_wf(closure(P,T,B),Expansion,closure_cardinality,WF), |
| 1099 | | my_length(Expansion,0,Card). |
| 1100 | | |
| 1101 | | :- block my_length(-,?,?). |
| 1102 | | my_length([],A,A). |
| 1103 | | my_length([_|T],A,R) :- A1 is A+1, my_length(T,A1,R). |
| 1104 | | |
| 1105 | | % compute domain and range for specific relations; |
| 1106 | | % not the closure is total over the domain and surjective over the range |
| 1107 | | % WARNING: this should never enumerate on its own, it is often called with |
| 1108 | | % a cut straight after it; if some enumeration happens then only first solution |
| 1109 | | % will be pursued (e.g., cond_assign_eq_obj) |
| 1110 | | dom_range_for_specific_closure([],[],[],function(bijection),_WF). |
| 1111 | | dom_range_for_specific_closure(closure(P,T,Pred),Domain,Range,Functionality,WF) :- |
| 1112 | | dom_range_for_specific_closure2(P,T,Pred, Domain,Range,Functionality,WF). |
| 1113 | | |
| 1114 | | dom_range_for_specific_closure2(Par,Typ,Body, Domain,Range,Functionality,_WF) :- |
| 1115 | | is_member_closure(Par,Typ,Body,TYPE,SET), |
| 1116 | | dom_range_for_member_closure(SET,TYPE,Domain,Range,Functionality),!. |
| 1117 | | dom_range_for_specific_closure2(Par,Typ,Body, DOMAIN,RANGE,Functionality,WF) :- |
| 1118 | | is_cartesian_product_closure_aux(Par,Typ,Body,SET1,SET2),!, |
| 1119 | | (singleton_set(SET2,_) % checks nonvar |
| 1120 | | -> Functionality = function(total) % function if card(SET2)=1 |
| 1121 | | ; Functionality=relation), |
| 1122 | | kernel_equality:empty_set_test_wf(SET1,EqRes1,WF), |
| 1123 | | cond_assign_eq_obj_wf(EqRes1,RANGE,[],SET2,WF), % if SET1=[] then Range=[] |
| 1124 | | kernel_equality:empty_set_test_wf(SET2,EqRes2,WF), |
| 1125 | | cond_assign_eq_obj_wf(EqRes2,DOMAIN,[],SET1,WF). %if SET2=[] then Domain=[] |
| 1126 | | dom_range_for_specific_closure2(Par,Typ,Body, DomainRange,DomainRange,function(bijection),_WF) :- |
| 1127 | | is_id_closure_over(Par,Typ,Body,DomainRange,_). |
| 1128 | | |
| 1129 | | |
| 1130 | | dom_range_for_member_closure(identity(b(value(SET1),ST1,_)),_SEQT,SET1,SET1,function(bijection)) :- |
| 1131 | | is_set_type(ST1,_). /* _SEQT=id(T1) */ |
| 1132 | | % not sure if we need this: memoized functions are infinite usually and range can never be computed anyway |
| 1133 | | %dom_range_for_member_closure(Expr,_,Domain,Range,Func) :- |
| 1134 | | % expand_memoize_stored_function_reference(Expr,ExpandedValue), |
| 1135 | | % dom_range_for_specific_closure(ExpandedValue,Domain,Range,Func,no_wf_available). |
| 1136 | | |
| 1137 | | :- block cond_assign_eq_obj_wf(-,?,?,?,?). |
| 1138 | | %cond_assign_eq_obj_wf(PTF,R,A,B,_) :- var(PTF), add_error(cond_assign_eq_obj,'block declaration bug warning: ',cond_assign_eq_obj(PTF,R,A,B)),fail. % comment in to detect if affected by block declaration bug |
| 1139 | | cond_assign_eq_obj_wf(pred_true,Res,A,_,WF) :- equal_object_wf(Res,A,cond_assign_eq_obj_wf_1,WF). |
| 1140 | | cond_assign_eq_obj_wf(pred_false,Res,_,B,WF) :- equal_object_wf(Res,B,cond_assign_eq_obj_wf_2,WF). |
| 1141 | | |
| 1142 | | is_cartesian_product_closure(closure(Par,Typ,Body),SET1,SET2) :- |
| 1143 | ? | is_cartesian_product_closure_aux(Par,Typ,Body,SET1,SET2). |
| 1144 | | is_cartesian_product_closure_aux(Par,Types,b(truth,pred,Info),SET1,SET2) :- Par=[_,_|_],!, |
| 1145 | | append(LPar,[RParID],Par), append(LTypes,[RType],Types), |
| 1146 | | construct_closure_if_necessary(LPar,LTypes,b(truth,pred,Info),SET1), |
| 1147 | | construct_closure_if_necessary([RParID],[RType],b(truth,pred,Info),SET2). |
| 1148 | | is_cartesian_product_closure_aux(Par,Types,Body,SET1,SET2) :- Par=[_,_|_],!, |
| 1149 | | append(LPar,[RParID],Par), append(LTypes,[RType],Types),!, |
| 1150 | | split_conjunct(Body,[RParID], RConjL, LPar, LConjL), |
| 1151 | | bsyntaxtree:conjunct_predicates(RConjL,RConj), bsyntaxtree:conjunct_predicates(LConjL,LConj), |
| 1152 | | construct_closure_if_necessary(LPar,LTypes,LConj,SET1), |
| 1153 | | construct_closure_if_necessary([RParID],[RType],RConj,SET2). |
| 1154 | | is_cartesian_product_closure_aux(Par,Typ,Body,SET1,SET2) :- |
| 1155 | | SET = cartesian_product(b(value(SET1),ST1,_), b(value(SET2),ST2,_)), |
| 1156 | | is_member_closure(Par,Typ,Body,couple(T1m,T2m),SET), |
| 1157 | | is_set_type(ST1,T1),unify_types_strict(T1,T1m), |
| 1158 | | is_set_type(ST2,T2),unify_types_strict(T2,T2m),!. |
| 1159 | | %is_cartesian_product_closure_aux([ID1,ID2],[T1,T2],FBody,SET1,SET2) :- % is this not redundant wrt split ?? |
| 1160 | | % % a closure of the form {ID1,ID2|ID1 : SET1 & ID2 : SET2} ; |
| 1161 | | % % can get generated when computing domain symbolically of lambda abstraction |
| 1162 | | % FBody = b(Body,pred,_), |
| 1163 | | % is_cartesian_product_body(Body,ID1,ID2,T1,T2,SET1,SET2). % ,print(cart_res(SET1,SET2)),nl. |
| 1164 | | |
| 1165 | | % try and split conjunct into two disjoint parts (for detecting cartesian products) |
| 1166 | | % on the specified variables |
| 1167 | | % fails if it cannot be done |
| 1168 | | split_conjunct(b(PRED,pred,Info),Vars1,C1,Vars2,C2) :- |
| 1169 | | split_conjunct_aux(PRED,Info,Vars1,C1,Vars2,C2). |
| 1170 | | split_conjunct_aux(truth,_Info,_Vars1,C1,_Vars2,C2) :- !,C1=[],C2=[]. |
| 1171 | | split_conjunct_aux(conjunct(A,B),_Info,Vars1,C1,Vars2,C2) :- !, % TO DO: use DCG |
| 1172 | | split_conjunct(B,Vars1,CB1,Vars2,CB2), !, % Note: conjunct_predicates will create inner conjunct in A and atomic Expression in B |
| 1173 | | split_conjunct(A,Vars1,CA1,Vars2,CA2),!, |
| 1174 | | append(CA1,CB1,C1), append(CA2,CB2,C2). |
| 1175 | | split_conjunct_aux(E,Info,Vars1,C1,_Vars2,C2) :- unique_id_comparison(E,ID),!, |
| 1176 | | (member(ID,Vars1) -> C1=[b(E,pred,Info)], C2=[] ; C1=[], C2=[b(E,pred,Info)]). |
| 1177 | | |
| 1178 | | unique_id_comparison(less(b(L,_,_),b(R,_,_)), ID) :- unique_id_comparison_aux(L,R,ID). |
| 1179 | | unique_id_comparison(less_equal(b(L,_,_),b(R,_,_)), ID) :- unique_id_comparison_aux(L,R,ID). |
| 1180 | | unique_id_comparison(greater(b(L,_,_),b(R,_,_)), ID) :- unique_id_comparison_aux(L,R,ID). |
| 1181 | | unique_id_comparison(greater_equal(b(L,_,_),b(R,_,_)), ID) :- unique_id_comparison_aux(L,R,ID). |
| 1182 | | unique_id_comparison(member(b(identifier(ID),_,_),b(V,_,_)), ID) :- explicit_value(V). |
| 1183 | | unique_id_comparison(subset(b(identifier(ID),_,_),b(V,_,_)), ID) :- explicit_value(V). |
| 1184 | | unique_id_comparison(equal(b(L,_,_),b(R,_,_)), ID) :- unique_id_comparison_aux(L,R,ID). % means we also detect something like %x.(x : INTEGER|0) as cartesian product |
| 1185 | | % what about not_equal |
| 1186 | | |
| 1187 | | unique_id_comparison_aux(identifier(ID),V,ID) :- !,explicit_value(V). |
| 1188 | | unique_id_comparison_aux(V,identifier(ID),ID) :- explicit_value(V). |
| 1189 | | |
| 1190 | | explicit_value(value(_)) :- !. |
| 1191 | | explicit_value(integer(_)) :- !. |
| 1192 | | explicit_value(unary_minus(TV)) :- !, explicit_tvalue(TV). |
| 1193 | | explicit_value(interval(TV1,TV2)) :- !, |
| 1194 | | explicit_tvalue(TV1), explicit_tvalue(TV2). |
| 1195 | | %explicit_value(seq(B)) :- !, explicit_tvalue(B). % are encoded as values by b_compile |
| 1196 | | %explicit_value(seq1(B)) :- !, explicit_tvalue(B). |
| 1197 | | %explicit_value(iseq(B)) :- !, explicit_tvalue(B). |
| 1198 | | %explicit_value(iseq1(B)) :- !, explicit_tvalue(B). |
| 1199 | | %explicit_value(struct(B)) :- !, explicit_tvalue(B). |
| 1200 | | %explicit_value(rec(Fields)) :- !, explicit_tfields(Fields). |
| 1201 | | explicit_value(total_bijection(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). % see test 1897 for cases below |
| 1202 | | explicit_value(total_injection(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1203 | | explicit_value(total_function(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1204 | | explicit_value(total_surjection(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1205 | | explicit_value(partial_function(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1206 | | explicit_value(partial_injection(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1207 | | explicit_value(partial_surjection(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1208 | | explicit_value(relations(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1209 | | explicit_value(total_relation(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1210 | | explicit_value(surjection_relation(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1211 | | explicit_value(total_surjection_relation(A,B)) :- !, explicit_tvalue(A),explicit_tvalue(B). |
| 1212 | | explicit_value(real_set) :- !. |
| 1213 | | explicit_value(string_set) :- !. |
| 1214 | | |
| 1215 | | explicit_tvalue(b(B,_,_)) :- !, explicit_value(B). |
| 1216 | | |
| 1217 | | %explicit_tfields(V) :- var(V),!,fail. |
| 1218 | | %explicit_tfields([]). |
| 1219 | | %explicit_tfields([field(N,V)|T]) :- ground(N),explicit_tvalue(V),explicit_tfields(T). |
| 1220 | | |
| 1221 | | % conjunct_predicates([CA1,CB1],C1), |
| 1222 | | % conjunct_predicates([CA2,CB2],C2). |
| 1223 | | |
| 1224 | | /* ********* |
| 1225 | | is_cartesian_product_body(conjunct(A,B),ID1,ID2,_T1,_T2,SET1,SET2) :- !, |
| 1226 | | member_pred_value(A,CID1,CSET1), |
| 1227 | | member_pred_value(B,CID2,CSET2), |
| 1228 | | (ID1=CID1,ID2=CID2,SET1=CSET1,SET2=CSET2 ; ID1=CID2,ID2=CID1,SET1=CSET2,SET2=CSET1). |
| 1229 | | is_cartesian_product_body(A,ID1,ID2,T1,T2,SET1,SET2) :- |
| 1230 | | member_pred_value2(A,AID,ASET), |
| 1231 | | ( AID=ID1 -> SET1=ASET, construct_closure_if_necessary([ID2],[T2],b(truth,pred,[]),SET2) |
| 1232 | | ; AID=ID2 -> SET2=ASET, construct_closure_if_necessary([ID1],[T1],b(truth,pred,[]),SET1)). |
| 1233 | | |
| 1234 | | member_pred_value(b(B,pred,_), ID,VAL) :- print(member_pred_value2(B,ID,VAL)),nl, |
| 1235 | | member_pred_value2(B,ID,VAL). |
| 1236 | | member_pred_value2(member(b(identifier(ID),_CT1,_),b(value(VAL),_SCT1,_)), ID,VAL). %_SCT1 = set(CT1) |
| 1237 | | */ |
| 1238 | | |
| 1239 | | % check if we have POW(SET1) or SET1<->SET2 (equiv. to POW(SET1*SET2)) |
| 1240 | | is_full_powerset_or_relations_or_struct_closure(closure(Par,Typ,Body),SUBSETS) :- |
| 1241 | | %TYPE = set(T), |
| 1242 | | is_member_closure(Par,Typ,Body,TYPE,SET), |
| 1243 | | is_full_powset_aux(SET,TYPE,SUBSETS). |
| 1244 | | |
| 1245 | | :- use_module(library(lists),[maplist/3, maplist/4]). |
| 1246 | | is_full_powset_aux(pow_subset(b(value(SET1),set(T1),_)),set(T1),[SET1]). |
| 1247 | | is_full_powset_aux(relations(S1,S2),set(couple(T1,T2)),[SET1,SET2]) :- |
| 1248 | | S1 = b(value(SET1),set(T1),_), S2 = b(value(SET2),set(T2),_). |
| 1249 | | is_full_powset_aux(struct(b(value(rec(FIELDS)),record(_),_)),record(_),FieldValueSets) :- |
| 1250 | | maplist(get_field_val,FIELDS,FieldValueSets). |
| 1251 | | |
| 1252 | | get_field_val(field(_,Val),Val). |
| 1253 | | |
| 1254 | | %[field(duration,global_set('INTEGER')),field(rhythm,global_set('INTEGER')),field(slot,avl_set(...))] |
| 1255 | | |
| 1256 | | is_powerset_closure(closure(Par,Typ,Body),PType,Subset) :- |
| 1257 | ? | is_set_type(TYPE,T), |
| 1258 | | is_member_closure(Par,Typ,Body,TYPE,SET), |
| 1259 | | nonvar(SET), |
| 1260 | | is_powset_aux(SET,PType,b(VS,set(T),_)) , |
| 1261 | | nonvar(VS), VS = value(Subset). %,print(powerset(Subset)),nl. |
| 1262 | | is_powset_aux(pow_subset(A),pow,A). |
| 1263 | | is_powset_aux(pow1_subset(A),pow1,A). |
| 1264 | | is_powset_aux(fin_subset(A),fin,A). |
| 1265 | | is_powset_aux(fin1_subset(A),fin1,A). |
| 1266 | | |
| 1267 | | % group together closures which can be treated like cartesian products in the sense that: |
| 1268 | | % Closure is empty if either Set1 or Set2 (could also be empty in other conditions though) |
| 1269 | | % Closure is subset of other Closure if same Constructor and both sets are subsets |
| 1270 | | /* is_cartesian_product_like_closure(Closure,Constructor,Set1,Set2) :- |
| 1271 | | is_cartesian_product_closure(Closure,S11,S12),!, |
| 1272 | | Constructor = cartesian_product,Set1=S11,Set2=S12. |
| 1273 | | is_cartesian_product_like_closure(closure(Par,Typ,Body),Constructor,Set1,Set2) :- |
| 1274 | | is_member_closure(Par,Typ,Body,TYPE,SET), |
| 1275 | | is_cart_like_relation(SET,Constructor,b(value(Set1),set(_T1),_), b(value(Set1),set(_T2),_)). |
| 1276 | | is_cart_like_relation(relations(A,B),relations,A,B). |
| 1277 | | is_cart_like_relation(partial_function(A,B),partial_function,A,B). |
| 1278 | | is_cart_like_relation(partial_injection(A,B),partial_injection,A,B). */ |
| 1279 | | |
| 1280 | | % (closure([_zzzz_unary],[set(couple(integer,string))],b(member(b(identifier(_zzzz_unary),set(couple(integer,string)),[]),b(relations(b(value(global_set(INTEGER)),set(integer),[]),b(value(global_set(STRING)),set(string),[])),set(set(couple(integer,string))),[])),pred,[]))) |
| 1281 | | % 1 1 Fail: custom_explicit_sets:is_powset_aux(relations(b(value(global_set('INTEGER')),set(integer),[]),b(value(global_set('STRING')),set(string),[])),couple(integer,string),_19584) ? |
| 1282 | | |
| 1283 | | % card_for_specific_custom_set(+Set,-Cardinality,-CodeToComputeCardinality) |
| 1284 | | % succeeds if card can be computed efficiently |
| 1285 | | card_for_specific_custom_set(CS,C,Cd) :- var(CS),!, |
| 1286 | | add_internal_error('Internal error: var ',card_for_specific_custom_set(CS,C,Cd)),fail. |
| 1287 | | card_for_specific_custom_set(global_set(GS),Card,true) :- !, b_global_set_cardinality(GS,Card). |
| 1288 | | card_for_specific_custom_set(freetype(Id),Card,true) :- !, freetype_cardinality(Id,Card). |
| 1289 | | card_for_specific_custom_set(avl_set(S),Card,true) :- !,avl_size(S,Card). |
| 1290 | | card_for_specific_custom_set(closure(P,T,B),Card,CodeToComputeCard) :- |
| 1291 | | card_for_specific_closure3(_,P,T,B,Card,CodeToComputeCard). |
| 1292 | | |
| 1293 | | card_for_specific_closure(closure(P,T,Pred),Card,CodeToComputeCard) :- |
| 1294 | | card_for_specific_closure3(_ClosureKind,P,T,Pred,Card,CodeToComputeCard). |
| 1295 | | card_for_specific_closure(closure(P,T,Pred),ClosureKind,Card,CodeToComputeCard) :- |
| 1296 | | card_for_specific_closure3(ClosureKind,P,T,Pred,Card,CodeToComputeCard). |
| 1297 | | |
| 1298 | | :- use_module(btypechecker,[couplise_list/2]). |
| 1299 | | :- use_module(bsyntaxtree,[is_truth/1]). |
| 1300 | | card_for_specific_closure2(Par,Typ,Body, Card,Code) :- |
| 1301 | | card_for_specific_closure3(_ClosureKind,Par,Typ,Body, Card,Code). |
| 1302 | | |
| 1303 | | % first argument for debugging purposes or filtering |
| 1304 | | card_for_specific_closure3(special_closure,Par,Typ,Body, Card,Code) :- |
| 1305 | | is_special_infinite_closure(Par,Typ,Body),!,Card=inf, Code=true. |
| 1306 | | card_for_specific_closure3(truth_closure,_,Types,Body,Card,Code) :- is_truth(Body),!, |
| 1307 | | % TO DO: also treat multiple parameters |
| 1308 | | couplise_list(Types,Type), |
| 1309 | | Code=kernel_objects:max_cardinality(Type,Card). |
| 1310 | | card_for_specific_closure3(interval_closure,Par,Typ,Body, Card,Code) :- |
| 1311 | ? | is_geq_leq_interval_closure(Par,Typ,Body,Low,Up), !, |
| 1312 | | card_of_interval_inf(Low,Up,Card), |
| 1313 | | Code=true. % should we return card_of_interval_inf as code ? |
| 1314 | | % TO DO: deal with non-infinite not_member_closures, prj1, prj2, id, ... |
| 1315 | | card_for_specific_closure3(lambda_closure,Par,Typ,Body, Card,Code) :- |
| 1316 | | is_lambda_value_domain_closure(Par,Typ,Body, DomainValue,_Expr),!, nonvar(DomainValue), |
| 1317 | | efficient_card_for_set(DomainValue,Card,Code). |
| 1318 | | card_for_specific_closure3(cartesian_product,Par,Typ,Body, Card,Code) :- |
| 1319 | | is_cartesian_product_closure_aux(Par,Typ,Body,A1,A2),!, nonvar(A1), nonvar(A2), |
| 1320 | | efficient_card_for_set(A1,Card1,Code1), |
| 1321 | | efficient_card_for_set(A2,Card2,Code2), |
| 1322 | | Code = (Code1,Code2, custom_explicit_sets:blocking_safe_mul(Card1,Card2,Card)). |
| 1323 | | card_for_specific_closure3(member_closure,Par,Typ,Body, Card,Code) :- |
| 1324 | | is_member_closure(Par,Typ,Body,TYPE,SET), |
| 1325 | | nonvar(SET),!, |
| 1326 | | card_for_member_closure(SET,TYPE,Card,Code). |
| 1327 | | % Note: _ExprInfo could have: contains_wd_condition, |
| 1328 | | % but if lambda is well-defined we compute the correct card ; if not then card is not well-defined anyway |
| 1329 | | % maybe we should check contains_wd_condition produce a warning msg ? |
| 1330 | | |
| 1331 | | % inner values can sometimes be a list, e.g., [pred_true,pred_false] for BOOL |
| 1332 | | efficient_card_for_set(VAR,_,_) :- var(VAR),!,fail. |
| 1333 | | efficient_card_for_set([],Card,Code) :- !, Card=0,Code=true. |
| 1334 | | efficient_card_for_set([_|T],Card,Code) :- known_length(T,1,C), !, Card = C, Code=true. |
| 1335 | | efficient_card_for_set(CS,Card,Code) :- card_for_specific_custom_set(CS,Card,Code). |
| 1336 | | known_length(X,_,_) :- var(X),!,fail. |
| 1337 | | known_length([],A,A). |
| 1338 | | known_length([_|T],A,R) :- A1 is A+1, known_length(T,A1,R). |
| 1339 | | known_length(avl_set(S),Acc,Res) :- avl_size(S,Card), |
| 1340 | | Res is Acc+Card. |
| 1341 | | % TO DO: also support closures |
| 1342 | | |
| 1343 | | card_for_member_closure(parallel_product(b(value(A1),ST1,_),b(value(A2),ST1,_)),_T,Card,CodeToComputeCard) :- !, |
| 1344 | | nonvar(A1), nonvar(A2), |
| 1345 | | efficient_card_for_set(A1,Card1,Code1), |
| 1346 | | CodeToComputeCard = (Code1,Code2, custom_explicit_sets:blocking_safe_mul(Card1,Card2,Card)), |
| 1347 | | % cardinality computed like for cartesian_product. |
| 1348 | | efficient_card_for_set(A2,Card2,Code2). |
| 1349 | | card_for_member_closure(seq(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=seq(T1) */ |
| 1350 | | is_set_type(ST1,_T1), |
| 1351 | | CodeToComputeCard = custom_explicit_sets:seq_card(SET1,Card). |
| 1352 | | card_for_member_closure(seq1(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=seq1(T1) */ |
| 1353 | | is_set_type(ST1,_T1), |
| 1354 | | CodeToComputeCard = custom_explicit_sets:seq1_card(SET1,Card). |
| 1355 | | card_for_member_closure(perm(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=perm(T1) */ |
| 1356 | | is_set_type(ST1,_T1), |
| 1357 | | CodeToComputeCard = (kernel_objects:cardinality_as_int(SET1,int(SCard)), |
| 1358 | | custom_explicit_sets:blocking_factorial(SCard,Card)). |
| 1359 | | card_for_member_closure(iseq(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=iseq(T1) */ |
| 1360 | | is_set_type(ST1,_T1), |
| 1361 | | CodeToComputeCard = (kernel_objects:cardinality_as_int(SET1,int(SCard)), |
| 1362 | | kernel_card_arithmetic:blocking_nr_iseq(SCard,Card)). |
| 1363 | | card_for_member_closure(iseq1(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=iseq1(T1) */ |
| 1364 | | is_set_type(ST1,_T1), |
| 1365 | | CodeToComputeCard = (kernel_objects:cardinality_as_int(SET1,int(SCard)), |
| 1366 | | kernel_card_arithmetic:blocking_nr_iseq1(SCard,Card)). |
| 1367 | | card_for_member_closure(identity(b(value(SET1),ST1,_)),_SEQT,Card,CodeToComputeCard) :- !, /* _SEQT=id(T1) */ |
| 1368 | | is_set_type(ST1,_T1), |
| 1369 | | CodeToComputeCard = |
| 1370 | | kernel_objects:cardinality_as_int(SET1,int(Card)). |
| 1371 | | card_for_member_closure(struct(b(RecVal,record(_FieldSetTypes),_)), record(_FieldTypes), % set of records |
| 1372 | | Card,CodeToComputeCard) :- |
| 1373 | | !, |
| 1374 | | (RecVal=value(RECF), nonvar(RECF), RECF=rec(FIELDS) % value has been computed: |
| 1375 | | -> CodeToComputeCard = custom_explicit_sets:get_field_cardinality(FIELDS,Card) |
| 1376 | | ; RecVal = rec(TypedFields), % we still have a typed AST |
| 1377 | | maplist(get_field_val_type,TypedFields,Exprs,Types), |
| 1378 | | l_card_for_member_closure(Exprs,Types,Card, CodeToComputeCard) |
| 1379 | | ). |
| 1380 | | % now dealt with separately above: card_for_member_closure(cartesian_product(b(value(SET1),set(T1),_), b(value(SET2),set(T2),_)), |
| 1381 | | % couple(T1,T2), Card,CodeToComputeCard) :- !, |
| 1382 | | % CodeToComputeCard = |
| 1383 | | % (kernel_objects:cardinality_as_int(SET1,int(SCard1)), |
| 1384 | | % kernel_objects:cardinality_as_int(SET2,int(SCard2)), |
| 1385 | | % custom_explicit_sets:blocking_safe_mul(SCard1,SCard2,Card) ). |
| 1386 | | card_for_member_closure(POW,TYPE, Card,CodeToComputeCard) :- |
| 1387 | | (POW = pow_subset(b(value(SET),TYPE,_)) ; |
| 1388 | | POW = fin_subset(b(value(SET),TYPE,_))),!, |
| 1389 | | CodeToComputeCard = |
| 1390 | | (kernel_objects:cardinality_as_int(SET,int(SCard)), |
| 1391 | | custom_explicit_sets:blocking_safe_pow2(SCard,Card) |
| 1392 | | ). |
| 1393 | | card_for_member_closure(POW,TYPE, Card,CodeToComputeCard) :- |
| 1394 | | (POW = pow1_subset(b(value(SET),TYPE,_)) ; |
| 1395 | | POW = fin1_subset(b(value(SET),TYPE,_))),!, |
| 1396 | | CodeToComputeCard = |
| 1397 | | (kernel_objects:cardinality_as_int(SET,int(SCard)), |
| 1398 | | custom_explicit_sets:blocking_safe_pow2(SCard,C1), |
| 1399 | | custom_explicit_sets:safe_dec(C1,Card) |
| 1400 | | ). |
| 1401 | | card_for_member_closure(RELEXPR,SType, Card,CodeToComputeCard) :- |
| 1402 | | is_set_type(SType,couple(T1,T2)), |
| 1403 | | is_a_relation(RELEXPR, b(value(DOM),set(T1),_), |
| 1404 | | b(value(RAN),set(T2),_), DCard,RCard,Card,RELCODE),!, |
| 1405 | | CodeToComputeCard = |
| 1406 | | ( |
| 1407 | | kernel_objects:cardinality_as_int(DOM,int(DCard)), |
| 1408 | | kernel_objects:cardinality_as_int(RAN,int(RCard)), |
| 1409 | | custom_explicit_sets:call_card_for_relations(DCard,RCard,RELCODE) |
| 1410 | | ). |
| 1411 | | card_for_member_closure(BODY, integer, Card,CodeToComputeCard) :- |
| 1412 | | is_interval_with_integer_bounds(BODY,Low,Up),!, |
| 1413 | | CodeToComputeCard = custom_explicit_sets:card_of_interval_inf(Low,Up,Card). |
| 1414 | | card_for_member_closure(value(Value), _Type, Card,CodeToComputeCard) :- |
| 1415 | | % we have a closure of the type {x|x:S}; equivalent to S |
| 1416 | | (nonvar(Value), |
| 1417 | | Value=closure(P,T,B) |
| 1418 | | -> % cardinality_as_int may expand it ! is bad if e.g. we called this code to check if a closure is infinite |
| 1419 | | card_for_specific_closure2(P,T,B,Card,CodeToComputeCard) % will not expand, but fail if cannot be computed |
| 1420 | | % TO DO: provide an argument: precise_or_efficient |
| 1421 | | ; CodeToComputeCard = kernel_objects:cardinality_as_int(Value,int(Card)) |
| 1422 | | ). |
| 1423 | | %card_for_member_closure(BODY, Type, Card,CodeToComputeCard) :- print(try_card(BODY,Type)),nl,fail. |
| 1424 | | % TO DO: add maybe other common closures ? simple value closure |
| 1425 | | % also: what if subexpressions are not of value() type ? |
| 1426 | | |
| 1427 | | :- public call_card_for_relations/3. |
| 1428 | | :- block call_card_for_relations(-,?,?), call_card_for_relations(?,-,?). |
| 1429 | | call_card_for_relations(_,_,RELCODE) :- call(RELCODE). |
| 1430 | | |
| 1431 | | get_field_val_type(field(_F1,b(Expr1,Type1,_)),Expr1,Type1). |
| 1432 | | |
| 1433 | | l_card_for_member_closure([Expr1],[Type1],Card,CodeToComputeCard) :- !, |
| 1434 | | card_for_member_closure(Expr1,Type1,Card, CodeToComputeCard). |
| 1435 | | l_card_for_member_closure([Expr1|ET],[Type1|TT],Card,CodeToComputeCard) :- |
| 1436 | | CodeToComputeCard = (Code1,Code2, custom_explicit_sets:blocking_safe_mul(Card1,Card2,Card)), |
| 1437 | | card_for_member_closure(Expr1,Type1,Card1, Code1), |
| 1438 | | l_card_for_member_closure(ET,TT,Card2,Code2). |
| 1439 | | |
| 1440 | | :- public safe_dec/2. % used in card_for_member_closure |
| 1441 | | :- block safe_dec(-,?). |
| 1442 | | safe_dec(inf,R) :- !, R=inf. |
| 1443 | | safe_dec(inf_overflow,R) :- !, R=inf_overflow. |
| 1444 | | safe_dec(X,R) :- R is X-1. |
| 1445 | | |
| 1446 | | :- use_module(kernel_equality,[empty_set_test/2]). |
| 1447 | | :- public seq_card/2. % used in card_for_member_closure |
| 1448 | | :- block seq_card(-,?). |
| 1449 | | seq_card([],R) :- !,R=1. |
| 1450 | | seq_card([_|_],R) :- !,R=inf. |
| 1451 | | seq_card(X,Res) :- empty_set_test(X,EqRes), |
| 1452 | | set_card(EqRes,1,Res). |
| 1453 | | |
| 1454 | | :- block set_card(-,?,?). |
| 1455 | | set_card(pred_true,Nr,Nr). |
| 1456 | | set_card(pred_false,_,inf). |
| 1457 | | % card(seq({n|n>10 & (n mod 20=3 & n mod 20 = 4) })) |
| 1458 | | |
| 1459 | | :- public seq1_card/2. % used in card_for_member_closure |
| 1460 | | :- block seq1_card(-,?). |
| 1461 | | seq1_card([],R) :- !,R=0. |
| 1462 | | seq1_card([_|_],R) :- !,R=inf. |
| 1463 | | seq1_card(X,Res) :- empty_set_test(X,EqRes), set_card(EqRes,0,Res). |
| 1464 | | |
| 1465 | | :- public get_field_cardinality/2. % used in card_for_member_closure |
| 1466 | | get_field_cardinality([],1). |
| 1467 | | get_field_cardinality([field(_Name,Value)|T],ResCard) :- |
| 1468 | | kernel_objects:cardinality_as_int(Value,int(SCard1)), |
| 1469 | | get_field_cardinality(T,RestCard), blocking_safe_mul(SCard1,RestCard,ResCard). |
| 1470 | | |
| 1471 | | :- use_module(kernel_card_arithmetic). |
| 1472 | | |
| 1473 | | :- block blocking_safe_mul(-,-,?). |
| 1474 | | blocking_safe_mul(A,B,R) :- |
| 1475 | | ( A==0 -> R=0 |
| 1476 | | ; B==0 -> R=0 |
| 1477 | | ; A==1 -> R=B |
| 1478 | | ; B==1 -> R=A |
| 1479 | | ; blocking_safe_mul2(A,B,R) ). |
| 1480 | | |
| 1481 | | :- block blocking_safe_mul2(-,?,?), blocking_safe_mul2(?,-,?). |
| 1482 | | blocking_safe_mul2(A,B,Res) :- |
| 1483 | | (safe_mul(A,B,AB) -> Res=AB |
| 1484 | | ; add_warning(blocking_safe_mul2,'Call failed: ',blocking_safe_mul2(A,B,Res)), |
| 1485 | | % could happen for something like prj2(BOOL,NAT) = prj2(BOOL,0..n) |
| 1486 | | fail). |
| 1487 | | |
| 1488 | | :- public blocking_safe_pow2/2. % used in card_for_member_closure above |
| 1489 | | :- block blocking_safe_pow2(-,?). |
| 1490 | | blocking_safe_pow2(A,Res) :- |
| 1491 | | (safe_pow2(A,A2) -> Res=A2 |
| 1492 | | ; add_warning(blocking_safe_pow2,'Call failed: ',safe_pow2(A,Res)),fail). |
| 1493 | | |
| 1494 | | |
| 1495 | | |
| 1496 | | |
| 1497 | | :- assert_must_succeed((custom_explicit_sets:card_for_specific_closure2(['_zzzz_binary'],[integer], |
| 1498 | | b(member(b(identifier('_zzzz_binary'),integer,[generated]), |
| 1499 | | b(interval(b(value(int(1)),integer,[]),b(value(int(10)),integer,[])),set(integer),[])),pred,[]),R,C), |
| 1500 | | call(C), |
| 1501 | | R=10)). |
| 1502 | | |
| 1503 | | %! is_interval_closure_or_integerset(+I,-L,-U) |
| 1504 | | is_interval_closure_or_integerset(Var,_,_) :- var(Var),!,fail. |
| 1505 | | is_interval_closure_or_integerset(global_set(X),Low,Up) :- !, get_integer_set_interval(X,Low,Up). |
| 1506 | | is_interval_closure_or_integerset(Set,El,El) :- singleton_set(Set,ELX), |
| 1507 | | nonvar(ELX), ELX=int(El),!. % new, useful?? |
| 1508 | | is_interval_closure_or_integerset(closure(P,T,B),Low,Up) :- |
| 1509 | ? | (is_geq_leq_interval_closure(P,T,B,Low,Up) -> true ; is_interval_closure(P,T,B,Low,Up)). |
| 1510 | | |
| 1511 | | |
| 1512 | | get_integer_set_interval('NAT',0,MAXINT) :- (preferences:preference(maxint,MAXINT)->true). |
| 1513 | | get_integer_set_interval('NAT1',1,MAXINT) :- (preferences:preference(maxint,MAXINT)->true). |
| 1514 | | get_integer_set_interval('INT',MININT,MAXINT) :- |
| 1515 | | ((preferences:preference(maxint,MAXINT),preferences:preference(minint,MININT))->true). |
| 1516 | | get_integer_set_interval('NATURAL',0,inf). |
| 1517 | | get_integer_set_interval('NATURAL1',1,inf). |
| 1518 | | get_integer_set_interval('INTEGER',minus_inf,inf). |
| 1519 | | % TO DO: add minus_inf to kernel_objects ! |
| 1520 | | |
| 1521 | | :- block geq_inf(-,?), geq_inf(?,-). |
| 1522 | | geq_inf(inf,_) :- !. |
| 1523 | | geq_inf(minus_inf,B) :- !, B=minus_inf. |
| 1524 | | geq_inf(_,minus_inf) :- !. |
| 1525 | | geq_inf(A,inf) :- !, A=inf. |
| 1526 | | geq_inf(inf_overflow,_) :- !. |
| 1527 | | geq_inf(A,inf_overflow) :- !, A=inf_overflow. |
| 1528 | | geq_inf(A,B) :- A >= B. |
| 1529 | | |
| 1530 | | :- block minimum_with_inf(-,-,?). |
| 1531 | | % in the first three cases we can determine outcome without knowing both args |
| 1532 | | minimum_with_inf(A,B,R) :- (A==minus_inf ; B==minus_inf),!,R=minus_inf. |
| 1533 | | minimum_with_inf(A,B,R) :- A==inf,!,R=B. |
| 1534 | | minimum_with_inf(A,B,R) :- B==inf,!,R=A. |
| 1535 | | minimum_with_inf(A,B,R) :- minimum_with_inf1(A,B,R), geq_inf(A,R), geq_inf(B,R). |
| 1536 | | :- block minimum_with_inf1(-,?,?), minimum_with_inf1(?,-,?). |
| 1537 | | minimum_with_inf1(minus_inf,_,R) :- !, R=minus_inf. |
| 1538 | | minimum_with_inf1(_,minus_inf,R) :- !, R=minus_inf. |
| 1539 | | minimum_with_inf1(inf,B,R) :- !, R=B. |
| 1540 | | minimum_with_inf1(A,inf,R) :- !, R=A. |
| 1541 | | minimum_with_inf1(inf_overflow,B,R) :- !, R=B. |
| 1542 | | minimum_with_inf1(A,inf_overflow,R) :- !, R=A. |
| 1543 | | minimum_with_inf1(A,B,R) :- (A<B -> R=A ; R=B). |
| 1544 | | |
| 1545 | | :- block maximum_with_inf(-,-,?). |
| 1546 | | % in the first three cases we can determine outcome without knowing both args |
| 1547 | | maximum_with_inf(A,B,R) :- (A==inf ; B==inf),!,R=inf. |
| 1548 | | maximum_with_inf(A,B,R) :- A==minus_inf,!,R=B. |
| 1549 | | maximum_with_inf(A,B,R) :- B==minus_inf,!,R=A. |
| 1550 | | maximum_with_inf(A,B,R) :- maximum_with_inf1(A,B,R), geq_inf(R,A), geq_inf(R,B). |
| 1551 | | :- block maximum_with_inf1(-,?,?), maximum_with_inf1(?,-,?). |
| 1552 | | maximum_with_inf1(inf,_,R) :- !, R=inf. |
| 1553 | | maximum_with_inf1(_,inf,R) :- !, R=inf. |
| 1554 | | maximum_with_inf1(minus_inf,B,R) :- !, R=B. |
| 1555 | | maximum_with_inf1(A,minus_inf,R) :- !, R=A. |
| 1556 | | maximum_with_inf1(inf_overflow,_,R) :- !, R=inf_overflow. |
| 1557 | | maximum_with_inf1(_,inf_overflow,R) :- !, R=inf_overflow. |
| 1558 | | maximum_with_inf1(A,B,R) :- (A>B -> R=A ; R=B). |
| 1559 | | |
| 1560 | | /* utilities for detecting interval closures */ |
| 1561 | | construct_interval_closure(Low,Up,Res) :- (Low==inf;Up==minus_inf),!,Res=[]. |
| 1562 | | construct_interval_closure(Low,Up,Res) :- number(Low),number(Up), Low>Up,!,Res=[]. |
| 1563 | | construct_interval_closure(Low,Up,Res) :- Up==inf,!, |
| 1564 | | ( Low==0 -> Res = global_set('NATURAL') |
| 1565 | | ; Low==1 -> Res = global_set('NATURAL1') |
| 1566 | | ; Low==minus_inf -> Res = global_set('INTEGER') |
| 1567 | | ; Low==inf -> Res = [] |
| 1568 | | ; construct_greater_equal_closure(Low,Res) |
| 1569 | | ). |
| 1570 | | construct_interval_closure(Low,Up,Res) :- Low==minus_inf,!, |
| 1571 | | construct_less_equal_closure(Up,Res). |
| 1572 | | construct_interval_closure(Low,Up,Res) :- Low==Up,!, |
| 1573 | | (number(Low) -> construct_one_element_custom_set(int(Low),Res) |
| 1574 | | ; Res = [int(Low)]). |
| 1575 | | construct_interval_closure(Low,Up,Res) :- |
| 1576 | | construct_interval_set(Low,Up,Set), |
| 1577 | | construct_member_closure('_zzzz_unary',integer,[],Set,Res). |
| 1578 | | |
| 1579 | | transform_global_sets_into_closure(closure(P,T,B),closure(P,T,B)). |
| 1580 | | transform_global_sets_into_closure(global_set(X),Res) :- |
| 1581 | | transform_global_set_into_closure_aux(X,Res). |
| 1582 | | transform_global_set_into_closure_aux('NATURAL',Res) :- |
| 1583 | | construct_greater_equal_closure(0,Res). |
| 1584 | | transform_global_set_into_closure_aux('NATURAL1',Res) :- |
| 1585 | | construct_greater_equal_closure(1,Res). |
| 1586 | | % TO DO: add INTEGER |
| 1587 | | |
| 1588 | | |
| 1589 | | |
| 1590 | | is_geq_leq_interval_closure([Par],[integer],b(Body,pred,Span),Low,Up) :- |
| 1591 | | (var(Par) |
| 1592 | | -> add_internal_error('Non-ground closure: ',closure([Par],[integer],b(Body,pred,Span))),fail |
| 1593 | ? | ; get_geq_leq_bounds(Body,Par,Low,Up)). |
| 1594 | | |
| 1595 | | infinite_interval(Low,Up) :- (Low==minus_inf -> true ; Up==inf). |
| 1596 | | |
| 1597 | | :- assert_must_succeed((card_of_interval_inf(1,10,10))). |
| 1598 | | :- assert_must_succeed((card_of_interval_inf(1,inf,R),R==inf)). |
| 1599 | | :- assert_must_succeed((card_of_interval_inf(minus_inf,0,R),R==inf)). |
| 1600 | | :- assert_must_succeed((card_of_interval_inf(2,2,R), R==1)). |
| 1601 | | :- assert_must_succeed((card_of_interval_inf(12,2,R), R==0)). |
| 1602 | | :- assert_must_succeed((card_of_interval_inf(2,B,10), B==11)). |
| 1603 | | :- assert_must_succeed((card_of_interval_inf(A,12,10), A==3)). |
| 1604 | | :- assert_must_succeed((card_of_interval_inf(A,12,0), A=222)). |
| 1605 | | :- assert_must_succeed((card_of_interval_inf(12,B,0), B=11)). |
| 1606 | | :- assert_must_fail((card_of_interval_inf(A,12,0), A=12)). |
| 1607 | | % compute cardinality of interval; allow bounds to be inf and minus_inf (but if so, they must be bound straightaway) |
| 1608 | | card_of_interval_inf(A,B,Card) :- |
| 1609 | ? | at_least_two_vars(A,B,Card), % initially this will usually be true, if only one variable we can compute result |
| 1610 | | preferences:preference(use_clpfd_solver,true), |
| 1611 | | !, |
| 1612 | | clpfd_interface:post_constraint(Card #= max(0,1+B-A),custom_explicit_sets:block_card_of_interval_inf(A,B,Card)). |
| 1613 | | card_of_interval_inf(A,B,Card) :- block_card_of_interval_inf(A,B,Card). |
| 1614 | | |
| 1615 | ? | at_least_two_vars(A,B,C) :- var(A),!,(var(B) -> not_infinite_bound(C) ; number(B),var(C)). |
| 1616 | | at_least_two_vars(A,B,C) :- number(A), var(B),var(C). |
| 1617 | | not_infinite_bound(A) :- (var(A) ; number(A)). % inf can only appear immediately, not for variables |
| 1618 | | |
| 1619 | | :- block block_card_of_interval_inf(-,?,-),block_card_of_interval_inf(?,-,-). |
| 1620 | | block_card_of_interval_inf(A,_,Card) :- A==minus_inf,!, Card=inf. |
| 1621 | | block_card_of_interval_inf(_,B,Card) :- B==inf,!, Card=inf. |
| 1622 | | block_card_of_interval_inf(From,To,Card) :- number(From),number(To),!, |
| 1623 | | (From>To -> Card=0 ; Card is (To-From)+1). |
| 1624 | | block_card_of_interval_inf(A,B,C) :- number(C),!, number_card_of_interval_inf_aux(C,A,B). |
| 1625 | | block_card_of_interval_inf(A,B,C) :- C==inf,!, |
| 1626 | | % probably this should systematically fail; if A and B are not inf/minus_inf now they will never be |
| 1627 | | print(infinite_interval_requested(A,B,C)),nl, |
| 1628 | | when((nonvar(A),nonvar(B)), block_card_of_interval_inf(A,B,C)). |
| 1629 | | block_card_of_interval_inf(A,B,C) :- add_internal_error('Illegal call: ',card_of_interval_inf(A,B,C)). |
| 1630 | | :- use_module(inf_arith,[block_inf_greater/2]). |
| 1631 | | number_card_of_interval_inf_aux(0,A,B) :- !, % empty interval |
| 1632 | | % if A and B are variables then they will not become inf later ?? |
| 1633 | | % inf can only be set directly for sets such as {x|x>4} or NATURAL1 |
| 1634 | | (((var(A);number(A)),(var(B);number(B))) |
| 1635 | | % hence we can use ordinary comparison (with CLPFD) here |
| 1636 | | -> kernel_objects:less_than_direct(B,A) |
| 1637 | | % TO DO: we could do this even if both A and B are variables !! ex : {n,m|n..m = {} & m..100={} & 103..n={}} |
| 1638 | | ; block_inf_greater(A,B)). |
| 1639 | | %number_card_of_interval_inf_aux(Card,From,B) :- number(From),!, B is (From+Card)-1. |
| 1640 | | %number_card_of_interval_inf_aux(Card,A,To) :- number(To),!, A is 1+To-Card. |
| 1641 | | number_card_of_interval_inf_aux(Card,A,B) :- |
| 1642 | | Card>0, C1 is Card-1, |
| 1643 | | kernel_objects:int_minus(int(B),int(A),int(C1)). |
| 1644 | | |
| 1645 | | |
| 1646 | | get_geq_leq_bounds(conjunct(b(LEFT,pred,_),b(RIGHT,pred,_)), Par,Low,Up) :- |
| 1647 | ? | get_geq_leq_bounds(LEFT,Par,From1,To1), |
| 1648 | ? | get_geq_leq_bounds(RIGHT,Par,From2,To2), |
| 1649 | | intersect_intervals_with_inf(From1,To1,From2,To2,Low,Up). |
| 1650 | | get_geq_leq_bounds(member(b(identifier(Par),integer,_), |
| 1651 | | b(Value,set(integer),_)),Par,Low,Up) :- |
| 1652 | | get_value_bounds(Value,Low,Up). |
| 1653 | ? | get_geq_leq_bounds(greater_equal(b(A,_,_),b(B,_,_)),Par,Low,Up) :- get_bounds2(greater_equal,A,B,Par,Low,Up). |
| 1654 | ? | get_geq_leq_bounds( less_equal(b(A,_,_),b(B,_,_)),Par,Low,Up) :- get_bounds2(less_equal,A,B,Par,Low,Up). |
| 1655 | ? | get_geq_leq_bounds( greater(b(A,_,_),b(B,_,_)),Par,Low,Up) :- get_bounds2(greater,A,B,Par,Low,Up). |
| 1656 | | get_geq_leq_bounds( less(b(A,_,_),b(B,_,_)),Par,Low,Up) :- get_bounds2(less,A,B,Par,Low,Up). |
| 1657 | | |
| 1658 | | get_value_bounds(value(GS),Low,Up) :- is_interval_closure_or_integerset(GS,Low,Up). % recursive call |
| 1659 | | % nonvar(GS), GS=global_set(ISET), get_integer_set_interval(ISET,Low,Up). |
| 1660 | | get_value_bounds(interval(b(TLow,_,_),b(TUp,_,_)),Low,Up) :- |
| 1661 | | integer_value(TLow,Low), |
| 1662 | | integer_value(TUp,Up). |
| 1663 | | |
| 1664 | | get_bounds2(greater_equal,identifier(Par),V,Par,X,inf) :- integer_value(V,X). |
| 1665 | | get_bounds2(greater_equal,V,identifier(Par),Par,minus_inf,X) :- integer_value(V,X). |
| 1666 | | get_bounds2(less_equal,identifier(Par),V,Par,minus_inf,X) :- integer_value(V,X). |
| 1667 | | get_bounds2(less_equal,V,identifier(Par),Par,X,inf) :- integer_value(V,X). |
| 1668 | | get_bounds2(greater,identifier(Par),V,Par,X1,inf) :- integer_value(V,X), kernel_objects:int_plus(int(X),int(1),int(X1)). %, X1 is X+1. |
| 1669 | | get_bounds2(greater,V,identifier(Par),Par,minus_inf,X1) :- integer_value(V,X), kernel_objects:int_minus(int(X),int(1),int(X1)). %X1 is X-1. |
| 1670 | | get_bounds2(less,V,identifier(Par),Par,X1,inf) :- integer_value(V,X), kernel_objects:int_plus(int(X),int(1),int(X1)). %X1 is X+1. |
| 1671 | | get_bounds2(less,identifier(Par),V,Par,minus_inf,X1) :- integer_value(V,X), |
| 1672 | | kernel_objects:int_minus(int(X),int(1),int(X1)). %X1 is X-1. |
| 1673 | | % to do: add negation thereof ?? |
| 1674 | | |
| 1675 | | integer_value(V,_) :- var(V),!, print(var_integer_value(V)),nl,fail. |
| 1676 | | integer_value(integer(X),R) :- !, R=X. |
| 1677 | | integer_value(unary_minus(b(X,_,_)),R) :- !, integer_value(X,RM), |
| 1678 | | number(RM), % if RM is not a number we could setup CLPFD constraint ?! |
| 1679 | | R is -(RM). |
| 1680 | | integer_value(minus(b(X,_,_),b(Y,_,_)),R) :- !, % some AST compilation rules generate X-1, X+1 ... |
| 1681 | | integer_value(X,RMX), |
| 1682 | | integer_value(Y,RMY), |
| 1683 | | kernel_objects:int_minus(int(RMX),int(RMY),int(R)). |
| 1684 | | integer_value(plus(b(X,_,_),b(Y,_,_)),R) :- !, % some AST compilation rules generate X-1, X+1 ... |
| 1685 | | integer_value(X,RMX), |
| 1686 | | integer_value(Y,RMY), |
| 1687 | | kernel_objects:int_plus(int(RMX),int(RMY),int(R)). |
| 1688 | | integer_value(value(V),R) :- !, V=int(R). |
| 1689 | | |
| 1690 | | is_interval_closure(closure(Par,[integer],Pred),Low,Up) :- |
| 1691 | | is_interval_closure_aux(Par,Pred,Low,Up). |
| 1692 | | is_interval_closure(Par,[integer],Pred,Low,Up) :- |
| 1693 | | is_interval_closure_aux(Par,Pred,Low,Up). |
| 1694 | | is_interval_closure_aux(Par,Pred,Low,Up) :- |
| 1695 | | is_member_closure(Par,[integer],Pred,integer,Set), |
| 1696 | | is_interval_with_integer_bounds(Set,Low,Up). |
| 1697 | | %is_interval_closure(closure_x(Par,[integer],Pred,_),Low,Up) :- |
| 1698 | | % is_interval_closure(closure(Par,[integer],Pred),Low,Up). |
| 1699 | | |
| 1700 | | is_interval_closure_body(Body,ID,Low,Up) :- |
| 1701 | | is_member_closure([ID],[integer],Body,integer,Set),!, |
| 1702 | | is_interval_with_integer_bounds(Set,Low,Up). |
| 1703 | | is_interval_closure_body(Body,ID,Low,Up) :- |
| 1704 | ? | is_geq_leq_interval_closure([ID],[integer],Body,Low,Up), |
| 1705 | | number(Low), number(Up). |
| 1706 | | |
| 1707 | | :- use_module(bsyntaxtree,[get_texpr_info/2,get_texpr_id/2]). |
| 1708 | | % do a single check if we have interval, member or not-member closure, avoiding redundant checking |
| 1709 | | % TO DO: move this and related predicates to closures module ? |
| 1710 | | is_special_closure(_Ids,_Types,Pred,Result) :- |
| 1711 | | get_texpr_info(Pred,Info),memberchk(prob_annotation(recursive(RId)),Info),!, |
| 1712 | | Result = recursive_special_closure(RId). |
| 1713 | | is_special_closure(Ids,Types,Pred,Result) :- |
| 1714 | ? | is_memoization_closure(Ids,Types,Pred,MemoID),!, |
| 1715 | | Result = memoization_closure(MemoID). |
| 1716 | | is_special_closure([ID],[TYPE],b(PRED,_,_), Result) :- |
| 1717 | | ( closures:is_member_closure_aux(PRED, ID,TYPE,SET) -> |
| 1718 | | ( (TYPE=integer, is_interval_with_integer_bounds(SET,Low,Up)) -> |
| 1719 | | Result = interval(Low,Up) |
| 1720 | | ; Result = member_closure(ID,TYPE,SET)) |
| 1721 | | ; closures:is_not_member_closure_aux(PRED,ID,TYPE,SET) -> |
| 1722 | | Result = not_member_closure(ID,TYPE,SET) |
| 1723 | ? | ; (TYPE=integer,get_geq_leq_bounds(PRED,ID,Low,Up),number(Low), number(Up)) -> |
| 1724 | | Result = interval(Low,Up) |
| 1725 | | ). |
| 1726 | | |
| 1727 | | |
| 1728 | | construct_interval_set(Low,Up,Res) :- |
| 1729 | | Res = interval(b(value(int(Low)),integer,[]), |
| 1730 | | b(value(int(Up)), integer,[])). |
| 1731 | | is_interval_with_integer_bounds(X,L,U) :- var(X),!, |
| 1732 | | add_internal_error('var arg: ',is_interval_with_integer_bounds(X,L,U)),fail. |
| 1733 | | is_interval_with_integer_bounds(interval(b(TLOW,integer,_),b(TUP, integer,_)),Low,Up) :- |
| 1734 | | integer_value(TLOW,Low), integer_value(TUP,Up). |
| 1735 | | |
| 1736 | | |
| 1737 | | is_a_relation(relations(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '<->' |
| 1738 | | Code = (kernel_card_arithmetic:safe_mul(DCard,RCard,Exp), kernel_card_arithmetic:safe_pow2(Exp,Card)). |
| 1739 | | is_a_relation(partial_function(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '+->' |
| 1740 | | Code = (kernel_card_arithmetic:safe_add_card(RCard,1,R1),kernel_card_arithmetic:safe_pown(R1,DCard,Card)). |
| 1741 | | is_a_relation(total_function(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '-->' |
| 1742 | | Code = (kernel_card_arithmetic:safe_pown(RCard,DCard,Card)). |
| 1743 | | is_a_relation(partial_bijection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '>+>>' |
| 1744 | | Code = (kernel_card_arithmetic:partial_bijection_card(DCard,RCard,Card)). |
| 1745 | | is_a_relation(total_bijection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '>->>' |
| 1746 | | Code = (kernel_card_arithmetic:total_bijection_card(DCard,RCard,Card)). |
| 1747 | | is_a_relation(total_injection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '>->' |
| 1748 | | Code = (kernel_card_arithmetic:blocking_factorial_k(RCard,DCard,Card)). |
| 1749 | | is_a_relation(partial_injection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '>+>' |
| 1750 | | Code = (kernel_card_arithmetic:partial_injection_card(DCard,RCard,Card)). |
| 1751 | | is_a_relation(total_surjection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '-->>' |
| 1752 | | Code = (kernel_card_arithmetic:total_surjection_card(DCard,RCard,Card)). |
| 1753 | | is_a_relation(partial_surjection(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '+->>' |
| 1754 | | Code = (kernel_card_arithmetic:partial_surjection_card(DCard,RCard,Card)). |
| 1755 | | is_a_relation(total_relation(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '<<->' |
| 1756 | | Code = (kernel_card_arithmetic:total_relation_card(DCard,RCard,Card)). |
| 1757 | | is_a_relation(surjection_relation(Domain,Range),Domain,Range,DCard,RCard,Card,Code) :- %% '<->>' |
| 1758 | | % just swap args: card(A<->>B) = card(B<<->A) |
| 1759 | | Code = (kernel_card_arithmetic:total_relation_card(RCard,DCard,Card)). |
| 1760 | | % TO DO: total_surjection_relation <<->> |
| 1761 | | |
| 1762 | | |
| 1763 | | |
| 1764 | | :- use_module(b_global_sets,[infinite_global_set/1]). |
| 1765 | | |
| 1766 | | :- block is_infinite_global_set(-,?). |
| 1767 | | is_infinite_global_set('NATURAL',integer). |
| 1768 | | is_infinite_global_set('NATURAL1',integer). |
| 1769 | | is_infinite_global_set('INTEGER',integer). |
| 1770 | | is_infinite_global_set('FLOAT',real). |
| 1771 | | is_infinite_global_set('REAL',real). |
| 1772 | | is_infinite_global_set('STRING',string). |
| 1773 | | is_infinite_global_set(G,global(G)) :- infinite_global_set(G). |
| 1774 | | |
| 1775 | | %is_finite_integer_global_set('NAT'). |
| 1776 | | %is_finite_integer_global_set('NAT1'). |
| 1777 | | %is_finite_integer_global_set('INT'). |
| 1778 | | |
| 1779 | | % detects (certain) infinite explict sets |
| 1780 | | is_infinite_explicit_set(X) :- var(X),!, add_internal_error(is_infinite_explicit_set,var(X)),fail. |
| 1781 | ? | is_infinite_explicit_set(global_set(X)) :- is_infinite_global_set(X,_). |
| 1782 | | is_infinite_explicit_set(freetype(X)) :- is_infinite_freetype(X). |
| 1783 | | is_infinite_explicit_set(closure(Par,T,Body)) :- is_infinite_closure(Par,T,Body). |
| 1784 | | |
| 1785 | | % detect some closure that we should definitely expand; even in SYMBOLIC mode or for ABSTRACT_CONSTANTS |
| 1786 | | definitely_expand_this_explicit_set(Var) :- var(Var),!,fail. |
| 1787 | | definitely_expand_this_explicit_set(closure(P,_T,B)) :- |
| 1788 | | B = b(Body,_,_), definitely_expand(Body,P). |
| 1789 | | % some lambda functions have small domain, but are very complicated to compute (test 1078, 1376) |
| 1790 | | % hence the following is not sufficient: |
| 1791 | | % ;is_small_specific_custom_set(closure(P,T,B),100), print(exp(T)),nl,translate:print_bexpr(B),nl,fail). |
| 1792 | | |
| 1793 | | definitely_expand(Body,_) :- avl_mem_construct(Body,_). |
| 1794 | | definitely_expand(exists(TEIDS,Body),P) :- P = [ID], TEIDS = [TEID], % TO DO: detect multiple ids |
| 1795 | | % detect {res|#y.(y:AVL & res=Expr(y))} % test 1101 |
| 1796 | | Body = b(conjunct(b(Mem,pred,_),Eq),pred,_), |
| 1797 | | Eq = b(equal(EqA,EqB),pred,_), |
| 1798 | | avl_mem_construct(Mem,LHS), get_texpr_id(LHS,EID), get_texpr_id(TEID,EID), |
| 1799 | | (get_texpr_id(EqA,ID) -> true ; get_texpr_id(EqB,ID)). |
| 1800 | | |
| 1801 | | avl_mem_construct(member(LHS,RHS),LHS) :- RHS = b(value(V),_,_), nonvar(V), V=avl_set(_). |
| 1802 | | |
| 1803 | | dont_expand_this_explicit_set(closure(P,T,B)) :- !, |
| 1804 | ? | dont_expand_this_closure(P,T,B). |
| 1805 | | dont_expand_this_explicit_set(S) :- |
| 1806 | | is_infinite_or_very_large_explicit_set(S). |
| 1807 | | |
| 1808 | | % true if we have a closure / global_set that should not be expanded |
| 1809 | | % TO DO: we could detect finite (is_lambda_value_domain_closure) closures which contain infinite elements such as %p.(p : BOOL|%t.(t : NATURAL|t .. t + 7)) |
| 1810 | | dont_expand_symbolic_explicit_set(closure(P,T,B)) :- !, |
| 1811 | ? | dont_expand_this_closure(P,T,B). |
| 1812 | | dont_expand_symbolic_explicit_set(avl_set(_)) :- !, |
| 1813 | | fail. % already expanded |
| 1814 | | dont_expand_symbolic_explicit_set(S) :- |
| 1815 | | is_infinite_or_very_large_explicit_set(S). |
| 1816 | | |
| 1817 | | |
| 1818 | ? | dont_expand_this_explicit_set(closure(P,T,B),Limit) :- !, dont_expand_this_closure(P,T,B,Limit). |
| 1819 | | dont_expand_this_explicit_set(S,_) :- is_infinite_or_very_large_explicit_set(S). |
| 1820 | | |
| 1821 | ? | dont_expand_this_closure(P,T,B) :- dont_expand_this_closure(P,T,B,20000). |
| 1822 | | |
| 1823 | | dont_expand_this_closure(P,T,B,_Limit) :- |
| 1824 | | is_interval_closure_or_integerset(closure(P,T,B),Low,Up), !, |
| 1825 | | % interval closures are quite efficient for certain manipulations |
| 1826 | | (number(Low), number(Up) |
| 1827 | | -> Size is Up+1-Low, Size>100 % another magic constant ; which value to choose ?? |
| 1828 | | ; true % we have a closure with inf/minus_inf or variables as bounds; in both cases keep the closure |
| 1829 | | ). |
| 1830 | | dont_expand_this_closure(_P,_T,b(_,_,INFO),_Limit) :- |
| 1831 | ? | member(prob_annotation('SYMBOLIC'),INFO). % cf is_symbolic_closure in closures |
| 1832 | | dont_expand_this_closure(P,T,B,Limit) :- |
| 1833 | | is_infinite_or_very_large_closure(P,T,B,Limit). |
| 1834 | | %% TODO: also prevent expansion of things like ff = %x.(x:STRING & REGEX_MATCH(x,"[a-z]+")=TRUE|TRUE) |
| 1835 | | |
| 1836 | | is_converted_lambda_closure(_P,_T,b(_,_,INFO)) :- |
| 1837 | ? | member(prob_annotation('LAMBDA'),INFO). |
| 1838 | | |
| 1839 | | is_symbolic_closure_or_symbolic_mode(P,T,B) :- |
| 1840 | ? | (is_symbolic_closure(P,T,B) -> true |
| 1841 | | ; preference(convert_comprehension_sets_into_closures,true) |
| 1842 | | % by default suppose closures should be dealt with symbolically |
| 1843 | | ). |
| 1844 | | /* |
| 1845 | | % check both LAMBDA + not RECURSIVE |
| 1846 | | is_converted_non_recursive_lambda_closure(_,_,b(_,_,INFO)) :- is_conv_lambda_nonrec(INFO). |
| 1847 | | is_conv_lambda_nonrec([prob_annotation(A)|T]) :- !, |
| 1848 | | (A='LAMBDA' -> \+ memberchk(prob_annotation('RECURSIVE'),T) |
| 1849 | | ; A\='RECURSIVE' -> is_conv_lambda_nonrec(T)). |
| 1850 | | is_conv_lambda_nonrec([_|T]) :- is_conv_lambda_nonrec(T). */ |
| 1851 | | |
| 1852 | | |
| 1853 | | |
| 1854 | | % a set that is so large that expanding it would probably cause problems |
| 1855 | | is_infinite_or_very_large_explicit_set(S) :- is_infinite_or_very_large_explicit_set(S,20000). |
| 1856 | | |
| 1857 | | :- use_module(inf_arith,[infgreater/2]). |
| 1858 | | |
| 1859 | | is_infinite_or_very_large_explicit_set(X,_) :- var(X),!,print(var_is_infinite_check(X)),nl,fail. |
| 1860 | | is_infinite_or_very_large_explicit_set(closure(P,T,B),Limit) :- !, |
| 1861 | | % treat closure separately here; some special rules |
| 1862 | | is_infinite_or_very_large_closure(P,T,B,Limit). |
| 1863 | | is_infinite_or_very_large_explicit_set(avl_set(A),Limit) :- !, % we could compute log and use avl_height_less_than |
| 1864 | | quick_avl_approximate_size(A,Size), Size >= Limit. |
| 1865 | | is_infinite_or_very_large_explicit_set(X,Limit) :- % closures are checked above |
| 1866 | | explicit_set_cardinality(X,Card), |
| 1867 | | nonvar(Card),infgreater(Card,Limit). |
| 1868 | | |
| 1869 | | |
| 1870 | | is_very_large_or_symbolic_closure(P,T,B,Limit) :- |
| 1871 | ? | (is_symbolic_closure(P,T,B) -> true ; is_infinite_or_very_large_closure(P,T,B,Limit)). |
| 1872 | | :- use_module(bsyntaxtree,[is_a_disjunct/3]). |
| 1873 | | is_infinite_or_very_large_closure(P,T,B,Limit) :- |
| 1874 | | is_a_disjunct(B,D1,D2), % Assumption: there is no card_for_specific_closure code for disjuncts |
| 1875 | | !, |
| 1876 | | (is_infinite_or_very_large_closure(P,T,D1,Limit) -> true |
| 1877 | | ; is_infinite_or_very_large_closure(P,T,D2,Limit)). |
| 1878 | | is_infinite_or_very_large_closure(Par,T,Body,Limit) :- |
| 1879 | | is_closure1_value_closure(Par,T,Body,VAL),!, |
| 1880 | | nonvar(VAL), % it could still be large or infinite |
| 1881 | | (Limit>1 -> NLimit is Limit/2 ; NLimit = Limit), % reduce limit as closure1 usually blows up |
| 1882 | | is_infinite_or_very_large_explicit_set(VAL,NLimit). |
| 1883 | | is_infinite_or_very_large_closure(P,T,B,Limit) :- |
| 1884 | | card_for_specific_closure3(Kind,P,T,B,Card,Code), |
| 1885 | ? | on_enumeration_warning(call(Code), |
| 1886 | | (debug_println(9,cannot_expand_specific_closure_for_card(Kind,Limit)), |
| 1887 | | % see test 1519 for relevance |
| 1888 | | Card=inf)), % assume it is large |
| 1889 | | !, |
| 1890 | | nonvar(Card),infgreater(Card,Limit). |
| 1891 | | |
| 1892 | | |
| 1893 | | is_infinite_or_symbolic_closure(P,T,B) :- |
| 1894 | ? | (is_symbolic_closure(P,T,B) -> true ; is_infinite_closure(P,T,B)). |
| 1895 | | is_infinite_closure(P,T,B) :- |
| 1896 | | is_a_disjunct(B,D1,D2), % Assumption: there is no card_for_specific_closure code for disjuncts |
| 1897 | | !, |
| 1898 | | (is_infinite_closure(P,T,D1) -> true ; is_infinite_closure(P,T,D2)). |
| 1899 | | is_infinite_closure(Par,T,Body) :- |
| 1900 | | is_closure1_value_closure(Par,T,Body,VAL),!, % TO DO: also check if closure1 is large this way |
| 1901 | | nonvar(VAL), % if var: it could still be infinite !! TO DO fix |
| 1902 | | is_infinite_explicit_set(VAL). |
| 1903 | | is_infinite_closure(Par,T,Body) :- |
| 1904 | | card_for_specific_closure(closure(Par,T,Body),Card,Code), |
| 1905 | ? | call(Code), % TO DO: catch enumeration exceptions (see is_infinite_or_very_large_closure above) |
| 1906 | | Card == inf. % TODO: instantiate inf before to avoid computing huge numbers |
| 1907 | | |
| 1908 | | |
| 1909 | | :- use_module(memoization,[compute_memo_hash/2, get_stored_memo_expansion/3, store_memo_expansion/3]). |
| 1910 | | /* transitive closure */ |
| 1911 | | closure1_for_explicit_set(avl_set(A),Res) :- |
| 1912 | | preferences:preference(use_closure_expansion_memoization,true),!, |
| 1913 | | compute_memo_hash(closure1_for_explicit_set(A),Hash), |
| 1914 | | (get_stored_memo_expansion(Hash,closure1_for_explicit_set(A),StoredResult) |
| 1915 | | -> Res = StoredResult |
| 1916 | | ; closure1_for_explicit_set_direct(avl_set(A),Result), |
| 1917 | | store_memo_expansion(Hash,closure1_for_explicit_set(A),Result), |
| 1918 | | Res = Result |
| 1919 | | ). |
| 1920 | | closure1_for_explicit_set(avl_set(A),Res) :- closure1_for_explicit_set_direct(avl_set(A),Res). |
| 1921 | | |
| 1922 | | % sometimes faster, but can also be considerably slower: |
| 1923 | | %:- use_module(extrasrc(avl_ugraphs),[avl_transitive_closure/2]). |
| 1924 | | %closure1_for_explicit_set_direct(avl_set(A),Res) :- |
| 1925 | | % avl_transitive_closure(A,TC), |
| 1926 | | % construct_avl_set(TC,Res). |
| 1927 | | closure1_for_explicit_set_direct(avl_set(A),Res) :- |
| 1928 | | avl_domain(A,AList), |
| 1929 | | iterate_closure(AList,A,A,IterationRes), |
| 1930 | | construct_avl_set(IterationRes,Res). |
| 1931 | | |
| 1932 | | /* transitive closure starting from some initial set */ |
| 1933 | | /* not sure if we should do this: |
| 1934 | | closure1_for_explicit_set_from(avl_set(A),StartFrom,Res) :- |
| 1935 | | preferences:preference(use_closure_expansion_memoization,true), |
| 1936 | | compute_memo_hash(closure1_for_explicit_set(A),Hash), |
| 1937 | | stored_expansion(Hash,closure1_for_explicit_set(A),StoredResult),!, |
| 1938 | | domain_restriction_explicit_set(StartFrom,StoredResult,Res). */ |
| 1939 | | % StartFrom can be avl_set(empty) |
| 1940 | | closure1_for_explicit_set_from(avl_set(A),StartFrom,Res) :- |
| 1941 | | avl_domain(A,AList), |
| 1942 | | filter_start_relation(AList,StartFrom,FAList), |
| 1943 | | (FAList = [] -> Res=[] |
| 1944 | | ; convert_to_avl(FAList,avl_set(Start)), |
| 1945 | | iterate_closure(FAList,A,Start,IterationRes), |
| 1946 | | construct_avl_set(IterationRes,Res)). |
| 1947 | | filter_start_relation([],_,[]). |
| 1948 | | filter_start_relation([(X,Y)|T],StartSet,Res) :- |
| 1949 | | (element_of_custom_set(X,StartSet) -> Res = [(X,Y)|RT] ; Res=RT), |
| 1950 | | filter_start_relation(T,StartSet,RT). |
| 1951 | | |
| 1952 | | iterate_closure([],_,Res,Res). |
| 1953 | | iterate_closure([(X,Y)|T],InitialRelation,Relation,Res) :- |
| 1954 | | %(Key = (X,Y) -> true ; add_error_and_fail(iterate_closure,'Not a relation element: ',Key)), |
| 1955 | | add_tuples(X,Y,InitialRelation,Relation,NewRelation,AddedTuples), |
| 1956 | | % better: do added tuples straight away ? |
| 1957 | | iterate_closure(T,InitialRelation,NewRelation,NewRelation2), |
| 1958 | | iterate_closure(AddedTuples,InitialRelation,NewRelation2,Res). |
| 1959 | | |
| 1960 | | add_tuples(X,Y,AVL,AVLClosureSoFar,Res,NewTuples) :- |
| 1961 | | findall((X,Z), (avl_fetch_pair(Y,AVL,Z), %ok instead of safe_avl_member((Y,Z),AVL),; Y in AVL form, Z var |
| 1962 | | %Y \= Z, % self-loops are already in initial AVLClosure, this will never add a new pair |
| 1963 | | % if we use AVLClosureSoFar instead of AVL: considerably slower |
| 1964 | | \+ avl_fetch((X,Z),AVLClosureSoFar)), NewTuples), |
| 1965 | | add_to_avl(NewTuples,AVLClosureSoFar,Res). |
| 1966 | | |
| 1967 | | :- use_module(bsyntaxtree,[create_negation/2]). |
| 1968 | | % SUBSET_OF <: |
| 1969 | | % subset_of_explicit_set: returns code to be executed if this subset check can be done in an optimized way |
| 1970 | | % TO DO: add strict_subset <<: + more cases, e.g., interval & avl_set, ... |
| 1971 | | % interval & interval already handled in check_subset_of_global_sets |
| 1972 | | subset_of_explicit_set(AVL,Closure,Code,_WF) :- nonvar(AVL),AVL=avl_set(A), |
| 1973 | | is_interval_closure_or_integerset(Closure,Low,Up),!, |
| 1974 | | Code=custom_explicit_sets:check_avl_in_interval(A,Low,Up). |
| 1975 | | subset_of_explicit_set(Closure,CS,Code,WF) :- nonvar(CS), is_custom_explicit_set(CS), |
| 1976 | | is_interval_closure_or_integerset(Closure,Low,Up),!, |
| 1977 | | Code=custom_explicit_sets:check_interval_in_custom_set(Low,Up,CS,WF). |
| 1978 | | subset_of_explicit_set(AVL1,AVL2,Code,_WF) :- |
| 1979 | | nonvar(AVL1),AVL1=avl_set(A1), nonvar(AVL2),AVL2=avl_set(A2),!, |
| 1980 | | Code = custom_explicit_sets:check_avl_subset(A1,A2). |
| 1981 | | subset_of_explicit_set(C1,AVL2,Code,_WF) :- nonvar(C1), |
| 1982 | | simple_finite_set(AVL2), |
| 1983 | | is_simple_infinite_set(C1),!, % infinite set cannot be subset of finite one |
| 1984 | | Code = fail. |
| 1985 | | subset_of_explicit_set(C1,C2,Code,WF) :- nonvar(C1), |
| 1986 | | is_cartesian_product_closure(C1,S11,S12),!, |
| 1987 | | ((S11==[] ; S12==[]) -> Code=true /* we always have a subset */ |
| 1988 | | ; is_definitely_not_empty(S11), |
| 1989 | | is_definitely_not_empty(S12), % only use optimisation if we know S11, S12 to be non-empty |
| 1990 | | nonvar(C2), is_cartesian_product_closure(C2,S21,S22), |
| 1991 | | Code = (kernel_objects:check_subset_of_wf(S11,S21,WF), |
| 1992 | | kernel_objects:check_subset_of_wf(S12,S22,WF) ) |
| 1993 | | ). |
| 1994 | | subset_of_explicit_set(Set1,Set2,Code,WF) :- |
| 1995 | | nonvar(Set2),is_cartesian_product_closure(Set2,S21,S22),!, |
| 1996 | | % TO DO: maybe don't do this if Set1 is avl_set ?? |
| 1997 | | debug_println(9,'Applying C <: S21*S22 <=> C : S21 <-> S22'), |
| 1998 | | Code = bsets_clp:relation_over_wf(Set1,S21,S22,WF). |
| 1999 | | subset_of_explicit_set(C1,C2,Code,WF) :- nonvar(C1), nonvar(C2), |
| 2000 | ? | is_powerset_closure(C1,Constructor1,Set1), |
| 2001 | ? | is_powerset_closure(C2,Constructor2,Set2), |
| 2002 | | subset_constructor(Constructor1,Constructor2,R), |
| 2003 | | !, |
| 2004 | | Code = (R=pred_true, kernel_objects:check_subset_of_wf(Set1,Set2,WF)). |
| 2005 | | subset_of_explicit_set(Set1,Set2,Code,WF) :- %print_term_summary(subset(Set1,Set2)),nl, |
| 2006 | | get_subset_counter_example_closure(Set1,Set2,NewP,NewT,NewB,DefResult), % {x|P1} <: {x|P2} <=> {x|P1 & not(P2)}={} |
| 2007 | | !, |
| 2008 | | (DefResult==definitely_non_empty -> Code = fail |
| 2009 | | ; Code = custom_explicit_sets:is_empty_closure_wf(NewP,NewT,NewB,WF)). |
| 2010 | | |
| 2011 | | % get closure representing the counter examples to Set1 <: Set2: i.e. elements in Set1 and not in Set2 |
| 2012 | | % used for symbolic treatment of subset, not_subset and test_subset |
| 2013 | | % note: in case this fails subset_test1 will expand Set1 |
| 2014 | | % DefiniteResultFlag may return the information that the generated closure is definitely not empty |
| 2015 | | get_subset_counter_example_closure(Set1,Set2,NewP,NewT,NewB,DefiniteResultFlag) :- |
| 2016 | | get_closure(Set1,P1,T1,B1), |
| 2017 | | get_subset_counter_aux(P1,T1,B1,Set2,NewP,NewT,NewB,DefiniteResultFlag). |
| 2018 | | |
| 2019 | | get_subset_counter_aux(P1,T1,B1,Set2,NewP,NewT,NewB,DefRes) :- |
| 2020 | | nonvar(Set2), is_definitely_finite(Set2), !, |
| 2021 | | create_couple_term(P1,T1,P1Couple), % can currently still fail for more than 2 args |
| 2022 | ? | (is_symbolic_closure(P1,T1,B1) -> DefRes=unknown |
| 2023 | | ; is_infinite_closure(P1,T1,B1) -> DefRes=definitely_non_empty |
| 2024 | | % return a flag that tells that there are definitely counter examples as Set2 is finite |
| 2025 | | ), |
| 2026 | | NewP=P1, NewT=T1, |
| 2027 | | % {x|P1} <: {a1,...} <=> {x|P1 & x /: {a1,...}}={} |
| 2028 | | get_texpr_type(P1Couple,CoupleType1), |
| 2029 | | VSet2 = b(value(Set2),set(CoupleType1),[]), |
| 2030 | | create_texpr(not_member(P1Couple,VSet2),pred,[],NegPred2), |
| 2031 | | conjunct_predicates([B1,NegPred2],NewB). |
| 2032 | | get_subset_counter_aux(P1,T1,B1,Set2,NewP,NewT,NewB,unknown) :- |
| 2033 | | get_closure(Set2,P2,T2,B2), |
| 2034 | | (is_infinite_or_symbolic_closure(P1,T1,B1) -> true |
| 2035 | | ), % should we also allow ?? ; is_symbolic_closure(P2,T2,B2)), |
| 2036 | | % not necessary maybe as subset_test1 only expands Set1 |
| 2037 | | % {x|P1} <: {x|P2} <=> {x|P1 & not(P2)}={} |
| 2038 | | unify_closure_predicates(P1,T1,B1, P2,T2,B2 , NewP,NewT, NewB1,NewB2), |
| 2039 | | create_negation(NewB2,NegNewB2), |
| 2040 | | bsyntaxtree:conjunct_predicates([NewB1,NegNewB2],NewB). |
| 2041 | | |
| 2042 | | |
| 2043 | | % get_closure or infinite global set: |
| 2044 | | get_closure(V,_,_,_) :- var(V),!,fail. |
| 2045 | | get_closure(closure(P,T,B),P,T,B). |
| 2046 | | get_closure(global_set(G),P,T,B) :- is_infinite_global_set(G,Type),!, |
| 2047 | | ID = '_zzzz_unary', |
| 2048 | | TID = b(identifier(ID),Type,[]), |
| 2049 | | TSet = b(value(global_set(G)),set(Type),[]), |
| 2050 | | P = [ID], T=[Type], B= b(member(TID,TSet),pred,[prob_annotation('SYMBOLIC')]). |
| 2051 | | |
| 2052 | | |
| 2053 | | subset_constructor(X,X,R) :- !,R=pred_true. |
| 2054 | | subset_constructor(fin1,_,R) :- !,R=pred_true. |
| 2055 | | subset_constructor(fin,pow,R) :- !,R=pred_true. |
| 2056 | | subset_constructor(X,Y,R) :- strict_subset_constructor(X,Y),!,R=pred_true. |
| 2057 | | subset_constructor(X,Y,R) :- strict_subset_constructor(Y,X),!,R=pred_false. |
| 2058 | | % pow1,fin1 ; pow,fin ; and pow1,fin only ok if type infinite |
| 2059 | | strict_subset_constructor(pow1,pow). |
| 2060 | | strict_subset_constructor(fin1,fin). |
| 2061 | | |
| 2062 | | % more rules for <->, +->, ... |
| 2063 | | % what if same closure: then we also know it is a subset |
| 2064 | | |
| 2065 | | % to be completed: |
| 2066 | | % code that instantiates R to subset or not_subset, may have to delay |
| 2067 | | test_subset_of_explicit_set(Set1,_,_,_,_) :- var(Set1),!,fail. |
| 2068 | | test_subset_of_explicit_set(avl_set(A),Closure,R,WF,Code) :- |
| 2069 | | is_interval_closure_or_integerset(Closure,Low,Up),!, |
| 2070 | | Code=custom_explicit_sets:test_avl_in_interval(A,Low,Up,R,WF). |
| 2071 | | test_subset_of_explicit_set(_,Set2,_,_,_) :- var(Set2),!,fail. |
| 2072 | | test_subset_of_explicit_set(avl_set(A1),avl_set(A2),R,_WF,Code) :- |
| 2073 | | Code = (custom_explicit_sets:check_avl_subset(A1,A2) -> R=pred_true ; R=pred_false). |
| 2074 | | test_subset_of_explicit_set(global_set(G),Set2,R,_WF,Code) :- |
| 2075 | ? | is_infinite_global_set(G,_), % TODO: we could extend this to other infinite sets |
| 2076 | | is_definitely_finite(Set2), !, |
| 2077 | | Code =(R=pred_false). |
| 2078 | | test_subset_of_explicit_set(Set1,Set2,Res,WF,Code) :- |
| 2079 | | get_subset_counter_example_closure(Set1,Set2,NewP,NewT,NewB,DefResult), % {x|P1} <: {x|P2} <=> {x|P1 & not(P2)}={} |
| 2080 | | !, |
| 2081 | | (DefResult==definitely_non_empty -> Code = (Res=pred_false) |
| 2082 | | ; Code = custom_explicit_sets:test_empty_closure_wf(NewP,NewT,NewB,Res,WF) |
| 2083 | | ). |
| 2084 | | % TO DO: add is_cartesian_product_closure case |
| 2085 | | is_definitely_finite([]). |
| 2086 | | is_definitely_finite(avl_set(_)). |
| 2087 | | |
| 2088 | | :- use_module(kernel_equality,[test_interval_subset_wf/6]). |
| 2089 | | |
| 2090 | | :- public test_avl_in_interval/5. % used in test_subset_of_explicit_set |
| 2091 | | % see also check_avl_in_interval(A,Low,Up), check_avl_not_in_interval(A,Low,Up). |
| 2092 | | test_avl_in_interval(A,Low2,Up2,Res,WF) :- |
| 2093 | | avl_min(A,int(Min)), % not needed if Low2==minus_inf |
| 2094 | | avl_max(A,int(Max)), % not needed if Up2==inf |
| 2095 | | test_interval_subset_wf(Min,Max,Low2,Up2,Res,WF). |
| 2096 | | |
| 2097 | | % ---------------------- |
| 2098 | | |
| 2099 | | is_definitely_not_empty(X) :- nonvar(X), |
| 2100 | | (X=[_|_] -> true |
| 2101 | | ; is_custom_explicit_set(X), is_non_empty_explicit_set(X)). |
| 2102 | | |
| 2103 | | % check if defnitely not empty and provide a witness |
| 2104 | | is_definitely_not_empty_with_witness(X,El) :- nonvar(X), |
| 2105 | | get_witness_element(X,El). |
| 2106 | | get_witness_element([H|_],H). |
| 2107 | | get_witness_element(avl_set(node(H,_True,_,_,_)),H). |
| 2108 | | % TO DO: add global_set(GS),... |
| 2109 | | |
| 2110 | | check_avl_subset(A1,A2) :- avl_max(A1,Max1), avl_max(A2,Max2), |
| 2111 | | Max1@>Max2,!, % then A1 cannot be subset of A2 |
| 2112 | | fail. |
| 2113 | | check_avl_subset(A1,A2) :- |
| 2114 | | avl_min(A1,Cur1), avl_min(A2,Cur2), |
| 2115 | | check_avl_subset_loop(Cur1,A1,Cur2,A2). |
| 2116 | | check_avl_subset_loop(Cur1,AVL1,Cur2,AVL2) :- |
| 2117 | | (Cur1 @> Cur2 -> avl_next(Cur2,AVL2,NC2), check_avl_subset_loop(Cur1,AVL1,NC2,AVL2) |
| 2118 | | ; Cur1=Cur2 -> (avl_next(Cur1,AVL1,NC1) |
| 2119 | | -> avl_next(Cur2,AVL2,NC2), |
| 2120 | | check_avl_subset_loop(NC1,AVL1,NC2,AVL2) |
| 2121 | | ; true /* all objects of AVL1 inspected */) |
| 2122 | | ). |
| 2123 | | |
| 2124 | | % check A <: Low..Up |
| 2125 | | check_avl_in_interval(A,Low,Up) :- % does not have to delay: if we have minus_inf & inf they will be known straightaway |
| 2126 | | (Low==minus_inf -> true |
| 2127 | | ; avl_min(A,Min), kernel_objects:less_than_equal(int(Low),Min)), |
| 2128 | | (Up==inf -> true |
| 2129 | | ; avl_max(A,Max), kernel_objects:less_than_equal(Max,int(Up))). |
| 2130 | | |
| 2131 | | % some experiments: |
| 2132 | | % 1..x <: {1,2,3,5} & x>1 & !y.(y>x & y<10 => 1..y /<: {1,2,3,5}) |
| 2133 | | % {ss | ss <: 0..0 & ss /= {} & ss=0..max(ss)} |
| 2134 | | % {ss | ss <: 0..0 & ss /= {} & ss=min(ss)..max(ss)} // does not work yet |
| 2135 | | % x..x+1 <: {0,2,3,5} |
| 2136 | | % x..x+2 <: {0,2,3,5} // does not work yet |
| 2137 | | % r = {x|x:1..400 & x mod 3/=0} & res={v|v:0..1300 & v..v+1 <: r} |
| 2138 | | % check Low..Up <: Avl |
| 2139 | | |
| 2140 | | check_interval_in_custom_set(Low,Up,CS,WF) :- |
| 2141 | | Low \== minus_inf, |
| 2142 | | Up \== inf, |
| 2143 | | b_interpreter_check:check_arithmetic_operator('<=',Low,Up,LeqRes), |
| 2144 | | (var(LeqRes) -> get_binary_choice_wait_flag_exp_backoff(16,check_interval_in_custom_set,WF,WF2) ; true), |
| 2145 | | check_interval_in_custom_set_aux(LeqRes,Low,Up,CS,WF2). |
| 2146 | | |
| 2147 | | :- block check_interval_in_custom_set_aux(-,?,?,?,-). |
| 2148 | | check_interval_in_custom_set_aux(pred_true,Low,Up,CS,_WF2) :- |
| 2149 | | element_of_custom_set_wf(int(Low),CS,WF), |
| 2150 | | element_of_custom_set_wf(int(Up),CS,WF), |
| 2151 | | interval_in_avl_block(Low,Up,CS,WF). |
| 2152 | | check_interval_in_custom_set_aux(pred_false,_Low,_Up,_CS,_WF2). % Interval is empty; but infinitely many solutions for Low and Up exist in principle |
| 2153 | | |
| 2154 | | :- block interval_in_avl_block(-,?,?,?), interval_in_avl_block(?,-,?,?). |
| 2155 | | interval_in_avl_block(Low,Up,CS,WF) :- |
| 2156 | | Low1 is Low+1, interval_in_avl_loop(Low1,Up,CS,WF). |
| 2157 | | interval_in_avl_loop(Low,Up,_CS,_WF) :- Low>=Up,!. % Lower bound and upper bound already checked |
| 2158 | | interval_in_avl_loop(Low,Up,CS,WF) :- |
| 2159 | | element_of_custom_set_wf(int(Low),CS,WF), L1 is Low+1, |
| 2160 | | interval_in_avl_loop(L1,Up,CS,WF). |
| 2161 | | |
| 2162 | | |
| 2163 | | :- public not_check_avl_subset/2. % used in not_subset_of_explicit_set_aux |
| 2164 | | not_check_avl_subset(A1,A2) :- \+ check_avl_subset(A1,A2). |
| 2165 | | |
| 2166 | | not_subset_of_explicit_set(S1,S2,Code,WF) :- nonvar(S1), |
| 2167 | ? | not_subset_of_explicit_set_aux(S1,S2,Code,WF). |
| 2168 | | not_subset_of_explicit_set_aux(avl_set(A),Closure,Code,_WF) :- |
| 2169 | | is_interval_closure_or_integerset(Closure,Low,Up),!, |
| 2170 | | Code=custom_explicit_sets:check_avl_not_in_interval(A,Low,Up). |
| 2171 | | not_subset_of_explicit_set_aux(avl_set(A1),AVL2,Code,_WF) :- |
| 2172 | | nonvar(AVL2),AVL2=avl_set(A2), |
| 2173 | | Code = custom_explicit_sets:not_check_avl_subset(A1,A2). |
| 2174 | | not_subset_of_explicit_set_aux(CS,AVL,Code,_WF) :- |
| 2175 | ? | is_simple_infinite_set(CS), |
| 2176 | | % TO DO: provide code for interval/NAT/INT /<: AVL |
| 2177 | | simple_finite_set(AVL), |
| 2178 | | !, |
| 2179 | | Code = true. % G cannot be subset of finite set |
| 2180 | | not_subset_of_explicit_set_aux(C1,C2,Code,WF) :- is_cartesian_product_closure(C1,S11,S12), |
| 2181 | | ((S11==[] ; S12==[]) -> Code=fail /* we always have a subset */ |
| 2182 | | ; is_definitely_not_empty(S11), |
| 2183 | | is_definitely_not_empty(S12), % only use optimisation if we know S11, S12 to be non-empty |
| 2184 | | nonvar(C2), is_cartesian_product_closure(C2,S21,S22), |
| 2185 | | Code = (kernel_objects:not_both_subset_of(S11,S12, S21,S22, WF)) |
| 2186 | | ), !. |
| 2187 | | not_subset_of_explicit_set_aux(C1,C2,Code,WF) :- nonvar(C2), |
| 2188 | ? | is_powerset_closure(C1,Constructor1,Set1), |
| 2189 | ? | is_powerset_closure(C2,Constructor2,Set2), |
| 2190 | | subset_constructor(Constructor1,Constructor2,R),!, |
| 2191 | | Code = (R=pred_false -> true ; kernel_objects:not_subset_of_wf(Set1,Set2,WF)). |
| 2192 | | not_subset_of_explicit_set_aux(Set1,Set2,Code,WF) :- |
| 2193 | | get_subset_counter_example_closure(Set1,Set2,NewP,NewT,NewB,DefResult), % {x|P1} <: {x|P2} <=> {x|P1 & not(P2)}={} |
| 2194 | | !, |
| 2195 | | (DefResult==definitely_non_empty -> Code = true |
| 2196 | | ; Code = custom_explicit_sets:is_non_empty_closure_wf(NewP,NewT,NewB,WF) |
| 2197 | | ). |
| 2198 | | |
| 2199 | | |
| 2200 | | :- public check_avl_not_in_interval/3. % used in not_subset_of_explicit_set_aux |
| 2201 | | :- block check_avl_not_in_interval(?,-,?). % TO DO: use non-blocking version, minus_inf, and inf set directly |
| 2202 | | check_avl_not_in_interval(A,Low,Up) :- avl_min(A,int(Min)), |
| 2203 | | check_avl_not_in_interval4(Low,Up,A,Min). |
| 2204 | | |
| 2205 | | check_avl_not_in_interval4(Low,_Up,_A,Min) :- Low \== minus_inf, Min < Low,!. |
| 2206 | | check_avl_not_in_interval4(_Low,Up,A,_Min) :- |
| 2207 | | Up \== inf, avl_max(A,Max), |
| 2208 | | kernel_objects:less_than(int(Up),Max). % Up could still be a variable |
| 2209 | | |
| 2210 | | |
| 2211 | | % checks for simple infinite sets, without Cartesian Product, ... decomposition |
| 2212 | ? | is_simple_infinite_set(global_set(X)) :- !, is_infinite_global_set(X,_). |
| 2213 | | is_simple_infinite_set(CS) :- is_interval_closure_or_integerset(CS,Low,Up), infinite_interval(Low,Up). |
| 2214 | | |
| 2215 | | simple_finite_set(AVL) :- nonvar(AVL), (AVL=avl_set(_) -> true ; AVL = []). |
| 2216 | | |
| 2217 | | % IMAGE [.] |
| 2218 | | image_for_id_closure(closure(Par,Types,Body),Set,Res) :- |
| 2219 | | is_full_id_closure(Par,Types,Body),!, |
| 2220 | | Res=Set. |
| 2221 | | |
| 2222 | | image_for_explicit_set(closure(Par,Types,Body),Set,Res,WF) :- |
| 2223 | | image_for_closure(Par,Types,Body,Set,Res,WF). |
| 2224 | | image_for_explicit_set(avl_set(A),Set,Res,WF) :- nonvar(Set), |
| 2225 | | image_for_explicit_avl_set(A,Set,Res,WF). |
| 2226 | | |
| 2227 | | |
| 2228 | | image_for_closure(Par,Types,Body,Set,Res,_WF) :- |
| 2229 | | is_id_closure_over(Par,Types,Body,ID_Domain,Full),!, |
| 2230 | | (Full=true -> Res=Set ; kernel_objects:intersection(ID_Domain,Set,Res)). |
| 2231 | | % infinite function case dealt with in image1 in bsets_clp |
| 2232 | | % TO DO: other closure(); Maybe special case if Set is an interval ? |
| 2233 | | image_for_closure(Par,Types,Body,Set,Res,WF) :- |
| 2234 | | is_closure1_value_closure(Par,Types,Body,VAL), % TODO: also detect reflexive closure, iteration (iterate(rel,k)) |
| 2235 | | % compute closure1(VAL)[Set] |
| 2236 | | bsets_clp:image_for_closure1_wf(VAL,Set,Res,WF). |
| 2237 | | |
| 2238 | | is_closure1_value_closure(Par,Types,Body,VAL) :- |
| 2239 | | is_member_closure(Par,Types,Body,couple(A,A),MemSET), nonvar(MemSET), |
| 2240 | | MemSET = closure(V), % this is the closure1 B operator ! |
| 2241 | | nonvar(V), V=b(value(VAL),_,_). |
| 2242 | | |
| 2243 | | image_for_explicit_avl_set(A,Set,Res,_WF) :- % Set is nonvar |
| 2244 | | is_interval_closure_or_integerset(Set,From1,To1),!, |
| 2245 | | % Note: if From1, To1 not yet known we will block and not revert to other image calculation code |
| 2246 | | % Important e.g. for performance of San Juan (AdaptedBModelPropCheck/acs_as_env_cfg_ipart.mch) |
| 2247 | | %we used to check for: ground(From1),ground(To1), |
| 2248 | | interval_image_for_explicit_avl_set(From1,To1,A,Set,Res). |
| 2249 | | image_for_explicit_avl_set(A,Set,Res,WF) :- |
| 2250 | ? | \+ bsets_clp:keep_symbolic(Set), % in this case we fall back to treatment in bsets_clp (image1) |
| 2251 | | expand_custom_set_to_list_gg(Set,ESet,GG,image_for_explicit_avl_set), |
| 2252 | | empty_avl(Empty), |
| 2253 | | (GG=guaranteed_ground -> image_explicit_ground(ESet,A,Empty,Res,WF) |
| 2254 | | ; image_explicit(ESet,A,Empty,Res,WF)). |
| 2255 | | |
| 2256 | | :- block interval_image_for_explicit_avl_set(-,?,?,?,?), |
| 2257 | | interval_image_for_explicit_avl_set(?,-,?,?,?). |
| 2258 | | interval_image_for_explicit_avl_set(From1,To1,_A,_Set,Res) :- |
| 2259 | | number(From1), number(To1), From1>To1,!, |
| 2260 | | kernel_objects:empty_set(Res). |
| 2261 | | interval_image_for_explicit_avl_set(From1,To1,A,_Set,Res) :- |
| 2262 | | findall(Image-true, avl_image_interval(From1,To1, A,Image),ImageList), |
| 2263 | | normalised_list_to_avl(ImageList,ImageAvl), |
| 2264 | ? | equal_object(ImageAvl,Res). |
| 2265 | | |
| 2266 | | |
| 2267 | | %! singleton_set(+Set,-Element). |
| 2268 | | singleton_set(X,_) :- var(X),!,fail. |
| 2269 | | singleton_set([H|T],R) :- T==[], R=H. |
| 2270 | | singleton_set(avl_set(node(Y,_,_,empty,empty)),Y). % same as is_one_element_custom_set |
| 2271 | | |
| 2272 | | is_one_element_custom_set(avl_set(node(Y,_,_,empty,empty)),Y). |
| 2273 | | is_one_element_avl(node(Y,_,_,empty,empty),Y). |
| 2274 | | |
| 2275 | | % requires El to be ground |
| 2276 | | construct_one_element_custom_set(El,avl_set(AVL)) :- |
| 2277 | | empty_avl(E),avl_store(El,E,true,AVL). |
| 2278 | | |
| 2279 | | construct_avl_set(Avl,Res) :- empty_avl(Avl) -> Res = [] ; Res = avl_set(Avl). |
| 2280 | | |
| 2281 | | :- block image_explicit(-,?,?,?,?). |
| 2282 | | image_explicit([],_,Acc,Res,WF) :- !, |
| 2283 | | construct_avl_set(Acc,AVLS), |
| 2284 | ? | kernel_objects:equal_object_wf(Res,AVLS,image_explicit,WF). |
| 2285 | | image_explicit([D1|T],AVLRelation,In,Out,WF) :- !, |
| 2286 | | ground_value_check(D1,G1), |
| 2287 | | ((var(T);T==[]) % TO DO: see below, make propagation also interesting in other circumstances |
| 2288 | | -> must_be_in_domain_check(G1,D1,T,AVLRelation,In,Out,WF) |
| 2289 | | ; true), |
| 2290 | | image_explicit_aux(G1,D1,AVLRelation,T,In,Out,WF). |
| 2291 | | image_explicit(Set,_,_,_,_) :- add_error_and_fail(image_explicit,'Unknown set: ',Set). |
| 2292 | | |
| 2293 | | % a version of image_explicit where the list is guaranteed to be ground |
| 2294 | | image_explicit_ground([],_,Acc,Res,WF) :- !, |
| 2295 | | construct_avl_set(Acc,AVLS), |
| 2296 | | kernel_objects:equal_object_wf(Res,AVLS,image_explicit,WF). |
| 2297 | | image_explicit_ground([D1|T],AVLRelation,In,Out,WF) :- !, |
| 2298 | | image_explicit_aux_ground(D1,AVLRelation,T,In,Out,WF). |
| 2299 | | image_explicit_ground(Set,_,_,_,_) :- add_error_and_fail(image_explicit_ground,'Unknown set: ',Set). |
| 2300 | | |
| 2301 | | :- block must_be_in_domain_check(-,?,?,?,?,-,?), |
| 2302 | | must_be_in_domain_check(-,?,-,?,?,?,?). |
| 2303 | | % if result requires at least one more element, then D must be in domain of Relation |
| 2304 | | % ensures that we get a domain for j in x = {1|->2,2|->4, 4|->8} & x[{j}]={8} |
| 2305 | | % we could even propagate using inverse of AVLRelation ?! |
| 2306 | | must_be_in_domain_check(GroundD,D,T,AVLRelation,In,Out,WF) :- |
| 2307 | | T==[], % apart from D, there are no more elements to be added |
| 2308 | | var(GroundD), % otherwise we already have a value for D |
| 2309 | | delta_witness(In,Out,Witness), % obtain at least one value that D must map to |
| 2310 | | !, |
| 2311 | | quick_propagation_element_information(avl_set(AVLRelation),(D,Witness),WF,_). % Witness avoids pending co-routines |
| 2312 | | % TO DO: we could check that *all* elements of Out have this value |
| 2313 | | % TO DO: below we could check that In is a subset of Out; e.g., for x = %i.(i:1..10|i+i) & x[{5,j,k}]={16,11}; we could also check that Out is subset of range of relation |
| 2314 | | must_be_in_domain_check(_,_D,_T,_,_In,_Out,_). % :- print(must_be(D,T,In,Out)),nl. |
| 2315 | | |
| 2316 | | % provide, if possible, a witness element in Out not in In |
| 2317 | | delta_witness(In,Out,_Witness) :- (var(In) ; var(Out)),!,fail. |
| 2318 | | %delta_witness(empty,Out,Witness) :- is_definitely_not_empty_with_witness(Out,Witness). |
| 2319 | | delta_witness(In,Out,Witness) :- |
| 2320 | | is_custom_explicit_set(Out,delta_witness), |
| 2321 | | difference_of_explicit_set(Out,avl_set(In),Diff), % could be expensive to compute !? delay ? print(delta(Diff)),nl, |
| 2322 | | is_definitely_not_empty_with_witness(Diff,Witness). |
| 2323 | | |
| 2324 | | |
| 2325 | | :- block image_explicit_aux(-,?,?, ?,?,?,?). % we know that D1 is ground |
| 2326 | | image_explicit_aux(_,D1,AVLRelation,T,In,Out,WF) :- |
| 2327 | | all_images(D1,AVLRelation,NewImages), % compute AVLRelation[{D1}] |
| 2328 | | add_to_avl(NewImages,In,In2), |
| 2329 | ? | image_explicit(T,AVLRelation,In2,Out,WF). |
| 2330 | | image_explicit_aux_ground(D1,AVLRelation,T,In,Out,WF) :- |
| 2331 | | all_images(D1,AVLRelation,NewImages), % compute AVLRelation[{D1}] |
| 2332 | | add_to_avl(NewImages,In,In2), |
| 2333 | | image_explicit_ground(T,AVLRelation,In2,Out,WF). |
| 2334 | | |
| 2335 | | all_images(From,AVLRelation,Images) :- |
| 2336 | | findall(AY,avl_member_pair_arg1_ground(From,AY,AVLRelation),Images). % we know From ground and AY free variable |
| 2337 | | % findall(AY,safe_avl_member_pair(From,AY,AVLRelation),Images). % |
| 2338 | | |
| 2339 | | % compute relational composition ( ; ) if second arg is an AVL set |
| 2340 | | % TO DO: add support for infinite closures; avoid expanding them [currently handled by symbolic composition in bsets_clp] |
| 2341 | | rel_composition_for_explicit_set(Rel1,Rel2,Comp) :- nonvar(Rel2), |
| 2342 | | Rel2=avl_set(A2), % TO DO: see if we can maybe convert Rel2 to AVL ? |
| 2343 | | % \+ bsets_clp:keep_symbolic(Rel1), check already done in bsets |
| 2344 | | expand_custom_set_to_list_gg(Rel1,Relation1,GG,rel_composition_for_explicit_set), |
| 2345 | | empty_avl(In), |
| 2346 | | (GG=guaranteed_ground |
| 2347 | | -> rel_avl_compose2_ground(Relation1,A2,In,Comp) |
| 2348 | | ; rel_avl_compose2(Relation1,A2,In,Comp)). |
| 2349 | | |
| 2350 | | :- block rel_avl_compose2(-,?,?,?). |
| 2351 | | rel_avl_compose2([],_,In,Res) :- construct_avl_set(In,A), |
| 2352 | | equal_object(Res,A,rel_avl_compose2). % as we delay; we need to use equal_object at the end |
| 2353 | | rel_avl_compose2([(X,Y)|T],A2,In,Out) :- |
| 2354 | | when((ground(X),ground(Y)), |
| 2355 | | (all_image_pairs_ground(X,Y,A2,ImagePairs), |
| 2356 | | add_to_avl(ImagePairs,In,In2), |
| 2357 | | rel_avl_compose2(T,A2,In2,Out))). |
| 2358 | | |
| 2359 | | % a version where argument is guaranteed to be ground; no when-ground checks |
| 2360 | | rel_avl_compose2_ground([],_,In,Res) :- construct_avl_set(In,A), |
| 2361 | | equal_object(Res,A,rel_avl_compose2). % as we delay; we need to use equal_object at the end |
| 2362 | | rel_avl_compose2_ground([(X,Y)|T],A2,In,Out) :- |
| 2363 | | all_image_pairs_ground(X,Y,A2,ImagePairs), |
| 2364 | | add_to_avl(ImagePairs,In,In2), |
| 2365 | | rel_avl_compose2_ground(T,A2,In2,Out). |
| 2366 | | |
| 2367 | | %all_image_pairs(From,To,AVLRelation,ImagePairs) :- |
| 2368 | | % findall((From,AY),safe_avl_member_pair(To,AY,AVLRelation),ImagePairs). |
| 2369 | | all_image_pairs_ground(From,To,AVLRelation,ImagePairs) :- |
| 2370 | | findall((From,AY),avl_member_pair_arg1_ground(To,AY,AVLRelation),ImagePairs). |
| 2371 | | % To: already in AVL format; AY is variable -> we could use avl_fetch_pair directly : findall((From,AY),avl_fetch_pair(To,AVLRelation,AY),ImagePairs). |
| 2372 | | |
| 2373 | | /* succeeds if it can compute domain by some clever way */ |
| 2374 | | domain_of_explicit_set_wf(global_set(GS),_R,_) :- !, |
| 2375 | | add_error_and_fail(domain_of_explicit_set_wf,'Cannot compute domain of global set: ',GS). |
| 2376 | | domain_of_explicit_set_wf(freetype(GS),_R,_) :- !, |
| 2377 | | add_error_and_fail(domain_of_explicit_set_wf,'Cannot compute domain of freetype: ',GS). |
| 2378 | | domain_of_explicit_set_wf(avl_set(A),Res,_) :- !, |
| 2379 | | domain_of_avl_set(A,Res). |
| 2380 | | domain_of_explicit_set_wf(C,R,WF) :- dom_for_specific_closure(C,Dom,_,WF),!, |
| 2381 | | Dom=R. |
| 2382 | | domain_of_explicit_set_wf(C,R,_) :- |
| 2383 | ? | dom_symbolic(C,CC),!, |
| 2384 | | R=CC. |
| 2385 | | domain_of_explicit_set_wf(closure(P,T,B),Res,WF) :- |
| 2386 | | % does not seem to be reached, as dom_symbolic now seems to cover all cases |
| 2387 | | expand_custom_set_wf(closure(P,T,B),EC,domain_of_explicit_set,WF), |
| 2388 | | domain_of_list_blocking(EC,R), |
| 2389 | | normalised_list_to_avl_when_ground(R,Res). |
| 2390 | | |
| 2391 | | % avl tree is a relation with an integer domain |
| 2392 | | %avl_integer_domain(node((int(_From),_KeyTo),_True,_,_L,_R)). |
| 2393 | | |
| 2394 | | % the first clause is in principle faster |
| 2395 | | % but we don't gain time compared to treatment in second clause; we just avoid building up the domain list |
| 2396 | | %domain_of_avl_set(A,Res) :- avl_integer_domain(A), |
| 2397 | | % \+ avl_tools:avl_height_less_than(A,10), % try and detect interval if height >= 10 |
| 2398 | | % avl_is_pf_with_interval_domain(A,First,Last),!, |
| 2399 | | % construct_interval_closure(First,Last,Res). |
| 2400 | | domain_of_avl_set(A,Res) :- |
| 2401 | | avl_domain(A,EC), % -> expand_custom_set(avl_set(A),EC), |
| 2402 | | domain_of_sorted_list(EC,SizeRes,R), % size of list can be smaller than A if we have a relation |
| 2403 | | (SizeRes=size_res(Size,int(Last)), R=[int(First)-true|_], |
| 2404 | | Size>1000, |
| 2405 | | Size is Last+1-First % we have an interval; quite common that we have functions with intervals as domain |
| 2406 | | -> debug_println(19,constructing_interval_for_domain(First,Last)), |
| 2407 | | construct_interval_closure(First,Last,Res) |
| 2408 | | ; ord_list_to_avlset(R,Res,domain) |
| 2409 | | ). |
| 2410 | | |
| 2411 | | % check if an AVL tree represents a function with an interval domain |
| 2412 | | %avl_is_pf_with_interval_domain(AVL,Min,Max) :- |
| 2413 | | % avl_min(AVL,(int(Min),_)),avl_max(AVL,(int(Max),_)), |
| 2414 | | % Size is 1+Max-Min, avl_size_possible(AVL,Size), |
| 2415 | | % is_avl_partial_function(AVL), |
| 2416 | | % % now check real size |
| 2417 | | % avl_size(AVL,Size). |
| 2418 | | |
| 2419 | | % check if an avl represents a set of integers: |
| 2420 | | avl_integer_set(node(int(_TOP),_True,_,_L,_R)). |
| 2421 | | |
| 2422 | | % check if an avl set is an interval: |
| 2423 | | avl_is_interval(AVL,Min,Max) :- |
| 2424 | | avl_integer_set(AVL), |
| 2425 | | avl_min(AVL,int(Min)),avl_max(AVL,int(Max)), |
| 2426 | | Size is 1+Max-Min, |
| 2427 | | avl_size_possible(AVL,Size), |
| 2428 | | avl_size(AVL,Size). |
| 2429 | | |
| 2430 | | |
| 2431 | | |
| 2432 | | :- use_module(bsyntaxtree,[create_typed_id/3]). |
| 2433 | | dom_symbolic(closure(Paras,Types,Pred), Res) :- |
| 2434 | | expand_pair_closure(Paras,Types,Pred,[X,Y],[TX,TY],NewPred), |
| 2435 | | !, % single argument which is a pair |
| 2436 | | % simply call code for range ; inverting arguments |
| 2437 | | bsyntaxtree:check_used_ids_in_ast(Pred), |
| 2438 | | bsyntaxtree:check_used_ids_in_ast(NewPred), |
| 2439 | | ran_symbolic_closure(Y,[X],TY,[TX],NewPred,Res). |
| 2440 | | dom_symbolic(closure(Paras,Types,Pred), Res) :- |
| 2441 | | append(Xs,[Y],Paras), Xs \= [], |
| 2442 | | append(TXs,[TY],Types), |
| 2443 | | % simply call code for range ; inverting arguments |
| 2444 | | ran_symbolic_closure(Y,Xs,TY,TXs,Pred,Res). |
| 2445 | | % TO DO: allow computation if Paras is a single argument and more than pair |
| 2446 | | |
| 2447 | | % just computes domain: it can also be successful for lambda closures |
| 2448 | | dom_for_specific_closure(closure(P,T,Pred),Domain,Functionality,WF) :- |
| 2449 | | dom_for_specific_closure_aux(P,T,Pred,Domain,Functionality,WF). |
| 2450 | | dom_for_specific_closure_aux(P,T,Pred,Domain,Functionality,_WF) :- |
| 2451 | | is_lambda_value_domain_closure(P,T,Pred, DomainValue,Expr), |
| 2452 | | (preference(find_abort_values,full) -> bsyntaxtree:always_well_defined_or_disprover_mode(Expr) |
| 2453 | | ; true), |
| 2454 | | % Warning: this will lead to dom(%x.(x:1..3|1/0)) = 1..3 to be true; discarding WD condition |
| 2455 | | % this is not as bad as {1|->2}(0) = 3 to be silently failing though; hence only done if TRY_FIND_ABORT = full |
| 2456 | | !, |
| 2457 | | Domain=DomainValue, |
| 2458 | | Functionality=function(total). |
| 2459 | | %dom_for_specific_closure_aux([ID],[Type],Pred,Domain,Functionality,_WF) :- Functionality=relation, |
| 2460 | | % Pred = b(exists(Paras,ClosurePred),pred,Info1), |
| 2461 | | % % dom({res|#(paras).(.... & res= domVal|->ran)}) = {res|#(paras).(.... & res= domVal)} |
| 2462 | | % closures:select_equality(ClosurePred,ID,RHSExpr,Type,Info,RestPred), |
| 2463 | | % RHSExpr = couple(DomValue,_), |
| 2464 | | % closures:does_not_occur_in(ID,RestPred), |
| 2465 | | % Type = couple(DomT,_), |
| 2466 | | % TID = b(identifier(ID),DomT,[]), |
| 2467 | | % % safe_create_texpr |
| 2468 | | % conjunct_predicates([RestPred,b(equal(TID,DomValue),pred,[])],NewClosurePred), |
| 2469 | | % NewPred = b(exists(Paras,NewClosurePred),pred,Info1), |
| 2470 | | % Domain = closure([ID],[DomT],NewPred). |
| 2471 | | dom_for_specific_closure_aux(P,T,Pred,Domain,Functionality,WF) :- |
| 2472 | | dom_range_for_specific_closure2(P,T,Pred, Domain,_Range,Functionality,WF). |
| 2473 | | %TO DO treat overwrite closure dom(F1<+F2) = dom(F1) \/ dom(F2) |
| 2474 | | |
| 2475 | | dom_for_lambda_closure(closure(P,T,Pred),Domain) :- |
| 2476 | | is_lambda_value_domain_closure(P,T,Pred, DomainValue,_Expr), |
| 2477 | | Domain=DomainValue. |
| 2478 | | |
| 2479 | | % TO DO: add total functions |
| 2480 | | %dom_for_specific_closure2([F],[T], |
| 2481 | | % b(member(b(identifier(F),T,_), b(total_function(value(A),B),set(couple(DOM,RAN)),_)), pred,_) , |
| 2482 | | % A). |
| 2483 | | |
| 2484 | | :- block domain_of_list_blocking(-,?). |
| 2485 | | % the list will be sorted according to the term ordering for (_,_); hence it will |
| 2486 | | % already be sorted for the projection onto the first element |
| 2487 | | % maybe the speed difference is not worth it ?? |
| 2488 | | domain_of_list_blocking([],[]). |
| 2489 | | domain_of_list_blocking([(A,_B)|T],[A-true|DT]) :- domain_blocking_aux(T,A,DT). |
| 2490 | | :- block domain_blocking_aux(-,?,?). |
| 2491 | | domain_blocking_aux([],_,[]). |
| 2492 | | domain_blocking_aux([(A,_B)|T],Prev,Res) :- |
| 2493 | | compare(Comp,A,Prev), |
| 2494 | | (Comp = '=' |
| 2495 | | -> domain_blocking_aux(T,Prev,Res) |
| 2496 | | ; Res = [A-true|DT], |
| 2497 | | (Comp = '<' -> add_error_fail(custom_explicit_sets,'Domain list not_sorted: ',(A,Prev)) ; true), |
| 2498 | | domain_blocking_aux(T,A,DT) ). |
| 2499 | | |
| 2500 | | % and now a non-blocking version: |
| 2501 | | domain_of_sorted_list([],size_res(0,'$none'),[]). |
| 2502 | | domain_of_sorted_list([(A,_B)|T],Size,[A-true|DT]) :- domain_aux(T,A,DT,1,Size). |
| 2503 | | |
| 2504 | | % TO DO: count length and determine when we have an interval |
| 2505 | | domain_aux([],Prev,[],Acc,size_res(Acc,Prev)). |
| 2506 | | domain_aux([(A,_B)|T],Prev,Res,SizeAcc,Size) :- SA1 is SizeAcc+1, |
| 2507 | | compare(Comp,A,Prev), |
| 2508 | | (Comp = '=' |
| 2509 | | -> domain_aux(T,Prev,Res,SA1,Size) |
| 2510 | | ; Res = [A-true|DT], |
| 2511 | | (Comp = '<' -> add_error_fail(custom_explicit_sets,'Domain list not_sorted: ',(A,Prev)) ; true), |
| 2512 | | domain_aux(T,A,DT,SA1,Size) ). |
| 2513 | | |
| 2514 | | /* succeeds if it can compute domain by some clever way */ |
| 2515 | | range_of_explicit_set_wf(global_set(GS),_R,_) :- !, |
| 2516 | | add_error_and_fail(range_of_explicit_set_wf,'Cannot compute domain of global set: ',GS). |
| 2517 | | range_of_explicit_set_wf(freetype(GS),_R,_) :- !, |
| 2518 | | add_error_and_fail(range_of_explicit_set_wf,'Cannot compute domain of freetype: ',GS). |
| 2519 | | range_of_explicit_set_wf(avl_set(A),Res,_) :- !, |
| 2520 | | avl_domain(A,EC), % -> expand_custom_set(avl_set(A),EC), |
| 2521 | | range(EC,R), |
| 2522 | | normalised_list_to_avl(R,Res). |
| 2523 | | range_of_explicit_set_wf(C,R,WF) :- |
| 2524 | | ran_for_specific_closure(C,Ran,WF),!, |
| 2525 | | Ran=R. |
| 2526 | | range_of_explicit_set_wf(C,R,_) :- |
| 2527 | | ran_symbolic(C,CC),!, |
| 2528 | | R=CC. |
| 2529 | | range_of_explicit_set_wf(closure(P,T,B),Res,WF) :- |
| 2530 | | expand_custom_set_wf(closure(P,T,B),EC,range_of_explicit_set_wf,WF), |
| 2531 | | % TO DO: it would be more useful here to directly just expand the projection onto the last component of P |
| 2532 | | range_blocking(EC,R), |
| 2533 | | normalised_list_to_avl_when_ground(R,Res). |
| 2534 | | |
| 2535 | | % TO DO: in future it is maybe better to add an in_range_wf kernel predicate |
| 2536 | | ran_symbolic(closure(Paras,Types,Pred), Res) :- |
| 2537 | ? | (is_memoization_closure(Paras,Types,Pred,_) |
| 2538 | | -> !,fail % memoization closures can never be dealt with symbolically; we need expansion |
| 2539 | | ; true), |
| 2540 | | expand_pair_closure(Paras,Types,Pred,[Y,X],[TY,TX],NewPred),!, |
| 2541 | | % following test (1541) works with this: 2 : ran({y|#(x).(y = x |-> x + 2 & x : NATURAL)}) |
| 2542 | | ran_symbolic_closure(Y,[X],TY,[TX],NewPred,Res). %, print('res: '),translate:print_bvalue(Res),nl. |
| 2543 | | ran_symbolic(closure([Y,X],[TY,TX],Pred), Res) :- |
| 2544 | | ran_symbolic_closure(Y,[X],TY,[TX],Pred,Res). |
| 2545 | | % TO DO: treat closures with more arguments: we need to quantify Y1,...Yn [Y1,...,Yn,X] |
| 2546 | | |
| 2547 | | % Replace single Identifier YX of type pair by pair (Y,X) where Y,X are (fresh) variables not occuring in Pred |
| 2548 | | % example: {y| #(x).(y = x |-> x + 2 & x : NATURAL)} --> {y__1,y__2|#(x).(y__1 |-> y__2 = x |-> x + 2 & x : NATURAL)} |
| 2549 | | expand_pair_closure([YX],[TYX],Pred,[Y,X],[TY,TX],NewPred) :- TYX = couple(TY,TX), |
| 2550 | | % Replace single ID YX of type pair by pair (Y,X) where Y,X are (fresh) variables not occuring in Pred |
| 2551 | | % example: {y| #(x).(y = x |-> x + 2 & x : NATURAL)} --> {y__1,y__2|#(x).(y__1 |-> y__2 = x |-> x + 2 & x : NATURAL)} |
| 2552 | | % following test (1541) works with this: 2 : ran({y|#(x).(y = x |-> x + 2 & x : NATURAL)}) |
| 2553 | | gensym:gensym(YX,Y),gensym:gensym(YX,X), |
| 2554 | | create_typed_id(Y,TY,YTID), create_typed_id(X,TX,XTID), |
| 2555 | | Pair = b(couple(YTID,XTID),TYX,[]), |
| 2556 | | bsyntaxtree:replace_id_by_expr(Pred,YX,Pair,NewPred). |
| 2557 | | |
| 2558 | | :- use_module(bsyntaxtree,[create_exists_opt_liftable/3]). |
| 2559 | | %:- use_module(bsyntaxtree,[add_texpr_info_if_new/3]). |
| 2560 | | ran_symbolic_closure(Y,Xs,TY,TXs,Pred,Res) :- |
| 2561 | | % create closure for {Xs | #Y.(Pred)} where Pred uses Y|->Xs |
| 2562 | | rename_ran_ids(Xs,Pred,[],XIDs,Pred2), |
| 2563 | | create_typed_id(Y,TY,YTID), |
| 2564 | | create_exists_opt_liftable([YTID],Pred2,Exists), % Y is liftable as the source is a closure with all ids |
| 2565 | | %bsyntaxtree:check_used_ids_in_ast(Exists), |
| 2566 | | %bsyntaxtree:create_exists_opt([YTID],[Pred2],Exists), %or |
| 2567 | | %b_interpreter_components:create_and_simplify_exists([YTID],Pred2,Exists), |
| 2568 | | %bsyntaxtree:add_texpr_info_if_new(Exists,allow_to_lift_exists,Exists2), % leads to pending co-routines in self_checks for bsets for apply_to; |
| 2569 | | % Reason: the tests ground only det WF; without lifting the exists is fully evaluated (and its waitflags with prio 2 and higher grounded) as the wait arguments are ground; with lifting only the det WF is grounded leading to pending coroutines |
| 2570 | | Res = closure(XIDs,TXs,Exists). |
| 2571 | | |
| 2572 | | |
| 2573 | | |
| 2574 | | :- use_module(library(lists),[select/3]). |
| 2575 | | |
| 2576 | | % rename lambda_results : |
| 2577 | | rename_ran_ids([],Pred,_,[],Pred). |
| 2578 | | rename_ran_ids([X|TX],Pred,Acc,[XID|TTX],Pred2) :- |
| 2579 | | % in case X is _lambda_result_ we need to rename it as it then would not get enumerated ! |
| 2580 | | (X == '_lambda_result_' |
| 2581 | | -> get_fresh_id('_was_lambda_result_',TX,Acc,XID), |
| 2582 | | % we could remove lambda_result info field, but it will no longer match new id anyway |
| 2583 | | rename_bt(Pred,[rename(X,XID)],Pred2), |
| 2584 | | TTX=TX |
| 2585 | | % TODO: maybe we should also remove the prob_annotation('LAMBDA-EQUALITY') info inside Pred for the ids and equality !? |
| 2586 | | ; XID = X, rename_ran_ids(TX,Pred,[X|Acc],TTX,Pred2) |
| 2587 | | ). |
| 2588 | | |
| 2589 | | :- use_module(b_ast_cleanup,[get_unique_id/2]). |
| 2590 | | get_fresh_id(ID,List1,List2,Res) :- nonmember(ID,List1), nonmember(ID,List2),!, Res=ID. |
| 2591 | | get_fresh_id(ID,_,_,FRESHID) :- nl,print('*** VARIABLE_CLASH PREVENTED: '), print(ID),nl, |
| 2592 | | get_unique_id(ID,FRESHID). |
| 2593 | | |
| 2594 | | :- block range_blocking(-,?). |
| 2595 | | range_blocking([],[]). |
| 2596 | | range_blocking([(_A,B)|T],[B-true|DT]) :- range_blocking(T,DT). |
| 2597 | | % and a non-blocking version: |
| 2598 | | range([],[]). |
| 2599 | | range([(_A,B)|T],[B-true|DT]) :- range(T,DT). |
| 2600 | | |
| 2601 | | ran_for_specific_closure(closure(P,T,Pred),Range,WF) :- |
| 2602 | | dom_range_for_specific_closure2(P,T,Pred, _Domain,Range,_Functionality,WF). |
| 2603 | | %ran_for_specific_closure(closure_x(P,T,Pred,_Exp),Card,_) :- ran_for_specific_closure2(P,T,Pred,Card). |
| 2604 | | |
| 2605 | | :- use_module(bsyntaxtree,[conjunct_predicates/2, disjunct_predicates/2, create_typed_id/3, get_texpr_type/2]). |
| 2606 | | override_custom_explicit_set_wf(R,S,Res,WF) :- /* R <+ S */ |
| 2607 | | nonvar(R),override_custom_explicit_set_aux(R,S,Res,WF). |
| 2608 | | override_custom_explicit_set_aux(CL,Rel2,Res,_WF) :- |
| 2609 | | CL=closure(P0,T,B0), |
| 2610 | | % TO DO: maybe call keep_symbolic in bsets_clp ?? |
| 2611 | | ( preferences:get_preference(convert_comprehension_sets_into_closures,true), |
| 2612 | | (var(Rel2) -> true ; Rel2 \= avl_set(_)) % if Rel2 is avl_set then maybe better to compute explicitly; unless infinite |
| 2613 | | ; quick_size_check_larger_than(Rel2,Size2,133) -> |
| 2614 | | % if we have a large AVL set anyway; then allow expansion up to a larger limit; cf machine 670_002.mch |
| 2615 | | % a lot of machines use A*B*C <+ {....} to more compactly define large explicit sets |
| 2616 | | (Size2=inf -> Limit = 200000 |
| 2617 | | ; Limit is min(200000,Size2*150)), dont_expand_this_closure(P0,T,B0,Limit) |
| 2618 | ? | ; dont_expand_this_closure(P0,T,B0) % use default limit |
| 2619 | | ), |
| 2620 | | !, |
| 2621 | | rename_ran_ids(P0,B0,[],P,B), % any '_lambda_result_' id is no longer guaranteed to be assigned a value in all cases |
| 2622 | | NewClosure=closure(P,T,NewBody), |
| 2623 | | % B <+ Rel2 ---> NewBody = P:Rel2 or (prj1(P) /: dom(Rel2) & B) |
| 2624 | | % TODO better? : %x.(x:Domain|IF x:dom(SFF) THEN SFF(x) ELSE DEFAULT)? |
| 2625 | | generate_typed_id_pairs(P,T,NestedPairs), |
| 2626 | | get_texpr_type(NestedPairs,PairsType), |
| 2627 | | RelPairsType = set(PairsType), |
| 2628 | | ValS = b(value(Rel2),RelPairsType,[]), |
| 2629 | | MemS = b(member(NestedPairs,ValS),pred,[]), % P:Rel2 |
| 2630 | | get_prj1(NestedPairs,DomExpr), |
| 2631 | | get_texpr_type(DomExpr,DomType), |
| 2632 | | Domain = b(domain(ValS),set(DomType),[]), % TO DO: perform some optimisations like dom(%x.(P|E)) --> {x|P} |
| 2633 | | %bsets_clp:domain_wf(Rel2,DomainOfRel2,WF), Domain = b(value(DomainOfRel2),DomType,[]), % this DOES NOT work for 1619, 1706 where override is used for infinite functions |
| 2634 | | NotMemDomS = b(not_member(DomExpr,Domain),pred,[]), % prj1(P) /: dom(Rel2) |
| 2635 | | conjunct_predicates([NotMemDomS,B],RHS), |
| 2636 | | disjunct_predicates([MemS,RHS],NewBody), |
| 2637 | | %print(override),nl, bsyntaxtree:check_used_ids_in_ast(NewBody), |
| 2638 | | mark_closure_as_symbolic(NewClosure,Res). |
| 2639 | | % TO DO: add a case where for second set we have: dont_expand_this_closure |
| 2640 | | override_custom_explicit_set_aux(R,S,Res,WF) :- |
| 2641 | | is_custom_explicit_set(R,override_custom_explicit_set), |
| 2642 | | nonvar(S), is_custom_explicit_set(S,override_custom_explicit_set), |
| 2643 | | %% hit_profiler:add_profile_hit(override(R,S),3), %% |
| 2644 | | override_custom_explicit_set2(R,S,Res,WF). |
| 2645 | | |
| 2646 | | override_custom_explicit_set2(R,S,Res,_WF) :- is_one_element_custom_set(S,(X,Y)), |
| 2647 | | override_pair_explicit_set(R,X,Y,NewR),!, |
| 2648 | | Res=NewR. |
| 2649 | | % TO DO: if R is very large and S relatively small : iterate by calling override_pair_explicit_set |
| 2650 | | override_custom_explicit_set2(R,S,Res,WF) :- |
| 2651 | | expand_custom_set_wf(R,ER,override_custom_explicit_set_aux1,WF), |
| 2652 | | expand_custom_set_wf(S,ES,override_custom_explicit_set_aux2,WF), |
| 2653 | | override_list(ER,ES,LRes,Done), |
| 2654 | | finish_restriction(Done,LRes,Res). |
| 2655 | | |
| 2656 | | quick_size_check_larger_than(Set,Size,Limit) :- |
| 2657 | | quick_custom_explicit_set_approximate_size(Set,Size), |
| 2658 | | (is_inf_or_overflow_card(Size) -> true ; Size > Limit). |
| 2659 | | get_prj1(b(couple(DomExpr,_),_,_),Prj1) :- !, Prj1 = DomExpr. |
| 2660 | | get_prj1(BE,b(first_of_pair(BE),DT,[])) :- % some closures have a single identifier; we need to apply prj1 |
| 2661 | | BE = b(_E,couple(DT,_RT),_I). |
| 2662 | | |
| 2663 | | % translate a parameter name and type list into a nested-pair value |
| 2664 | | generate_typed_id_pairs([ID|IT],[Type|TT],Res) :- create_typed_id(ID,Type,TypedID), |
| 2665 | | conv2(IT,TT,TypedID,Res). |
| 2666 | | conv2([],[],X,X). |
| 2667 | | conv2([ID|IT],[Type|TT],Acc,Res) :- create_typed_id(ID,Type,TypedID), |
| 2668 | | get_texpr_type(Acc,AccType), |
| 2669 | | Couple = b(couple(Acc,TypedID),couple(AccType,Type),[]), |
| 2670 | | conv2(IT,TT,Couple,Res). |
| 2671 | | |
| 2672 | | :- block override_list(-,?,?,?), override_list(?,-,?,?). |
| 2673 | | override_list([],S,Res,Done) :- !, copy_to_true_list(S,Res,Done). |
| 2674 | | override_list(R,[],Res,Done) :- !, copy_to_true_list(R,Res,Done). |
| 2675 | | override_list([(From1,To1)|T1],[(From2,To2)|T2],Res,Done) :- |
| 2676 | | (From1 @< From2 |
| 2677 | | -> Res = [(From1,To1)-true|TR], override_list(T1,[(From2,To2)|T2],TR,Done) |
| 2678 | | ; From2 @< From1 |
| 2679 | | -> Res = [(From2,To2)-true|TR], override_list([(From1,To1)|T1],T2,TR,Done) |
| 2680 | | ; override_list(T1,[(From2,To2)|T2],Res,Done)). |
| 2681 | | |
| 2682 | | :- block copy_to_true_list(-,?,?). |
| 2683 | | % add -true to get lists that can be converted to avl |
| 2684 | | copy_to_true_list([],[],true). |
| 2685 | | copy_to_true_list([H|T],[H-true|CT],Done) :- copy_to_true_list(T,CT,Done). |
| 2686 | | |
| 2687 | | :- use_module(closures,[get_domain_range_for_closure_types/3]). |
| 2688 | | % compute a closure with the functionality violations of a closure |
| 2689 | | symbolic_functionality_check_closure(closure(P,T,B),closure([DID,ID1,ID2],[DomType,RanType,RanType],Body)) :- |
| 2690 | | % construct {d,z_,z__| (d,z_):R & (d,z__):R & z_\= z__} |
| 2691 | | generate_typed_id_pairs(P,T,NestedPairs), |
| 2692 | | get_texpr_type(NestedPairs,PairsType), |
| 2693 | | RelPairsType = set(PairsType), |
| 2694 | | TRel = b(value(closure(P,T,B)),RelPairsType,[]), |
| 2695 | | DID = '_domain', ID1 = '_zzzz_unary', ID2 = '_zzzz_binary', |
| 2696 | | TDID = b(identifier(DID),DomType,[]), |
| 2697 | | TID1 = b(identifier(ID1),RanType,[]), |
| 2698 | | TID2 = b(identifier(ID2),RanType,[]), |
| 2699 | | Mem1 = b(member( b(couple(TDID,TID1),PairsType,[]),TRel),pred,[]), |
| 2700 | | Mem2 = b(member( b(couple(TDID,TID2),PairsType,[]),TRel),pred,[]), |
| 2701 | | get_domain_range_for_closure_types(T,DomType,RanType), |
| 2702 | | NeqRan = b(not_equal(TID1,TID2), pred, []), |
| 2703 | | conjunct_predicates([Mem1,Mem2,NeqRan],Body), |
| 2704 | | bsyntaxtree:check_used_ids_in_ast(Body). |
| 2705 | | %bsyntaxtree:check_ast(Body). |
| 2706 | | |
| 2707 | | % compute a closure with the injectivity violations of a closure |
| 2708 | | symbolic_injectivity_check_closure(closure(P,T,B),closure([RID,ID1,ID2],[RanType,DomType,DomType],Body)) :- |
| 2709 | | % construct {r,z_,z__| (z_,r):R & (z__,r):R & z_\= z__} |
| 2710 | | generate_typed_id_pairs(P,T,NestedPairs), |
| 2711 | | get_texpr_type(NestedPairs,PairsType), |
| 2712 | | RelPairsType = set(PairsType), |
| 2713 | | TRel = b(value(closure(P,T,B)),RelPairsType,[]), % what if closure body B has WD condition? |
| 2714 | | RID = '_range', ID1 = '_zzzz_unary', ID2 = '_zzzz_binary', |
| 2715 | | TRID = b(identifier(RID),RanType,[]), |
| 2716 | | TID1 = b(identifier(ID1),DomType,[]), |
| 2717 | | TID2 = b(identifier(ID2),DomType,[]), |
| 2718 | | Mem1 = b(member( b(couple(TID1,TRID),PairsType,[]),TRel),pred,[]), |
| 2719 | | Mem2 = b(member( b(couple(TID2,TRID),PairsType,[]),TRel),pred,[]), |
| 2720 | | get_domain_range_for_closure_types(T,DomType,RanType), |
| 2721 | | NeqRan = b(not_equal(TID1,TID2), pred, []), |
| 2722 | | conjunct_predicates([Mem1,Mem2,NeqRan],Body), |
| 2723 | | bsyntaxtree:check_used_ids_in_ast(Body). |
| 2724 | | %bsyntaxtree:check_ast(Body). |
| 2725 | | |
| 2726 | | % ------------------------- |
| 2727 | | |
| 2728 | | |
| 2729 | | % check whether we have a partial function |
| 2730 | | is_avl_partial_function(empty) :- !. |
| 2731 | | is_avl_partial_function(node((KeyFrom,_KeyTo),_True,_,L,R)) :- !, |
| 2732 | | is_avl_partial_function2(L,'$$MIN$$',KeyFrom), |
| 2733 | | is_avl_partial_function2(R,KeyFrom,'$$MAX$$'). |
| 2734 | | is_avl_partial_function(X) :- add_internal_error('Not avl_set or relation: ',is_avl_partial_function(X)),fail. |
| 2735 | | |
| 2736 | | % we traverse the tree from top to bottom, keeping track of possible upper- and lower-bounds |
| 2737 | | % if any value matches the upper or lower bound, the we do not have a partial function |
| 2738 | | is_avl_partial_function2(empty,_,_). |
| 2739 | | is_avl_partial_function2(node((KeyFrom,_KeyTo),_True,_,L,R),ParentFrom,ParentTo) :- |
| 2740 | | KeyFrom \= ParentFrom, KeyFrom \= ParentTo, |
| 2741 | | is_avl_partial_function2(L,ParentFrom,KeyFrom), |
| 2742 | | is_avl_partial_function2(R,KeyFrom,ParentTo). |
| 2743 | | |
| 2744 | | % the dual of the above, returning a counter example |
| 2745 | | is_not_avl_partial_function(node((KeyFrom,_KeyTo),_True,_,L,R),DuplicateKey) :- !, |
| 2746 | | (is_not_avl_partial_function2(L,'$$MIN$$',KeyFrom,DuplicateKey) -> true |
| 2747 | | ; is_not_avl_partial_function2(R,KeyFrom,'$$MAX$$',DuplicateKey)). |
| 2748 | | is_not_avl_partial_function2(node((KeyFrom,_KeyTo),_True,_,L,R),ParentFrom,ParentTo,DuplicateKey) :- |
| 2749 | | ( KeyFrom = ParentFrom -> DuplicateKey=KeyFrom |
| 2750 | | ; KeyFrom = ParentTo -> DuplicateKey=KeyFrom |
| 2751 | | ; is_not_avl_partial_function2(L,ParentFrom,KeyFrom,DuplicateKey) -> true |
| 2752 | | ; is_not_avl_partial_function2(R,KeyFrom,ParentTo,DuplicateKey) -> true). |
| 2753 | | |
| 2754 | | |
| 2755 | | % check whether we have a function which is total over a given domain; both as AVL sets |
| 2756 | | is_avl_total_function_over_domain(empty,empty) :- !. |
| 2757 | | is_avl_total_function_over_domain(AVLFun,AVLDom) :- |
| 2758 | | avl_domain(AVLFun,FunList), |
| 2759 | | avl_domain(AVLDom,DomList), |
| 2760 | | is_avl_total_fun2(FunList,DomList). |
| 2761 | | |
| 2762 | | is_avl_total_fun2([],[]). |
| 2763 | | is_avl_total_fun2([(From,_To)|FT],[From|DomT]) :- is_avl_total_fun2(FT,DomT). |
| 2764 | | |
| 2765 | | |
| 2766 | | %not_is_avl_partial_function(AVLF) :- \+ is_avl_partial_function(AVLF). |
| 2767 | | |
| 2768 | | :- use_module(kernel_equality,[membership_test_wf/4]). |
| 2769 | | % check whether an AVL Relation is not over a specific domain & range |
| 2770 | | is_not_avl_relation_over_domain_range(AVLRel,Domain,Range,WF) :- AVLRel \= empty, |
| 2771 | | avl_min_pair(AVLRel,RFrom,RTo), |
| 2772 | | membership_test_wf(Domain,RFrom,MemRes,WF), |
| 2773 | | is_not_avl_rel_dom1(MemRes,RFrom,RTo,AVLRel,Domain,Range,WF). |
| 2774 | | |
| 2775 | | :- block is_not_avl_rel_dom1(-, ?,?,?,?,?,?). |
| 2776 | | is_not_avl_rel_dom1(pred_false,_,_,_,_,_,_WF). |
| 2777 | | is_not_avl_rel_dom1(pred_true,RFrom,RTo,AVLRel,Domain,Range,WF) :- |
| 2778 | | membership_test_wf(Range,RTo,MemRes,WF), |
| 2779 | | is_not_avl_rel_dom2(MemRes,RFrom,RTo,AVLRel,Domain,Range,WF). |
| 2780 | | |
| 2781 | | :- block is_not_avl_rel_dom2(-, ?,?,?,?,?,?). |
| 2782 | | is_not_avl_rel_dom2(pred_false,_,_,_,_,_,_WF). |
| 2783 | | is_not_avl_rel_dom2(pred_true,RFrom,RTo,AVLRel,Domain,Range,WF) :- |
| 2784 | | avl_next((RFrom,RTo),AVLRel,(RFrom2,RTo2)), |
| 2785 | | membership_test_wf(Domain,RFrom2,MemRes,WF), |
| 2786 | | is_not_avl_rel_dom1(MemRes,RFrom2,RTo2,AVLRel,Domain,Range,WF). |
| 2787 | | |
| 2788 | | % check whether an AVL Relation is not over a specific range |
| 2789 | | is_not_avl_relation_over_range(AVLRel,Range,WF) :- AVLRel \= empty, |
| 2790 | | avl_min_pair(AVLRel,RFrom,RTo), |
| 2791 | | membership_test_wf(Range,RTo,MemRes,WF), |
| 2792 | | is_not_avl_rel_ran2(MemRes,RFrom,RTo,AVLRel,Range,WF). |
| 2793 | | |
| 2794 | | :- block is_not_avl_rel_ran2(-, ?,?,?,?,?). |
| 2795 | | is_not_avl_rel_ran2(pred_false,_,_,_,_,_WF). |
| 2796 | | is_not_avl_rel_ran2(pred_true,RFrom,RTo,AVLRel,Range,WF) :- |
| 2797 | | avl_next((RFrom,RTo),AVLRel,(RFrom2,RTo2)), |
| 2798 | | kernel_equality:membership_test_wf(Range,RTo2,MemRes,WF), |
| 2799 | | is_not_avl_rel_ran2(MemRes,RFrom2,RTo2,AVLRel,Range,WF). |
| 2800 | | |
| 2801 | | % check whether we have a relation |
| 2802 | | is_avl_relation(node((_KeyFrom,_KeyTo),_True,_,_,_)). |
| 2803 | | |
| 2804 | | % check whether a Relation has all its range elments in a certain Range (not necessarily AVL) |
| 2805 | | % TO DO: if Domain is an interval: we could take avl_min and avl_max and rely on lexicographic ordering |
| 2806 | | is_avl_relation_over_domain(AVL,IntervalClosure,_WF) :- |
| 2807 | | is_interval_closure_or_integerset(IntervalClosure,Low,Up),!, |
| 2808 | | ((avl_min(AVL,(int(ALow),_)), avl_max(AVL,(int(AUp),_))) |
| 2809 | | -> cs_greater_than_equal(ALow,Low), cs_greater_than_equal(Up,AUp) %,print(ok),nl |
| 2810 | | ; (AVL=empty -> true ; add_error_and_fail(is_avl_relation_over_domain,'Not a relation with integer domain: ',AVL))). |
| 2811 | | is_avl_relation_over_domain(_,Domain,_) :- |
| 2812 | | quick_is_definitely_maximal_set(Domain),!. |
| 2813 | | %is_definitely_maximal_set(Domain),!. |
| 2814 | | is_avl_relation_over_domain(AVL,Domain,WF) :- is_avl_relation_over_domain2(AVL,Domain,WF). |
| 2815 | | is_avl_relation_over_domain2(empty,_,_). |
| 2816 | | is_avl_relation_over_domain2(node((KeyFrom,_KeyTo),_,_,L,R), Domain,WF) :- |
| 2817 | | is_avl_relation_over_domain2(L, Domain,WF), |
| 2818 | | is_avl_relation_over_domain2(R, Domain,WF), |
| 2819 | | kernel_objects:check_element_of_wf(KeyFrom,Domain,WF). |
| 2820 | | |
| 2821 | | % : faster to check than is_definitely_maximal_set |
| 2822 | | quick_is_definitely_maximal_set(X) :- nonvar(X), |
| 2823 | | quick_is_definitely_maximal_set_aux(X). |
| 2824 | | quick_is_definitely_maximal_set_aux(global_set(GS)) :- |
| 2825 | | nonvar(GS),is_maximal_global_set(GS). |
| 2826 | | quick_is_definitely_maximal_set_aux(avl_set(AVL)) :- |
| 2827 | | quick_definitely_maximal_set_avl(AVL). |
| 2828 | | |
| 2829 | | % check whether a Relation has all its range elments in a certain Range (not necessarily AVL) |
| 2830 | | |
| 2831 | | |
| 2832 | | |
| 2833 | | is_avl_relation_over_range(empty,_,_) :- !. |
| 2834 | | is_avl_relation_over_range(_,Range,_) :- |
| 2835 | | %quick_is_definitely_maximal_set(Range), |
| 2836 | | is_definitely_maximal_set(Range), |
| 2837 | | !. |
| 2838 | | is_avl_relation_over_range(AVL,Range,WF) :- is_avl_relation_over_range2(AVL,Range,WF). |
| 2839 | | |
| 2840 | | is_avl_relation_over_range2(empty,_,_). |
| 2841 | | is_avl_relation_over_range2(node((_KeyFrom,KeyTo),_,_,L,R), Range,WF) :- |
| 2842 | | is_avl_relation_over_range(L, Range,WF), |
| 2843 | | kernel_objects:check_element_of_wf(KeyTo,Range,WF), |
| 2844 | | is_avl_relation_over_range2(R, Range,WF). |
| 2845 | | |
| 2846 | | |
| 2847 | | is_avl_sequence(empty) :- !. |
| 2848 | | is_avl_sequence(node((int(KeyFrom),_KeyTo),_True,_,L,R)) :- !, |
| 2849 | | is_avl_sequence2(L,0,KeyFrom), |
| 2850 | | is_avl_sequence2(R,KeyFrom,'$$MAX$$'). |
| 2851 | | is_avl_sequence(X) :- add_error_and_fail(is_avl_sequence,'Not avl_set or sequence: ',X). |
| 2852 | | |
| 2853 | | % we traverse the tree from top to bottom, keeping track of possible upper- and lower-bounds |
| 2854 | | % if any value matches the upper or lower bound, the we do not have a partial function |
| 2855 | | is_avl_sequence2(empty,X,Y) :- |
| 2856 | | (Y=='$$MAX$$' -> true ; Y is X+1). % otherwise there is a gap in the sequence |
| 2857 | | is_avl_sequence2(node((int(KeyFrom),_KeyTo),_,_,L,R),ParentFrom,ParentTo) :- |
| 2858 | | KeyFrom > ParentFrom, KeyFrom \= ParentTo, |
| 2859 | | is_avl_sequence2(L,ParentFrom,KeyFrom), |
| 2860 | | is_avl_sequence2(R,KeyFrom,ParentTo). |
| 2861 | | |
| 2862 | | % for performance: it is not worthwhile to make a version that checks that |
| 2863 | | % we have a sequence over a range using a single traversal |
| 2864 | | |
| 2865 | | |
| 2866 | | % get avl_sequence elements as sorted list (without indices) |
| 2867 | | % used by external function REPLACE |
| 2868 | | get_avl_sequence(AVL,SeqList) :- |
| 2869 | | get_avl_sequence_dcg(AVL,SeqList,[]). |
| 2870 | | |
| 2871 | | get_avl_sequence_dcg(empty) --> []. |
| 2872 | | get_avl_sequence_dcg(node((int(_),SeqEl),_True,_,L,R)) --> |
| 2873 | | get_avl_sequence_dcg(L), |
| 2874 | | [SeqEl], |
| 2875 | | get_avl_sequence_dcg(R). |
| 2876 | | |
| 2877 | | |
| 2878 | | % --------------------------- |
| 2879 | | prefix_of_custom_explicit_set(avl_set(A),MinIndex,Result,WF) :- |
| 2880 | | size_of_avl_sequence(A,Size,WF), |
| 2881 | | (MinIndex > Size |
| 2882 | | -> add_wd_error('index larger than size of sequence in prefix_sequence (/|\\)! ', '>'(MinIndex,Size),WF) |
| 2883 | | % ; MinIndex = 0 -> Result = [] % case already treated in bsets_clp |
| 2884 | | ; MinIndex = Size -> Result=avl_set(A) |
| 2885 | | ; prefix_of_custom_explicit_set2(A,MinIndex,OrdList,[]), |
| 2886 | | ord_list_to_avlset(OrdList,Result,prefix_of_custom_explicit_set) |
| 2887 | | ). |
| 2888 | | prefix_of_custom_explicit_set2(empty,_MaxIndex) --> {true}. |
| 2889 | | prefix_of_custom_explicit_set2(node((int(KeyFrom),KeyTo),_True,_,L,R),MaxIndex) --> |
| 2890 | | ({KeyFrom = MaxIndex} |
| 2891 | | -> prefix_of_custom_explicit_set2(L,MaxIndex), [((int(KeyFrom),KeyTo)-true)] |
| 2892 | | ; {KeyFrom > MaxIndex} -> prefix_of_custom_explicit_set2(L,MaxIndex) |
| 2893 | | ; prefix_of_custom_explicit_set2(L,MaxIndex), [((int(KeyFrom),KeyTo)-true)], |
| 2894 | | prefix_of_custom_explicit_set2(R,MaxIndex) |
| 2895 | | ). |
| 2896 | | |
| 2897 | | % size is only well-defined for sequences: |
| 2898 | | size_of_custom_explicit_set(avl_set(AVL),int(Size),WF) :- size_of_avl_sequence(AVL,Size,WF). |
| 2899 | | size_of_custom_explicit_set(closure(P,T,B),Res,WF) :- |
| 2900 | | is_lambda_value_domain_closure(P,T,B, DomainValue,_Expr), |
| 2901 | | kernel_cardinality_attr:finite_cardinality_as_int_wf(DomainValue,Res,WF). |
| 2902 | | size_of_avl_sequence(AVL,Size,WF) :- |
| 2903 | | preference(find_abort_values,true), |
| 2904 | | \+ is_avl_sequence(AVL),!, |
| 2905 | | avl_max_pair(AVL,int(Sz),_), |
| 2906 | | add_wd_error('Applying size to a value which is not a sequence',b(value(avl_set(AVL)),seq(any),[]),WF), |
| 2907 | | Size=Sz. % other calls to size_of_avl_sequence currently expect a value |
| 2908 | | size_of_avl_sequence(AVL,Size,WF) :- |
| 2909 | | % TO DO: checking minimum is 1? |
| 2910 | | avl_max_pair(AVL,int(Sz),_), |
| 2911 | | avl_height(AVL,H), % we cannot compute the height together with max; we need the longest path! |
| 2912 | | get_min_max_card(H,MinSize,MaxSize), |
| 2913 | | %avl_size(AVL,Real),format('AVL SeqSize: ~w, height: ~w, real size:~w, min: ~w, max: ~w~n',[Sz,H,Real,MinSize,MaxSize]), |
| 2914 | | (Sz > MaxSize |
| 2915 | | -> add_wd_error('Applying size to a value which is not a sequence (maximum index too large)',b(value(avl_set(AVL)),seq(any),[]),WF), |
| 2916 | | avl_size(AVL,Size) |
| 2917 | | % triggered by e.g. size({0|->1,0|->2,1|->3}) or size({0|->1,1|->2,3|->3,1|->22,1|->23,1|->24,1|->25,1|->26}) |
| 2918 | | ; Sz < MinSize |
| 2919 | | -> add_wd_error('Applying size to a value which is not a sequence (maximum index too small)',b(value(avl_set(AVL)),seq(any),[]),WF), |
| 2920 | | avl_size(AVL,Size) |
| 2921 | | % triggered by e.g. size([0,2,2,2] |> {2}) |
| 2922 | | ; Size=Sz). |
| 2923 | | |
| 2924 | | get_min_max_card(Height,MinCard,MaxCard) :- |
| 2925 | | % page 460, Knuth 3: The height of a balanced tree with N internal nodes always lies between lg(N+1) and 1.4405 lg(N+2) - 0.3277 |
| 2926 | | MaxCard is 2^Height - 1, |
| 2927 | | % 1.618034 is golden ration phi 0.5(1+sqrt(5)) , 2.236068 is sqrt(5) |
| 2928 | | % proof in Knuth uses fact: N > phi^(h+2)/sqrt(5) - 2 |
| 2929 | | MinCard is ceiling((1.61803398875**(Height+2)) / 2.2360679775 - 2). |
| 2930 | | |
| 2931 | | % check if a candidate size is possible given height: |
| 2932 | | avl_size_possible(AVL,SizeCandidate) :- |
| 2933 | | avl_height(AVL,Height), % TO DO: restrict to something like log2 of Height |
| 2934 | | get_min_max_card(Height,MinCard,MaxCard), |
| 2935 | | MinCard =< SizeCandidate, |
| 2936 | | SizeCandidate =< MaxCard. |
| 2937 | | |
| 2938 | | |
| 2939 | | suffix_of_custom_explicit_set(avl_set(A),MinIndex,Result,WF) :- |
| 2940 | | size_of_avl_sequence(A,Size,WF), |
| 2941 | | (MinIndex > Size |
| 2942 | | -> add_wd_error('index larger than size of sequence in suffix_sequence (\\|/)! ', '>'(MinIndex,Size),WF) |
| 2943 | | % ; MinIndex = 0 -> Result = avl_set(A) % case already treated in bsets_clp |
| 2944 | | ; MinIndex = Size -> Result=[] |
| 2945 | | ; suffix_of_custom_explicit_set2(A,MinIndex,OrdList,[]), |
| 2946 | | ord_list_to_avlset(OrdList,Result,suffix_of_custom_explicit_set) |
| 2947 | | ). |
| 2948 | | suffix_of_custom_explicit_set2(empty,_MinIndex) --> {true}. |
| 2949 | | suffix_of_custom_explicit_set2(node((int(KeyFrom),KeyTo),_True,_,L,R),MinIndex) --> |
| 2950 | | ({KeyFrom =< MinIndex} -> suffix_of_custom_explicit_set2(R,MinIndex) |
| 2951 | | ; {ShiftedKeyFrom is KeyFrom-MinIndex}, |
| 2952 | | ({KeyFrom =:= MinIndex+1} |
| 2953 | | -> {true} ; suffix_of_custom_explicit_set2(L,MinIndex)), |
| 2954 | | [((int(ShiftedKeyFrom),KeyTo)-true)], |
| 2955 | | suffix_of_custom_explicit_set2(R,MinIndex) |
| 2956 | | ). |
| 2957 | | |
| 2958 | | shift_avl_sequence_to_ord_list(AVL,Offset,ShiftedOrdList) :- |
| 2959 | | avl_to_list(AVL,List),shift_seq(List,Offset,ShiftedOrdList). |
| 2960 | | % it does not seem to be worth to use avl_to_list_dcg_offset or a variation thereof |
| 2961 | | % it is not really slower to do two traversals (avl_to_list and shift_seq) |
| 2962 | | |
| 2963 | | shift_seq([],_,[]). |
| 2964 | | shift_seq([(int(I),Val)-true|T],Offset,[(int(NI),Val)-true|ST]) :- NI is I+Offset, |
| 2965 | | shift_seq(T,Offset,ST). |
| 2966 | | |
| 2967 | | :- use_module(debug). |
| 2968 | | concat_custom_explicit_set(avl_set(S1),Seq2,Res,WF) :- nonvar(Seq2), Seq2=avl_set(S2), |
| 2969 | | size_of_avl_sequence(S1,Size1,WF), |
| 2970 | | shift_avl_sequence_to_ord_list(S2,Size1,OL2), |
| 2971 | | % if OL2 is small we could use avl_store like in append_custom_explicit_set |
| 2972 | | %avl_to_list(S1,OL1), |
| 2973 | | avl_to_list_dcg(S1,NewOrdList,OL2), % use OL2 rather than [] as tail |
| 2974 | | %append(OL1,OL2,NewOrdList), % we could avoid traversing OL1 again by doing a custom avl_to_list/3 which specifies tail |
| 2975 | | ord_list_to_avlset(NewOrdList,Res,concat). % , print_term_summary(res_concat(Res)). |
| 2976 | | |
| 2977 | | % a DCG version of avl_to_list; allows to call it with something else than [] as tail |
| 2978 | | avl_to_list_dcg(empty) --> []. |
| 2979 | | avl_to_list_dcg(node(Key,Val,_,L,R)) --> |
| 2980 | | avl_to_list_dcg(L), [(Key-Val)], |
| 2981 | | avl_to_list_dcg(R). |
| 2982 | | |
| 2983 | | /* conc: concatenation of sequence of sequences (general_concat) */ |
| 2984 | | conc_custom_explicit_set(avl_set(AVL),Res) :- |
| 2985 | | avl_min_pair(AVL,int(ONE),First), |
| 2986 | | conc2_cs(First,ONE,AVL,0,NewOrdList), |
| 2987 | | ord_list_to_avlset(NewOrdList,Res,conc). |
| 2988 | | |
| 2989 | | conc2_cs(Seq,NrSeq,AVL,Offset,OrdList) :- |
| 2990 | | add_seq(Seq,Offset,OrdList,NewOffset,TailOrd), |
| 2991 | | (avl_next((int(NrSeq),Seq),AVL,(int(N2),Seq2)) |
| 2992 | | -> conc2_cs(Seq2,N2,AVL,NewOffset,TailOrd) |
| 2993 | | ; TailOrd=[]). |
| 2994 | | |
| 2995 | | add_seq([],Offset,OrdRes,NewOffset,TailOrdRes) :- NewOffset=Offset, TailOrdRes=OrdRes. |
| 2996 | | add_seq(avl_set(ASeq),Offset,OrdRes,NewOffset,TailOrd) :- |
| 2997 | | avl_to_list_dcg_offset(ASeq,Offset,NrEls,OrdRes,TailOrd), NewOffset is Offset+NrEls. |
| 2998 | | |
| 2999 | | % a version of avl_to_list for sequences which autmatically adds an offset |
| 3000 | | avl_to_list_dcg_offset(empty,_,0) --> []. |
| 3001 | | avl_to_list_dcg_offset(node((int(Idx),El),Val,_,L,R),Offset,NrEls) --> |
| 3002 | | {NIdx is Idx+Offset}, |
| 3003 | | avl_to_list_dcg_offset(L,Offset,N1), |
| 3004 | | [((int(NIdx),El)-Val)], |
| 3005 | | avl_to_list_dcg_offset(R,Offset,N2), {NrEls is N1+N2+1}. |
| 3006 | | |
| 3007 | | prepend_custom_explicit_set(avl_set(S1),ObjectToPrepend,Res) :- |
| 3008 | | %hit_profiler:add_profile_hit(prepend_custom_explicit_set(avl_set(S1),ObjectToPrepend,Res)), |
| 3009 | | element_can_be_added_or_removed_to_avl(ObjectToPrepend), |
| 3010 | | shift_avl_sequence_to_ord_list(S1,1,OL1), |
| 3011 | | ord_list_to_avlset([(int(1),ObjectToPrepend)-true|OL1],Res). |
| 3012 | | |
| 3013 | | append_custom_explicit_set(avl_set(S1),ObjectToAppend,Res,WF) :- |
| 3014 | | element_can_be_added_or_removed_to_avl(ObjectToAppend), % implies that ObjectToAppend is ground |
| 3015 | | size_of_avl_sequence(S1,Size1,WF), NewSize is Size1+1, |
| 3016 | | add_ground_element_to_explicit_set_wf(avl_set(S1),(int(NewSize),ObjectToAppend),Res,WF). |
| 3017 | | |
| 3018 | | % compute tail of a sequence and also return first element |
| 3019 | | tail_sequence_custom_explicit_set(avl_set(S1),First,Res,Span,WF) :- |
| 3020 | | shift_avl_sequence_to_ord_list(S1,-1,NewOrdList), |
| 3021 | | (NewOrdList = [(int(0),First)-true|TailOL] -> ord_list_to_avlset(TailOL,Res) |
| 3022 | | ; add_wd_error_span('tail argument is not a sequence!', avl_set(S1),Span,WF) |
| 3023 | | % add_error_fail(tail_sequence,'tail applied to ', NewOrdList)) |
| 3024 | | ). |
| 3025 | | last_sequence_explicit_set(avl_set(AVL),Last) :- |
| 3026 | | avl_max_pair(AVL,int(_Sz),Last). |
| 3027 | | % TO DO: we could compute height of the path to max H, then check that Sz is in 2**(H-1)+1 .. 2**(H+1)-1 ? |
| 3028 | | %first_sequence_explicit_set(avl_set(AVL),First) :- % not used anymore; apply_to used instead |
| 3029 | | % avl_min_pair(AVL,int(_One),First). |
| 3030 | | |
| 3031 | | % compute front and return last element at the same time |
| 3032 | | front_sequence_custom_explicit_set(avl_set(AVL),Last,Res) :- |
| 3033 | | avl_max_pair(AVL,int(Size),Last), |
| 3034 | | direct_remove_element_from_avl(AVL, (int(Size),Last), Res). % we know Last is already in AVL-converted format |
| 3035 | | |
| 3036 | | |
| 3037 | | reverse_custom_explicit_set(avl_set(AVL),Res) :- |
| 3038 | | avl_to_list_dcg_offset(AVL,0,Size,List,[]), |
| 3039 | | S1 is Size+1, |
| 3040 | | reverse_list(List,S1,[],RevList), |
| 3041 | | ord_list_to_avl(RevList,RevAVL), |
| 3042 | | Res=avl_set(RevAVL). |
| 3043 | | |
| 3044 | | reverse_list([],_,Acc,Acc). |
| 3045 | | reverse_list([(int(Idx),El)-V|T],S1,Acc,Res) :- |
| 3046 | | NewIdx is S1 - Idx, |
| 3047 | | reverse_list(T,S1,[(int(NewIdx),El)-V|Acc],Res). |
| 3048 | | |
| 3049 | | % check if a relation is injective ; compute range at the same time; note AVL can be empty |
| 3050 | | is_injective_avl_relation(AVL,RangeRes) :- |
| 3051 | | avl_domain(AVL,ElList), |
| 3052 | | empty_avl(EmptyAcc), |
| 3053 | | is_avl_inj_list(ElList,EmptyAcc,Range), |
| 3054 | | construct_avl_set(Range,RangeRes). |
| 3055 | | |
| 3056 | | is_avl_inj_list([],Range,Range). |
| 3057 | | is_avl_inj_list([(_From,To)|T],InRange,OutRange) :- |
| 3058 | | (avl_fetch(To,InRange) -> fail /* this is not an injection; a range element is repeated */ |
| 3059 | | ; avl_store(To,InRange,true,InRange1), |
| 3060 | | is_avl_inj_list(T,InRange1,OutRange) |
| 3061 | | ). |
| 3062 | | |
| 3063 | | % Example predicates that work with code below: |
| 3064 | | % card(id((1..1000)*(1..1000))~)=1000*1000 |
| 3065 | | % card(((1..1000)*(1..1000))~)=1000*1000 |
| 3066 | | invert_explicit_set(global_set(GS),_R) :- !, |
| 3067 | | add_error_and_fail(invert_explicit_set,'Cannot compute inverse of global set: ',GS). |
| 3068 | | invert_explicit_set(freetype(GS),_R) :- !, |
| 3069 | | add_error_and_fail(invert_explicit_set,'Cannot compute inverse of freetype: ',GS). |
| 3070 | | invert_explicit_set(closure([P1,P2],[T1,T2],Clo),R) :- !, |
| 3071 | | % TODO: also invert closures with single argument or more arguments |
| 3072 | | % e.g., {a,b,c|a=1 & b=1 &c:1..10}~ = {c,ab|ab=(1,1) & c:1..10} |
| 3073 | | R = closure([P2,P1],[T2,T1],Clo). |
| 3074 | | invert_explicit_set(closure([P1],[T1],Clo),R) :- |
| 3075 | | is_member_closure_with_info([P1],[T1],Clo,_Type,Info,MEM), |
| 3076 | | invert_member_predicate(MEM,T1,InvMEM,InvT1),!, |
| 3077 | | construct_member_closure(P1,InvT1,Info,InvMEM,R). |
| 3078 | | invert_explicit_set(C,AVL) :- expand_custom_set(C,EC,invert_explicit_set), %% convert to AVL ? |
| 3079 | | inv_and_norm(EC,AVL). |
| 3080 | | |
| 3081 | | invert_member_predicate(cartesian_product(A,B),couple(TA,TB), |
| 3082 | | cartesian_product(B,A),couple(TB,TA)). |
| 3083 | | invert_member_predicate(identity(A),TA,identity(A),TA). |
| 3084 | | |
| 3085 | | |
| 3086 | | :- block inv_and_norm(-,?). |
| 3087 | | inv_and_norm(EC,AVL) :- inv(EC,R,Done), norm(Done,R,AVL). |
| 3088 | | |
| 3089 | | :- block norm(-,?,?). |
| 3090 | | norm(_,R,AVL) :- normalised_list_to_avl(R,AVL). |
| 3091 | | |
| 3092 | | :- block inv(-,?,?). |
| 3093 | | inv([],[],done). |
| 3094 | | inv([(A,B)|T],[(B,A)-true|DT],Done) :- inv(T,DT,Done). |
| 3095 | | |
| 3096 | | |
| 3097 | | |
| 3098 | | % checks whether a ground value is in the domain of an AVL relation |
| 3099 | | check_in_domain_of_avlset(X,AVL) :- convert_to_avl_inside_set(X,AX),!, |
| 3100 | ? | (avl_fetch_pair(AX,AVL,_) -> true ; fail). |
| 3101 | | check_in_domain_of_avlset(X,AVL) :- |
| 3102 | | print('### could not convert arg for check_in_domain_of_avlset'),nl, |
| 3103 | | print(X),nl, |
| 3104 | | safe_avl_member_pair(X,_,AVL). |
| 3105 | | |
| 3106 | | % checks whether a ground value is in the domain of an AVL relation and has only one solution |
| 3107 | | check_unique_in_domain_of_avlset(X,AVL) :- convert_to_avl_inside_set(X,AX),!, |
| 3108 | | avl_fetch_pair(AX,AVL,AY1),!, |
| 3109 | | (avl_fetch_pair(AX,AVL,AY2), AY1 \= AY2 -> fail |
| 3110 | | ; true). |
| 3111 | | |
| 3112 | | |
| 3113 | | % utility to check if for a value there is at most one matching element in an AVL set |
| 3114 | | % optimized for function application |
| 3115 | | at_most_one_match_possible(Element,AVL,Matches) :- nonvar(Element), |
| 3116 | | Element=(Index,_Rest), % Function Application; TO DO: does this cover all func. appl ? |
| 3117 | | element_can_be_added_or_removed_to_avl(Index), |
| 3118 | | convert_to_avl_inside_set(Index,AX), % is ground and normalised ? |
| 3119 | | % TO DO: check AVL size ? Check other patterns ? |
| 3120 | | findall((AX,Match),avl_tools:avl_fetch_pair(AX,AVL,Match),Matches), |
| 3121 | | Matches \= [_,_|_]. |
| 3122 | | |
| 3123 | | |
| 3124 | | |
| 3125 | | apply_to_avl_set(A,X,Y,Span,WF) :- |
| 3126 | | ground_value_check(X,GroundX), |
| 3127 | | apply_to_avl_set_aux(A,X,Y,GroundX,Span,WF). |
| 3128 | | |
| 3129 | | apply_to_avl_set_aux(A,X,Y,GroundX,Span,WF) :- nonvar(GroundX),!, |
| 3130 | | apply_check_tuple(X,Y,A,Span,WF). % we could call apply_check_tuple_ground to avoid one ground test |
| 3131 | | % We know that A is a function: we can deterministically apply if X is ground; |
| 3132 | | % if Y is ground this is only the cases for injective functions |
| 3133 | | apply_to_avl_set_aux(A,X,Y,GroundX,Span,WF) :- |
| 3134 | | %(preference(data_validation_mode,true); % we now reduce priority of backpropagation below |
| 3135 | | preference(find_abort_values,true), |
| 3136 | | % do not try inverse propagation onto argument X of function application A(X) = Y |
| 3137 | | !, |
| 3138 | | avl_approximate_size(A,3,ApproxSizeA), |
| 3139 | | apply_check_tuple_delay(X,Y,A,ApproxSizeA,Span,WF,GroundX,_,_). |
| 3140 | | apply_to_avl_set_aux(A,X,Y,GroundX,Span,WF) :- |
| 3141 | | ground_value_check(Y,GroundY), |
| 3142 | | avl_approximate_size(A,3,ApproxSizeA), % exact size for height <= 3; approximate size above |
| 3143 | | (ApproxSizeA < 4 -> SPrio=ApproxSizeA ; SPrio is ApproxSizeA * 10), % magic number; ideally we want X or Y to be known beforehand; if none are known we may miss WD errors and may enumerate useless intermediate variables |
| 3144 | | get_bounded_wait_flag(SPrio,apply_to_explicit(X,Y),WF,WF1), % this only makes sense if X is a domain variable to be enumerated |
| 3145 | | %propagate_avl_element_information((X,Y),A,ApproxSizeA,WF), % could be done; but would prevent WD problems from being detected |
| 3146 | | % this waitflag is used when neither X nor Y are ground; |
| 3147 | | % quite often not much is gained by enumerating possible values; unless X or Y are constrained or trigger other computations |
| 3148 | | % WSz is 10*ApproxSizeA, % magic value |
| 3149 | | %(ApproxSizeA > 100 -> InversePrioSize = 4 |
| 3150 | | % ; avl_range_size_and_propagate_element_info(A,X,Y,RSize), InversePrioSize is ApproxSizeA // RSize), % we could probably compute the exact worst case with the same complexity |
| 3151 | | % delay_get_wait_flag(GroundY,GroundX,WF1,InversePrioSize,apply_to_explicit_inverse(X,Y),WF,WF2), |
| 3152 | | %(ApproxSizeA<4000 -> propagate_apply(X,Y,A,ApproxSizeA,WF,GroundX,GroundY) ; true), |
| 3153 | | apply_check_tuple_delay(X,Y,A,ApproxSizeA,Span,WF,GroundX,WF1,GroundY), |
| 3154 | | (preference(use_clpfd_solver,false) -> true |
| 3155 | | % should we also check: preference(find_abort_values,true)? |
| 3156 | | ; get_wait_flag0(WF,WF0), |
| 3157 | | propagate_apply(X,Y,A,ApproxSizeA,WF,WF0,GroundX,WF1,GroundY)). |
| 3158 | | |
| 3159 | | :- block propagate_apply(?,?,?,?,?,-,?,?,?). |
| 3160 | | propagate_apply(X,Y,AVL,ApproxSizeA,WF,_,GroundX,WF1,GroundY) :- |
| 3161 | | var(GroundX), var(WF1), var(GroundY), |
| 3162 | | (preference(disprover_mode,true) |
| 3163 | | -> XX=X % this will also instantiate X and prevent finding WD errors |
| 3164 | | ; (ApproxSizeA<128 -> true |
| 3165 | | ; preference(solver_strength,SS), ApproxSizeA < 128+SS*100), % up until 4000 it may make sense to constrain Y |
| 3166 | | preference(data_validation_mode,false), % note: this can slow down ProB, e.g., test 1105; hence allow disabling it |
| 3167 | | preference(find_abort_values,false), % TO DO: v = %x.(x:1..20|x+x) & {y,z|y<4 & z=v(y) & (y:{-1,2})} =res: no WD ERROR found |
| 3168 | | propagate_value(X,XX) % only instantiate X, propagation only makes sense for propagate_avl_element_information_small, as otherwise only X will be bounded |
| 3169 | | ), |
| 3170 | | !, |
| 3171 | | propagate_avl_element_information_direct((XX,Y),AVL,ApproxSizeA,WF). |
| 3172 | | propagate_apply(_,_,_,_,_,_,_,_,_). |
| 3173 | | |
| 3174 | | % only propagate in one direction to allow to find WD errors but also prevent pending co-routines/constraints |
| 3175 | | :- block propagate_value(-,?). |
| 3176 | | propagate_value(int(X),R) :- !, |
| 3177 | | ( |
| 3178 | | %%integer(X) -> R=int(X) ; % relevant for SWI 8.5.10 and older where fd_set fails for integers, see test 788; should be fixed in next release |
| 3179 | | propagate_fd_dom(X,RX), R=int(RX), propagate_atomic_value(X,RX) |
| 3180 | | ). |
| 3181 | | propagate_value(fd(X,T),R) :- !, |
| 3182 | | ( |
| 3183 | | %%integer(X) -> R=fd(X,T) ; % for SWI 8.5.10 and older, see above |
| 3184 | | propagate_fd_dom(X,RX), R=fd(RX,T), propagate_atomic_value(X,RX) |
| 3185 | | ). |
| 3186 | | propagate_value((X1,X2),R) :- !, R=(RX1,RX2), propagate_value(X1,RX1), propagate_value(X2,RX2). |
| 3187 | | propagate_value(pred_true,R) :- !, if(R=pred_true,true,debug_println(9,function_arg_outside_domain(pred_true))). |
| 3188 | | propagate_value(pred_false,R) :- !, if(R=pred_false,true,debug_println(9,function_arg_outside_domain(pred_false))). |
| 3189 | | propagate_value(string(X),R) :- !, R=string(RX),propagate_atomic_value(X,RX). |
| 3190 | | propagate_value(X,RX) :- equal_object(X,RX). % TO DO: get rid of this: this propagates and prevents finding WD errors |
| 3191 | | :- block propagate_atomic_value(-,?). |
| 3192 | | propagate_atomic_value(X,Y) :- |
| 3193 | | if(X=Y,true,debug_println(9,function_arg_outside_domain(X))). |
| 3194 | | |
| 3195 | | %propagate_fd_dom(X,RX) :- integer(X),!,RX=X. % relevant for SWI 8.5.10 and older where fd_set fails for integers |
| 3196 | | propagate_fd_dom(X,RX) :- fd_set(X,Dom),in_set(RX,Dom). |
| 3197 | | |
| 3198 | | |
| 3199 | | /* |
| 3200 | | :- block propagate_apply(-,?,?,?,?,-,-). |
| 3201 | | % call propagate as soon as we know something about the function argument and we do not propgagate completely using GroundX/Y anyway |
| 3202 | | propagate_apply(X,Y,AVL,Size,WF,GroundX,GroundY) :- print(prop_apply(Size,GroundX,GroundY,X,Y)),nl, |
| 3203 | | (nonvar(GroundX) -> true ; nonvar(GroundY) -> true |
| 3204 | | ; propagate_avl_element_information((X,Y),AVL,Size,WF)). |
| 3205 | | |
| 3206 | | % get the waitflag when first WF set and other two not |
| 3207 | | :- block delay_get_wait_flag(-,-,-,?,?,?,?). |
| 3208 | | delay_get_wait_flag(_,WF1,WF2, _,_,_,_) :- (nonvar(WF1);nonvar(WF2)),!. % DO NOTHING |
| 3209 | | delay_get_wait_flag(_,_,_,Prio,Info,WF,WF2) :- get_wait_flag(Prio,Info,WF,WF2). |
| 3210 | | */ |
| 3211 | | |
| 3212 | | :- block apply_check_tuple_delay(?,?,?, ?,?,?, -,-,-). |
| 3213 | | apply_check_tuple_delay(X,Y,AVL,_ApproxSizeA,Span,WF,GroundX,WF1,_) :- |
| 3214 | | (nonvar(GroundX);nonvar(WF1)),!, |
| 3215 | | apply_check_tuple(X,Y,AVL,Span,WF). |
| 3216 | | apply_check_tuple_delay(X,Y,AVL,ApproxSizeA,Span,WF,_GroundX,_WF1,_GroundY) :- |
| 3217 | | % Y is ground; try to do an inverse function lookup |
| 3218 | | inverse_apply_ok(Y,X,AVL,ApproxSizeA), |
| 3219 | | !, |
| 3220 | | % print(inverse_apply(Y,X,ApproxSizeA,_GroundX)),nl, |
| 3221 | | inverse_get_possible_values(X,Y,AVL,Res), |
| 3222 | | Res=avl_set(InvAVL), % if empty set : we fail |
| 3223 | | (preference(data_validation_mode,true), |
| 3224 | | avl_approximate_size(InvAVL,10,ApproxSize), |
| 3225 | | ApproxSize>1 |
| 3226 | | -> A2 is (ApproxSize*15*ApproxSize)//ApproxSizeA, % used to be A2 is ApproxSize*100, |
| 3227 | | A22 is max(A2,ApproxSize), |
| 3228 | | (get_inversion_penalty(Span) |
| 3229 | | -> A23 is A22 * 100 %, add_message(f,'Inversion Penalty: ',Y:A22,Span) |
| 3230 | | ; A23=A22), |
| 3231 | | % give lower priority for backwards propagation, upto 15 times if no reduction from backwards propagation |
| 3232 | | % but also take into account how much we reduce the size by inverting |
| 3233 | | % relevant for, e.g., Machines_perf_0111/Thales_All/rule_OPS_SDS_3940.mch |
| 3234 | | % or rule_OPS_SDS_6496 -> 15 instead of 150 improves performance |
| 3235 | | get_bounded_wait_flag(A23,element_of_avl_inverse_apply_ok(X),WF,WF2), |
| 3236 | | % does not call propagate_avl_element_information(X,InvAVL,ApproxSize,WF) or avl_to_table |
| 3237 | | element_of_avl_set_wf3(X,InvAVL,ApproxSize,WF2,WF) % TODO: pass GroundX |
| 3238 | | %apply_check_tuple_delay(X,Y,AVL,ApproxSizeA,Span,WF,GroundX,WF1,_) % now wait on WF1 or GroundX |
| 3239 | | ; element_of_avl_set_wf(InvAVL,X,WF) |
| 3240 | | ). |
| 3241 | | apply_check_tuple_delay(X,Y,AVL,ApproxSizeA,Span,WF,GroundX,WF1,_GroundY) :- |
| 3242 | | apply_check_tuple_delay(X,Y,AVL,ApproxSizeA,Span,WF,GroundX,WF1,_). % now wait on WF1 or GroundX |
| 3243 | | |
| 3244 | | % check if the function call was annotated as not suitable for backwards inverse function lookup propagation |
| 3245 | | get_inversion_penalty(span_predicate(b(_Function,_,Info),_LS,_S)) :- !, |
| 3246 | | get_inversion_penalty(Info). |
| 3247 | | get_inversion_penalty(Info) :- |
| 3248 | | member(prob_annotation('INVERSION_PENALTY'),Info). |
| 3249 | | |
| 3250 | | inverse_get_possible_values(X,Y,AVL,Res) :- |
| 3251 | | get_template(X,XX,_), |
| 3252 | | copy_term(XX,XX_Copy), % avoid that findall instantiates X |
| 3253 | | % TODO: copy_value_term similar to ground_value to avoid traversing avl_sets; but usually X is not a set |
| 3254 | | findall(XX_Copy, safe_avl_member_default((XX_Copy,Y),AVL), PossibleValues), |
| 3255 | | PossibleValues \= [], % fail straightaway |
| 3256 | | sort(PossibleValues,SPV), |
| 3257 | | % length(SPV,Len),print(inverse_image(Y,Len)),nl, print_term_summary(apply_check_tuple_delay(X,Y,AVL)),nl, |
| 3258 | | convert_to_avl(SPV,Res). |
| 3259 | | |
| 3260 | | % is it ok to compute inverse ? only makes sense if AVL tree not too big and quite functional |
| 3261 | | inverse_apply_ok(pred_true,_,_AVL,ApproxSizeA) :- !, % only two values possible, probably half of AVL will be returned |
| 3262 | | ApproxSizeA < 1023. % corresponds to avl_height < 10 |
| 3263 | | inverse_apply_ok(pred_false,_,_AVL,ApproxSizeA) :- !,ApproxSizeA < 1023. |
| 3264 | | % TO DO: other small types, such as fd(_,_) |
| 3265 | | inverse_apply_ok(_,_,_AVL,ApproxSizeA) :- ApproxSizeA < 255,!. |
| 3266 | | inverse_apply_ok(_,X,_AVL,ApproxSizeA) :- ApproxSizeA < 65535, % corresponds Height < 16 |
| 3267 | | (preference(data_validation_mode,true) -> |
| 3268 | | (preference(solver_strength,SS), ApproxSizeA < 16383+SS -> true |
| 3269 | | ; perfmessage(inverse,function_call_not_inverted(ApproxSizeA)),fail |
| 3270 | | ) |
| 3271 | | ; true), |
| 3272 | | quick_non_ground_check(X). |
| 3273 | | %inverse_apply_ok(_,_,_,_). |
| 3274 | | |
| 3275 | | % sometimes the ground_value_check co-routine hasn't grounded GroundX yet ! so do a quick check |
| 3276 | | quick_non_ground_check(X) :- var(X),!. |
| 3277 | | quick_non_ground_check([]) :- !,fail. |
| 3278 | | quick_non_ground_check(avl_set(_)) :- !,fail. |
| 3279 | | quick_non_ground_check(pred_true) :- !,fail. |
| 3280 | | quick_non_ground_check(pred_false) :- !,fail. |
| 3281 | | quick_non_ground_check(int(X)) :- !,var(X). |
| 3282 | | quick_non_ground_check(string(X)) :- !,var(X). |
| 3283 | | quick_non_ground_check(fd(X,T)) :- !,(var(X) ; var(T)). |
| 3284 | | quick_non_ground_check((A,B)) :- !, (quick_non_ground_check(A) -> true ; quick_non_ground_check(B)). |
| 3285 | | quick_non_ground_check(_). % assume it is non ground |
| 3286 | | |
| 3287 | | |
| 3288 | | |
| 3289 | | % apply_check_tuple is allowed to enumerate: either X is ground or Y is ground |
| 3290 | | apply_check_tuple(X,Y,A,Span,WF) :- |
| 3291 | | ground_value(X), |
| 3292 | | convert_to_avl_inside_set_wf(X,AX,WF),!, % we can do optimized lookup + checking in one go (but avl_apply only does partial check) |
| 3293 | | avl_apply(AX,A,XY,Span,WF), |
| 3294 | | kernel_objects:equal_object_wf(XY,Y,apply_check_tuple,WF). |
| 3295 | | :- if(environ(no_wd_checking, true)). |
| 3296 | | apply_check_tuple(X,Y,A,_Span,WF) :- safe_avl_member_default_wf((X,Y),A,WF). |
| 3297 | | :- else. |
| 3298 | | apply_check_tuple(X,Y,A,_Span,WF) :- preferences:preference(find_abort_values,false), !, |
| 3299 | | safe_avl_member_default_wf((X,Y),A,WF). |
| 3300 | | apply_check_tuple(X,Y,A,Span,WF) :- !, |
| 3301 | | if(safe_avl_member_default_wf((X,XY),A,WF), % does not detect abort errors if X unbound |
| 3302 | | kernel_objects:equal_object_wf(XY,Y,apply_check_tuple_avl,WF), |
| 3303 | | add_wd_error_span('function applied outside of domain (#4): ','@fun'(X,avl_set(A)),Span,WF)). |
| 3304 | | :- endif. |
| 3305 | | |
| 3306 | | |
| 3307 | | % ------------------------------------------ |
| 3308 | | |
| 3309 | | |
| 3310 | | :- use_module(b_global_sets,[b_type2_set/2]). |
| 3311 | | :- use_module(bsyntaxtree,[rename_bt/3]). |
| 3312 | | union_of_explicit_set(global_set(GS),_,R) :- is_maximal_global_set(GS), !, |
| 3313 | | R= global_set(GS). /* global_set is already maximal */ |
| 3314 | | union_of_explicit_set(freetype(GS),_,R) :- !, R= freetype(GS). /* freetype is already maximal */ |
| 3315 | | union_of_explicit_set(closure(P,T,B),_,R) :- is_definitely_maximal_closure(P,T,B), !, |
| 3316 | | R= closure(P,T,B). /* global_set is already maximal */ |
| 3317 | | union_of_explicit_set(_,S2,R) :- is_definitely_maximal_set(S2),!, % will also look at AVL set |
| 3318 | | R=S2. |
| 3319 | | union_of_explicit_set(S1,S2,R) :- nonvar(S2), S2 = [], !, R=S1. |
| 3320 | | union_of_explicit_set(S1,S2,_) :- (var(S1);var(S2)),!,fail. % then we cannot compute it here |
| 3321 | | union_of_explicit_set(S2,S1,R) :- |
| 3322 | | is_not_member_value_closure(S1,TYPE,MS1), nonvar(MS1), is_efficient_custom_set(MS1), |
| 3323 | | % also works if S2 is complement closure |
| 3324 | | difference_of_explicit_set(MS1,S2,Diff),!, |
| 3325 | | construct_complement_closure_if_necessary(Diff,TYPE,R). |
| 3326 | | union_of_explicit_set(avl_set(A1),S2,R) :- !, union_of_avl_set(S2,A1,R). |
| 3327 | | union_of_explicit_set(S1,S2,R) :- |
| 3328 | | is_not_member_value_closure(S1,TYPE,MS1), nonvar(MS1), is_efficient_custom_set(MS1), |
| 3329 | | difference_of_explicit_set(MS1,S2,Diff),!, |
| 3330 | | construct_complement_closure_if_necessary(Diff,TYPE,R). |
| 3331 | | union_of_explicit_set(S1,avl_set(A2),R) :- !, union_of_avl_set(S1,A2,R). |
| 3332 | | union_of_explicit_set(I1,I2,R) :- is_interval_closure_or_integerset(I1,From1,To1), ground(From1), ground(To1), |
| 3333 | | is_interval_closure_or_integerset(I2,From2,To2), ground(From2), ground(To2), |
| 3334 | | !, |
| 3335 | | (union_of_interval(From1,To1,From2,To2,FromRes,ToRes) |
| 3336 | | -> construct_interval_closure(FromRes,ToRes,R) |
| 3337 | | ; small_enough_for_expansion(From1,To1),small_enough_for_expansion(From2,To2) -> |
| 3338 | | % do not attempt union_of_closure below |
| 3339 | | expand_interval_closure_to_avl(From1,To1,R1), R1=avl_set(A1), % empty interval already dealt with above !? |
| 3340 | | expand_interval_closure_to_avl(From2,To2,R2), R2=avl_set(A2), % Note: unification after call as expand_interval calls equal_object (which gets confused by partially instantiated avl_set(_)) |
| 3341 | | union_of_avl(A1,A2,ARes),R=avl_set(ARes) /* AVL not normalised */ |
| 3342 | | ; transform_global_sets_into_closure(I1,closure(Par,T,Body)), |
| 3343 | | union_of_closure(I2,Par,T,Body,R) |
| 3344 | | ). |
| 3345 | | union_of_explicit_set(closure(P,T,B),C2,Res) :- |
| 3346 | | union_of_closure(C2,P,T,B,Res). |
| 3347 | | |
| 3348 | | small_enough_for_expansion(From1,To1) :- number(To1), number(From1), To1-From1<250. |
| 3349 | | |
| 3350 | | :- use_module(bsyntaxtree,[extract_info/2, extract_info_wo_used_ids/2, extract_info/3, rename_bt/3, replace_id_by_expr/4]). |
| 3351 | | |
| 3352 | | union_of_closure(global_set(X),P,T,B,Res) :- !, transform_global_sets_into_closure(global_set(X),C), |
| 3353 | | union_of_closure(C,P,T,B,Res). |
| 3354 | | union_of_closure(closure(P2,T2,B2),P,T,B,Res) :- !, |
| 3355 | | % T2 should be equal to T, module seq(_) <-> set(couple(integer,_)) |
| 3356 | | unify_closure_predicates(P,T,B, P2,T2,B2 , NewP,NewT, NewB1,NewB2), |
| 3357 | | debug:debug_println(9,union_of_two_closures(P,P2,NewP,NewT)), |
| 3358 | | extract_info(B,B2,NewInfo), |
| 3359 | | construct_disjunct(NewB1,NewB2,Disj), |
| 3360 | | Res = closure(NewP,NewT,b(Disj,pred,NewInfo)). |
| 3361 | | |
| 3362 | | % rename predicates of two closures so that they work on common closure parameter ids |
| 3363 | | % and can then be either joined by conjunction or disjunction |
| 3364 | | unify_closure_predicates(P,T,B, P2,T2,B2 , NewP,NewT, NewB1,NewB2) :- |
| 3365 | | length(P,Len1), length(P2,Len2), |
| 3366 | | (Len1=Len2 |
| 3367 | | -> generate_renaming_list(P,P2,RL), |
| 3368 | | rename_bt(B2,RL,NewB2), |
| 3369 | | NewP=P, NewT=T, NewB1 = B |
| 3370 | | ; Len1 < Len2 -> unify_clos_lt(P,T,B, P2,T2,B2 , NewP,NewT, NewB1,NewB2) |
| 3371 | | ; unify_clos_lt(P2,T2,B2, P,T,B , NewP,NewT, NewB2,NewB1) % inverted the predicate |
| 3372 | | ). |
| 3373 | | |
| 3374 | | % TO DO: generalize: currently only works for single identifier on left |
| 3375 | | % but works for id(NATURAL) \/ %x.(x<0|-x) or abs = id(NATURAL) \/ %x.(x<0|-x) & abs(2)=a2 & abs(-2)=am2 |
| 3376 | | unify_clos_lt([ID1],[couple(_,_)],B, P2,T2,B2 , NewP,NewT, NewB1,NewB2) :- |
| 3377 | | rename_lambda_result_id(P2,B2,P3,B3), |
| 3378 | | create_couple_term(P3,T2,Pair), |
| 3379 | | replace_id_by_expr(B,ID1,Pair,NewB1), |
| 3380 | | NewP=P3, NewT=T2, NewB2=B3. |
| 3381 | | |
| 3382 | | % _lambda_result_ id is not enumerated, hence we have to avoid inserting such ids into NewB1 as part of the pPair |
| 3383 | | rename_lambda_result_id(['_lambda_result_',ID2],B2,[FRESHID,ID2],B3) :- !,get_unique_id('_RANGE_',FRESHID), |
| 3384 | | rename_bt(B2,[rename('_lambda_result_',FRESHID)],B3). |
| 3385 | | rename_lambda_result_id([ID1,'_lambda_result_'],B2,[ID1,FRESHID],B3) :- !,get_unique_id('_RANGE_',FRESHID), |
| 3386 | | rename_bt(B2,[rename('_lambda_result_',FRESHID)],B3). |
| 3387 | | rename_lambda_result_id(P2,B2,P2,B2). |
| 3388 | | |
| 3389 | | % translate a list of atomic ids and a list of types into a couple-term |
| 3390 | | create_couple_term([ID1],[T1],Res) :- !, |
| 3391 | | create_texpr(identifier(ID1),T1,[],Res). |
| 3392 | | create_couple_term([ID1,ID2],[T1,T2],Res) :- |
| 3393 | | bsyntaxtree:create_couple(b(identifier(ID1),T1,[]),b(identifier(ID2),T2,[]),Res). |
| 3394 | | % TODO: extend for more than two args |
| 3395 | | |
| 3396 | | generate_renaming_list([],[],[]). |
| 3397 | | generate_renaming_list([ID|T],[ID2|T2],RL) :- |
| 3398 | | (ID==ID2 -> generate_renaming_list(T,T2,RL) |
| 3399 | | ; RL = [rename(ID2,ID)|RL2], |
| 3400 | | generate_renaming_list(T,T2,RL2)). |
| 3401 | | |
| 3402 | | |
| 3403 | | % a more clever way of constructing a disjunct; factor out common prefixes |
| 3404 | | % (A & B1) or (A1 & B2) <=> A1 & (B1 or B2) |
| 3405 | | % TO DO: we should try and get the leftmost basic conjunct ! |
| 3406 | | /* construct_disjunct(b(conjunct(A1,A2),pred,IA), b(conjunct(B1,B2),pred,_IB), Res) :- |
| 3407 | | |
| 3408 | | print('TRY DISJUNCT FACTOR: '), translate:print_bexpr(A1),nl, |
| 3409 | | translate:print_bexpr(B1),nl, |
| 3410 | | same_texpr_body(A1,B1),!, |
| 3411 | | print('DISJUNCT FACTOR: '), translate:print_bexpr(A1),nl, |
| 3412 | | Res = conjunct(A1,b(Disj,pred,IA)), |
| 3413 | | construct_disjunct(A2,B2,Disj). |
| 3414 | | */ |
| 3415 | | construct_disjunct(A,B,disjunct(A,B)). |
| 3416 | | |
| 3417 | | :- use_module(btypechecker,[couplise_list/2]). |
| 3418 | | % TO DO: quick_check if AVL A1 is maximal ? |
| 3419 | | union_of_avl_set(avl_set(A2),A1,R) :- !, union_of_avl(A1,A2,ARes), R=avl_set(ARes). /* AVL not normalised */ |
| 3420 | | union_of_avl_set(I2,A1,R) :- is_interval_closure_or_integerset(I2,From2,To2), !, |
| 3421 | | ground(From2), ground(To2), % we can only compute it if bounds known |
| 3422 | | (avl_min(A1,int(Min)), low_border(From2,Min,FromRes), avl_max(A1,int(Max)), up_border(To2,Max,ToRes) |
| 3423 | | -> /* AVL contained (almost) in Interval */ |
| 3424 | | construct_interval_closure(FromRes,ToRes,R) |
| 3425 | | ; \+ small_interval(From2,To2) -> |
| 3426 | | transform_global_sets_into_closure(I2,closure(Par,T,Body)), % we may have something like NATURAL1,... |
| 3427 | | union_of_avl_set_with_closure(Par,T,Body,A1,R) |
| 3428 | | ; expand_and_convert_to_avl_set(I2,A2,union_of_avl_set,'? \\/ ARG'), % can generate ARel=empty; will fail if not possible to convert |
| 3429 | | union_of_avl(A1,A2,ARes), R=avl_set(ARes) |
| 3430 | | ). |
| 3431 | | union_of_avl_set(closure(Par,T,Body),A1,Res) :- is_infinite_or_symbolic_closure(Par,T,Body),!, |
| 3432 | | % TO DO: what if we are in SYMBOLIC mode and the type of T is infinite; maybe we should also keep the union symbolic ?? (cf Ticket/Georghe1) |
| 3433 | | union_of_avl_set_with_closure(Par,T,Body,A1,Res). |
| 3434 | | union_of_avl_set(S2,A1,Res) :- |
| 3435 | | S2 \= freetype(_), |
| 3436 | | ground_value(S2), % could be a closure |
| 3437 | | !, |
| 3438 | | (try_expand_and_convert_to_avl_set(S2,A2,union) |
| 3439 | | -> union_of_avl(A1,A2,ARes), Res=avl_set(ARes) /* AVL not normalised */ |
| 3440 | | ; S2=closure(Par,T,Body), |
| 3441 | | union_of_avl_set_with_closure(Par,T,Body,A1,Res)). |
| 3442 | | |
| 3443 | | try_expand_and_convert_to_avl_set(S2,A2,Source) :- |
| 3444 | | % false: do not add enumeration warning events as errors |
| 3445 | | catch_enumeration_warning_exceptions(expand_and_convert_to_avl_set(S2,A2,Source,''),fail,false,ignore(Source)). |
| 3446 | | |
| 3447 | | % try expanding to list, but catch enumeration warnings and fail if they do occur |
| 3448 | | % used by override(...) |
| 3449 | | %try_expand_custom_set_to_list(CS,_,_,_) :- nonvar(CS),CS=global_set(GS),is_infinite_global_set(GS,_), |
| 3450 | | % !, |
| 3451 | | % fail. |
| 3452 | | try_expand_custom_set_to_list(CS,_,_,_) :- nonvar(CS), |
| 3453 | | (is_symbolic_closure(CS) ; is_infinite_explicit_set(CS)), |
| 3454 | | !, % we could also check is_symbolic_closure |
| 3455 | | fail. |
| 3456 | | try_expand_custom_set_to_list(CS,List,Done,Source) :- |
| 3457 | | % false: do not add enumeration warning events as errors |
| 3458 | | catch_enumeration_warning_exceptions(expand_custom_set_to_list(CS,List,Done,Source),fail,false,ignore(Source)). |
| 3459 | | |
| 3460 | | |
| 3461 | | small_interval(From,To) :- number(From), number(To), To-From < 10000. |
| 3462 | | |
| 3463 | | union_of_avl_set_with_closure(Par,T,Body,A1,Res) :- |
| 3464 | | Body = b(_,BodyT,_), |
| 3465 | | setup_typed_ids(Par,T,TypedPar), |
| 3466 | | btypechecker:couplise_list(TypedPar,TypedCPar), |
| 3467 | | generate_couple_types(TypedCPar,ParExpr,ParType), |
| 3468 | | debug:debug_println(9,union_of_avl_and_infinite_closure(Par,T,BodyT)), |
| 3469 | | BodyAvl = b(member(ParExpr,b(value(avl_set(A1)),set(ParType),[])),pred,[]), |
| 3470 | | extract_info_wo_used_ids(Body,NewInfo), |
| 3471 | | Res = closure(Par,T,b(disjunct(BodyAvl,Body),pred,NewInfo)). |
| 3472 | | % mark_closure_as_symbolic(closure(Par,T,b(disjunct(BodyAvl,Body),pred,NewInfo)),Res). |
| 3473 | | |
| 3474 | | low_border(Low,AVLMin,R) :- geq_inf(AVLMin,Low),!,R=Low. |
| 3475 | | low_border(Low,AVLMin,R) :- number(Low),AVLMin is Low-1,R=AVLMin. % extend lower border by one |
| 3476 | | up_border(Up,AVLMax,R) :- geq_inf(Up,AVLMax),!,R=Up. |
| 3477 | | up_border(Up,AVLMax,R) :- number(Up),AVLMax is Up+1,R=AVLMax. % extend upper border by one |
| 3478 | | |
| 3479 | | |
| 3480 | | setup_typed_ids([],[],[]). |
| 3481 | | setup_typed_ids([ID|TI],[Type|TT],[b(identifier(ID),Type,[])|BT]) :- setup_typed_ids(TI,TT,BT). |
| 3482 | | |
| 3483 | | generate_couple_types(couple(A,B),b(couple(TA,TB),Type,[]),Type) :- !, Type = couple(TTA,TTB), |
| 3484 | | generate_couple_types(A,TA,TTA), |
| 3485 | | generate_couple_types(B,TB,TTB). |
| 3486 | | generate_couple_types(b(X,T,I),b(X,T,I),T). |
| 3487 | | |
| 3488 | | |
| 3489 | | % try to see if two intervals can be unioned into a new interval |
| 3490 | | union_of_interval(F1,T1,F2,T2,FR,TR) :- |
| 3491 | | geq_inf(F2,F1), geq_inf(T1,T2),!,FR=F1,TR=T1. % interval [F2,T2] contained in [F1,T1] |
| 3492 | | union_of_interval(F2,T2,F1,T1,FR,TR) :- geq_inf(F2,F1), geq_inf(T1,T2),!,FR=F1,TR=T1. % see above |
| 3493 | | union_of_interval(F1,T1,F2,T2,FR,TR) :- number(F2), |
| 3494 | | geq_inf(F2,F1), number(T1),T11 is T1+1,geq_inf(T11,F2), geq_inf(T2,F2),!,FR=F1,TR=T2. % intervals can be joined |
| 3495 | | union_of_interval(F2,T2,F1,T1,FR,TR) :- number(F2), |
| 3496 | | geq_inf(F2,F1), number(T1),T11 is T1+1,geq_inf(T11,F2), geq_inf(T2,F2),!,FR=F1,TR=T2. % see above |
| 3497 | | |
| 3498 | | :- use_module(library(ordsets),[ord_union/3]). |
| 3499 | | union_of_avl(A1,A2,ARes) :- |
| 3500 | | avl_height(A2,Sz2), |
| 3501 | | (Sz2 < 2 % we have something like Set := Set \/ {x}; no need to compute height of A1 |
| 3502 | | -> union_of_avl1(A1,99999,A2,Sz2,ARes) |
| 3503 | | ; avl_height(A1,Sz1), % TODO: we could call avl_height_less_than or avl_height_compare |
| 3504 | | (Sz1<Sz2 -> union_of_avl1(A2,Sz2,A1,Sz1,ARes) ; union_of_avl1(A1,Sz1,A2,Sz2,ARes)) |
| 3505 | | ). |
| 3506 | | union_of_avl1(A1,Sz1,A2,Sz2,ARes) :- Sz2>2, Sz1 =< Sz2+3, % difference not too big; Sz2 at least a certain size |
| 3507 | | !, |
| 3508 | | avl_to_list(A2,List2), % get all members |
| 3509 | | avl_to_list(A1,List1), |
| 3510 | | ord_union(List1,List2,L12), |
| 3511 | | ord_list_to_avl(L12,ARes). |
| 3512 | | union_of_avl1(A1,_Sz1,A2,_Sz2,ARes) :- % this version is better when A2 is small compared to A1 |
| 3513 | | avl_domain(A2,List2), % get all members |
| 3514 | | add_to_avl(List2,A1,ARes). |
| 3515 | | |
| 3516 | | :- use_module(library(lists),[reverse/2]). |
| 3517 | | % a custom version for union(A) where A is AVL set; avoid converting/expanding accumulators and computing avl_height |
| 3518 | | % runtime of e.g., UNION(x).(x:1000..1514|0..x) 0.65 sec or UNION(n).(n:10000..10010|UNION(x).(x:n..n+1000|n..x)) 4.8 sec is considerably smaller with this version |
| 3519 | | union_generalized_explicit_set(avl_set(SetsOfSets),Res,WF) :- |
| 3520 | | expand_custom_set_to_list_wf(avl_set(SetsOfSets),ESetsOfSets,_,union_generalized_wf,WF), |
| 3521 | | % length(ESetsOfSets,Len),print(union_gen(Len)),nl, |
| 3522 | | (ESetsOfSets=[OneSet] |
| 3523 | | -> Res=OneSet % avoid converting to list and back to Avl |
| 3524 | | ; reverse(ESetsOfSets,RESetsOfSets), % be sure to insert larger values first, so that ord_union has less work to do below; useful if you have many small singleton sets, for example union(ran(%x.(x : 1 .. 10000|{x * x}))) 2.37 secs --> 0.15 secs |
| 3525 | | % note: dom({r,x|x:1..50000 & r:{x*x}}) is still 3 times faster |
| 3526 | | union_of_avls(RESetsOfSets,[],Res)). |
| 3527 | | |
| 3528 | | % take the union of a list of avl_sets |
| 3529 | | union_of_avls([],Acc,Res) :- ord_list_to_avl(Acc,ARes), construct_avl_set(ARes,Res). |
| 3530 | | union_of_avls([H|T],Acc,Res) :- |
| 3531 | | union_of_avl_with_acc(H,Acc,NewAcc), |
| 3532 | | union_of_avls(T,NewAcc,Res). |
| 3533 | | |
| 3534 | | union_of_avl_with_acc(avl_set(H),Acc,NewAcc) :- !, |
| 3535 | | avl_to_list(H,HList), |
| 3536 | | ord_union(Acc,HList,NewAcc). |
| 3537 | | union_of_avl_with_acc([],Acc,Res) :- !,Res=Acc. |
| 3538 | | % other custom sets should normally not appear, we obtain the list as elements stored in an avl_set |
| 3539 | | union_of_avl_with_acc(G,_,_) :- add_internal_error('Uncovered element: ',union_of_avl_with_acc(G,_,_)),fail. |
| 3540 | | |
| 3541 | | |
| 3542 | | |
| 3543 | | % TO DO: there are no rules for is_not_member_value_closure for intersection below |
| 3544 | | intersection_of_explicit_set_wf(global_set(GS),S2,R,_WF) :- is_maximal_global_set(GS), !, R=S2. |
| 3545 | | intersection_of_explicit_set_wf(freetype(_GS),S2,R,_WF) :- !, R=S2. |
| 3546 | | intersection_of_explicit_set_wf(_,S2,_,_WF) :- var(S2),!,fail. % code below may instantiate S2 |
| 3547 | | intersection_of_explicit_set_wf(S1,S2,R,_WF) :- is_definitely_maximal_set(S2), !, R=S1. |
| 3548 | | intersection_of_explicit_set_wf(_S1,[],R,_WF) :-!, R=[]. |
| 3549 | | intersection_of_explicit_set_wf(avl_set(A1),I2,R,_WF) :- |
| 3550 | | is_interval_closure_or_integerset(I2,From1,To1), |
| 3551 | | !, |
| 3552 | | intersect_avl_interval(A1,From1,To1,R). |
| 3553 | | intersection_of_explicit_set_wf(I1,I2,R,_WF) :- |
| 3554 | | intersection_with_interval_closure(I1,I2,R),!. |
| 3555 | | intersection_of_explicit_set_wf(S1,S2,R,_WF) :- |
| 3556 | | get_avl_sets(S1,S2,A1,A2), |
| 3557 | | !, % if too large: better to apply normal intersection code ? |
| 3558 | | % if one of the args is an interval this is already caught in kernel_objects calling intersection_with_interval_closure; see SetIntersectionBig.mch |
| 3559 | | avl_domain(A1,ES), % A1 has the smaller height; important for e.g. SetIntersectionBig2.mch |
| 3560 | | inter2(ES,A2,IRes), |
| 3561 | | ord_list_to_avlset(IRes,R,intersection). % we have generated the elements in the right order already |
| 3562 | | intersection_of_explicit_set_wf(Set1,Set2,R,WF) :- |
| 3563 | | transform_global_sets_into_closure(Set1,closure(P1,T1,B1)), |
| 3564 | | transform_global_sets_into_closure(Set2,closure(P2,T2,B2)), |
| 3565 | | % gets called, e.g., for {x|x /: NATURAL1} /\ NATURAL1 |
| 3566 | | unify_closure_predicates(P1,T1,B1, P2,T2,B2 , NewP,NewT, NewB1,NewB2), |
| 3567 | | debug:debug_println(9,intersection_of_two_closures(P1,P2,NewP,NewT)), |
| 3568 | | conjunct_predicates([NewB1,NewB2],BI), |
| 3569 | | % create a conjunction: can be much more efficient than seperately expanding; |
| 3570 | | % also works well if one of the closures is infinite |
| 3571 | | C = closure(NewP,NewT,BI), |
| 3572 | | expand_custom_set_wf(C,R,intersection_of_explicit_set_wf,WF). % we could keep it symbolic; maybe use SYMBOLIC pref |
| 3573 | | % to do: also use above for closure and AVL set with member(P,value(avl_set(A))) |
| 3574 | | % we could also apply the same principle to difference_of_explicit_set |
| 3575 | | % currently we enable intersection to be treated symbolically (not_symbolic_binary(intersection) commented out) |
| 3576 | | % This means the above clause for intersection_of_explicit_set_wf is less useful |
| 3577 | | % a special case; just for interval closures |
| 3578 | | intersection_with_interval_closure(I1,I2,R) :- |
| 3579 | | is_interval_closure_or_integerset(I1,From1,To1), nonvar(I2), |
| 3580 | | intersection_with_interval_closure_aux(I2,From1,To1,R). |
| 3581 | | intersection_with_interval_closure(avl_set(A1),I2,R) :- |
| 3582 | | is_interval_closure_or_integerset(I2,From1,To1), |
| 3583 | | !, |
| 3584 | | intersect_avl_interval(A1,From1,To1,R). |
| 3585 | | |
| 3586 | | % try and get AVL sets from two args; first AVL set is smaller one according to height |
| 3587 | | get_avl_sets(avl_set(A1),S2,AA1,AA2) :- nonvar(S2), S2=avl_set(A2), |
| 3588 | ? | (avl_height_compare(A1,A2,R), R=lt |
| 3589 | | -> (AA1,AA2)=(A1,A2) |
| 3590 | | ; (AA1,AA2)=(A2,A1)). |
| 3591 | | %get_avl_sets(S1,S2,AA1,AA2) :- nonvar(S2),S2=avl_set(A2), get_avl_set_arg(S1,A1), |
| 3592 | | % (avl_height_compare(A1,A2,R),R=gt -> (AA1,AA2)=(A2,A1) ; (AA1,AA2)=(A1,A2)). |
| 3593 | | |
| 3594 | | |
| 3595 | | %intersection_with_interval_closure_aux(avl_set(A),... |
| 3596 | | intersection_with_interval_closure_aux(I2,From1,To1,R) :- |
| 3597 | | is_interval_closure_or_integerset(I2,From2,To2),!, |
| 3598 | | intersect_intervals_with_inf(From1,To1,From2,To2,FromRes,ToRes), |
| 3599 | | construct_interval_closure(FromRes,ToRes,R). |
| 3600 | | % (is_interval_closure_or_integerset(R,F,T) -> print(ok(F,T)),nl ; print(ko),nl). |
| 3601 | | intersection_with_interval_closure_aux(avl_set(A2),From1,To1,R) :- |
| 3602 | | intersect_avl_interval(A2,From1,To1,R). |
| 3603 | | |
| 3604 | | % intersect avl with interval |
| 3605 | | % TO DO: expand interval if small (or small intersection with AVL) and use avl intersection |
| 3606 | | intersect_avl_interval(_,From2,To2,_) :- (var(From2) ; var(To2)),!,fail. |
| 3607 | | intersect_avl_interval(A1,From2,To2,R) :- avl_min(A1,int(Min)), |
| 3608 | | geq_inf(Min,From2), |
| 3609 | | geq_inf(To2,Min), avl_max(A1,int(Max)), |
| 3610 | | geq_inf(To2,Max), |
| 3611 | | % AVL fully contained in interval; no need to expand to list and back again |
| 3612 | | !, |
| 3613 | | construct_avl_set(A1,R). |
| 3614 | | intersect_avl_interval(A1,From2,To2,R) :- |
| 3615 | | avl_domain(A1,ES), |
| 3616 | | inter_interval(ES,From2,To2,IRes), |
| 3617 | | ord_list_to_avlset(IRes,R,intersect_avl_interval). |
| 3618 | | |
| 3619 | | inter_interval([],_,_, []). |
| 3620 | | inter_interval([IH|T],From2,To2, Res) :- IH = int(H), |
| 3621 | | (geq_inf(To2,H) -> |
| 3622 | | (geq_inf(H,From2) -> Res = [IH-true|Res2] ; Res = Res2), |
| 3623 | | inter_interval(T,From2,To2,Res2) |
| 3624 | | ; Res = [] % we have exceeded the upper limit of the interval |
| 3625 | | ). |
| 3626 | | |
| 3627 | | intersect_intervals_with_inf(From1,To1,From2,To2,FromRes,ToRes) :- |
| 3628 | | minimum_with_inf(To1,To2,ToRes), |
| 3629 | | maximum_with_inf(From1,From2,FromRes). |
| 3630 | | |
| 3631 | | % check if two intervals are disjoint |
| 3632 | | disjoint_intervals_with_inf(From1,To1,From2,To2) :- |
| 3633 | | intersect_intervals_with_inf(From1,To1,From2,To2,Low,Up), |
| 3634 | | number(Up), number(Low), Low > Up. |
| 3635 | | |
| 3636 | | inter2([],_, []). |
| 3637 | | inter2([H|T],A1, Res) :- |
| 3638 | | (avl_fetch(H,A1) -> Res = [H-true|Res2] ; Res = Res2), inter2(T,A1,Res2). |
| 3639 | | |
| 3640 | | ord_list_to_avlset(OL,R) :- ord_list_to_avlset(OL,R,unknown). |
| 3641 | | ord_list_to_avlset(OrdList,Res,Origin) :- |
| 3642 | | % assumes that we have generated the elements in the right order already |
| 3643 | | (OrdList=[] -> Res=[] |
| 3644 | | ; check_sorted(OrdList,Origin), |
| 3645 | | ord_list_to_avl(OrdList,ARes), Res=avl_set(ARes)). |
| 3646 | | |
| 3647 | | % a version which accepts a list of values without -true |
| 3648 | | % values have to be ground and already converted for use in avl_set |
| 3649 | | sorted_ground_normalised_list_to_avlset(List,Res,PP) :- |
| 3650 | | add_true_to_list(List,LT), |
| 3651 | | ord_list_to_avlset_direct(LT,Res,PP). |
| 3652 | | |
| 3653 | | add_true_to_list([],[]). |
| 3654 | | add_true_to_list([H|T],[H-true|TT]) :- add_true_to_list(T,TT). |
| 3655 | | |
| 3656 | | % the same, but without checking sorted (only use if you are really sure the list is sorted) |
| 3657 | | ord_list_to_avlset_direct([],[],_). |
| 3658 | | ord_list_to_avlset_direct([H|T],Res,_):- |
| 3659 | | (T==[] -> H=Key-Val, Res = avl_set(node(Key,Val,0,empty,empty)) % slightly faster than calling ord_list_to_avl |
| 3660 | | ; ord_list_to_avl([H|T],ARes), Res = avl_set(ARes)). |
| 3661 | | |
| 3662 | | check_sorted([],_) :- !. |
| 3663 | | check_sorted([H-_|T],Origin) :- !, check_sorted2(T,H,Origin). |
| 3664 | | check_sorted(X,Origin) :- add_error_and_fail(ord_list_to_avlset,'Not a list of -/2 pairs: ',Origin:X). |
| 3665 | | |
| 3666 | | check_sorted2([],_,_) :- !. |
| 3667 | | check_sorted2([H-_|T],PH,Origin) :- PH @< H,!, check_sorted2(T,H,Origin). |
| 3668 | | check_sorted2(X,Prev,Origin) :- |
| 3669 | | add_error_and_fail(ord_list_to_avlset,'Not a sorted list of -/2 pairs: ',Origin:(X,Prev)). |
| 3670 | | |
| 3671 | | % ------------------ |
| 3672 | | |
| 3673 | | :- use_module(kernel_freetypes,[is_maximal_freetype/1]). |
| 3674 | | is_definitely_maximal_set(S) :- nonvar(S), |
| 3675 | | is_definitely_maximal_set2(S). |
| 3676 | | is_definitely_maximal_set2(freetype(ID)) :- is_maximal_freetype(ID). |
| 3677 | | is_definitely_maximal_set2(global_set(GS)) :- is_maximal_global_set(GS). |
| 3678 | | is_definitely_maximal_set2(closure(P,T,B)) :- is_definitely_maximal_closure(P,T,B). |
| 3679 | | is_definitely_maximal_set2(avl_set(S)) :- quick_definitely_maximal_set_avl(S). |
| 3680 | | is_definitely_maximal_set2([H|T]) :- nonvar(H), is_definitely_maximal_list(H,T). %, nl,print(maximal(H,T)),nl,nl. |
| 3681 | | %H==pred_true, T == [pred_false]. % for some reason BOOL is sometimes presented this way |
| 3682 | | is_definitely_maximal_set2(empty) :- % detect unwrapped AVL sets |
| 3683 | | add_internal_error('Not a set: ',is_definitely_maximal_set2(empty)),fail. |
| 3684 | | is_definitely_maximal_set2(node(A,B,C,D,E)) :- |
| 3685 | | add_internal_error('Not a set: ',is_definitely_maximal_set2(node(A,B,C,D,E))),fail. |
| 3686 | | |
| 3687 | | is_definitely_maximal_list(pred_true,T) :- nonvar(T), T=[_|_]. % |
| 3688 | | is_definitely_maximal_list(pred_false,T) :- nonvar(T), T=[_|_].% |
| 3689 | | is_definitely_maximal_list(fd(_,Type),T) :- nonvar(T),b_global_set_cardinality(Type,Card), |
| 3690 | | % check if we have the same number of elements as the type: then the set must me maximal |
| 3691 | | length_at_least(T,Card). |
| 3692 | | % We could try and and also treat pairs |
| 3693 | | |
| 3694 | | length_at_least(1,_) :- !. % we have already removed 1 element; T can be nil |
| 3695 | | length_at_least(N,T) :- nonvar(T), T=[_|TT], N1 is N-1, length_at_least(N1,TT). |
| 3696 | | |
| 3697 | | is_definitely_maximal_closure(_,_,b(truth,_Pred,_)) :- !. |
| 3698 | | is_definitely_maximal_closure(P,T,B) :- is_cartesian_product_closure_aux(P,T,B,S1,S2),!, |
| 3699 | | is_definitely_maximal_set(S1),is_definitely_maximal_set(S2). |
| 3700 | | is_definitely_maximal_closure(P,T,B) :- |
| 3701 | | is_full_powerset_or_relations_or_struct_closure(closure(P,T,B),Sets), |
| 3702 | | l_is_definitely_maximal_set(Sets). |
| 3703 | | |
| 3704 | | l_is_definitely_maximal_set([]). |
| 3705 | | l_is_definitely_maximal_set([H|T]) :- is_definitely_maximal_set(H), l_is_definitely_maximal_set(T). |
| 3706 | | |
| 3707 | | % check if we have an AVL tree covering all elements of the underlying type |
| 3708 | | quick_definitely_maximal_set_avl(AVL) :- |
| 3709 | | AVL=node(El,_True,_,_Left,_Right), |
| 3710 | | quick_definitely_maximal_set_avl_aux(El,AVL). |
| 3711 | | quick_definitely_maximal_set_avl_aux(El,AVL) :- |
| 3712 | | try_get_finite_max_card_from_ground_value(El,Card), |
| 3713 | | % this could fail if El contains empty sets ! |
| 3714 | | % also: it must fail if Card is infinite (no avl_set can be maximal) |
| 3715 | | (Card < 1000 -> true |
| 3716 | | ; preferences:preference(solver_strength,SS), Card < 1000+SS*100 |
| 3717 | | ), % otherwise too expensive a check avl_size |
| 3718 | | quick_avl_approximate_size(AVL,MaxSize), |
| 3719 | | MaxSize >= Card, % otherwise no sense in computing avl_size, which is linear in size of AVL |
| 3720 | | avl_size(AVL,Size), |
| 3721 | | %(MaxSize>=Size -> print(ok(Size,all(Card))),nl ; print('**** ERROR: '), print(Size),nl,trace), |
| 3722 | | Size=Card. |
| 3723 | | |
| 3724 | | % check if we have an AVL function with domain covering all elements of the underlying type |
| 3725 | | quick_definitely_maximal_total_function_avl(AVL) :- |
| 3726 | | AVL=node(El,_True,_,_Left,_Right), |
| 3727 | | El=(DomEl,_), |
| 3728 | | quick_definitely_maximal_set_avl_aux(DomEl,AVL), % the size is exactly the size of the domain |
| 3729 | | is_avl_partial_function(AVL). |
| 3730 | | |
| 3731 | | % ---------------------- |
| 3732 | | % set_subtraction / |
| 3733 | | difference_of_explicit_set(S1,S2,R) :- |
| 3734 | | difference_of_explicit_set_wf(S1,S2,R,no_wf_available). |
| 3735 | | % this is called with first argument nonvar (for set_subtraction operator): |
| 3736 | | difference_of_explicit_set_wf(_S1,S2,R,_) :- |
| 3737 | | is_definitely_maximal_set(S2), !, R=[]. |
| 3738 | | difference_of_explicit_set_wf(S1,S2,R,_) :- nonvar(S2), S2=[],!, R=S1. |
| 3739 | | difference_of_explicit_set_wf(S1,S2,R,_) :- |
| 3740 | | %nonvar(S1), |
| 3741 | ? | is_very_large_maximal_global_set(S1,Type), !, % TO DO: also for freetype ? cartesian products,... |
| 3742 | | /* we have a complement-set */ |
| 3743 | | complement_set(S2,Type,R). |
| 3744 | | difference_of_explicit_set_wf(S1,S2,Result,_) :- |
| 3745 | | is_not_member_value_closure(S1,Type,MS1), |
| 3746 | | nonvar(MS1), is_custom_explicit_set(MS1,difference_of_explicit_set_wf),!, |
| 3747 | | union_complement_set(MS1,S2,Type,Result). |
| 3748 | | difference_of_explicit_set_wf(_,S2,_,_) :- var(S2), !, fail. % then we cannot do anything below |
| 3749 | | difference_of_explicit_set_wf(S1,S2,R,WF) :- |
| 3750 | | is_not_member_value_closure(S2,_Type,MS2), nonvar(MS2), |
| 3751 | | intersection_of_explicit_set_wf(MS2,S1,R,WF),!. |
| 3752 | | difference_of_explicit_set_wf(I1,I2,R,_) :- |
| 3753 | | is_interval_closure_or_integerset(I1,From1,To1), |
| 3754 | | is_interval_closure_or_integerset(I2,From2,To2), |
| 3755 | | difference_interval(From1,To1,From2,To2,FromRes,ToRes), |
| 3756 | | % TO DO: also treat case when difference yields two disjoint intervals |
| 3757 | | % i.e., do not fail and forget info about interval bounds in case we cannot compute difference as a an interval, e.g., INT - {0} |
| 3758 | | !, |
| 3759 | | construct_interval_closure(FromRes,ToRes,R). |
| 3760 | | difference_of_explicit_set_wf(avl_set(A1),S2,R,WF) :- |
| 3761 | | (S2=avl_set(A2) ; |
| 3762 | | ground_value(S2), expand_and_convert_to_avl_set_unless_very_large(S2,A2,WF)),!, |
| 3763 | | avl_height(A2,H2), |
| 3764 | | %avl_min(A1,Min1),avl_max(A1,Max1), avl_min(A2,Min2),avl_max(A2,Max2), avl_height(A1,H1),nl,print(diff(avl(H1,Min1,Max1),avl(H2,Min2,Max2))),nl, |
| 3765 | | avl_height(A1,H1), |
| 3766 | | ((H2<2 -> true ; H1 > H2+1) % then it is more efficient to expand A2 and remove the A2 elements from A1; |
| 3767 | | % note that difference_of_explicit_set2 now also sometimes expands both: |
| 3768 | | % exact threshold when it is beneficial: difference_of_explicit_set2/3 |
| 3769 | | % for {x|x:1..200000 & x mod 2 = 0} - {y|y:2500..29010 & y mod 2 = 0} -> 150 ms vs 80 ms avl(17,int(2),int(200000)),avl(14,int(2500),int(29010) |
| 3770 | | % {x|x:1..200000 & x mod 2 = 0} - {y|y:2500..59010 & y mod 2 = 0} -> 180 ms vs 80 ms avl(17,int(2),int(200000)),avl(15,int(2500),int(59010)) |
| 3771 | | % {x|x:1..200000 & x mod 2 = 0} - {y|y:500..159010 & y mod 2 = 0} -> 180 ms vs 250 ms avl(17,int(2),int(200000)),avl(17,int(500),int(159010)) |
| 3772 | | -> expand_custom_set_to_sorted_list(S2,ES,_,difference_of_explicit_set1,WF), |
| 3773 | | difference_of_explicit_set3(ES,A1,R) |
| 3774 | | ; expand_custom_set_to_sorted_list(avl_set(A1),ES,Done,difference_of_explicit_set2,WF), |
| 3775 | | difference_of_explicit_set2(ES,H1,A2,H2,R,Done)). |
| 3776 | | difference_of_explicit_set_wf(S1,S2,R,WF) :- |
| 3777 | | (S2=avl_set(A2) ; |
| 3778 | | ground_value(S2), expand_and_convert_to_avl_set_unless_very_large(S2,A2,WF)),!, |
| 3779 | | avl_height(A2,A2Height), |
| 3780 | | difference_with_avl(S1,A2,A2Height,R,WF). |
| 3781 | | % to do: we could detect same_texpr_body for two closures and return R=[] |
| 3782 | | |
| 3783 | | :- use_module(avl_tools,[avl_approximate_size_from_height/2]). |
| 3784 | | :- use_module(bsyntaxtree,[create_texpr/4, conjunct_predicates/2, mark_bexpr_as_symbolic/2]). |
| 3785 | | difference_with_avl(S1,A2,A2Height,R,_) :- |
| 3786 | | is_closure_or_integer_set(S1,[ID],[T],B), |
| 3787 | | % check if the first argument is infinite; then do the difference set symbolically |
| 3788 | | % this could supersed the complement set construction and be generalised to other sets apart from avl_sets as A2 |
| 3789 | | avl_approximate_size_from_height(A2Height,A2Size), |
| 3790 | | Limit is max(A2Size*10,1000000), % if A2 is more than 10% size of S1, probably better to compute difference explicitly |
| 3791 | | is_very_large_or_symbolic_closure([ID],[T],B,Limit), |
| 3792 | | !, % TO DO: also allow multiple identifiers |
| 3793 | | create_texpr(identifier(ID),T,[],TID), |
| 3794 | | create_texpr(value(avl_set(A2)),set(T),[],A2Value), |
| 3795 | | create_texpr(not_member(TID,A2Value),pred,[],NotMemA2), |
| 3796 | | conjunct_predicates([B,NotMemA2],NewBody), |
| 3797 | | mark_bexpr_as_symbolic(NewBody,NewBodyS), |
| 3798 | | R = closure([ID],[T],NewBodyS). |
| 3799 | | difference_with_avl(S1,A2,A2Height,R,WF) :- |
| 3800 | | (nonvar(S1),S1=avl_set(A1) -> avl_height(A1,H1) ; H1=unknown), |
| 3801 | | expand_custom_set_to_sorted_list(S1,ES,Done,difference_of_explicit_set3,WF), |
| 3802 | | difference_of_explicit_set2(ES,H1,A2,A2Height,R,Done). |
| 3803 | | |
| 3804 | | |
| 3805 | | % construct complement of a set |
| 3806 | | union_complement_set(S1,S2,Type,Result) :- |
| 3807 | | ground_value_check(S2,G2), |
| 3808 | | when(nonvar(G2),union_complement_set2(S1,S2,Type,Result)). |
| 3809 | | union_complement_set2(S1,S2,Type,Result) :- |
| 3810 | | union_of_explicit_set(S1,S2,S12), |
| 3811 | | construct_complement_closure_if_necessary(S12,Type,R), |
| 3812 | | kernel_objects:equal_object(R,Result,union_complement_set2). |
| 3813 | | |
| 3814 | | % construct complement of a set |
| 3815 | | complement_set(S2,Type,Result) :- |
| 3816 | | ground_value_check(S2,G2), |
| 3817 | | when(nonvar(G2),complement_set2(S2,Type,Result)). |
| 3818 | | complement_set2(S2,Type,Result) :- |
| 3819 | | is_not_member_value_closure(S2,Type,MS2),!, % complement of complement |
| 3820 | | kernel_objects:equal_object(MS2,Result,complement_set2). |
| 3821 | | complement_set2(S2,Type,Result) :- |
| 3822 | | try_expand_and_convert_to_avl_with_check(S2,ExpandedS2,difference_complement_set), |
| 3823 | | construct_complement_closure_if_necessary(ExpandedS2,Type,R), |
| 3824 | | kernel_objects:equal_object(R,Result,complement_set2). |
| 3825 | | |
| 3826 | | :- block construct_complement_closure_if_necessary(-,?,?). |
| 3827 | | construct_complement_closure_if_necessary(Set,TYPE,R) :- |
| 3828 | | (Set=[] -> b_type2_set(TYPE,R) |
| 3829 | | ; is_not_member_value_closure(Set,TYPE,MS) -> R=MS % complement of complement |
| 3830 | | ; construct_complement_closure(Set,TYPE,R)). |
| 3831 | | |
| 3832 | | % succeeds if difference of two intervals is also an interval |
| 3833 | | difference_interval(SourceLow,SourceUp,DiffLow,DiffUp,ResLow,ResUp) :- |
| 3834 | | (ground(SourceLow),ground(DiffLow),geq_inf(SourceLow,DiffLow) |
| 3835 | | -> inc(DiffUp,D1),maximum_with_inf(D1,SourceLow,ResLow), ResUp=SourceUp |
| 3836 | | ; ground(DiffUp),ground(SourceUp),geq_inf(DiffUp,SourceUp) |
| 3837 | | -> ResLow=SourceLow, dec(DiffLow,D1),minimum_with_inf(SourceUp,D1,ResUp)). |
| 3838 | | |
| 3839 | | inc(N,R) :- N==inf,!,R=inf. |
| 3840 | | inc(N,N1) :- N1 is N+1. |
| 3841 | | dec(N,R) :- N==inf,!,R=inf. |
| 3842 | | dec(N,N1) :- N1 is N-1. |
| 3843 | | |
| 3844 | | :- use_module(library(ordsets), [ord_subtract/3]). |
| 3845 | | :- block difference_of_explicit_set2(?,?,?,?,?,-). |
| 3846 | | difference_of_explicit_set2(ES,A1Height,A2,A2Height,R,_) :- |
| 3847 | | (number(A1Height), A1Height+4 >= A2Height -> true |
| 3848 | | ; A2Height < 5 |
| 3849 | | ; Limit is 2**(A2Height-4), |
| 3850 | | length_larger_than(ES,Limit) |
| 3851 | | % TO DO: we could try and pass sizes from specific closures to this predicate |
| 3852 | | ), |
| 3853 | | % A1 is not much larger than A2, then it is probably faster to use ord_subtract on expanded A2 |
| 3854 | | % {x|x mod 2 =0 & x:1..10000} - {y|y mod 3 =0 & y : 1..200000} : still more efficient with ord_subtract |
| 3855 | | !, |
| 3856 | | avl_domain(A2,A2Expanded), |
| 3857 | | ord_subtract(ES,A2Expanded,OrdRes), |
| 3858 | | sorted_ground_normalised_list_to_avlset(OrdRes,AVL,difference_of_explicit_set2), |
| 3859 | | equal_object(AVL,R). |
| 3860 | | difference_of_explicit_set2(ES,_A1Height,A2,_A2Height,R,_) :- |
| 3861 | | avl_min(A2,Min), |
| 3862 | | diff1(ES,Min,A2,IRes), |
| 3863 | | ord_list_to_avlset(IRes,AVL,difference), % we have generated the elements in the right order already |
| 3864 | | equal_object(AVL,R). % due to delays in expansion the result could be instantiated |
| 3865 | | |
| 3866 | | |
| 3867 | | length_larger_than([_|T],Limit) :- |
| 3868 | | (Limit<1 -> true |
| 3869 | | ; L1 is Limit-1, length_larger_than(T,L1)). |
| 3870 | | |
| 3871 | | diff1([],_, _,[]). |
| 3872 | | diff1([H|T],Min,A1, Res) :- |
| 3873 | | (H @< Min -> Res = [H-true|Res2],diff1(T,Min,A1,Res2) |
| 3874 | | ; diff2([H|T],A1,Res)).% TO DO: compute avl_max |
| 3875 | | |
| 3876 | | diff2([],_, []). |
| 3877 | | diff2([H|T],A1, Res) :- |
| 3878 | | (avl_fetch(H,A1) -> Res = Res2 ; Res = [H-true|Res2]), diff2(T,A1,Res2). |
| 3879 | | |
| 3880 | | % another version to be used when second set small in comparison to first set |
| 3881 | | difference_of_explicit_set3([],A1,Res) :- construct_avl_set(A1,AVL), |
| 3882 | | equal_object(AVL,Res). % due to delay in expansion, Res could now be instantiated |
| 3883 | | difference_of_explicit_set3([H|T],A1,ARes) :- |
| 3884 | | (avl_delete(H,A1,_True,A2) -> true ; A2=A1), |
| 3885 | | difference_of_explicit_set3(T,A2,ARes). |
| 3886 | | |
| 3887 | | % ------------------------- |
| 3888 | | |
| 3889 | | % a version of add_element_to_explicit_set where we have already done the groundness check |
| 3890 | | add_ground_element_to_explicit_set_wf(avl_set(A),Element,R,WF) :- !, |
| 3891 | | convert_to_avl_inside_set_wf(Element,AEl,WF), |
| 3892 | | avl_store(AEl,A,true,A2),!,R=avl_set(A2). |
| 3893 | | add_ground_element_to_explicit_set_wf(Set,Element,R,WF) :- |
| 3894 | | add_element_to_explicit_set_wf(Set,Element,R,WF). |
| 3895 | | |
| 3896 | | add_element_to_explicit_set_wf(global_set(GS),_,R,_) :- is_maximal_global_set(GS), !, R=global_set(GS). |
| 3897 | | add_element_to_explicit_set_wf(freetype(ID),_,R,_) :- is_maximal_freetype(ID),!, R=freetype(ID). |
| 3898 | | add_element_to_explicit_set_wf(avl_set(A),Element,R,WF) :- |
| 3899 | | ground_value(Element), %% was element_can_be_added_or_removed_to_avl(Element), |
| 3900 | | convert_to_avl_inside_set_wf(Element,AEl,WF), |
| 3901 | | avl_store(AEl,A,true,A2),!,R=avl_set(A2). /* AVL not normalised */ |
| 3902 | | /* do we need to add support for (special) closures ?? |
| 3903 | | add_element_to_explicit_set_wf(Clos,Element,R,_) :- nonvar(Element),Element=int(X), nonvar(X), |
| 3904 | | is_interval_closure_or_integerset(Clos,Low,Up), ground(Low), ground(Up), |
| 3905 | | union_of_interval(X,X,Low,Up,FromRes,ToRes), |
| 3906 | | !, |
| 3907 | | construct_interval_closure(FromRes,ToRes,R). |
| 3908 | | % not-member closure not dealt with here |
| 3909 | | */ |
| 3910 | | |
| 3911 | | element_can_be_added_or_removed_to_avl(Element) :- |
| 3912 | | ground_value(Element), |
| 3913 | | does_not_contain_closure(Element). |
| 3914 | | ground_element_can_be_added_or_removed_to_avl(Element) :- /* use if you know the element to be ground */ |
| 3915 | | does_not_contain_closure(Element). |
| 3916 | | |
| 3917 | | % does not contain closure or infinite other sets |
| 3918 | | does_not_contain_closure([]). |
| 3919 | | does_not_contain_closure([H|T]) :- |
| 3920 | | (simple_value(H) -> true /* TO DO: check if we could have a closure at the end ?? */ |
| 3921 | | ; does_not_contain_closure(H),list_does_not_contain_closure(T)). |
| 3922 | | does_not_contain_closure(fd(_,_)). |
| 3923 | | does_not_contain_closure(pred_true /* bool_true */). |
| 3924 | | does_not_contain_closure(pred_false /* bool_false */). |
| 3925 | | does_not_contain_closure(int(_)). |
| 3926 | | does_not_contain_closure(string(_)). |
| 3927 | | does_not_contain_closure(term(_)). % real/floating number |
| 3928 | | does_not_contain_closure((X,Y)) :- does_not_contain_closure(X), does_not_contain_closure(Y). |
| 3929 | | does_not_contain_closure(avl_set(_)). |
| 3930 | | does_not_contain_closure(global_set(G)) :- \+ is_infinite_global_set(G,_). |
| 3931 | | %does_not_contain_closure(freetype(_)). |
| 3932 | | does_not_contain_closure(freeval(_,_,Value)) :- does_not_contain_closure(Value). |
| 3933 | | does_not_contain_closure(rec(Fields)) :- does_not_contain_closure_fields(Fields). |
| 3934 | | |
| 3935 | | does_not_contain_closure_fields([]). |
| 3936 | | does_not_contain_closure_fields([field(_,Val)|T]) :- does_not_contain_closure(Val), |
| 3937 | | does_not_contain_closure_fields(T). |
| 3938 | | |
| 3939 | | list_does_not_contain_closure([]). |
| 3940 | | list_does_not_contain_closure([H|T]) :- |
| 3941 | | does_not_contain_closure(H),list_does_not_contain_closure(T). |
| 3942 | | list_does_not_contain_closure(avl_set(_)). |
| 3943 | | list_does_not_contain_closure(global_set(G)) :- \+ is_infinite_global_set(G,_). |
| 3944 | | |
| 3945 | | simple_value(fd(_,_)). |
| 3946 | | simple_value(pred_true /* bool_true */). |
| 3947 | | simple_value(pred_false /* bool_false */). |
| 3948 | | simple_value(int(_)). |
| 3949 | | simple_value((A,B)) :- simple_value(A), simple_value(B). |
| 3950 | | simple_value(string(_)). |
| 3951 | | |
| 3952 | | |
| 3953 | | % a version of the above which throws error if element cannot be added |
| 3954 | | % assumes element_can_be_added_or_removed_to_avl has been checked |
| 3955 | | remove_element_from_explicit_set(avl_set(A),Element,R) :- |
| 3956 | | element_can_be_added_or_removed_to_avl(Element), % remove check? |
| 3957 | | convert_to_avl_inside_set(Element,AEl), !, |
| 3958 | | direct_remove_element_from_avl(A,AEl,R). |
| 3959 | | remove_element_from_explicit_set(ES,Element,R) :- |
| 3960 | | add_internal_error('Cannot remove element from explicit set:',remove_element_from_explicit_set(ES,Element,R)). |
| 3961 | | |
| 3962 | | direct_remove_element_from_avl(A,AEl,R) :- |
| 3963 | | avl_delete(AEl,A,_True,A2), |
| 3964 | | construct_avl_set(A2,R). /* AVL not normalised */ |
| 3965 | | |
| 3966 | | /* same as remove but element can be absent */ |
| 3967 | | delete_element_from_explicit_set(avl_set(A),Element,R) :- |
| 3968 | | element_can_be_added_or_removed_to_avl(Element), |
| 3969 | | convert_to_avl_inside_set(Element,AEl), !, |
| 3970 | | (avl_delete(AEl,A,_True,A2) |
| 3971 | | -> construct_avl_set(A2,R) |
| 3972 | | ; R = avl_set(A) |
| 3973 | | ). /* AVL not normalised */ |
| 3974 | | |
| 3975 | | is_maximal_global_set(GS) :- is_maximal_global_set(GS,_Type). |
| 3976 | | is_maximal_global_set(GS,_) :- var(GS),!,fail. |
| 3977 | | is_maximal_global_set('INTEGER',Type) :- !, Type=integer. |
| 3978 | | is_maximal_global_set('REAL',Type) :- !, Type=real. |
| 3979 | | is_maximal_global_set('FLOAT',_) :- !, fail. |
| 3980 | | is_maximal_global_set('STRING',Type) :- !, Type=string. |
| 3981 | | is_maximal_global_set(GS,global(GS)) :- |
| 3982 | | \+ kernel_objects:integer_global_set(GS). |
| 3983 | | |
| 3984 | | % To do: maybe get rid of all complement set code; add in_difference_set as symbolic binary operator |
| 3985 | | %is_very_large_maximal_global_set(X,_) :- print(very(X)),nl,fail. |
| 3986 | | is_very_large_maximal_global_set(closure(P,T,B),Type) :- is_definitely_maximal_closure(P,T,B), |
| 3987 | | couplise_list(T,Type). |
| 3988 | | is_very_large_maximal_global_set(global_set('INTEGER'),integer). |
| 3989 | | is_very_large_maximal_global_set(global_set('STRING'),string). |
| 3990 | | is_very_large_maximal_global_set(global_set('REAL'),string). |
| 3991 | | is_very_large_maximal_global_set(freetype(ID),freetype(ID)) :- is_infinite_freetype(ID). |
| 3992 | | |
| 3993 | | |
| 3994 | | |
| 3995 | | remove_minimum_element_custom_set(avl_set(S),X,RES) :- !, |
| 3996 | | avl_del_min(S,X,_True,Res0), |
| 3997 | | (empty_avl(Res0) -> RES=[] ; RES = avl_set(Res0)). |
| 3998 | | %remove_minimum_element_custom_set(closure(P,T,B),X,RES) :- |
| 3999 | | % is_interval_closure_or_integerset(Clos,Low,Up),!, |
| 4000 | | % X = Low, TO DO: construct new interval closure |
| 4001 | | remove_minimum_element_custom_set(CS,X,RES) :- |
| 4002 | | expand_custom_set_to_list(CS,ECS,Done,remove_minimum_element_custom_set), |
| 4003 | | remove_minimum_element_custom_set2(ECS,X,RES,Done). |
| 4004 | | |
| 4005 | | :- block remove_minimum_element_custom_set2(?,?,?,-). |
| 4006 | | % wait until Done: otherwise the Tail of the list could be instantiated by somebody else; interfering with expand_custom_set_to_list |
| 4007 | | remove_minimum_element_custom_set2([H|T],X,RES,_) :- equal_object((H,T),(X,RES)). |
| 4008 | | |
| 4009 | | |
| 4010 | | min_of_explicit_set_wf(avl_set(S),Min,_) :- !, avl_min(S,Min). |
| 4011 | | min_of_explicit_set_wf(Clos,Min,WF) :- |
| 4012 | | is_interval_closure_or_integerset(Clos,Low,Up), |
| 4013 | | (Low == minus_inf |
| 4014 | | -> add_wd_error('minimum of unbounded infinite set not defined:',Clos,WF) |
| 4015 | | ; cs_greater_than_equal(Up,Low), |
| 4016 | | Min=int(Low)). |
| 4017 | | |
| 4018 | | cs_greater_than_equal(X,Y) :- |
| 4019 | | ((X==inf;Y==minus_inf) -> true ; kernel_objects:less_than_equal_direct(Y,X)). |
| 4020 | | |
| 4021 | | |
| 4022 | | max_of_explicit_set_wf(avl_set(S),Max,_) :- !,avl_max(S,Max). |
| 4023 | | max_of_explicit_set_wf(Clos,Max,WF) :- |
| 4024 | | is_interval_closure_or_integerset(Clos,Low,Up), |
| 4025 | | (Up==inf |
| 4026 | | -> add_wd_error('maximum of unbounded infinite set not defined:',Clos,WF) |
| 4027 | | ; cs_greater_than_equal(Up,Low), |
| 4028 | | Max=int(Up)). |
| 4029 | | |
| 4030 | | % ------------- SIGMA/PI -------------- |
| 4031 | | |
| 4032 | | % compute sum or product of an integer set: |
| 4033 | | sum_or_mul_of_explicit_set(avl_set(S),SUMorMUL,Result) :- |
| 4034 | | avl_domain(S,Dom), |
| 4035 | | (SUMorMUL=sum -> simple_sum_list(Dom,0,R) ; simple_mul_list(Dom,1,R)), |
| 4036 | | Result = int(R). |
| 4037 | | sum_or_mul_of_explicit_set(CS,SUMorMUL,Result) :- SUMorMUL == sum, |
| 4038 | | is_interval_closure(CS,Low,Up), |
| 4039 | | sum_interval(Low,Up,Result), |
| 4040 | | sum_interval_clpfd_prop(Low,Up,Result). |
| 4041 | | |
| 4042 | | :- block sum_interval(-,?,?), sum_interval(?,-,?). |
| 4043 | | sum_interval(Low,Up,_) :- (\+ number(Low) ; \+ number(Up)),!, |
| 4044 | | add_error(sum_interval,'Cannot compute sum of interval: ',Low:Up),fail. |
| 4045 | | sum_interval(Low,Up,Result) :- Low>Up,!, Result=int(0). |
| 4046 | | sum_interval(Low,Up,Result) :- |
| 4047 | | R is ((1+Up-Low)*(Low+Up)) // 2, % generalisation of Gauss formula k*(k+1)//2 |
| 4048 | | Result = int(R). |
| 4049 | | |
| 4050 | | sum_interval_clpfd_prop(Low,Up,Result) :- |
| 4051 | | preferences:preference(use_clpfd_solver,true), Result=int(R), |
| 4052 | | var(R), % we haven't computed the result yet; the bounds are not known; set up constraint propagation rules |
| 4053 | | !, |
| 4054 | | try_post_constraint((Low #>= 0) #=> (R #> 0)), % we could provide better bounds here for negative numbers |
| 4055 | | try_post_constraint(((Low #=< Up) #\/ (R #\= 0)) #=> (R #= ((1+Up-Low)*(Low+Up))//2)), |
| 4056 | | try_post_constraint((Low #> Up) #=> (R #= 0)). |
| 4057 | | % not working yet: x = SIGMA(i).(i:-3..n|i) & x=0 & n< -1 |
| 4058 | | sum_interval_clpfd_prop(_,_,_). |
| 4059 | | |
| 4060 | | simple_sum_list([],A,A). |
| 4061 | | simple_sum_list([int(H)|T],Acc,R) :- NA is Acc+H, simple_sum_list(T,NA,R). |
| 4062 | | simple_mul_list([],A,A). |
| 4063 | | simple_mul_list([int(H)|T],Acc,R) :- NA is Acc*H, simple_mul_list(T,NA,R). |
| 4064 | | |
| 4065 | | |
| 4066 | | /* |
| 4067 | | direct_product_symbolic(S,R,Res) :- % NOT YET FINISHED |
| 4068 | | nonvar(S), S=closure(PS,[T1,TS2],RS), |
| 4069 | | nonvar(R), R=closure(PR,[T1,TR1],RR), |
| 4070 | | is_lambda_value_domain_closure(PS,TS,RS, SDomainValue,SExpr), |
| 4071 | | is_lambda_value_domain_closure(PR,TR,RR, RDomainValue,RExpr), |
| 4072 | | construct_closure(['zzz','_lambda_result_'],[T1,couple(TR1,TR2)], |
| 4073 | | member(zzz,SDomainValue) , member(zzz,RDomainValue), eq(lambda,pair(SExpr,RExpr))). |
| 4074 | | */ |
| 4075 | | |
| 4076 | | % we assume that try_expand_and_convert_to_avl_unless_very_large already called on arguments |
| 4077 | | direct_product_explicit_set(S,R,Res) :- |
| 4078 | | nonvar(R), %is_custom_explicit_set(R,direct_product), |
| 4079 | | nonvar(S), %is_custom_explicit_set(S,direct_product), |
| 4080 | | direct_product_explicit_set_aux(S,R,Res). |
| 4081 | | %direct_product_explicit_set_aux(S,R,Res) :- (S = closure(_,_,_) ; R = closure(_,_,_)), |
| 4082 | | % print_term_summary(direct_product_explicit_set_aux(S,R,Res)),nl, |
| 4083 | | % % TO DO: generate closure |
| 4084 | | % fail. |
| 4085 | | direct_product_explicit_set_aux(avl_set(AS),avl_set(AR),Res) :- |
| 4086 | | % the expansion guarantees that we have the lists ES and ER then in sorted order |
| 4087 | | avl_domain(AS,ES), % -> expand_custom_set(avl_set(AS),ES), |
| 4088 | | avl_domain(AR,ER), % -> expand_custom_set(avl_set(AR),ER), |
| 4089 | | direct_product3(ES,ER,DPList), |
| 4090 | | ord_list_to_avlset(DPList,DPAVL,direct_product), % is it really ordered ? findall must also return things ordered! |
| 4091 | | equal_object(DPAVL,Res,direct_product_explicit_set). |
| 4092 | | |
| 4093 | | direct_product3([],_Rel2,[]). |
| 4094 | | direct_product3([(From,To1)|T1],Rel2,Res) :- |
| 4095 | | get_next_mapped_to_eq(T1,From,TTo,Tail1), ToList1 = [To1|TTo], |
| 4096 | | get_next_mapped_to(Rel2,From,ToList2,Tail2), |
| 4097 | | calc_direct_product(ToList1,From,ToList2,Res,Rest), |
| 4098 | | (Tail2=[] -> Rest=[] ; direct_product3(Tail1,Tail2,Rest)). |
| 4099 | | |
| 4100 | | % get all elements which map to From, supposing that the list is sorted & we have already had a match |
| 4101 | | get_next_mapped_to_eq([],_,[],[]). |
| 4102 | | get_next_mapped_to_eq([(From2,To2)|T],From,Result,Tail) :- |
| 4103 | | (From=From2 -> Result = [To2|RR], get_next_mapped_to_eq(T,From,RR,Tail) |
| 4104 | | ; Result = [], Tail = [(From2,To2)|T] |
| 4105 | | ). |
| 4106 | | |
| 4107 | | % get all elements which map to From, supposing the list is sorted |
| 4108 | | get_next_mapped_to([],_,[],[]). |
| 4109 | | get_next_mapped_to([(From2,To2)|T],From,Result,Tail) :- |
| 4110 | | (From=From2 -> Result = [To2|RR], get_next_mapped_to_eq(T,From,RR,Tail) |
| 4111 | | ; From2 @> From -> Result = [], Tail = [(From2,To2)|T] |
| 4112 | | ; get_next_mapped_to(T,From,Result,Tail) |
| 4113 | | ). |
| 4114 | | |
| 4115 | | calc_direct_product([],_From,_,Tail,Tail). |
| 4116 | | calc_direct_product([To1|T1],From,To2List,Result,Tail) :- |
| 4117 | | findall((From,(To1,To2))-true,member(To2,To2List),Result,ResResult), |
| 4118 | | calc_direct_product(T1,From,To2List,ResResult,Tail). |
| 4119 | | |
| 4120 | | % TO DO: maybe also add a special rule for infinite R such as event_b_identity ? |
| 4121 | | domain_restriction_explicit_set_wf(S,R,Res,WF) :- /* S <| R */ |
| 4122 | | nonvar(R), |
| 4123 | | (nonvar(S),is_one_element_custom_set(S,El),R \= closure(_,_,_) -> |
| 4124 | | domain_restrict_singleton_element(El,R,Res) |
| 4125 | | ; restriction_explicit_set_wf(S,R,Res,domain,pred_true,WF)). |
| 4126 | | domain_subtraction_explicit_set_wf(S,R,Res,WF) :- /* S <<| R */ |
| 4127 | | (nonvar(S),is_one_element_custom_set(S,El), nonvar(R), R=avl_set(AVL) -> |
| 4128 | | avl_domain_subtraction_singleton(AVL,El,ARes), |
| 4129 | | construct_avl_set(ARes,Res) % TO DO: use this also when S is small and R large |
| 4130 | | ; restriction_explicit_set_wf(S,R,Res,domain,pred_false,WF)). |
| 4131 | | range_restriction_explicit_set_wf(R,S,Res,WF) :- /* R |> S */ |
| 4132 | | restriction_explicit_set_wf(S,R,Res,range,pred_true,WF). |
| 4133 | | range_subtraction_explicit_set_wf(R,S,Res,WF) :- /* R |>> S */ |
| 4134 | | restriction_explicit_set_wf(S,R,Res,range,pred_false,WF). |
| 4135 | | |
| 4136 | | |
| 4137 | | domain_restrict_singleton_element(El,R,Res) :- /* {El} <| R ; TO DO maybe apply this technique for "small" sets as well */ |
| 4138 | | nonvar(R), is_custom_explicit_set(R,domain_restrict_singleton_element), |
| 4139 | | expand_and_convert_to_avl_set(R,AR,domain_restrict_singleton_element,''), % can generate ARel=empty; will fail if not possible to convert |
| 4140 | | findall((El,Z)-true, avl_fetch_pair(El,AR,Z), RTuples), |
| 4141 | | ord_list_to_avlset(RTuples,Res,domain_restrict_singleton_element). |
| 4142 | | |
| 4143 | | restriction_explicit_set_wf(Set,Rel,Res,_RanOrDom,AddWhen,WF) :- Set==[],!, |
| 4144 | | (AddWhen=pred_false |
| 4145 | | -> equal_object_wf(Rel,Res,restriction_explicit_set_wf,WF) % {} <<| Rel = Rel |>> {} = Rel |
| 4146 | | ; kernel_objects:empty_set_wf(Res,WF) |
| 4147 | | ). |
| 4148 | | restriction_explicit_set_wf(Set,Rel,Res,_RanOrDom,AddWhen,WF) :- is_definitely_maximal_set(Set),!, |
| 4149 | | (AddWhen=pred_true |
| 4150 | | -> equal_object_wf(Rel,Res,restriction_explicit_set_wf,WF) % TYPE <| Rel = Rel |> TYPE = Rel |
| 4151 | | ; kernel_objects:empty_set_wf(Res,WF) |
| 4152 | | ). |
| 4153 | | restriction_explicit_set_wf(_,Rel,_,_,_,_) :- var(Rel),!,fail. |
| 4154 | | restriction_explicit_set_wf(Set,closure(Paras,Types,Body),Res,RanOrDom,AddWhen,WF) :- |
| 4155 | | % perform symbolic treatment by adding restriction predicate to Body |
| 4156 | | !, |
| 4157 | | (RanOrDom=domain |
| 4158 | | -> get_domain_id_or_expr(Paras,Types,TID,TT) |
| 4159 | | ; get_range_id_or_expr(Paras,Types,TID,TT) |
| 4160 | | ), |
| 4161 | | TSet=b(value(Set),set(TT),[]), |
| 4162 | | (AddWhen = pred_true |
| 4163 | | -> PRED = member(TID,TSet) |
| 4164 | | ; PRED = not_member(TID,TSet) ), |
| 4165 | | conjunct_predicates([b(PRED,pred,[]),Body],NewBody), |
| 4166 | | % translate:print_bexpr(NewBody),nl, |
| 4167 | | try_expand_and_convert_to_avl_with_catch_wf(closure(Paras,Types,NewBody),Res,restriction_explicit_set_wf,WF). |
| 4168 | | restriction_explicit_set_wf(Set,Rel,Res,RanOrDom,AddWhen,WF) :- |
| 4169 | | is_custom_explicit_set(Rel,restriction_explicit_set_wf), |
| 4170 | | expand_and_convert_to_avl_set(Rel,ARel,restriction_explicit_set_wf,''), % can generate ARel=empty; will fail if not possible to convert |
| 4171 | | avl_domain(ARel,ERel), % -> expand_custom_set(avl_set(ARel),ERel), |
| 4172 | | %try_expand_and_convert_to_avl_unless_large_wf(Set,ES,WF), |
| 4173 | | (nonvar(Set),Set=avl_set(AVLS) |
| 4174 | | -> restrict2_avl(ERel,AVLS,DRes,RanOrDom,AddWhen,Done) |
| 4175 | | ; restrict2(ERel,Set,DRes,RanOrDom,AddWhen,Done,WF) |
| 4176 | | ), |
| 4177 | | finish_restriction(Done,DRes,Res). |
| 4178 | | |
| 4179 | | % extract domain expression for domain restriction/subtraction predicate: |
| 4180 | | get_domain_id_or_expr([DR],[couple(TD,TR)], PRJ1, TD) :- !, % special case: just one parameter in closure |
| 4181 | | TID = b(identifier(DR),couple(TD,TR),[]), |
| 4182 | | PRJ1 = b(first_of_pair(TID),TD,[]). |
| 4183 | | get_domain_id_or_expr([D1|Paras],[TD1|Types],Expr,Type) :- |
| 4184 | | get_dom_couple_aux(Paras,Types, b(identifier(D1),TD1,[]), TD1, Expr,Type). |
| 4185 | | |
| 4186 | | get_dom_couple_aux([_RangeID],[_], AccExpr, AccType, Expr, Type) :- !, Expr=AccExpr, Type=AccType. |
| 4187 | | get_dom_couple_aux([D2|TParas],[TD2|Types], AccExpr, AccType, Expr, Type) :- |
| 4188 | | TID2 = b(identifier(D2),TD2,[]), |
| 4189 | | NewAccType = couple(AccType,TD2), |
| 4190 | | NewAcc = b(couple(AccExpr,TID2),NewAccType,[]), |
| 4191 | | get_dom_couple_aux(TParas,Types,NewAcc,NewAccType,Expr,Type). |
| 4192 | | |
| 4193 | | :- use_module(library(lists),[last/2]). |
| 4194 | | % extract range expression for range restriction/subtraction predicate: |
| 4195 | | get_range_id_or_expr( [DR],[CType], PRJ2, TR) :- !, % special case: just one parameter in closure |
| 4196 | | CType = couple(TD,TR), |
| 4197 | | TID = b(identifier(DR),CType,[]), |
| 4198 | | PRJ2 = b(second_of_pair(TID),TD,[]). |
| 4199 | | get_range_id_or_expr( [_|Paras],[_|Types], b(identifier(R),TR,[]), TR) :- |
| 4200 | | last(Paras,R), last(Types,TR). |
| 4201 | | |
| 4202 | | :- block finish_restriction(-,?,?). |
| 4203 | | finish_restriction(_,DRes,Res) :- |
| 4204 | | ord_list_to_avlset(DRes,Restriction,restriction), |
| 4205 | | equal_object(Restriction,Res,finish_restriction). % as we may block below: we need to use equal_object |
| 4206 | | |
| 4207 | | restrict2([],_,[],_,_,done,_WF). |
| 4208 | | restrict2([(From,To)|T],S,Res,RanOrDom,AddWhen,Done,WF) :- |
| 4209 | | (RanOrDom==domain -> El=From ; El=To), |
| 4210 | | kernel_equality:membership_test_wf(S,El,MemRes,WF), % TO DO: WF Version !! |
| 4211 | | /* this only makes sense once we have the full result as argument: |
| 4212 | | (nonvar(MemRes) -> true % it is already decided |
| 4213 | | ; AddWhen=pred_true -> kernel_equality:membership_test_wf(Res,(From,To),MemRes,WF) |
| 4214 | | ; kernel_equality:membership_test_wf(Res,(From,To),InResult,WF), bool_pred:negate(InResult,MemRes) |
| 4215 | | ), */ |
| 4216 | | restrict3(MemRes,From,To,T,S,Res,RanOrDom,AddWhen,Done,WF). |
| 4217 | | :- block restrict3(-, ?,?, ?,?,?, ?,?,?,?). |
| 4218 | | restrict3(MemRes, From,To, T,S,Res, RanOrDom,AddWhen,Done,WF) :- |
| 4219 | | (AddWhen=MemRes -> Res = [(From,To)-true|TRes] |
| 4220 | | ; Res=TRes), |
| 4221 | | restrict2(T,S,TRes,RanOrDom,AddWhen,Done,WF). |
| 4222 | | |
| 4223 | | % optimised version when second set is also an AVL tree: less blocking,... |
| 4224 | | restrict2_avl([],_,[],_,_,done). |
| 4225 | | restrict2_avl([(From,To)|T],AVLS,Res,RanOrDom,AddWhen,Done) :- |
| 4226 | | fetch(RanOrDom,From,To,AVLS,MemRes), |
| 4227 | | (AddWhen=MemRes -> Res = [(From,To)-true|TRes] |
| 4228 | | ; Res=TRes), |
| 4229 | | restrict2_avl(T,AVLS,TRes,RanOrDom,AddWhen,Done). |
| 4230 | | |
| 4231 | | fetch(domain,El,_,AVLS,MemRes) :- (avl_fetch(El,AVLS) -> MemRes=pred_true ; MemRes = pred_false). |
| 4232 | | fetch(range,_,El,AVLS,MemRes) :- (avl_fetch(El,AVLS) -> MemRes=pred_true ; MemRes = pred_false). |
| 4233 | | |
| 4234 | | % override R(X) := Y |
| 4235 | | override_pair_explicit_set(avl_set(S),X,Y,avl_set(NewAVL)) :- element_can_be_added_or_removed_to_avl(X), |
| 4236 | | element_can_be_added_or_removed_to_avl(Y), |
| 4237 | | convert_to_avl_inside_set(X,AX), |
| 4238 | | convert_to_avl_inside_set(Y,AY), |
| 4239 | | avl_domain_subtraction_singleton(S,AX,AVL2), |
| 4240 | | avl_store((AX,AY), AVL2, true, NewAVL). |
| 4241 | | |
| 4242 | | avl_domain_subtraction_singleton(AVL,AX,NewAVL) :- |
| 4243 | | avl_delete_pair(AX,AVL,_True,AVL2), |
| 4244 | | !, % recurse, in case we have multiple entries |
| 4245 | | % this recursion could be avoided if we know AVL to be a function |
| 4246 | | avl_domain_subtraction_singleton(AVL2,AX,NewAVL). |
| 4247 | | avl_domain_subtraction_singleton(AVL,_,AVL). |
| 4248 | | |
| 4249 | | % try and decompose an AVL set into a cartesian product |
| 4250 | | % AVL = Set1 * Set2 |
| 4251 | | % much faster e.g. for let xx = ((1..10)*(3..1000)\/ {0}*(3..1000)) and then xx = AA*BB |
| 4252 | | % should not produce pending co-routines |
| 4253 | | decompose_avl_set_into_cartesian_product_wf(AVL,DomainSet,RangeSet,WF) :- |
| 4254 | | avl_domain(AVL,Expansion), |
| 4255 | | decompose_cart(Expansion,'$none',DomainList,[],RangeList), |
| 4256 | | construct_avl_from_lists_wf(DomainList,DomainSet,WF), |
| 4257 | | construct_avl_from_lists_wf(RangeList,RangeSet,WF). |
| 4258 | | |
| 4259 | | decompose_cart([],_,[],[],_). |
| 4260 | | decompose_cart([(A,B)|T],Prev,Domain,Range,FullRange) :- |
| 4261 | | (A=Prev |
| 4262 | | -> Range = [B|TRange], |
| 4263 | | decompose_cart(T,Prev,Domain,TRange,FullRange) |
| 4264 | | ; Domain = [A|TDom], Range=[], |
| 4265 | | FullRange = [B|TRange], |
| 4266 | | decompose_cart(T,A,TDom,TRange,FullRange) |
| 4267 | | ). |
| 4268 | | |
| 4269 | | /* --------- */ |
| 4270 | | /* EXPANSION */ |
| 4271 | | /* --------- */ |
| 4272 | | |
| 4273 | | :- use_module(b_global_sets,[all_elements_of_type_wf/3, all_elements_of_type_rand_wf/3]). |
| 4274 | | :- use_module(kernel_freetypes,[expand_freetype/3]). |
| 4275 | | |
| 4276 | | expand_custom_set(X,R) :- expand_custom_set_wf(X,R,expand_custom_set,no_wf_available). |
| 4277 | | expand_custom_set(X,R,Src) :- expand_custom_set_wf(X,R,Src,no_wf_available). |
| 4278 | | expand_custom_set_wf(X,R,Source,WF) :- var(X), !, |
| 4279 | | add_error_and_fail(expand_custom_set_wf, 'Variable as argument: ',expand_custom_set_wf(X,R,Source,WF)). |
| 4280 | | expand_custom_set_wf(global_set(GS),ExpandedSet,_,WF) :- !, |
| 4281 | | all_elements_of_type_wf(GS,ExpandedSet,WF). % they are generated in order |
| 4282 | | expand_custom_set_wf(freetype(GS),ValueList,_,WF) :- !, |
| 4283 | | expand_freetype(GS,ValueList,WF). |
| 4284 | | expand_custom_set_wf(avl_set(AVL),ExpandedSet,_,_) :- !, |
| 4285 | | avl_domain(AVL,ExpandedSet). |
| 4286 | | expand_custom_set_wf(closure(Parameters,PTypes,Cond),Res,Source,WF) :- !, |
| 4287 | | expand_closure_to_list(Parameters,PTypes,Cond,Res,_Done,Source,WF). |
| 4288 | | %wait_try_expand_custom_set(Res1,Res). % could be in AVL form; no longer the case ! |
| 4289 | | expand_custom_set_wf(Set,_,Source,_) :- |
| 4290 | | add_error_and_fail(expand_custom_set(Source),'Cannot expand custom set: ',Set). |
| 4291 | | |
| 4292 | | |
| 4293 | | |
| 4294 | | %try_expand_only_custom_closure_global(X,Y) :- |
| 4295 | | % (var(X) -> X=Y ; expand_only_custom_closure_global(X,Y,check)). |
| 4296 | | |
| 4297 | | expand_only_custom_closure_global(X,R,C,_WF) :- var(X), !, |
| 4298 | | add_error_and_fail(expand_only_custom_closure_global, 'Variable as argument: ',expand_only_custom_closure_global(X,R,C)). |
| 4299 | | expand_only_custom_closure_global(global_set(GS),ExpandedSet,_,WF) :- !,all_elements_of_type_wf(GS,ExpandedSet,WF). |
| 4300 | | expand_only_custom_closure_global(freetype(GS),ExpandedSet,_,_WF) :- !,ExpandedSet=freetype(GS). |
| 4301 | | expand_only_custom_closure_global(avl_set(AVL),ExpandedSet,_,_WF) :- !, ExpandedSet=avl_set(AVL). |
| 4302 | | expand_only_custom_closure_global(closure(Parameters,PTypes,Cond),Res,CheckTimeOuts,WF) :- !, |
| 4303 | | (Res==[] -> is_empty_explicit_set(closure(Parameters,PTypes,Cond)) % TO DO: think about other special cases |
| 4304 | | ; expand_closure_to_avl_or_list(Parameters,PTypes,Cond,Res,CheckTimeOuts,WF)). |
| 4305 | | expand_only_custom_closure_global(Set,Set,_CheckTimeOuts,_WF). |
| 4306 | | %:- add_error_and_fail(expand_only_custom_closure_global,'Cannot expand custom set: ',Set). |
| 4307 | | |
| 4308 | | |
| 4309 | | try_expand_custom_set_with_catch(CS,Expansion,PP) :- |
| 4310 | | on_enumeration_warning(try_expand_custom_set_wf(CS,Expansion,PP,no_wf_available), |
| 4311 | | Expansion=CS). |
| 4312 | | |
| 4313 | | try_expand_custom_set(CS,Expansion) :- |
| 4314 | | try_expand_custom_set_wf(CS,Expansion,try_expand_custom_set,no_wf_available). |
| 4315 | | |
| 4316 | | |
| 4317 | | try_expand_custom_set_wf(CS,Res,_,_) :- var(CS),!,Res=CS. |
| 4318 | | try_expand_custom_set_wf([],Res,_,_) :- !, Res=[]. |
| 4319 | | try_expand_custom_set_wf([H|T],Res,_,_) :- !, Res=[H|T]. |
| 4320 | | try_expand_custom_set_wf(CS,Res,Src,WF) :- |
| 4321 | | expand_custom_set_wf(CS,Res,Src,WF). % will generate error message for illegal sets |
| 4322 | | |
| 4323 | | |
| 4324 | | :- assert_must_succeed((expand_custom_set_to_list(closure(['_zzzz_unit_tests'], |
| 4325 | | [couple(integer,integer)], |
| 4326 | | b(member(b(identifier('_zzzz_unit_tests'),couple(integer,integer),[generated]), |
| 4327 | | b(value([(int(1),int(22))]),set(couple(integer,integer)),[])),pred,[])),R),R==[(int(1),int(22))])). |
| 4328 | | |
| 4329 | | expand_custom_set_to_list(CS,List) :- expand_custom_set_to_list(CS,List,_Done,unknown). |
| 4330 | | |
| 4331 | | % a version of expansion which returns guaranteed_ground if the List is guaranteed to be ground |
| 4332 | | expand_custom_set_to_list_gg(CS,List,GuaranteedGround,_PP) :- |
| 4333 | | nonvar(CS), CS=avl_set(AVL), var(List), |
| 4334 | | !, |
| 4335 | | GuaranteedGround = guaranteed_ground, |
| 4336 | | avl_domain(AVL,List). |
| 4337 | | expand_custom_set_to_list_gg(CS,List,not_guaranteed_ground,PP) :- |
| 4338 | | expand_custom_set_to_list(CS,List,_Done,PP). |
| 4339 | | |
| 4340 | | % a version where the expansion should happen straightaway and should not block: |
| 4341 | | expand_custom_set_to_list_now(CS,List) :- expand_custom_set_to_list(CS,List,Done,unknown), |
| 4342 | | (Done==true -> true ; print_error(expand_custom_set_to_list_not_done(CS,List))). |
| 4343 | | |
| 4344 | | :- block expand_custom_set_to_sorted_list(-,-,?,?,?). |
| 4345 | | % sorts the resulting list if needed |
| 4346 | | % due to random enumeration |
| 4347 | | expand_custom_set_to_sorted_list(From,To,Done,Source,WF) :- |
| 4348 | | expand_custom_set_to_list(From,UnsortedTo,Done,Source), |
| 4349 | | (preferences:get_preference(randomise_enumeration_order,true) |
| 4350 | | -> sort_when_done(Done,UnsortedTo,To,WF) ; UnsortedTo = To). |
| 4351 | | |
| 4352 | | :- block sort_when_done(-,?,?,?). |
| 4353 | | sort_when_done(_,Unsorted,Res,WF) :- sort(Unsorted,Sorted), |
| 4354 | | equal_object_wf(Sorted,Res,sort_when_done,WF). |
| 4355 | | |
| 4356 | | expand_custom_set_to_list(From,To,Done,Source) :- |
| 4357 | | expand_custom_set_to_list_wf(From,To,Done,Source,no_wf_available). |
| 4358 | | |
| 4359 | | :- use_module(kernel_objects,[equal_object_wf/4]). |
| 4360 | | |
| 4361 | | expand_custom_set_to_list_wf(From,To,Done,Source,WF) :- |
| 4362 | | expand_custom_set_to_list_k_wf(From,To,Done,_Kind,Source,WF). |
| 4363 | | |
| 4364 | | % a variation of expand_custom_set_to_list which also checks that there are no duplicates in the list |
| 4365 | | expand_custom_set_to_list_no_dups_wf(From,To,Done,Source,WF) :- |
| 4366 | | expand_custom_set_to_list_k_wf(From,To,Done,Kind,Source,WF), |
| 4367 | | check_dups(Kind,To,WF). |
| 4368 | | |
| 4369 | | :- block check_dups(-,?,?). |
| 4370 | | check_dups(unsorted_list,List,WF) :- !, |
| 4371 | | kernel_objects:check_no_duplicates_in_list(List,[],WF). |
| 4372 | | check_dups(_,_,_). |
| 4373 | | |
| 4374 | | % warn if duplicates in list; to do: use in prob_safe mode |
| 4375 | | %:- block warn_dups(-,?,?,?). |
| 4376 | | %warn_dups(unsorted_list,List,Src,WF) :- !, |
| 4377 | | % kernel_objects:warn_if_duplicates_in_list(List,Src,WF). |
| 4378 | | %warn_dups(_,_,_,_). |
| 4379 | | |
| 4380 | | |
| 4381 | | |
| 4382 | | :- block expand_custom_set_to_list_k_wf(-,-,?,?,?,?). |
| 4383 | | % ensures that the output is a pure list; the list skeleton should not be instantiated by anybody else |
| 4384 | | expand_custom_set_to_list_k_wf(From,To,Done,Kind,Source,WF) :- |
| 4385 | | (var(From) -> |
| 4386 | | (is_list_skeleton(To) |
| 4387 | | -> equal_object_wf(To,From,Source,WF), Done=true, Kind=unsorted_list |
| 4388 | ? | ; expand_custom_set_to_list2(To,From,Done,Kind,Source,WF)) |
| 4389 | | ; var(To),is_list_skeleton(From) |
| 4390 | | -> To=From, Done=true, Kind=unsorted_list % equal_object_wf will also to a Prolog unification |
| 4391 | | ; expand_custom_set_to_list2(From,To,Done,Kind,Source,WF)). |
| 4392 | | |
| 4393 | | expand_custom_set_to_list2([],ExpandedSet,Done,Kind,_Source,WF) :- !, |
| 4394 | ? | equal_object_wf([],ExpandedSet,expand_custom_set_to_list2,WF),Done=true,Kind=empty_set. |
| 4395 | | expand_custom_set_to_list2([H|T],ExpandedSet,Done,Kind,Source,WF) :- !, Kind=unsorted_list, |
| 4396 | ? | equal_object_wf([H|ET],ExpandedSet,expand_custom_set_to_list2,WF), |
| 4397 | ? | expand_custom_set_to_list3(T,ET,Done,Source,WF). |
| 4398 | | expand_custom_set_to_list2(global_set(GS),ExpandedSet,Done,Kind,_Source,WF) :- !, |
| 4399 | | all_elements_of_type_rand_wf(GS,R,WF), |
| 4400 | | check_list(R,expand_custom_set_to_list2), |
| 4401 | | equal_object_wf(R,ExpandedSet,expand_custom_set_to_list2,WF),Done=true,Kind=sorted_list. |
| 4402 | | expand_custom_set_to_list2(avl_set(AVL),ExpandedSet,Done,Kind,_Source,WF) :- !, |
| 4403 | | avl_domain(AVL,R), |
| 4404 | ? | equal_object_wf(R,ExpandedSet,expand_custom_set_to_list2,WF), Done=true,Kind=sorted_list. |
| 4405 | | expand_custom_set_to_list2(closure(Parameters,PTypes,Cond),ExpandedSet,Done,Kind,Source,WF) :- !, |
| 4406 | | expand_closure_to_list(Parameters,PTypes,Cond,ExpandedSet,Done,Source,WF), |
| 4407 | | Kind=sorted_list. |
| 4408 | | %assign_expand_result(CDone,Res,ExpandedSet,Done). |
| 4409 | | expand_custom_set_to_list2(freetype(ID),ExpandedSet,Done,Kind,_Source,WF) :- !, |
| 4410 | | expand_freetype(ID,R,WF), |
| 4411 | | equal_object_wf(R,ExpandedSet,expand_custom_set_to_list2,WF), |
| 4412 | | Done=true,Kind=sorted_list. |
| 4413 | | % missing avl_set wrapper: |
| 4414 | | expand_custom_set_to_list2(node(A,B,C,D,E),ExpandedSet,Done,Kind,Source,WF) :- !, |
| 4415 | | add_internal_error('Illegal argument: ',expand_custom_set_to_list2(node(A,B,C,D,E),ExpandedSet,Done,Source)), |
| 4416 | | expand_custom_set_to_list2(avl_set(node(A,B,C,D,E)),ExpandedSet,Done,Kind,Source,WF). |
| 4417 | | expand_custom_set_to_list2(E,ES,Done,Kind,Source,WF) :- |
| 4418 | | add_internal_error('Illegal argument: ',expand_custom_set_to_list2(E,ES,Done,Kind,Source,WF)),fail. |
| 4419 | | |
| 4420 | | :- block expand_custom_set_to_list3(-,-,?,?,?). % we are no longer sure which was From and which is To |
| 4421 | | expand_custom_set_to_list3(From,To,Done,Source,WF) :- |
| 4422 | ? | (var(From) -> expand_custom_set_to_list2(To,From,Done,_,Source,WF) ; |
| 4423 | ? | expand_custom_set_to_list2(From,To,Done,_,Source,WF)). |
| 4424 | | |
| 4425 | | |
| 4426 | | is_list_skeleton(X) :- var(X),!,fail. |
| 4427 | | is_list_skeleton([]). |
| 4428 | | is_list_skeleton([_|T]) :- is_list_skeleton(T). |
| 4429 | | |
| 4430 | | % true if it is more efficient to keep this, rather than expand into list |
| 4431 | | is_efficient_custom_set(avl_set(_)). |
| 4432 | | is_efficient_custom_set(closure(P,T,B)) :- |
| 4433 | | (is_interval_closure(closure(P,T,B),_,_) -> true ; is_infinite_or_symbolic_closure(P,T,B)). |
| 4434 | | is_efficient_custom_set(global_set(X)) :- is_infinite_global_set(X,_). |
| 4435 | | is_efficient_custom_set(freetype(_)). |
| 4436 | | |
| 4437 | | % tries to expand & convert to avl_set; fails if not possible: NOTE: also generates empty AVL |
| 4438 | | expand_and_convert_to_avl_set(R,AER,Origin,Source) :- |
| 4439 | | try_expand_and_convert_to_avl(R,ER,Origin,Source), |
| 4440 | | nonvar(ER),(ER==[] -> AER=empty ; ER=avl_set(AER)). |
| 4441 | | |
| 4442 | | |
| 4443 | | expand_and_convert_to_avl_set_unless_very_large(R,AER,WF) :- |
| 4444 | | try_expand_and_convert_to_avl_unless_very_large_wf(R,ER,WF), |
| 4445 | | nonvar(ER),(ER==[] -> AER=empty ; ER=avl_set(AER)). |
| 4446 | | |
| 4447 | | |
| 4448 | | % similar to unless_large version, but will only expand if it is guaranteed to be small |
| 4449 | | |
| 4450 | | try_expand_and_convert_to_avl_if_smaller_than(freetype(GS),Res,_) :- !, Res = freetype(GS). |
| 4451 | | try_expand_and_convert_to_avl_if_smaller_than([H|T],Res,_) :- !, try_expand_and_convert_to_avl([H|T],Res). |
| 4452 | | try_expand_and_convert_to_avl_if_smaller_than(avl_set(A),Res,_) :- !, Res=avl_set(A). |
| 4453 | | try_expand_and_convert_to_avl_if_smaller_than(CS,Res,Limit) :- |
| 4454 | | (is_small_specific_custom_set(CS,Limit) |
| 4455 | | -> try_expand_and_convert_to_avl(CS,Res,try_expand_and_convert_to_avl_if_smaller_than,'') |
| 4456 | | ; Res = CS % TO DO: maybe look at cardinality of types and determine max. cardinality |
| 4457 | | ). |
| 4458 | | is_small_specific_custom_set(CS,Limit) :- card_for_specific_custom_set(CS,Card,Code), |
| 4459 | | call(Code), is_finite_card(Card), Card<Limit. |
| 4460 | | get_card_for_specific_custom_set(CS,Card) :- |
| 4461 | | card_for_specific_custom_set(CS,Card,Code), |
| 4462 | ? | call(Code), ground(Card). |
| 4463 | | |
| 4464 | | try_expand_and_convert_to_avl_unless_very_large_wf(CS,Res,WF) :- |
| 4465 | | try_expand_and_convert_to_avl_unless_large_wf(CS,Res,10000,WF). |
| 4466 | | |
| 4467 | | try_expand_and_convert_to_avl_unless_large_wf(CS,Res,WF) :- |
| 4468 | | try_expand_and_convert_to_avl_unless_large_wf(CS,Res,2000,WF). |
| 4469 | | |
| 4470 | | try_expand_and_convert_to_avl_unless_large_wf(CS,Res,_,_WF) :- var(CS), !, CS=Res. |
| 4471 | | try_expand_and_convert_to_avl_unless_large_wf(global_set(GS),Res,_,_WF) :- !, Res = global_set(GS). |
| 4472 | | try_expand_and_convert_to_avl_unless_large_wf(freetype(GS),Res,_,_WF) :- !, Res = freetype(GS). |
| 4473 | | %try_expand_and_convert_to_avl_unless_large_wf(CS,Res,_WF) :- is_interval_closure(CS,Low,Up),!, |
| 4474 | | % ((ground(Low),ground(Up),Size is 1+Up-Low, Size<2000) |
| 4475 | | %% -> try_expand_and_convert_to_avl(CS,Res) |
| 4476 | | % ; Res = CS |
| 4477 | | % ). |
| 4478 | | try_expand_and_convert_to_avl_unless_large_wf(closure(P,T,B),Res,Limit,_WF) :- |
| 4479 | | is_very_large_or_symbolic_closure(P,T,B,Limit),!, % is explicitly marked as SYMBOLIC |
| 4480 | | Res=closure(P,T,B). |
| 4481 | | try_expand_and_convert_to_avl_unless_large_wf(CS,Res,_Limit,WF) :- |
| 4482 | | % TO DO: check if maybe we cannot determine card explicitly, but have a large lower-bound |
| 4483 | | try_expand_and_convert_to_avl_wf(CS,Res,try_expand_and_convert_to_avl_unless_large,'',WF). |
| 4484 | | |
| 4485 | | |
| 4486 | | |
| 4487 | | % calls try_expand_and_convert_to_avl and returns original value if enumeration warning occured |
| 4488 | | try_expand_and_convert_to_avl_with_catch_wf(CS,Res,Origin,WF) :- |
| 4489 | | on_enumeration_warning(try_expand_and_convert_to_avl_wf(CS,Res,Origin,'',WF), |
| 4490 | | Res=CS). |
| 4491 | | |
| 4492 | | /* tries to generate an avl-structure, if possible */ |
| 4493 | | try_expand_and_convert_to_avl(CS,Res) :- |
| 4494 | | try_expand_and_convert_to_avl_wf(CS,Res,try_expand_and_convert_to_avl,'',no_wf_available). |
| 4495 | | |
| 4496 | | try_expand_and_convert_to_avl(CS,Res,Origin,Source) :- |
| 4497 | | try_expand_and_convert_to_avl_wf(CS,Res,Origin,Source,no_wf_available). |
| 4498 | | |
| 4499 | | try_expand_and_convert_to_avl_wf(CS,Res,_,_,_WF) :- var(CS), !, CS=Res. |
| 4500 | | try_expand_and_convert_to_avl_wf(avl_set(A),R,_,_,_WF) :- !, R=avl_set(A). |
| 4501 | | try_expand_and_convert_to_avl_wf([],R,_,_,_WF) :- !, R=[]. |
| 4502 | | try_expand_and_convert_to_avl_wf([H|T],R,_,_,WF) :- !, try_convert_to_avl_wf([H|T],R,WF). |
| 4503 | | try_expand_and_convert_to_avl_wf(closure(P,T,B),Res,Origin,_Source,WF) :- !, |
| 4504 | | debug_opt_push_wait_flag_call_stack_info(WF, |
| 4505 | | external_call('TRY EXPANDING',[closure(P,T,B)],unknown),WF2), |
| 4506 | | expand_only_custom_closure_global(closure(P,T,B),Expansion,check(Origin),WF2), |
| 4507 | | try_convert_to_avl_wf(Expansion,Res,WF). |
| 4508 | | try_expand_and_convert_to_avl_wf(CS,Res,Origin,_Source,WF) :- |
| 4509 | | (\+ is_custom_explicit_set(CS,try_expand_and_convert_to_avl_wf) |
| 4510 | | -> Expansion = CS |
| 4511 | | ; expand_only_custom_closure_global(CS,Expansion,check(Origin),WF) |
| 4512 | | ), |
| 4513 | | try_convert_to_avl_wf(Expansion,Res,WF). |
| 4514 | | |
| 4515 | | try_convert_to_avl(Expansion,Res) :- |
| 4516 | | (should_be_converted_to_avl_from_lists(Expansion) -> construct_avl_from_lists(Expansion,Res) ; Res=Expansion). |
| 4517 | | try_convert_to_avl_wf(Expansion,Res,WF) :- |
| 4518 | | (should_be_converted_to_avl_from_lists(Expansion) -> construct_avl_from_lists_wf(Expansion,Res,WF) ; Res=Expansion). |
| 4519 | | |
| 4520 | | should_be_converted_to_avl_from_lists(Value) :- var(Value),!,fail. |
| 4521 | | should_be_converted_to_avl_from_lists(Value) :- |
| 4522 | | \+ is_custom_explicit_set(Value,should_be_converted_to_avl_from_lists), % already avl_set, global_set or closure |
| 4523 | ? | \+ do_not_convert_aux(Value), |
| 4524 | | ground_value(Value). |
| 4525 | | |
| 4526 | | do_not_convert_aux(V) :- var(V),!. |
| 4527 | | do_not_convert_aux((A,B)) :- !, |
| 4528 | | (do_not_convert_aux(A) -> true ; do_not_convert_aux(B)). |
| 4529 | | do_not_convert_aux([H|T]) :- !, % do not convert a set containing a symbolic closure |
| 4530 | ? | (var(T) -> true ; do_not_convert_aux(H)). |
| 4531 | | do_not_convert_aux(rec(Fields)) :- !, |
| 4532 | | (var(Fields) -> true |
| 4533 | ? | ; member(field(_,V),Fields), do_not_convert_aux(V) -> true). |
| 4534 | | do_not_convert_aux(H) :- |
| 4535 | ? | is_symbolic_closure(H). |
| 4536 | | |
| 4537 | | should_be_converted_to_avl(Value) :- %preference(use_avl_trees_for_sets,true), |
| 4538 | | ground_value(Value). |
| 4539 | | |
| 4540 | | try_expand_and_convert_to_avl_with_check(CS,Res,Origin) :- |
| 4541 | | try_expand_and_convert_to_avl_with_check(CS,Res,do_not_keep_intervals,Origin). |
| 4542 | | |
| 4543 | | try_expand_and_convert_to_avl_with_check(CS,Res,_,_Origin) :- var(CS),!, Res = CS. |
| 4544 | | try_expand_and_convert_to_avl_with_check([],Res,_,_Origin) :- !, Res=[]. |
| 4545 | | try_expand_and_convert_to_avl_with_check(avl_set(A),Res,_,_Origin) :- !, Res=avl_set(A). |
| 4546 | | try_expand_and_convert_to_avl_with_check([H|T],Res,_,Origin) :- !, try_expand_and_convert_to_avl([H|T],Res,Origin,''). |
| 4547 | | %try_expand_and_convert_to_avl_with_check(CS,Res,_Origin) :- |
| 4548 | | % \+ is_custom_explicit_set(CS,try_expand_and_convert_to_avl),!, Res = CS. |
| 4549 | | try_expand_and_convert_to_avl_with_check(CS,Res,KeepIntervals,_Origin) :- |
| 4550 | | is_interval_closure(CS,Low,Up), |
| 4551 | | (var(Low) -> true ; var(Up) -> true % better keep this symbolic as we may be able to do constraint propagation |
| 4552 | | ; KeepIntervals=keep_intervals(Size) -> Up-Low >= Size |
| 4553 | | ), |
| 4554 | | !, % TO DO: see if we should do this check in try_expand_and_convert_to_avl above instead |
| 4555 | | Res=CS. |
| 4556 | | try_expand_and_convert_to_avl_with_check(CS,Res,_,Origin) :- |
| 4557 | ? | get_card_for_specific_custom_set(CS,Size), % TO DO: avoid checking for special closures twice (below in try_expand_and_convert_to_avl ?) |
| 4558 | | !, |
| 4559 | | try_expconv_to_avl_with_size(Size,CS,Res,Origin). |
| 4560 | | try_expand_and_convert_to_avl_with_check(CS,Res,_,Origin) :- |
| 4561 | | try_expand_and_convert_to_avl(CS,Res,Origin,''). |
| 4562 | | |
| 4563 | | try_expconv_to_avl_with_size(inf,CS,Res,Origin) :- !, |
| 4564 | | debug_format(9,'### Not expanding infinite set~n### ORIGIN: ~w~n',[Origin]), |
| 4565 | | Res=CS. |
| 4566 | | try_expconv_to_avl_with_size(inf_overflow,CS,Res,Origin) :- !, |
| 4567 | | debug_format(9,'### Not expanding very large set~n### ORIGIN: ~w~n',[Origin]), |
| 4568 | | Res=CS. |
| 4569 | | try_expconv_to_avl_with_size(Size,CS,Res,Origin) :- Size>=10000000, !, |
| 4570 | | /* will probably never terminate */ |
| 4571 | | debug_format(9,'### Not expanding very large set with cardinality ~w~n### ORIGIN: ~w~n',[Size,Origin]), |
| 4572 | | Res=CS. |
| 4573 | | try_expconv_to_avl_with_size(Size,CS,Res,Origin) :- Size>=50000, !, |
| 4574 | | print('### WARNING: expanding very large comprehension set, size = '), print(Size),nl, |
| 4575 | | print('### ORIGIN: '), print(Origin),nl, |
| 4576 | | try_expand_and_convert_to_avl(CS,Res,Origin,''). |
| 4577 | | try_expconv_to_avl_with_size(_Size,CS,Res,Origin) :- |
| 4578 | | try_expand_and_convert_to_avl(CS,Res,Origin,''). |
| 4579 | | |
| 4580 | | /* underlying assumption for var case: if G is a global set: we get back the |
| 4581 | | global_set tag immediately: no need to use when to wait; |
| 4582 | | better: ensure that b_compute_expression always returns a nonvar term */ |
| 4583 | | |
| 4584 | | |
| 4585 | | :- assert_must_succeed((custom_explicit_sets:try_expand_custom_set(closure([xx],[integer],b(falsity,pred,[])),R),R = [])). |
| 4586 | | :- assert_must_succeed((custom_explicit_sets:test_closure(X),custom_explicit_sets:expand_custom_set(X,EX), |
| 4587 | | EX = [(fd(1,'Name'),_),(fd(3,'Name'),_)])). |
| 4588 | | |
| 4589 | | test_closure(X) :- X = closure(['_zzzz_binary'],[couple(global('Name'),set(global('Name')))], |
| 4590 | | b(member(b(identifier('_zzzz_binary'),couple(global('Name'),set(global('Name'))),[generated]), |
| 4591 | | b(cartesian_product(b(value([fd(1,'Name'),fd(3,'Name')]),set(global('Name')),[]), |
| 4592 | | b(value([[fd(2,'Name'),fd(3,'Name')]]),set(set(global('Name'))),[])), |
| 4593 | | set(couple(global('Name'),set(global('Name')))),[])),pred,[])). |
| 4594 | | |
| 4595 | | |
| 4596 | | /* --------- */ |
| 4597 | | /* ELEMENT_OF */ |
| 4598 | | /* --------- */ |
| 4599 | | |
| 4600 | | |
| 4601 | | /* A function that instantiates last argument when membership test can be decided */ |
| 4602 | | |
| 4603 | | membership_custom_set(CS,X,R) :- print(warning_deprecated_non_wf_version(CS,X,R)),nl, |
| 4604 | | membership_custom_set_wf(CS,X,R,_WF). |
| 4605 | | |
| 4606 | | membership_custom_set_wf(avl_set(A),X,R,WF) :- !, membership_avl_set_wf(A,X,R,WF). |
| 4607 | | membership_custom_set_wf(freetype(_GS),_X,R,_WF) :- !, R=pred_true. % should be covered by clause above |
| 4608 | | membership_custom_set_wf(CS,X,R,WF) :- R==pred_true,!, element_of_custom_set_wf(X,CS,WF). |
| 4609 | | membership_custom_set_wf(CS,X,R,WF) :- R==pred_false,!, not_element_of_custom_set_wf(X,CS,WF). |
| 4610 | | membership_custom_set_wf(CS,_X,R,_WF) :- |
| 4611 | | is_definitely_maximal_set(CS),!, |
| 4612 | | R=pred_true. |
| 4613 | | membership_custom_set_wf(closure(Par,Types,Body),X,R,WF) :- !, |
| 4614 | | closure_membership_wf(X,Par,Types,Body,R,WF). |
| 4615 | | %membership_custom_set_wf(CS,X,R,WF) :- is_one_element_custom_set(CS,Y),!, % only succeeds for AVL |
| 4616 | | % kernel_equality:equality_objects_wf_no_enumr(X,Y,R,WF). |
| 4617 | | membership_custom_set_wf(global_set(GS),X,R,WF) :- !, |
| 4618 | | membership_global_set(GS,X,R,WF). |
| 4619 | | membership_custom_set_wf(CS,X,R,WF) :- |
| 4620 | | add_internal_error('Illegal custom set: ',membership_custom_set_wf(CS,X,R,WF)),fail. |
| 4621 | | |
| 4622 | | membership_avl_set_wf(A,X,R,WF) :- R==pred_true,!, element_of_avl_set_wf(A,X,WF). |
| 4623 | | membership_avl_set_wf(A,X,R,WF) :- R==pred_false,!, not_element_of_custom_set_wf(X,avl_set(A),WF). |
| 4624 | | membership_avl_set_wf(A,X,R,WF) :- is_one_element_avl(A,Y),!, |
| 4625 | | kernel_equality:equality_objects_wf_no_enum(X,Y,R,WF). |
| 4626 | | membership_avl_set_wf(A,_X,R,_WF) :- |
| 4627 | | quick_definitely_maximal_set_avl(A),!, |
| 4628 | | R=pred_true. |
| 4629 | | membership_avl_set_wf(A,X,R,WF) :- reify_avl_membership(A,X,R,FullReification), |
| 4630 | | (FullReification==true |
| 4631 | | -> true %print_term_summary(full_reification(A,X,R)),nl,nl %% did slow down e.g. Bosch Deadlock v9, seems no longer the case |
| 4632 | | ; when((ground(X);nonvar(R)),membership_avl_set_wf2(A,X,R,WF))). |
| 4633 | | |
| 4634 | ? | membership_avl_set_wf2(A,X,R,WF) :- R==pred_true,!, element_of_avl_set_wf(A,X,WF). |
| 4635 | | membership_avl_set_wf2(A,X,R,WF) :- R==pred_false,!, not_element_of_custom_set_wf(X,avl_set(A),WF). |
| 4636 | | membership_avl_set_wf2(AVL,X,R,_WF) :- |
| 4637 | | ground_element_can_be_added_or_removed_to_avl(X), !, |
| 4638 | | (safe_avl_member(X,AVL) %safe_avl_member_ground(X,AVL) |
| 4639 | | -> R=pred_true ; R=pred_false). |
| 4640 | | membership_avl_set_wf2(AVL,X,Res,WF) :- % X is ground but cannot be added |
| 4641 | | (Res \== pred_false, element_of_avl_set_wf(AVL,X,WF), Res=pred_true |
| 4642 | | ; |
| 4643 | | Res \== pred_true, not_element_of_custom_set_wf(X,avl_set(AVL),WF), Res=pred_false). |
| 4644 | | |
| 4645 | | membership_global_set(GS,_X,R,_WF) :- is_maximal_global_set(GS),!, |
| 4646 | | R=pred_true. |
| 4647 | | membership_global_set(GS,X,R,WF) :- ground(X),!, |
| 4648 | | (element_of_global_set_wf(X,GS,WF) -> R=pred_true ; R=pred_false). |
| 4649 | | membership_global_set(GS,X,R,_WF) :- get_integer_set_interval(GS,Low,Up),!, |
| 4650 | | membership_interval(X,Low,Up,R). |
| 4651 | | membership_global_set(GS,X,R,WF) :- % this case should probably never apply |
| 4652 | | (GS=='FLOAT' -> true % currently it actually is also treated like REAL |
| 4653 | | ; print(uncovered_membership(GS,X,R,WF)),nl), |
| 4654 | | when(ground(X), (element_of_global_set_wf(X,GS,WF) -> R=pred_true ; R=pred_false)). |
| 4655 | | |
| 4656 | | membership_interval(X,Low,Up,Res) :- nonvar(Up),Up=inf,!,X=int(IX), |
| 4657 | | b_interpreter_check:check_arithmetic_operator('<=',Low,IX,Res). |
| 4658 | | membership_interval(X,Low,Up,Res) :- kernel_equality:in_nat_range_test(X,int(Low),int(Up),Res). |
| 4659 | | |
| 4660 | | :- use_module(bool_pred). |
| 4661 | | closure_membership_wf(X,[ZZZZ],[integer],CondClosure,Res,_WF) :- |
| 4662 | ? | is_interval_closure_body(CondClosure,ZZZZ,LOW,UP),!, |
| 4663 | | kernel_equality:in_nat_range_test(X,int(LOW),int(UP),Res). |
| 4664 | | % TO DO: deal with open intervals 0..inf ... |
| 4665 | | closure_membership_wf(X,Par,Types,Body,Res,WF) :- |
| 4666 | | is_member_closure(Par,Types,Body,_Type,VAL), |
| 4667 | | (VAL=value(_) ; VAL = cartesian_product(b(value(A),_,_),b(value(B),_,_))),!, |
| 4668 | | (VAL=value(Set) |
| 4669 | | -> kernel_objects:membership_test_wf(Set,X,Res,WF) |
| 4670 | | ; kernel_equality:cartesian_pair_test_wf(X,A,B,Res,WF)). |
| 4671 | | closure_membership_wf(X,Par,Typ,Body,Res,WF) :- |
| 4672 | | is_not_member_closure(Par,Typ,Body,_Type,value(Set)),!, |
| 4673 | | bool_pred:negate(ResXSet,Res), % was kernel_equality:inv_mem_obj(ResXSet,Res), |
| 4674 | | kernel_objects:membership_test_wf(Set,X,ResXSet,WF). |
| 4675 | | % TO DO: if closure = POW closure -> translate into subset_test pow_subset |
| 4676 | | % TO DO: support a few other closures related to symbolic unary/binary operators: closure1, POW(..), ... ? |
| 4677 | | % TO DO: expand if set is small |
| 4678 | | closure_membership_wf(X,Par,Types,Body,Res,WF) :- ground_value(X),!, |
| 4679 | | closure_membership_ground_wf(X,closure(Par,Types,Body),Res,WF). |
| 4680 | | closure_membership_wf(X,Par,Types,Body,Res,WF) :- |
| 4681 | | CS = closure(Par,Types,Body), |
| 4682 | | is_small_specific_custom_set(CS,100), |
| 4683 | | try_expand_and_convert_to_avl_wf(CS,Expanded,closure_membership_wf,'',WF), |
| 4684 | | nonvar(Expanded), Expanded=avl_set(_), |
| 4685 | | !, |
| 4686 | | membership_custom_set_wf(Expanded,X,Res,WF). |
| 4687 | | closure_membership_wf(X,Par,Types,Body,Res,WF) :- |
| 4688 | | Body \= b(member(_,_),_,_), % otherwise we may have an infinite loop; b_check_boolean_expression will generate a closure which will call closure_membership_wf again; TO DO: refine to allow certain memberships to go through |
| 4689 | | get_texpr_info(Body,BodyInfo), |
| 4690 | | \+ member(prob_annotation(recursive(_RID)),BodyInfo), % otherwise we can get errors as recursive identifier _RID needs to be added to local state ! (test 1151 fails otherwise) |
| 4691 | | % TO DO: add recursive parameter below in set_up_typed_localstate2; + in which other circumstances do we need to set up recursion identifier ! |
| 4692 | | % Try reifiyng the body |
| 4693 | | NegationContext=positive, |
| 4694 | | copy_wf_start(WF,closure_membership_wf,CWF), |
| 4695 | | b_interpreter:set_up_typed_localstate2(Par,Types,BodyInfo,ParValues,TypedVals,[],State,NegationContext), |
| 4696 | | %couplise_list(Types,XType), |
| 4697 | | convert_list_into_pairs(ParValues,SingleParValue), |
| 4698 | | kernel_objects:equal_object(X,SingleParValue,closure_membership_wf), |
| 4699 | | b_interpreter_check:b_check_boolean_expression(Body,[],State,CWF,PredRes), |
| 4700 | | !, |
| 4701 | | (debug_mode(on) -> print('REIFICATION of closure: '), translate:print_bexpr(Body),nl, print(pred_res(X,PredRes)),nl ; true), |
| 4702 | | b_enumerate:b_tighter_enumerate_all_values(TypedVals,WF), % not necessary ?? as X should get enumerated |
| 4703 | | Res=PredRes, |
| 4704 | | copy_wf_finish(WF,CWF). |
| 4705 | | closure_membership_wf(X,Par,Types,Body,Res,WF) :- |
| 4706 | | when( (ground(X);nonvar(Res)), %% |
| 4707 | | % used to be ground(X), % with (ground(X);nonvar(Res)), test 292 failed {x,t|t : BOOL & (x : POW(1024 .. 1025) & bool(x : POW(NATURAL1)) = t)} = {{} |-> TRUE,{1024} |-> TRUE,{1024,1025} |-> TRUE,{1025} |-> TRUE} and test 1088 failed |
| 4708 | | closure_membership_ground_wf(X,closure(Par,Types,Body),Res,WF)). |
| 4709 | | |
| 4710 | | closure_membership_ground_wf(X,CS,Res,WF) :- nonvar(Res),!, |
| 4711 | | % this optimization is checked in test 1452 |
| 4712 | | (Res==pred_true -> element_of_custom_set_wf(X,CS,WF) ; not_element_of_custom_set_wf(X,CS,WF)). |
| 4713 | | closure_membership_ground_wf(X,CS,Res,WF) :- |
| 4714 | | % to ensure that we leave no choice point behind we have to force full evaluation of element/not_element calls: |
| 4715 | | % hence we do not call element_of_custom_set_wf or not_element_of_custom_set_wf below !! |
| 4716 | | kernel_waitflags:get_idle_wait_flag(closure_membership_ground_wf,WF,LWF), % enable other triggered co-routines to fire first; some maybe much more efficient to deal with than closure expansion; |
| 4717 | | % used to be important for test 1146, but this is no longer the case |
| 4718 | | %term_variables(CS,Vars),print(closure_membership_ground_wf_aux(LWF,vars(Vars),CS)),nl, |
| 4719 | | ground_value_check(CS,CSGr), |
| 4720 | | %when((nonvar(LWF),(nonvar(CSGr);nonvar(Res))),closure_membership_ground_wf_aux(X,CS,Res)). |
| 4721 | | block_closure_membership_ground_wf_aux(X,CS,Res,CSGr,LWF,WF). % Note: wrong block in commit 332cb17487017d819e9140427b1017a3045b3685 caused problem for test 1162 |
| 4722 | | |
| 4723 | | :- block block_closure_membership_ground_wf_aux(?,?,?,?,-,?), |
| 4724 | | block_closure_membership_ground_wf_aux(?,?,-,-,?,?). |
| 4725 | | block_closure_membership_ground_wf_aux(X,CS,Res, _,_,WF) :- |
| 4726 | ? | closure_membership_ground_wf_aux(X,CS,Res,WF). |
| 4727 | | |
| 4728 | | % X & CS are ground or Res is known |
| 4729 | | closure_membership_ground_wf_aux(X,CS,Res,WF) :- Res==pred_true,!, |
| 4730 | | element_of_custom_set_wf(X,CS,WF). |
| 4731 | | closure_membership_ground_wf_aux(X,CS,Res,WF) :- Res==pred_false,!, |
| 4732 | ? | not_element_of_custom_set_wf(X,CS,WF). |
| 4733 | | closure_membership_ground_wf_aux(X,CS,Res,_WF) :- |
| 4734 | | % we know that X is a ground value and CS is ground: we can determine completely whether X is element of CS or not |
| 4735 | | if(element_of_custom_set(X,CS),Res=pred_true, Res=pred_false). |
| 4736 | | /* used to be: (Res \== pred_false, element_of_custom_set(X,CS), Res=pred_true |
| 4737 | | ; Res \== pred_true, not_element_of_custom_set(X,CS), Res=pred_false)). |
| 4738 | | */ |
| 4739 | | |
| 4740 | | |
| 4741 | | |
| 4742 | | :- use_module(kernel_objects,[element_of_global_set/2,element_of_global_set_wf/3]). |
| 4743 | | element_of_custom_set_wf(X,CS,WF) :- |
| 4744 | ? | element_of_custom_set_wf2(CS,X,WF). %, print(check_ok(X)),nl. |
| 4745 | | |
| 4746 | | element_of_custom_set_wf2(node(A,B,C,D,E),X,WF) :- |
| 4747 | | add_internal_error('Unwrapped avl_set: ',element_of_custom_set_wf2(node(A,B,C,D,E),X,WF)),fail. |
| 4748 | | element_of_custom_set_wf2(global_set(GS),X,WF) :- element_of_global_set_wf(X,GS,WF). |
| 4749 | | element_of_custom_set_wf2(freetype(ID),X,WF) :- |
| 4750 | | (is_maximal_freetype(ID) -> true |
| 4751 | | ; add_internal_error('Uncovered case: ',element_of_custom_set_wf2(freetype(ID),X,WF)) |
| 4752 | | ). % we assume freetypes to be maximal ! |
| 4753 | ? | element_of_custom_set_wf2(avl_set(AVL),X,WF) :- element_of_avl_set_wf(AVL,X,WF). |
| 4754 | | element_of_custom_set_wf2(closure(Parameters,PT,Cond),X,WF) :- |
| 4755 | ? | element_of_closure(X,Parameters,PT,Cond,WF). |
| 4756 | | |
| 4757 | | element_of_avl_set_wf(node(Y,_,_,empty,empty),X,WF) :- !, |
| 4758 | ? | kernel_objects:equal_object_wf(X,Y,element_of_custom_set_wf2,WF). |
| 4759 | | element_of_avl_set_wf(AVL,X,_WF) :- ground_value(X),!, safe_avl_member(X,AVL). %safe_avl_member_ground(X,AVL). |
| 4760 | | element_of_avl_set_wf(AVL,X,WF) :- |
| 4761 | | avl_approximate_size(AVL,10,ApproxSize), |
| 4762 | ? | element_of_avl_set_wf(AVL,ApproxSize,X,WF). |
| 4763 | | |
| 4764 | | :- use_module(clpfd_tables). |
| 4765 | | |
| 4766 | | element_of_avl_set_wf(AVL,ApproxSize,X,WF) :- |
| 4767 | | % first check if worthwhile to attempt table treatment |
| 4768 | | % after fixing table/2 bug runtimes have slowed down and test 1753 became much slower |
| 4769 | | % for test 1753 a threshold of < 63 would be ideal; but test 1716 requires size 91 |
| 4770 | | % TODO: re-evaluate when SICStus 4.8 available |
| 4771 | | preferences:preference(use_clpfd_solver,true), |
| 4772 | | preferences:preference(solver_strength,SS), |
| 4773 | | ApproxSize < 100+SS, |
| 4774 | | (var(X) -> true |
| 4775 | | ; X = (X1,_X2) -> (ground_value(X1) -> ApproxSize < 10+SS ; true) |
| 4776 | | ; X=rec(_) -> true |
| 4777 | | %; X=int(_) -> true ; X=fd(_,_) -> true % for scalar values we already use in_fd_value_list_wf via avl_fd_value_check |
| 4778 | | ), |
| 4779 | | can_translate_avl_to_table(AVL,SkeletonType), |
| 4780 | | !, |
| 4781 | ? | check_element_of_avl_with_table(X,SkeletonType,AVL,WF). |
| 4782 | | element_of_avl_set_wf(AVL,ApproxSize,X,WF) :- |
| 4783 | ? | propagate_avl_element_information(X,AVL,ApproxSize,WF), %translate:translate_bvalue(avl_set(AVL),SS), |
| 4784 | | get_bounded_wait_flag(ApproxSize,element_of_avl(X),WF,WF1), |
| 4785 | | element_of_avl_set_wf3(X,AVL,ApproxSize,WF1,WF). |
| 4786 | | |
| 4787 | | |
| 4788 | | % compute an approximate size (small sets are computed exactly) |
| 4789 | | avl_approximate_size(AVL,Size) :- avl_approximate_size(AVL,10,Size). |
| 4790 | | |
| 4791 | | avl_approximate_size(AVL,HeightBound,Size) :- var(AVL),!, |
| 4792 | | add_internal_error('AVL Set is variable: ', avl_approximate_size(AVL,HeightBound,Size)), |
| 4793 | | Size=1000000. |
| 4794 | | avl_approximate_size(AVL,HeightBound,Size) :- % when the AVL gets too large; not so important that we have a precise estimation anyway |
| 4795 | | % so: save some time and just compute height |
| 4796 | | avl_height(AVL,Height), |
| 4797 | | (Height>HeightBound |
| 4798 | | -> Size is floor(2**Height-1) |
| 4799 | | ; avl_size(AVL,Size)). |
| 4800 | | |
| 4801 | | :- block element_of_avl_set_wf3(-,?,?,-,?). |
| 4802 | ? | element_of_avl_set_wf3(X,AVL,_ApproxSize,_WF1,_WF) :- var(X), !, safe_avl_member(X,AVL). |
| 4803 | | % TO DO: if randomise_enumeration_order is true then choose elements in random order |
| 4804 | | :- if(environ(prob_data_validation_mode,xxxtrue)). % currently disabled due to bug related to 14082013/435_002.mch TO DO: investigate |
| 4805 | | element_of_avl_set_wf3((X,Y),AVL,ApproxSize,WF1,WF) :- !, |
| 4806 | | %% ((var(WF1), \+ ground(X)) -> print(avl_relation_check(X,Y)),nl, %% |
| 4807 | | %% copy_term((X,Y),Copy), findall(Copy,safe_avl_member(Copy,AVL),Cs), print(Cs),nl, Cs \=[] %% check that at least one element exists |
| 4808 | | %% ; true), |
| 4809 | | couple_element_of_avl_set_wf(X,Y,AVL,ApproxSize,WF1,WF). |
| 4810 | | :- else. |
| 4811 | | element_of_avl_set_wf3((X,Y),AVL,ApproxSize,WF1,WF) :- !, |
| 4812 | | ground_value_check(X,GrX), |
| 4813 | | block_couple_element_of_avl_set_grX_wf1(X,Y,AVL,ApproxSize,GrX,WF1,WF). |
| 4814 | | %when((nonvar(WF1) ; ground(X)), couple_element_of_avl_set(X,Y,AVL,GrX,WF1,WF)). |
| 4815 | | :- endif. |
| 4816 | | element_of_avl_set_wf3(X,AVL,_ApproxSize,WF1,_WF) :- |
| 4817 | | ground_value_check(X,GrX), |
| 4818 | | safe_avl_member_block(X,AVL,GrX,WF1). |
| 4819 | | |
| 4820 | | :- block safe_avl_member_block(?,?,-,-). |
| 4821 | | safe_avl_member_block(X,AVL,_,_) :- |
| 4822 | ? | safe_avl_member(X,AVL). |
| 4823 | | |
| 4824 | | :- if(environ(prob_data_validation_mode,true)). |
| 4825 | | :- public couple_element_of_avl_set_wf/6. % used in conditional if above |
| 4826 | | :- block couple_element_of_avl_set_wf(-,?,?,?,-,?). |
| 4827 | | couple_element_of_avl_set_wf(X,Y,AVL,ApproxSize,WF1,WF) :- |
| 4828 | | ground_value_check(X,GrX), |
| 4829 | | ((nonvar(WF1);nonvar(GrX)) -> couple_element_of_avl_set(X,Y,AVL,GrX,WF1,WF) |
| 4830 | | %; true -> when((nonvar(WF1) ; ground(X)), couple_element_of_avl_set(X,Y,AVL,WF1,WF)) |
| 4831 | | ; nonvar(X),X=(X1,X2),ground(X1) -> triple_element_of_avl_set(X1,X2,Y,AVL,WF) |
| 4832 | | ; nonvar(X),X=(X1,X2) -> |
| 4833 | | avl_member_blocking((X,Y),AVL), |
| 4834 | | (ground(Y),ground(X1) -> safe_avl_member_pair_wf(X,Y,AVL,WF) |
| 4835 | | ; when(ground(X1),(\+ ground(X2) -> triple_element_of_avl_set(X1,X2,Y,AVL,WF) ; true % avl_member_blocking will have done its work |
| 4836 | | )), |
| 4837 | | block_couple_element_of_avl_set(X,Y,AVL,WF1,WF) |
| 4838 | | ) |
| 4839 | | ; %when((nonvar(WF1) ; ground(X)), couple_element_of_avl_set(X,Y,AVL,WF1,WF)) |
| 4840 | | block_couple_element_of_avl_set_grX_wf1(X,Y,AVL,ApproxSize,GrX,WF1,WF) |
| 4841 | | /* ; (simple_avl_type(AVL) |
| 4842 | | -> avl_member_blocking((X,Y),AVL) % TO DO: don't call couple_element_of_avl_set ! avoid double traversal !! |
| 4843 | | ; true), |
| 4844 | | block_couple_element_of_avl_set_grX_wf1(X,Y,AVL,GrX,WF1,WF) */ |
| 4845 | | ). |
| 4846 | | |
| 4847 | | :- block block_couple_element_of_avl_set(?,?,?,-,?). |
| 4848 | | block_couple_element_of_avl_set(X,Y,_AVL,_WF1,_WF) :- ground(X),ground(Y),!. |
| 4849 | | block_couple_element_of_avl_set(X,Y,AVL,_WF1,WF) :- safe_avl_member_pair_wf(X,Y,AVL,WF). |
| 4850 | | |
| 4851 | | triple_element_of_avl_set(X1,X2,Y,AVLRelation,WF) :- % X1 must be ground |
| 4852 | | copy_term((X2,Y),(CX2,CY)), |
| 4853 | | findall((CX2,CY),safe_avl_member_pair((X1,CX2),CY,AVLRelation),Images), |
| 4854 | | % we pass no WF to safe_avl_member_pair; we need to fully evaluate all unifications due to findall |
| 4855 | | Images \= [], |
| 4856 | | construct_avl_from_lists_wf(Images,AVL,WF), |
| 4857 | | element_of_custom_set_wf2(AVL,(X2,Y),WF). % will set up waitflag if necessary |
| 4858 | | :- endif. |
| 4859 | | |
| 4860 | | % --------------------------------------------------- |
| 4861 | | |
| 4862 | | test_avl_set(node(((int(2),int(3)),int(6)),true,0,node(((int(1),int(2)),int(2)),true,0,empty,empty),node(((int(3),int(4)),int(12)),true,0,empty,empty))). |
| 4863 | | |
| 4864 | | %simple_avl_type(node(K,_,_,_,_)) :- simple_value(K). % we can index directly on AVL, without having to normalise inner values |
| 4865 | | % in particular, we can apply avl_member_blocking |
| 4866 | | |
| 4867 | | :- assert_must_succeed(( custom_explicit_sets:test_avl_set(A), custom_explicit_sets:avl_member_blocking(((X,Y),Z),A), X=int(2), Y==int(3),Z==int(6) )). |
| 4868 | | :- assert_must_succeed(( custom_explicit_sets:test_avl_set(A), custom_explicit_sets:avl_member_blocking(((X,Y),Z),A), X=int(3), Y==int(4),Z==int(12) )). |
| 4869 | | :- assert_must_succeed(( custom_explicit_sets:test_avl_set(A), custom_explicit_sets:avl_member_blocking(((X,Y),Z),A), X=int(1), Y==int(2),Z==int(2) )). |
| 4870 | | :- assert_must_fail(( custom_explicit_sets:test_avl_set(A), custom_explicit_sets:avl_member_blocking(((X,_Y),_Z),A), X=int(5) )). |
| 4871 | | % a blocking version of avl_member; will not instantiate the element; just prune |
| 4872 | | |
| 4873 | | avl_member_blocking(Key, AVL) :- AVL=node(K,_,_,L,R), |
| 4874 | | %avl_height(AVL,Height), |
| 4875 | | avl_member_blocking4(Key,K,L,R). |
| 4876 | | |
| 4877 | | avl_member_blocking4(Key,Kavl,L,R) :- L=empty,R=empty,!, |
| 4878 | | Key=Kavl. % we could do equal_object |
| 4879 | | avl_member_blocking4(Key,Kavl,L,R) :- |
| 4880 | | match_possible(Key,Kavl,MatchPossible), % check if in principle a match could occur |
| 4881 | | (Kavl=(_,_) -> |
| 4882 | | (avl_min(R,Knext) -> true ; dif(O,>), Knext=no_match, |
| 4883 | | force_comp(MatchPossible,O,'<')), |
| 4884 | | (avl_max(L,Kprev) -> true ; dif(O,<), Kprev=no_match, |
| 4885 | | force_comp(MatchPossible,O,'>')) |
| 4886 | | ; Knext = no_match, Kprev = no_match |
| 4887 | | ), |
| 4888 | | (nonvar(O) -> true |
| 4889 | | /* ; (MatchPossible==pred_false, avl_height(L,Height), Height < 8, |
| 4890 | | copy_term(Key,CKey), \+ safe_avl_member(CKey,L), \+ safe_avl_member(CKey,R)) |
| 4891 | | -> print(cannot_match(Key)),nl,fail */ |
| 4892 | | ; compare_blocking(O, Key, Kavl, Kprev,Knext)), |
| 4893 | | avl_member_blocking_aux(O, Key, Kavl, L, R). |
| 4894 | | |
| 4895 | | %force_comp(V,_,_) :- var(V),!. |
| 4896 | | :- block force_comp(-,?,?). |
| 4897 | | force_comp(pred_true,_,_). |
| 4898 | | force_comp(pred_false,R,R). |
| 4899 | | |
| 4900 | | :- block avl_member_blocking_aux(-,?,?,?,?). |
| 4901 | | avl_member_blocking_aux(<, Key, _K, AVL, _) :- avl_member_blocking(Key, AVL). |
| 4902 | | avl_member_blocking_aux(=, Key, Key, _L, _R). % we could use equal_object |
| 4903 | | avl_member_blocking_aux(>, Key, _K, _, AVL) :- avl_member_blocking(Key, AVL). |
| 4904 | | |
| 4905 | | % a blocking version of compare |
| 4906 | | compare_blocking(Res,A,Kavl, Kprev, Knext) :- block_compare(A,Kavl,Res, Kprev, Knext). |
| 4907 | | |
| 4908 | | :- block block_compare(-,?,?,?,?), block_compare(?,-,?,?,?). |
| 4909 | | block_compare((A,B),Kavl,Res, Kprev, Knext) :- !, |
| 4910 | | (Kavl=(RA,RB) -> |
| 4911 | | match_key(Kprev,RA,PA,PB), |
| 4912 | | match_key(Knext,RA,NA,NB), |
| 4913 | | block_compare(A,RA,ACRes,PA,NA), |
| 4914 | | block_compare_aux(ACRes,B,RB,Res,PB,NB) |
| 4915 | | ; add_internal_error('Illegal type: ',block_compare((A,B),Kavl,Res, Kprev, Knext)),fail). |
| 4916 | | % TO DO: same for records; but currently not used anyway |
| 4917 | | block_compare(int(A),int(B),Res,_,_) :- !, block_compare_atomic(A,B,Res). |
| 4918 | | block_compare(pred_false,B,Res,_,_) :- !, block_compare_atomic(pred_false,B,Res). |
| 4919 | | block_compare(pred_true,B,Res,_,_) :- !, block_compare_atomic(pred_true,B,Res). |
| 4920 | | block_compare(string(A),string(B),Res,_,_) :- !, block_compare_atomic(A,B,Res). |
| 4921 | | block_compare(fd(A,T),fd(B,T),Res,_,_) :- !, block_compare_atomic(A,B,Res). |
| 4922 | | block_compare(avl_set(A),Kavl,Res,_,_) :- !, |
| 4923 | | convert_to_avl_inside_set(avl_set(A),ConvertedA),compare(Res,ConvertedA,Kavl). |
| 4924 | | block_compare([],[],Res,_,_) :- !, Res = '='. |
| 4925 | | block_compare([],_,Res,_,_) :- !, Res = '<'. |
| 4926 | | block_compare(A,Kavl,Res,_,_) :- |
| 4927 | | % does deal with various representations of sets !! closure/global_set/... |
| 4928 | | when(ground(A), |
| 4929 | | (convert_to_avl_inside_set(A,ConvertedA),compare(Res,ConvertedA,Kavl))). |
| 4930 | | |
| 4931 | | match_key((KeyA,KeyB),Key,ResA,ResB) :- !, ResA=KeyA, |
| 4932 | | (Key==KeyA -> ResB=KeyB ; ResB = no_match). |
| 4933 | | match_key(_,_,no_match,no_match). |
| 4934 | | |
| 4935 | | :- block block_compare_atomic(-,?,?), block_compare_atomic(?,-,?). |
| 4936 | | block_compare_atomic(A,B,Res) :- compare(Res,A,B). |
| 4937 | | |
| 4938 | | :- block block_compare_aux(-,?,?,?, ?,?). |
| 4939 | | block_compare_aux(ACRes,B,D,Res, Kprev,Knext) :- |
| 4940 | | (ACRes='<' -> Res = '<' |
| 4941 | | ; ACRes = '>' -> Res = '>' |
| 4942 | | ; Kprev=no_match, Knext=no_match -> |
| 4943 | | Res = '=' % we cannot match neither previous nor next key: force match |
| 4944 | | ; block_compare(B,D,Res,Kprev,Knext)). % TO DO: check with prev & next value: if no match possible force Res='=' |
| 4945 | | |
| 4946 | | % check if a match is possible between two terms |
| 4947 | | :- block match_possible(-,?,?), match_possible(?,-,?). |
| 4948 | | match_possible([],[],Possible) :- !, Possible=pred_true. |
| 4949 | | match_possible([],avl_set(_),Possible) :- !, Possible=pred_false. |
| 4950 | | match_possible(avl_set(_),[],Possible) :- !, Possible=pred_false. |
| 4951 | | match_possible(int(A),int(B),Possible) :- !, match_possible_atomic(A,B,Possible). |
| 4952 | | match_possible(fd(A,T),fd(B,T),Possible) :- !, match_possible_atomic(A,B,Possible). |
| 4953 | | match_possible(string(A),string(B),Possible) :- !, match_possible_atomic(A,B,Possible). |
| 4954 | | match_possible((A1,A2),(B1,B2),Possible) :- !, match_possible(A1,B1,P1), |
| 4955 | | match_possible(A2,B2,P2), kernel_equality:conjoin_test(P1,P2,Possible,_WF). %% WF <--- TO DO |
| 4956 | | match_possible(_,_,pred_true). |
| 4957 | | |
| 4958 | | :- block match_possible_atomic(-,?,?), match_possible_atomic(?,-,?). |
| 4959 | | match_possible_atomic(A,B,Res) :- (A==B -> Res=pred_true ; Res=pred_false). |
| 4960 | | |
| 4961 | | % -------------------------------------------- |
| 4962 | | |
| 4963 | | :- block block_couple_element_of_avl_set_grX_wf1(?, - ,?,?,-,-,?). |
| 4964 | | block_couple_element_of_avl_set_grX_wf1(X,Y,AVL,ApproxSize,GrX,WF1,WF) :- |
| 4965 | | var(GrX), var(WF1), |
| 4966 | | !, |
| 4967 | | % we know the result Y but not yet fully the input value X |
| 4968 | | (ApproxSize < 129 % TO DO: improve this; unify with inverse_apply_ok(Y,X,AVL,ApproxSize) ? |
| 4969 | | -> ground_value_check(Y,GrY) % wait until Y is fully known |
| 4970 | | ; (preference(solver_strength,SS), ApproxSize < 129+SS) |
| 4971 | | -> ground_value_check(Y,GrY) |
| 4972 | | % TO DO: we could look at avl_min and avl_max and estimate spread of range keys |
| 4973 | | ; cond_perfmessage([data_validation_mode/false],no_inverse_avl_lookup(ApproxSize,Y)) % do not bind GrY; we wait until GrX or WF1 is bound |
| 4974 | | ), |
| 4975 | | block_couple_element_of_avl_set_grX_grY_wf1(X,Y,AVL,ApproxSize,GrX,GrY,WF1,WF). |
| 4976 | | block_couple_element_of_avl_set_grX_wf1(X,Y,AVL,_ApproxSize,GrX,WF1,WF) :- |
| 4977 | ? | couple_element_of_avl_set(X,Y,AVL,GrX,WF1,WF). |
| 4978 | | |
| 4979 | | :- block block_couple_element_of_avl_set_grX_grY_wf1(?,?,?,?, -,-,-,?). |
| 4980 | | block_couple_element_of_avl_set_grX_grY_wf1(X,Y,AVL,_ApproxSize, GrX,_GrY,WF1,WF) :- |
| 4981 | | var(GrX), var(WF1), % i.e., Y is known |
| 4982 | | % we know the result Y but not yet fully the input value X |
| 4983 | | %inverse_apply_ok(Y,X,AVL,ApproxSize), |
| 4984 | | !, |
| 4985 | | inverse_get_possible_values(X,Y,AVL,Res), |
| 4986 | | Res = avl_set(InvAVL), |
| 4987 | | element_of_avl_set_wf(InvAVL,X,WF). |
| 4988 | | %couple_element_of_avl_set(X,Y,AVL,GrX,1,WF). |
| 4989 | | block_couple_element_of_avl_set_grX_grY_wf1(X,Y,AVL,_ApproxSize,GrX,_GrY,WF1,WF) :- |
| 4990 | ? | couple_element_of_avl_set(X,Y,AVL,GrX,WF1,WF). |
| 4991 | | |
| 4992 | | |
| 4993 | | % special treatment for relations: if the first component is known: then we can check how many images there are |
| 4994 | | couple_element_of_avl_set(X,Y,AVL,GrX,WF1,WF) :- |
| 4995 | | nonvar(WF1), var(GrX), %\+ground(X), |
| 4996 | | !, |
| 4997 | ? | safe_avl_member_default_wf((X,Y),AVL,WF). |
| 4998 | | couple_element_of_avl_set(X,Y,AVLRelation,_GrX,_,WF) :- % X must be ground |
| 4999 | | get_template(Y,TY,_ToUnifyAfter), % was copy_term(Y,CY) but could cause issues with closures with variables |
| 5000 | | copy_term(TY,CY), % avoid that we instantiate Y and trigger co-routines |
| 5001 | | findall(CY,avl_member_pair_arg1_ground(X,CY,AVLRelation),Images), % should we use Y instead of CY |
| 5002 | | Images \= [], |
| 5003 | | construct_avl_from_lists_wf(Images,AVL,WF), |
| 5004 | | element_of_custom_set_wf2(AVL,Y,WF). % will set up waitflag if necessary |
| 5005 | | |
| 5006 | | |
| 5007 | | % set Res -> pred_true or pred_false if membership can be decided early |
| 5008 | | % interval closures already dealt with by closure_membership |
| 5009 | | % maximal sets are also already dealt with by membership_custom_set |
| 5010 | | reify_avl_membership(AVL,Element,Res,FullReification) :- |
| 5011 | | is_avl_simple_set(AVL,Type), |
| 5012 | | preferences:preference(use_clpfd_solver,true), % to do: require maybe only for integer type !? |
| 5013 | | \+ ground_value(Element), |
| 5014 | | !, |
| 5015 | | reify_avl_mem2(Type,Element,AVL,Res,FullReification). |
| 5016 | | reify_avl_membership(_,_,_,false). |
| 5017 | | |
| 5018 | | |
| 5019 | | is_avl_simple_set(node(El,_True,_,_,_),Type) :- simple_type(El,Type). |
| 5020 | | simple_type(int(_),integer). |
| 5021 | | simple_type(fd(_,GS),global(GS)). |
| 5022 | | |
| 5023 | | |
| 5024 | | reify_avl_mem2(integer,int(El),AVL,Res,FullReification) :- |
| 5025 | | avl_min(AVL,int(Min)), avl_max(AVL,int(Max)), |
| 5026 | | (reify_integer_avl_mem(AVL,Min,Max) % reify if AVL small enough |
| 5027 | | -> avl_domain(AVL,R),project_avl_domain_on_fd(R,FDList), |
| 5028 | | clpfd_reify_inlist(El,FDList,FDRes,Posted), |
| 5029 | | propagate_fd_membership(FDRes,Res,inlist(El,FDList)), |
| 5030 | | FullReification=Posted |
| 5031 | | ; clpfd_interface:try_post_constraint((El in Min..Max) #<=> FDRes), |
| 5032 | | propagate_not_membership(FDRes,Res,int(El,Min,Max)), |
| 5033 | | FullReification=false |
| 5034 | | ). |
| 5035 | | % this could also be enabled with CLPFD = FALSE ?? no overflows are possible |
| 5036 | | reify_avl_mem2(global(GS),fd(El,GS),AVL,Res,FullReification) :- |
| 5037 | | avl_domain(AVL,R),project_avl_domain_on_fd(R,FDList), |
| 5038 | | b_global_sets:b_get_fd_type_bounds(GS,Low,Up), |
| 5039 | | (is_full_fdlist(FDList,Low,Up) |
| 5040 | | -> Res=pred_true, % all the values are in the list; it must be a member |
| 5041 | | % normally this should also be detected by clpfd_reify_inlist, unless no constraint was set up for El |
| 5042 | | % it seems to have an effect for test 426: probcli examples/EventBPrologPackages/SSF/Bepi_Soton/M1_mch.eventb -cbc all -strict -p CLPFD TRUE -p SMT TRUE -strict -p STRICT_RAISE_WARNINGS TRUE |
| 5043 | | FullReification=true |
| 5044 | | ; clpfd_reify_inlist(El,FDList,FDRes,Posted), |
| 5045 | | propagate_fd_membership(FDRes,Res,inlist(El,FDList)), |
| 5046 | | FullReification=Posted |
| 5047 | | ). |
| 5048 | | %reify_avl_mem2(global(GS),fd(El,GS),AVL,Res) :- |
| 5049 | | % avl_min(AVL,fd(Min,GS)), avl_max(AVL,fd(Max,GS)), |
| 5050 | | % clpfd_interface:try_post_constraint((El in Min..Max) #<=> FDRes), |
| 5051 | | % propagate_not_membership(FDRes,Res,fd(El,GS,Min,Max)). |
| 5052 | | |
| 5053 | | % assumes list is sorted |
| 5054 | | is_full_fdlist(List,Low,Up) :- integer(Up), is_full_fdlist2(List,Low,Up). |
| 5055 | | is_full_fdlist2([],Low,Up) :- Low>Up. |
| 5056 | | is_full_fdlist2([Low|T],Low,Up) :- L1 is Low+1, is_full_fdlist2(T,L1,Up). |
| 5057 | | |
| 5058 | | % check if avl small enough to call clpfd_reify_inlist |
| 5059 | | reify_integer_avl_mem(_AVL,Min,Max) :- MaxSizeM1 is Max-Min, MaxSizeM1 =< 20,!. |
| 5060 | | reify_integer_avl_mem(AVL,_Min,_Max) :- avl_height_less_than_with_solver_strength(AVL,5). |
| 5061 | | |
| 5062 | | |
| 5063 | | |
| 5064 | | project_avl_domain_on_fd([],[]). |
| 5065 | | project_avl_domain_on_fd([H|T],[PH|PT]) :- project_avl_domain(H,PH), project_avl_domain_on_fd(T,PT). |
| 5066 | | project_avl_domain(int(X),X). |
| 5067 | | project_avl_domain(fd(X,_),X). |
| 5068 | | |
| 5069 | | |
| 5070 | | :- block propagate_fd_membership(-,-,?). |
| 5071 | | % if we make it propagate_fd_membership(-,-?) Bosch examples becomes much slower ? |
| 5072 | | % Indeed: membership_custom_set will already force membership or non-membership ! |
| 5073 | | %propagate_fd_membership(X,M,Info) :- var(X),!, print(propagate_fd(X,M,Info)),nl, (M=pred_true ->X=1 ; X=0). |
| 5074 | | propagate_fd_membership(1,pred_true,_Info). |
| 5075 | | propagate_fd_membership(0,pred_false,_Info). |
| 5076 | | |
| 5077 | | :- block propagate_not_membership(-,?,?). |
| 5078 | | propagate_not_membership(1,_,_). % there could be elements in the interval which are not in the set |
| 5079 | | propagate_not_membership(0,Res,_Info) :- |
| 5080 | | Res=pred_false. |
| 5081 | | |
| 5082 | | % ----------------- |
| 5083 | | |
| 5084 | | % fails if not possible to quickly compute approximate size |
| 5085 | | quick_custom_explicit_set_approximate_size(V,_) :- var(V),!,fail. |
| 5086 | | quick_custom_explicit_set_approximate_size(avl_set(AVL),Size) :- !, |
| 5087 | | quick_avl_approximate_size(AVL,Size). |
| 5088 | | quick_custom_explicit_set_approximate_size(CS,Size) :- |
| 5089 | | card_for_specific_custom_set(CS,Size,Code), |
| 5090 | | on_enumeration_warning(call(Code),fail), |
| 5091 | | atomic(Size). % inf or number; sometimes card_for_specific_custom_set can return a variable |
| 5092 | | |
| 5093 | | :- use_module(clpfd_lists,[try_get_fd_value_list/4, get_fd_value/3, in_fd_value_list_wf/4]). |
| 5094 | | % a membership propagation, but only done if it can be done quickly |
| 5095 | | |
| 5096 | | |
| 5097 | | % quick_propagation_element_information(Set, Element, WF, PossiblyCompiledSet) |
| 5098 | | % use last element for next iteration if you call quick_propagation_element_information in a loop |
| 5099 | | :- block quick_propagation_element_information(-,?,?,?). |
| 5100 | | quick_propagation_element_information(Set,_El,_,R) :- |
| 5101 | | preferences:preference(use_clpfd_solver,false), |
| 5102 | | !, R=Set. |
| 5103 | | quick_propagation_element_information(avl_set(AVL),Element,WF,NewSet) :- !, |
| 5104 | | quick_avl_approximate_size(AVL,Size), |
| 5105 | | NewSet=avl_set_with_size(AVL,Size), |
| 5106 | | propagate_avl_element_information_direct(Element,AVL,Size,WF). |
| 5107 | | quick_propagation_element_information(avl_set_with_size(AVL,Size),Element,WF,NewSet) :- !, |
| 5108 | | NewSet = avl_set_with_size(AVL,Size), |
| 5109 | | propagate_avl_element_information_direct(Element,AVL,Size,WF). |
| 5110 | | quick_propagation_element_information(closure(P,T,B),Element,WF,NewSet) :- !, |
| 5111 | | NewSet = closure(P,T,B), |
| 5112 | | element_of_closure(Element,P,T,B,WF). |
| 5113 | | quick_propagation_element_information(fd_value_list(FDList,GroundList,Type),El,WF,NewSet) :- !, |
| 5114 | | NewSet = fd_value_list(FDList,GroundList,Type), |
| 5115 | | get_fd_value(Type,El,ElFD), |
| 5116 | | in_fd_value_list_wf(GroundList,ElFD,FDList,WF). |
| 5117 | | quick_propagation_element_information(Set,El,WF,NewSet) :- |
| 5118 | ? | try_get_fd_value_list(Set,Type,FDList,GroundList),!, |
| 5119 | | FDList \= [], % if list is empty membership fails |
| 5120 | | NewSet = fd_value_list(FDList,GroundList,Type), |
| 5121 | | % clpfd_inlist requires list of integers as second argument |
| 5122 | ? | get_fd_value(Type,El,ElFD), |
| 5123 | | % We could apply filter_non_matching_elements here |
| 5124 | | in_fd_value_list_wf(GroundList,ElFD,FDList,WF). |
| 5125 | | quick_propagation_element_information(Set,_,_,Set). |
| 5126 | | |
| 5127 | | % ----------------- |
| 5128 | | |
| 5129 | | % infer information about an element of an AVL set |
| 5130 | | propagate_avl_element_information(Element,AVL,Size,WF) :- |
| 5131 | | (preferences:preference(use_clpfd_solver,true) |
| 5132 | ? | -> propagate_avl_element_information_direct(Element,AVL,Size,WF) |
| 5133 | | ; true). |
| 5134 | | |
| 5135 | | propagate_avl_element_information_direct(Element,AVL,Size,WF) :- |
| 5136 | | (Size<100 -> %30 which magic constant to use here; use larger value in SMT mode ? |
| 5137 | ? | propagate_avl_element_information_small(Element,AVL,WF) |
| 5138 | | ; is_avl_fd_index_set(AVL,Type) -> |
| 5139 | | propagate_avl_element_information_large(Type,Element,AVL), |
| 5140 | | (Size < 4000, nonvar(Element), Element = (_,_) % another magic constant |
| 5141 | | -> Prio is Size // 60, |
| 5142 | | get_wait_flag(Prio,propagate_avl_element_information(Element),WF,LWF), |
| 5143 | | propagate_avl_el_large_block(Element,AVL,WF,LWF) % will do precise propagation |
| 5144 | | ; true) |
| 5145 | | ; true). |
| 5146 | | % TO DO: we could call in_nat_range_wf; this way it would also work in non-CLPFD mode |
| 5147 | | |
| 5148 | | :- block propagate_avl_el_large_block(?,?,?,-). |
| 5149 | | propagate_avl_el_large_block((A,B),_,_,_) :- |
| 5150 | | (ground(A); ground_value(B)), % in first: case we will apply AVL set ; in second case probably no benefit as propagate_avl_element_information_large already propagated first element |
| 5151 | | !. |
| 5152 | | propagate_avl_el_large_block(Element,AVL,WF,_LWF) :- |
| 5153 | | % TO DO: maybe look if we should not use clpfd_list, but only upper & lower bound |
| 5154 | | propagate_avl_element_information_small(Element,AVL,WF). % will do precise propagation. |
| 5155 | | |
| 5156 | | :- use_module(clpfd_lists,[avl_fd_value_check/4]). |
| 5157 | | :- use_module(clpfd_interface,[catch_and_ignore_clpfd_overflow/2]). |
| 5158 | | propagate_avl_element_information_small(Element,AVL,WF) :- |
| 5159 | ? | catch_and_ignore_clpfd_overflow(propagate_avl_element_information_small, % relevant test e.g. 1708 (with used_ids_defined_by_equality) |
| 5160 | | avl_fd_value_check(AVL,Element,WF,_FullyChecked)). |
| 5161 | | |
| 5162 | | propagate_avl_element_information_large(Type,El,AVL) :- |
| 5163 | | avl_min(AVL,Min), avl_max(AVL,Max), |
| 5164 | | % if Size small enough and smaller than Max-Min we call clpfd_inlist on domain |
| 5165 | | % Note: overflows should be caught below; we could check that Min/Max are within CLPFD range |
| 5166 | | couple_prj1_in_range(Type,El,Min,Max). |
| 5167 | | |
| 5168 | | couple_prj1_in_range(integer,int(El),int(Min),int(Max)) :- clpfd_interface:clpfd_inrange(El,Min,Max). |
| 5169 | | couple_prj1_in_range(global(GS),fd(El,GS),fd(Min,GS),fd(Max,GS)) :- clpfd_interface:clpfd_inrange(El,Min,Max). |
| 5170 | | couple_prj1_in_range(couple_prj1(T),(El,_),(Min,_),(Max,_)) :- couple_prj1_in_range(T,El,Min,Max). |
| 5171 | | couple_prj1_in_range(rec_first_field(Name,T),rec([field(Name,El)|TF]), |
| 5172 | | rec([field(Name,Min)|TMin]),rec([field(Name,Max)|_])) :- |
| 5173 | | (var(TF) |
| 5174 | | -> copy_field_names(TMin,TF) % if Fields not yet instantiated: copy over all fields |
| 5175 | | ; true), |
| 5176 | | couple_prj1_in_range(T,El,Min,Max). |
| 5177 | | |
| 5178 | | copy_field_names([],[]). |
| 5179 | | copy_field_names([field(N,_)|T],[field(N,_)|CT]) :- copy_field_names(T,CT). |
| 5180 | | |
| 5181 | | % check if the first component of the AVL elements of a type such that we can propagate FD information |
| 5182 | | is_avl_fd_index_set(node(El,_True,_,_,_),Type) :- |
| 5183 | | simple_index_type(El,Type). |
| 5184 | | simple_index_type((El,_),couple_prj1(T)) :- simple_index_type(El,T). |
| 5185 | | simple_index_type(int(_),integer). |
| 5186 | | simple_index_type(fd(_,GS),global(GS)). |
| 5187 | | simple_index_type(rec(Fields),rec_first_field(Name,T)) :- nonvar(Fields), |
| 5188 | | Fields = [field(Name,El)|_], |
| 5189 | | simple_index_type(El,T). |
| 5190 | | %simple_index_type((int(_),_),couple_integer). |
| 5191 | | %simple_index_type(((int(_),_),_),couple_couple_integer). |
| 5192 | | %simple_index_type((fd(_,GS),_),couple_global(GS)). |
| 5193 | | |
| 5194 | | |
| 5195 | | /* avoid instantiating non-normalised with normalised values leading to failure */ |
| 5196 | | :- assert_must_succeed((X=(fd(1,'Name'),fd(2,'Name')), A=node(X,true,0,empty,empty), |
| 5197 | | custom_explicit_sets:safe_avl_member(X,A) )). |
| 5198 | | |
| 5199 | ? | safe_avl_member(X,AVL) :- var(X), !, my_avl_member(X,AVL). |
| 5200 | | %safe_avl_member((X,Y),AVL) :- !, safe_avl_member_pair(X,Y,AVL). |
| 5201 | | safe_avl_member(Value,AVL) :- decompose_index(Value,Key,RestVal), !, |
| 5202 | ? | avl_fetch_indexed(Value,Key,RestVal,AVL). |
| 5203 | | safe_avl_member(X,AVL) :- ground_value(X), convert_to_avl_inside_set(X,AX), !, avl_fetch(AX,AVL). |
| 5204 | ? | safe_avl_member(X,AVL) :- safe_avl_member_default_wf(X,AVL,no_wf_available). |
| 5205 | | |
| 5206 | | |
| 5207 | | % this is a generalisation of safe_avl_member_pair |
| 5208 | | % check if a value can be decomposed into an index and the rest of a value and the key is ground |
| 5209 | | % it also works for records indexing on first field |
| 5210 | | avl_fetch_indexed(Value,Key,RestVal,AVL) :- |
| 5211 | | ground_value_or_field(Key), |
| 5212 | | convert_value_or_field(Key,NormKey), |
| 5213 | | !, |
| 5214 | | (ground_value_or_field(RestVal), |
| 5215 | | convert_to_avl_inside_set(Value,NormValue) |
| 5216 | | -> avl_fetch(NormValue,AVL) |
| 5217 | ? | ; avl_fetch_with_index(NormKey,AVL,RestValLookup), |
| 5218 | | kernel_objects:equal_object(RestValLookup,RestVal,avl_fetch_indexed) |
| 5219 | | ). |
| 5220 | | avl_fetch_indexed(Value,_,_,AVL) :- |
| 5221 | ? | safe_avl_member_default_wf(Value,AVL,no_wf_available). |
| 5222 | | |
| 5223 | | convert_value_or_field(field(Name,Val),field(Name,NVal)) :- !, |
| 5224 | | convert_to_avl_inside_set(Val,NVal). |
| 5225 | | convert_value_or_field(Key,NormKey) :- |
| 5226 | | convert_to_avl_inside_set(Key,NormKey). |
| 5227 | | |
| 5228 | | % a version of safe_avl_member where the first argument is guaranteed to be ground |
| 5229 | | % somehow using this seems to slow-down evaluation for vesg_Dec12; Caching ?? |
| 5230 | | %safe_avl_member_ground(X,AVL) :- |
| 5231 | | % convert_to_avl_inside_set(X,AX), !, avl_fetch(AX,AVL). |
| 5232 | | %safe_avl_member_ground((X,Y),AVL) :- !, avl_member_pair_arg1_ground(X,Y,AVL). |
| 5233 | | %safe_avl_member_ground(X,AVL) :- safe_avl_member_default_wf(X,AVL,no_wf_available). |
| 5234 | | |
| 5235 | | |
| 5236 | | safe_avl_member_pair(X,Y,AVL) :- safe_avl_member_pair_wf(X,Y,AVL,no_wf_available). |
| 5237 | | |
| 5238 | | safe_avl_member_pair_wf(X,Y,AVL,_WF) :- ground_value(X),!, |
| 5239 | | ( ground_value(Y), |
| 5240 | | convert_to_avl_inside_set((X,Y),AX) |
| 5241 | | -> avl_fetch(AX,AVL) |
| 5242 | | ; avl_member_pair_arg1_ground(X,Y,AVL)). % TODO: pass WF |
| 5243 | | safe_avl_member_pair_wf(X,Y,AVL,WF) :- safe_avl_member_default_wf((X,Y),AVL,WF). |
| 5244 | | |
| 5245 | | % can be used to try and lookup a function value without creating WD errors, ... |
| 5246 | | % used in b_compiler to compile function applications |
| 5247 | | try_apply_to_avl_set(X,Y,AVL) :- ground_value(X), |
| 5248 | ? | avl_member_pair_arg1_ground(X,Y,AVL). |
| 5249 | | |
| 5250 | | %safe_avl_member_pair_ground(X,Y,AVL) :- convert_to_avl_inside_set((X,Y),AX),!, avl_fetch(AX,AVL). |
| 5251 | | %safe_avl_member_pair_ground(X,Y,AVL) :- avl_member_pair_arg1_ground(X,Y,AVL). |
| 5252 | | |
| 5253 | | avl_member_pair_arg1_ground(X,Y,AVL) :- convert_to_avl_inside_set(X,AX), !, |
| 5254 | | get_template(Y,RY,ToUnifyAfter), |
| 5255 | ? | avl_fetch_pair(AX,AVL,RY), |
| 5256 | | unify_after_wf(ToUnifyAfter,no_wf_available). %kernel_objects:equal_object(RY,Y). |
| 5257 | | avl_member_pair_arg1_ground(X,Y,AVL) :- |
| 5258 | | safe_avl_member_default((X,Y),AVL). |
| 5259 | | |
| 5260 | ? | safe_avl_member_default(X,AVL) :- safe_avl_member_default_wf(X,AVL,no_wf_available). |
| 5261 | | %safe_avl_member_default(PP,X,AVL) :- |
| 5262 | | % debug:timer_call(safe_avl_member_default(PP),custom_explicit_sets:safe_avl_member_default1(X,AVL)). |
| 5263 | | safe_avl_member_default_wf(X,AVL,WF) :- %statistics(runtime,_), |
| 5264 | | get_template(X,Template,ToUnifyAfter), |
| 5265 | ? | my_avl_member(Template,AVL), |
| 5266 | | % statistics(runtime,[_,T2]), print(avl_member(Template,T2)),nl, |
| 5267 | | unify_after_wf(ToUnifyAfter,WF). % kernel_objects:equal_object(Template,X)). |
| 5268 | | |
| 5269 | | unify_after_wf([],_). |
| 5270 | | unify_after_wf([A/B|T],WF) :- kernel_objects:equal_object_wf(A,B,unify_after,WF), |
| 5271 | | unify_after_wf(T,WF). |
| 5272 | | |
| 5273 | | |
| 5274 | | |
| 5275 | | get_template(A,R,ToUnifyAfter) :- |
| 5276 | | (var(A) -> ToUnifyAfter=[A/R] |
| 5277 | | ; get_template2(A,R,ToUnifyAfter) -> true |
| 5278 | | ; add_internal_error('Could_not_get_template: ',get_template(A,R,_))). |
| 5279 | | |
| 5280 | | get_template2((A,B),(TA,TB),ToUnifyAfter) :- get_template(A,TA,ToUnifyAfter1), get_template(B,TB,ToUnifyAfter2), |
| 5281 | | append(ToUnifyAfter1,ToUnifyAfter2,ToUnifyAfter). % TO DO: use DifferenceLists / DCG |
| 5282 | | get_template2(int(X),int(X),[]). |
| 5283 | | get_template2(fd(A,B),fd(A,B),[]). |
| 5284 | | get_template2([],[],[]). |
| 5285 | | get_template2(pred_false /* bool_false */,pred_false /* bool_false */,[]). |
| 5286 | | get_template2(pred_true /* bool_true */,pred_true /* bool_true */,[]). |
| 5287 | | get_template2([H|T],R,ToUnifyAfter) :- |
| 5288 | | (ground_value(H),ground_value(T) |
| 5289 | | -> convert_to_avl_inside_set([H|T],R),ToUnifyAfter=[] |
| 5290 | | ; ToUnifyAfter=[[H|T]/R]). |
| 5291 | | % ; R=avl_set(A), ToUnifyAfter=[[H|T]/avl_set(A)]). |
| 5292 | | get_template2(closure(P,T,B),R,[]) :- ground_value(closure(P,T,B)), |
| 5293 | | expand_closure_to_avl_wf(P,T,B,R,no_wf_available),!. |
| 5294 | | get_template2(closure(P,T,B),AVL_OR_EMPTY_OR_GS,[closure(P,T,B)/AVL_OR_EMPTY_OR_GS]). % closure could be empty or an infinite global set ? |
| 5295 | | %get_template2(closure_x(_,_,_),_AVL_OR_EMPTY). |
| 5296 | | get_template2(avl_set(A),avl_set(NA),[]) :- convert_to_avl_inside_set(avl_set(A),avl_set(NA)). % do we need to normalise here ?? |
| 5297 | | get_template2(string(X),string(X),[]). |
| 5298 | | get_template2(term(X),term(X),[]). |
| 5299 | | get_template2(freetype(X),R,[]) :- convert_to_avl_inside_set(freetype(X),R). |
| 5300 | | get_template2(rec(Fields),rec(TFields),ToUnifyAfter) :- get_fields_template(Fields,TFields,ToUnifyAfter). |
| 5301 | | get_template2(freeval(ID,Case,Value),freeval(ID,Case,TValue),ToUnifyAfter) :- get_template(Value,TValue,ToUnifyAfter). |
| 5302 | | get_template2(global_set(GS),R,[]) :- convert_to_avl_inside_set(global_set(GS),R). |
| 5303 | | |
| 5304 | | |
| 5305 | | get_fields_template(A,R,[rec(A)/rec(R)]) :- var(A),!. |
| 5306 | | get_fields_template([],[],ToUnifyAfter) :- !, ToUnifyAfter=[]. |
| 5307 | | get_fields_template([field(Name,Val)|T],[field(Name,TVal)|TT],ToUnifyAfter) :- nonvar(Name),!, |
| 5308 | | get_template(Val,TVal,ToUnifyAfter1), |
| 5309 | | get_fields_template(T,TT,ToUnifyAfter2), append(ToUnifyAfter1,ToUnifyAfter2,ToUnifyAfter). |
| 5310 | | get_fields_template(A,R,[rec(A)/rec(R)]). |
| 5311 | | |
| 5312 | | |
| 5313 | | % succeed if we can decide membership of an avl_set on the spot |
| 5314 | | quick_test_avl_membership(AVL,X,Res) :- |
| 5315 | | element_can_be_added_or_removed_to_avl(X), |
| 5316 | | convert_to_avl_inside_set(X,AX), |
| 5317 | | (avl_fetch(AX,AVL) -> Res=pred_true ; Res=pred_false). |
| 5318 | | |
| 5319 | | % --------------------- |
| 5320 | | |
| 5321 | | % a dispatch predicate |
| 5322 | | my_avl_member(Key,AVL) :- |
| 5323 | | (preferences:preference(randomise_enumeration_order,true) |
| 5324 | ? | -> random_avl_member(Key,AVL) ; avl_member_opt(Key,AVL)). |
| 5325 | | :- use_module(library(random),[random/3]). |
| 5326 | ? | random_avl_member(Key,AVL) :- avl_height(AVL,Height), H1 is Height+1, random_avl_member(Key,H1,AVL). |
| 5327 | | % TO DO: make more intelligent; this is not really a very uniform way of randomly enumerating an AVL set (e.g., Key never occurs between L and R) |
| 5328 | | random_avl_member(Key, H, node(K,_,_,L,R)) :- |
| 5329 | | random(1,H,1), !, H1 is H-1, |
| 5330 | ? | (Key=K ; random_avl_member(Key,H1,L) ; random_avl_member(Key,H1,R)). |
| 5331 | | random_avl_member(Key, H, node(K,_,_,L,R)) :- random(1,3,1), !, H1 is H-1, |
| 5332 | ? | (random_avl_member(Key,H1,L) ; random_avl_member(Key,H1,R) ; Key=K). |
| 5333 | | random_avl_member(Key, H, node(K,_,_,L,R)) :- H1 is H-1, |
| 5334 | ? | (random_avl_member(Key,H1,R) ; random_avl_member(Key,H1,L) ; Key=K). |
| 5335 | | |
| 5336 | | % a variation of avl_member from library(avl) which tries to avoid leaving choice points behind |
| 5337 | | avl_member_opt(Key, node(K,_,_,L,R)) :- |
| 5338 | ? | ( avl_member_opt(Key, L) |
| 5339 | | ; R=empty -> Key = K % avoid trailing choice_point |
| 5340 | ? | ; (Key=K ; avl_member_opt(Key, R)) |
| 5341 | | ). |
| 5342 | | |
| 5343 | | % --------------------- |
| 5344 | | |
| 5345 | | :- use_module(kernel_objects,[check_element_of_wf/3,not_element_of_wf/3]). |
| 5346 | | :- use_module(memoization,[element_of_memoization_closure/6]). |
| 5347 | | element_of_special_closure(interval(LOW,UP),X,WF,_,_,_) :- !, |
| 5348 | | %hit_profiler:add_profile_hit(in_nat_range(X,LOW,UP,CondClosure)), |
| 5349 | ? | kernel_objects:in_nat_range_wf(X,int(LOW),int(UP),WF). |
| 5350 | | element_of_special_closure(member_closure(_ID,_Type,VAL),X,WF,_,_,_) :- |
| 5351 | | (VAL=value(_) ; VAL = cartesian_product(b(value(A),_,_),b(value(B),_,_))),!, |
| 5352 | | %hit_profiler:add_profile_hit(in_member_closure(X,Par,Typ,Body)), |
| 5353 | | (VAL=value(Set) -> check_element_of_wf(X,Set,WF) |
| 5354 | | ; X=(XA,XB), |
| 5355 | ? | kernel_objects:check_element_of_wf(XA,A,WF), |
| 5356 | ? | kernel_objects:check_element_of_wf(XB,B,WF)). |
| 5357 | | element_of_special_closure(not_member_closure(_ID,_Type,value(Set)),X,WF,_,_,_) :- !, |
| 5358 | | %hit_profiler:add_profile_hit(in_not_member_closure(X,Par,Typ,Set)), |
| 5359 | | not_element_of_wf(X,Set,WF). |
| 5360 | | % we used to have to add enumerator, as not_element_of does not instantiate; e.g. relevant when doing X :: GS - {y} |
| 5361 | | % This is no longer required |
| 5362 | | % see test 6 (../prob_examples/public_examples/B/FeatureChecks/NotMemberCheck.mch) |
| 5363 | | element_of_special_closure(recursive_special_closure(RId),X,WF,Parameters,PT,CondClosure) :- !, |
| 5364 | | add_recursive_parameter(Parameters,PT,X,RId,CondClosure,NewParameters,NewPT,Value,WF), |
| 5365 | | element_of_normal_closure(Value,NewParameters,NewPT,CondClosure,WF). |
| 5366 | | element_of_special_closure(memoization_closure(MemoID),X,WF,P,T,B) :- !, |
| 5367 | | element_of_memoization_closure(MemoID,X,WF,P,T,B). |
| 5368 | | element_of_special_closure(_,X,WF,Parameters,PT,CondClosure) :- |
| 5369 | | % none of the special cases above apply after all |
| 5370 | ? | element_of_normal_closure(X,Parameters,PT,CondClosure,WF). |
| 5371 | | |
| 5372 | | :- block element_of_closure(?,-,?,?,?), element_of_closure(?,?,?,-,?). |
| 5373 | | % element_of_closure(X,Para,T,Body,_WF): check if X is a member of closure(Para,T,Body) |
| 5374 | | element_of_closure(X,Parameters,PT,CondClosure,WF) :- |
| 5375 | | is_special_closure(Parameters,PT,CondClosure, SpecialClosure),!, |
| 5376 | | %print_term_summary(element_of_special_closure(SpecialClosure,X,WF,Parameters,PT,CondClosure)), trace_in_debug_mode, |
| 5377 | ? | element_of_special_closure(SpecialClosure,X,WF,Parameters,PT,CondClosure). |
| 5378 | | element_of_closure(X,Parameters,PT,CondClosure,WF) :- |
| 5379 | | %print_term_summary(element_of_normal_closure(X,Parameters,PT,CondClosure,WF)), trace_in_debug_mode, |
| 5380 | ? | element_of_normal_closure(X,Parameters,PT,CondClosure,WF). |
| 5381 | | element_of_normal_closure(X,Parameters,PT,CondClosure,WF) :- |
| 5382 | | %hit_profiler:add_profile_hit(element_of_closure(X,Parameters,PT,CondClosure)), |
| 5383 | | same_length(Parameters,ParValues), |
| 5384 | | convert_list_into_pairs(ParValues,X), |
| 5385 | ? | b_test_closure_wo_enum(Parameters,PT,CondClosure,ParValues,WF). |
| 5386 | | |
| 5387 | | :- use_module(store,[set_up_localstate/4]). |
| 5388 | | :- block b_test_closure_wo_enum(?,?,-,?,?). |
| 5389 | | b_test_closure_wo_enum(Parameters,ParameterTypes,ClosurePred,ParValues,WF) :- |
| 5390 | | % same_length(Parameters,ParValues), % not necessary |
| 5391 | | set_up_localstate(Parameters,ParValues,[],LocalState), |
| 5392 | ? | b_enumerate:b_type_values_in_store(Parameters,ParameterTypes,LocalState), |
| 5393 | | copy_wf_start(WF,b_test_closure_wo_enum(Parameters),InnerWF), |
| 5394 | | % avoid that WF0 actions triggered before we have had a chance to traverse the expression |
| 5395 | | b_test_boolean_expression(ClosurePred,LocalState,[],InnerWF), |
| 5396 | ? | copy_wf_finish(WF,InnerWF). |
| 5397 | | |
| 5398 | | % recursive identifier to list of parameters with body as value |
| 5399 | | % NewValue is the Value that should be checked for membership in the adapted closure; it has one argument more |
| 5400 | | add_recursive_parameter(Parameters,Types,Value,TId,CondClosure,NewParameters,NewTypes,NewValue,WF) :- |
| 5401 | | TId = b(identifier(RId),SetType,_), % unification replaces: get_texpr_id(TId,RId), get_texpr_type(TId,SetType), |
| 5402 | | append(Parameters,[RId],NewParameters), |
| 5403 | | append(Types,[SetType],NewTypes), |
| 5404 | | %tools_printing:print_term_summary(recursion(Value)),nl, |
| 5405 | | % TO DO check some variant decreases |
| 5406 | | (kernel_waitflags:pending_abort_error(WF) |
| 5407 | | -> NewValue = (_,_) % prevent further expansion of recursion, in case WD error in recursive function |
| 5408 | | % TO DO: detect whether WD error occurs within recursive function, |
| 5409 | | % indeed, the expansion of the recursive function could be unrelated to WD error and be important to detect inconsistency which prevents WD error: e.g., 1/x=res & recfun(x) \= 0 |
| 5410 | | ,debug_println(19,stopping_recursion_due_to_wd_error) |
| 5411 | | ; NewValue = (Value,closure(Parameters,Types,CondClosure)) |
| 5412 | | ). |
| 5413 | | |
| 5414 | | |
| 5415 | | % same as above, but without a waitflag |
| 5416 | | element_of_custom_set(X,CS) :- element_of_custom_set2(CS,X). |
| 5417 | | |
| 5418 | | element_of_custom_set2(global_set(GS),X) :- !,element_of_global_set(X,GS). |
| 5419 | | element_of_custom_set2(freetype(ID),_) :- is_maximal_freetype(ID),!. % freetypes are always maximal at the moment |
| 5420 | | element_of_custom_set2(avl_set(AVL),X) :- !, |
| 5421 | | safe_avl_member(X,AVL). |
| 5422 | | element_of_custom_set2(CS,X) :- init_wait_flags(WF,[element_of_custom_set2]), |
| 5423 | | element_of_custom_set_wf2(CS,X,WF), |
| 5424 | | ground_wait_flags(WF). |
| 5425 | | |
| 5426 | | % --------------- |
| 5427 | | |
| 5428 | | % function application for closure |
| 5429 | | |
| 5430 | | % same as check_element_of_wf but does not wait on Y: |
| 5431 | | % should also work for relation ?? |
| 5432 | | |
| 5433 | | check_element_of_function_closure(X,Y,Parameters,PT,CondClosure,WF) :- |
| 5434 | | is_special_closure(Parameters,PT,CondClosure, SpecialClosure),!, % this covers recursive closures |
| 5435 | | element_of_special_closure(SpecialClosure,(X,Y),WF,Parameters,PT,CondClosure). |
| 5436 | | check_element_of_function_closure(X,Y, P,T,ClosureBody, WF) :- |
| 5437 | | % affects test 1312, unless we add s:seq(0..9) before calling num |
| 5438 | | % a special rule which tries and avoid enumerating solutions to arguments of function application |
| 5439 | | % usually a function application will either be given all arguments or maybe be used in inverse |
| 5440 | ? | is_converted_lambda_closure(P,T,ClosureBody), %is_converted_non_recursive_lambda_closure(P,T,ClosureBody), |
| 5441 | | % TO DO: also make this work for recursive closures by adding recursive args (see e.g. test 1302) |
| 5442 | | is_lambda_closure(P,T,ClosureBody, OtherIDs, OtherTypes, DomainPred, EXPR), |
| 5443 | | (debug:debug_level_active_for(4) -> |
| 5444 | | print('Apply Fun : '), translate:print_bexpr(DomainPred), print(' | '), translate:print_bexpr(EXPR),nl, |
| 5445 | | get_texpr_info(ClosureBody,I), print(info(I,WF)),nl, |
| 5446 | | print_term_summary((X,Y)),nl %,trace |
| 5447 | | ; true), |
| 5448 | | !, |
| 5449 | | % alternative: annotate X,Y as inner variable ? |
| 5450 | | get_texpr_info(ClosureBody,BInfo), |
| 5451 | | b_interpreter:set_up_typed_localstate2(OtherIDs,OtherTypes,BInfo,ParValues,_TypedVals,[],LocalState,positive), |
| 5452 | | convert_list_into_pairs(ParValues,SingleParValue), |
| 5453 | | kernel_objects:equal_object_wf(X,SingleParValue,check_element_of_function_closure,WF), |
| 5454 | | (is_truth(DomainPred) -> true |
| 5455 | | ; init_wait_flags(InnerWF,[check_element_of_function_closure]), |
| 5456 | | %copy_wf01e_wait_flags(WF,InnerWF), % we could delay copying WF0 until after test_boolean_expression of DomainPred ? |
| 5457 | | b_test_boolean_expression(DomainPred,LocalState,[],InnerWF), |
| 5458 | | get_wait_flag0(WF,WF0), get_wait_flag0(InnerWF,WF0), % was: ground_wait_flag0(InnerWF), but this can result in inner WF0 being set when outer is not yet set; see test 1948 |
| 5459 | | ground_value_check(X,GrX), |
| 5460 | | (nonvar(GrX) -> copy_waitflag_store(InnerWF,WF) % block would trigger already |
| 5461 | | ; ground_value_check(Y,GrY), |
| 5462 | | (nonvar(GrY) -> copy_waitflag_store(InnerWF,WF) % block would trigger already |
| 5463 | | ; get_last_wait_flag(check_element_of_function_closure(OtherIDs),WF,LastWF), |
| 5464 | | block_copy_waitflag_store(InnerWF,WF,GrX,GrY,LastWF) |
| 5465 | | ) |
| 5466 | | ) |
| 5467 | | ), |
| 5468 | | b_interpreter:b_compute_expression(EXPR,LocalState,[],Y,WF). |
| 5469 | | check_element_of_function_closure(X,Y, P,T,ClosureBody, WF) :- |
| 5470 | | element_of_normal_closure((X,Y),P,T,ClosureBody,WF). |
| 5471 | | % we could memoize on X here if /*@symbolic-memo */ pragma used and closure has special ID associated with it |
| 5472 | | |
| 5473 | | :- block block_copy_waitflag_store(?,?,-,-,-). |
| 5474 | | block_copy_waitflag_store(InnerWF,WF,_GrX,_GrY,_LWF) :- |
| 5475 | | % copy waitflags from InnerWF store to WF |
| 5476 | | copy_waitflag_store(InnerWF,WF). |
| 5477 | | |
| 5478 | | /* -------------- */ |
| 5479 | | /* NOT_ELEMENT_OF */ |
| 5480 | | /* -------------- */ |
| 5481 | | |
| 5482 | | :- use_module(kernel_objects,[not_element_of_global_set/2]). |
| 5483 | | |
| 5484 | | not_element_of_custom_set(X,CS) :- init_wait_flags(WF,[not_element_of_custom_set]), |
| 5485 | | not_element_of_custom_set_wf(X,CS,WF), |
| 5486 | | ground_wait_flags(WF). |
| 5487 | | not_element_of_custom_set_wf(X,CS,WF) :- |
| 5488 | ? | not_element_of_custom_set_wf2(CS,X,WF). |
| 5489 | | |
| 5490 | | not_element_of_custom_set_wf2(global_set(GS),X,_WF) :- not_element_of_global_set(X,GS). |
| 5491 | | not_element_of_custom_set_wf2(freetype(_),_,_) :- !,fail. % TO DO: what if we have List(1..3) ? can that occur ?? |
| 5492 | | not_element_of_custom_set_wf2(avl_set(node(Y,_,_,empty,empty)),X,WF) :- !, |
| 5493 | | % X /: {Y} <=> X /= Y |
| 5494 | ? | kernel_objects:not_equal_object_wf(X,Y,WF). % improve if X is ground |
| 5495 | | not_element_of_custom_set_wf2(avl_set(AVL),X,_WF) :- !, |
| 5496 | | ground_value_check(X,GrX), |
| 5497 | ? | propagate_avl_not_element_information(X,GrX,AVL), |
| 5498 | | not_element_of_avl_set_block(GrX,X,AVL). |
| 5499 | | not_element_of_custom_set_wf2(closure(Parameters,PT,Cond),X,WF) :- |
| 5500 | ? | closure_not_member(X,Parameters,PT,Cond,WF). |
| 5501 | | |
| 5502 | | :- block not_element_of_avl_set_block(-,?,?). |
| 5503 | | not_element_of_avl_set_block(_,X,AVL) :- |
| 5504 | | convert_to_avl_inside_set(X,CX), |
| 5505 | | \+ avl_fetch(CX,AVL). %% IMPROVE ?? |
| 5506 | | |
| 5507 | | propagate_avl_not_element_information(_,GrEl,_) :- nonvar(GrEl),!. |
| 5508 | | propagate_avl_not_element_information(Element,_,AVL) :- preferences:preference(use_clpfd_solver,true), |
| 5509 | | is_avl_simple_set(AVL,Type), % integer or global(GS) \+ground(Element) , |
| 5510 | | ((Type=integer -> avl_height_less_than_with_solver_strength(AVL,6) % 16-31 elements - was: avl_size<20 |
| 5511 | | ; true) |
| 5512 | | -> !, |
| 5513 | ? | propagate_avl_not_element_information3(Type,Element,AVL) % uses clpfd_not_inlist |
| 5514 | | ; Type=integer, avl_height_less_than_with_solver_strength(AVL,15), |
| 5515 | | avl_is_interval(AVL,Min,Max) |
| 5516 | | -> !, |
| 5517 | | kernel_objects:not_in_nat_range(Element,int(Min),int(Max)) % WF not used anyway in _wf version |
| 5518 | | ). |
| 5519 | | propagate_avl_not_element_information(_Element,_,AVL) :- |
| 5520 | | quick_definitely_maximal_set_avl(AVL), |
| 5521 | | !, % we require something not to be an element of the full set; impossible |
| 5522 | | fail. |
| 5523 | | % to do: check if all but one element is in set |
| 5524 | | propagate_avl_not_element_information(_,_,_). |
| 5525 | | |
| 5526 | | avl_height_less_than_with_solver_strength(AVL,Limit) :- preference(solver_strength,SS), |
| 5527 | | RealLimit is Limit + SS/100, |
| 5528 | | avl_height_less_than(AVL,RealLimit). |
| 5529 | | |
| 5530 | | % try and compute a small finite cardinality for a ground value; fail if not possible |
| 5531 | | try_get_finite_max_card_from_ground_value(pred_true,2). |
| 5532 | | try_get_finite_max_card_from_ground_value(pred_false,2). |
| 5533 | | try_get_finite_max_card_from_ground_value(fd(_,Type),Card) :- |
| 5534 | | b_global_sets:b_fd_card(Type,Card), integer(Card). |
| 5535 | | try_get_finite_max_card_from_ground_value((A,B),Card) :- |
| 5536 | | try_get_finite_max_card_from_ground_value(A,CA), |
| 5537 | | try_get_finite_max_card_from_ground_value(B,CB), |
| 5538 | | Card is CA*CB, |
| 5539 | | Card < 20000. |
| 5540 | | try_get_finite_max_card_from_ground_value(rec(Fields),Card) :- |
| 5541 | | try_get_finite_max_card_from_fields(Fields,Card). |
| 5542 | | try_get_finite_max_card_from_ground_value(freeval(FreetypeId,_CaseId,_EArgs),Card) :- |
| 5543 | | freetype_cardinality(FreetypeId,Card), number(Card), Card < 20000. |
| 5544 | | try_get_finite_max_card_from_ground_value(avl_set(node(El,_True,_,_,_)),Card) :- |
| 5545 | | try_get_finite_max_card_from_ground_value(El,CEl), |
| 5546 | | CEl < 16, |
| 5547 | | safe_pow2(CEl,Card). |
| 5548 | | % int(_), term(floating(_)), string(_) are all infinite |
| 5549 | | |
| 5550 | | try_get_finite_max_card_from_fields([],1). |
| 5551 | | try_get_finite_max_card_from_fields([field(_,A)|TF],Card) :- |
| 5552 | | try_get_finite_max_card_from_ground_value(A,CA), |
| 5553 | | try_get_finite_max_card_from_fields(TF,CB), |
| 5554 | | Card is CA*CB, |
| 5555 | | Card < 20000. |
| 5556 | | |
| 5557 | | :- use_module(b_global_sets,[get_global_type_value/3]). |
| 5558 | | propagate_avl_not_element_information3(integer,int(El),AVL) :- |
| 5559 | | avl_domain(AVL,R),project_avl_domain_on_fd(R,FDList), |
| 5560 | | clpfd_interface:clpfd_not_inlist(El,FDList). |
| 5561 | | propagate_avl_not_element_information3(global(GS),FD,AVL) :- |
| 5562 | | get_global_type_value(FD,GS,El), % sets up the FD constraint if var; maybe we can detect inconsistency straightaway below |
| 5563 | | avl_domain(AVL,R),project_avl_domain_on_fd(R,FDList), % maybe we can compute directly the complement ? |
| 5564 | ? | clpfd_interface:clpfd_not_inlist(El,FDList). |
| 5565 | | |
| 5566 | | |
| 5567 | | :- block closure_not_member(?,-,?,?,?). |
| 5568 | | %, closure_not_member(-,?,?,?,?). /* El is unlikely to be instantiated by not_element_of test , but test 6 requires commenting out block declaration */ |
| 5569 | | |
| 5570 | | closure_not_member(X,Parameters,Types,Body,WF) :- |
| 5571 | | is_special_closure(Parameters,Types,Body,SpecialClosure),!, |
| 5572 | ? | not_element_of_special_closure(SpecialClosure,X,WF,Parameters,Types,Body). |
| 5573 | | closure_not_member(El,Parameters,PT,Cond,WF) :- |
| 5574 | | normal_closure_not_member(El,Parameters,PT,Cond,WF). |
| 5575 | | |
| 5576 | | :- use_module(memoization,[not_element_of_memoization_closure/6]). |
| 5577 | | not_element_of_special_closure(interval(LOW,UP),X,_WF,_Parameters,_Types,_Body) :- |
| 5578 | ? | !,kernel_objects:not_in_nat_range(X,int(LOW),int(UP)). |
| 5579 | | not_element_of_special_closure(member_closure(_ID,_Type,VAL),X,WF,_Parameters,_Types,_Body) :- |
| 5580 | | ( VAL = value(_) |
| 5581 | | ; VAL = cartesian_product(b(value(A),_,_),b(value(B),_,_))),!, |
| 5582 | | %hit_profiler:add_profile_hit(member(X,Par,Typ,Body)), |
| 5583 | | ( VAL=value(Set) -> kernel_objects:not_element_of_wf(X,Set,WF) |
| 5584 | ? | ; kernel_objects:not_is_cartesian_pair(X,A,B,WF)). |
| 5585 | | not_element_of_special_closure(not_member_closure(_ID,_Type,value(Set)),X,WF,_Parameters,_Types,_Body) :- |
| 5586 | | !,kernel_objects:check_element_of_wf(X,Set,WF). |
| 5587 | | not_element_of_special_closure(memoization_closure(MemoID),X,WF,P,T,B) :- !, |
| 5588 | | not_element_of_memoization_closure(MemoID,X,WF,P,T,B). |
| 5589 | | not_element_of_special_closure(recursive_special_closure(RId),X,WF,Parameters,Types,Body) :- |
| 5590 | | !, |
| 5591 | | add_recursive_parameter(Parameters,Types,X,RId,Body,NewParameters,NewPT,Value,WF), |
| 5592 | | normal_closure_not_member(Value,NewParameters,NewPT,Body,WF). |
| 5593 | | |
| 5594 | | not_element_of_special_closure(SC,_X,_WF,Parameters,Types,Body) :- |
| 5595 | | SC \= interval(_,_), |
| 5596 | | SC \= not_member_closure(_,_,_), |
| 5597 | | is_definitely_maximal_closure(Parameters,Types,Body), |
| 5598 | | !, |
| 5599 | | fail. |
| 5600 | | not_element_of_special_closure(_,X,WF,Parameters,Types,Body) :- |
| 5601 | | % falling back to normal test |
| 5602 | ? | normal_closure_not_member(X,Parameters,Types,Body,WF). |
| 5603 | | |
| 5604 | | :- use_module(library(lists),[same_length/2]). |
| 5605 | | |
| 5606 | | normal_closure_not_member(El,Parameters,PT,Cond,WF) :- |
| 5607 | | %hit_profiler:add_profile_hit(closure_not_member(El,Parameters,PT,Cond,WF)), |
| 5608 | | same_length(Parameters,ParValues), |
| 5609 | | convert_list_into_pairs(ParValues,El), |
| 5610 | ? | b_not_test_closure_wf(Parameters,PT,Cond,ParValues,WF). |
| 5611 | | |
| 5612 | | |
| 5613 | | |
| 5614 | | |
| 5615 | | /* -------------------------- */ |
| 5616 | | /* VARIOUS CLOSURE PREDICATES */ |
| 5617 | | /* -------------------------- */ |
| 5618 | | |
| 5619 | | |
| 5620 | | :- use_module(tools,[convert_list_into_pairs/2]). |
| 5621 | | :- use_module(b_interpreter,[b_test_boolean_expression/4, b_not_test_boolean_expression/4]). |
| 5622 | | :- use_module(b_enumerate). |
| 5623 | | |
| 5624 | | :- assert_pre(custom_explicit_sets:expand_closure_to_list(_,_,ClosureBody,_Result,_Done,_,_WF), |
| 5625 | | (nonvar(ClosureBody), |
| 5626 | | bsyntaxtree:check_if_typed_predicate(ClosureBody))). |
| 5627 | | :- assert_post(custom_explicit_sets:expand_closure_to_list(_,_,_,Result,_Done,_,_WF), |
| 5628 | | b_interpreter:value_type(Result)). |
| 5629 | | |
| 5630 | | :- block expand_interval_closure_to_avl(-,?,?), expand_interval_closure_to_avl(?,-,?). |
| 5631 | | expand_interval_closure_to_avl(Low,Up,Result) :- |
| 5632 | | Delta is Up-Low, |
| 5633 | | (Delta>9999 -> perfmessage(expanding_interval(Low,Up)) ; true), |
| 5634 | | construct_interval_ord_list(Low,Up,OL), |
| 5635 | | ord_list_to_avlset_direct(OL,ARes,expand_interval), |
| 5636 | | equal_object(ARes,Result,expand_interval_closure_to_avl). |
| 5637 | | construct_interval_ord_list(Low,Up,Res) :- |
| 5638 | | (Low>Up -> Res = [] |
| 5639 | | ; Res = [int(Low)-true|T], L1 is Low+1, construct_interval_ord_list(L1,Up,T) |
| 5640 | | ). |
| 5641 | | |
| 5642 | | :- block expand_interval_closure_to_list(-,?,?,?), expand_interval_closure_to_list(?,-,?,?). |
| 5643 | | expand_interval_closure_to_list(Low,Up,Result,Done) :- |
| 5644 | | construct_interval_list(Low,Up,OL), |
| 5645 | | equal_object(OL,Result,expand_interval_closure_to_list), |
| 5646 | | Done=true. |
| 5647 | | construct_interval_list(Low,Up,Res) :- |
| 5648 | | (Low>Up -> Res = [] |
| 5649 | | ; Res = [int(Low)|T], L1 is Low+1, construct_interval_list(L1,Up,T) |
| 5650 | | ). |
| 5651 | | |
| 5652 | | expand_closure_to_list([X],[integer],Body,Result,Done,_,_) :- |
| 5653 | ? | is_interval_closure_body(Body,X,Low,Up),!, |
| 5654 | | expand_interval_closure_to_list(Low,Up,Result,Done). |
| 5655 | | expand_closure_to_list(Par,Types,Body,Result,Done,Source,WF) :- |
| 5656 | | expand_normal_closure(Par,Types,Body,CResult,CDone,expand_closure_to_list(Source),WF), |
| 5657 | | expand_if_avl(CResult,Result,CDone,Done,Source), |
| 5658 | | (WF==no_wf_available -> true ; |
| 5659 | | lazy_check_elements(Result,CDone, Par,Types,Body,WF)). |
| 5660 | | |
| 5661 | | % Note: does slow down test 1306 |
| 5662 | | % check that if result variable bound by the outside, before closure expanded, we check that the predicate holds for its elements |
| 5663 | | :- block lazy_check_elements(-,-, ?,?,?,?). |
| 5664 | | lazy_check_elements(Result,CDone, _Par,_Types,_Body,_WF) :- (var(Result) ; nonvar(CDone)),!. |
| 5665 | | lazy_check_elements([H|T],CDone, Par,Types,Body,WF) :- !, |
| 5666 | ? | element_of_closure(H,Par,Types,Body,WF), |
| 5667 | ? | lazy_check_elements(T,CDone, Par,Types,Body,WF). |
| 5668 | | lazy_check_elements(avl_set(A),_CDone, Par,Types,Body,WF) :- !, |
| 5669 | | avl_max(A,X), |
| 5670 | | element_of_closure(X,Par,Types,Body,WF). |
| 5671 | | % TO DO: also check avl_min or even all elements ? |
| 5672 | | lazy_check_elements(_,_,_,_,_,_). |
| 5673 | | |
| 5674 | | %check_valid_avl(AVL,Origin) :- |
| 5675 | | % (nonvar(AVL) -> true |
| 5676 | | % ; add_internal_error('Var avl_set: ', check_valid_avl(AVL,Origin)),fail). |
| 5677 | | |
| 5678 | | :- block expand_if_avl(?,?,-,?,?). |
| 5679 | | expand_if_avl(avl_set(S),Result,_,Done,Source) :- !, % we could transmit a flag to expand_normal_closure so that transform_result_into_set does not expand to avl |
| 5680 | ? | expand_custom_set_to_list2(avl_set(S),Result,Done,_,expand_if_avl(Source),no_wf_available). |
| 5681 | | expand_if_avl(Res,Result,_,Done,Source) :- check_list(Res,expand_if_avl(Source)), |
| 5682 | | equal_object(Res,Result), Done=true. |
| 5683 | | |
| 5684 | | check_list(Res,_) :- nonvar(Res), is_list(Res),!. |
| 5685 | | check_list(Res,Src) :- add_error(Src,'Could not expand to list: ',Res). |
| 5686 | | is_list([]). is_list([_|_]). |
| 5687 | | |
| 5688 | | expand_closure_to_avl_or_list([X],[integer],Body,Result,_CheckTimeouts,_WF) :- |
| 5689 | ? | is_interval_closure_body(Body,X,Low,Up),!, |
| 5690 | | expand_interval_closure_to_avl(Low,Up,Result). |
| 5691 | | %expand_closure_to_avl_or_list(P,T,Body,Result,_WF) :- is_member_closure(P,T,Body,TS,Set), |
| 5692 | | % print(expand_member_closure(P,T,Body,TS,Set)),nl,fail. |
| 5693 | | expand_closure_to_avl_or_list(Par,Types,Body,Result,CheckTimeouts,WF) :- |
| 5694 | | expand_normal_closure(Par,Types,Body,CResult,_Done,CheckTimeouts,WF), |
| 5695 | | kernel_objects:equal_object(Result,CResult,expand_closure_to_avl_or_list). % may convert to AVL, should we wait for _Done? |
| 5696 | | |
| 5697 | | |
| 5698 | | % use WF just for call stack messages; we should not delay creating result |
| 5699 | | expand_closure_to_avl_wf([X],[integer],Body,Result,_WF) :- |
| 5700 | | is_interval_closure_body(Body,X,Low,Up),!, |
| 5701 | | expand_interval_closure_to_avl(Low,Up,Result). % we could pass WF |
| 5702 | | expand_closure_to_avl_wf(Par,Types,Body,Result,WF) :- |
| 5703 | | expand_normal_closure(Par,Types,Body,S,Done,check(expand_closure_to_avl),WF), |
| 5704 | | (ground_value(S) % ground value is sufficient to proceed; we do not need to check Done |
| 5705 | | -> convert_to_avl_inside_set(S,R),equal_object(R,Result,expand_closure_to_avl) |
| 5706 | | ; print(cannot_convert_closure_value_to_avl(closure(Par,Types),done(Done))),nl, |
| 5707 | | translate:print_bexpr(Body),nl,trace, |
| 5708 | | fail). |
| 5709 | | |
| 5710 | | |
| 5711 | | % possible values for CheckTimeouts: check, check_no_inf, no_check, ... |
| 5712 | | % Note: we no longer check is_infinite_explicit_set(closure(Parameters,ParameterTypes,ClosureBody)) |
| 5713 | | % and no longer raise add_closure_warning(Source,Parameters,ParameterTypes,ClosureBody,'### WARNING: expanding infinite comprehension set: ') |
| 5714 | | % and no longer use preference warn_when_expanding_infinite_closures |
| 5715 | | % this is relevant for e.g., test 1291 |
| 5716 | | expand_normal_closure(Parameters,ParameterTypes,ClosureBody,Result,Done,CheckTimeouts,WF) :- |
| 5717 | | expand_normal_closure_memo(CheckTimeouts,Parameters,ParameterTypes,ClosureBody,Result,Done,WF). |
| 5718 | | |
| 5719 | | :- public add_closure_warning_wf/6. |
| 5720 | | add_closure_warning_wf(Source,Parameters,_ParameterTypes,_ClosureBody,_MSG,_WF) :- |
| 5721 | | preference(provide_trace_information,false),preference(strict_raise_warnings,false),!, |
| 5722 | | format('### TIME-OUT raised during closure expansion (~w,~w).~n### set TRACE_INFO preference to TRUE for more details.~n',[Parameters,Source]). |
| 5723 | | add_closure_warning_wf(Source,Parameters,ParameterTypes,ClosureBody,MSG,WF) :- |
| 5724 | | (debug_mode(on) -> Limit = 2500, AvlLim=10 ; Limit = 500, AvlLim=5), |
| 5725 | | preferences:temporary_set_preference(expand_avl_upto,AvlLim,CHNG), |
| 5726 | | call_cleanup(translate:translate_bvalue_with_limit(closure(Parameters,ParameterTypes,ClosureBody),Limit,CT), |
| 5727 | | preferences:reset_temporary_preference(expand_avl_upto,CHNG)), |
| 5728 | | bsyntaxtree:get_texpr_info(ClosureBody,Infos), |
| 5729 | | add_warning_wf(Source,MSG,CT,Infos,WF), debug_print(19,'! infos: '), debug_println(Infos). %,trace. |
| 5730 | | |
| 5731 | | |
| 5732 | | :- use_module(memoization,[is_memoization_closure/4,get_complete_memoization_expansion/6]). |
| 5733 | | |
| 5734 | | % a version of closure expansion which memoizes its results; stored_expansion needs to be cleared when new machine loaded |
| 5735 | | expand_normal_closure_memo(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF) :- |
| 5736 | ? | is_memoization_closure(Parameters,ParameterTypes,ClosureBody,MemoID), |
| 5737 | | !, Span=ClosureBody, |
| 5738 | | % MemoID can be a variable |
| 5739 | | (var(MemoID) -> perfmessage(CHECK,'Getting full value of a memoized function',ClosureBody) ; true), |
| 5740 | | get_complete_memoization_expansion(MemoID,FullResult,Done,Span,expand_normal_closure_memo(CHECK),WF). |
| 5741 | | expand_normal_closure_memo(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF) :- |
| 5742 | | preferences:preference(use_closure_expansion_memoization,false),!, |
| 5743 | | expand_normal_closure2(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF). |
| 5744 | | expand_normal_closure_memo(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF) :- |
| 5745 | | % maybe we should only memo when ClosureWaitVars are ground ? |
| 5746 | | MemoLookupTerm = closure(Parameters,ParameterTypes,ClosureBody), |
| 5747 | | compute_memo_hash(MemoLookupTerm,Hash), |
| 5748 | | % idea: maybe store expansion only on second hit ? |
| 5749 | | (get_stored_memo_expansion(Hash,MemoLookupTerm,StoredResult) |
| 5750 | | -> %print_term_summary(reusing_expansion(Hash,Parameters,ParameterTypes,ClosureBody,StoredResult)),nl, |
| 5751 | | UPV=StoredResult, %state_packing:unpack_value(StoredResult,UPV), |
| 5752 | | FullResult = UPV, Done=true |
| 5753 | | ; %statistics(runtime,[T1,_]), %% |
| 5754 | | expand_normal_closure2(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF), |
| 5755 | | %statistics(runtime,[T2,_]), Time is T2-T1, store_memo_computation_time(Hash,Time), |
| 5756 | | (Done==true/* ,T2-T1>0*/ |
| 5757 | | -> PackedValue=FullResult, %state_packing:pack_value(FullResult,PackedValue), |
| 5758 | | store_memo_expansion(Hash,MemoLookupTerm,PackedValue) |
| 5759 | | ; true) |
| 5760 | | ). |
| 5761 | | |
| 5762 | | |
| 5763 | | expand_normal_closure2(_CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF) :- |
| 5764 | | % TO DO: add more symbolic member closures who have expression computation code |
| 5765 | | is_closure1_value_closure(Parameters,ParameterTypes,ClosureBody,VAL),!, |
| 5766 | | bsets_clp:relational_trans_closure_wf(VAL,FullResult,WF), |
| 5767 | | ground_value_check(FullResult,FRGr), |
| 5768 | | when(nonvar(FRGr),Done=true). |
| 5769 | | expand_normal_closure2(CHECK,Parameters,ParameterTypes,ClosureBody,FullResult,Done,WF) :- |
| 5770 | | % special treatment for lambda closures: Advantage: we don't have to wait for variables in EXPR body of closure |
| 5771 | | % Disadvantage: EXPR only gets evaluated after a solution has been found for args: can mean repeated computations ! |
| 5772 | | % (cf pas_as_env_inv_cv_sui, negated version of !(cv_i).(cv_i : t_cv_pas => closure(%cv_o2.((...|>> {cv_i} : t_cv_pas <-> t_cv_pas) ASSERTION |
| 5773 | | % Advantage: it can solve constraints such as f = %x.(x:1..10|x+y) & f(5)=1005 (finding y without enumeration); see test 1168 |
| 5774 | | \+ preferences:preference(use_smt_mode,false), |
| 5775 | | is_lambda_closure(Parameters,ParameterTypes,ClosureBody, OtherIDs,OtherTypes, DomainPred, EXPR), |
| 5776 | | \+ ground_bexpr(EXPR), % if EXPR is ground, there is nothing to be gained by special treatment here |
| 5777 | | WF \= no_wf_available, % otherwise we may have to enumerate EXPR result leading to choice points, e.g. in phase 0 |
| 5778 | | !, |
| 5779 | | bexpr_variables(DomainPred,ClosureWaitVars), |
| 5780 | | (CHECK=no_check -> TIMEOUTCODE = true ; |
| 5781 | | TIMEOUTCODE = add_closure_warning_wf(CHECK,Parameters,ParameterTypes,ClosureBody, |
| 5782 | | 'TIME-OUT occurred while ProB was expanding: ',WF)), |
| 5783 | | (CHECK=check_no_inf -> VIRTUALTIMEOUTCODE=true ; VIRTUALTIMEOUTCODE=TIMEOUTCODE), |
| 5784 | | delay_setof_check_wf( ParTuple, |
| 5785 | | (custom_explicit_sets:b_test_closure(OtherIDs,OtherTypes,DomainPred,OtherValues,all_solutions,WF), |
| 5786 | | convert_list_into_pairs(OtherValues,ParTuple) |
| 5787 | | % TO DO: compile EXPR when we start expanding the closure: to avoid repeated re-computation of expressions for every instance |
| 5788 | | ), |
| 5789 | | Result, ClosureWaitVars, __Done, |
| 5790 | | TIMEOUTCODE,VIRTUALTIMEOUTCODE,WF,DomainPred), |
| 5791 | | (WF = no_wf_available |
| 5792 | | -> init_wait_flags(WF1,[expansion_context(lambda_function_result,Parameters)]) |
| 5793 | | ; WF1=WF |
| 5794 | | ), |
| 5795 | | evaluate_result_expr(Result,EXPR,OtherIDs,EvResult,EvDone,WF1), |
| 5796 | | when(nonvar(EvDone),( |
| 5797 | | (WF = no_wf_available -> ground_wait_flags(WF1) ; true), |
| 5798 | | kernel_objects:equal_object_wf(EvResult,FullResult,expand_normal_closure2,WF), |
| 5799 | | Done=true)). |
| 5800 | | expand_normal_closure2(no_check,Parameters,ParameterTypes,ClosureBody,Result,Done,WF) :- !, |
| 5801 | | expand_normal_closure_direct(Parameters,ParameterTypes,ClosureBody,Result,Done,WF). |
| 5802 | | expand_normal_closure2(CHECK,Parameters,ParameterTypes,ClosureBody,Result,Done,WF) :- |
| 5803 | | bexpr_variables(ClosureBody,ClosureWaitVars), |
| 5804 | | TIMEOUTCODE = add_closure_warning_wf(CHECK,Parameters,ParameterTypes,ClosureBody, |
| 5805 | | 'TIME-OUT occurred while ProB was expanding: ',WF), |
| 5806 | | (CHECK=check_no_inf -> VIRTUALTIMEOUTCODE=true ; VIRTUALTIMEOUTCODE=TIMEOUTCODE), |
| 5807 | | % Note: delay_setof_check_wf will throw enumeration warning for virtual timeouts, after VIRTUALTIMEOUTCODE |
| 5808 | | delay_setof_check_wf( ParTuple, |
| 5809 | | custom_explicit_sets:test_closure_and_convert(Parameters,ParameterTypes,ClosureBody, ParTuple,WF), |
| 5810 | | Result, ClosureWaitVars, Done, TIMEOUTCODE, VIRTUALTIMEOUTCODE,WF,ClosureBody). |
| 5811 | | |
| 5812 | | expand_normal_closure_direct(Parameters,ParameterTypes,ClosureBody,Result,Done,WF) :- |
| 5813 | | bexpr_variables(ClosureBody,ClosureWaitVars), |
| 5814 | | Span = ClosureBody, |
| 5815 | | delay_setof_wf( ParTuple, |
| 5816 | | % TO DO: refresh waitflag in outer WF store to let pending code run to completion and avoid spurious WD errors ? |
| 5817 | | custom_explicit_sets:test_closure_and_convert(Parameters,ParameterTypes,ClosureBody, ParTuple,WF), |
| 5818 | | Result, ClosureWaitVars, Done,WF, Span). |
| 5819 | | |
| 5820 | | |
| 5821 | | |
| 5822 | | :- block evaluate_result_expr(-,?,?,?,?,?). |
| 5823 | | evaluate_result_expr(avl_set(AVL),EXPR,OtherIDs,Res,Done,WF) :- |
| 5824 | | avl_domain(AVL,R), |
| 5825 | | evaluate_result_expr(R,EXPR,OtherIDs,Res,Done,WF). |
| 5826 | | evaluate_result_expr([],_EXPR,_OtherIDs,[],Done,_WF) :- |
| 5827 | | %ground_wait_flags(WF), |
| 5828 | | Done=true. |
| 5829 | | evaluate_result_expr([ParTuple|T],EXPR,OtherIDs,[FullTuple|ET],Done,WF) :- |
| 5830 | | % same_length(OtherIDs,ParValues), % not necessary |
| 5831 | | set_up_localstate(OtherIDs,ParValues,[],LocalState), |
| 5832 | | convert_list_into_pairs(ParValues,ParTuple), % bind values in ParTuple to LocalState |
| 5833 | | b_interpreter:b_compute_expression(EXPR,LocalState,[],EXPRVALUE,WF), |
| 5834 | | append(ParValues,[EXPRVALUE],FullValues), |
| 5835 | | convert_list_into_pairs(FullValues,FullTuple), |
| 5836 | | evaluate_result_expr(T,EXPR,OtherIDs,ET,Done,WF). |
| 5837 | | |
| 5838 | | :- use_module(bsyntaxtree,[split_names_and_types/3]). |
| 5839 | | :- use_module(probsrc(bsyntaxtree), [def_get_texpr_id/2]). |
| 5840 | | %:- use_module(library(lists),[prefix_length/3, suffix_length/3]). |
| 5841 | | % test a closure and convert into pairs; assume we want all solutions |
| 5842 | | test_closure_and_convert(Parameters,ParameterTypes,ClosureBody, ParTuple, WF) :- |
| 5843 | | is_recursive_closure(Parameters,ParameterTypes,ClosureBody), |
| 5844 | | get_recursive_identifier_of_closure_body(ClosureBody,TRID),!, |
| 5845 | | def_get_texpr_id(TRID,RID), get_texpr_type(TRID,RType), |
| 5846 | | %print(test_recursion(RID)),nl, translate:nested_print_bexpr(ClosureBody),nl, |
| 5847 | | RecVal = closure(Parameters,ParameterTypes,ClosureBody), % Recursive Value added to parameters |
| 5848 | | same_length(Parameters,ParValues), |
| 5849 | | reset_closure_solution_counter(Parameters), |
| 5850 | | b_test_closure([RID|Parameters],[RType|ParameterTypes],ClosureBody,[RecVal|ParValues],all_solutions,WF), |
| 5851 | | convert_sol_list_into_pairs(ParValues,Parameters,ParTuple). % convert tuple without recursive value to ParTuple |
| 5852 | | test_closure_and_convert(Parameters,ParameterTypes,b(exists(EParAndTypes,ClosureBody),pred,OuterInfo), ParTuple, WF) :- |
| 5853 | | % Motivation: enumerating Parameters can be quite inefficient |
| 5854 | | % if for example we have something like {x|#y.(y:SmallSet & x=f(y))} |
| 5855 | | % Problem: the existential quantifier will be delayed until the Parameters are instantiated ! |
| 5856 | | % relevant test: 1162 |
| 5857 | | % Note: this is duplicating to some extent the code in b_test_exists_wo_expansion |
| 5858 | | % However, here we can also apply lambda_closure optimisation in b_test_closure below, this is |
| 5859 | | % relevant for private_examples/2023/.../rule_FICHIER_MRGATKSAATPAR_RVF219_MRGA_DE.mch |
| 5860 | ? | exists_should_be_lifted(Parameters,ParameterTypes,OuterInfo,ClosureBody), |
| 5861 | | split_names_and_types(EParAndTypes,EPar,ETypes), |
| 5862 | | !, |
| 5863 | | % print(' Lifting existential quantifier (i.e., enumerating paras with closure paras): '), print(EPar),nl, |
| 5864 | | % print(outer_paras(Parameters)),nl, |
| 5865 | | % append Parameters at end; in case we have a lambda function |
| 5866 | | append(EPar,Parameters,FullPar), length(Parameters,NrParas), |
| 5867 | | append(ETypes,ParameterTypes,FullTypes), |
| 5868 | | length(EPar,NrExistsParas), |
| 5869 | | length(IrrelevantParas,NrExistsParas), length(Suffix,NrParas), |
| 5870 | | append(IrrelevantParas,Suffix,FullParList), |
| 5871 | | copy_identifier_infos(OuterInfo,ClosureBody,ClosureBody2), |
| 5872 | | reset_closure_solution_counter(Parameters), |
| 5873 | | % bsyntaxtree:check_used_ids_in_ast(ClosureBody2), |
| 5874 | ? | b_test_closure(FullPar,FullTypes,ClosureBody2, FullParList,all_solutions,WF), |
| 5875 | | convert_sol_list_into_pairs(Suffix,Parameters,ParTuple). |
| 5876 | | test_closure_and_convert(Parameters,ParameterTypes,ClosureBody, ParTuple, WF) :- |
| 5877 | | reset_closure_solution_counter(Parameters), |
| 5878 | | % print(test),nl, translate:nested_print_bexpr(ClosureBody),nl, |
| 5879 | | length(Parameters,Len), length(ParValues,Len), |
| 5880 | | %(annotate_exists(Parameters,ParameterTypes,ClosureBody,Body2) -> true ; Body2=ClosureBody), |
| 5881 | ? | b_test_closure(Parameters,ParameterTypes,ClosureBody,ParValues,all_solutions,WF), |
| 5882 | | convert_sol_list_into_pairs(ParValues,Parameters,ParTuple). % ,print(solution(ParTuple)),nl,nl. |
| 5883 | | |
| 5884 | | % Lifting existential quantifier was previously done here, but was duplicating code in b_test_exists_wo_expansion |
| 5885 | | % we now simply generate the allow_to_lift_exists annotation here and let b_test_exists_wo_expansion do its job |
| 5886 | | %annotate_exists(Parameters,ParameterTypes, |
| 5887 | | % b(exists(EParAndTypes,ClosureBody),pred,OuterInfo), |
| 5888 | | % b(exists(EParAndTypes,ClosureBody),pred,[allow_to_lift_exists|OuterInfo])) :- |
| 5889 | | % exists_should_be_lifted(Parameters,ParameterTypes,OuterInfo,ClosureBody). |
| 5890 | | |
| 5891 | | % check if a top-level exists with body ExistsClosureBody should be lifted |
| 5892 | | % within a closure with paras Parameters of type ParameterTypes: |
| 5893 | | exists_should_be_lifted(Parameters,ParameterTypes,OuterInfo,ExistsClosureBody) :- |
| 5894 | | (Parameters == ['_was_lambda_result_'] % here we are quite sure that we gain by this optimisation |
| 5895 | ? | ; member(allow_to_lift_exists,OuterInfo) % parameters were originally from a set comprehension, |
| 5896 | | % see test 306: in this case existential quantifier is lifted in b_interpreter anyway; |
| 5897 | | % Note we counter the rewrite ran({x1,...xn|P}) ---> {xn| #(x1,...).(P)} and similarly for dom({...}) |
| 5898 | | ; ExistsClosureBody = b(member(_,_),_,_) % we have a simple projection closure |
| 5899 | | % TO DO: maybe support other ones as well |
| 5900 | ? | ; basic_type_list_cardinality(ParameterTypes,Card), |
| 5901 | | (Card=inf -> true ; Card>10000) |
| 5902 | | % if here are only a few parameter values: do not lift existential quantified variables |
| 5903 | | ). |
| 5904 | | |
| 5905 | | % we need to copy important infos about the outer Parameters to ClosureBody |
| 5906 | | copy_identifier_infos(Info,b(InnerPred,T,II),b(InnerPred,T,II2)) :- |
| 5907 | | findall(I,identifier_info(I,Info),ToCopy), |
| 5908 | | append(ToCopy,II,II2). |
| 5909 | | identifier_info(I,Info) :- I=prob_annotation('DO_NOT_ENUMERATE'(ID)), |
| 5910 | ? | member(I,Info), ID \= '$$NONE$$'. |
| 5911 | | |
| 5912 | | convert_sol_list_into_pairs(ParaValues,Parameters,ParTuple) :- |
| 5913 | | convert_list_into_pairs(ParaValues,ParTuple), |
| 5914 | | update_closure_solution_counter(Parameters,ParTuple). |
| 5915 | | |
| 5916 | | :- if(environ(prob_debug_flag,true)). |
| 5917 | | :- dynamic closure_solution_counter/3. |
| 5918 | | % debugging long expansions of comprehension_set / closures |
| 5919 | | reset_closure_solution_counter(Parameters) :- retractall(closure_solution_counter(Parameters,_,_)). |
| 5920 | | |
| 5921 | | update_closure_solution_counter(Parameters,ParTuple) :- |
| 5922 | | retract(closure_solution_counter(Parameters,OldCount,OldTime)),!, |
| 5923 | | statistics(walltime,[W2,_]), Delta is W2-OldTime, |
| 5924 | | NewCount is OldCount+1, |
| 5925 | | ((Delta > 5000 ; NewCount mod 1000 =:= 0) |
| 5926 | | -> format('--> Solution ~w for expansion of closure ~w (delta ~w ms): ',[NewCount,Parameters,Delta]), |
| 5927 | | translate:print_bvalue(ParTuple),nl, |
| 5928 | | assert(closure_solution_counter(Parameters,NewCount,W2)) |
| 5929 | | ; assert(closure_solution_counter(Parameters,NewCount,OldTime)) |
| 5930 | | ). |
| 5931 | | update_closure_solution_counter(Parameters,_ParTuple) :- |
| 5932 | | statistics(walltime,[W2,_]), |
| 5933 | | assert(closure_solution_counter(Parameters,1,W2)). |
| 5934 | | :- else. |
| 5935 | | reset_closure_solution_counter(_). |
| 5936 | | update_closure_solution_counter(_,_). |
| 5937 | | :- endif. |
| 5938 | | |
| 5939 | | |
| 5940 | | |
| 5941 | | % compute cardinality of a list of basic types |
| 5942 | | basic_type_list_cardinality([],1). |
| 5943 | | basic_type_list_cardinality([BasicType|T],Res) :- |
| 5944 | | basic_type_list_cardinality(T,TCard), |
| 5945 | | (TCard=inf -> Res=inf |
| 5946 | ? | ; kernel_objects:max_cardinality(BasicType,Card), |
| 5947 | | safe_mul(Card,TCard,Res) |
| 5948 | | ). |
| 5949 | | |
| 5950 | | % for lambda closures we can set up a second waitflag for the expression and only ground it when body enumeration finished |
| 5951 | | % idea is to avoid perturbation of constraint solving of main closure predicate by lambda expression, see test 1737 |
| 5952 | | % something like %(x,y).(x:1..200 & y:1..100 & y+x<259 & y*x>10|(y+x*x+y) mod 100) is faster |
| 5953 | | % this is slower : %(x,y).(x:1..200 & y:1..100 |(y+x*x+y)) |
| 5954 | | % currently this slows down test 1336 |
| 5955 | | :- block b_test_closure(?,?,-,?,?,?). |
| 5956 | | b_test_closure(Parameters,ParameterTypes,ClosureBody, FullParValues, NegationContext, OuterWF) :- |
| 5957 | | (preference(data_validation_mode,true) |
| 5958 | | -> true % avoids ineraction between domain and range expression enumeration; see |
| 5959 | | % private_examples/ClearSy/2019_May/perf_3264/rule_186.mch or |
| 5960 | | % computation of 631 ic___DMI_MRGATKSAAT___Parametre_Identifiant_indices_function in rule_FICHIER_MRGATKSAATPAR_RVF219_MRGA_DE.mch |
| 5961 | | % however, as b_optimize below does *not* evaluate nested set comprehensions, there can be a slowdown: |
| 5962 | | % the nested set comprehension gets re-evaluated for every soluiton of the lambda parameters ! |
| 5963 | | % this was the case of private_examples/ClearSy/2019_Nov/rule_Regle_31C_0005/rule.mch before using SORT |
| 5964 | | ; \+ preferences:preference(use_smt_mode,false)), % TO DO: enable in normal mode when performance of 1336 fixed |
| 5965 | | % print(test_closure(Parameters,FullParValues)),nl, |
| 5966 | | is_lambda_closure(Parameters,ParameterTypes,ClosureBody, OtherIDs,OtherTypes, DomainPred, EXPR), |
| 5967 | | % TO DO: detect not only equalities at end, but any equality which is irrelevant for the rest |
| 5968 | | % nl,print(lambda_closure(OtherIDs)),nl, translate:print_bexpr(EXPR),nl, |
| 5969 | | append(ParValues,[LambdaResult],FullParValues), |
| 5970 | | !, |
| 5971 | | get_texpr_info(ClosureBody,BInfo), |
| 5972 | ? | b_interpreter:set_up_typed_localstate2(OtherIDs,OtherTypes,BInfo,ParValues,TypedVals,[],LocalState,NegationContext), |
| 5973 | | simplify_span(ClosureBody,BSpan), % sometimes BInfo no longer contains a position info, but first_sub_expr does |
| 5974 | | init_quantifier_wait_flag(OuterWF,comprehension_set(NegationContext),OtherIDs,ParValues,BSpan,WF), |
| 5975 | | b_test_boolean_expression(DomainPred,LocalState,[],WF), |
| 5976 | | %print('PRED: '),translate:print_bexpr(ClosureBody),nl, |
| 5977 | | b_tighter_enumerate_values_in_ctxt(TypedVals,DomainPred,WF), % also does: project_away_useless_enumeration_values |
| 5978 | | init_quantifier_wait_flag(OuterWF,comprehension_set(NegationContext),OtherIDs,ParValues,BSpan,WF2), |
| 5979 | | b_compiler:b_optimize(EXPR,[],LocalState,[],CEXPR,WF), % already pre-compile lookup, without constraint processing; is not sufficient for test 1336 |
| 5980 | ? | ground_wait_flags(WF), % TODO: also call ground inner WF in context |
| 5981 | | b_interpreter:b_compute_expression(CEXPR,LocalState,[],LambdaResult,WF2), |
| 5982 | | ground_inner_wait_flags_in_context(NegationContext,WF2). |
| 5983 | | b_test_closure(Parameters,ParameterTypes,ClosureBody,ParValues,NegationContext, OuterWF) :- |
| 5984 | | % tools:print_bt_message(b_test_closure_testing_closure(Parameters,ParValues)), %% |
| 5985 | | get_texpr_info(ClosureBody,BInfo), |
| 5986 | ? | b_interpreter:set_up_typed_localstate2(Parameters,ParameterTypes,BInfo, |
| 5987 | | ParValues,TypedVals,[],LocalState,NegationContext), |
| 5988 | | % print_message(b_interpreter:b_test_boolean_expression(ClosureBody,LocalState,[],WF)), |
| 5989 | | simplify_span(ClosureBody,BSpan), % sometimes BInfo no longer contains a position info, but first_sub_expr does |
| 5990 | | init_quantifier_wait_flag(OuterWF,comprehension_set(NegationContext),Parameters,ParValues,BSpan,WF), |
| 5991 | | %external_functions:observe_parameters(Parameters,LocalState), %% |
| 5992 | ? | b_test_boolean_expression(ClosureBody,LocalState,[],WF), |
| 5993 | | % tools:print_bt_message(tested_bool_expr), translate:print_bexpr(ClosureBody),nl, |
| 5994 | | b_enumerate:b_tighter_enumerate_values_in_ctxt(TypedVals,ClosureBody,WF), % also detects useless enumeration ids |
| 5995 | ? | ground_inner_wait_flags_in_context(NegationContext,WF). |
| 5996 | | |
| 5997 | | |
| 5998 | | |
| 5999 | | :- block b_not_test_closure_wf(?,?,?,-,?). |
| 6000 | | b_not_test_closure_wf(Parameters,ParameterTypes,Closure,ParValues,WF) :- |
| 6001 | | % same_length(Parameters,ParValues), % not necessary |
| 6002 | | set_up_localstate(Parameters,ParValues,[],LocalState), |
| 6003 | | b_enumerate:b_type_values_in_store(Parameters,ParameterTypes,LocalState), |
| 6004 | ? | b_not_test_boolean_expression(Closure,LocalState,[],WF), |
| 6005 | | get_last_wait_flag(b_not_test_closure_wf(Parameters),WF,WF2), |
| 6006 | | get_texpr_info(Closure,Infos), |
| 6007 | | b_not_test_closure_enum(Parameters,ParameterTypes,Infos,LocalState,WF,WF2). |
| 6008 | | |
| 6009 | | :- block b_not_test_closure_enum(-,?,?,?,?,?). |
| 6010 | | b_not_test_closure_enum(Parameters,ParameterTypes,Infos,LocalState,WF,WF2) :- |
| 6011 | | b_enumerate:b_extract_typedvalc(Parameters,ParameterTypes,Infos,LocalState,TypedVals), |
| 6012 | | (var(WF2) -> ground_typedvals_check(TypedVals,GrVals) ; true), |
| 6013 | | b_not_test_closure_enum_aux(GrVals,WF2,TypedVals,WF). |
| 6014 | | |
| 6015 | | :- block b_not_test_closure_enum_aux(-,-,?,?). |
| 6016 | | b_not_test_closure_enum_aux(_,_,TypedVals,WF) :- |
| 6017 | | b_enumerate:b_tighter_enumerate_all_values(TypedVals,WF). |
| 6018 | | % , print(finished_enum(Parameters)),nl. |
| 6019 | | |
| 6020 | | |
| 6021 | | :- use_module(library(terms)). |
| 6022 | | % check whether a VARIABLE occurs inside a closure |
| 6023 | | closure_occurs_check(VARIABLE,_Par,_ParTypes,ClosureBody) :- expression_contains_setvar(ClosureBody,VARIABLE). |
| 6024 | | % /* occurs check; x = closure1(x) ; for other closures this cannot happen ???!!! TO DO: Check */ |
| 6025 | | % custom_explicit_sets:is_closure1_value_closure(Par,ParTypes,ClosureBody,Val), |
| 6026 | | % contains_var(VARIABLE,Val). |
| 6027 | | |
| 6028 | | expression_contains_setvar(b(E,_,_),Variable) :- !, |
| 6029 | | expression_contains_setvar_aux(E,Variable). |
| 6030 | | expression_contains_setvar(E,V) :- add_internal_error('Illegal Expression: ', expression_contains_setvar(E,V)), |
| 6031 | | contains_var(V,E). |
| 6032 | | |
| 6033 | | expression_contains_setvar_aux(value(Val),Variable) :- !,value_contains_setvar(Val,Variable). |
| 6034 | | % a few very common cases for performance; currently this predicate is often called for recursive functions |
| 6035 | | expression_contains_setvar_aux(identifier(_),_) :- !,fail. |
| 6036 | | expression_contains_setvar_aux(equal(A,B),Variable) :- !, |
| 6037 | | (expression_contains_setvar(A,Variable) -> true ; expression_contains_setvar(B,Variable)). |
| 6038 | | expression_contains_setvar_aux(conjunct(A,B),Variable) :- !, |
| 6039 | | (expression_contains_setvar(A,Variable) -> true ; expression_contains_setvar(B,Variable)). |
| 6040 | | expression_contains_setvar_aux(function(A,B),Variable) :- !, |
| 6041 | | (expression_contains_setvar(A,Variable) -> true ; expression_contains_setvar(B,Variable)). |
| 6042 | | expression_contains_setvar_aux(union(A,B),Variable) :- !, |
| 6043 | | (expression_contains_setvar(A,Variable) -> true ; expression_contains_setvar(B,Variable)). |
| 6044 | | expression_contains_setvar_aux(couple(A,B),Variable) :- !, |
| 6045 | | (expression_contains_setvar(A,Variable) -> true ; expression_contains_setvar(B,Variable)). |
| 6046 | | % the rest via safe_syntaxelement: |
| 6047 | | expression_contains_setvar_aux(Expr,V) :- |
| 6048 | | safe_syntaxelement_det(Expr,Subs,_Names,_,_),!, |
| 6049 | ? | member(Sub,Subs), expression_contains_setvar(Sub,V),!. |
| 6050 | | expression_contains_setvar_aux(E,V) :- add_internal_error('Illegal Expression: ', expression_contains_setvar_aux(E,V)), |
| 6051 | | contains_var(V,E). |
| 6052 | | |
| 6053 | | value_contains_setvar(Val,V) :- var(Val),!,Val==V. |
| 6054 | | value_contains_setvar(avl_set(_),_V) :- !, fail. % assume avl_set always properly grounded; avoid looking inside |
| 6055 | | value_contains_setvar(closure(_,_,Body),V) :- !, |
| 6056 | | expression_contains_setvar(Body,V). |
| 6057 | | value_contains_setvar(int(_),_) :- !,fail. % we check for set variables |
| 6058 | | value_contains_setvar(global_set(_),_) :- !,fail. % we check for set variables |
| 6059 | | value_contains_setvar(freetype(_),_) :- !,fail. % we check for set variables |
| 6060 | | value_contains_setvar(freeval(_ID,_Case,Val),V) :- !, value_contains_setvar(Val,V). |
| 6061 | | value_contains_setvar(string(_),_) :- !,fail. % we check for set variables |
| 6062 | | value_contains_setvar(fd(_,_),_) :- !,fail. % we check for set variables |
| 6063 | | value_contains_setvar((A,B),V) :- !, (value_contains_setvar(A,V) ; value_contains_setvar(B,V)). |
| 6064 | | value_contains_setvar([A|B],V) :- !, (value_contains_setvar(A,V) ; value_contains_setvar(B,V)). |
| 6065 | | value_contains_setvar(Val,V) :- |
| 6066 | | contains_var(V,Val). |
| 6067 | | |
| 6068 | | % ------------------ |