| 1 | | % (c) 2009-2023 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
| 2 | | % Heinrich Heine Universitaet Duesseldorf |
| 3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
| 4 | | |
| 5 | | :- module(b_global_sets, |
| 6 | | [b_get_global_constants/1, b_get_enumerated_set_constants/1, |
| 7 | | b_get_global_enumerated_sets/1, b_get_global_sets/1, |
| 8 | | lookup_global_constant/2, |
| 9 | | is_b_global_constant/3, |
| 10 | | is_b_global_constant_hash/3, % a variation with indexing of first two args |
| 11 | | is_used_b_global_constant/3, is_unused_b_global_constant/2, |
| 12 | | |
| 13 | | b_global_set/1, b_non_empty_global_set/1, b_empty_global_set/1, |
| 14 | | b_global_deferred_set/1, |
| 15 | | b_global_set_with_potential_symmetry/1, b_global_deferred_set_with_card_gt1/1, |
| 16 | | b_partially_deferred_set/1, |
| 17 | | |
| 18 | | enumerated_set/1, |
| 19 | | unfixed_deferred_set/1, unfixed_deferred_set_exists/0, |
| 20 | | fixed_deferred_set_size/2, |
| 21 | | provably_finite_global_set/1, infinite_global_set/1, |
| 22 | | contains_unfixed_deferred_set/1, contains_unfixed_deferred_set/2, |
| 23 | | b_supplementary_global_set/1, % introduced when untyped ids are allowed |
| 24 | | |
| 25 | | inferred_minimum_global_set_cardinality/2, |
| 26 | | inferred_maximum_global_set_cardinality/2, |
| 27 | | b_exists_global_set_with_potential_symmetry/0, |
| 28 | | b_global_set_cardinality/2, |
| 29 | | |
| 30 | | b_clear_global_set_type_definitions/0, |
| 31 | | |
| 32 | | % three phases of precompilation: |
| 33 | | b_check_and_precompile_enumerated_sets/0, |
| 34 | | b_check_and_precompile_deferred_sets/0, |
| 35 | | b_check_and_precompile_global_set_symmetry/0, |
| 36 | | % can be called before precompilation: |
| 37 | | register_enumerated_sets/2, |
| 38 | | |
| 39 | | b_get_prob_deferred_set_elements/2, |
| 40 | | add_prob_deferred_set_elements_to_store/3, |
| 41 | | inline_prob_deferred_set_elements_into_bexpr/2, |
| 42 | | prob_deferred_set_element/4, |
| 43 | | |
| 44 | | find_inequal_global_set_identifiers/4, |
| 45 | | static_symmetry_reduction_for_global_sets/1, |
| 46 | | |
| 47 | | b_integer_set/1, b_integer_or_real_or_string_set/1, b_integer_or_real_set/1, |
| 48 | | b_type2_set/2, try_b_type2global_set/2, |
| 49 | | |
| 50 | | %b_fd_type/3, |
| 51 | | b_get_fd_type_bounds/3, |
| 52 | | b_fd_card/2, |
| 53 | | is_global_set_of_cardinality_one/2, %is_global_set_of_cardinality_two/3, |
| 54 | | global_type/2, global_type_wf/3, |
| 55 | | get_global_type_value/3, |
| 56 | | enum_global_type_limited/2, enumerate_global_type_with_enum_warning/4, |
| 57 | | |
| 58 | | all_elements_of_type/2, all_elements_of_type_wf/3, |
| 59 | | all_elements_of_type_rand_wf/3, |
| 60 | | |
| 61 | | set_user_defined_scope/2, get_user_defined_scope/4, |
| 62 | | |
| 63 | | generate_fresh_supplementary_global_set/1, |
| 64 | | register_replaced_global_set/2, b_replaced_global_set/2, |
| 65 | | %,add_global_set_with_named_constants/2 /* for use by Z,... */ |
| 66 | | list_contains_unfixed_deferred_set_id/1 |
| 67 | | ]). |
| 68 | | |
| 69 | | :- use_module(debug). |
| 70 | | :- use_module(tools). |
| 71 | | :- use_module(library(lists)). |
| 72 | | :- use_module(library(ordsets)). |
| 73 | | :- use_module(self_check). |
| 74 | | :- use_module(preferences). |
| 75 | | :- use_module(error_manager). |
| 76 | | :- use_module(bsyntaxtree). |
| 77 | | :- use_module(library(between),[between/3]). |
| 78 | | :- use_module(gensym,[gensym/2]). |
| 79 | | |
| 80 | | :- use_module(module_information,[module_info/2]). |
| 81 | | :- module_info(group,kernel). |
| 82 | | :- module_info(description,'This module provides support for deferred/enumerated set elements in B.'). |
| 83 | | |
| 84 | | :- use_module(bmachine,[b_get_properties_from_machine/1, |
| 85 | | b_get_machine_constants/1, b_get_machine_variables/1, |
| 86 | | b_get_named_machine_set/2, b_get_machine_set/1, |
| 87 | | b_get_all_used_identifiers/1, % required for symmetry-related infos |
| 88 | | b_get_disjoint_constants_of_type/3, |
| 89 | | b_extract_values_clause_assignment/3, |
| 90 | | b_get_typed_definition/3, b_get_machine_setscope/2]). |
| 91 | | |
| 92 | | /* what we call global sets here usually called "given sets", which can be |
| 93 | | either enumerated or deferred */ |
| 94 | | |
| 95 | | |
| 96 | | :- dynamic b_global_constant/3. % named element of a deferred or enumerated set |
| 97 | | % for enumerated sets S = {a,b,c} we would have entries a,b,c as b_global_constant |
| 98 | | % for deferred set S, we may add CONSTANTS which are element of S as b_global_constant |
| 99 | | :- dynamic used_b_global_constant/3. |
| 100 | | |
| 101 | | :- dynamic inferred_minimum_global_set_cardinality/2. |
| 102 | | :- dynamic inferred_maximum_global_set_cardinality/2. |
| 103 | | |
| 104 | | %% b_get_global_enumerated_sets(-GSets). |
| 105 | | % Returns all fully and partially enumerated sets. |
| 106 | | b_get_global_enumerated_sets(GSets) :- |
| 107 | | findall(GS, (b_global_set(GS), \+ b_global_deferred_set(GS)), GSets). |
| 108 | | b_get_global_sets(GSets) :- |
| 109 | | findall(GS, b_global_set(GS), GSets). |
| 110 | | |
| 111 | | b_get_global_constants(Csts) :- findall(Cst,is_b_global_constant(_,_,Cst),Csts). |
| 112 | | % only get those elements that have been explicitly marked as enumerated; excludes partially enumerated sets. |
| 113 | | b_get_enumerated_set_constants(Csts) :- findall(Cst,(enumerated_set(Set),is_b_global_constant(Set,_,Cst)),Csts). |
| 114 | | |
| 115 | | % getting named elements of SETS: |
| 116 | ? | is_b_global_constant(Set,Nr,Cst) :- b_global_constant(Set,Nr,Cst). |
| 117 | | |
| 118 | | :- use_module(library(terms),[term_hash/2]). |
| 119 | | % efficient indexing if both GS and X are known, useful for large global sets |
| 120 | | is_b_global_constant_hash(GS,Nr,Name) :- |
| 121 | | term_hash(fd(Nr,GS),Hash), b_global_constant_hash(Hash,GS,Nr,Name). |
| 122 | | |
| 123 | | is_unused_b_global_constant(Set,Nr) :- |
| 124 | | b_get_fd_type_bounds_limited(Set,Low,Up), |
| 125 | ? | between(Low,Up,Nr), |
| 126 | | \+ used_b_global_constant(Set,Nr,_). |
| 127 | | is_used_b_global_constant(Set,Nr,Cst) :- |
| 128 | | used_b_global_constant(Set,Nr,Cst). |
| 129 | | |
| 130 | | b_get_fd_type_bounds_limited(GlobalSet,Low,UpLimited) :- |
| 131 | | b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 132 | | (Up=inf -> add_message(b_global_sets,'Limiting infinite deferred set elements to 999: ',GlobalSet), |
| 133 | | UpLimited=999 |
| 134 | | ; UpLimited=Up). |
| 135 | | |
| 136 | | :- dynamic lookup_global_constant/2, b_global_constant_hash/4. |
| 137 | | %lookup_global_constant(Id,Val) :- |
| 138 | | % b_global_constant(Set,Nr,Id), % not an indexed lookup ; now we assert lookup_global_constant below |
| 139 | | % Val = fd(Nr,Set). |
| 140 | | |
| 141 | | |
| 142 | | :- dynamic b_precompiled_global_set/1. |
| 143 | | b_precompiled_global_set(_) :- print_error('*** b_global_set not precompiled'),fail. |
| 144 | | |
| 145 | ? | b_global_set(GS) :- b_precompiled_global_set(GS) ; b_supplementary_global_set(GS). |
| 146 | | |
| 147 | | % a version of b_global_set which does not leave a trailing choice point for b_supplementary_global_set around |
| 148 | | % has to be called with GS ground |
| 149 | | %b_global_set_ground(GS) :- if(b_precompiled_global_set(GS),true,b_supplementary_global_set(GS)). |
| 150 | | |
| 151 | | % Does not contain partially enumerated sets. |
| 152 | | b_global_deferred_set(GS) :- |
| 153 | ? | b_global_set(GS), |
| 154 | | \+ is_b_global_constant(GS,_Nr,_Cst). % note : some deferred sets are translated into partially_deferred_set |
| 155 | | |
| 156 | | % either an enumerated set with unused constants or a deferred set where some constants were lifted into the deferred set |
| 157 | | b_partially_deferred_set(GS) :- |
| 158 | | b_global_set(GS), |
| 159 | | (is_b_global_constant(GS,_Nr,_Cst) -> true), % GS is in principle enumerated |
| 160 | | (is_unused_b_global_constant(GS,_X) -> true). |
| 161 | | |
| 162 | | |
| 163 | | b_global_set_with_potential_symmetry(GS) :- |
| 164 | ? | b_global_set(GS), |
| 165 | ? | (b_global_deferred_set_with_card_gt1(GS) -> true |
| 166 | | ; (is_unused_b_global_constant(GS,X), |
| 167 | | is_unused_b_global_constant(GS,Y), |
| 168 | | X\=Y -> true % At least two unused constants exist |
| 169 | | ; fail)). |
| 170 | | |
| 171 | | b_global_deferred_set_with_card_gt1(GS) :- |
| 172 | ? | b_global_deferred_set(GS), |
| 173 | | extract_setsize_from_machine_cache(GS,Low,Up), |
| 174 | | inf_greater(Up,Low). |
| 175 | | |
| 176 | | inf_greater(X,Y) :- (X=inf -> integer(Y) ; X>Y). |
| 177 | | inf_add(X,Y,XY) :- (X=inf -> XY=inf ; Y=inf -> XY=inf ; XY is X+Y). |
| 178 | | |
| 179 | | :- volatile b_exists_global_set_with_potential_symmetry/0. |
| 180 | | :- dynamic b_exists_global_set_with_potential_symmetry/0. |
| 181 | | :- dynamic precompilation_phase/1. |
| 182 | | |
| 183 | | % ------------------------------------------- |
| 184 | | |
| 185 | | % Phase 1 of precompilation: |
| 186 | | b_check_and_precompile_enumerated_sets :- |
| 187 | | b_reset_global_set_type_definitions, |
| 188 | | retractall(b_exists_global_set_with_potential_symmetry), |
| 189 | | retractall(precompilation_phase(_)), |
| 190 | | assertz(precompilation_phase(1)), |
| 191 | | debug_println(9,'Preprocessing enumerated sets: '), |
| 192 | | debug_print(9,'% '), |
| 193 | | b_get_named_machine_set(Set,_Els), % treat enumerated sets first; their cardinality is obvious |
| 194 | | precompile_global_set(Set), % will only require b_get_named_machine_set/2 from bmachine |
| 195 | | fail. |
| 196 | | b_check_and_precompile_enumerated_sets :- |
| 197 | | retractall(precompilation_phase(_)), |
| 198 | | assertz(precompilation_phase(2)), |
| 199 | | debug_nl(9). |
| 200 | | |
| 201 | | % Phase 2 of precompilation: |
| 202 | | b_check_and_precompile_deferred_sets :- |
| 203 | | (deferred_sets_precompiled |
| 204 | | -> add_internal_error('Deferred sets already precompiled',b_check_and_precompile_deferred_sets) |
| 205 | | ; enumerated_sets_precompiled -> true |
| 206 | | ; add_internal_error('Enumerated sets not yet precompiled',b_check_and_precompile_deferred_sets)), |
| 207 | | retractall(precompilation_phase(_)), |
| 208 | | assertz(precompilation_phase(3)), |
| 209 | | check_enumerated_set_scope(_), |
| 210 | | fail. |
| 211 | | b_check_and_precompile_deferred_sets :- |
| 212 | | debug_println(9,'Inferring cardinality and disjoint elements of deferred sets: '), |
| 213 | | debug_print(9,'% '), |
| 214 | ? | b_get_machine_set(Set), |
| 215 | | \+ b_get_named_machine_set(Set,_), % not enumerated |
| 216 | | precompile_global_set(Set), |
| 217 | | fail. |
| 218 | | b_check_and_precompile_deferred_sets :- |
| 219 | | retractall(precompilation_phase(_)), |
| 220 | | assertz(precompilation_phase(4)), |
| 221 | | debug_nl(9). |
| 222 | | |
| 223 | | enumerated_sets_precompiled :- precompilation_phase(X), X >= 2. |
| 224 | | deferred_sets_precompiled :- precompilation_phase(X), X >= 4. |
| 225 | | |
| 226 | | precompile_global_set(Set) :- |
| 227 | | add_new_global_set(Set), |
| 228 | ? | (b_extract_fd_type(Set,LowBnd,UpBnd) /* also computes & caches the size of the SET */ |
| 229 | | -> debug_print(9,' '),debug_print(9,Set), |
| 230 | | debug_print(9,'=='),debug_print(9,LowBnd),debug_print(9,'..'),debug_print(9,UpBnd) |
| 231 | | ; add_internal_error('No b_extract_fd_type/3 solution for global set: ',b_extract_fd_type(Set,_,_)) |
| 232 | | ),debug_print(9,' '). |
| 233 | | |
| 234 | | % check if there are any conflicts between scope annotations and enumerated set |
| 235 | | check_enumerated_set_scope(GlobalSetName) :- |
| 236 | | enumerated_set(GlobalSetName), |
| 237 | | extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound), |
| 238 | | (get_user_defined_scope(GlobalSetName,DL,DU,Span), |
| 239 | | DU-DL =\= UpBound-LowBound |
| 240 | | -> UserSize is 1+DU-DL, |
| 241 | | EnumSize is 1+UpBound-LowBound, |
| 242 | | ajoin(['Conflict between cardinality of scope_',GlobalSetName, |
| 243 | | ' DEFINITION (',UserSize,') and enumeration (',EnumSize,') of SET:'],Msg), |
| 244 | | add_error(extract_setsize_from_machine,Msg,GlobalSetName,Span) |
| 245 | | ; true |
| 246 | | ). |
| 247 | | |
| 248 | | :- use_module(library(avl),[avl_fetch/2]). |
| 249 | | % Phase 3 of precompilation: |
| 250 | | % This can be done after bmachine pre-compile is finished |
| 251 | | b_check_and_precompile_global_set_symmetry :- |
| 252 | | (retract(precompilation_phase(4)) -> true |
| 253 | | ; add_internal_error('Deferred sets not yet precompiled',b_check_and_precompile_global_set_symmetry)), |
| 254 | | assertz(precompilation_phase(5)), |
| 255 | | find_all_used_enumerated_elements(UsedEnumsAVL), |
| 256 | ? | b_extract_fd_type(GS,_Low,_Up), |
| 257 | | (is_b_global_constant(GS,_Nr,_Cst) -> true), % GS is in principle enumerated |
| 258 | | (user_forced_symmetry(GS) |
| 259 | | -> print('FORCING SYMMETRY: '), print(GS), print(' '), |
| 260 | | fail % not asserting used_b_global_constant; every constant becomes "virtually" unused |
| 261 | | ; true |
| 262 | | ), |
| 263 | | is_b_global_constant_hash(GS,X,Name), |
| 264 | | avl_fetch(Name,UsedEnumsAVL), |
| 265 | | assertz(used_b_global_constant(GS,X,deferred)), % by storing that it is not used, we enable symmetry reduction |
| 266 | | debug_println(9,used_b_global_constant(GS:Name)), |
| 267 | | fail. |
| 268 | | b_check_and_precompile_global_set_symmetry :- %print(precomp_gs_3), debug:nl_time, |
| 269 | ? | (b_global_set_with_potential_symmetry(_) |
| 270 | | -> assertz(b_exists_global_set_with_potential_symmetry), |
| 271 | | debug_println(9,'% Symmetry is potentially useful for this machine') |
| 272 | | ; true), |
| 273 | | debug_nl(9), |
| 274 | | /* clean up: */ |
| 275 | | reset_global_set_user_defined_scope. |
| 276 | | |
| 277 | | % ------------------------------------------- |
| 278 | | |
| 279 | | % peform MACE style static symmetry reduction for those global constants |
| 280 | | % that have not already been fixed |
| 281 | | % e.g., for constants aa,bb,cc,dd of type ID and bb/=cc --> nrs of bb,cc will be fixed as 1 and 2; we will ensure that numbers of aa:1..3 and dd:1..4 and that dd=4 only if aa=3 |
| 282 | | |
| 283 | | static_symmetry_reduction_for_global_sets(_ConstantsState) :- |
| 284 | | get_preference(use_solver_on_load,kodkod),!. % no idea which numbering Kodkod might return/expect ?! |
| 285 | | static_symmetry_reduction_for_global_sets(_ConstantsState) :- |
| 286 | | get_preference(use_static_symmetry_detection,false),!. |
| 287 | | static_symmetry_reduction_for_global_sets(ConstantsState) :- |
| 288 | | findall(gs_info(GS,FirstAvailableNewIdx,Low,Up,Other), |
| 289 | | static_symmetry_reduction_possible(GS,FirstAvailableNewIdx,Low,Up,Other),L), |
| 290 | | maplist(perform_static_symmetry_reduction(ConstantsState),L). |
| 291 | | |
| 292 | | :- use_module(static_symmetry_reduction,[static_symmetry_reduction_possible/5, perform_ssr/8]). |
| 293 | | perform_static_symmetry_reduction(ConstantsState,gs_info(GS,First,Low,Up,Other)) :- |
| 294 | | if(perform_ssr(Other,[],First,First,GS,Low,Up,ConstantsState),true, |
| 295 | | add_internal_error('Call failed: ',perform_ssr(Other,[],First,First,GS,Low,Up,ConstantsState))). |
| 296 | | |
| 297 | | |
| 298 | | |
| 299 | | % -------------------- |
| 300 | | |
| 301 | | |
| 302 | | :- use_module(avl_tools,[ord_domain_list_to_avl/2]). |
| 303 | | find_all_used_enumerated_elements(ElementsAVL) :- |
| 304 | | b_get_all_used_identifiers(Identifiers), |
| 305 | | b_get_machine_variables(TVariables),get_texpr_ids(TVariables,Variables), |
| 306 | | % We assume that b_get_all_used_identifiers/1 is a proper ordset. (sorted with sort/2) |
| 307 | | % As an optimisation, we remove the variables, they cannot be enumerated elements. |
| 308 | | list_to_ord_set(Variables,OVariables), |
| 309 | | ord_subtract(Identifiers,OVariables,Elements), |
| 310 | | ord_domain_list_to_avl(Elements,ElementsAVL),!. |
| 311 | | find_all_used_enumerated_elements(_Elements) :- |
| 312 | | add_error_and_fail(b_global_sets, 'find_all_used_enumerated_elements failed'). |
| 313 | | |
| 314 | | |
| 315 | | reset_global_set_user_defined_scope :- |
| 316 | | retract(global_set_user_defined_scope(GS,_Scope)), |
| 317 | | (is_b_precompiled_globalset(GS) |
| 318 | | -> true |
| 319 | | ; add_error(b_global_sets,'Trying to set scope of unknown SET: ',GS) |
| 320 | | ),fail. |
| 321 | | reset_global_set_user_defined_scope. |
| 322 | | |
| 323 | | % Return those constants which are implicitly introduced by ProB, but not really |
| 324 | | % part of the model. These are the elements of a deferred set. |
| 325 | | b_get_prob_deferred_set_elements(TIds,AllOrVisible) :- |
| 326 | | findall( TId, |
| 327 | | ( prob_deferred_set_element(GS,_Nr,Id,AllOrVisible), |
| 328 | | create_texpr(identifier(Id),global(GS),[],TId)), |
| 329 | | TIds). |
| 330 | | |
| 331 | | |
| 332 | | |
| 333 | | :- use_module(bsyntaxtree,[transform_bexpr_with_scoping/3]). |
| 334 | | % inline probids (prob deferred set ids) as values into a predicate or expression |
| 335 | | inline_prob_deferred_set_elements_into_bexpr(Pred,CompiledPred) :- |
| 336 | | add_prob_deferred_set_elements_to_store([], State, visible), % visible: only those Ids which do not clash with variables, constants, ... are added |
| 337 | | State \= [], !, |
| 338 | | sort(State,S), |
| 339 | | debug_println(19,compiling_probids_into_bexpr(S)), |
| 340 | | transform_bexpr_with_scoping(b_global_sets:inline_state(S),Pred,CompiledPred). |
| 341 | | inline_prob_deferred_set_elements_into_bexpr(Pred,Pred). |
| 342 | | |
| 343 | | :- use_module(tools_lists,[ord_member_nonvar_chk/2]). |
| 344 | | :- use_module(library(ordsets),[ord_nonmember/2]). |
| 345 | | % difference with compile from b_compiler: no need to specify parameters, no errors if identifier not found |
| 346 | | inline_state(State,b(identifier(ID),Type,I),b(value(Val),Type,I),LocalIds) :- |
| 347 | | ord_member_nonvar_chk(bind(ID,Val),State), % the ID appears in the binding list |
| 348 | | ord_nonmember(ID,LocalIds). % The ID is not overriden by a locally quantified variable |
| 349 | | |
| 350 | | add_prob_deferred_set_elements_to_store(OldStore,NewStore,AllOrVisible) :- % add prob_ids |
| 351 | | is_list(OldStore),!, |
| 352 | | %print(add_prob_deferred_set_elements_to_store(OldStore)),nl, |
| 353 | | findall(bind(Id,fd(Nr,GS)),(prob_deferred_set_element(GS,Nr,Id,AllOrVisible), |
| 354 | | \+ member(bind(Id,_),OldStore)), |
| 355 | | NewStore, OldStore). |
| 356 | | add_prob_deferred_set_elements_to_store(OldStore,NewStore,_) :- |
| 357 | | add_internal_error('Cannot add deferred set elements to this store: ',OldStore), |
| 358 | | NewStore=OldStore. |
| 359 | | |
| 360 | | % virtual deferred set elements generated by ProB |
| 361 | | prob_deferred_set_element(GlobalSet,Elem,Id,AllOrVisible) :- |
| 362 | ? | b_global_set(GlobalSet), |
| 363 | | atom_codes(GlobalSet,GlobalSetCodes),append(GlobalSetCodes,ECodes,NameCodes), |
| 364 | | b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 365 | | (Up=inf -> UpLimited=999, |
| 366 | | debug_format(19,'Limiting ProB IDs for deferred set ~w to ~w..~w elements~n',[GlobalSet,Low,UpLimited]) |
| 367 | | ; Up>999 -> UpLimited=999, % TODO: provide preference/option ? |
| 368 | | debug_format(19,'Limiting ProB IDs for deferred set ~w to ~w..~w elements~n',[GlobalSet,Low,UpLimited]) |
| 369 | | ; UpLimited=Up), |
| 370 | ? | between(Low,UpLimited,Elem), |
| 371 | | (AllOrVisible = all -> true |
| 372 | | ; % only visible ones |
| 373 | | \+ is_b_global_constant_hash(GlobalSet,Elem,_) % the identifier is not used somewhere else |
| 374 | | ), |
| 375 | | number_codes(Elem,ECodes), |
| 376 | | atom_codes(Id,NameCodes), |
| 377 | | \+ b_global_set(Id), % not used as another SET name |
| 378 | | \+ lookup_global_constant(Id,_). % not used as another SET element |
| 379 | | |
| 380 | | |
| 381 | | user_forced_symmetry(GS) :- % check if the user defined FORCE_SYMMETRY_GS == TRUE |
| 382 | | string_concatenate('FORCE_SYMMETRY_',GS,DefName), |
| 383 | | b_get_typed_definition(DefName,[],F), get_texpr_expr(F,boolean_true). |
| 384 | | |
| 385 | | |
| 386 | | %is_global_set_of_cardinality_two(Type,LowBnd,UpBnd) :- |
| 387 | | % b_get_fd_type_bounds(Type,LowBnd,UpBnd), |
| 388 | | % LowBnd+1 =:= UpBnd. |
| 389 | | |
| 390 | | :- volatile is_global_set_of_cardinality_one/2. |
| 391 | | :- dynamic is_global_set_of_cardinality_one/2. |
| 392 | | % should be called when unloading a machine, before type-checking etc... |
| 393 | | % TO DO: use :- use_module(eventhandling,[register_event_listener/3]). |
| 394 | | b_clear_global_set_type_definitions :- % nl,print(clearing_gs),nl, |
| 395 | | retractall(b_supplementary_global_set(_)), |
| 396 | | retractall(b_replaced_global_set(_,_)), |
| 397 | | b_reset_global_set_type_definitions, |
| 398 | | retractall(global_set_user_defined_scope(_,_)). |
| 399 | | |
| 400 | | b_reset_global_set_type_definitions :- %nl,print(reset_gs),nl, |
| 401 | | % print_message('resetting global sets'), |
| 402 | | retractall(b_precompiled_global_set(_)), |
| 403 | | retractall(enumerated_set(_)), |
| 404 | | retractall(fixed_deferred_set_size(_,_)), |
| 405 | | retractall(extract_setsize_from_machine_cache(_,_,_)), |
| 406 | | retractall(find_minimum_cardinality_cache(_,_)), |
| 407 | | retractall(is_global_set_of_cardinality_one(_,_)), |
| 408 | | retractall(b_global_constant(_,_,_)), |
| 409 | | retractall(b_global_constant_hash(_,_,_,_)), |
| 410 | | retractall(lookup_global_constant(_,_)), |
| 411 | | retractall(used_b_global_constant(_,_,_)), |
| 412 | | retractall(inferred_minimum_global_set_cardinality(_,_)), |
| 413 | | retractall(inferred_maximum_global_set_cardinality(_,_)). |
| 414 | | |
| 415 | | |
| 416 | | add_new_global_set(Set) :- |
| 417 | | (b_precompiled_global_set(Set) |
| 418 | | -> add_internal_error('Global set already exists: ',add_new_global_set(Set)) |
| 419 | | ; b_integer_or_real_or_string_set(Set) |
| 420 | | % should only occur in Event-B mode, or possibly in Z, TLA; in Atelier-B these are reserved keywords |
| 421 | | % this can cause problems as we currently create symbolic set values global_set('STRING'), ... |
| 422 | | -> add_warning(add_new_global_set,'Global set name can cause internal name clashes: ',Set), |
| 423 | | assertz(b_precompiled_global_set(Set)) |
| 424 | | ; assertz(b_precompiled_global_set(Set))). |
| 425 | | |
| 426 | | |
| 427 | | :- dynamic b_supplementary_global_set/1, b_replaced_global_set/2. |
| 428 | | b_supplementary_global_set(GS) :- b_supplementary_global_set(GS). |
| 429 | | |
| 430 | | % these should be called before we precompile the global set definitions |
| 431 | | generate_fresh_supplementary_global_set(FRESHID) :- |
| 432 | | gensym('__DEFERREDSET__',FRESHID), |
| 433 | | debug_println(10,generate_fresh_supplementary_global_set(FRESHID)), |
| 434 | | assertz(b_supplementary_global_set(FRESHID)). |
| 435 | | |
| 436 | | % called by record construction, when a global deferred set gets replaced by something else |
| 437 | | % we register it here for safety and better error messages |
| 438 | | % in some contexts (like freetype constructors/destructors) the old type may accidentally get used; but we should remove all references to old type |
| 439 | | register_replaced_global_set(ID,_) :- |
| 440 | | b_global_set(ID),!, |
| 441 | | add_warning(b_global_sets,'Global set already exists: ',ID). |
| 442 | | register_replaced_global_set(ID,_) :- |
| 443 | | b_replaced_global_set(ID,_),!, |
| 444 | | add_warning(b_global_sets,'Global set already registered as replaced: ',ID). |
| 445 | | register_replaced_global_set(ID,NewTypeExpr) :- |
| 446 | | assertz(b_replaced_global_set(ID,NewTypeExpr)). |
| 447 | | |
| 448 | | /* --------------------------------------------------------- */ |
| 449 | | /* Extracting Finite Domain type information from the B machine */ |
| 450 | | /* --------------------------------------------------------- */ |
| 451 | | |
| 452 | | |
| 453 | | |
| 454 | | /* below treats annotations in the form: |
| 455 | | DEFINITIONS |
| 456 | | scope_Name == 1..3; |
| 457 | | scope_Code == 4..8 |
| 458 | | which inform us about which finidte domain ranges we should |
| 459 | | give to global sets defined in SETS |
| 460 | | */ |
| 461 | | |
| 462 | | :- use_module(tools_printing,[print_error/1, format_error_with_nl/2]). |
| 463 | | :- dynamic extract_setsize_from_machine_cache/3. |
| 464 | | extract_setsize_from_machine_cache(_,_,_) :- |
| 465 | | print_error('*** extract_setsize_from_machine not precompiled'),fail. |
| 466 | | |
| 467 | | try_extract_setsize_from_machine(GlobalSetName,_LowBound,_UpBound) :- |
| 468 | | start_extracting_setsize(GlobalSetName),!,fail. % cyclic dependency; abort computation |
| 469 | | try_extract_setsize_from_machine(GlobalSetName,LowBound,UpBound) :- |
| 470 | | extract_setsize_from_machine(GlobalSetName,LowBound,UpBound). |
| 471 | | |
| 472 | | % Determine if GlobalSetName is enumerated or deferred and if we can infer cardinality (bounds) |
| 473 | | extract_setsize_from_machine(GlobalSetName,LowBound,UpBound) :- |
| 474 | | extract_setsize_from_machine_cache(GlobalSetName,L,U),!, |
| 475 | | LowBound=L,UpBound=U. |
| 476 | | extract_setsize_from_machine(GlobalSetName,LowBound,UpBound) :- |
| 477 | | start_extracting_setsize_from_machine(GlobalSetName), |
| 478 | | b_get_named_machine_set(GlobalSetName,ListOfConstants), % find explicitly declared ENUMERATED SETS |
| 479 | | !, |
| 480 | | assert_enumerated_set(GlobalSetName,ListOfConstants,LowBound,UpBound). % will also assert_extract_setsize_from_machine_cache |
| 481 | | extract_setsize_from_machine(GlobalSetName,L,U) :- |
| 482 | | b_supplementary_global_set(GlobalSetName),!, % deferred set that was added for untyped ID,... |
| 483 | | default_deferred_set_bounds(LowBound,UpBound), |
| 484 | | assert_extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound), |
| 485 | | (LowBound,UpBound)=(L,U). |
| 486 | | extract_setsize_from_machine(GlobalSetName,L,U) :- |
| 487 | | /* we have a DEFERRED SET */ |
| 488 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,LowBound,UpBound), |
| 489 | | (LowBound=UpBound -> assertz(is_global_set_of_cardinality_one(GlobalSetName,LowBound)) ; true), |
| 490 | | assert_extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound), |
| 491 | | % determine if some of the elements are ENUMERATED: |
| 492 | | (b_get_disjoint_constants_of_type(GlobalSetName, DisjointConstants,_) |
| 493 | | % DISABLE for Disprover ?? what if selected hyps does not contain this |
| 494 | | -> /* add those constants to the deferred set as though they were enumerated set elements: improves performance by avoiding redundant permutations; is a kind of symmetry breaking */ |
| 495 | | debug_format(19,'Adding enumerated disjoint constants ~w : ~w~n~n',[GlobalSetName,DisjointConstants]), |
| 496 | | add_named_constants_to_global_set(GlobalSetName,LowBound,DisjointConstants) |
| 497 | | ; true |
| 498 | | ), |
| 499 | | debug_println(9,setsize(GlobalSetName,LowBound,UpBound)), |
| 500 | | (LowBound,UpBound)=(L,U). |
| 501 | | |
| 502 | | |
| 503 | | /* for Deferred SETS : */ |
| 504 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,L,U) :- |
| 505 | | b_extract_values_clause_assignment(GlobalSetName,_Type,TVal), % VALUES clause |
| 506 | | (get_interval(TVal,Low,Up) -> true |
| 507 | | ; add_error(b_global_sets,'VALUES clause must set deferred set to an interval: ',GlobalSetName,TVal),fail), |
| 508 | | (evaluable_integer_expression(Low,[],LowBound) -> true |
| 509 | | ; add_error(b_global_sets,'Cannot extract lower bound from VALUES interval for: ',GlobalSetName,Low),fail), |
| 510 | | (evaluable_integer_expression(Up,[],UpBound) -> true |
| 511 | | ; add_error(b_global_sets,'Cannot extract upper bound from VALUES interval for: ',GlobalSetName,Up),fail), |
| 512 | | !, |
| 513 | | check_compatible_with_user_scope(GlobalSetName,UpBound,LowBound), |
| 514 | | LowBound=L,UpBound=U. |
| 515 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,L,U) :- |
| 516 | | b_get_properties_from_machine(Properties), member_in_conjunction(C,Properties), |
| 517 | | (is_equality_card_global_set(C,GlobalSetName,Properties,Card) |
| 518 | | % check if the PROPERTIES contain an expression of the form card(GS) = Nr |
| 519 | | -> true |
| 520 | | ; is_infinite_global_set_pred(C,GlobalSetName) |
| 521 | | % look for predicates which stipulate that the set is infinite |
| 522 | | -> Card=inf |
| 523 | | ), |
| 524 | | !, |
| 525 | | assertz(fixed_deferred_set_size(GlobalSetName,Card)), |
| 526 | | LowBound=1, UpBound = Card, |
| 527 | | check_compatible_with_user_scope(GlobalSetName,UpBound,LowBound), |
| 528 | | LowBound=L,UpBound=U. |
| 529 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,L,U) :- /* check if there is a scope_ DEFINITION */ |
| 530 | | get_user_defined_scope(GlobalSetName,LowBound,UpBound,_),!, |
| 531 | | LowBound=L,UpBound=U. |
| 532 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,LowBound,UpBound) :- |
| 533 | | get_preference(globalsets_fdrange,DefaultUpperBound), |
| 534 | | find_minimum_cardinality(GlobalSetName,MinCard), |
| 535 | | assertz(inferred_minimum_global_set_cardinality(GlobalSetName,MinCard)), |
| 536 | | !, |
| 537 | | LowBound = 1, |
| 538 | | (find_maximum_cardinality(GlobalSetName,MaxCard) |
| 539 | | -> (MaxCard=MinCard -> assertz(fixed_deferred_set_size(GlobalSetName,MinCard)), |
| 540 | | debug_println(9,fixed_deferred_set_size(GlobalSetName,MinCard)), |
| 541 | | UpBound = MinCard |
| 542 | | ; DefaultUpperBound>MaxCard -> |
| 543 | | debug_println(9,reducing_deferred_set_size(GlobalSetName,MaxCard)), |
| 544 | | UpBound=MaxCard |
| 545 | | ; DefaultUpperBound<MinCard -> |
| 546 | | debug_println(9,inferred_minimum_global_set_cardinality(GlobalSetName,MinCard)), |
| 547 | | UpBound=MinCard |
| 548 | | ; UpBound is MinCard |
| 549 | | ) |
| 550 | | ; MinCard>DefaultUpperBound -> UpBound=MinCard |
| 551 | | ; UpBound=DefaultUpperBound), |
| 552 | | debug_println(4,inferred(GlobalSetName,UpBound)). |
| 553 | | extract_DEFERRED_setsize_from_machine(GlobalSetName,LowBound,UpBound) :- |
| 554 | | % No Minimum cardinality was inferred |
| 555 | | LowBound=1, get_preference(globalsets_fdrange,DefaultUpperBound), |
| 556 | | find_maximum_cardinality(GlobalSetName,MaxCard), |
| 557 | | !, |
| 558 | | (MaxCard=1 -> UpBound=1, assertz(fixed_deferred_set_size(GlobalSetName,1)) |
| 559 | | ; inf_greater(DefaultUpperBound,MaxCard) -> |
| 560 | | debug_println(9,reducing_deferred_set_size(GlobalSetName,MaxCard)), |
| 561 | | UpBound=MaxCard |
| 562 | | % does not have the case: DefaultUpperBound<MinCard -> UpBound=MinCard |
| 563 | | ; UpBound=DefaultUpperBound). |
| 564 | | extract_DEFERRED_setsize_from_machine(_GlobalSetName,LowBound,UpBound) :- |
| 565 | | % No Minimum cardinality was inferred |
| 566 | | default_deferred_set_bounds(LowBound,UpBound). |
| 567 | | |
| 568 | | default_deferred_set_bounds(1,UpBound) :- get_preference(globalsets_fdrange,UpBound). |
| 569 | | |
| 570 | | check_compatible_with_user_scope(GlobalSetName,UpBound,LowBound) :- |
| 571 | | (get_user_defined_scope(GlobalSetName,DL,DU,Span), |
| 572 | | DU-DL =\= UpBound-LowBound |
| 573 | | -> add_error(extract_DEFERRED_setsize_from_machine,'Conflict between scope_ Definition and PROPERTIES:',GlobalSetName,Span) |
| 574 | | ; true |
| 575 | | ). |
| 576 | | |
| 577 | | |
| 578 | | find_maximum_cardinality(GlobalSetName,MaxCard) :- |
| 579 | | find_maximum_cardinality1(GlobalSetName,MaxCard), |
| 580 | | assertz(inferred_maximum_global_set_cardinality(GlobalSetName,MaxCard)). |
| 581 | | |
| 582 | | find_maximum_cardinality1(GlobalSetName,MaxCard) :- |
| 583 | | b_get_machine_constants(Csts), |
| 584 | | b_get_properties_from_machine(Properties), |
| 585 | | findall(MC2,find_maximum_cardinality2(Csts,Properties,GlobalSetName,MC2),List), |
| 586 | | min_member(MaxCard,List). |
| 587 | | find_maximum_cardinality2(_Csts,Properties,GlobalSetName,MaxCard) :- |
| 588 | | get_card_upper_bound(Properties,GlobalSetName,MaxCard). |
| 589 | | find_maximum_cardinality2(_Csts,Properties,GlobalSetName,MaxCard) :- |
| 590 | | get_equality(Properties,GlobalSetName,EXPR,RestProp), % GlobalSetName = EXPR |
| 591 | | maximum_cardinality_of_expression(EXPR,RestProp,MaxCard). |
| 592 | | find_maximum_cardinality2(_Csts,Properties,GlobalSetName,MaxCard) :- |
| 593 | | member_in_conjunction(C,Properties), |
| 594 | | get_texpr_expr(C,partition(Set,DisjSets)), % partition(GlobalSetName, DisjSets) |
| 595 | | global_set_identifier(Set,GlobalSetName), |
| 596 | | max_card_of_partition_list(DisjSets,Properties,0,MaxCard). |
| 597 | | |
| 598 | | |
| 599 | | get_equality(Properties,ID,R,RestProp) :- |
| 600 | | select_member_in_conjunction(C,Properties,RestProp), |
| 601 | | get_texpr_expr(C,equal(LHS,RHS)), |
| 602 | | ( get_texpr_expr(LHS,identifier(ID)), R=RHS |
| 603 | | ; get_texpr_expr(RHS,identifier(ID)), R=LHS ). |
| 604 | | |
| 605 | | % find card(ID) <= MaxCard |
| 606 | | get_card_upper_bound(Properties,ID,MaxCard) :- |
| 607 | | LHS = b(card(TID),_,_), |
| 608 | | get_texpr_expr(TID,identifier(ID)), |
| 609 | | select_member_in_conjunction(C,Properties,RestProp), |
| 610 | | ( get_texpr_expr(C,less_equal(LHS,RHS)), Strict=false ; |
| 611 | | get_texpr_expr(C,greater_equal(RHS,LHS)), Strict=false ; |
| 612 | | get_texpr_expr(C,less(LHS,RHS)), Strict=true ; |
| 613 | | get_texpr_expr(C,greater(RHS,LHS)), Strict=true |
| 614 | | ), |
| 615 | | evaluable_integer_expression(RHS,RestProp,R), |
| 616 | | (Strict=true -> MaxCard is R-1 ; MaxCard = R). |
| 617 | | |
| 618 | | maximum_cardinality_of_expression(b(E,_,_),Props,MC) :- maximum_cardinality_of_expression2(E,Props,MC). |
| 619 | | maximum_cardinality_of_expression2(set_extension(SetExtElements),_,MaxCard) :- |
| 620 | | length(SetExtElements,MaxCard). |
| 621 | | % we assume that all elements in List can be different |
| 622 | | maximum_cardinality_of_expression2(union(A,B),Props,MaxCard) :- |
| 623 | | maximum_cardinality_of_expression(A,Props,MA), |
| 624 | | maximum_cardinality_of_expression(B,Props,MB), MaxCard is MA+MB. |
| 625 | | maximum_cardinality_of_expression2(intersection(A,B),Props,MaxCard) :- |
| 626 | | maximum_cardinality_of_expression(A,Props,MA), |
| 627 | | maximum_cardinality_of_expression(B,Props,MB), MaxCard is min(MA,MB). |
| 628 | | maximum_cardinality_of_expression2(set_subtraction(A,_),Props,MaxCard) :- |
| 629 | | maximum_cardinality_of_expression(A,Props,MaxCard). |
| 630 | | maximum_cardinality_of_expression2(cartesian_product(A,B),Props,MaxCard) :- |
| 631 | | maximum_cardinality_of_expression(A,Props,MA), |
| 632 | | maximum_cardinality_of_expression(B,Props,MB), MaxCard is MA*MB. |
| 633 | | maximum_cardinality_of_expression2(identifier(ID),Props,MaxCard) :- % tested in testcase 1917 |
| 634 | | maximum_cardinality_of_identifier(ID,Props,MaxCard). |
| 635 | | maximum_cardinality_of_expression2(empty_set,_,0). |
| 636 | | % TO DO: generalized union... |
| 637 | | %maximum_cardinality_of_expression2(Ex,_) :- nl, print(uncov_max_partition_card(Ex)),nl,nl,fail. |
| 638 | | % TO DO: other cases |
| 639 | | |
| 640 | | maximum_cardinality_of_identifier(ID,Properties,MaxCard) :- |
| 641 | | TID = b(identifier(ID),_,_), |
| 642 | | member_in_conjunction(EqCardExpr,Properties), % look for card(ID) = MaxCard |
| 643 | | is_equality_card_expression(EqCardExpr,Properties,TID,MaxCard), % this is actually an exact card |
| 644 | | !. % TODO: also check for card(ID) <= Bound |
| 645 | | maximum_cardinality_of_identifier(ID,Properties,MaxCard) :- |
| 646 | | get_equality(Properties,ID,EXPR,RestProp), % ID = EXPR, |
| 647 | | % remove equality to avoid loops, TO DO: try several equalities? |
| 648 | | maximum_cardinality_of_expression(EXPR,RestProp,MaxCard). |
| 649 | | maximum_cardinality_of_identifier(ID,Properties,MaxCard) :- |
| 650 | | get_texpr_id(Set,ID), |
| 651 | | get_texpr_expr(C,partition(Set,DisjSets)), % partition(ID, DisjSets) |
| 652 | | select_member_in_conjunction(C,Properties,RestProp), % remove partition to avoid loops |
| 653 | | max_card_of_partition_list(DisjSets,RestProp,0,MaxCard). |
| 654 | | |
| 655 | | % determine maximum cardinality of partition RHS-List (partition(Set,RHS-List)) |
| 656 | | max_card_of_partition_list([],_,Acc,Acc). |
| 657 | | max_card_of_partition_list([TPartSet|T],Properties,Acc,Res) :- |
| 658 | | maximum_cardinality_of_expression(TPartSet,Properties,Max),!, |
| 659 | | NAcc is Acc+Max, |
| 660 | | max_card_of_partition_list(T,Properties,NAcc,Res). |
| 661 | | |
| 662 | | |
| 663 | | :- dynamic find_minimum_cardinality_cache/2. |
| 664 | | find_minimum_cardinality(GS,MC) :- |
| 665 | | find_minimum_cardinality_cache(GS,Nr),!, %print(min_card_cache(GS,Nr)),nl, |
| 666 | | % avoid loops; e.g., if we have N1 >->> N2 and N2 >->> N1 |
| 667 | | number(Nr), |
| 668 | | MC=Nr. |
| 669 | | find_minimum_cardinality(GlobalSetName,Res) :- % print(find_min_card(GlobalSetName)),nl, |
| 670 | | /* try to find out from the Properties whether there is an implied minimum cardinality */ |
| 671 | | b_get_machine_constants(Csts), |
| 672 | | b_get_properties_from_machine(Properties), |
| 673 | | assertz(find_minimum_cardinality_cache(GlobalSetName,unknown)), |
| 674 | | findall(MinCard2,find_minimum_cardinality2(Csts,Properties,GlobalSetName,MinCard2),List), |
| 675 | | debug_println(9,mincard_list(GlobalSetName,List)), |
| 676 | | max_member(MinCard,List), % we do not allow empty global sets anymore, allow_empty_global_sets is obsolete |
| 677 | | inf_greater(MinCard,0), |
| 678 | | retract(find_minimum_cardinality_cache(GlobalSetName,_)), |
| 679 | | assertz(find_minimum_cardinality_cache(GlobalSetName,MinCard)), |
| 680 | | Res=MinCard. |
| 681 | | |
| 682 | | find_minimum_cardinality2(_,Properties,GlobalSetName,MinCard) :- |
| 683 | | member_in_conjunction(C,Properties), |
| 684 | | find_minimum_cardinality3(C,Properties,GlobalSetName,MinCard). |
| 685 | | find_minimum_cardinality2(_Constants,_Properties,GlobalSetName,MinCard) :- |
| 686 | | %print(trying_find_min_card(GlobalSetName,Constants)),nl, |
| 687 | | b_get_disjoint_constants_of_type(GlobalSetName, DisjointConstants,_), |
| 688 | | length(DisjointConstants,MinCard), inf_greater(MinCard,1). |
| 689 | | |
| 690 | | |
| 691 | | :- use_module(partition_detection,[is_disjoint_pred/4]). |
| 692 | | |
| 693 | | find_minimum_cardinality3(C,Properties,GlobalSetName,MinCard) :- |
| 694 | | % check if the PROPERTIES contain an expression of the form card(GS) >= Nr or similar |
| 695 | | is_greaterequalthan_card_global_set(C,GlobalSetName,Properties,MinCard). |
| 696 | | find_minimum_cardinality3(C,Properties,GlobalSetName,MinCard) :- |
| 697 | | % find things like partition(GlobalSetName,S1,...,SN) |
| 698 | | get_texpr_expr(C,partition(Set,DisjSets)), |
| 699 | | global_set_identifier(Set,GlobalSetName), |
| 700 | | % print(partition(Set,DisjSets,GlobalSetName)),nl, |
| 701 | | find_min_card_of_disjoint_sets(DisjSets,Properties,MinCard). % ,print(min(MinCard)),nl. |
| 702 | | find_minimum_cardinality3(C,_Properties,GlobalSetName,MinCard) :- |
| 703 | | get_texpr_expr(C,member(_Something,SURJ)), |
| 704 | | is_surjection(SURJ,Set,OTHERSET), |
| 705 | | global_set_identifier(Set,GlobalSetName), |
| 706 | | \+ global_set_identifier(OTHERSET,GlobalSetName), % Surjection on itself; no use in narrowing down cardinality |
| 707 | | (minimum_cardinality(OTHERSET,MinCard) |
| 708 | | -> true |
| 709 | | ; print('*** could not compute mincard: '), print(OTHERSET),nl,fail), |
| 710 | | (MinCard=inf -> add_error(b_global_sets,'Set has to be of infinite cardinality: ',GlobalSetName),fail ; true). |
| 711 | | find_minimum_cardinality3(C,Properties,GlobalSetName,MinCard) :- |
| 712 | | is_disjoint_pred(C,set(global(GlobalSetName)),A,B), % A /\ B = {} with A<:GS and B<:GS |
| 713 | | minimum_cardinality_of_set(A,Properties,MinA), number(MinA), inf_greater(MinA,0), |
| 714 | | minimum_cardinality_of_set(B,Properties,MinB), number(MinB), inf_greater(MinB,0), |
| 715 | | inf_add(MinA,MinB,MinCard). |
| 716 | | % TO DO: store information and try to combine with other disjointedness infos |
| 717 | | |
| 718 | | % TO DO: detect that if f is total function from non_empty set to set X, then card(X)>0 |
| 719 | | |
| 720 | | % is a surjective function |
| 721 | | is_surjection(SURJ,FromSet,ToSet) :- get_texpr_expr(SURJ,total_surjection(FromSet,ToSet)). |
| 722 | | is_surjection(SURJ,FromSet,ToSet) :- get_texpr_expr(SURJ,partial_surjection(FromSet,ToSet)). |
| 723 | | is_surjection(SURJ,FromSet,ToSet) :- get_texpr_expr(SURJ,total_bijection(FromSet,ToSet)). % here we know the exact cardinality - TO DO: use this fact |
| 724 | | is_surjection(SURJ,FromSet,ToSet) :- get_texpr_expr(SURJ,partial_bijection(FromSet,ToSet)). |
| 725 | | is_surjection(SURJ,FromSet,ToSet) :- get_texpr_expr(SURJ,total_injection(ToSet,FromSet)). % inverse is surjective |
| 726 | | |
| 727 | | |
| 728 | | |
| 729 | | % compute the minmum cardinality of an expression |
| 730 | | minimum_cardinality(ID,MinCard) :- global_set_identifier(ID,GlobalSet),!, |
| 731 | | (b_extract_fd_type(GlobalSet,LowBnd,UpBnd) |
| 732 | | -> MinCard is 1+UpBnd-LowBnd |
| 733 | | ; print('*** Do not know card of : '), print(GlobalSet),nl, |
| 734 | | % TO DO: do full blown cardinality analysis of deferred sets |
| 735 | | fail). |
| 736 | | minimum_cardinality(b(EXPR,TYPE,_INFO),MinCard) :- |
| 737 | | minimum_cardinality2(EXPR,TYPE,MinCard). |
| 738 | | |
| 739 | | %minimum_cardinality2(A,T,R) :- print(mincard(A,T,R)),nl,fail. |
| 740 | | minimum_cardinality2(bool_set,_,2). |
| 741 | | minimum_cardinality2(cartesian_product(A,B),_,Res) :- minimum_cardinality(A,CA), |
| 742 | | minimum_cardinality(B,CB), kernel_objects:safe_mul(CA,CB,Res). |
| 743 | | minimum_cardinality2(interval(A,B),_,Res) :- |
| 744 | | b_get_properties_from_machine(Properties), |
| 745 | | evaluable_integer_expression(A,Properties,EA), |
| 746 | | evaluable_integer_expression(B,Properties,EB), |
| 747 | | (EB >= EA -> Res is EB+1-EA ; Res=0). |
| 748 | | % TO DO: enumerated sets, ... seq, relations, ... ? |
| 749 | | |
| 750 | | |
| 751 | | find_min_card_of_disjoint_sets([],_Properties,0). |
| 752 | | find_min_card_of_disjoint_sets([H|T],Properties,R) :- |
| 753 | | find_min_card_of_disjoint_sets(T,Properties,TN), |
| 754 | | (minimum_cardinality_of_set(H,Properties,MC) |
| 755 | | -> true %,print(min_card(MC,H)),nl |
| 756 | | ; add_internal_error('Call failed: ',minimum_cardinality_of_set(H,Properties,MC)), MC=1), |
| 757 | | R is TN+MC. |
| 758 | | |
| 759 | | |
| 760 | | minimum_cardinality_of_set(b(Expr,set(Type),_),Properties,MC) :- |
| 761 | | minimum_cardinality_of_set_aux(Expr,Type,Properties,MC). |
| 762 | | |
| 763 | | %minimum_cardinality_of_set_aux(P,Type,_,_MC) :- print(min_card(P,Type)),nl,fail. |
| 764 | | minimum_cardinality_of_set_aux(set_extension(List),GlobalSetName,Properties,MinCard) :- !, |
| 765 | | get_texpr_ids(List,AtomicIDList), |
| 766 | | find_inequal_global_set_identifiers(AtomicIDList,GlobalSetName,Properties,DisjointConstants), |
| 767 | | length(DisjointConstants,MinCard). % , print(disj_set_ext(MinCard,DisjointConstants)),nl,nl. |
| 768 | | minimum_cardinality_of_set_aux(identifier(CST),_Type,_Properties,MinCard) :- |
| 769 | | find_minimum_cardinality_cache(CST,Nr),!, |
| 770 | | number(Nr), |
| 771 | | MinCard=Nr. |
| 772 | | minimum_cardinality_of_set_aux(identifier(CST),Type,Properties,MinCard) :- |
| 773 | | Cst_Template = b(identifier(CST),set(Type),_), |
| 774 | | min_card_of_identifier(Cst_Template,CST,Type,Properties,MC), |
| 775 | | !, |
| 776 | | MinCard=MC, |
| 777 | | assertz(find_minimum_cardinality_cache(CST,MC)). % global sets and constants cannot have the same name |
| 778 | | % TO DO: add more cases ? sequence extension cannot appear |
| 779 | | minimum_cardinality_of_set_aux(_,_,_,0). |
| 780 | | |
| 781 | | % determine minimum cardinality of an identifier; usually a constant (cannot be another global set due to B typing). |
| 782 | | min_card_of_identifier(Cst_Template,_CST,_Type,Properties,MinCard) :- |
| 783 | | member_in_conjunction(EqCardExpr,Properties), % look for card(CstTemplate) = MinCard |
| 784 | | is_equality_card_expression(EqCardExpr,Properties,Cst_Template,MinCard), % this is actually an exact card |
| 785 | | !. |
| 786 | | min_card_of_identifier(_Cst_Template,CST,_Type,Properties,MinCard) :- |
| 787 | | member_in_conjunction(EqCardExpr,Properties), % look for card(CstTemplate) = MinCard |
| 788 | | is_greaterequalthan_card_global_set_id(EqCardExpr,CST,_GS,Properties,MinCard), |
| 789 | | MinCard > 0, % otherwise not helpful; maybe we can find a better bound below |
| 790 | | !. |
| 791 | | min_card_of_identifier(Cst_Template,_,_Type,Properties,MC) :- |
| 792 | | get_texpr_expr(PT,partition(Cst_Template,DisjSets)), |
| 793 | | member_in_conjunction(PT,Properties), |
| 794 | | find_min_card_of_disjoint_sets(DisjSets,Properties,MC),!. |
| 795 | | min_card_of_identifier(Cst_Template,_,Type,Properties,MinCard) :- |
| 796 | | % id1:CST ... idk:CST & all_different(id1,...,idk) => card(CST) >= k |
| 797 | | get_texpr_id(TID,ID), |
| 798 | | get_texpr_expr(EL,member(TID,Cst_Template)), |
| 799 | | findall(ID,member_in_conjunction(EL,Properties),AtomicIDList), |
| 800 | | % find all identifiers such that we have id : CST |
| 801 | | AtomicIDList \= [], |
| 802 | | !, % now detect which of these can be inferred to be disjoint |
| 803 | | find_inequal_global_set_identifiers(AtomicIDList,Type,Properties,DisjointConstants), |
| 804 | | length(DisjointConstants,MinCard). |
| 805 | | min_card_of_identifier(Cst_Template,_,_Type,Properties,MC) :- % x:CST => card(CST) >= 1 |
| 806 | | get_texpr_expr(EL,member(_,Cst_Template)), |
| 807 | | member_in_conjunction(EL,Properties), |
| 808 | | !, |
| 809 | | MC=1. |
| 810 | | min_card_of_identifier(Cst_Template,_,_Type,Properties,MC) :- % ID /= {} => card(ID) >= 1 |
| 811 | | member_in_conjunction(Pred,Properties), |
| 812 | | not_empty(Pred,Cst_Template), |
| 813 | | !, |
| 814 | | MC=1. |
| 815 | | |
| 816 | | not_empty(b(E,pred,_),A) :- |
| 817 | | not_empty_aux(E,A). |
| 818 | | not_empty_aux(not_equal(A,B),R) :- |
| 819 | | (definitely_empty_set(B) -> R=A ; definitely_empty_set(A),R=B). |
| 820 | | not_empty_aux(negation(b(equal(A,B),pred,_)),R) :- not_empty_aux(not_equal(A,B),R). |
| 821 | | % card() >= dealt with above |
| 822 | | % not_empty_aux(member(_,TotalFunction)) x: Dom --> R & Dom /= {} ---> R /={} |
| 823 | | |
| 824 | | |
| 825 | | |
| 826 | | |
| 827 | | % DETECT ENUMERATED constants part of a deferred set |
| 828 | | % the following could be further improved |
| 829 | | % try and find out how many different identifiers are in a list in the context of a predicate Prop |
| 830 | | % it is also called by b_get_disjoint_constants_of_type_calc in bmachine |
| 831 | | %find_inequal_global_set_identifiers(L,GS,_P,_R) :- print(find_inequal_global_set_identifiers(L,GS)),nl,fail. |
| 832 | | |
| 833 | | :- use_module(bsyntaxtree,[conjunction_to_list/2]). |
| 834 | | find_inequal_global_set_identifiers(IDS,GS,Prop,Res) :- |
| 835 | | %format('Finding enumerated elements of ~w (over ~w) in: ',[GS,IDS]),translate:print_bexpr(Prop),nl, |
| 836 | | conjunction_to_list(Prop,Preds), |
| 837 | | % first apply nested partition predicates as much as possible, to obtain maximally large partitions of distinct elements |
| 838 | | get_relevant_partition_preds(Preds,GS,RelevantPartitionPreds), % TO DO: cache this computation |
| 839 | | findall(TP,find_a_transitive_partition(RelevantPartitionPreds,TP),TransitivePartitions), |
| 840 | | append(TransitivePartitions,Preds,Preds2), |
| 841 | | find_inequal_global_set_identifiers2(IDS,GS,Preds2,Res). |
| 842 | | |
| 843 | | find_inequal_global_set_identifiers2([],_,_,[]). |
| 844 | | find_inequal_global_set_identifiers2([ID|T],GS,Preds,Res) :- |
| 845 | | (atomic(ID) -> true |
| 846 | | ; add_internal_error('Not atomic id: ',find_inequal_global_set_identifiers([ID|T],GS,Preds,Res)),fail), |
| 847 | | findall(ID2, (find_inquality(GS,Preds,ID,ID2), |
| 848 | | member(ID2,T)), DiffIDs), |
| 849 | | sort(DiffIDs,SortedDiffIDs), % also remove duplicates |
| 850 | | (SortedDiffIDs=[],T=[_,_|_] % then try to proceed with T, ignoring ID |
| 851 | | -> find_inequal_global_set_identifiers2(T,GS,Preds,Res) |
| 852 | | ; find_inequal_global_set_identifiers2(SortedDiffIDs,GS,Preds,RT), Res = [ID|RT] |
| 853 | | ). |
| 854 | | |
| 855 | | %find_inquality(_,_,ID,ID2) :- % TODO: make usable; currently VALUES clause is precompiled after this is used |
| 856 | | % b_extract_values_clause_assignment(ID,Type,TVal1), |
| 857 | | % b_extract_values_clause_assignment(ID2,Type,TVal2), |
| 858 | | % ID \= ID2, TVal1 \= TVal2. |
| 859 | | find_inquality(GS,Preds,ID,ID2) :- |
| 860 | | member(Conjunct,Preds), %print(chck(C)),nl, |
| 861 | | inequality(Conjunct,GS,ID,ID2,Preds). |
| 862 | | |
| 863 | | |
| 864 | | get_relevant_partition_preds(Preds,GS,SortedRelevantPartitionPreds) :- |
| 865 | | % detect which partition predicates are relevant for this global set |
| 866 | | findall(partition(Set,Subsets), |
| 867 | | (member(C,Preds), |
| 868 | | is_relevant_partition(C,GS,Set,Subsets)), RelevantPartitionPreds), |
| 869 | | sort(RelevantPartitionPreds,SortedRelevantPartitionPreds). |
| 870 | | is_relevant_partition(b(partition(Set,Subsets),pred,_),GS,Set,Subsets) :- |
| 871 | | get_texpr_type(Set,set(GS)). % , translate:print_bexpr(b(partition(Set,Subsets),pred,[])),nl. |
| 872 | | |
| 873 | | % if we have partition(A,[B,C]) and partition(B,[E,F]) --> generate partition(A,[E,F,C]) |
| 874 | | find_a_transitive_partition(Preds,b(partition(A,C),pred,[generated])) :- |
| 875 | | member(partition(A,B),Preds), |
| 876 | | inline_subsets(B,Preds,Inlined,C), Inlined==inlined. |
| 877 | | inline_subsets([],_,_,[]). |
| 878 | | inline_subsets([Subset1|TS],Preds,inlined,Result) :- get_texpr_id(Subset1,SubID), |
| 879 | | %prefix(Pred,[partition(S2,SubList)|Pred2]), |
| 880 | | select(partition(Subset2,SubList),Preds,Pred2), |
| 881 | | get_texpr_id(Subset2,SubID), |
| 882 | | debug_format(19,'Inlining nested partition predicate for set ~w~n',[SubID]), |
| 883 | | !, |
| 884 | | append(SubList,TS,NewList), |
| 885 | | inline_subsets(NewList,Pred2,_,Result). |
| 886 | | inline_subsets([Subset1|TS],Preds,Inlined,[Subset1|TSRes]) :- inline_subsets(TS,Preds,Inlined,TSRes). |
| 887 | | |
| 888 | | |
| 889 | | inequality(b(P,pred,_),GS,ID,OtherID,FullProps) :- |
| 890 | | inequality_aux(P,GS,ID,OtherID,FullProps). |
| 891 | | inequality_aux(not_equal(I1,I2),GS,ID,OtherID,_) :- |
| 892 | | gs_identifier(I1,GS,ID1), gs_identifier(I2,GS,ID2), |
| 893 | | (ID=ID1 -> OtherID=ID2 ; ID=ID2,OtherID=ID1). |
| 894 | | inequality_aux(not_equal(I1,I2),GS,ID,OtherID,_) :- % treat {aa} \= {bb} or more generally {aa,bb} \= {aa,cc} |
| 895 | | % two identifiers of global sets need not be different |
| 896 | | % in order for two set extensions to be inequal |
| 897 | | % first we check if I1, I2 are in fact subsets of global sets |
| 898 | | get_texpr_type(I1,set(global(_))), |
| 899 | | get_texpr_expr(I1,set_extension(IDs1)), % TODO: is there something more general than a set_extension? |
| 900 | | get_texpr_expr(I2,set_extension(IDs2)), % should full sets or set identifiers added? |
| 901 | | % remove the common elements and see if we find a pair of identifiers |
| 902 | | maplist(remove_all_infos_and_ground,IDs1,IDs1NoInfos), |
| 903 | | maplist(remove_all_infos_and_ground,IDs2,IDs2NoInfos), |
| 904 | | % TODO: maybe it is same to assume the order? |
| 905 | | list_to_ord_set(IDs1NoInfos,IDs1Set), list_to_ord_set(IDs2NoInfos,IDs2Set), |
| 906 | | ord_subtract(IDs1Set,IDs2Set,[E1]), % each set has one identifier that is not in the other one |
| 907 | | ord_subtract(IDs2Set,IDs1Set,[E2]), |
| 908 | | E1 \= E2, % and they are not the same |
| 909 | | gs_identifier(E1,GS,ID1), gs_identifier(E2,GS,ID2), |
| 910 | | set_ids(ID1,ID2,ID,OtherID). |
| 911 | | inequality_aux(negation( b(equal(I1,I2),pred,_)),GS,ID,OtherID,_) :- |
| 912 | | gs_identifier(I1,GS,ID1), gs_identifier(I2,GS,ID2), |
| 913 | | set_ids(ID1,ID2,ID,OtherID). |
| 914 | | inequality_aux(partition(Set,DisjSets),GS,ID,OtherID,Preds) :- |
| 915 | | get_texpr_type(Set,set(GS)), % only look at relevant partitions of correct type |
| 916 | | %nl,print(part(_Set,DisjSets,GS,ID,OtherID)),nl, |
| 917 | | % detect such things as partition(_,{...ID...},...{...OtherID...}...) |
| 918 | | select(Set1,DisjSets,Rest), set_extension_list(Set1,Preds,List1), |
| 919 | | member(O1,List1), gs_identifier(O1,GS,ID), |
| 920 | | member(Set2,Rest), set_extension_list(Set2,Preds,List2), |
| 921 | | member(O2,List2), gs_identifier(O2,GS,OtherID). |
| 922 | | inequality_aux(member(I1,SetDiff),GS,ID,OtherID,_Preds) :- |
| 923 | | % detect ID : SUPERSET - { ... OtherID ...} => ID:SUPERSET & ID /= OtherID |
| 924 | | get_texpr_expr(SetDiff,set_subtraction(_SuperSet,b(OtherSet,_,_))), |
| 925 | | gs_identifier(I1,GS,ID1), |
| 926 | | id_element_of_set(OtherSet,GS,ID2), |
| 927 | | set_ids(ID1,ID2,ID,OtherID). |
| 928 | | inequality_aux(AllDiff,GS,ID,OtherID,Preds) :- |
| 929 | | all_different(AllDiff,List1,GS,Preds), |
| 930 | | select(O1,List1,RestList), gs_identifier(O1,GS,ID), |
| 931 | | member(O2,RestList), gs_identifier(O2,GS,OtherID). |
| 932 | | |
| 933 | | set_ids(ID1,ID2,ID,OtherID) :- (ID=ID1 -> OtherID=ID2 ; ID=ID2,OtherID=ID1). |
| 934 | | |
| 935 | | id_element_of_set(set_extension(List),GS,ID) :- |
| 936 | | member(I2,List), |
| 937 | | gs_identifier(I2,GS,ID). |
| 938 | | |
| 939 | | % detect card({x1,....,xn}) = n as an all-different predicate |
| 940 | | all_different(equal(A,B),List,Type,Preds) :- |
| 941 | | all_diff_aux(A,B,List,Type,Preds) ; all_diff_aux(B,A,List,Type,Preds). |
| 942 | | all_diff_aux(A,B,List1,Type,Preds) :- |
| 943 | | A=b(card(Set1),_,_), |
| 944 | | get_texpr_type(Set1,set(Type)), % TO DO: also match seq type ? (in case we use predicate in other context) |
| 945 | | set_extension_list(Set1,Preds,List1), |
| 946 | | evaluable_integer_expression(B,b(truth,pred,[]),Card), |
| 947 | | length(List1,Card). |
| 948 | | |
| 949 | | set_extension_list(b(set_extension(List),_,_),_,List). |
| 950 | | set_extension_list(b(identifier(ID),_,_),Preds,List) :- |
| 951 | | % accept card(GS) = nr & ... GS = {....} |
| 952 | | member(Eq,Preds), |
| 953 | | equality(Eq,TID,b(set_extension(List),_,_)), |
| 954 | | get_texpr_id(TID,ID). |
| 955 | | |
| 956 | | equality(b(equal(LHS,RHS),pred,_),L,R) :- ( (L,R)=(LHS,RHS) ; (L,R)=(RHS,LHS) ). |
| 957 | | |
| 958 | | gs_identifier(b(identifier(ID),GS,_),GS,ID). |
| 959 | | |
| 960 | | :- assert_must_succeed(( b_global_sets:is_equality_card_global_set(b(equal(b(card(b(identifier('FACES'),set(global('FACES')),[])),integer,[]),b(integer(6),integer,[])),pred,[]),GS,[],Card),GS='FACES',Card=6) |
| 961 | | ). |
| 962 | | :- assert_must_succeed(( b_global_sets:is_equality_card_global_set(b(equal(b(card(b(value(global_set('TITLE')),set(global('TITLE')),[])),integer,[]),b(integer(4),integer,[])),pred,[]),GS,[],Card), |
| 963 | | GS=='TITLE', Card=4) |
| 964 | | ). |
| 965 | | |
| 966 | | is_equality_card_expression(TE,Properties,Expr,Card) :- |
| 967 | | get_texpr_expr(TE,equal(LHS,RHS)), |
| 968 | | get_texpr_expr(LHS,L), get_texpr_expr(RHS,R), |
| 969 | | ( L=card(Expr), evaluable_integer_expression(R,Properties,Card) |
| 970 | | ; R=card(Expr), evaluable_integer_expression(L,Properties,Card)). |
| 971 | | |
| 972 | | is_equality_card_global_set(TE,GlobalSet,Properties,Card) :- |
| 973 | ? | is_equality_card_expression(TE,Properties,Expr,Card), |
| 974 | | global_set_identifier(Expr,GlobalSet), |
| 975 | | get_texpr_type(Expr,set(global(GlobalSet))). |
| 976 | | |
| 977 | | % detect a predicate that stipulates that given Set is infinite |
| 978 | | % i.e., we detect not(finite(GS)) which can be rewritten from not(GS:FIN(GS)) in ast_cleanup by introduce_finite rule |
| 979 | | is_infinite_global_set_pred(Pred,GlobalSetName) :- |
| 980 | | get_texpr_expr(Pred,negation(Pred2)), |
| 981 | | get_texpr_expr(Pred2,finite(ID)), |
| 982 | | get_texpr_id(ID,GlobalSetName). |
| 983 | | |
| 984 | | %evaluable_integer_expression(X,_Y,_) :- print(ev(X)),nl,fail. |
| 985 | | % TO DO: maybe we should do some kind of constant folding or call b_compile ?? |
| 986 | | evaluable_integer_expression(b(E,integer,_),Properties,R) :- |
| 987 | | evaluable_integer_expression(E,Properties,R). |
| 988 | | evaluable_integer_expression(max_int,_,R) :- preferences:preference(maxint,R). |
| 989 | | evaluable_integer_expression(min_int,_,R) :- preferences:preference(minint,R). |
| 990 | | evaluable_integer_expression(identifier(ID),Properties,R) :- |
| 991 | | get_texpr_expr(Eq,equal(LHS,RHS)), get_texpr_id(LHS,ID), |
| 992 | | select_member_in_conjunction(Eq,Properties,RestProp), % avoids loops; but an identifier cannot be used multiple times N+N |
| 993 | | evaluable_integer_expression(RHS,RestProp,R). |
| 994 | | evaluable_integer_expression(card(Set),Properties,Card) :- |
| 995 | | Set = b(identifier(GlobalSetName),set(global(GlobalSetName)),_), |
| 996 | | (extract_setsize_from_machine_cache(GlobalSetName,L,U) |
| 997 | | -> Card is U+1-L |
| 998 | | ; select_member_in_conjunction(Eq,Properties,RestProp), |
| 999 | | is_equality_card_global_set(Eq,GlobalSetName,RestProp,Card) |
| 1000 | | ). |
| 1001 | | evaluable_integer_expression(integer(Card),_,Card). |
| 1002 | | evaluable_integer_expression(div(A,B),Properties,Res) :- |
| 1003 | | evaluable_integer_expression(A,Properties,RA), |
| 1004 | | evaluable_integer_expression(B,Properties,RB), Res is RA // RB. |
| 1005 | | evaluable_integer_expression(multiplication(A,B),Properties,Res) :- |
| 1006 | | evaluable_integer_expression(A,Properties,RA), |
| 1007 | | evaluable_integer_expression(B,Properties,RB), Res is RA*RB. |
| 1008 | | evaluable_integer_expression(add(A,B),Properties,Res) :- |
| 1009 | | evaluable_integer_expression(A,Properties,RA), |
| 1010 | | evaluable_integer_expression(B,Properties,RB), Res is RA+RB. |
| 1011 | | evaluable_integer_expression(minus(A,B),Properties,Res) :- |
| 1012 | | evaluable_integer_expression(A,Properties,RA), |
| 1013 | | evaluable_integer_expression(B,Properties,RB), Res is RA-RB. |
| 1014 | | evaluable_integer_expression(unary_minus(A),Properties,Res) :- |
| 1015 | | evaluable_integer_expression(A,Properties,RA), Res is 0-RA. |
| 1016 | | |
| 1017 | | % checks if we have an identifier or a precompiled global_set value |
| 1018 | | global_set_identifier(C,GS) :- get_texpr_expr(C,BE), global_set_identifier2(BE,GS). |
| 1019 | | global_set_identifier2(identifier(GlobalSet),GlobalSet). |
| 1020 | | global_set_identifier2(value(global_set(GlobalSet)),GlobalSet). % generated by Z |
| 1021 | | |
| 1022 | | % check for card(GlobalSet) >= Card or similar |
| 1023 | | is_greaterequalthan_card_global_set(TE,GlobalSet,Properties,Card) :- |
| 1024 | | is_greaterequalthan_card_global_set_id(TE,GlobalSet,GlobalSet,Properties,Card). |
| 1025 | | % check for card(Identifier) >= Card or similar with Identifier of type GlobalSet |
| 1026 | | is_greaterequalthan_card_global_set_id(TE,Identifier,GlobalSet,Properties,Card) :- |
| 1027 | | (get_texpr_expr(TE,greater_equal(LHS,RHS)) ; |
| 1028 | | get_texpr_expr(TE,less_equal(RHS,LHS)) ), |
| 1029 | | get_texpr_expr(LHS,card(C)), |
| 1030 | | get_minimum_or_exact_value(RHS,Properties,Card), |
| 1031 | | global_set_identifier(C,Identifier), |
| 1032 | | get_texpr_type(C,set(global(GlobalSet))). |
| 1033 | | is_greaterequalthan_card_global_set_id(TE,Identifier,GlobalSet,Properties,Card1) :- |
| 1034 | | (get_texpr_expr(TE,greater(LHS,RHS)) ; |
| 1035 | | get_texpr_expr(TE,less(RHS,LHS)) ), |
| 1036 | | get_texpr_expr(LHS,card(C)), |
| 1037 | | get_minimum_or_exact_value(RHS,Properties,Card), |
| 1038 | | number(Card), Card1 is Card+1, |
| 1039 | | global_set_identifier(C,Identifier), |
| 1040 | | get_texpr_type(C,set(global(GlobalSet))). |
| 1041 | | is_greaterequalthan_card_global_set_id(TE,GlobalSet,GlobalSet,_Properties,2) :- |
| 1042 | | %% preferences:get_preference(allow_empty_global_sets,false), preference no longer exists |
| 1043 | | /* GlobalSet /= { ANY } -> as GlobalSet cannot be empty & as ANY must be well-typed: |
| 1044 | | we need at least one more element of GlobalSet */ |
| 1045 | | get_texpr_expr(TE,not_equal(LHS,RHS)), |
| 1046 | | ( get_texpr_expr(LHS,identifier(GlobalSet)) |
| 1047 | | -> get_texpr_expr(RHS,set_extension([b(_X,global(GlobalSet),_)])) |
| 1048 | | ; get_texpr_expr(RHS,identifier(GlobalSet)), |
| 1049 | | get_texpr_expr(LHS,set_extension([b(_X,global(GlobalSet),_)])) |
| 1050 | | ). |
| 1051 | | %%print(not_equal(GlobalSet,_X)),nl. |
| 1052 | | % not_equal(S_CHEMIN_ID,b(set_extension([b(identifier(C_NULL_CHEMIN_ID),global(S_CHEMIN_ID),[nodeid(pos(35,1,80,27,80,42)),loc(local,emi,concrete_constants)])]),set(global(S_CHEMIN_ID)),[nodeid(pos(34,1,80,26,80,43))])) |
| 1053 | | |
| 1054 | | % get mininimum or exact value for an expression |
| 1055 | | get_minimum_or_exact_value(TE,Properties,N) :- %print(get_min(TE,Properties)),nl,nl, |
| 1056 | | get_texpr_expr(TE,E), |
| 1057 | | get_minimum_or_exact_value_aux(E,Properties,N). |
| 1058 | | get_minimum_or_exact_value_aux(integer(N),_,N). |
| 1059 | | get_minimum_or_exact_value_aux(identifier(ID),Properties,N) :- |
| 1060 | | %(extract_min_or_exact_value_for_id(ID,Properties,N) -> true). % avoid backtracking; TO DO: in future all this should be part of constraint solving |
| 1061 | | findall(NVal,extract_min_or_exact_value_for_id(ID,Properties,NVal),NVals), |
| 1062 | | max_member(N,NVals). % find the maximum value for which we need to be greater(_equal) to |
| 1063 | | |
| 1064 | | get_minimum_or_exact_value_aux(add(A,B),Properties,Res) :- |
| 1065 | | get_minimum_or_exact_value(A,Properties,RA), |
| 1066 | | get_minimum_or_exact_value(B,Properties,RB), Res is RA+RB. |
| 1067 | | % TO DO: other operators |
| 1068 | | get_minimum_or_exact_value_aux(card(Set),_Properties,Card) :- |
| 1069 | | Set = b(identifier(GlobalSetName),set(global(GlobalSetName)),_), |
| 1070 | | try_extract_setsize_from_machine(GlobalSetName,L,U), % will try extraction; unless a cycle is hit |
| 1071 | | Card is U+1-L. |
| 1072 | | |
| 1073 | | extract_min_or_exact_value_for_id(ID,Properties,N) :- |
| 1074 | | member_in_conjunction(TE,Properties), |
| 1075 | | get_texpr_expr(TE,E), |
| 1076 | | get_value_bound(E,ID,N). |
| 1077 | | |
| 1078 | | % equalities already inlined |
| 1079 | | get_value_bound(equal(LHS,RHS),ID,N) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N). |
| 1080 | | get_value_bound(equal(RHS,LHS),ID,N) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N). |
| 1081 | | get_value_bound(greater(LHS,RHS),ID,N1) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N), N1 is N+1. |
| 1082 | | get_value_bound(less(RHS,LHS),ID,N1) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N), N1 is N+1. |
| 1083 | | get_value_bound(greater_equal(LHS,RHS),ID,N) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N). |
| 1084 | | get_value_bound(less_equal(RHS,LHS),ID,N) :- get_texpr_id(LHS,ID), get_texpr_integer(RHS,N). |
| 1085 | | |
| 1086 | | get_texpr_integer(b(integer(N),_,_),N). |
| 1087 | | |
| 1088 | | |
| 1089 | | :- volatile global_set_user_defined_scope/2. |
| 1090 | | :- dynamic global_set_user_defined_scope/2. |
| 1091 | | |
| 1092 | | /* allow to set scope for specific sets, e.g., via command-line */ |
| 1093 | | set_user_defined_scope(GS,X) :- |
| 1094 | | \+ number(X),!, |
| 1095 | | add_internal_error('Scope must be number: ',set_user_defined_scope(GS,X)). |
| 1096 | | set_user_defined_scope(GS,X) :- |
| 1097 | | format('% Setting user defined scope: ~w == ~w~n',[GS,X]), |
| 1098 | | assertz(global_set_user_defined_scope(GS,X)). |
| 1099 | | |
| 1100 | | get_user_defined_scope(GlobalSetName,_,_,_) :- var(GlobalSetName),!, |
| 1101 | | add_internal_error('Arg is variable: ',get_user_defined_scope(GlobalSetName)). |
| 1102 | | get_user_defined_scope(GlobalSetName,LowBound,UpBound,Span) :- |
| 1103 | | (global_set_user_defined_scope(GlobalSetName,UpBound) % from command-line |
| 1104 | | -> LowBound=1, Span = unknown |
| 1105 | | ; extract_setsize_from_defs(GlobalSetName,LowBound,UpBound,Span) % scopeSET == Low..Up from DEFINITIONS |
| 1106 | | ). |
| 1107 | | |
| 1108 | | :- use_module(translate,[translate_bexpression/2]). |
| 1109 | | % find scope_NAME == Low..Up in DEFINITIONS |
| 1110 | | extract_setsize_from_defs(GlobalSetName,LowBound,UpBound,DefTerm) :- |
| 1111 | | b_get_machine_setscope(GlobalSetName,DefTerm), |
| 1112 | | get_texpr_expr(DefTerm,DefExpr), |
| 1113 | | (extract_integer_range(DefExpr,LowBound,UpBound) |
| 1114 | | -> true |
| 1115 | | ; translate_bexpression(DefTerm,DS), |
| 1116 | | add_warning(extract_setsize_from_defs,'scope DEFINITION for deferred set should be number or interval: ',DS,DefTerm), |
| 1117 | | fail |
| 1118 | | ). |
| 1119 | | |
| 1120 | | extract_integer_range(interval(LB,UB), LowBound, UpBound) :- |
| 1121 | | get_texpr_expr(LB,integer(LowBound)), get_texpr_expr(UB,integer(UpBound)). |
| 1122 | | %extract_integer_range(set_extension(CstList),LowBound,UpBound) :- |
| 1123 | | % LowBound = 1, length(CstList,UpBound). % extract names of constants in list for pretty printing; check that different names |
| 1124 | | %extract_integer_range(value(avl_set(A)),LowBound,UpBound) :- |
| 1125 | | % LowBound = 1, avl_size(A,UpBound). |
| 1126 | | extract_integer_range(integer(UpBound),LowBound,UpBound) :- |
| 1127 | | LowBound = 1, UpBound>0. |
| 1128 | | |
| 1129 | | |
| 1130 | | :- dynamic start_extracting_setsize/1. |
| 1131 | | |
| 1132 | | start_extracting_setsize_from_machine(GlobalSetName) :- %print(start(GlobalSetName)),nl, |
| 1133 | | (start_extracting_setsize(GlobalSetName) |
| 1134 | | -> add_internal_error('Cyclic computation: ',start_extracting_setsize_from_machine(GlobalSetName)) |
| 1135 | | ; assertz(start_extracting_setsize(GlobalSetName))). |
| 1136 | | |
| 1137 | | assert_extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound) :- |
| 1138 | | retractall(start_extracting_setsize(GlobalSetName)), |
| 1139 | | %print(finished(GlobalSetName,LowBound,UpBound)),nl, |
| 1140 | | (retract(extract_setsize_from_machine_cache(GlobalSetName,L,U)) |
| 1141 | | -> print(overriding_set_size(GlobalSetName,LowBound-UpBound,L-U)),nl |
| 1142 | | ; true), |
| 1143 | | assertz(extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound)), |
| 1144 | | (integer(UpBound), UpBound<LowBound |
| 1145 | | -> format_error_with_nl('*** Illegal empty global set ~w, bounds ~w:~w',[GlobalSetName,LowBound,UpBound]) |
| 1146 | | ; true |
| 1147 | | ). |
| 1148 | | |
| 1149 | | |
| 1150 | | %% b_try_update_fd_cardinality has been removed |
| 1151 | | |
| 1152 | | :- volatile enumerated_set/1, fixed_deferred_set_size/2. |
| 1153 | | :- dynamic enumerated_set/1, fixed_deferred_set_size/2. |
| 1154 | | % true if GS is a deferred set whose size was not fixed; i.e., ProB has not inspected all possible instantiations |
| 1155 | | % TODO: rename to unfixed_or_infinite_deferred_set |
| 1156 | | unfixed_deferred_set(GS) :- |
| 1157 | ? | if(b_global_set(GS), |
| 1158 | | (\+ enumerated_set(GS), |
| 1159 | | \+ fixed_finite_deferred_set_size(GS,_)), |
| 1160 | | (debug_println(unknown_global_set(GS)),fail)). % triggered in test 2063 |
| 1161 | | |
| 1162 | ? | unfixed_deferred_set_exists :- b_global_set(GS), unfixed_deferred_set(GS),!. |
| 1163 | | |
| 1164 | | % a global set that is treated as infinite by ProB |
| 1165 | | % not unfixed deferred sets may still in principle allowed to be infinite, but could be give a finite card by ProB |
| 1166 | | infinite_global_set(GlobalSetName) :- |
| 1167 | | (fixed_deferred_set_size(GlobalSetName,X) -> X=inf |
| 1168 | | ; inferred_maximum_global_set_cardinality(GlobalSetName,MaxCard) -> MaxCard=inf % should not happen |
| 1169 | | ; enumerated_set(GlobalSetName) -> false |
| 1170 | | % ; (precompilation_phase(Phase) -> true ; Phase=0), |
| 1171 | | % nl,print(not_provably_infinite_global_set(GlobalSetName,Phase)),nl,nl,portray_global_sets,nl,fail |
| 1172 | | ). |
| 1173 | | |
| 1174 | | provably_finite_global_set(GlobalSetName) :- |
| 1175 | | enumerated_set(GlobalSetName),!. |
| 1176 | | provably_finite_global_set(GlobalSetName) :- |
| 1177 | | fixed_deferred_set_size(GlobalSetName,X),!, number(X). |
| 1178 | | provably_finite_global_set(GlobalSetName) :- |
| 1179 | | inferred_maximum_global_set_cardinality(GlobalSetName,MaxCard),!, |
| 1180 | | integer(MaxCard). |
| 1181 | | %provably_finite_global_set(GS) :- (precompilation_phase(Phase) -> true ; Phase=0), |
| 1182 | | % nl,print(not_provably_finite_global_set(GS,Phase)),nl,nl,portray_global_sets,nl,fail. |
| 1183 | | |
| 1184 | | fixed_finite_deferred_set_size(Set,Card) :- fixed_deferred_set_size(Set,Card), integer(Card). |
| 1185 | | |
| 1186 | | contains_unfixed_deferred_set(Type) :- (contains_unfixed_deferred_set(Type,_) -> true). |
| 1187 | | |
| 1188 | | contains_unfixed_deferred_set(global(Type),DS) :- unfixed_deferred_set(Type),DS=Type. |
| 1189 | | contains_unfixed_deferred_set(set(Type),DS) :- contains_unfixed_deferred_set(Type,DS). |
| 1190 | | contains_unfixed_deferred_set(seq(Type),DS) :- contains_unfixed_deferred_set(Type,DS). |
| 1191 | | contains_unfixed_deferred_set(couple(Type1,Type2),DS) :- |
| 1192 | | (contains_unfixed_deferred_set(Type1,DS) -> true ; contains_unfixed_deferred_set(Type2,DS)). |
| 1193 | | contains_unfixed_deferred_set(record(Fields),DS) :- |
| 1194 | | (member(field(_,Type),Fields), contains_unfixed_deferred_set(Type,DS) -> true). |
| 1195 | | |
| 1196 | | |
| 1197 | | % enumerated sets can be registered here, before cleaning up a machine |
| 1198 | | % this way we already know which sets are enumerated and definitely finite |
| 1199 | | % and we can also register the enumerated set elements |
| 1200 | | register_enumerated_sets([],_). |
| 1201 | | register_enumerated_sets([TID|T],Elems) :- def_get_texpr_id(TID,ID), get_texpr_type(TID,set(Type)), |
| 1202 | | El = b(identifier(Elem),Type,_), |
| 1203 | | findall(Elem,member(El,Elems),EnumElems), |
| 1204 | | pre_register_enumerated_set_with_elems(ID,EnumElems), |
| 1205 | | register_enumerated_sets(T,Elems). |
| 1206 | | |
| 1207 | | pre_register_enumerated_set_with_elems(GlobalSetName,ListOfConstants) :- |
| 1208 | | (enumerated_set(GlobalSetName) -> true |
| 1209 | | ; debug_format(19,'Pre-register ~w = ~w~n',[GlobalSetName,ListOfConstants]), |
| 1210 | | assertz(enumerated_set(GlobalSetName)), |
| 1211 | | LowBound=1, |
| 1212 | | add_named_constants_to_global_set(GlobalSetName,LowBound,ListOfConstants) % probably only lookup_global_constant relevant |
| 1213 | | ). |
| 1214 | | % pre-registering just the enumerated set name |
| 1215 | | pre_register_enumerated_set(GlobalSetName) :- |
| 1216 | | (enumerated_set(GlobalSetName) -> true |
| 1217 | | ; debug_format(9,'Pre-register ~w~n',[GlobalSetName]), |
| 1218 | | assertz(enumerated_set(GlobalSetName)) |
| 1219 | | ). |
| 1220 | | |
| 1221 | | |
| 1222 | | :- assert_pre(b_global_sets:assert_enumerated_set(_GS,_L,_,_),true). |
| 1223 | | % TODO(DP, 7.8.2008) |
| 1224 | | % (atomic(GS),type_check(L,list(xml_identifier)))). |
| 1225 | | :- assert_post(b_global_sets:assert_enumerated_set(_,_,L,U),(number(L),number(U))). |
| 1226 | | |
| 1227 | | % TODO: also process b_extract_values_clause_assignment(Cst,integer,Nr) facts ! |
| 1228 | | assert_enumerated_set(GlobalSetName,ListOfConstants,LowBound,UpBound) :- |
| 1229 | | pre_register_enumerated_set(GlobalSetName), |
| 1230 | | % print_message(enum_set(GlobalSetName,ListOfConstants)), |
| 1231 | | LowBound = 1, |
| 1232 | | length(ListOfConstants,UpBound), |
| 1233 | | assert_extract_setsize_from_machine_cache(GlobalSetName,LowBound,UpBound), |
| 1234 | | add_named_constants_to_global_set(GlobalSetName,LowBound,ListOfConstants). |
| 1235 | | |
| 1236 | | add_named_constants_to_global_set(GlobalSetName,LowBound,ListOfConstants) :- |
| 1237 | | (b_global_constant(GlobalSetName,CurNr,CurCst) |
| 1238 | | -> add_error_fail(add_named_constants_to_global_set,'Globalset already has constants: ', |
| 1239 | | b_global_constant(GlobalSetName,CurNr,CurCst)) |
| 1240 | | ; true), |
| 1241 | ? | nth0(Nr0,ListOfConstants,Cst), |
| 1242 | | (lookup_global_constant(Cst,fd(_,GS2)) |
| 1243 | | -> (GS2=GlobalSetName |
| 1244 | | -> add_internal_error('Duplicate element in global set:',(Cst,GS2)) % error is already caught by type checker |
| 1245 | | ; add_internal_error('Element appears in multiple sets:',(Cst,GS2,GlobalSetName)) % ditto |
| 1246 | | ) |
| 1247 | | ; true |
| 1248 | | ), |
| 1249 | | Nr is Nr0+LowBound, |
| 1250 | | assertz(b_global_constant(GlobalSetName,Nr,Cst)), |
| 1251 | | term_hash(fd(Nr,GlobalSetName),Hash), |
| 1252 | | assertz(b_global_constant_hash(Hash,GlobalSetName,Nr,Cst)), |
| 1253 | | assertz(lookup_global_constant(Cst,fd(Nr,GlobalSetName))), |
| 1254 | | %format('Added ~w as nr ~w to ~w~n',[Cst,Nr,GlobalSetName]), |
| 1255 | | fail. |
| 1256 | | add_named_constants_to_global_set(_,_,_). |
| 1257 | | |
| 1258 | | |
| 1259 | | %add_global_set_with_named_constants(GlobalSetName,ListOfConstants) :- |
| 1260 | | % (b_global_sets:assert_enumerated_set(GlobalSetName,ListOfConstants,_,_)), |
| 1261 | | % add_new_global_set(GlobalSetName). |
| 1262 | | |
| 1263 | | |
| 1264 | | |
| 1265 | | :- assert_pre(b_global_sets:b_extract_fd_type(_G,_L,_U),true). |
| 1266 | | :- assert_post(b_global_sets:b_extract_fd_type(G,L,U),(atomic(G),(integer(L),integer(U)))). |
| 1267 | | |
| 1268 | | b_extract_fd_type(GlobalSetName,LowBound,UpBound) :- |
| 1269 | ? | b_global_set(GlobalSetName), % was b_get_machine_set(GlobalSetName), |
| 1270 | | extract_setsize_from_machine(GlobalSetName,LowBound,UpBound). |
| 1271 | | |
| 1272 | | is_b_precompiled_globalset(GlobalSetName) :- extract_setsize_from_machine_cache(GlobalSetName,_,_). |
| 1273 | | |
| 1274 | | % like b_extract_fd_type above, but with GS known (avoids backtracking b_supplementary_global_set) |
| 1275 | | b_get_fd_type_bounds(NonvarGlobalSetname,LowBound,UpBound) :- nonvar(NonvarGlobalSetname), |
| 1276 | | extract_setsize_from_machine_cache(NonvarGlobalSetname,L,U), |
| 1277 | | !, |
| 1278 | | (LowBound,UpBound)=(L,U). |
| 1279 | | b_get_fd_type_bounds(GS,L,U) :- b_replaced_global_set(GS,_),!, |
| 1280 | | add_internal_error('Global set has been replaced: ',b_get_fd_type_bounds(GS,L,U)),fail. |
| 1281 | | b_get_fd_type_bounds(GS,L,U) :- |
| 1282 | | add_internal_error('Illegal call: ',b_get_fd_type_bounds(GS,L,U)),fail. |
| 1283 | | |
| 1284 | | |
| 1285 | | b_global_set_cardinality('STRING',Card) :- !, Card=inf. |
| 1286 | | b_global_set_cardinality('REAL',Card) :- !, Card=inf. |
| 1287 | | b_global_set_cardinality('FLOAT',Card) :- !, Card=18446744073709551616. % 2^64 - TO DO: check |
| 1288 | | b_global_set_cardinality('NAT',Card) :- !, get_preference(maxint,MaxInt), Card is MaxInt+1. |
| 1289 | | b_global_set_cardinality('NATURAL',Card) :- !, Card=inf. %get_preference(maxint,MaxInt), Card is MaxInt+1. |
| 1290 | | b_global_set_cardinality('NAT1',Card) :- !, get_preference(maxint,Card). |
| 1291 | | b_global_set_cardinality('NATURAL1',Card) :- !, Card=inf. % get_preference(maxint,Card). |
| 1292 | | b_global_set_cardinality('INT',Card) :- !, get_preference(maxint,MaxInt), |
| 1293 | | get_preference(minint,MinInt), |
| 1294 | | (MaxInt >= MinInt -> Card is MaxInt-MinInt+1 |
| 1295 | | ; add_error(b_global_set_cardinality,'MININT larger than MAXINT',(MinInt:MaxInt)), |
| 1296 | | Card = 0 |
| 1297 | | ). |
| 1298 | | b_global_set_cardinality('INTEGER',Card) :- !, Card=inf. % b_global_set_cardinality('INT',Card). |
| 1299 | | b_global_set_cardinality(GlobalSet,Card) :- nonvar(GlobalSet),!, |
| 1300 | | (b_fd_card(GlobalSet,C) -> Card=C |
| 1301 | | ; b_replaced_global_set(GlobalSet,_) -> |
| 1302 | | add_internal_error('Global set has been replaced: ', b_global_set_cardinality(GlobalSet,Card)), |
| 1303 | | fail |
| 1304 | | ; add_internal_error('Unknown global set: ', b_global_set_cardinality(GlobalSet,Card)), |
| 1305 | | fail). |
| 1306 | | b_global_set_cardinality(GlobalSet,Card) :- %b_global_set(GlobalSet), |
| 1307 | | b_extract_fd_type(GlobalSet,Low,Up), Card is 1+ Up - Low. |
| 1308 | | % enum_warning_for_global_set(GlobalSet,'assuming deferred set to be of given cardinality',Card,trigger_true(card)). |
| 1309 | | %% Note: The Disprover now checks whether unfixed_deferred sets were involved; keeping track of implicit enumerations of deferred sets is just too difficult |
| 1310 | | |
| 1311 | | b_fd_card(GlobalSet,Card) :- b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 1312 | | (Up=inf -> Card=inf ; Card is 1+Up-Low). |
| 1313 | | |
| 1314 | | b_non_empty_global_set(_). % allow_empty_global_sets no longer exists; all global_sets are non-empty |
| 1315 | | %b_non_empty_global_set(IntSet) :- b_integer_or_real_or_string_set(IntSet). |
| 1316 | | %b_non_empty_global_set(GlobalSet) :- b_global_set(GlobalSet), |
| 1317 | | % b_get_fd_type_bounds(GlobalSet,Low,Up), Up >= Low. |
| 1318 | | |
| 1319 | | b_empty_global_set(_) :- fail. % allow_empty_global_sets no longer exists; all global_sets are non-empty |
| 1320 | | %b_empty_global_set(GlobalSet) :- %b_global_set(GlobalSet), |
| 1321 | | % b_get_fd_type_bounds(GlobalSet,Low,Up), Up < Low. |
| 1322 | | |
| 1323 | | |
| 1324 | | b_integer_or_real_or_string_set('STRING'). |
| 1325 | | b_integer_or_real_or_string_set('FLOAT'). |
| 1326 | | b_integer_or_real_or_string_set('REAL'). |
| 1327 | | b_integer_or_real_or_string_set(X) :- b_integer_set(X). |
| 1328 | | |
| 1329 | | b_integer_or_real_set('REAL'). |
| 1330 | | b_integer_or_real_set('FLOAT'). |
| 1331 | | b_integer_or_real_set(X) :- b_integer_set(X). |
| 1332 | | |
| 1333 | | b_integer_set('NAT'). b_integer_set('NATURAL'). |
| 1334 | | b_integer_set('NAT1'). b_integer_set('NATURAL1'). |
| 1335 | | b_integer_set('INT'). b_integer_set('INTEGER'). |
| 1336 | | |
| 1337 | | % convert a type term into a global_set term |
| 1338 | | try_b_type2global_set(string,R) :- !, R= global_set('STRING'). |
| 1339 | | try_b_type2global_set(integer,R) :- !, R= global_set('INTEGER'). |
| 1340 | | try_b_type2global_set(real,R) :- !, R= global_set('REAL'). |
| 1341 | | try_b_type2global_set(global(GS),R) :- b_global_set(GS),!, R=global_set(GS). |
| 1342 | | try_b_type2global_set(freetype(ID),R) :- !, R=freetype(ID). |
| 1343 | | try_b_type2global_set(boolean,R) :- !, |
| 1344 | | %custom_explicit_sets:construct_avl_from_lists([pred_false /* bool_false */,pred_true /* bool_true */],R). |
| 1345 | | R = avl_set(node(pred_false,true,1,empty,node(pred_true,true,0,empty,empty))). |
| 1346 | | |
| 1347 | | b_type2_set(GS,Res) :- try_b_type2global_set(GS,GR),!, Res=GR. |
| 1348 | | b_type2_set(Type,Res) :- Res = closure(['_zzzz_unary'],[Type],b(truth,pred,[])). |
| 1349 | | %b_type2global_set(GS,_) :- add_error_and_fail(b_type2_set,'Type cannot be converted to global_set: ',GS). |
| 1350 | | |
| 1351 | | :- use_module(fd_utils_clpfd). % in_fd, fd_domain |
| 1352 | | |
| 1353 | | global_type(fd(X,GlobalSet),GlobalSet) :- %b_global_set(GlobalSet), |
| 1354 | | if(b_get_fd_type_bounds(GlobalSet,Low,Up), %print(b_get_fd_type_bounds(X,GlobalSet,Low,Up)),nl, when(nonvar(X),trace), |
| 1355 | | % print(in_fd(X,Low,Up)),nl, |
| 1356 | | in_fd(X,Low,Up), |
| 1357 | | add_internal_error('Illegal global set: ',global_type(fd(X,GlobalSet),GlobalSet))). |
| 1358 | | global_type2(X,GlobalSet) :- %b_global_set(GlobalSet), |
| 1359 | | if(b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 1360 | | in_fd(X,Low,Up), |
| 1361 | | add_internal_error('Illegal global set: ',global_type2(X,GlobalSet))). |
| 1362 | | |
| 1363 | | global_type_wf(fd(X,GlobalSet),GlobalSet,WF) :- %b_global_set(GlobalSet), |
| 1364 | | b_get_fd_type_bounds(GlobalSet,Low,Up), %print(b_get_fd_type_bounds(X,GlobalSet,Low,Up)),nl, |
| 1365 | | in_fd_wf(X,Low,Up,WF). |
| 1366 | | |
| 1367 | | % get value and setup global_type FD constraint if it is a variable |
| 1368 | | get_global_type_value(FD,Type,X) :- |
| 1369 | | (var(FD) % print(fresh(Type,FD)),nl, |
| 1370 | | -> (nonvar(Type) |
| 1371 | | -> global_type2(X,Type) % instantiate FD bounds if we create a fresh FD variable X |
| 1372 | | ; true |
| 1373 | | ), |
| 1374 | | FD = fd(X,Type) |
| 1375 | | ; FD = fd(X,TypeX), |
| 1376 | | (Type \== TypeX, nonvar(Type), nonvar(TypeX) |
| 1377 | | -> add_internal_error('FD Type error:',get_global_type_value(FD,Type,X)) |
| 1378 | | ; true), |
| 1379 | | TypeX=Type |
| 1380 | | ). |
| 1381 | | |
| 1382 | | % like enum_global_type but with a nonvar GlobalSet + generate enum_warning for deferred set (currently commented out) |
| 1383 | | enumerate_global_type_with_enum_warning(R,GlobalSet,EnumWarning,WF) :- var(R),!, % print(enum_var(R,GlobalSet)),nl, |
| 1384 | | b_get_fd_type_bounds_with_enum_warning(X,GlobalSet,Low,Up,EnumWarning,WF), |
| 1385 | | % first setup CLP(FD) bounds before enumerating |
| 1386 | | in_fd(X,Low,Up), % Note: Up can be the restricted range for infinite sets |
| 1387 | | R=fd(X,GlobalSet), |
| 1388 | ? | enum_fd(X,Low,Up). |
| 1389 | | enumerate_global_type_with_enum_warning(fd(X,GlobalSet),GlobalSet,EnumWarning,WF) :- |
| 1390 | | (nonvar(X) -> true |
| 1391 | | ; b_get_fd_type_bounds_with_enum_warning(X,GlobalSet,Low,Up,EnumWarning,WF), |
| 1392 | ? | enum_fd(X,Low,Up) |
| 1393 | | ). |
| 1394 | | |
| 1395 | | b_get_fd_type_bounds_with_enum_warning(X,GlobalSet,Low2,Up2,EnumWarning,WF) :- |
| 1396 | | b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 1397 | | (Up=inf |
| 1398 | | -> fd_domain(X,LowX,UpX), |
| 1399 | | (integer(UpX), integer(LowX) -> Low2=LowX, Up2=UpX |
| 1400 | | ; get_preference(maxint,MaxInt), |
| 1401 | | (integer(LowX), LowX >= MaxInt -> |
| 1402 | | gen_enum_warning_wf(GlobalSet,Low:Up,LowX:LowX,EnumWarning,unknown,WF), |
| 1403 | | Low2=LowX, Up2=LowX % we could increase Up2, e.g., to LowX+MaxInt |
| 1404 | | ; gen_enum_warning_wf(GlobalSet,Low:Up,Low:MaxInt,EnumWarning,unknown,WF), |
| 1405 | | Low2=Low, Up2=MaxInt |
| 1406 | | ) |
| 1407 | | ) |
| 1408 | | ; Low2=Low,Up2=Up |
| 1409 | | ). |
| 1410 | | |
| 1411 | | % enumerate global types, but limit infinite ones |
| 1412 | | enum_global_type_limited(fd(X,GlobalSet),GlobalSet) :- %b_global_set(GlobalSet), |
| 1413 | | (nonvar(GlobalSet) -> |
| 1414 | ? | (b_get_fd_type_bounds_limited(GlobalSet,Low,Up) -> enum_global_type_aux(X,Low,Up,GlobalSet) |
| 1415 | | ; add_internal_error('Illegal value: ',enum_global_type(fd(X,GlobalSet),GlobalSet)),fail) |
| 1416 | | ; b_global_set(GlobalSet), |
| 1417 | | b_get_fd_type_bounds(GlobalSet,Low,Up), |
| 1418 | | enum_global_type_aux(X,Low,Up,GlobalSet) |
| 1419 | | ). |
| 1420 | | |
| 1421 | | enum_global_type_aux(X,Low,Up,GlobalSet) :- |
| 1422 | | atomic(X), |
| 1423 | | !, |
| 1424 | | (number(X),X >= Low, X =< Up |
| 1425 | | -> true |
| 1426 | | ; add_internal_error('Illegal value: ', enum_global_type_aux(X,Low,Up,GlobalSet))). |
| 1427 | | enum_global_type_aux(X,Low,Up,_GlobalSet) :- |
| 1428 | ? | enum_fd(X,Low,Up). |
| 1429 | | |
| 1430 | | % get range information for global set and generate warning if necessary |
| 1431 | | %b_fd_type_with_enum_warning(GlobalSet,Low,Up) :- |
| 1432 | | % b_fd_type(GlobalSet,Low,Up), |
| 1433 | | % enum_warning_for_global_set(GlobalSet,'assuming deferred set to be of finite cardinality',Up,trigger_true(card)). |
| 1434 | | |
| 1435 | | /* ------------------------------------- */ |
| 1436 | | |
| 1437 | | all_elements_of_type(Type,Set) :- |
| 1438 | | all_elements_of_type_wf(Type,Set,no_wf_available). |
| 1439 | | |
| 1440 | | :- block all_elements_of_type_wf(-,?,?). |
| 1441 | | all_elements_of_type_wf(Type,Set,WF) :- % print(all_elements(Type,Set)),nl, |
| 1442 | | all_elements_of_type2(Type,Set,WF). |
| 1443 | | |
| 1444 | | :- use_module(kernel_objects,[all_strings_wf/2, gen_enum_warning_wf/6]). |
| 1445 | | all_elements_of_type2('STRING',Res,WF) :- !, |
| 1446 | | all_strings_wf(Res,WF). |
| 1447 | | all_elements_of_type2('NAT',Res,_WF) :- !, get_preference(maxint,MaxInt), |
| 1448 | | gen_int_set(0,MaxInt,Res). |
| 1449 | | all_elements_of_type2('NATURAL',Res,WF) :- !, get_preference(maxint,MaxInt), |
| 1450 | | gen_enum_warning_wf('NATURAL',0:sup,0:MaxInt,trigger_throw('NATURAL'),unknown,WF), %print('### Warning: expanding NATURAL'),nl, |
| 1451 | | gen_int_set(0,MaxInt,Res). |
| 1452 | | all_elements_of_type2('NAT1',Res,_WF) :- !, get_preference(maxint,MaxInt), |
| 1453 | | gen_int_set(1,MaxInt,Res). |
| 1454 | | all_elements_of_type2('NATURAL1',Res,WF) :- !, |
| 1455 | | get_preference(maxint,MaxInt), |
| 1456 | | gen_enum_warning_wf('NATURAL1',1:sup,1:MaxInt,trigger_throw('NATURAL1'),unknown,WF), %print('### Warning: expanding NATURAL1'),nl, |
| 1457 | | gen_int_set(1,MaxInt,Res). |
| 1458 | | all_elements_of_type2('INT',Res,_WF) :- !, get_preference(maxint,MaxInt), |
| 1459 | | get_preference(minint,MinInt), |
| 1460 | | gen_int_set(MinInt,MaxInt,Res). |
| 1461 | | all_elements_of_type2('INTEGER',Res,WF) :- !, get_preference(maxint,MaxInt), |
| 1462 | | get_preference(minint,MinInt), |
| 1463 | | gen_enum_warning_wf('INTEGER',inf:sup,MinInt:MaxInt,trigger_throw('INTEGER'),unknown,WF), %print('### Warning: expanding INTEGER'),nl, |
| 1464 | | gen_int_set(MinInt,MaxInt,Res). |
| 1465 | | all_elements_of_type2('FLOAT',Res,WF) :- !, all_elements_of_type2('REAL',Res,WF). |
| 1466 | | all_elements_of_type2('REAL',Res,WF) :- !, |
| 1467 | | gen_enum_warning_wf('REAL',inf:sup,0.0:1.0,trigger_throw('REAL'),unknown,WF), |
| 1468 | | Res = [term(floating(0.0)),term(floating(1.0))]. % not sure this will ever be used |
| 1469 | | all_elements_of_type2(Type,Set,WF) :- |
| 1470 | | b_get_fd_type_bounds(Type,Low,Up), |
| 1471 | | (Up=inf |
| 1472 | | -> get_preference(maxint,MaxInt), % infinite deferred set |
| 1473 | | gen_enum_warning_wf(Type,Low:Up,Low:MaxInt,trigger_throw(Type),unknown,WF), |
| 1474 | | findall(fd(El,Type),enum_fd_linear(El,Low,MaxInt),Set) |
| 1475 | | ; % ensure we do not use Random enumeration |
| 1476 | | findall(fd(El,Type),enum_fd_linear(El,Low,Up),Set) |
| 1477 | | ). |
| 1478 | | |
| 1479 | | % a version of all_elements_of_type which may randomise element order if preference set |
| 1480 | | :- block all_elements_of_type_rand_wf(-,?,?). |
| 1481 | | all_elements_of_type_rand_wf(Type,Set,WF) :- % print(all_elements(Type,Set)),nl, |
| 1482 | | all_elements_of_type_rand2(Type,Set,WF). |
| 1483 | | |
| 1484 | ? | all_elements_of_type_rand2(Type,Set,_WF) :- b_global_set(Type),!, |
| 1485 | | b_get_fd_type_bounds(Type,Low,Up), |
| 1486 | | % may use Random enumeration if preference RANDOMISE_ENUMERATION_ORDER set |
| 1487 | | findall(fd(El,Type),enum_fd(El,Low,Up),Set). |
| 1488 | | all_elements_of_type_rand2(Type,Set,WF) :- % TO DO: we could permute the solution here; but currently all_elements_of_type_rand2 is only called for enumerated/deferred sets |
| 1489 | | all_elements_of_type2(Type,Set,WF). |
| 1490 | | |
| 1491 | | |
| 1492 | | gen_int_set(Min,Max,Set) :- |
| 1493 | | (Min>Max -> Set = [] |
| 1494 | | ; Set = [int(Min)|RSet], |
| 1495 | | M1 is Min+1, |
| 1496 | | gen_int_set(M1,Max,RSet)). |
| 1497 | | |
| 1498 | | %% list_contains_unfixed_deferred_set_id(+TypedIds). |
| 1499 | | list_contains_unfixed_deferred_set_id([b(identifier(_),Type,_)|_]) :- |
| 1500 | | contains_unfixed_deferred_set(Type), |
| 1501 | | !. |
| 1502 | | list_contains_unfixed_deferred_set_id([_|T]) :- |
| 1503 | | list_contains_unfixed_deferred_set_id(T). |
| 1504 | | |
| 1505 | | % ----------------- |
| 1506 | | :- public portray_global_sets/0. % debugging utility |
| 1507 | | portray_global_sets :- |
| 1508 | | (enumerated_sets_precompiled -> Comp=true ; Comp=false), |
| 1509 | | format('ENUMERATED SETS (precompiled=~w):~n ',[Comp]), |
| 1510 | | enumerated_set(GS), |
| 1511 | | format(' ~w ',[GS]), |
| 1512 | | fail. |
| 1513 | | portray_global_sets :- |
| 1514 | | (deferred_sets_precompiled -> Comp=true ; Comp=false), |
| 1515 | | format('~nDEFERRED SETS with some constants (precompiled=~w):~n ',[Comp]), |
| 1516 | | b_partially_deferred_set(GS), |
| 1517 | | (is_b_global_constant(GS,_Nr,Cst) -> true), |
| 1518 | | format(' ~w {~w,...} ',[GS, Cst]), |
| 1519 | | (fixed_deferred_set_size(GS,RCard) |
| 1520 | | -> format('(fixed card ~w) ',[RCard]) |
| 1521 | | ; inferred_maximum_global_set_cardinality(GS,MaxCard) |
| 1522 | | -> format('(max card ~w) ',[MaxCard])), |
| 1523 | | fail. |
| 1524 | | portray_global_sets :- |
| 1525 | | (deferred_sets_precompiled -> Comp=true ; Comp=false), |
| 1526 | | format('~nDEFERRED SETS (precompiled=~w):~n ',[Comp]), |
| 1527 | | b_global_deferred_set(GS), |
| 1528 | | format(' ~w ',[GS]), |
| 1529 | | (fixed_deferred_set_size(GS,RCard) |
| 1530 | | -> format('(fixed card ~w) ',[RCard]) |
| 1531 | | ; inferred_maximum_global_set_cardinality(GS,MaxCard) |
| 1532 | | -> format('(max card ~w) ',[MaxCard])), |
| 1533 | | fail. |
| 1534 | | portray_global_sets :- nl. |