| 1 | | % (c) 2009-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
| 2 | | % Heinrich Heine Universitaet Duesseldorf |
| 3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
| 4 | | |
| 5 | | :- module(bsyntaxtree, |
| 6 | | [is_texpr/1, % checks if the given argument is a typed expression |
| 7 | | |
| 8 | | get_texpr_expr/2, % get the expression part of a typed expression |
| 9 | | get_texpr_type/2, % get the type of a typed expression |
| 10 | | get_texpr_info/2, % get the list of information of a typed expression |
| 11 | | get_texpr_id/2, % get the id of a typed identifier, fails if it's not an identifier |
| 12 | | def_get_texpr_id/2, % same as above, but raises error if arg1 is not an identifier |
| 13 | | def_get_texpr_ids/2, % maplist of the above, i.e., translate a typed id list into a plain list of id names |
| 14 | | create_typed_id/3, % create a typed identifier |
| 15 | | create_typed_ids/3, % create a list of typed identifiers from list of names and types |
| 16 | | same_id/3, % true if two typed identifiers have the same id |
| 17 | | same_ids/2, % true if two lists of typed identifiers have the same ids |
| 18 | | same_ids_and_types/2, % also check types |
| 19 | | split_names_and_types/3, % split list of typed ids into ids and types |
| 20 | | get_texpr_exprs/2, % list variant of the above |
| 21 | | get_texpr_types/2, % list variant of the above |
| 22 | | get_texpr_infos/2, % list variant of the above |
| 23 | | get_texpr_ids/2, % list variant of the above |
| 24 | | get_texpr_pos/2, % get the position of a typed expression |
| 25 | | get_texpr_pos_infos/2, % the a list containing the position infos, sublist of get_texpr_infos |
| 26 | | extract_pos_infos/2, % get the position info sub list of an info list |
| 27 | | copy_pos_infos/3, % copy position infos from one typed expression to another |
| 28 | | delete_pos_info/2, % delete position info from an info list |
| 29 | | propagate_pos_info_if_useful/3, % propagate position info from second list if useful |
| 30 | | merge_info/3, % merge two information lists as well as possible |
| 31 | | update_infos/3, % provide updates to an existing info list |
| 32 | | get_info_pos/2, % get the position directly from info field |
| 33 | | contains_info_pos/1, % true if info field contains position infos |
| 34 | | |
| 35 | | same_texpr/2, % check if two typed expressions are equal modulo Info fields |
| 36 | | different_texpr_values/2, % check if two type expressions are WD and definitely denote different values |
| 37 | | |
| 38 | | create_texpr/4, % creates a typed expression by giving expression, type and infos |
| 39 | | add_texpr_infos/3, % adds some more information to a typed expression at front |
| 40 | | add_texpr_info_if_new/3, % adds one info field to typed B expression info list at front if it is new |
| 41 | | add_texpr_infos_if_new/3, % ditto but list of infos can be added |
| 42 | | add_info_if_new/3, % adds to info list |
| 43 | | add_infos_if_new/3, % same for list of info items |
| 44 | | safe_create_texpr/3, % a version of create_texpr which extracts wd-info from sub-expressionssafe_create_texpr |
| 45 | | safe_create_texpr/4, |
| 46 | | texpr_contains_wd_condition/1, |
| 47 | | sub_expression_contains_wd_condition/1, % utility to check if sub-expression contains wd condition |
| 48 | | |
| 49 | | get_rodin_name/2, get_rodin_model_name/2, |
| 50 | | is_rodin_label_info/1, |
| 51 | | get_texpr_label/2, get_texpr_labels/2, |
| 52 | | get_info_labels/2, select_info_labels/3, |
| 53 | | add_labels_to_texpr/3, |
| 54 | | get_texpr_description/2, % get @desc pragma for typed expression |
| 55 | | add_texpr_description/3, % add an additional description by hand |
| 56 | | info_has_ignore_pragma/1, % check if an info list has an ignore pragma |
| 57 | | predicate_has_ignore_pragma/1, % ditto for the info list of a predicate |
| 58 | | always_well_defined/1, always_well_defined_or_disprover_mode/1, |
| 59 | | always_well_defined_or_wd_reorderings_allowed/1, |
| 60 | | always_well_defined_or_wd_improvements_allowed/1, |
| 61 | | finite_wd_set_value/1, finite_set_or_disprover_mode/1, |
| 62 | | is_truth/1, is_falsity/1, |
| 63 | | conjunct_predicates/2, |
| 64 | | conjunct_predicates_with_pos_info/3, conjunct_predicates_with_pos_info/2, |
| 65 | | is_a_conjunct/3, is_a_conjunct_without_label/3, decompose_conjunct/3, |
| 66 | | is_a_disjunct/3, is_an_implication/3, is_an_equivalence/3, is_a_negation/2, |
| 67 | | conjunction_to_list/2, |
| 68 | | conjunction_to_list_with_rodin_labels/2, % a variation which propagates labels down to conjuncts |
| 69 | | member_in_conjunction/2, select_member_in_conjunction/3, |
| 70 | | flatten_conjunctions/2, |
| 71 | | size_of_conjunction/2, |
| 72 | | member_in_conjunction_cse/3, |
| 73 | | disjunct_predicates/2, |
| 74 | | disjunct_predicates_with_pos_info/3, |
| 75 | | disjunction_to_list/2, |
| 76 | | is_a_disjunct_or_implication/4, |
| 77 | | is_a_conjunct_or_neg_disj/3, |
| 78 | | |
| 79 | | predicate_components/2, % split a predicate into components which use distinct identifiers |
| 80 | | predicate_components_in_scope/3, % ditto with an optional list of local variables |
| 81 | | predicate_components_with_restriction/4, |
| 82 | | predicate_identifiers/2, predicate_identifiers_in_scope/3, |
| 83 | | |
| 84 | | project_predicate_on_identifiers/5, |
| 85 | | |
| 86 | | find_identifier_uses_top_level/2, % not including global sets and constants |
| 87 | | find_identifier_uses/3, find_identifier_uses_if_necessary/3, |
| 88 | | find_identifier_uses_l/3, |
| 89 | | find_typed_identifier_uses/3, |
| 90 | | find_typed_identifier_uses/2, % not including global sets and constants |
| 91 | | find_typed_identifier_uses_l/3, |
| 92 | | find_identifier_uses_for_quantifier_body/3, |
| 93 | | get_global_identifiers/1, get_global_identifiers/2, |
| 94 | | occurs_in_expr/2, some_id_occurs_in_expr/2, |
| 95 | | single_usage_identifier/3, |
| 96 | | update_used_ids/3, |
| 97 | | check_computed_used_ids/2, |
| 98 | | |
| 99 | | create_exists/3, create_or_merge_exists/3, |
| 100 | | create_exists_or_let_predicate/3, |
| 101 | | create_exists_opt_liftable/3, |
| 102 | | create_exists_opt/3, create_exists_opt/4, create_exists_opt/5, |
| 103 | | not_generated_exists_paras/1, |
| 104 | | create_forall/3, |
| 105 | | create_negation/2, is_negation_of/2, get_negated_operator_expr/2, |
| 106 | | create_implication/3, |
| 107 | | create_equivalence/3, |
| 108 | | is_equality/3, |
| 109 | | create_equality/3, split_equality/3, get_texpr_couple/3, |
| 110 | | create_couple/3, create_couple/2, nested_couple_to_list/2, |
| 111 | | create_cartesian_product/3, |
| 112 | | create_comprehension_set/4, |
| 113 | | is_eventb_comprehension_set/4, is_eventb_comprehension_set/6, |
| 114 | | singleton_set_extension/2, |
| 115 | | is_membership/3, is_membership_or_equality/3, |
| 116 | | get_lambda_equality/4, |
| 117 | | is_pow_subset/2, is_pow1_subset/2, |
| 118 | | |
| 119 | | detect_global_predicates/4, |
| 120 | | |
| 121 | | definitely_not_empty_set/1, definitely_empty_set/1, definitely_not_empty_finite_value/1, |
| 122 | | get_integer/2, |
| 123 | | get_interval/3, |
| 124 | | |
| 125 | | replace_id_by_expr/4, |
| 126 | | replace_id_by_expr_with_count/5, % also count number of replacements |
| 127 | | replace_ids_by_exprs/4, |
| 128 | | remove_used_id_from_info/3, % remove an id from used_id info field if it exists |
| 129 | | remove_used_ids_from_info/3, % remove list of ids (order of args different !) |
| 130 | | |
| 131 | | rename_bt/3, % a simplified version of replace_ids_by_exprs, which assumes target of renamings are variables |
| 132 | | rename_bt_l/3, |
| 133 | | remove_bt/4, |
| 134 | | syntaxtransformation/5, |
| 135 | | syntaxtransformation_det/5, % faster, non-backtracking version |
| 136 | | syntaxtransformation_for_renaming/5, |
| 137 | | remove_renamings/3, |
| 138 | | |
| 139 | | map_over_bexpr/2, map_over_typed_bexpr/2, map_over_typed_bexpr/3, |
| 140 | | map_over_typed_bexpr_with_names/2, |
| 141 | | map_over_bexpr_top_down_acc/3, map_over_typed_bexpr_top_down_acc/3, |
| 142 | | reduce_over_bexpr/4, |
| 143 | | transform_bexpr/3, % transform a typed B expression bottom-up |
| 144 | | transform_bexpr_with_scoping/3, % ditto, but we also provide info about local ids |
| 145 | | transform_bexpr_td_with_scoping/3, % top-down with scoping |
| 146 | | transform_bexpr_with_bup_accs/5, transform_bexpr_with_acc/5, |
| 147 | | non_det_transform_bexpr_with_acc/5, % can be used to generate several transformed expressions |
| 148 | | uses_implementable_integers/1, |
| 149 | | min_max_integer_value_used/3, min_max_integer_value_used/5, |
| 150 | | syntaxtraversion/6, |
| 151 | | safe_syntaxelement/5, |
| 152 | | safe_syntaxelement_det/5, % a deterministic, non-backtracking version |
| 153 | | is_subst_syntaxelement/1, |
| 154 | | is_syntax_constant/1, |
| 155 | | |
| 156 | | expand_all_lets/2, |
| 157 | | |
| 158 | | remove_all_infos/2, extract_info/2, extract_info/3, extract_info_wo_used_ids/2, |
| 159 | | bsyntax_pattern/2, |
| 160 | | |
| 161 | | remove_all_infos_and_ground/2, |
| 162 | | |
| 163 | | check_if_typed_predicate/1, |
| 164 | | check_if_typed_expression/1, |
| 165 | | check_if_typed_substitution/1, |
| 166 | | |
| 167 | | strip_and_norm_ast/2, |
| 168 | | same_norm_texpr/2, |
| 169 | | get_texpr_functor/3, |
| 170 | | |
| 171 | | is_set_type/2, get_set_type/2, get_texpr_set_type/2, |
| 172 | | is_just_type/1, is_just_type/2, |
| 173 | | get_texpr_boolean/2, |
| 174 | | |
| 175 | | create_recursive_compset/6, |
| 176 | | unique_typed_id/3, |
| 177 | | mark_bexpr_as_symbolic/2, |
| 178 | | |
| 179 | | identifier_sub_ast/3, exchange_ast_position/5, |
| 180 | | |
| 181 | | has_declared_identifier/2, add_declaration_for_identifier/3, |
| 182 | | check_ast/1, check_ast/2, |
| 183 | | repair_used_ids/3, |
| 184 | | print_ast/1, |
| 185 | | rewrite_if_then_else_expr_to_b/2, |
| 186 | | normalise_bexpr_for_ml/2 |
| 187 | | ]). |
| 188 | | |
| 189 | | % meta_predicate annotations should appear before loading any code: |
| 190 | | |
| 191 | | :- meta_predicate map_over_full_bexpr_no_fail(1,?). |
| 192 | | |
| 193 | | :- meta_predicate map_over_bexpr(1,?). |
| 194 | | :- meta_predicate map_over_typed_bexpr(1,?). |
| 195 | | :- meta_predicate map_over_typed_bexpr(2,?,?). |
| 196 | | :- meta_predicate map_over_bexpr_top_down_acc(3,?,?). |
| 197 | | :- meta_predicate map_over_typed_bexpr_top_down_acc(3,?,?). |
| 198 | | |
| 199 | | :- meta_predicate reduce_over_bexpr(3,?,?,?). |
| 200 | | :- meta_predicate transform_bexpr(2,?,?). |
| 201 | | :- meta_predicate l_transform_bexpr(?,2,?). |
| 202 | | :- meta_predicate transform_bexpr_with_scoping(3,?,?). |
| 203 | | :- meta_predicate transform_bexpr_td_with_scoping(3,?,?). |
| 204 | | :- meta_predicate transform_bexpr_with_scoping2(3,?,?,?). |
| 205 | | :- meta_predicate l_transform_bexpr_with_scoping(?,3,?,?). |
| 206 | | :- meta_predicate transform_bexpr_with_bup_accs(4,?,?,?,?). |
| 207 | | :- meta_predicate l_transform_bexpr_with_bup_accs(?,4,?,?,?). |
| 208 | | :- meta_predicate transform_bexpr_with_acc(4,?,?,?,?). |
| 209 | | :- meta_predicate l_transform_bexpr_with_acc(?,4,?,?,?). |
| 210 | | :- meta_predicate non_det_transform_bexpr_with_acc(4,?,?,?,?). |
| 211 | | :- meta_predicate l_nd_transform_bexpr_with_acc(?,4,?,?,?). |
| 212 | | |
| 213 | | % ----------- |
| 214 | | |
| 215 | | |
| 216 | | :- use_module(tools). |
| 217 | | |
| 218 | | :- use_module(module_information,[module_info/2]). |
| 219 | | :- module_info(group,typechecker). |
| 220 | | :- module_info(description,'This module provides operations on the type-checked AST.'). |
| 221 | | |
| 222 | | :- use_module(library(lists)). |
| 223 | | :- use_module(library(ordsets)). |
| 224 | | :- use_module(library(avl)). |
| 225 | | :- use_module(library(terms)). |
| 226 | | |
| 227 | | :- use_module(self_check). |
| 228 | | :- use_module(error_manager). |
| 229 | | :- use_module(translate,[print_bexpr/1,translate_bexpression/2]). |
| 230 | | :- use_module(gensym,[gensym/2]). |
| 231 | | :- use_module(preferences,[get_preference/2,preference/2]). |
| 232 | | :- use_module(debug,[debug_mode/1,debug_format/3]). |
| 233 | | |
| 234 | | :- use_module(typing_tools,[is_finite_type_in_context/2,normalize_type/2]). |
| 235 | | :- use_module(tools_lists,[convlist_max/4]). |
| 236 | | |
| 237 | | :- set_prolog_flag(double_quotes, codes). |
| 238 | | |
| 239 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 240 | | % basic access to enriched syntax tree |
| 241 | | |
| 242 | | is_texpr(b(_,_,_)). |
| 243 | | |
| 244 | | get_texpr_expr(b(Name,_,_),R) :- !,R=Name. |
| 245 | | get_texpr_expr(E,_) :- add_error_fail(get_texpr_expr,'B Expression not properly wrapped: ',E). |
| 246 | | |
| 247 | | get_texpr_type(b(_,Type,_),R) :- !, R=Type. |
| 248 | | get_texpr_type(E,_) :- add_error_fail(get_texpr_type,'B Expression not properly wrapped: ',E). |
| 249 | | get_texpr_info(b(_,_,Info),R) :- !, R=Info. |
| 250 | | get_texpr_info(E,_) :- add_error_fail(get_texpr_info,'B Expression not properly wrapped: ',E). |
| 251 | | |
| 252 | | %! get_texpr_id(+Texpr,-Id) |
| 253 | | get_texpr_id(b(N,_,_),Id) :- !, N=identifier(Id). |
| 254 | | get_texpr_id(E,_) :- add_error_fail(get_texpr_id,'B Expression not properly wrapped: ',E). |
| 255 | | /* same as above: but must succeed */ |
| 256 | | def_get_texpr_id(b(identifier(Id),_,_),R) :- !,R=Id. |
| 257 | | def_get_texpr_id(b(E,_,_),_) :- !, |
| 258 | | add_error_fail(def_get_texpr_id,'Could not extract identifier from typed expression: ',E). |
| 259 | | def_get_texpr_id(ID,_) :- add_error_fail(def_get_texpr_id,'Could not extract identifier, not properly wrapped: ',ID). |
| 260 | | |
| 261 | | % translate a list of ids with the b/3 wrapper into a plain id list; throw error if not an identifier |
| 262 | | % used to also be called get_texpr_id_names |
| 263 | | def_get_texpr_ids(L,Ids) :- maplist(def_get_texpr_id,L,Ids). |
| 264 | | |
| 265 | | create_typed_id(IDName,Type,b(identifier(IDName),Type,[])). |
| 266 | | |
| 267 | | create_typed_ids([],[],[]). |
| 268 | | create_typed_ids([ID|TI],[Type|TT],[TID| TRes]) :- |
| 269 | | create_typed_id(ID,Type,TID), |
| 270 | | create_typed_ids(TI,TT,TRes). |
| 271 | | |
| 272 | | same_id(X,Y,ID) :- get_texpr_id(X,ID), get_texpr_id(Y,ID). |
| 273 | | |
| 274 | | same_ids([],[]). |
| 275 | | same_ids([X|Xs],[Y|Ys]) :- same_id(X,Y,_), same_ids(Xs,Ys). |
| 276 | | |
| 277 | | % check if two lists of identifiers have the same name and types |
| 278 | | same_ids_and_types([],[]). |
| 279 | | same_ids_and_types([b(identifier(Id),T1,_)|Xs],[b(identifier(Id),T2,_)|Ys]) :- unify_types_strict(T1,T2), |
| 280 | | same_ids_and_types(Xs,Ys). |
| 281 | | |
| 282 | | % split a list of typed identifiers into atomic ids and types |
| 283 | | split_names_and_types([],N,T) :- !, N=[], T=[]. |
| 284 | | split_names_and_types([Identifier|IdRest],[Name|NRest],[Type|TRest]) :- !, |
| 285 | | def_get_texpr_id(Identifier,Name), |
| 286 | | get_texpr_type(Identifier,Type), |
| 287 | | split_names_and_types(IdRest,NRest,TRest). |
| 288 | | split_names_and_types(TIDS,N,R) :- |
| 289 | | add_internal_error('Illegal call to:',split_names_and_types(TIDS,N,R)),fail. |
| 290 | | |
| 291 | | |
| 292 | | |
| 293 | | % check if two wrapped expressions are equal (modulo associated Info, e.g. source loc info) |
| 294 | | same_texpr(b(E1,Type,_),b(E2,Type,_)) :- % should we do a == check first ?? probably not as it may traverse the entire structure (see email exchange with SICStus 28.1.2015) |
| 295 | | same_functor(E1,E2), |
| 296 | | safe_syntaxelement_det(E1,Subs1,_Names1,_List1,Constant), |
| 297 | | safe_syntaxelement_det(E2,Subs2,_Names2,_List2,Constant2), |
| 298 | | Constant==Constant2, % in case we have values with variables inside ! |
| 299 | | same_sub_expressions(Subs1,Subs2). |
| 300 | | |
| 301 | | same_sub_expressions([],[]). |
| 302 | | same_sub_expressions([H1|T1],[H2|T2]) :- same_texpr(H1,H2), same_sub_expressions(T1,T2). |
| 303 | | |
| 304 | | % check if two wrapped expressions definitely denote a different value (and are well-defined) |
| 305 | | % only detects certain cases ! |
| 306 | | different_texpr_values(b(E1,Type,I1),b(E2,Type,I2)) :- |
| 307 | | different_value(E1,E2,CheckWD), |
| 308 | | (CheckWD=false -> true |
| 309 | | ; always_well_defined_or_wd_improvements_allowed(b(E1,Type,I1)), |
| 310 | | always_well_defined_or_wd_improvements_allowed(b(E2,Type,I2))). |
| 311 | | different_value(boolean_false,boolean_true,false) :- !. |
| 312 | | different_value(boolean_true,boolean_false,false) :- !. |
| 313 | | different_value(integer(X),IY,false) :- get_integer_aux(IY,Y),!, X\=Y. |
| 314 | | different_value(string(X),string(Y),false) :- !, X\=Y. |
| 315 | | different_value(value(VX),Y,false) :- !, different_val_from(VX,Y). |
| 316 | | different_value(empty_set,S,check_wd) :- !, non_empty_set(S). |
| 317 | | different_value(S,empty_set,check_wd) :- !, non_empty_set(S). |
| 318 | | % should we compare two set_extensions ? couples ? records ? reals/floats? |
| 319 | | |
| 320 | | different_val_from(Var,_) :- var(Var),!,fail. |
| 321 | | different_val_from(int(X),IY) :- integer(X), get_integer_aux(IY,Y), X\=Y. |
| 322 | | different_val_from(fd(X,Gs),value(FY)) :- nonvar(X), nonvar(FY), FY=fd(Y,Gs), nonvar(Y), X\=Y. |
| 323 | | different_val_from(pred_false,boolean_true). |
| 324 | | different_val_from(pred_false,value(BY)) :- BY==pred_true. |
| 325 | | different_val_from(pred_true,boolean_false). |
| 326 | | different_val_from(pred_true,value(BY)) :- BY==pred_false. |
| 327 | | different_val_from(string(X),string(Y)) :- !, X\=Y. |
| 328 | | different_val_from(string(X),value(VY)) :- nonvar(VY), VY=string(Y), nonvar(Y), !, X\=Y. |
| 329 | | different_val_from(avl_set(node(_,_,_,_,_)),empty_set). |
| 330 | | |
| 331 | | non_empty_set(set_extension([_|_])). |
| 332 | | non_empty_set(sequence_extension([_|_])). |
| 333 | | |
| 334 | | |
| 335 | | get_texpr_exprs([],[]). |
| 336 | | get_texpr_exprs([E|Rest],[N|NRest]) :- get_texpr_expr(E,N),get_texpr_exprs(Rest,NRest). |
| 337 | | get_texpr_exprs(b(E,_,_),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(E,_,_),Res)), Res=[E]. |
| 338 | | get_texpr_types([],[]). |
| 339 | | get_texpr_types([E|Rest],[T|TRest]) :- get_texpr_type(E,T),get_texpr_types(Rest,TRest). |
| 340 | | get_texpr_types(b(_,T,_),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(_,T,_),Res)), Res=[T]. |
| 341 | | get_texpr_infos([],[]). |
| 342 | | get_texpr_infos([E|Rest],[I|IRest]) :- get_texpr_info(E,I),get_texpr_infos(Rest,IRest). |
| 343 | | get_texpr_infos(b(_,_,I),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(_,_,I),Res)), Res=[I]. |
| 344 | | get_texpr_ids([],[]). |
| 345 | | get_texpr_ids([E|Rest],[I|IRest]) :- get_texpr_id(E,I),get_texpr_ids(Rest,IRest). |
| 346 | | |
| 347 | | get_texpr_pos(TExpr,Pos) :- |
| 348 | | get_texpr_info(TExpr,Infos), |
| 349 | ? | ( member(nodeid(Pos1),Infos) -> !,Pos=Pos1 |
| 350 | | ; Pos = none). |
| 351 | | |
| 352 | | get_texpr_pos_infos(b(_,_,Infos),PosInfos) :- extract_pos_infos(Infos,PosInfos). |
| 353 | | |
| 354 | | % similar to get_texpr_pos, but returns sub-list of infos relating to position |
| 355 | | extract_pos_infos(Infos,InfoRes) :- |
| 356 | ? | ( member(nodeid(Pos1),Infos) -> !,InfoRes=[nodeid(Pos1)] |
| 357 | | ; InfoRes = []). |
| 358 | | |
| 359 | | % copy position info from first arg to second argument |
| 360 | | copy_pos_infos(b(_,_,Infos1),Arg2,Res) :- |
| 361 | | member(nodeid(Pos1),Infos1),!, |
| 362 | | Arg2 = b(E,T,Infos2), Res = b(E,T,Infos3), |
| 363 | | delete_pos_info(Infos2,Infos2d), |
| 364 | | Infos3 = [nodeid(Pos1)|Infos2d]. |
| 365 | | copy_pos_infos(_,TE,TE). |
| 366 | | |
| 367 | | delete_pos_info(Infos1,Infos2) :- |
| 368 | | select(nodeid(_),Infos1,D),!, Infos2=D. |
| 369 | | %delete(Infos1,nodeid(_),Infos2). |
| 370 | | delete_pos_info(I,I). |
| 371 | | |
| 372 | | % propagate position info from second list to first one if it has better position info |
| 373 | | propagate_pos_info_if_useful(Infos,AuxInfos,NewInfos) :- |
| 374 | | member(nodeid(Pos2),AuxInfos), |
| 375 | | \+ derived_pos(Pos2),!, % potentially useful position info to propagate |
| 376 | | (select(nodeid(Pos1),Infos,Infos2) |
| 377 | | -> (derived_pos(Pos1) |
| 378 | | -> NewInfos = [nodeid(Pos2)|Infos2] % we have better position info now |
| 379 | | ; NewInfos = Infos % we already have a position info |
| 380 | | ) |
| 381 | | ; NewInfos = [nodeid(Pos2)|Infos] |
| 382 | | ). |
| 383 | | propagate_pos_info_if_useful(Infos,_,Infos). |
| 384 | | |
| 385 | | % derived position; not precise instrinsic label at top-level |
| 386 | | derived_pos(rodin_derived_context_pos(_,_,_)). |
| 387 | | |
| 388 | | |
| 389 | | get_info_pos(Infos,Pos) :- (member(nodeid(Pos1),Infos) -> Pos=Pos1 ; Pos=none). |
| 390 | | contains_info_pos(Infos) :- (member(nodeid(NI),Infos) -> NI \= none). |
| 391 | | |
| 392 | | create_texpr(Expr,Type,Info,b(Expr,Type,Info)). |
| 393 | | |
| 394 | | add_texpr_infos(b(Expr,Type,Old),Infos,b(Expr,Type,New)) :- !, |
| 395 | | append(Infos,Old,New). |
| 396 | | add_texpr_infos(Other,Infos,Res) :- |
| 397 | | add_internal_error('Illegal call, not BExpr:',add_texpr_infos(Other,Infos,Res)),fail. |
| 398 | | |
| 399 | | add_texpr_info_if_new(b(Expr,Type,Old),Info,b(Expr,Type,New)) :- !, |
| 400 | | add_info_if_new(Old,Info,New). |
| 401 | | add_texpr_info_if_new(Other,Infos,Res) :- |
| 402 | | add_internal_error('Illegal call, not BExpr:',add_texpr_info_if_new(Other,Infos,Res)),fail. |
| 403 | | % add multiple infos: |
| 404 | | add_texpr_infos_if_new(b(Expr,Type,Old),Infos,b(Expr,Type,New)) :- |
| 405 | | add_infos_if_new(Infos,Old,New). |
| 406 | | |
| 407 | | % add to info list: |
| 408 | | add_info_if_new(Old,Info,New) :- |
| 409 | | (member(Info,Old) -> New=Old ; New = [Info|Old]). |
| 410 | | |
| 411 | | add_infos_if_new([]) --> []. |
| 412 | | add_infos_if_new([Info|T]) --> add_info(Info), add_infos_if_new(T). |
| 413 | | add_info(Info,Old,New) :- |
| 414 | | (member(Info,Old) -> New=Old ; New = [Info|Old]). |
| 415 | | |
| 416 | | |
| 417 | | % try and extract the Rodin name of a predicate or expression |
| 418 | | get_rodin_name(Expression,Name) :- get_texpr_pos(Expression,rodinpos(Name,_)), Name \= []. |
| 419 | | get_rodin_name(Expression,Name) :- get_texpr_pos(Expression,rodinpos(_Model,Name,_)), Name \= []. % new rodinpos |
| 420 | | |
| 421 | | get_rodin_model_name(Expression,Model) :- |
| 422 | | get_texpr_pos(Expression,rodinpos(Model,Name,_)), Name \= []. % new rodinpos |
| 423 | | % Note: only precise position label, not rodin_derived_context_pos |
| 424 | | |
| 425 | | % try and extract the Rodin name or label pragma of a predicate or expression |
| 426 | | get_texpr_labels(TExpr,Label) :- |
| 427 | | get_texpr_info(TExpr,Infos), |
| 428 | | member(I,Infos), info_label(I,Label). |
| 429 | | get_info_labels(Infos,LabelList) :- |
| 430 | ? | member(I,Infos), info_label(I,LabelList). |
| 431 | | select_info_labels(LabelList,Infos,Rest) :- |
| 432 | | select(I,Infos,Rest), info_label(I,LabelList). |
| 433 | | info_label(nodeid(NodeID),[Name]) :- nodeid_info_label(NodeID,Name). |
| 434 | | info_label(label(LabelList),LabelList). |
| 435 | | |
| 436 | | nodeid_info_label(rodinpos(Name,_),Name) :- Name \= []. |
| 437 | | nodeid_info_label(rodinpos(Model,Name,_),FullName) :- Name \= [], % new rodinpos |
| 438 | | ajoin([Model,':',Name], FullName). % TO DO: if only one level; don't do this |
| 439 | | % TODO: provide separate way to access this derived information: |
| 440 | | %nodeid_info_label(rodin_derived_context_pos(Model,Context,Label),FullName) :- |
| 441 | | % ajoin([Model,'.',Context,':',Label], FullName). |
| 442 | | |
| 443 | | |
| 444 | | add_labels_to_texpr(E,[],R) :- !, R=E. % no labels to add |
| 445 | | add_labels_to_texpr(b(E,T,I),Labels,b(E,T,NewI)) :- |
| 446 | | (select(label(OldList),I,Rest) |
| 447 | | -> append(Labels,OldList,NewList), NewI=[label(NewList)|Rest] |
| 448 | | % TO DO: what if we have Rodin labels |
| 449 | | ; NewI = [label(Labels)|I] |
| 450 | | ). |
| 451 | | |
| 452 | | get_texpr_label(TExpr,Label) :- get_texpr_labels(TExpr,Labels), member(Label,Labels). |
| 453 | | |
| 454 | | get_texpr_description(TExpr,Description) :- |
| 455 | | get_texpr_info(TExpr,Infos), |
| 456 | | memberchk(description(Description),Infos). |
| 457 | | |
| 458 | | add_texpr_description(b(E,T,I),Description,b(E,T,[description(Description)|I])) :- |
| 459 | | (atom(Description) -> true ; |
| 460 | | add_error(add_texpr_description,'Non-atomic description:',Description)). |
| 461 | | |
| 462 | | % check if an info list has an ignore pragma |
| 463 | | info_has_ignore_pragma(Infos) :- |
| 464 | | member(description('prob-ignore'),Infos). |
| 465 | | % detect_prob_ignore ast_cleanup rule also generates this description annotation |
| 466 | | |
| 467 | | predicate_has_ignore_pragma(b(_E,pred,I)) :- |
| 468 | | %add_message(check_prob_ignore,'Pred: ',b(_E,pred,I),I), |
| 469 | | info_has_ignore_pragma(I). |
| 470 | | |
| 471 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 472 | | |
| 473 | | :- assert_must_succeed( (E = "1/2", |
| 474 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 475 | | Type==integer, Err==none, always_well_defined(ET) ) ). |
| 476 | | :- assert_must_succeed( (E = "3 mod 2", |
| 477 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 478 | | Type==integer, Err==none, always_well_defined(ET) ) ). |
| 479 | | :- assert_must_succeed( (E = "1/0", |
| 480 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 481 | | Type==integer, Err==none, \+ always_well_defined(ET) ) ). |
| 482 | | :- assert_must_succeed( (E = "2*(3 mod card({}))", |
| 483 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 484 | | Type==integer, Err==none, \+ always_well_defined(ET) ) ). |
| 485 | | :- assert_must_succeed( (E = "1/(2+1-3)", |
| 486 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 487 | | Type==integer, Err==none, \+ always_well_defined(ET) ) ). |
| 488 | | :- assert_must_succeed( (E = "max({1,2,3,0})", |
| 489 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 490 | | Type==integer, Err==none, always_well_defined(ET) ) ). |
| 491 | | :- assert_must_succeed( (E = "min({1,2,3,0})", |
| 492 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 493 | | Type==integer, Err==none, always_well_defined(ET) ) ). |
| 494 | | :- assert_must_succeed( (E = "min({1,2,3,0}-(0..4))", |
| 495 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 496 | | Type==integer, Err==none, \+ always_well_defined(ET) ) ). |
| 497 | | :- assert_must_succeed( (E = "2+max({1,2,3, 1/0})", |
| 498 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 499 | | Type==integer, Err==none,\+ always_well_defined(ET) ) ). |
| 500 | | :- assert_must_succeed( (E = "2-card({1,2,3})", |
| 501 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 502 | | Type==integer, Err==none, always_well_defined(ET) ) ). |
| 503 | | :- assert_must_succeed( (E = "2-card({1,2,3, 1/0})", |
| 504 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 505 | | Type==integer, Err==none,\+ always_well_defined(ET) ) ). |
| 506 | | :- assert_must_succeed( (E = "bool(2-size([1,2,3, 1/0])=3)", |
| 507 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 508 | | Type==boolean, Err==none, \+ always_well_defined(ET) ) ). |
| 509 | | :- assert_must_succeed( (E = "bool(2-size([1,2,3, 1/2, 3 mod 2, 3**2])=size([]))", |
| 510 | | bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err), |
| 511 | | Type==boolean, Err==none, always_well_defined(ET) ) ). |
| 512 | | |
| 513 | | always_well_defined_or_wd_reorderings_allowed(BE) :- % allow re-ordering to improve Left-to-right WD |
| 514 | | (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined |
| 515 | | ; preferences:preference(allow_improving_wd_mode,true) -> true |
| 516 | | ; preferences:preference(data_validation_mode,true) -> true |
| 517 | | ; always_well_defined_or_discharged(BE)). |
| 518 | | always_well_defined_or_wd_improvements_allowed(BE) :- % allow to remove useless calls which could be non-WD |
| 519 | | % example #x(x = f(...)) -> btrue or f[{}] --> {} |
| 520 | | always_well_defined_or_wd_reorderings_allowed(BE). % we currently use the same definition |
| 521 | | always_well_defined_or_disprover_mode(BE) :- |
| 522 | | (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined |
| 523 | | ; always_well_defined_or_discharged(BE)). |
| 524 | | |
| 525 | | always_well_defined_or_discharged(b(E,_,Infos)) :- !, |
| 526 | | (nonmember(contains_wd_condition,Infos) -> true |
| 527 | | ; always_wd(E) -> true % some special rules |
| 528 | | ; member(discharged_wd_po,Infos) -> true |
| 529 | | %; nl, functor(E,F,N), F \= function, print(non_wd(F,N)),nl,nl,fail |
| 530 | | ). |
| 531 | | always_well_defined_or_discharged(E) :- |
| 532 | | add_error_fail(always_well_defined,'Illegal call: ',always_well_defined_or_discharged(E)). |
| 533 | | |
| 534 | | % should ensure that there is no failure and no error raised |
| 535 | | always_well_defined(b(E,_,Infos)) :- !, |
| 536 | | (nonmember(contains_wd_condition,Infos) -> true |
| 537 | | ; always_wd(E) -> true % some special rules |
| 538 | | %; nl, functor(E,F,N), F \= function, print(non_wd(F,N)),nl,nl,fail |
| 539 | | ). |
| 540 | | always_well_defined(E) :- add_error_fail(always_well_defined,'Illegal call: ',always_well_defined(E)). |
| 541 | | |
| 542 | | |
| 543 | | :- assert_must_succeed( always_wd(div( b(integer(2),integer,[]), b(integer(2),integer,[]) )) ). |
| 544 | | :- assert_must_fail( always_wd(div( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ). |
| 545 | | :- assert_must_succeed( always_wd(modulo( b(integer(2),integer,[]), b(integer(2),integer,[]) )) ). |
| 546 | | :- assert_must_fail( always_wd(modulo( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ). |
| 547 | | :- assert_must_fail( always_wd(modulo( b(integer(2),integer,[]), b(integer(-2),integer,[]) )) ). |
| 548 | | :- assert_must_fail( always_wd(modulo( b(integer(-1),integer,[]), b(integer(2),integer,[]) )) ). |
| 549 | | :- assert_must_succeed( always_wd(power_of( b(integer(2),integer,[]), b(integer(3),integer,[]) )) ). |
| 550 | | :- assert_must_succeed( always_wd(power_of( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ). |
| 551 | | :- assert_must_fail( always_wd(power_of( b(integer(2),integer,[]), b(integer(-1),integer,[]) )) ). |
| 552 | | |
| 553 | | % catch cases where the construct is currently so instantiated that we can determine that it is well-defined |
| 554 | | % can happen e.g. during closure compilation |
| 555 | | :- use_module(custom_explicit_sets,[check_unique_in_domain_of_avlset/2]). |
| 556 | | :- use_module(kernel_tools,[ground_value/1]). |
| 557 | | always_wd(power_of(X,Y)) :- get_integer(Y,Val), Val>=0, |
| 558 | | (eventb_mode -> get_integer(X,ValX), ValX >=0 |
| 559 | | ; always_well_defined(X)). |
| 560 | | always_wd(div(X,Y)) :- get_integer(Y,Val), Val\=0, always_well_defined(X). |
| 561 | | always_wd(modulo(X,Y)) :- get_integer(Y,Val), Val>0, % Z Live allows negative numbers here it seems, cf modulo2 |
| 562 | | (z_or_tla_minor_mode -> true % in Z, TLA we can have negative numbers here |
| 563 | | ; get_integer(X,ValX), ValX>=0). |
| 564 | | always_wd(function(X,Y)) :- nonvar(X), |
| 565 | | X= b(value(AVLSET),_,_), nonvar(AVLSET), AVLSET=avl_set(AVL), |
| 566 | | always_wd_avl_function(AVL,Y). |
| 567 | | always_wd(min(X)) :- non_empty_finite_wd_set_value(X). |
| 568 | | always_wd(max(X)) :- non_empty_finite_wd_set_value(X). |
| 569 | | always_wd(card(X)) :- finite_wd_set_value(X). |
| 570 | | always_wd(size(X)) :- finite_wd_seq_value(X). |
| 571 | | always_wd(first(X)) :- non_empty_wd_seq_value(X). |
| 572 | | always_wd(front(X)) :- non_empty_wd_seq_value(X). |
| 573 | | always_wd(last(X)) :- non_empty_wd_seq_value(X). |
| 574 | | always_wd(tail(X)) :- non_empty_wd_seq_value(X). % TO DO: add restrict_front, restrict_tail ? |
| 575 | | always_wd(general_intersection(X)) :- non_empty_finite_wd_set_value(X). |
| 576 | | always_wd(value(_)). % we have already computed the value and will raise WD error; to be 100 % safe we could restrict this to ground values |
| 577 | | % other candidates: size(_), first(_) last(_) tail(_) front(_) restrict_front(_,_) restrict_tail(_,_) rel_iterate(_,_) |
| 578 | | always_wd(typeset). |
| 579 | | % operators that are always wd on their own: |
| 580 | | always_wd(record_field(RecEx,FieldName)) :- ground(FieldName), |
| 581 | | always_well_defined(RecEx). |
| 582 | | always_wd(unary_minus(A)) :- always_well_defined(A). |
| 583 | | always_wd(unary_minus_real(A)) :- always_well_defined(A). |
| 584 | | always_wd(first_of_pair(A)) :- always_well_defined(A). |
| 585 | | always_wd(add(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 586 | | always_wd(add_real(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 587 | | always_wd(minus(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 588 | | always_wd(minus_real(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 589 | | always_wd(multiplication(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 590 | | always_wd(multiplication_real(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 591 | | always_wd(equal(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 592 | | always_wd(not_equal(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 593 | | always_wd(less_equal(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 594 | | always_wd(less_equal_real(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 595 | | always_wd(greater_equal(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 596 | | always_wd(less(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 597 | | always_wd(less_real(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 598 | | always_wd(greater(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 599 | | always_wd(couple(A,B)) :- always_well_defined(A),always_well_defined(B). |
| 600 | | % TO DO: add more/all other operators ? |
| 601 | | |
| 602 | | always_wd_avl_function(AVL,Y) :- nonvar(Y), Y= b(value(Val),_,_), |
| 603 | | ground_value(Val), !, |
| 604 | | % Warning: this does not check that the whole AVL is a function; just this particular lookup is ok |
| 605 | | check_unique_in_domain_of_avlset(Val,AVL). % ,print(ok),nl. |
| 606 | | always_wd_avl_function(AVL,Y) :- always_well_defined(Y), |
| 607 | | custom_explicit_sets:quick_definitely_maximal_total_function_avl(AVL). |
| 608 | | |
| 609 | | % non empty set with WD elements |
| 610 | | non_empty_finite_wd_set_value(b(E,_,_)) :- non_empty_fin_wd_set2(E). |
| 611 | | non_empty_fin_wd_set2(bool_set). |
| 612 | | non_empty_fin_wd_set2(value(X)) :- definitely_not_empty_finite_value(X). |
| 613 | | non_empty_fin_wd_set2(set_extension(S)) :- l_always_well_defined(S). % the set_extension could contain wd_errors !! |
| 614 | | non_empty_fin_wd_set2(sequence_extension(S)) :- l_always_well_defined(S). % ditto |
| 615 | | non_empty_fin_wd_set2(interval(A,B)) :- get_integer(A,IA), get_integer(B,IB), IA =< IB. |
| 616 | | % see not_empty_set_aux |
| 617 | | definitely_not_empty_finite_value(X) :- var(X),!,fail. |
| 618 | | definitely_not_empty_finite_value(avl_set(_)). |
| 619 | | definitely_not_empty_finite_value([_|_]). |
| 620 | | definitely_not_empty_finite_value(closure(P,T,B)) :- |
| 621 | | custom_explicit_sets:is_interval_closure(P,T,B,LOW,UP), integer(LOW),integer(UP), LOW =< UP. |
| 622 | | % TODO: pow_subset of finite values |
| 623 | | |
| 624 | | non_empty_wd_seq_value(b(E,_,_)) :- non_empty_seq2(E). |
| 625 | | non_empty_seq2(value(X)) :- definitely_not_empty_seq(X). |
| 626 | | non_empty_seq2(sequence_extension(S)) :- l_always_well_defined(S), S=[_|_]. |
| 627 | | |
| 628 | | definitely_not_empty_seq(X) :- var(X),!,fail. |
| 629 | | definitely_not_empty_seq(avl_set(A)) :- custom_explicit_sets:is_avl_sequence(A). |
| 630 | | definitely_not_empty_seq([El1|T]) :- T==[],nonvar(El1), El1=(IDX,_), IDX==int(1). % TO DO: add more cases ? |
| 631 | | |
| 632 | | |
| 633 | | finite_set_or_disprover_mode(Set) :- |
| 634 | | (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined |
| 635 | | ; finite_wd_set_value(Set)). |
| 636 | | |
| 637 | | :- use_module(typing_tools,[is_provably_finite_type/1]). |
| 638 | | % we could also use is_finite_type_in_context to allow deferred sets to be counted as finite |
| 639 | | finite_wd_set_value(b(E,T,_)) :- !, (finite_set2(E) -> true ; is_provably_finite_type(T)). |
| 640 | | finite_wd_set_value(E) :- add_internal_error('Not a BExpr: ',E),fail. |
| 641 | | finite_set2(empty_set). |
| 642 | | finite_set2(empty_sequence). |
| 643 | | finite_set2(value(X)) :- X==[] -> true ; definitely_not_empty_finite_value(X). |
| 644 | | finite_set2(set_extension(S)) :- l_always_well_defined(S). % the set_extension could contain wd_errors !! |
| 645 | | finite_set2(sequence_extension(S)) :- l_always_well_defined(S). % ditto |
| 646 | | |
| 647 | | finite_wd_seq_value(b(E,_,_)) :- finite_seq2(E). |
| 648 | | finite_seq2(empty_set). |
| 649 | | finite_seq2(empty_sequence). |
| 650 | | finite_seq2(value(X)) :- finite_seq_value(X). |
| 651 | | finite_seq2(sequence_extension(S)) :- l_always_well_defined(S). |
| 652 | | |
| 653 | | finite_seq_value(X) :- var(X),!,fail. |
| 654 | | finite_seq_value([]). |
| 655 | | finite_seq_value(avl_set(A)) :- custom_explicit_sets:is_avl_sequence(A). |
| 656 | | % it could be expensive to check if non empty list is a B sequence ?? |
| 657 | | |
| 658 | | l_always_well_defined([]). |
| 659 | | l_always_well_defined([H|T]) :- always_well_defined(H), l_always_well_defined(T). |
| 660 | | |
| 661 | | is_truth(b(F,pred,_)) :- is_truth_aux(F). |
| 662 | | is_truth_aux(truth). |
| 663 | | is_truth_aux(value(V)) :- V==pred_true. % can occur in CSE mode |
| 664 | | |
| 665 | | is_falsity(b(F,pred,_)) :- is_falsity_aux(F). |
| 666 | | is_falsity_aux(falsity). |
| 667 | | is_falsity_aux(value(V)) :- V==pred_false. % can occur in CSE mode |
| 668 | | |
| 669 | | % conjunction of a list of predicates |
| 670 | | % NOTE: bsyntaxtree:conjunct_predicates([P1,P2,P3],R). --> generates R = b(conjunct(b(conjunct(P1,P2),pred,[]),P3),pred,[]) |
| 671 | | conjunct_predicates(V,R) :- var(V),!, add_internal_error('Variable conjunction list: ',conjunct_predicates(V,R)),fail. |
| 672 | | conjunct_predicates([],b(truth,pred,[])). |
| 673 | | conjunct_predicates([P|Rest],Result) :- conjunct2(Rest,P,Result). |
| 674 | | conjunct2([],P,P). |
| 675 | | conjunct2([Q|Rest],P,Result) :- conjunct3(P,Q,R), conjunct2(Rest,R,Result). |
| 676 | | conjunct3(b(truth,_,_),P,P) :- !. |
| 677 | | conjunct3(P,b(truth,_,_),P) :- !. |
| 678 | | conjunct3(A,B,b(conjunct(A,B),pred,NewInfo)) :- extract_info(A,B,NewInfo). |
| 679 | | |
| 680 | | % disjunction of a list of predicates |
| 681 | | disjunct_predicates([],b(falsity,pred,[])). |
| 682 | | disjunct_predicates([P|Rest],Result) :- disjunct2(Rest,P,Result). |
| 683 | | disjunct2([],P,P). |
| 684 | | disjunct2([Q|Rest],P,Result) :- disjunct3(P,Q,R), disjunct2(Rest,R,Result). |
| 685 | | disjunct3(b(falsity,_,_),P,R) :- !, R=P. |
| 686 | | disjunct3(b(truth,T,I),_,R) :- !, R=b(truth,T,I). |
| 687 | | disjunct3(P,b(falsity,_,_),R) :- !, R=P. |
| 688 | | disjunct3(_,b(truth,T,I),R) :- !, R=b(truth,T,I). |
| 689 | | disjunct3(A,B,b(disjunct(A,B),pred,NewInfo)) :- extract_info(A,B,NewInfo). |
| 690 | | |
| 691 | | % conjunct two predicates and try and construct position information |
| 692 | | conjunct_predicates_with_pos_info(A,B,AB) :- is_truth(B),!, AB=A. |
| 693 | | conjunct_predicates_with_pos_info(A,B,AB) :- is_truth(A),!, AB=B. |
| 694 | | conjunct_predicates_with_pos_info(A,B,AB) :- |
| 695 | | conjunct_predicates([A,B],AB0), % this may contain position info if B is truth; hence we do check above |
| 696 | | (try_get_merged_position_info(A,B,ABI) |
| 697 | | -> add_texpr_infos(AB0,[ABI],AB) %,print(abi(ABI)),nl |
| 698 | | ; AB=AB0). |
| 699 | | |
| 700 | | % disjunct two predicates and try and construct position information |
| 701 | | disjunct_predicates_with_pos_info(A,B,AB) :- |
| 702 | | disjunct_predicates([A,B],AB0), |
| 703 | | (try_get_merged_position_info(A,B,ABI) |
| 704 | | -> add_texpr_infos(AB0,[ABI],AB) %,print(abi(ABI)),nl |
| 705 | | ; AB=AB0). |
| 706 | | |
| 707 | | try_get_merged_position_info(b(_,_,I1),b(_,_,I2),PosInfo) :- |
| 708 | | (try_get_merged_position_info_aux(I1,I2,MergedInfo) -> PosInfo = MergedInfo |
| 709 | | ; get_non_label_posinfo(Pos1,I1) -> PosInfo=nodeid(Pos1) |
| 710 | | ; get_non_label_posinfo(Pos2,I2) -> PosInfo=nodeid(Pos2) |
| 711 | | ). |
| 712 | | try_get_merged_position_info_aux(I1,I2,nodeid(pos(C,Filenumber,Srow,Scol,Erow,Ecol))) :- |
| 713 | | member(nodeid(pos(C1,Filenumber,Srow1,Scol1,Erow1,Ecol1)),I1), |
| 714 | | (number(C1),number(Srow1),number(Scol1),number(Erow1),number(Ecol1) |
| 715 | | -> true ; add_internal_error('Info field 1 not yet instantiated: ',try_get_merged_position_info(I1)),fail), |
| 716 | | !, |
| 717 | | member(nodeid(pos(C2,Filenumber,Srow2,Scol2,Erow2,Ecol2)),I2), |
| 718 | | (number(C2),number(Srow2),number(Scol2),number(Erow2),number(Ecol2) |
| 719 | | -> true ; add_internal_error('Info field 2 not yet instantiated: ',try_get_merged_position_info(I2)),fail), |
| 720 | | !, |
| 721 | | % merge position info if in same file |
| 722 | | (C1 =< C2 -> C=C1, Srow=Srow1,Scol=Scol1 ; C=C2, Srow=Srow2,Scol=Scol2), |
| 723 | | ((Erow1 > Erow2 ; Erow1=Erow2, Ecol1 >= Ecol2) |
| 724 | | -> Erow =Erow1, Ecol=Ecol1 |
| 725 | | ; Erow =Erow2, Ecol=Ecol2). |
| 726 | | |
| 727 | | % get position info which is not a label; label info should not be propagated to outer conjuncts/disjuncts/... |
| 728 | | get_non_label_posinfo(Pos,Infos) :- member(nodeid(Pos),Infos), |
| 729 | | \+ functor(Pos,rodinpos,_). |
| 730 | | |
| 731 | | get_texpr_non_label_posinfo(b(_,_,Infos),nodeid(Pos)) :- get_non_label_posinfo(Pos,Infos). |
| 732 | | |
| 733 | | % conjunct list of predicates and try and construct position information |
| 734 | | conjunct_predicates_with_pos_info([H|T],Res) :- is_truth(H),!, |
| 735 | | (T=[] -> Res = H ; conjunct_predicates_with_pos_info(T,Res)). |
| 736 | | conjunct_predicates_with_pos_info([H|T],Res) :- |
| 737 | | last_non_truth(T,none,Last), % the truth elements will be removed and are not relevant; get last relevant predicate |
| 738 | | Last \= none, |
| 739 | | try_get_merged_position_info(H,Last,MergedPosInfo), % try and merge position of first and last element |
| 740 | | !, |
| 741 | | conjunct_predicates([H|T],Res0), |
| 742 | | add_texpr_infos(Res0,[MergedPosInfo],Res). % Res0 should have no nodeid field |
| 743 | | conjunct_predicates_with_pos_info(L,Res) :- conjunct_predicates(L,Res). |
| 744 | | |
| 745 | | :- assert_must_succeed((bsyntaxtree:last_non_truth([a,b,c],none,L),L==c)). |
| 746 | | :- assert_must_succeed((bsyntaxtree:last_non_truth([a,b,c,b(truth,pred,[])],none,L),L==c)). |
| 747 | | |
| 748 | | % get last non-truth element and filter out all truth elements |
| 749 | | last_non_truth([],Acc,Acc). |
| 750 | | last_non_truth([H|T],NonTruth,Last) :- is_truth(H),!, last_non_truth(T,NonTruth,Last). |
| 751 | | last_non_truth([H|T],_,Last) :- last_non_truth(T,H,Last). |
| 752 | | |
| 753 | | |
| 754 | | texpr_contains_wd_condition(b(_,_,Info)) :- !, memberchk(contains_wd_condition,Info). |
| 755 | | texpr_contains_wd_condition(E) :- add_internal_error('Not a texpr: ',texpr_contains_wd_condition(E)). |
| 756 | | |
| 757 | | % a version of create_texpr which collects automatically important infos from sub-expressions |
| 758 | | safe_create_texpr(Expr,Type,b(Expr,Type,Info)) :- % |
| 759 | ? | (sub_expression_contains_wd_condition(Expr) -> Info = [contains_wd_condition] ; Info=[]). |
| 760 | | |
| 761 | | safe_create_texpr(Expr,Type,Info,b(Expr,Type,FullInfo)) :- % |
| 762 | | ((sub_expression_contains_wd_condition(Expr), nonmember(contains_wd_condition, Info)) -> FullInfo = [contains_wd_condition|Info] ; FullInfo=Info). |
| 763 | | |
| 764 | ? | sub_expression_contains_wd_condition(Expr) :- sub_expression_contains_wd_condition(Expr,_). |
| 765 | | sub_expression_contains_wd_condition(Expr,Sub) :- |
| 766 | | safe_syntaxelement_det(Expr,Subs,_Names,_L,_C), |
| 767 | ? | member(b(Sub,_,Infos),Subs), |
| 768 | | (var(Infos) |
| 769 | | -> add_internal_error('Typed expression not sufficiently instantiated (variable Infos): ',sub_expression_contains_wd_condition(Expr)), |
| 770 | | fail |
| 771 | | ; memberchk(contains_wd_condition,Infos)). |
| 772 | | |
| 773 | | % provide updated infos (e.g., reads(...)) and remove any old info fields with same functor |
| 774 | | update_infos([],Infos,Infos). |
| 775 | | update_infos([Update|T],OldInfos,NewInfos) :- |
| 776 | | functor(Update,F,N), |
| 777 | | functor(Old,F,N), |
| 778 | | delete(OldInfos,Old,OldInfos1), |
| 779 | | update_infos(T,[Update|OldInfos1],NewInfos). |
| 780 | | |
| 781 | | % merge two info lists and try to reconcile position information: |
| 782 | | merge_info(Info1,Info2,Res) :- |
| 783 | | merge_imp_info2(Info2,Info1,NewInfo), |
| 784 | | (try_get_merged_position_info_aux(Info1,Info2,NewPos) |
| 785 | | -> delete_pos_info(NewInfo,NI2), |
| 786 | | Res = [NewPos|NI2] |
| 787 | | ; Res = NewInfo). |
| 788 | | |
| 789 | | % extract important info but without used_ids: |
| 790 | | extract_info_wo_used_ids(b(_,_,Info1),Info) :- |
| 791 | | extract_pos_infos(Info1,PosInfos), |
| 792 | | extract_just_important_info_aux(Info1,[],I1), |
| 793 | | append(PosInfos,I1,Info). |
| 794 | | extract_info_wo_used_ids_and_pos(b(_,_,Info1),b(_,_,Info2),Info) :- |
| 795 | | extract_just_important_info_aux(Info1,[],I1), |
| 796 | | extract_just_important_info_aux(Info2,I1,Info). |
| 797 | | |
| 798 | | % extract important info from one sub-expression: |
| 799 | | extract_info(b(_,_,Info1),NewInfo) :- |
| 800 | | extract_imp_info1(Info1,I1),!, NewInfo = I1. |
| 801 | | extract_info(A,R) :- |
| 802 | | add_internal_error('Could not extract info: ',extract_info(A,R)), |
| 803 | | R=[]. |
| 804 | | % extract imortant info fields from two (sub-)expressions |
| 805 | | extract_info(b(_,_,Info1),b(_,_,Info2),NewInfo) :- |
| 806 | | merge_imp_info2(Info1,Info2,II),!, NewInfo = II. |
| 807 | | %:- use_module(library(ordsets),[ord_intersection/3]). |
| 808 | | % ord_intersection(Info1,Info2,NewInfo),!. |
| 809 | | % TO DO: should we merge nodeid position information !? |
| 810 | | extract_info(A,B,R) :- add_internal_error('Could not extract info: ',extract_info(A,B,R)), |
| 811 | | R=[]. |
| 812 | | |
| 813 | | % extract important info and used_ids |
| 814 | | extract_imp_info1([],[]). |
| 815 | | extract_imp_info1([H|T],Res) :- |
| 816 | | ((important_info(H); H=used_ids(_)) -> Res=[H|ET], extract_imp_info1(T,ET) |
| 817 | | ; extract_imp_info1(T,Res) |
| 818 | | ). |
| 819 | | |
| 820 | | % extract and merge important info and try to merge used_ids from two info lists |
| 821 | | merge_imp_info2(Info1,Info2,ResInfos) :- |
| 822 | | extract_imp_info1(Info1,I1), |
| 823 | | extract_imp_info1(Info2,I2), |
| 824 | | merge_aux(I1,I2,ResInfos). |
| 825 | | |
| 826 | | merge_aux([],I2,Res) :- !, delete(I2,used_ids(_),Res). % used_ids not valid for new construct |
| 827 | | merge_aux(I1,[],Res) :- !, delete(I1,used_ids(_),Res). % ditto |
| 828 | | merge_aux(I1,I2,ResInfos) :- |
| 829 | ? | (select(used_ids(Ids1),I1,II1) |
| 830 | ? | -> (select(used_ids(Ids2),I2,II2) |
| 831 | | -> ord_union(Ids1,Ids2,Ids3), |
| 832 | | append(II1,[used_ids(Ids3)|II2],II) |
| 833 | | ; append(II1,I2,II) |
| 834 | | ) |
| 835 | | ; delete(I2,used_ids(_),II2), |
| 836 | | append(I1,II2,II) |
| 837 | | ), |
| 838 | | sort(II,ResInfos). % TO DO: sort sublists ? and use ord_union? |
| 839 | | |
| 840 | | important_info(contains_wd_condition). |
| 841 | | important_info(prob_annotation(_)). |
| 842 | | important_info(allow_to_lift_exists). |
| 843 | | important_info(removed_typing). |
| 844 | | %important_info(lambda_result(_)). % should probably not be copied |
| 845 | | |
| 846 | | % variation of above which does not extract and merge used_ids: |
| 847 | | extract_just_important_info_aux([],Acc,Acc). |
| 848 | | extract_just_important_info_aux([H|T],Acc,Res) :- |
| 849 | | (important_info(H), \+ member(H,Acc) -> extract_just_important_info_aux(T,[H|Acc],Res) |
| 850 | | ; extract_just_important_info_aux(T,Acc,Res)). |
| 851 | | |
| 852 | | |
| 853 | | is_a_conjunct(b(conjunct(A,B),pred,_),A,B). |
| 854 | | % use is_a_conjunct_without_label if you want to avoid decomposing conjunction associated with a single label |
| 855 | | is_a_conjunct_without_label(b(conjunct(A,B),pred,I),A,B) :- \+ get_info_labels(I,_). |
| 856 | | % use decompose conjunct if you want to propagate labels down to the conjuncts |
| 857 | | decompose_conjunct(b(conjunct(A,B),pred,I),ResA,ResB) :- |
| 858 | | (get_info_labels(I,Labels) |
| 859 | | -> add_labels_to_texpr(A,Labels,ResA), add_labels_to_texpr(B,Labels,ResB) |
| 860 | | ; ResA=A, ResB=B). |
| 861 | | |
| 862 | | size_of_conjunction(C,Size) :- size_of_conjunction(C,0,Size). |
| 863 | | size_of_conjunction(C,Acc,Res) :- is_a_conjunct(C,A,B),!, |
| 864 | | size_of_conjunction(B,Acc,A1), |
| 865 | | size_of_conjunction(A,A1,Res). |
| 866 | | size_of_conjunction(_,Acc,Size) :- Size is Acc+1. |
| 867 | | |
| 868 | | conjunction_to_list(C,L) :- var(C),!, |
| 869 | | add_error_fail(conjunction_to_list,'Internal error: var :',conjunction_to_list(C,L)). |
| 870 | | conjunction_to_list(C,List) :- |
| 871 | | conjunction_to_list2(C,List,[]). |
| 872 | | conjunction_to_list2(X,I,O) :- X=b(E,_,_), |
| 873 | | (E=conjunct(LHS,RHS) -> conjunction_to_list2(LHS,I,Inter), |
| 874 | | conjunction_to_list2(RHS,Inter,O) |
| 875 | | ; E = truth -> I=O |
| 876 | | ; I = [X|O]). |
| 877 | | |
| 878 | | % a variation of conjunction_to_list which propagates Rodin and pragma label infos down |
| 879 | | % important for proof info; maybe we should only propagate Rodin labels ? |
| 880 | | conjunction_to_list_with_rodin_labels(C,L) :- var(C),!, |
| 881 | | add_error_fail(conjunction_to_list,'Internal error: var :',conjunction_to_list_with_rodin_labels(C,L)). |
| 882 | | conjunction_to_list_with_rodin_labels(C,List) :- |
| 883 | | conjunction_to_list_with_labels2(C,List,[]). |
| 884 | | conjunction_to_list_with_labels2(b(conjunct(A,B),pred,Infos),I,O) :- !, |
| 885 | | copy_rodin_label(Infos,A,B,LHS,RHS), |
| 886 | | conjunction_to_list_with_labels2(LHS,I,Inter), |
| 887 | | conjunction_to_list_with_labels2(RHS,Inter,O). |
| 888 | | conjunction_to_list_with_labels2(X,I,O) :- X=b(E,_,_), |
| 889 | | ( E = truth -> I=O |
| 890 | | ; I = [X|O]). |
| 891 | | |
| 892 | | |
| 893 | | copy_rodin_label(Infos,A,B,NewA,NewB) :- member(Pos,Infos), is_rodin_label_info(Pos),!, |
| 894 | | add_rodin_label_info(A,Pos,NewA), |
| 895 | | add_rodin_label_info(B,Pos,NewB). |
| 896 | | copy_rodin_label(_,A,B,A,B). |
| 897 | | |
| 898 | | add_rodin_label_info(b(E,T,I),Pos,b(E,T,I2)) :- |
| 899 | | (member(Pos,I), is_rodin_label_info(Pos) -> I2=I |
| 900 | | ; I2 = [Pos|I]). |
| 901 | | |
| 902 | | is_rodin_label_info(nodeid(Pos)) :- functor(Pos,rodinpos,_). |
| 903 | | |
| 904 | | |
| 905 | | flatten_conjunctions(List,FlattenedList) :- flatten_conj_aux(List,FlattenedList,[]). |
| 906 | | flatten_conj_aux([]) --> !, []. |
| 907 | | flatten_conj_aux([H|T]) --> !, flatten_conj_aux(H),flatten_conj_aux(T). |
| 908 | | flatten_conj_aux(C) --> {is_a_conjunct(C,LHS,RHS)}, |
| 909 | | !, |
| 910 | | flatten_conj_aux(LHS), flatten_conj_aux(RHS). |
| 911 | | flatten_conj_aux(Truth) --> {is_truth(Truth)},!,[]. |
| 912 | | flatten_conj_aux(C) --> [C]. |
| 913 | | |
| 914 | | member_in_conjunction(M,Conj) :- is_a_conjunct(Conj,LHS,RHS),!, |
| 915 | ? | (member_in_conjunction(M,LHS) ; member_in_conjunction(M,RHS)). |
| 916 | | member_in_conjunction(M,M). |
| 917 | | |
| 918 | | % a version of member_in_conjunction which can deal with lazy_let_pred : |
| 919 | | % member_in_conjunction_cse(FullConjunctWithLets,InnerConjunctNotALet, Conjunction) |
| 920 | | member_in_conjunction_cse(M,InnerConj,Conj) :- is_a_conjunct(Conj,LHS,RHS),!, |
| 921 | | (member_in_conjunction_cse(M,InnerConj,LHS) ; member_in_conjunction_cse(M,InnerConj,RHS)). |
| 922 | | member_in_conjunction_cse(Conj,InnerConj,b(lazy_let_pred(ID,Share,Body),pred,Info)) :- |
| 923 | | Conj = b(lazy_let_pred(ID,Share,BConj),pred,Info),!, |
| 924 | | member_in_conjunction_cse(BConj,InnerConj,Body). |
| 925 | | member_in_conjunction_cse(M,M,M). |
| 926 | | |
| 927 | | % not terribly efficient way to select and remove a conjunct from a predicate |
| 928 | | select_member_in_conjunction(M,Conj,Rest) :- is_a_conjunct(Conj,LHS,RHS),!, |
| 929 | | (select_member_in_conjunction(M,LHS,RL), conjunct_predicates([RL,RHS],Rest) |
| 930 | | ; select_member_in_conjunction(M,RHS,RR), conjunct_predicates([LHS,RR],Rest)). |
| 931 | | select_member_in_conjunction(M,M,b(truth,pred,[])). |
| 932 | | |
| 933 | | is_a_disjunct(b(disjunct(A,B),pred,_),A,B). |
| 934 | | is_a_negation(b(negation(A),pred,_),A). |
| 935 | | |
| 936 | | disjunction_to_list(C,L) :- var(C),!, |
| 937 | | add_error_fail(disjunction_to_list,'Internal error: var :',disjunction_to_list(C,L)). |
| 938 | | disjunction_to_list(C,List) :- |
| 939 | | disjunction_to_list2(C,List,[]). |
| 940 | | disjunction_to_list2(C,I,O) :- is_a_disjunct(C,LHS,RHS),!, |
| 941 | | disjunction_to_list2(LHS,I,Inter), |
| 942 | | disjunction_to_list2(RHS,Inter,O). |
| 943 | | disjunction_to_list2(X,[X|R],R). |
| 944 | | |
| 945 | | is_an_implication(b(implication(A,B),pred,_),A,B). |
| 946 | | |
| 947 | | is_an_equivalence(b(equivalence(A,B),pred,_),A,B). |
| 948 | | |
| 949 | | |
| 950 | | is_a_disjunct_or_implication(b(DI,pred,_),Type,A,B) :- is_a_disj_or_impl_aux(DI,Type,A,B). |
| 951 | | is_a_disj_or_impl_aux(disjunct(A,B),'disjunction',A,B). |
| 952 | | is_a_disj_or_impl_aux(implication(A,B),'implication',NA,B) :- |
| 953 | | create_negation(A,NA). |
| 954 | | is_a_disj_or_impl_aux(negation(b(conjunct(A,B),pred,_)),'negated conjunction',NA,NB) :- |
| 955 | | create_negation(A,NA),create_negation(B,NB). |
| 956 | | |
| 957 | | % a more liberal version of is_a_conjunct/2 which also detects negated disjunctions/implications |
| 958 | | is_a_conjunct_or_neg_disj(b(DI,pred,I),A,B) :- is_conjunct_aux(DI,I,A,B). |
| 959 | | |
| 960 | | is_conjunct_aux(conjunct(LHS,RHS),_,LHS,RHS). |
| 961 | | is_conjunct_aux(negation(DISJ),_,NegLHS,NegRHS) :- |
| 962 | | is_a_disjunct_or_implication(DISJ,_Type,LHS,RHS), |
| 963 | | create_negation(LHS,NegLHS), |
| 964 | | create_negation(RHS,NegRHS). |
| 965 | | is_conjunct_aux(equal(TA,TB),I,b(equal(TA1,TB1),pred,I),b(equal(TA2,TB2),pred,I)) :- |
| 966 | | % split TA1|->TA2 = TB1|->TB2, cf, split_equality/3; useful for enumeration order analysis |
| 967 | | get_texpr_couple(TA,TA1,TA2), |
| 968 | | get_texpr_couple(TB,TB1,TB2). |
| 969 | | % print('Splitting equality in is_a_conjunct_or_neg_disj: '), translate:print_bexpr(b(equal(TA,TB),pred,I)),nl. |
| 970 | | |
| 971 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 972 | | % remove all info fields by fresh variables |
| 973 | | % typically the result will be unified with AST terms which contain full info fields |
| 974 | | remove_all_infos(TExpr,TNExpr) :- |
| 975 | | var(TExpr),!,TExpr=TNExpr. |
| 976 | | % in contrast to remove_all_infos_and_ground we provide no special treatment of values with closures here; |
| 977 | | % there could be a problem if we unify with a free variable as value |
| 978 | | remove_all_infos(TExpr,TNExpr) :- |
| 979 | | get_texpr_expr(TExpr,Expr), |
| 980 | | get_texpr_type(TExpr,Type), |
| 981 | | syntaxtransformation(Expr,Subs,_,NSubs,NExpr), |
| 982 | | create_texpr(NExpr,Type,_,TNExpr), |
| 983 | | maplist(remove_all_infos,Subs,NSubs). |
| 984 | | |
| 985 | | % replace all info fields |
| 986 | | remove_all_infos_and_ground(TExpr,TNExpr) :- |
| 987 | | var(TExpr),!,TExpr=TNExpr. |
| 988 | | remove_all_infos_and_ground(b(value(Value),Type,_),TNExpr) :- |
| 989 | | % special case for closure(_,_,_) since it is not covered by syntraxtransformation/5 |
| 990 | | % most useful for intervals |
| 991 | | !, |
| 992 | | remove_all_infos_from_bvalue(Value,NValue), |
| 993 | | TNExpr = b(value(NValue),Type,[]). |
| 994 | | remove_all_infos_and_ground(TExpr,TNExpr) :- |
| 995 | | get_texpr_expr(TExpr,Expr), |
| 996 | | get_texpr_type(TExpr,Type), |
| 997 | | syntaxtransformation(Expr,Subs,_,NSubs,NExpr), |
| 998 | | create_texpr(NExpr,Type,[],TNExpr), |
| 999 | | maplist(remove_all_infos_and_ground,Subs,NSubs). |
| 1000 | | |
| 1001 | | remove_all_infos_from_bvalue(Var,Res) :- var(Var),!, Res=Var. |
| 1002 | | remove_all_infos_from_bvalue((A,B),(RA,RB)) :- !, |
| 1003 | | remove_all_infos_from_bvalue(A,RA), |
| 1004 | | remove_all_infos_from_bvalue(B,RB). |
| 1005 | | remove_all_infos_from_bvalue(closure(P,T,Body),Res) :- !, |
| 1006 | | remove_all_infos_and_ground(Body,RBody), |
| 1007 | | Res = closure(P,T,RBody). |
| 1008 | | % TODO: we could provide more cases like records, sets as lists, freetype values |
| 1009 | | remove_all_infos_from_bvalue(Val,Val). |
| 1010 | | |
| 1011 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 1012 | | |
| 1013 | | % a version of create_exists_opt which also detects top-level disjunctions |
| 1014 | | % and marks the exists as generated and as allow_to_lift_exists |
| 1015 | | create_exists_opt_liftable(Ids,b(disjunct(A,B),pred,Info1),NewPred) :- !, |
| 1016 | | create_exists_opt_liftable(Ids,A,PA), |
| 1017 | | create_exists_opt_liftable(Ids,B,PB), |
| 1018 | | disjunct_predicates_with_pos_info(PA,PB,b(NP,pred,Info2)), |
| 1019 | | NewPred=b(NP,pred,NewInfo), |
| 1020 | | extract_just_important_info_aux(Info1,Info2,NewInfo). % copy symbolic or other relevant info |
| 1021 | | create_exists_opt_liftable(Ids,Pred,NewPred) :- conjunction_to_list(Pred,L), |
| 1022 | | create_exists_opt(Ids,L,[allow_to_lift_exists],NewPred,_Modified). |
| 1023 | | |
| 1024 | | % create_exists_opt(TIds,Preds,NewPred) |
| 1025 | | % creating an existential quantification with some optimisations. |
| 1026 | | % TIds: The typed identifiers that are quantified |
| 1027 | | % Preds: A list of predicates |
| 1028 | | % NewPred: The (optimised) quantified expression |
| 1029 | | % Basically two optimisations are performed: |
| 1030 | | % - identifiers that are not used at all are removed from the quantifier |
| 1031 | | % - predicates that do not use one of the quantified identifiers are moved |
| 1032 | | % outside the quantification, resulting in a predicate of the form "P & #x.Q(x)" |
| 1033 | | |
| 1034 | | create_exists_opt(TIds,Preds,NewPred) :- |
| 1035 | | create_exists_opt(TIds,Preds,[],NewPred,_). |
| 1036 | | |
| 1037 | | create_exists_opt(TIds,Preds,NewPred,Modified) :- |
| 1038 | | create_exists_opt(TIds,Preds,[],NewPred,Modified). |
| 1039 | | |
| 1040 | | create_exists_opt([],Preds,_,NewPred,Modified) :- !, Modified = false, |
| 1041 | | conjunct_predicates(Preds,NewPred). |
| 1042 | | create_exists_opt(TIds,Preds,AdditionalInfos,Res,Mod) :- |
| 1043 | | get_texpr_ids(TIds,UnsortedIds), sort(UnsortedIds,Ids), |
| 1044 | | (create_exists_opt1(TIds,Ids,Preds,AdditionalInfos,NewPred2,Modified) -> Res = NewPred2, Mod=Modified |
| 1045 | | ; add_internal_error('Call failed:',create_exists_opt(TIds,Preds,AdditionalInfos,_,_)),fail). |
| 1046 | | %create_exists_opt1(TIds,_,Preds,AdditionalInfos,NewPred,Modified) :- preference(data_validation_mode,true), |
| 1047 | | % % do not lift predicates outside of existential quantifiers and change order; see rule_avec_DV.mch ClearSy example (N_ITERa_avec_DV_sans_DV) and test 1945 |
| 1048 | | create_exists_opt1(TIds,Ids,Preds,AdditionalInfos,NewPred2,Modified) :- |
| 1049 | | create_exists_opt2(Preds,first,Ids,[],Inner,Outer,UsedIds), |
| 1050 | | % Inner: quantified part, Outer: part which does not have to be quantified |
| 1051 | | ( Inner = [] -> AllPreds=Outer % no exists needed |
| 1052 | | ; % Inner = [_|_] -> |
| 1053 | | create_filtered_exists(TIds,UsedIds,Inner,AdditionalInfos,Exists,IModified), |
| 1054 | | append(Outer,[Exists],AllPreds) |
| 1055 | | ), |
| 1056 | | (Outer=[_|_] -> Modified=true % TO DO: check if TIds=UsedTIds |
| 1057 | | ; IModified==true -> Modified=true |
| 1058 | | ; UsedIds == Ids -> Modified= false |
| 1059 | | ; Modified=true), |
| 1060 | | conjunct_predicates(AllPreds,NewPred2). |
| 1061 | | |
| 1062 | | % create an exists for the used Ids only |
| 1063 | | create_filtered_exists(TIds,UsedIds,Inner,AdditionalInfos,Exists,_) :- |
| 1064 | | ceo_filter_used_ids(TIds,UsedIds,UsedTIds), % filter out unused variables |
| 1065 | | conjunct_predicates_with_pos_info(Inner,I), % we could store used_ids info |
| 1066 | | create_exists_detect_tautology_aux(UsedTIds,I,AdditionalInfos,Exists). |
| 1067 | | % remove_typing also added in create_exists_detect_tautology_aux |
| 1068 | | |
| 1069 | | |
| 1070 | | % return Inner: predicates inside quantifier and Outer: predicates that can be moved out of the quantifier |
| 1071 | | create_exists_opt2([],_,_Ids,UsedIds,[],[],UsedIds) :- !. |
| 1072 | | create_exists_opt2([Pred|Prest],First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut) :- !, |
| 1073 | | find_identifier_uses_if_necessary(Pred, [], LocalUses), % TODO: add used_ids(LocalUses) to Pred |
| 1074 | | ord_intersection(Ids,LocalUses,ExistsIdsUsed), |
| 1075 | | ( ExistsIdsUsed = [], % Pred uses none of the quantified ids: we can move it out |
| 1076 | | (First==first -> true |
| 1077 | | ; preference(data_validation_mode,false), % see test 1945; step 39 in trace replay |
| 1078 | | always_well_defined_or_disprover_mode(Pred) % TODO: we should probably also check this ! |
| 1079 | | ) |
| 1080 | | -> |
| 1081 | | Inner = Irest, |
| 1082 | | Outer = [Pred|Orest], % move Pred out of existential quantifier as it does not depend on quantified variables |
| 1083 | | % format('MOVED out of #(~w): ',[Ids]),translate:print_bexpr(Pred), format(' Uses ~w [~w]~n',[LocalUses,ExistsIdsUsed]), |
| 1084 | | create_exists_opt2(Prest,first,Ids,UsedIdsIn,Irest,Orest,UsedIdsOut) |
| 1085 | | ; |
| 1086 | | update_used_ids(Pred,LocalUses,Pred2), |
| 1087 | | Inner = [Pred2|Irest], |
| 1088 | | Outer = Orest, |
| 1089 | | ord_union(UsedIdsIn,ExistsIdsUsed,Urest), |
| 1090 | | create_exists_opt2(Prest,not_first_anymore,Ids,Urest,Irest,Orest,UsedIdsOut) |
| 1091 | | ). |
| 1092 | | create_exists_opt2(Pred,First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut) :- |
| 1093 | | add_error(create_exists_opt,'Expecting predicate list: ',Pred), |
| 1094 | | create_exists_opt2([Pred],First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut). |
| 1095 | | |
| 1096 | | % construct exists optimized: keep only used TIds |
| 1097 | | ceo_filter_used_ids([],_UsedIds,[]). |
| 1098 | | ceo_filter_used_ids([TId|Irest],UsedIds,Filtered) :- |
| 1099 | | get_texpr_id(TId,Id), |
| 1100 | | ( ord_member(Id,UsedIds) -> Filtered = [TId|Frest] % id used: keep it |
| 1101 | | ; Filtered = Frest), |
| 1102 | | ceo_filter_used_ids(Irest,UsedIds,Frest). |
| 1103 | | |
| 1104 | | % a version of create_exists which also detects x=E and x:E, x>E, not(x>E) tautologies |
| 1105 | | % we could replace this by a more generic prover |
| 1106 | | create_exists_detect_tautology_aux([TID],b(member(LHS,RHS),pred,_),_,Truth) :- |
| 1107 | | get_texpr_id(LHS,ID), get_texpr_id(TID,ID), |
| 1108 | | definitely_not_empty_set(RHS), |
| 1109 | | always_well_defined_or_disprover_mode(RHS), |
| 1110 | | !, % replace #x.(x:RHS) by TRUTH |
| 1111 | | debug_format(19,'Detected tautology exists membership over ~w~n',[ID]), |
| 1112 | | Truth=b(truth,pred,[]). |
| 1113 | | create_exists_detect_tautology_aux([TID],b(Pred,_,_),_,Truth) :- |
| 1114 | | is_comparison(Pred,pos_neg(pos,TID),L,R), get_texpr_id(TID,ID), |
| 1115 | | ((LHS,RHS)=(L,R) ; (LHS,RHS)=(R,L)), |
| 1116 | | get_texpr_id(LHS,ID), |
| 1117 | | \+ occurs_in_expr(ID,RHS), |
| 1118 | | always_well_defined_or_disprover_mode(RHS), |
| 1119 | | !, % replace #x.(x COMP E) by TRUTH |
| 1120 | | debug_format(19,'Detected tautology comparison over ~w~n',[ID]), |
| 1121 | | Truth=b(truth,pred,[]). |
| 1122 | | %create_exists_detect_tautology_aux(Ids,b(disjunct(A,B),pred,Info1),AdditionalInfos,NewPred) :- !, |
| 1123 | | % create_exists(Ids,A,PA), create_exists(Ids,B,PB), |
| 1124 | | % disjunct_predicates_with_pos_info(PA,PB,b(NP,pred,Info2)), |
| 1125 | | % NewPred=b(NP,pred,NewInfo), |
| 1126 | | % extract_just_important_info_aux(Info1,Info2,NewInfo). % copy symbolic or other relevant info |
| 1127 | | create_exists_detect_tautology_aux(Ids,Pred,AdditionalInfos,NewPred2) :- |
| 1128 | | create_exists_or_let_predicate(Ids,Pred,NewPred), |
| 1129 | | add_texpr_infos_if_new(NewPred,[removed_typing|AdditionalInfos],NewPred2). |
| 1130 | | % removed_typing to avoid spurious exists_body_warning, see test 1681, 625 |
| 1131 | | |
| 1132 | | |
| 1133 | | is_eventb_comprehension_set(b(comprehension_set(TopIds,Body),_,Info),Ids,PRED,EXPR) :- |
| 1134 | | is_eventb_comprehension_set(TopIds,Body,Info,Ids,PRED,EXPR). |
| 1135 | | is_eventb_comprehension_set([TID1],Body,Info,Ids,PRED,EXPR) :- |
| 1136 | | Body = b(exists(Ids,InnerBody),pred,_), |
| 1137 | | conjunction_to_list(InnerBody,Inner), |
| 1138 | | append(Inner1,[b(equal(TID2,EXPR),pred,EqInfo)],Inner), |
| 1139 | | (member(was(event_b_comprehension_set),Info) -> true ; |
| 1140 | | member(prob_annotation('LAMBDA-EQUALITY'),EqInfo) % relevant for TLA2B |
| 1141 | | ), |
| 1142 | | same_id(TID1,TID2,_), |
| 1143 | | conjunct_predicates(Inner1,PRED), |
| 1144 | | % we check that TID1 is not being used in P1 and not just rely on was(event_b_comprehension_set) |
| 1145 | | not_occurs_in_expr(PRED,TID1). |
| 1146 | | |
| 1147 | | % ------------------- |
| 1148 | | |
| 1149 | | is_equal(b(equal(LHS,RHS),pred,_),A,B) :- |
| 1150 | | ((A,B)=(LHS,RHS) ; (A,B)=(RHS,LHS)). |
| 1151 | | |
| 1152 | | :- use_module(typing_tools,[type_has_at_least_two_elements/1]). |
| 1153 | | is_comparison(greater(A,B),_,A,B). |
| 1154 | | is_comparison(less(A,B),_,A,B). |
| 1155 | | is_comparison(greater_equal(A,B),_,A,B). |
| 1156 | | is_comparison(less_equal(A,B),_,A,B). |
| 1157 | | is_comparison(equal(A,B),pos_neg(P,TID),A,B) :- |
| 1158 | | % for neg: we need to make sure there is more than one value in the type (otherwise we cannot make equal false) |
| 1159 | | % for pos: assuming the RHS expression above is well-defined there must be at least one element; no need to check non_empty_type(Type) |
| 1160 | | (P=pos -> true ; get_texpr_type(TID,Type),type_has_at_least_two_elements(Type)). |
| 1161 | | is_comparison(not_equal(A,B),pos_neg(P,TID),A,B) :- % ditto but with pos and neg reversed |
| 1162 | | (P=neg -> true ; get_texpr_type(TID,Type),type_has_at_least_two_elements(Type)). |
| 1163 | | is_comparison(negation(b(Comp,pred,_)),PosNeg,A,B) :- negate(PosNeg,P2), |
| 1164 | | is_comparison(Comp,P2,A,B). |
| 1165 | | negate(pos_neg(pos,T),pos_neg(neg,T)). |
| 1166 | | negate(pos_neg(neg,T),pos_neg(pos,T)). |
| 1167 | | |
| 1168 | | |
| 1169 | | |
| 1170 | | % is true if a predicate Pred can be split into two parts: |
| 1171 | | % Outer which does not depend on LocalIds (can be lifted out) and Inner which does |
| 1172 | | detect_global_predicates(LocalIds,Pred,Outer,Inner) :- |
| 1173 | | get_texpr_ids(LocalIds,UnsortedIds), sort(UnsortedIds,Ids), |
| 1174 | | conjunction_to_list(Pred,Preds), |
| 1175 | | split_predicate_local_global(Preds,Ids,OuterL,InnerL), |
| 1176 | | OuterL \= [], |
| 1177 | | conjunct_predicates(OuterL,Outer), |
| 1178 | | conjunct_predicates(InnerL,Inner). |
| 1179 | | split_predicate_local_global([],_Ids,[],[]). |
| 1180 | | split_predicate_local_global([P|Ps],Ids,Outer,Inner) :- |
| 1181 | | (is_local_predicate(Ids,P) |
| 1182 | | -> Inner = [P|Is], split_predicate_local_global(Ps,Ids,Outer,Is) |
| 1183 | | ; Outer = [P|Os], split_predicate_local_global(Ps,Ids,Os,Inner)). |
| 1184 | | is_local_predicate(Ids,Pred) :- |
| 1185 | | find_identifier_uses_if_necessary(Pred, [], LocalUses), |
| 1186 | | ord_intersect(Ids,LocalUses). |
| 1187 | | |
| 1188 | | %:- use_module(b_global_sets,[b_global_set/1]). |
| 1189 | | definitely_not_empty_set(b(SET,T,_)) :- not_empty_set_aux(SET,T). |
| 1190 | | not_empty_set_aux(bool_set,_). |
| 1191 | | not_empty_set_aux(integer_set(_),_). |
| 1192 | | not_empty_set_aux(float_set,_). |
| 1193 | | not_empty_set_aux(real_set,_). |
| 1194 | | not_empty_set_aux(string_set,_). |
| 1195 | | not_empty_set_aux(set_extension(X),_) :- dif(X,[]). |
| 1196 | | not_empty_set_aux(sequence_extension(X),_) :- dif(X,[]). |
| 1197 | | not_empty_set_aux(pow_subset(_),_). % always contains at least the empty set |
| 1198 | | not_empty_set_aux(fin_subset(_),_). % ditto |
| 1199 | | not_empty_set_aux(seq(_),_). % ditto |
| 1200 | | not_empty_set_aux(iseq(_),_). % ditto |
| 1201 | | not_empty_set_aux(pow1_subset(A),_) :- definitely_not_empty_set(A). |
| 1202 | | not_empty_set_aux(fin1_subset(A),_) :- definitely_not_empty_set(A). |
| 1203 | | not_empty_set_aux(seq1(A),_) :- definitely_not_empty_set(A). |
| 1204 | | not_empty_set_aux(iseq1(A),_) :- definitely_not_empty_set(A). |
| 1205 | | not_empty_set_aux(cartesian_product(A,B),_) :- definitely_not_empty_set(A), definitely_not_empty_set(B). |
| 1206 | | not_empty_set_aux(partial_function(_A,_B),_). % always contains at least the empty set |
| 1207 | | not_empty_set_aux(partial_injection(_A,_B),_). % ditto |
| 1208 | | not_empty_set_aux(relations(_A,_B),_). % ditto |
| 1209 | | not_empty_set_aux(total_function(A,B),_) :- |
| 1210 | | (definitely_not_empty_set(B) -> true |
| 1211 | | ; definitely_empty_set(A)). % if A is empty, then the set of total functions is {{}} |
| 1212 | | not_empty_set_aux(union(A,B),_) :- (definitely_not_empty_set(A) -> true ; definitely_not_empty_set(B)). |
| 1213 | | not_empty_set_aux(overwrite(A,B),_) :- (definitely_not_empty_set(A) -> true ; definitely_not_empty_set(B)). |
| 1214 | | % TODO: add a few more function rules |
| 1215 | | not_empty_set_aux(value(S),_) :- not_empty_value(S). |
| 1216 | | %not_empty_set_aux(identifier(X),set(global(X))) :- bmachine:b_get_machine_set(X). % what if we have a local variable ? ENSURE THAT WE DO NOT ALLOW identifier X to stand for global set X; see ExistentialGlobalSetIDTest in Tester % also: b_global_set not yet computed when ast_cleanup runs on startup ! |
| 1217 | | % TO DO: determine which identifier(X) refer to global set names |
| 1218 | | not_empty_set_aux(interval(A,B),_) :- get_integer(A,IA), get_integer(B,IB), IA =< IB. |
| 1219 | | |
| 1220 | | :- use_module(b_global_sets,[b_non_empty_global_set/1]). |
| 1221 | | :- use_module(kernel_freetypes,[is_non_empty_freetype/1]). |
| 1222 | | not_empty_value(S) :- var(S),!,fail. |
| 1223 | | not_empty_value(avl_set(_)). |
| 1224 | | not_empty_value([_|_]). |
| 1225 | | not_empty_value(global_set(G)) :- b_non_empty_global_set(G). % always true |
| 1226 | | not_empty_value(freetype(G)) :- is_non_empty_freetype(G). % always true |
| 1227 | | not_empty_value(closure(P,T,B)) :- |
| 1228 | | custom_explicit_sets:is_interval_closure(P,T,B,LOW,UP), integer(LOW),integer(UP), LOW =< UP. |
| 1229 | | %TODO: more closures; see also definitely_not_empty_finite_value |
| 1230 | | |
| 1231 | | definitely_empty_set(b(ES,_,_)) :- is_empty_set_aux(ES). |
| 1232 | | is_empty_set_aux(empty_set). |
| 1233 | | is_empty_set_aux(empty_sequence). |
| 1234 | | is_empty_set_aux(domain(D)) :- definitely_empty_set(D). |
| 1235 | | is_empty_set_aux(range(D)) :- definitely_empty_set(D). |
| 1236 | | is_empty_set_aux(domain_subtraction(_,Rel)) :- definitely_empty_set(Rel). |
| 1237 | | is_empty_set_aux(domain_restriction(Dom,Rel)) :- (definitely_empty_set(Dom) -> true ; definitely_empty_set(Rel)). |
| 1238 | | is_empty_set_aux(range_restriction(Rel,Ran)) :- (definitely_empty_set(Ran) -> true ; definitely_empty_set(Rel)). |
| 1239 | | is_empty_set_aux(range_subtraction(Rel,_)) :- definitely_empty_set(Rel). |
| 1240 | | is_empty_set_aux(interval(A,B)) :- get_integer(A,IA), get_integer(B,IB), IA > IB. |
| 1241 | | is_empty_set_aux(intersection(A,B)) :- (definitely_empty_set(A) -> true ; definitely_empty_set(B)). |
| 1242 | | is_empty_set_aux(set_subtraction(A,_)) :- definitely_empty_set(A). |
| 1243 | | is_empty_set_aux(union(A,B)) :- definitely_empty_set(A), definitely_empty_set(B). |
| 1244 | | is_empty_set_aux(overwrite(A,B)) :- definitely_empty_set(A), definitely_empty_set(B). |
| 1245 | | is_empty_set_aux(value(V)) :- V==[]. |
| 1246 | | |
| 1247 | | |
| 1248 | | get_integer(b(B,_,_),I) :- get_integer_aux(B,I). |
| 1249 | | get_integer_aux(integer(I),I). |
| 1250 | | get_integer_aux(value(V),I) :- get_integer_value(V,I). |
| 1251 | | get_integer_value(V,I) :- nonvar(V),V=int(I), integer(I). |
| 1252 | | |
| 1253 | | |
| 1254 | | |
| 1255 | | :- use_module(probsrc(custom_explicit_sets),[avl_is_interval/3]). |
| 1256 | | get_interval(b(I,set(integer),_),Low,Up) :- |
| 1257 | | is_interval_aux(I,Low,Up). |
| 1258 | | is_interval_aux(interval(Low,Up),Low,Up). |
| 1259 | | is_interval_aux(value(CS),Low,Up) :- nonvar(CS), CS=avl_set(AVL), % occurs in Leftpad_i.imp |
| 1260 | | Low = b(integer(LI),integer,[]), Up = b(integer(UI),integer,[]), |
| 1261 | | avl_is_interval(AVL,LI,UI). |
| 1262 | | is_interval_aux(set_extension(List),Low,Up) :- print(l(List)),nl, |
| 1263 | | sort(List,SList), |
| 1264 | | SList = [Low|Rest], get_integer(Low,LI), |
| 1265 | | last(SList,Up), get_integer(Up,UI), |
| 1266 | | length(List,Len), |
| 1267 | | Len is UI-LI+1, |
| 1268 | | maplist(get_integer,Rest,_). |
| 1269 | | |
| 1270 | | % a simple let-detection |
| 1271 | | create_exists_or_let_predicate([H|T],b(conjunct(LHS,RHS),pred,I),NewPred) :- get_texpr_id(H,ID), |
| 1272 | ? | is_equal(LHS,TID,IDEXPR), % TO DO: should we do a more complicated check here ? exist technique useful for SLOT-24 codespeed test |
| 1273 | | get_texpr_id(TID,ID), \+ occurs_in_expr(ID,IDEXPR), |
| 1274 | | maplist(not_occurs_in_expr(IDEXPR),T), |
| 1275 | | !, |
| 1276 | | NewPred = b(let_predicate([TID],[IDEXPR],Body),pred,I), |
| 1277 | | %print('LET: '),translate:print_bexpr(NewPred),nl, |
| 1278 | | create_exists_or_let_predicate(T,RHS,Body). |
| 1279 | | create_exists_or_let_predicate(Ids,Pred,NewPred) :- create_exists(Ids,Pred,NewPred). |
| 1280 | | |
| 1281 | | not_occurs_in_expr(IDEXPR,TID) :- get_texpr_id(TID,ID), \+ occurs_in_expr(ID,IDEXPR). |
| 1282 | | |
| 1283 | | create_exists([],Pred,NewPred) :- !,Pred=NewPred. |
| 1284 | | create_exists(Ids,Pred,NewPred) :- |
| 1285 | | find_identifier_uses_for_quantifier_body(Ids,Pred, Used), |
| 1286 | | extract_info_wo_used_ids(Pred,NewImportantInfo), |
| 1287 | | create_texpr(exists(Ids,Pred),pred,[used_ids(Used)|NewImportantInfo],NewPred). |
| 1288 | | |
| 1289 | | % a version of create_exists which can merge with an already present exists if possible |
| 1290 | | % possibly more expensive as identfiers used are recomputed for the moment (TODO: reuse used_ids and subtract) |
| 1291 | | create_or_merge_exists(IDs, Condition, Exists):- |
| 1292 | | get_texpr_expr(Condition,exists(InnerVars,InnerCond)),!, |
| 1293 | | % fuse two exists together |
| 1294 | | append(IDs,InnerVars,Vars), |
| 1295 | | create_or_merge_exists(Vars,InnerCond,Exists). |
| 1296 | | create_or_merge_exists(IDs, Condition, Exists):- |
| 1297 | | create_exists(IDs,Condition,Exists). |
| 1298 | | |
| 1299 | | % see create_unsimplified_exists |
| 1300 | | not_generated_exists_paras([b(_,_,Infos)|_]) :- nonmember(generated_exists_parameter,Infos). |
| 1301 | | |
| 1302 | | |
| 1303 | | create_forall([],Pred,NewPred) :- !,Pred=NewPred. |
| 1304 | | create_forall(Ids,Pred,NewPred) :- |
| 1305 | | find_identifier_uses_for_quantifier_body(Ids,Pred, Used), |
| 1306 | | split_forall_body(Pred,LHS,RHS), |
| 1307 | | extract_info_wo_used_ids_and_pos(LHS,RHS,NewImportantInfo), |
| 1308 | | create_texpr(forall(Ids,LHS,RHS),pred,[used_ids(Used)|NewImportantInfo],NewPred). |
| 1309 | | split_forall_body(b(implication(LHS,RHS),_,_),LHS,RHS) :- !. |
| 1310 | | split_forall_body(RHS,b(truth,pred,[]),RHS). |
| 1311 | | |
| 1312 | | create_implication(b(truth,pred,_),P,Res) :- !, Res=P. |
| 1313 | | create_implication(b(falsity,pred,_),P,Res) :- !, create_negation(P,Res). |
| 1314 | | create_implication(Lhs,Rhs,b(implication(Lhs,Rhs),pred,NewInfo)) :- |
| 1315 | | extract_info(Lhs,Rhs,NewInfo). |
| 1316 | | |
| 1317 | | create_equivalence(Lhs,Rhs, b(equivalence(Lhs,Rhs),pred,NewInfo)) :- |
| 1318 | | extract_info(Lhs,Rhs,NewInfo). |
| 1319 | | |
| 1320 | | create_negation(b(P,pred,I),Res) :- create_negation_aux(P,I,R),!,Res=R. |
| 1321 | | create_negation(Pred,b(negation(Pred),pred,NewInfo)) :- |
| 1322 | | extract_info(Pred,Infos), |
| 1323 | | (get_texpr_non_label_posinfo(Pred,Pos) -> NewInfo = [Pos|Infos] ; NewInfo=Infos). |
| 1324 | | |
| 1325 | | create_negation_aux(truth,I,R) :- !, R=b(falsity,pred,I). |
| 1326 | | create_negation_aux(falsity,I,R) :- !, R=b(truth,pred,I). |
| 1327 | | create_negation_aux(negation(Pred),_,R) :- R=Pred. % not(not(P)) = P |
| 1328 | | %create_negation_aux(equal(A,B),I,R) :- !, R=b(not_equal(A,B),pred,I). |
| 1329 | | %create_negation_aux(not_equal(A,B),I,R) :- !, R=b(equal(A,B),pred,I). |
| 1330 | | % we could add some rules about negating member <-> not_member, ... but be careful with effects on is_negation_of |
| 1331 | | |
| 1332 | | % check if something is the negation of something else (quite stupid at the moment) |
| 1333 | | % used, e.g., to detect IF-THEN-ELSE constructs in b_ast_cleanup |
| 1334 | | is_negation_of(P,NP) :- |
| 1335 | | create_negation(P,NotP), % works both with not(A),A or A,not(A) |
| 1336 | | same_texpr(NotP,NP). |
| 1337 | | is_negation_of(b(P,pred,_),b(NP,pred,_)) :- is_negation_aux(P,NP). |
| 1338 | | |
| 1339 | | is_negation_aux(equal(A,B),NP) :- is_negation_of_equality(NP,A,B). |
| 1340 | | is_negation_aux(not_equal(A,B),NP) :- is_negation_of_disequality(NP,A,B). |
| 1341 | | is_negation_aux(subset(XA,SA),not_subset(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1342 | | is_negation_aux(not_subset(XA,SA),subset(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1343 | | is_negation_aux(subset_strict(XA,SA),not_subset_strict(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1344 | | is_negation_aux(not_subset_strict(XA,SA),subset_strict(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1345 | | is_negation_aux(member(XA,SA),not_member(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1346 | | is_negation_aux(not_member(XA,SA),member(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB). |
| 1347 | | is_negation_aux(less(A,B),greater_equal(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1348 | | is_negation_aux(less(A,B),less_equal(BB,AA)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1349 | | is_negation_aux(less_equal(B,A),less(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1350 | | is_negation_aux(less_equal(A,B),greater(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1351 | | is_negation_aux(greater_equal(A,B),NP) :- is_negation_aux(less_equal(B,A),NP). |
| 1352 | | is_negation_aux(greater(A,B),NP) :- is_negation_aux(less(B,A),NP). |
| 1353 | | is_negation_aux(less_equal_real(B,A),less_real(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1354 | | is_negation_aux(less_real(B,A),less_equal_real(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1355 | | is_negation_aux(negation(A),negation(B)) :- is_negation_of(A,B). |
| 1356 | | is_negation_aux(truth,falsity). |
| 1357 | | is_negation_aux(falsity,truth). |
| 1358 | | % TO DO: detect more ?? x < y <=> not ( x > y-1 ) |
| 1359 | | |
| 1360 | | is_negation_of_equality(not_equal(AA,BB),A,B) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1361 | | is_negation_of_equality(equal(AA,BB),A,B) :- same_texpr(A,AA), neg_value(BB,B). |
| 1362 | | |
| 1363 | | neg_value(b(boolean_true,_,_),b(boolean_false,_,_)). |
| 1364 | | neg_value(b(boolean_false,_,_),b(boolean_true,_,_)). |
| 1365 | | |
| 1366 | | is_negation_of_disequality(equal(AA,BB),A,B) :- same_texpr(A,AA), same_texpr(B,BB). |
| 1367 | | is_negation_of_disequality(not_equal(AA,BB),A,B) :- same_texpr(A,AA), neg_value(BB,B). |
| 1368 | | |
| 1369 | | |
| 1370 | | % another version which is simpler can can be used to get the negation of some operators |
| 1371 | | |
| 1372 | | get_negated_operator_expr(b(E,pred,_),Res) :- negate_expr_aux(E,Res). |
| 1373 | | negate_expr_aux(falsity,truth). |
| 1374 | | negate_expr_aux(truth,falsity). |
| 1375 | | negate_expr_aux(member(X,S),not_member(X,S)). |
| 1376 | | negate_expr_aux(not_member(X,S),member(X,S)). |
| 1377 | | negate_expr_aux(subset(X,S),not_subset(X,S)). |
| 1378 | | negate_expr_aux(not_subset(X,S),subset(X,S)). |
| 1379 | | negate_expr_aux(subset_strict(X,S),not_subset_strict(X,S)). |
| 1380 | | negate_expr_aux(not_subset_strict(X,S),subset_strict(X,S)). |
| 1381 | | negate_expr_aux(equal(X,S),not_equal(X,S)). |
| 1382 | | negate_expr_aux(not_equal(X,S),equal(X,S)). |
| 1383 | | negate_expr_aux(less(X,S),greater_equal(X,S)). |
| 1384 | | negate_expr_aux(greater_equal(X,S),less(X,S)). |
| 1385 | | negate_expr_aux(less_equal(X,S),greater(X,S)). |
| 1386 | | negate_expr_aux(greater(X,S),less_equal(X,S)). |
| 1387 | | negate_expr_aux(less_equal_real(X,S),less_real(S,X)). |
| 1388 | | negate_expr_aux(less_real(X,S),less_equal_real(S,X)). |
| 1389 | | % TO DO: negation() |
| 1390 | | |
| 1391 | | |
| 1392 | | % a liberal version for finding equalities |
| 1393 | | is_equality(TP,TA,TB) :- get_texpr_expr(TP,P), is_equality_aux(P,TA,TB). |
| 1394 | | |
| 1395 | | is_equality_aux(Var,TA,TB) :- var(Var),!, add_internal_error('Illegal call: ', is_equality_aux(Var,TA,TB)),fail. |
| 1396 | | is_equality_aux(equal(TA,TB),TA,TB). |
| 1397 | | is_equality_aux(not_equal(TA,TB),NTA,NTB) :- |
| 1398 | | (negate_boolean_value(TB,NTB) -> NTA=TA |
| 1399 | | ; NTB=TB, negate_boolean_value(TA,NTA)). % TA /= TRUE ---> TA = FALSE |
| 1400 | | is_equality_aux(partition(TA,[TB]),TA,TB). |
| 1401 | | is_equality_aux(member(TA,TSet),TA,TB) :- singleton_set_extension(TSet,TB). % TA:{TB} |
| 1402 | | is_equality_aux(negation(TExpr),TA,TB) :- get_negated_operator_expr(TExpr,NT), is_equality_aux(NT,TA,TB). |
| 1403 | | |
| 1404 | | negate_boolean_value(b(B,T,I),b(NB,T,I)) :- neg_bool_aux(B,NB). |
| 1405 | | neg_bool_aux(boolean_true,boolean_false). |
| 1406 | | neg_bool_aux(boolean_false,boolean_true). |
| 1407 | | % TODO: should we also detect value(pred_true), .... |
| 1408 | | |
| 1409 | | singleton_set_extension(b(SONE,Type,_),El) :- singleton_set_extension_aux(SONE,Type,El). |
| 1410 | | singleton_set_extension_aux(set_extension([El]),_,El). |
| 1411 | | singleton_set_extension_aux(value(Set),set(Type),b(value(El),Type,[])) :- custom_explicit_sets:singleton_set(Set,El). |
| 1412 | | singleton_set_extension_aux(sequence_extension([El]),_,Couple) :- |
| 1413 | | ONE = b(integer(1),integer,[]), |
| 1414 | | create_couple(ONE,El,Couple). |
| 1415 | | |
| 1416 | | |
| 1417 | | % detect various forms of membership: |
| 1418 | | is_membership(b(Expr,pred,_),TID,Set) :- is_membership_aux(Expr,TID,Set). |
| 1419 | | is_membership_aux(member(TID,Set),TID,Set). |
| 1420 | | is_membership_aux(subset(SONE,Set),TID,Set) :- singleton_set_extension(SONE,TID). % {TID} <: Set |
| 1421 | | |
| 1422 | | % detect even more forms of membership: |
| 1423 | | is_membership_or_equality(b(Expr,pred,_),TID,Set) :- |
| 1424 | | (is_membership_aux(Expr,TID,Set) -> true ; is_mem_eq_aux(Expr,TID,Set)). |
| 1425 | | |
| 1426 | | is_mem_eq_aux(equal(TID,VAL),TID,Set) :- % x=VAL <==> x:{VAL} |
| 1427 | | get_texpr_type(VAL,Type), |
| 1428 | | safe_create_texpr(set_extension([VAL]),set(Type),Set). |
| 1429 | | |
| 1430 | | % extract a lambda equality from a body; we suppose the equality is the last conjunct |
| 1431 | | get_lambda_equality(b(equal(TID,ResultExpr),pred,_),ID,[],ResultExpr) :- get_texpr_id(TID,ID). |
| 1432 | | get_lambda_equality(b(conjunct(LHS,RHS),pred,_),ID,[LHS|T],ResultExpr) :- |
| 1433 | | get_lambda_equality(RHS,ID,T,ResultExpr). |
| 1434 | | |
| 1435 | | % --------------------------------- |
| 1436 | | |
| 1437 | | is_pow_subset(B,Set) :- |
| 1438 | | ( B = b(pow_subset(Set),_,_) |
| 1439 | | ; B = b(fin_subset(Set),_,_), |
| 1440 | | finite_wd_set_value(Set) |
| 1441 | | ). |
| 1442 | | is_pow1_subset(B,Set) :- |
| 1443 | | ( B = b(pow1_subset(Set),_,_) |
| 1444 | | ; B = b(fin1_subset(Set),_,_), |
| 1445 | | finite_wd_set_value(Set) |
| 1446 | | ). |
| 1447 | | |
| 1448 | | % --------------------------------- |
| 1449 | | |
| 1450 | | get_texpr_couple(b(couple(TA1,TA2),_,_),TA1,TA2). |
| 1451 | | |
| 1452 | | % detect TA1|->TA2 = TB1|->TB2 and split into two |
| 1453 | | split_equality(b(equal(TA,TB),pred,I),b(equal(TA1,TB1),pred,I),b(equal(TA2,TB2),pred,I)) :- |
| 1454 | | get_texpr_couple(TA,TA1,TA2), |
| 1455 | | get_texpr_couple(TB,TB1,TB2). |
| 1456 | | |
| 1457 | | create_equality(b(_,TA,_),b(_,TB,_),_) :- TA \= TB, \+ unify_types_strict(TA,TB),!, |
| 1458 | | add_internal_error('Creating equality with incompatible types:',equal(TA,TB)),fail. |
| 1459 | | create_equality(A,B,Equality) :- |
| 1460 | | safe_create_texpr(equal(A,B),pred,Equality). |
| 1461 | | |
| 1462 | | create_couple(A,B,b(couple(A,B),couple(TA,TB),Infos)) :- |
| 1463 | | get_texpr_type(A,TA), get_texpr_type(B,TB), |
| 1464 | | extract_info(A,B,Infos). |
| 1465 | | |
| 1466 | | % couplise_list for typed expression list |
| 1467 | | create_couple([A],Couple) :- !,A=Couple. |
| 1468 | | create_couple([A,B|Rest],Couple) :- |
| 1469 | | create_couple(A,B,Couple1), |
| 1470 | | create_couple([Couple1|Rest],Couple). |
| 1471 | | |
| 1472 | | create_cartesian_product(A,B,CartAB) :- |
| 1473 | | get_texpr_types([A,B],[STA,STB]), |
| 1474 | | is_set_type(STA,TypeA), is_set_type(STB,TypeB), |
| 1475 | | safe_create_texpr(cartesian_product(A,B),set(couple(TypeA,TypeB)),CartAB). |
| 1476 | | |
| 1477 | | % derive typing from Ids |
| 1478 | | create_comprehension_set(Ids,Pred,Info,CompSet) :- |
| 1479 | | get_texpr_types(Ids,Types), |
| 1480 | | couplise_list(Types,ElementType), |
| 1481 | | create_texpr(comprehension_set(Ids,Pred),set(ElementType),Info,CompSet). |
| 1482 | | |
| 1483 | | |
| 1484 | | :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(b(couple(a,b),x,[]),c),xx,[]),[a,b,c])). |
| 1485 | | :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(a,c),x,[]),[a,c])). |
| 1486 | | :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(a,b(couple(b,c),x,[])),xx,[]),[a,b(couple(b,c),x,[])])). |
| 1487 | | nested_couple_to_list(NC,L) :- nested_couple_to_list_dcg(NC,L,[]). |
| 1488 | | nested_couple_to_list_dcg(b(couple(A,B),_,_)) --> !, |
| 1489 | | nested_couple_to_list_dcg(A), [B]. |
| 1490 | | nested_couple_to_list_dcg(E) --> [E]. |
| 1491 | | |
| 1492 | | % -------------------------------------- |
| 1493 | | |
| 1494 | | |
| 1495 | | % check if identifier(s) occur in typed expressions |
| 1496 | | |
| 1497 | | occurs_in_expr(ID,TExpr) :- var(ID),!, |
| 1498 | | add_internal_error('Variable id: ',occurs_in_expr(ID,TExpr)),fail. |
| 1499 | | occurs_in_expr(ID,TExpr) :- ID=b(_,_,_),!, add_internal_error('Non-atomic identifier: ',occurs_in_expr(ID,TExpr)),fail. |
| 1500 | | occurs_in_expr(ID,TExpr) :- ID=[_|_],!, |
| 1501 | | add_internal_error('List instead of identifier: ',occurs_in_expr(ID,TExpr)),fail. |
| 1502 | | occurs_in_expr(ID,TExpr) :- occurs_in_expr1(TExpr,ID). |
| 1503 | | |
| 1504 | | % treat a few common operators here; possibly avoid traversing whole term if we find ID in a sub-tree |
| 1505 | | occurs_in_expr1(TExpr,ID) :- TExpr = b(Expr,_,_),!, |
| 1506 | | occurs_in_expr2(Expr,TExpr,ID). |
| 1507 | | occurs_in_expr1(TExpr,ID) :- add_internal_error('Illegal typed expression:',occurs_in_expr1(TExpr,ID)). |
| 1508 | | |
| 1509 | | occurs_in_expr2(add(A,B),_,ID) :- !, |
| 1510 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1511 | | occurs_in_expr2(conjunct(A,B),_,ID) :- !, |
| 1512 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1513 | | occurs_in_expr2(couple(A,B),_,ID) :- !, |
| 1514 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1515 | | occurs_in_expr2(member(A,B),_,ID) :- !, |
| 1516 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1517 | | occurs_in_expr2(equal(A,B),_,ID) :- !, |
| 1518 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1519 | | occurs_in_expr2(function(A,B),_,ID) :- !, |
| 1520 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1521 | | occurs_in_expr2(image(A,B),_,ID) :- !, |
| 1522 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1523 | | occurs_in_expr2(intersection(A,B),_,ID) :- !, |
| 1524 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1525 | | occurs_in_expr2(interval(A,B),_,ID) :- !, |
| 1526 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1527 | | occurs_in_expr2(not_equal(A,B),_,ID) :- !, |
| 1528 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1529 | | occurs_in_expr2(assertion_expression(A,_Msg,B),_,ID) :- !, |
| 1530 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)). |
| 1531 | | occurs_in_expr2(domain(A),_,ID) :- !, occurs_in_expr1(A,ID). |
| 1532 | | occurs_in_expr2(range(A),_,ID) :- !, occurs_in_expr1(A,ID). |
| 1533 | | occurs_in_expr2(record_field(A,_FieldName),_,ID) :- !, occurs_in_expr1(A,ID). |
| 1534 | | occurs_in_expr2(identifier(ID1),_,ID) :- !, |
| 1535 | | ID1 = ID. |
| 1536 | | occurs_in_expr2(integer(_),_,_ID) :- !,fail. |
| 1537 | | occurs_in_expr2(string(_),_,_ID) :- !,fail. |
| 1538 | | occurs_in_expr2(value(_),_,_ID) :- !,fail. |
| 1539 | | occurs_in_expr2(truth,_,_ID) :- !,fail. |
| 1540 | | occurs_in_expr2(if_then_else(A,B,C),_,ID) :- !, |
| 1541 | | (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID) -> true ; occurs_in_expr1(C,ID)). |
| 1542 | | occurs_in_expr2(rec(Fields),_,ID) :- !, |
| 1543 | | l_field_occurs_in_expr1(Fields,ID). |
| 1544 | | occurs_in_expr2(set_extension(Elements),_,ID) :- !, |
| 1545 | | l_occurs_in_expr1(Elements,ID). |
| 1546 | | occurs_in_expr2(sequence_extension(Elements),_,ID) :- !, |
| 1547 | | l_occurs_in_expr1(Elements,ID). |
| 1548 | | occurs_in_expr2(Expr,_,ID) :- |
| 1549 | | syntaxelement(Expr,List,[], [], [], _), % no bound quantifiers; TO DO: treat bound quantifiers |
| 1550 | | !, |
| 1551 | | l_occurs_in_expr1(List,ID). |
| 1552 | | occurs_in_expr2(_E,TExpr,ID) :- |
| 1553 | | %functor(_E,F,N), print(occurs_in_expr2(F,N,ID)),nl, |
| 1554 | | (find_identifier_uses_if_necessary(TExpr,[],Used) |
| 1555 | | -> %check_sorted(Used), |
| 1556 | | %add_message(bsyntaxtree,'Occurs check: ',ID:Used,TExpr), translate:nested_print_bexpr(TExpr),nl, |
| 1557 | | ord_member(ID,Used) |
| 1558 | | ; add_failed_call_error(find_identifier_uses(TExpr,[],_)),fail). |
| 1559 | | % TO DO: optimize so that we only look for ID; we don't have to keep track of other IDs |
| 1560 | | |
| 1561 | | l_occurs_in_expr1([H|T],ID) :- !, |
| 1562 | | (occurs_in_expr1(H,ID) -> true ; l_occurs_in_expr1(T,ID)). |
| 1563 | | l_occurs_in_expr1(L,ID) :- L \= [], |
| 1564 | | add_internal_error('Illegal typed expression list:',l_occurs_in_expr1(L,ID)). |
| 1565 | | l_field_occurs_in_expr1([field(_,H)|T],ID) :- !, |
| 1566 | | (occurs_in_expr1(H,ID) -> true ; l_field_occurs_in_expr1(T,ID)). |
| 1567 | | l_field_occurs_in_expr1(L,ID) :- L \= [], |
| 1568 | | add_internal_error('Illegal record field list:',l_field_occurs_in_expr1(L,ID)). |
| 1569 | | |
| 1570 | | %check_sorted(List) :- sort(List,SL), (SL \= List -> add_internal_error('Not sorted:',List) ; true). |
| 1571 | | |
| 1572 | | some_id_occurs_in_expr([H|T],TExpr) :- (var(H) ; \+ atomic(H) ; var(T) ; T=[H2|_], H2 @< H), |
| 1573 | | add_internal_error('Must be (sorted) atomic identifiers: ',some_id_occurs_in_expr([H|T],TExpr)), |
| 1574 | | fail. |
| 1575 | | some_id_occurs_in_expr([Id],TExpr) :- !, % use version without complete find_identifier_uses |
| 1576 | | occurs_in_expr(Id,TExpr). |
| 1577 | | some_id_occurs_in_expr(SortedIDs,TExpr) :- |
| 1578 | | find_identifier_uses_if_necessary(TExpr,[],Used), |
| 1579 | | list_to_ord_set(Used,UsedSorted), |
| 1580 | | ord_intersect(UsedSorted,SortedIDs). |
| 1581 | | |
| 1582 | | % ----------------------------- |
| 1583 | | |
| 1584 | | % find used identifiers in typed expressions |
| 1585 | | |
| 1586 | | % a special version for quantifier bodies, attempting to reuse used_ids info |
| 1587 | | find_identifier_uses_for_quantifier_body(TIds,Body,Res) :- |
| 1588 | | get_texpr_ids(TIds,Ids), |
| 1589 | | list_to_ord_set(Ids,Ignore), |
| 1590 | | find_identifier_uses_if_necessary(Body,Ignore,Res). |
| 1591 | | |
| 1592 | | % only run find_identifier_uses if necessary because no used_ids Info field present |
| 1593 | | % TO DO: we could consider using used_ids within find_typed_identifier_uses: drawback: we would need to store types |
| 1594 | | find_identifier_uses_if_necessary(Expr,Ignore,Res) :- |
| 1595 | | get_texpr_info(Expr,I), |
| 1596 | ? | member(used_ids(UIds),I),!, %print('+'),nl, |
| 1597 | | find_with_reuse(Expr,UIds,Ignore,Res). |
| 1598 | | find_identifier_uses_if_necessary(Expr,Ignore,Res) :- find_identifier_uses(Expr,Ignore,Res). |
| 1599 | | |
| 1600 | | find_with_reuse(Expr,UIds,Ignore,Res) :- preference(prob_safe_mode,true), |
| 1601 | | !, |
| 1602 | | (is_ordset(Ignore) -> true ; add_internal_error('Not ordset: ',Ignore)), |
| 1603 | | (is_ordset(UIds) -> true ; add_internal_error('Not ordset: ',UIds)), |
| 1604 | | ord_subtract(UIds,Ignore,Res0), |
| 1605 | | find_identifier_uses(Expr,Ignore,Res1), |
| 1606 | | (Res1=Res0 -> true |
| 1607 | | ; ord_subtract(Res1,Res0,Miss), % missing |
| 1608 | | ord_subtract(Res0,Res1,Res01), % too much |
| 1609 | | (Miss=[] -> add_message(find_identifier_uses_if_necessary,'Suboptimal used_ids: ',Res01,Expr) |
| 1610 | | ; add_internal_error('Incorrect used_ids:',used_ids(missing(Miss),toomuch(Res01),usedids(UIds), |
| 1611 | | ignore(Ignore),real(Res1))), |
| 1612 | | translate:print_bexpr(Expr),nl |
| 1613 | | ) |
| 1614 | | ), |
| 1615 | | Res=Res1. |
| 1616 | | find_with_reuse(_,UIds,Ignore,Res) :- |
| 1617 | | %(is_ordset(Ignore) -> true ; add_internal_error('Not ordset: ',Ignore)), |
| 1618 | | ord_subtract(UIds,Ignore,Res). |
| 1619 | | |
| 1620 | | |
| 1621 | | find_identifier_uses_top_level(TExpr,Ids) :- |
| 1622 | | % get_global_identifiers(Ignored), % ignore all global sets and global constants; |
| 1623 | | % hence find_identifier_uses_top_level/2 usually should only be called for top level expressions |
| 1624 | | Ignored = [], % much more efficient to exclude afterwards for long lists of Ignored ids |
| 1625 | | find_identifier_uses(TExpr,Ignored,Ids0), |
| 1626 | | exclude_global_identifiers(Ids0,Ids). |
| 1627 | | |
| 1628 | | :- use_module(tools,[safe_sort/3]). |
| 1629 | | find_identifier_uses(TExpr,Ignored,Ids) :- |
| 1630 | | %tools_printing:print_term_summary(find_identifier_uses(TExpr,Ignored,Ids)),nl, |
| 1631 | | check_is_texpr(TExpr,find_identifier_uses), |
| 1632 | | (find_typed_identifier_uses(TExpr,Ignored,TIds) |
| 1633 | | -> get_texpr_ids(TIds,RIds), |
| 1634 | | % in case of type errors, or when type checking is not yet complete, we can have multiple entries of the same identifier with different types ! |
| 1635 | | sort(RIds,Ids) % was remove_dups, but remove_dups just calls sort; TODO: implement get_sorted_texpr_ids |
| 1636 | | ; add_internal_error('Call failed:',find_typed_identifier_uses(TExpr,Ignored,_)), |
| 1637 | | Ids=[] |
| 1638 | | ). |
| 1639 | | find_identifier_uses_l(TExprs,Ignored,Ids) :- |
| 1640 | | find_typed_identifier_uses_l(TExprs,Ignored,TIds), |
| 1641 | | get_texpr_ids(TIds,RIds), |
| 1642 | | sort(RIds,Ids). % see above |
| 1643 | | |
| 1644 | | check_is_texpr(X,Context) :- |
| 1645 | | (get_texpr_expr(X,_) -> true ; add_internal_error('Expected TExpr: ', check_is_texpr(X,Context))). |
| 1646 | | |
| 1647 | | find_typed_identifier_uses(TExpr,Ids) :- |
| 1648 | | % get_global_identifiers(Ignored), % ignore all global sets and global constants; hence find_typed_identifier_uses/2 usually should only be called for top level expressions |
| 1649 | | Ignored = [], |
| 1650 | | find_typed_identifier_uses(TExpr,Ignored,Ids0), |
| 1651 | | exclude_global_identifiers(Ids0,Ids). |
| 1652 | | |
| 1653 | | find_typed_identifier_uses(TExpr,Ignored,Ids) :- var(TExpr),!, |
| 1654 | | add_internal_error('Variable typed expression: ', find_typed_identifier_uses(TExpr,Ignored,Ids)), |
| 1655 | | Ids = []. |
| 1656 | | find_typed_identifier_uses(TExpr,Ignored,Ids) :- |
| 1657 | | find_typed_identifier_uses_l([TExpr],Ignored,Ids). |
| 1658 | | |
| 1659 | | find_typed_identifier_uses2(TExpr,Ignored,Ids,Rest) :- |
| 1660 | | get_texpr_expr(TExpr,Expr), |
| 1661 | | safe_syntaxelement_det(Expr,Subs,TNames,_,_), % QSubs=[], |
| 1662 | | ( uses_an_identifier(Expr,Id,TExpr,Ignored) -> |
| 1663 | | ( ord_member(Id,Ignored) -> Ids=Rest |
| 1664 | | ; |
| 1665 | | get_texpr_type(TExpr,Type), |
| 1666 | | normalize_type(Type,NType), % replace seq by set; |
| 1667 | | % warning: when type-check not yet complete we have variables here |
| 1668 | | create_texpr(identifier(Id),NType,[],TId), |
| 1669 | | %print(adding(Id,NType,Ignored)),nl, |
| 1670 | | Ids = [TId|Rest] |
| 1671 | | ) |
| 1672 | | % ; (Expr = becomes_such(TIds,_)), nl,print(uses_primes(Expr)),nl,fail |
| 1673 | | ; indirectly_uses_identifiers(Expr,Ignored,IndirectIds) -> |
| 1674 | | add_typed_ids(IndirectIds,Ids,Rest2), |
| 1675 | | find_typed_identifier_uses2_l(Subs,Ignored,Rest2,Rest) |
| 1676 | | ; TNames = [] -> find_typed_identifier_uses2_l(Subs,Ignored,Ids,Rest) |
| 1677 | | ; |
| 1678 | | %find_typed_identifier_uses2_l(QSubs,Ignored,Ids,Ids2), % useless here as QSubs=[] |
| 1679 | | get_texpr_ids(TNames,Names), |
| 1680 | | list_to_ord_set(Names,SNames), ord_union(SNames,Ignored,Ignored2), |
| 1681 | | find_typed_identifier_uses2_l(Subs,Ignored2,Ids,Rest)). |
| 1682 | | find_typed_identifier_uses2_l([],_) --> !, []. |
| 1683 | | find_typed_identifier_uses2_l([Expr|Rest],Ignored) --> !, |
| 1684 | | find_typed_identifier_uses2(Expr,Ignored), |
| 1685 | | find_typed_identifier_uses2_l(Rest,Ignored). |
| 1686 | | find_typed_identifier_uses2_l(E,Ignored) --> |
| 1687 | | {add_internal_error('Illegal arguments (not a list):',find_typed_identifier_uses2_l(E,Ignored)),fail}. |
| 1688 | | |
| 1689 | | %Note: above we do not remap uses of Id$0 to Id in becomes_such; |
| 1690 | | % this is done in find_read_vars_for_becomes_such in b_read_write_info |
| 1691 | | |
| 1692 | | |
| 1693 | | uses_an_identifier(Expr,Id) :- uses_an_identifier(Expr,Id,none,[]). |
| 1694 | | |
| 1695 | | uses_an_identifier(identifier(Id),Id,_,_). |
| 1696 | | uses_an_identifier(lazy_lookup_pred(Id),Id,_,_). |
| 1697 | | uses_an_identifier(lazy_lookup_expr(Id),Id,_,_). |
| 1698 | | uses_an_identifier(value(_),Id,b(_,_,Info),Ignored) :- Ignored \= [], |
| 1699 | | member(was_identifier(Id),Info), |
| 1700 | | member('$examine_value_was_identifier_info',Ignored),!. |
| 1701 | | |
| 1702 | | % uses multiple ids and we also need to inspect subs (operation call arguments) |
| 1703 | | indirectly_uses_identifiers(operation_call_in_expr(Operation,_),Ignored,IndirectIds) :- |
| 1704 | | get_texpr_info(Operation,Info), |
| 1705 | | (memberchk(reads(Vars),Info) |
| 1706 | | -> (var(Vars) % can happen during initial computation of read_write info for recursive operation calls in expr |
| 1707 | | -> add_message(bsyntaxtree,'Operation reads info not yet computed (probably recursive call): ',Operation,Info), |
| 1708 | | fail % Assume this is a direct recursive call which adds no used ids, |
| 1709 | | % case happens in test 1960 for recursive call to Fact; TODO: more robust solution or disallow recursion |
| 1710 | | ; true) |
| 1711 | | ; add_warning(bsyntaxtree,'Operation call contains no read infos:',Operation,Info),fail), |
| 1712 | | ord_subtract(Vars,Ignored,IndirectIds), |
| 1713 | | IndirectIds \= []. |
| 1714 | | %indirectly_uses_identifiers(external_pred_call(FunName,_),Ignored,IndirectIds) :- |
| 1715 | | % expects_state(FunName), TODO: check for which external functions/predicates we need to add ids |
| 1716 | | |
| 1717 | | |
| 1718 | | % this is to convert untyped ids in operation call reads infos to typed ids |
| 1719 | | add_typed_ids([]) --> []. |
| 1720 | | add_typed_ids([Id|T]) --> {var_cst_type(Id,Type)},!, |
| 1721 | | {create_texpr(identifier(Id),Type,[],TId)}, [TId], add_typed_ids(T). |
| 1722 | | add_typed_ids([Id|T]) --> {debug_println(19,ignoring_used_id(Id))}, add_typed_ids(T). |
| 1723 | | |
| 1724 | | :- use_module(bmachine,[bmachine_is_precompiled/0, b_is_variable/2,b_is_constant/2]). |
| 1725 | | var_cst_type(Name,Type) :- bmachine_is_precompiled,!, |
| 1726 | | (b_is_variable(Name,Type) ; b_is_constant(Name,Type)),!. |
| 1727 | | var_cst_type(_,any). % TODO: provide a better solution; maybe only allow untyped find_identifier_uses ?? |
| 1728 | | |
| 1729 | | % ------------- |
| 1730 | | |
| 1731 | | find_typed_identifier_uses_l(TExprs,Ignored,Ids) :- |
| 1732 | | check_atomic_ids(Ignored), |
| 1733 | | list_to_ord_set(Ignored,SIgnored), |
| 1734 | | find_typed_identifier_uses2_l(TExprs,SIgnored,Unsorted,[]),!, |
| 1735 | | safe_sort(find_typed_identifier_uses,Unsorted,Ids), |
| 1736 | | (preference(prob_safe_mode,true) -> check_typed_ids(Ids) ; true). |
| 1737 | | find_typed_identifier_uses_l(TExprs,Ignored,Ids) :- |
| 1738 | | add_internal_error('Call failed:',find_typed_identifier_uses_l(TExprs,Ignored,Ids)), |
| 1739 | | fail. |
| 1740 | | |
| 1741 | | check_typed_ids([]) :- !. |
| 1742 | | check_typed_ids([b(identifier(ID),T,_)|Tail]) :- !, check_ids3(Tail,ID,T). |
| 1743 | | check_typed_ids(Other) :- add_internal_error('Unexpected typed id list:',check_typed_ids(Other)). |
| 1744 | | |
| 1745 | | |
| 1746 | | check_atomic_ids([]) :- !. |
| 1747 | | check_atomic_ids([Id|_]) :- atomic(Id),!. |
| 1748 | | check_atomic_ids(Other) :- add_internal_error('Expected atomic id list:',check_atomic_ids(Other)). |
| 1749 | | |
| 1750 | | |
| 1751 | | check_ids3([],_,_) :- !. |
| 1752 | | check_ids3([b(identifier(ID),T,_)|Tail],ID1,T1) :- !, |
| 1753 | | (ID=ID1 -> add_internal_error('Identifier appears multiple times with types:',id(ID,T1,T)) ; true), |
| 1754 | | check_ids3(Tail,ID,T). |
| 1755 | | check_ids3(Other,ID1,T1) :- add_internal_error('Unexpected typed id list:',check_ids3(Other,ID1,T1)). |
| 1756 | | |
| 1757 | | |
| 1758 | | update_used_ids(b(Pred,T,OInfo),UsedIds,b(Pred,T,[used_ids(UsedIds)|NInfo])) :- |
| 1759 | | delete(OInfo,used_ids(_),NInfo). |
| 1760 | | |
| 1761 | | % check if some pre-computed used ids are valid wrt find_typed_identifier_uses |
| 1762 | | check_computed_used_ids(TExpr,CompUsedIds) :- |
| 1763 | | find_identifier_uses(TExpr,[],RealUsedIds), |
| 1764 | | (RealUsedIds=CompUsedIds -> print(ok(CompUsedIds)),nl |
| 1765 | | ; add_error(range,'Unexpected used ids:',CompUsedIds,TExpr), |
| 1766 | | format('Real: ~w~nComp: ~w~n',[RealUsedIds,CompUsedIds]),trace |
| 1767 | | ). |
| 1768 | | |
| 1769 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 1770 | | % break predicate into components with disjunct identifiers |
| 1771 | | % Pred: a predicate |
| 1772 | | % Components: a list of terms component/2 where the first argument |
| 1773 | | % is a predicate, the second is the set of used identifiers |
| 1774 | | predicate_components(Pred,Res) :- predicate_components_in_scope(Pred,[],Res). |
| 1775 | | predicate_components_in_scope(Pred,LocalVars,Res) :- |
| 1776 | | predicate_components_with_restriction(Pred,LocalVars,all,Res). |
| 1777 | | |
| 1778 | | predicate_components_with_restriction(Pred,LocalVars,RestrictionList,Res) :- |
| 1779 | | conjunction_to_list(Pred,Preds), |
| 1780 | | l_predicate_identifiers(Preds,LocalVars,PredIds), |
| 1781 | | (RestrictionList=all -> R=all ; list_to_ord_set(RestrictionList,R)), |
| 1782 | | try_find_and_remove_equalities(PredIds,PredIds2), |
| 1783 | | % print(find_components(R)),nl,nl, |
| 1784 | | %%(member(pred(P,Ids,X),PredIds2), nl,print(pred(Ids,X)),nl,translate:print_bexpr(P),nl,fail ; true), |
| 1785 | | find_components(PredIds2,R,Components), |
| 1786 | | !, |
| 1787 | | %maplist(print_component,Components), |
| 1788 | | Components=Res. |
| 1789 | | predicate_components_with_restriction(Pred,_,_,[component(Pred,[])]) :- |
| 1790 | | add_internal_error('predicate_components failed: ',predicate_components_with_restriction(Pred,_,_,_)). |
| 1791 | | |
| 1792 | | % print_component(component(Pred,Ids)) :- format('Component over ~w :~n',[Ids]), translate:print_bexpr(Pred),nl. |
| 1793 | | |
| 1794 | | % get the list of used identifiers for each predicate |
| 1795 | | l_predicate_identifiers([],_LocalVars,[]). |
| 1796 | | l_predicate_identifiers([Pred|PRest],LocalVars,[pred(Pred,Ids,_Selected)|IRest]) :- |
| 1797 | | predicate_identifiers_in_scope(Pred,LocalVars,Ids), % Do not ignore local variables; used instead of enumerate set elements |
| 1798 | | l_predicate_identifiers(PRest,LocalVars,IRest). |
| 1799 | | |
| 1800 | | |
| 1801 | | try_find_and_remove_equalities(PredAndIds,PredAndIds2) :- |
| 1802 | | preferences:get_preference(partition_predicates_inline_equalities,true), |
| 1803 | | \+ preferences:get_preference(use_solver_on_load,kodkod), |
| 1804 | ? | find_and_remove_equalities(PredAndIds,RR), |
| 1805 | | !, PredAndIds2=RR. |
| 1806 | | try_find_and_remove_equalities(Ps,Ps). |
| 1807 | | |
| 1808 | | :- use_module(debug,[debug_println/2]). |
| 1809 | | % find and apply obvious equalities so that they do not interfere with partitioning into components |
| 1810 | | % example: c = 1 & f: 1..c --> A & g: 1..c --> B |
| 1811 | | % TO DO: preprocess and do one pass to detect potential equalities |
| 1812 | | find_and_remove_equalities([],[]). |
| 1813 | | find_and_remove_equalities(List,[pred(P,PIds,Sel)|FT]) :- |
| 1814 | ? | select(pred(P,PIds,Sel),List,Rest), |
| 1815 | | %PIds = [Id], |
| 1816 | | identifier_equality(P,Id,Value), |
| 1817 | | %(value_which_can_be_replaced(Value) -> true ; nl,print('Not replaced: '),translate:print_bexpr(Value),nl,fail), |
| 1818 | | (get_texpr_id(Value,Id2) |
| 1819 | | -> Id2 \= Id %,print(inline_id(Id,Id2)),nl |
| 1820 | | % Note: this inlining does *not* help with partitioning; but does help ProB detect common predicates/expressions |
| 1821 | | ; PIds=[Id],value_which_can_be_replaced(Value)), |
| 1822 | | debug_println(9,replace_simple_equality(Id,PIds)), |
| 1823 | | maplist(apply_to_pred(Id,Value),Rest,RT), |
| 1824 | | !, |
| 1825 | ? | find_and_remove_equalities(RT,FT). |
| 1826 | | % TO DO: detect equalityes x = EXPR, where EXPR does not contain x and where x occurs in no other predicate |
| 1827 | | % we can then annotate x as not to enumerate |
| 1828 | | find_and_remove_equalities(R,R). |
| 1829 | | |
| 1830 | | identifier_equality(b(equal(LHS,RHS),_,_),Id,EqTerm) :- |
| 1831 | | (get_texpr_id(LHS,Id) -> EqTerm = RHS |
| 1832 | | ; get_texpr_id(RHS,Id) -> EqTerm = LHS). |
| 1833 | | % TO DO: should we detect other equalities? |
| 1834 | | |
| 1835 | | value_which_can_be_replaced(b(E,T,_)) :- value_which_can_be_replaced2(E,T). |
| 1836 | | %(value_which_can_be_replaced2(E,T) -> true ; print(not_val(E)),nl,fail). |
| 1837 | | value_which_can_be_replaced2(value(_),_). |
| 1838 | | value_which_can_be_replaced2(integer(_),_). |
| 1839 | | %value_which_can_be_replaced2(identifier(I),global(G)) :- b_global_constant(G), id_not_used_anywhere(I). |
| 1840 | | value_which_can_be_replaced2(integer_set(_),_). |
| 1841 | | value_which_can_be_replaced2(unary_minus(A),_) :- value_which_can_be_replaced(A). |
| 1842 | | value_which_can_be_replaced2(add(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B). |
| 1843 | | % we could compute the value |
| 1844 | | value_which_can_be_replaced2(minus(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B). |
| 1845 | | value_which_can_be_replaced2(multiplication(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B). |
| 1846 | | value_which_can_be_replaced2(div(A,B),_) :- |
| 1847 | | get_integer(B,IB), IB \= 0, |
| 1848 | | value_which_can_be_replaced(A). |
| 1849 | | value_which_can_be_replaced2(floored_div(A,B),T) :- value_which_can_be_replaced2(div(A,B),T). |
| 1850 | | % should we add: with WD check: division, modulo, .... ? see also simple2 in b_ast_cleanup |
| 1851 | | value_which_can_be_replaced2(max_int,_). |
| 1852 | | value_which_can_be_replaced2(min_int,_). |
| 1853 | | value_which_can_be_replaced2(float_set,_). |
| 1854 | | value_which_can_be_replaced2(real(_),_). |
| 1855 | | value_which_can_be_replaced2(real_set,_). |
| 1856 | | value_which_can_be_replaced2(string(_),_). |
| 1857 | | value_which_can_be_replaced2(string_set,_). |
| 1858 | | value_which_can_be_replaced2(boolean_true,_). |
| 1859 | | value_which_can_be_replaced2(boolean_false,_). |
| 1860 | | value_which_can_be_replaced2(bool_set,_). |
| 1861 | | value_which_can_be_replaced2(empty_set,_). |
| 1862 | | value_which_can_be_replaced2(empty_sequence,_). |
| 1863 | | value_which_can_be_replaced2(couple(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B). |
| 1864 | | value_which_can_be_replaced2(interval(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B). |
| 1865 | | value_which_can_be_replaced2(set_extension(L),_) :- maplist(value_which_can_be_replaced,L). |
| 1866 | | value_which_can_be_replaced2(sequence_extension(L),_) :- maplist(value_which_can_be_replaced,L). |
| 1867 | | value_which_can_be_replaced2(cartesian_product(A,B),_) :- % typing equations, like t_float = INTEGER*NATURAL1 |
| 1868 | | simple_value_set(A), simple_value_set(B). |
| 1869 | | value_which_can_be_replaced2(pow_subset(A),_) :- simple_value_set(A). |
| 1870 | | %value_which_can_be_replaced2(identifier(_),_). % TO DO: check that this is not the LHS identifier which we replace !! |
| 1871 | | % identifiers can also be replaced: we check above that the only identifier in the predicate is the equality identifier |
| 1872 | | % TO DO: enable this but then we need to fix replace_id_by_expr2 to updated the used_ids info ! + we can have scoping issues !?; see test 1358 |
| 1873 | | |
| 1874 | | % TO DO: also allow inlining of prj1/prj2 of simple_value_set: |
| 1875 | | % not_val(comprehension_set([b(identifier(_zzzz_unary),integer,[generated(first)]),b(identifier(_zzzz_binary),integer,[generated(first)]),b(identifier(_lambda_result_),integer,[lambda_result])],b(equal(b(identifier(_lambda_result_),integer,[lambda_result]),b(identifier(_zzzz_unary),integer,[generated(first)])),pred,[prob_annotation(LAMBDA),lambda_result]))) |
| 1876 | | % not_val(comprehension_set([b(identifier(_zzzz_unary),integer,[generated(second)]),b(identifier(_zzzz_binary),integer,[generated(second)]),b(identifier(_lambda_result_),integer,[lambda_result])],b(equal(b(identifier(_lambda_result_),integer,[lambda_result]),b(identifier(_zzzz_binary),integer,[generated(second)])),pred,[prob_annotation(LAMBDA),lambda_result]))) |
| 1877 | | |
| 1878 | | % TO DO: maybe check if it is an infinite type which cannot be evaluated anyway |
| 1879 | | simple_value_set(b(E,_,_)) :- simple_value_set2(E). |
| 1880 | | %simple_value_set2(bool_set). % Warning: we could have a finite construct which gets evaluated multiple times |
| 1881 | | simple_value_set2(string_set). |
| 1882 | | simple_value_set2(integer_set(_)). |
| 1883 | | simple_value_set2(float_set). |
| 1884 | | simple_value_set2(real_set). |
| 1885 | | simple_value_set2(cartesian_product(A,B)) :- simple_value_set(A), simple_value_set(B). |
| 1886 | | simple_value_set2(pow_subset(A)) :- simple_value_set(A). |
| 1887 | | % POW, records struct(_) set ? |
| 1888 | | |
| 1889 | | % apply a substiution of ID/Expr on a pred(EXPR,VarList,X) term |
| 1890 | | % Expr must either be a variable or contain no variables at all |
| 1891 | | apply_to_pred(ID,Expr,pred(E1,PIds1,X),pred(E2,PIds3,X)) :- |
| 1892 | ? | (select(ID,PIds1,PIds2) |
| 1893 | | -> replace_id_by_expr(E1,ID,Expr,E2), %,print(applied(ID)),nl,translate:print_bexpr(E2),nl |
| 1894 | | % TO DO: replace_id_by_expr does not seem to update used_ids info !! check_used_ids_info fails for test 1358 if we allow identifiers inside Expr |
| 1895 | | (get_texpr_id(Expr,NewID) |
| 1896 | | -> ord_add_element(PIds2,NewID,PIds3) |
| 1897 | | ; PIds3 = PIds2) |
| 1898 | | %, format('Apply ~w -> ~w : ',[ID,NewID]),translate:print_bexpr(E2),nl |
| 1899 | | ; E1=E2,PIds1=PIds3). |
| 1900 | | |
| 1901 | | |
| 1902 | | % project a predicate : keep only those Predicates that are directly or |
| 1903 | | % indirectly relevant for Ids; FullIds are all identifiers used by ProjectedPredicate |
| 1904 | | project_predicate_on_identifiers(Pred,Ids,ProjectedPredicate,FullIds, RestList) :- |
| 1905 | | (debug_mode(on) |
| 1906 | | -> print('project: '),print_bexpr(Pred),nl, print(' on : '), print(Ids),nl |
| 1907 | | ; true), |
| 1908 | | conjunction_to_list(Pred,Preds), |
| 1909 | | l_predicate_identifiers(Preds,[],PredIds), % TO DO: allow LocalVariables to be passed |
| 1910 | | % print(predids(PredIds)),nl, |
| 1911 | | try_find_and_remove_equalities(PredIds,PredIds2), |
| 1912 | | extract_all_predicates(Ids,all,Ids,PredIds2,ProjectedPredicates, RestList,FullIds), |
| 1913 | | conjunct_predicates(ProjectedPredicates,ProjectedPredicate), |
| 1914 | | (debug_mode(on) |
| 1915 | | -> print('*result: '),print_bexpr(ProjectedPredicate),nl, |
| 1916 | | print(' on : '), print(FullIds),nl |
| 1917 | | ; true). |
| 1918 | | |
| 1919 | | %print_preds([]). |
| 1920 | | %print_preds([pred(P,_IDs,_)|T]) :- translate:print_bexpr(P), nl, print(' '), print_preds(T). |
| 1921 | | |
| 1922 | | :- use_module(b_global_sets,[b_get_global_constants/1, b_get_enumerated_set_constants/1, |
| 1923 | | b_get_global_sets/1, exclude_global_identifiers/2, exclude_global_identifiers/3]). |
| 1924 | | predicate_identifiers(Pred,Ids) :- predicate_identifiers_in_scope(Pred,[],Ids). |
| 1925 | | predicate_identifiers_in_scope(Pred,LocalVariables,Ids) :- |
| 1926 | | %get_global_identifiers(IS), |
| 1927 | | list_to_ord_set(LocalVariables,LV), |
| 1928 | | %ord_subtract(IS,LV,Ignore2), % Do not ignore any local variable; it will be used instead of enumerate set element |
| 1929 | | find_identifier_uses_if_necessary(Pred,[],Ids1), % Ignore enumerated set names |
| 1930 | | exclude_global_identifiers(Ids1,LV,Ids2), |
| 1931 | | list_to_ord_set(Ids2,Ids). |
| 1932 | | |
| 1933 | | % see also b_global_constant_or_set_identifier and exclude_global_identifiers |
| 1934 | | get_global_identifiers(IDs) :- get_global_identifiers(IDs,all). |
| 1935 | | % get global set and constant identifiers which you usually want to exclude for find_identifier_uses |
| 1936 | | get_global_identifiers(IDs,Option) :- |
| 1937 | | (Option=ignore_promoted_constants |
| 1938 | | % do not include those constants that have been automatically promoted as enumerated set elements |
| 1939 | | -> b_get_enumerated_set_constants(EnumeratedSetCsts) |
| 1940 | | ; b_get_global_constants(EnumeratedSetCsts) |
| 1941 | | ), |
| 1942 | | % b_global_sets:b_get_global_enumerated_sets(GSets), % is there a reason to exclude deferred sets ??; cardinality inference,... are all done before partitioning ? |
| 1943 | | b_get_global_sets(GSets), |
| 1944 | | append(GSets,EnumeratedSetCsts,GE), |
| 1945 | | list_to_ord_set(GE,IDs). |
| 1946 | | |
| 1947 | | % find_components(ListOf_pred, Restrict, Out:ListOfComponents) |
| 1948 | | % role of Restrict: all if we do normal partition or List of VariableIDs on which we restrict our attention to (for Existential quantifier construction) |
| 1949 | | find_components([],_,[]). |
| 1950 | | find_components([pred(P,PIds,true)|PRest],Restrict,[component(Pred,Ids)|CRest]) :- |
| 1951 | | % find all predicates which are using identifiers occuring in PIds |
| 1952 | | % (and additionally those which use common identifiers ) |
| 1953 | | ord_restrict(Restrict,PIds,InterIDs), |
| 1954 | | %format('Treating predicate with ids ~w; restr. intersect = ~w~n',[PIds,InterIDs]), |
| 1955 | | ( InterIDs =[] -> |
| 1956 | | % we simply copy this predicate into a single component; not with the scope of Restricted IDs |
| 1957 | | % print(skip(PIds,P)),nl, % |
| 1958 | | Pred=P, Ids=PIds, PRest=Rest |
| 1959 | | ; |
| 1960 | | extract_all_predicates(InterIDs,Restrict,PIds,PRest,Preds,Rest,Ids), |
| 1961 | | %length([P|Preds],Len), format('Detected component with ~w conjuncts over ~w~n',[Len,Ids]), |
| 1962 | | conjunct_predicates_with_pos_info([P|Preds],Pred) |
| 1963 | | ), |
| 1964 | | find_components(Rest,Restrict,CRest). |
| 1965 | | extract_all_predicates([],_,_,Preds,Found,Rest,[]) :- !, % selecting done at end: keep same order of conjuncts |
| 1966 | | select_predicates(Preds,Found,Rest). |
| 1967 | | extract_all_predicates(Ids,Restrict,OldIds,Preds,Found,Rest,ResultIds) :- |
| 1968 | | % search for all predicates that directly use one of the |
| 1969 | | % identifiers in "Ids" |
| 1970 | | select_all_using_preds(Preds,Ids,FoundIds), |
| 1971 | | ord_subtract(FoundIds,OldIds,NewIds), |
| 1972 | | ord_restrict(Restrict,NewIds,NewIdsToExtract), |
| 1973 | | ord_union(OldIds,FoundIds,OldIds2), |
| 1974 | | % now recursively do this which the new identifiers that we have found |
| 1975 | | extract_all_predicates(NewIdsToExtract,Restrict,OldIds2,Preds,Found,Rest,RestIds), |
| 1976 | | ord_union([Ids,NewIds,RestIds],ResultIds). |
| 1977 | | |
| 1978 | | % mark all predicates which intersect with ComponentIds and compute new ids to be added to the component |
| 1979 | | select_all_using_preds([],_,[]). |
| 1980 | | select_all_using_preds([pred(_P,PIds,Selected)|PRest],ComponentIds,NewFoundIds) :- |
| 1981 | | ( (Selected==true ; ord_disjoint(PIds,ComponentIds)) -> |
| 1982 | | NewFoundIds1 = [] |
| 1983 | | ; % we select the predicate for the component |
| 1984 | | ord_subtract(PIds,ComponentIds,NewFoundIds1), |
| 1985 | | Selected=true |
| 1986 | | ), |
| 1987 | | select_all_using_preds(PRest,ComponentIds,NewFoundIds2), |
| 1988 | | ord_union(NewFoundIds1,NewFoundIds2,NewFoundIds). |
| 1989 | | |
| 1990 | | % ord_intersection with special case for all term |
| 1991 | | ord_restrict(all,Ids,Res) :- !, Res=Ids. |
| 1992 | | ord_restrict(Restrict,Ids,Res) :- ord_intersection(Ids,Restrict,Res). |
| 1993 | | |
| 1994 | | select_predicates(Predicates,FoundPreds,OtherPreds) :- |
| 1995 | | split_list(is_selected_predicate,Predicates,FoundPredIds,OtherPreds), |
| 1996 | | maplist(extract_found_predicate,FoundPredIds,FoundPreds). |
| 1997 | | is_selected_predicate(pred(_P,_PIds,Selected)) :- ground(Selected). |
| 1998 | | extract_found_predicate(pred(P,_PIds,_Selected),P). |
| 1999 | | |
| 2000 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2001 | | % replace (simultaneously) multiple identifiers by expressions |
| 2002 | | % this could be used to replace the predicate replace_id_by_expr by mapping everything in a |
| 2003 | | % singleton list. however, that would involve list operations instead of unifications |
| 2004 | | parse_pred(Codes,TExpr) :- %format('Parsing ~s~n',[Codes]), |
| 2005 | | bmachine:b_parse_machine_predicate_from_codes_open(no_quantifier,Codes,[],[],TExpr). |
| 2006 | | parse_expr(Codes,TExpr) :- bmachine:b_parse_machine_expression_from_codes(Codes,[],TExpr,_Type,true,_Error). |
| 2007 | | test_result(1,b(equal(b(comprehension_set([b(identifier(__FRESH____),integer,_)], |
| 2008 | | b(greater(b(identifier(__FRESH____2),integer,_),b(identifier(x),integer,_)),pred,_)),set(integer),_), |
| 2009 | | b(empty_set,set(integer),_)),pred,_)). |
| 2010 | | |
| 2011 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), replace_ids_by_exprs(T1,[],[],T1))). |
| 2012 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), bsyntaxtree:parse_expr("100",T2), |
| 2013 | | replace_ids_by_exprs(T1,[y],[T2],R),bsyntaxtree:parse_pred("{x|x>100}={}",T3),same_texpr(R,T3) )). |
| 2014 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), |
| 2015 | | replace_ids_by_exprs(T1,[y],[b(identifier(x),integer,[])],R), |
| 2016 | | bsyntaxtree:test_result(1,R),bsyntaxtree:parse_pred("{x|x:INTEGER & x>x}={}",T3),\+ same_texpr(R,T3) )). |
| 2017 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>v & y>w}={}",T1), |
| 2018 | | replace_ids_by_exprs(T1,[v,w],[b(identifier(w),integer,[]),b(identifier(v),integer,[])],R), |
| 2019 | | bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>w & y>v}={}",T3), same_texpr(R,T3) )). |
| 2020 | | :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>v & y>w}={}",T1), |
| 2021 | | replace_ids_by_exprs(T1,[v,w],[b(identifier(w),integer,[]),b(identifier(x),integer,[])],R), |
| 2022 | | translate:translate_bexpression(R,TR), |
| 2023 | | TR = '{`__FRESH____1`,y|`__FRESH____1` > w & y > x} = {}')). %'{__FRESH____1,y|(__FRESH____1 : INTEGER & y : INTEGER) & (__FRESH____1 > w & y > x)} = {}' )). |
| 2024 | | |
| 2025 | | replace_ids_by_exprs(TExpr,[TId],[Inserted],Replaced) :- !, % better, more robust and efficient version |
| 2026 | | check_ids([TId],[Id]), |
| 2027 | | replace_id_by_expr(TExpr,Id,Inserted,Replaced). |
| 2028 | | replace_ids_by_exprs(TExpr,[],[],Replaced) :- !, Replaced=TExpr. % Nothing to do |
| 2029 | | replace_ids_by_exprs(TExpr,Ids,Exprs,Replaced) :- |
| 2030 | | check_ids(Ids,Ids2), % convert to atomic identifiers |
| 2031 | | find_identifier_uses_l(Exprs,[],ExprsUsedIds), |
| 2032 | | sort(ExprsUsedIds,SExprsUsedIds), |
| 2033 | | generate_rename_list(Ids2,Exprs,RenameList), |
| 2034 | | %print(replace(RenameList,SExprsUsedIds)),nl, |
| 2035 | | replace_ids_by_exprs2(RenameList,SExprsUsedIds,TExpr,Replaced,_). %, nl,print(done),nl. |
| 2036 | | % a version of replace_ids_by_exprs2 for maplist: |
| 2037 | | %replace_ids_by_exprs1(RenameList,SExprsUsedIds,TExpr,Replaced) :- |
| 2038 | | % replace_ids_by_exprs2(RenameList,SExprsUsedIds,TExpr,Replaced,_). %, print('Rep: '), translate:print_bexpr(Replaced),nl. |
| 2039 | | |
| 2040 | | generate_rename_list([],[],[]). |
| 2041 | | generate_rename_list([ID1|T],[Expr1|TE],[rename(ID1,Expr1)|RT]) :- generate_rename_list(T,TE,RT). |
| 2042 | | |
| 2043 | | check_ids([],[]). |
| 2044 | | check_ids([H|T],[ID|IT]) :- (atomic(H) -> ID=H ; def_get_texpr_id(H,ID)), check_ids(T,IT). |
| 2045 | | replace_ids_by_exprs2(RenameList,ExprsUsedIds,TExpr,Replaced,WDC) :- |
| 2046 | | remove_bt(TExpr,Expr,NewExpr,TNewExpr), |
| 2047 | ? | ( Expr = identifier(Id), member(rename(Id,Inserted),RenameList) -> |
| 2048 | | Replaced = Inserted, |
| 2049 | | get_texpr_info(Inserted,Infos), |
| 2050 | | (memberchk(contains_wd_condition,Infos) |
| 2051 | | -> WDC = true ; WDC = false) % WDC = true means we have added a wd-condition where previously there was none |
| 2052 | | ; contains_no_ids(Expr) -> Replaced=TExpr, WDC=false |
| 2053 | | ; |
| 2054 | | syntaxtransformation_det(Expr,Subs1,Names,NSubs,NewExpr), |
| 2055 | | find_variable_clashes(Names,ExprsUsedIds,RenameNames), % check for variable caputure |
| 2056 | | (RenameNames = [] |
| 2057 | | -> Subs = Subs1 % no variable capture occured |
| 2058 | | ; %format('*** VARIABLE CAPTURE : ~w~n~n',[RenameNames]), |
| 2059 | | rename_bt_l(Subs1,RenameNames,Subs) % replace affected names by fresh ids in sub arguments (will also change list of quantified variables itself) |
| 2060 | | ), |
| 2061 | | %l_replace_ids_by_exprs2(QSubs,RenameList,ExprsUsedIds,NQSubs,WDC1), % QSubs are like RHS of let expression, where Names are not in scope |
| 2062 | | remove_hidden_names(Names,RenameList,UpdatedRenameList), |
| 2063 | | ( UpdatedRenameList = [] -> % all Ids are now hidden for the inner expressions |
| 2064 | | NSubs=Subs, WDC=false |
| 2065 | | ; |
| 2066 | | l_replace_ids_by_exprs2(Subs,UpdatedRenameList,ExprsUsedIds,NSubs,WDC) |
| 2067 | | ), |
| 2068 | | TNewExpr = b(E1,T1,Info1), |
| 2069 | | rename_update_used_ids_info(RenameList,Info1,Info2), |
| 2070 | | add_wd_if_needed(WDC,b(E1,T1,Info2),Replaced) |
| 2071 | | ). |
| 2072 | | |
| 2073 | | contains_no_ids(integer(_)). |
| 2074 | | contains_no_ids(string(_)). |
| 2075 | | contains_no_ids(value(_)). |
| 2076 | | |
| 2077 | | |
| 2078 | | % check if we have to rename any quantified variable to avoid variable capture of RHS of renamings |
| 2079 | | % example, suppose we rename x/y+1 and we enter {y|y>x} we have to generate {fresh|fresh>y+1} and *not* {y|y>y+1} |
| 2080 | | find_variable_clashes([],_,[]). |
| 2081 | | find_variable_clashes([Name|Names],ExprsUsedIds,[rename(ID,FRESHID)|Renaming] ) :- |
| 2082 | | def_get_texpr_id(Name,ID), |
| 2083 | | ord_member(ID,ExprsUsedIds), % the quantified name is also introduced by the renaming |
| 2084 | | !, |
| 2085 | | gensym('__FRESH__',FRESHID), |
| 2086 | | find_variable_clashes(Names,ExprsUsedIds,Renaming). |
| 2087 | | find_variable_clashes([_|Names],ExprsUsedIds,Renaming) :- |
| 2088 | | find_variable_clashes(Names,ExprsUsedIds,Renaming). |
| 2089 | | |
| 2090 | | |
| 2091 | | l_replace_ids_by_exprs2([],_,_,[],false). |
| 2092 | | l_replace_ids_by_exprs2([H|T],UpdatedRenameList,ExprsUsedIds,[IH|IT],WDC) :- |
| 2093 | | replace_ids_by_exprs2(UpdatedRenameList,ExprsUsedIds,H,IH,WDC1), |
| 2094 | | l_replace_ids_by_exprs2(T,UpdatedRenameList,ExprsUsedIds,IT,WDC2), |
| 2095 | | and_wdc(WDC1,WDC2,WDC). |
| 2096 | | |
| 2097 | | % remove any identifiers that are now "invisible" because they are masked by quantified names |
| 2098 | | % e.g., when we enter #x.(P) then a renaming of x will be "hidden" inside P |
| 2099 | | remove_hidden_names([],RenameList,RenameList). |
| 2100 | | remove_hidden_names([Name|Names],RenameList,NewRenameList) :- |
| 2101 | | def_get_texpr_id(Name,ID), |
| 2102 | | delete(RenameList,rename(ID,_),RenameList1), |
| 2103 | | !, % only one rename should exist |
| 2104 | | %print(del(ID,RenameList1)),nl, |
| 2105 | | remove_hidden_names(Names,RenameList1,NewRenameList). |
| 2106 | | |
| 2107 | | find_rhs_ids(rename(Id,TExpr),rename_ids(Id,InsUsedIds)) :- find_identifier_uses(TExpr,[],InsUsedIds). |
| 2108 | | |
| 2109 | | % apply a rename list to the used_ids,... information fields |
| 2110 | | % this is more tricky than applying a single identifier, as we first have to deleted all ids |
| 2111 | | % and remember which ones were deleted, and only then insert the corresponding ids |
| 2112 | | % e.g., we could have a RenameList = [rename(p,q),rename(q,p)] ; see test 1776 M1_Internal_v3.mch |
| 2113 | | rename_update_used_ids_info(RenameList,IIn,IOut) :- |
| 2114 | | l_find_rhs_ids(RenameList,RenameList2), |
| 2115 | | %maplist(apply_rename_list(RenameList2),IIn,IOut). |
| 2116 | | l_apply_rename_list(IIn,RenameList2,IOut). |
| 2117 | | |
| 2118 | | l_find_rhs_ids([],[]). |
| 2119 | | l_find_rhs_ids([R1|T],[NR1|NTR]) :- |
| 2120 | | find_rhs_ids(R1,NR1), |
| 2121 | | l_find_rhs_ids(T,NTR). |
| 2122 | | |
| 2123 | | l_apply_rename_list([],_,[]). |
| 2124 | | l_apply_rename_list([Info1|T],RenameList2,[NewInfo1|NTI]) :- |
| 2125 | | apply_rename_list(RenameList2,Info1,NewInfo1), |
| 2126 | | l_apply_rename_list(T,RenameList2,NTI). |
| 2127 | | |
| 2128 | | apply_rename_list(RenameList,I,NI) :- |
| 2129 | | apply_rename_list2(I,RenameList,NI). |
| 2130 | | apply_rename_list2(used_ids(IDS),RenameList,used_ids(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS). |
| 2131 | | apply_rename_list2(reads(IDS),RenameList,reads(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS). |
| 2132 | | apply_rename_list2(modifies(IDS),RenameList,modifies(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS). |
| 2133 | | apply_rename_list2(Info,_,Info). |
| 2134 | | |
| 2135 | | % apply a rename list to a sorted list of ids |
| 2136 | | apply_rename_list_to_ids([],Acc,ToInsert,Res) :- ord_union(Acc,ToInsert,Res). |
| 2137 | | apply_rename_list_to_ids([rename_ids(Id,NewIds)|T],Acc,ToInsert,Res) :- |
| 2138 | | (ord_delete_existing_element(Acc,Id,Acc2) % the Id occurs and is deleted |
| 2139 | | -> ord_union(NewIds,ToInsert,ToInsert2), |
| 2140 | | apply_rename_list_to_ids(T,Acc2,ToInsert2,Res) |
| 2141 | | ; apply_rename_list_to_ids(T,Acc,ToInsert,Res)). |
| 2142 | | |
| 2143 | | ord_delete_existing_element(List,El,ResList) :- % ord_del_element also succeeds if El is not in the list ! |
| 2144 | | ord_intersection([El],List,[El],ResList). |
| 2145 | | % ----------------------- |
| 2146 | | % remove an Identifier from used_ids Info field if it exists |
| 2147 | | remove_used_id_from_info(I,ID_to_remove,NI) :- |
| 2148 | | update_used_ids_info(I,ID_to_remove,[],NI). |
| 2149 | | |
| 2150 | | remove_used_ids_from_info([],I,I). |
| 2151 | | remove_used_ids_from_info([ID_to_remove|T],I,NI) :- remove_used_id_from_info(I,ID_to_remove,I2), |
| 2152 | | remove_used_ids_from_info(T,I2,NI). |
| 2153 | | |
| 2154 | | % remove a single Identifier from used_ids Info field if it exists and insert sorted list of ids instead |
| 2155 | | % a simpler version of rename_update_used_ids_info for a single identifier |
| 2156 | | update_used_ids_info([],_,_,[]). |
| 2157 | | update_used_ids_info([InfoField|T],ID_to_remove,IDsInserted,[NewInfoField|NT]) :- |
| 2158 | | (update_id_from_info_field(ID_to_remove,IDsInserted,InfoField,R) |
| 2159 | | -> NewInfoField=R |
| 2160 | | ; NewInfoField=InfoField), |
| 2161 | | update_used_ids_info(T,ID_to_remove,IDsInserted,NT). |
| 2162 | | |
| 2163 | | update_id_from_info_field(ID_to_remove,IDsInserted,I,NI) :- |
| 2164 | | update_id_from_info_field2(I,ID_to_remove,IDsInserted,NI). |
| 2165 | | update_id_from_info_field2(used_ids(IDS),ID,IDsInserted,used_ids(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS). |
| 2166 | | update_id_from_info_field2(reads(IDS),ID,IDsInserted,reads(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS). |
| 2167 | | update_id_from_info_field2(modifies(IDS),ID,IDsInserted,modifies(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS). |
| 2168 | | |
| 2169 | | update_id(IDS,ID_to_remove,IDsInserted,NewIDS) :- |
| 2170 | | ord_delete_existing_element(IDS,ID_to_remove,IDS2), % the Id occurs and is deleted |
| 2171 | | ord_union(IDsInserted,IDS2,NewIDS). |
| 2172 | | %if ord_del_element fails we do not add IDsInserted: we assume the used_ids info is correct and ID_to_remove does not occur ! |
| 2173 | | % We could use this info to avoid traversing subtree ! |
| 2174 | | % print(projecting_away_unknown_id(ID_to_remove,IDS)),nl, |
| 2175 | | |
| 2176 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2177 | | |
| 2178 | | :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:exists_ast(A), replace_id_by_expr(A,y,b(identifier(x),integer,[]),RA),translate:translate_bexpression(RA,TR), |
| 2179 | | TR = 'r = {`__FRESH____1`|`__FRESH____1` : 1 .. x & `__FRESH____1` mod 2 = 1}' )). |
| 2180 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), |
| 2181 | | replace_id_by_expr(T1,y,b(identifier(x),integer,[]),R), |
| 2182 | | bsyntaxtree:test_result(1,R),bsyntaxtree:parse_pred("{x|x:INTEGER & x>x}={}",T3), |
| 2183 | | \+ same_texpr(R,T3) )). |
| 2184 | | :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), bsyntaxtree:parse_expr("100",T2), |
| 2185 | | replace_id_by_expr(T1,y,T2,R),bsyntaxtree:parse_pred("{x|x>100}={}",T3),same_texpr(R,T3) )). |
| 2186 | | |
| 2187 | | % replace an identifier Id by an expression Inserted |
| 2188 | | replace_id_by_expr(TExpr,Id,Inserted,Replaced) :- |
| 2189 | | replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,_). |
| 2190 | | |
| 2191 | | replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,NrReplacements) :- \+ atomic(Id),!, |
| 2192 | | add_internal_error('Id not atomic: ',replace_id_by_expr(TExpr,Id,Inserted,Replaced)), |
| 2193 | | Replaced = TExpr, NrReplacements=0. |
| 2194 | | replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,NrReplacements) :- |
| 2195 | | %find_all_relevant_quantified_vars(Id,TExpr,QVars), |
| 2196 | | find_identifier_uses(Inserted,[],SInsUsedIds), % SInsUsedIds is sorted |
| 2197 | | replace_id_by_expr2(Id,Inserted,SInsUsedIds,TExpr,Replaced,_WDC,0,NrReplacements). |
| 2198 | | |
| 2199 | | replace_id_by_expr2(Id,Inserted,InsUsedIds,TExpr,Replaced,WDC,InR,OutR) :- |
| 2200 | | remove_bt(TExpr,Expr,NewExpr,TNewExpr), |
| 2201 | | ( Expr = identifier(Id) -> % TODO: count number of replacements |
| 2202 | | Replaced = Inserted, |
| 2203 | | OutR is InR+1, |
| 2204 | | get_texpr_info(Inserted,Infos), |
| 2205 | | (memberchk(contains_wd_condition,Infos) |
| 2206 | | -> WDC = true ; WDC = false) % WDC = true means we have added a wd-condition where previously there was none |
| 2207 | | ; contains_no_ids(Expr) -> Replaced=TExpr, WDC=false, OutR=InR |
| 2208 | | ; |
| 2209 | | syntaxtransformation_det(Expr,Subs,Names,NSubs,NewExpr), |
| 2210 | | get_texpr_id(TId,Id), |
| 2211 | | ( memberchk(TId,Names) -> % the Id is now hidden for the inner expressions |
| 2212 | | NSubs=Subs, WDC=false, OutR = InR |
| 2213 | | ; (InsUsedIds \= [], |
| 2214 | | get_texpr_ids(Names,Ns),sort(Ns,SNs), |
| 2215 | | ord_intersection(SNs,InsUsedIds,Captured), |
| 2216 | | Captured \= [] %, print(inter(SNs,InsUsedIds,Captured)),nl |
| 2217 | | ) |
| 2218 | | % The Names introduced clash with variables used in the Inserted expression |
| 2219 | | -> findall(rename(X,FRESHID),(member(X,Captured),gensym:gensym('__FRESH__',FRESHID)),RenameList), |
| 2220 | | %print(rename(RenameList)),nl, |
| 2221 | | rename_bt_l(Subs,RenameList,RenSubs), |
| 2222 | | l_replace_id_by_expr2(RenSubs,Id,Inserted,InsUsedIds,NSubs,WDC,InR,OutR) |
| 2223 | | ; |
| 2224 | | l_replace_id_by_expr2(Subs,Id,Inserted,InsUsedIds,NSubs,WDC,InR,OutR) |
| 2225 | | ), |
| 2226 | | TNewExpr = b(E1,T1,Info1), |
| 2227 | | update_used_ids_info(Info1,Id,InsUsedIds,Info2), |
| 2228 | | %(E1 = exists(P,_) -> print(exists(P,Id,Info1,Info2)),nl ; true), |
| 2229 | | add_wd_if_needed(WDC,b(E1,T1,Info2),Replaced) |
| 2230 | | ). |
| 2231 | | |
| 2232 | | l_replace_id_by_expr2([],_,_,_,[],false,R,R). |
| 2233 | | l_replace_id_by_expr2([H|T],Id,Inserted,InsUsedIds,[IH|IT],WDC,InR,OutR) :- |
| 2234 | | replace_id_by_expr2(Id,Inserted,InsUsedIds,H,IH,WDC1,InR,InR2), |
| 2235 | | l_replace_id_by_expr2(T,Id,Inserted,InsUsedIds,IT,WDC2,InR2,OutR), |
| 2236 | | and_wdc(WDC1,WDC2,WDC). |
| 2237 | | |
| 2238 | | % conjunct wd condition added flag |
| 2239 | | and_wdc(true,_,R) :- !,R=true. |
| 2240 | | and_wdc(_,true,R) :- !, R=true. |
| 2241 | | and_wdc(_,_,false). |
| 2242 | | |
| 2243 | | % add contains_wd_condition if a change occured during replacement of id by expression |
| 2244 | | add_wd_if_needed(true,b(E,T,Infos),Replaced) :- |
| 2245 | | nonmember(contains_wd_condition,Infos), |
| 2246 | | !, |
| 2247 | | Replaced = b(E,T,[contains_wd_condition|Infos]). |
| 2248 | | add_wd_if_needed(_,T,T). |
| 2249 | | |
| 2250 | | |
| 2251 | | |
| 2252 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2253 | | |
| 2254 | | |
| 2255 | | % syntaxtransformation_fixed/7 is the same as syntaxtransformation/5 with the exception |
| 2256 | | % that we distinguish between subexpressions that have the newly introduced identifiers (Names) |
| 2257 | | % in scope (OSubs) and those who don't (OExprs). The only expressions where the latter case is relevant |
| 2258 | | % are let_expression and let_predicate. |
| 2259 | | % TODO: This is a quick'n dirty fix for only some cases. |
| 2260 | | % NO LONGER REQUIRED: let_expression and let_predicate now obey another semantic, not the Z semantics anymore |
| 2261 | | %syntaxtransformation_fixed(OExpr,OExprs,OSubs,Names,NExprs,NSubs,NExpr) :- |
| 2262 | | %syntaxtransformation_fixed(Expr,[],Subs,Names,[],NSubs,NExpr) :- |
| 2263 | | % syntaxtransformation_det(Expr,Subs,Names,NSubs,NExpr). |
| 2264 | | |
| 2265 | | |
| 2266 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2267 | | % rename identifier |
| 2268 | | |
| 2269 | | % r = {x|x : 1..y & x mod 2 = 1} |
| 2270 | | exists_ast(AST) :- AST = |
| 2271 | | b(equal(b(identifier(r),set(integer),[nodeid(none)]), |
| 2272 | | b(comprehension_set([b(identifier(x),integer,[nodeid(none)])], |
| 2273 | | b(conjunct(b(member(b(identifier(x),integer,[nodeid(none)]), |
| 2274 | | b(interval(b(integer(1),integer,[nodeid(none)]),b(identifier(y),integer,[nodeid(none)])), |
| 2275 | | set(integer),[nodeid(none)])),pred,[nodeid(none)]), |
| 2276 | | b(equal(b(modulo(b(identifier(x),integer,[nodeid(none)]), |
| 2277 | | b(integer(2),integer,[nodeid(none)])),integer,[contains_wd_condition,nodeid(none)]), |
| 2278 | | b(integer(1),integer,[nodeid(none)])),pred, |
| 2279 | | [contains_wd_condition,nodeid(none)])),pred,[contains_wd_condition,nodeid(none)])), |
| 2280 | | set(integer),[contains_wd_condition,nodeid(none)])), |
| 2281 | | pred,[contains_wd_condition,nodeid(none)]). |
| 2282 | | |
| 2283 | | :- assert_must_succeed((bsyntaxtree:exists_ast(A), rename_bt(A,[rename(x,xx)],RA), RA==A )). |
| 2284 | | :- assert_must_succeed((bsyntaxtree:exists_ast(A), rename_bt(A,[rename(r,v)],RA), |
| 2285 | | translate:translate_bexpression(RA,TR), TR='v = {x|x : 1 .. y & x mod 2 = 1}' )). |
| 2286 | | :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:exists_ast(A), rename_bt(A,[rename(y,x)],RA), RA \= A, |
| 2287 | | translate:translate_bexpression(RA,TR), |
| 2288 | | TR = 'r = {`__FRESH____1`|`__FRESH____1` : 1 .. x & `__FRESH____1` mod 2 = 1}' )). |
| 2289 | | |
| 2290 | | % a simplified version of replace_ids_by_exprs, which assumes target of renamings are variables |
| 2291 | | rename_bt(Expr,[],Res) :- !,Res=Expr. |
| 2292 | | rename_bt(OExpr,Renamings,NExpr) :- |
| 2293 | | create_texpr(Old,Type,OInfo,OExpr), |
| 2294 | | create_texpr(New,Type,NInfo,NExpr), |
| 2295 | | rename_in_infos(OInfo,Renamings,NInfo), |
| 2296 | | rename_bt2(Old,Renamings,New). |
| 2297 | | rename_bt2(identifier(Old),Renamings,identifier(New)) :- |
| 2298 | | !, rename_id(Old,Renamings,New). |
| 2299 | | rename_bt2(lazy_lookup_expr(Old),Renamings,lazy_lookup_expr(New)) :- |
| 2300 | | !, rename_id(Old,Renamings,New). |
| 2301 | | rename_bt2(lazy_lookup_pred(Old),Renamings,lazy_lookup_pred(New)) :- |
| 2302 | | !, rename_id(Old,Renamings,New). |
| 2303 | | rename_bt2(OExpr,Renamings,NExpr) :- |
| 2304 | | syntaxtransformation_for_renaming(OExpr,Subs,TNames,NSubs,NExpr), |
| 2305 | | get_texpr_exprs(TNames,Names), |
| 2306 | | remove_renamings(Names,Renamings,NRenamings), |
| 2307 | | rename_bt_l(Subs,NRenamings,NSubs). |
| 2308 | | rename_bt_l([],_,[]). |
| 2309 | | rename_bt_l([Old|ORest],Renamings,[New|NRest]) :- |
| 2310 | | rename_bt(Old,Renamings,New), |
| 2311 | | rename_bt_l(ORest,Renamings,NRest). |
| 2312 | | |
| 2313 | | % syntaxtransformation rule for operation_call_in_expr does not show Id field in sub expressions |
| 2314 | | % (to avoid issues with find_identifier_uses, see below) |
| 2315 | | % so here we explicitly also rename the operation name if required, relevant for bmachine_construction, test 2504 |
| 2316 | | % TODO: avoid this special case and fix find_identifier_uses instead |
| 2317 | | syntaxtransformation_for_renaming(operation_call_in_expr(ID,Subs1),Subs,TNames,NSubs,NExpr) :- !, |
| 2318 | | NExpr = operation_call_in_expr(NID,NSubs1), |
| 2319 | | Subs = [ID|Subs1], |
| 2320 | | NSubs = [NID|NSubs1], TNames = []. |
| 2321 | | syntaxtransformation_for_renaming(OExpr,Subs,TNames,NSubs,NExpr) :- |
| 2322 | | syntaxtransformation(OExpr,Subs,TNames,NSubs,NExpr). |
| 2323 | | |
| 2324 | | remove_renamings([],Renamings,Renamings). |
| 2325 | | remove_renamings([identifier(Name)|Rest],Old,New) :- |
| 2326 | ? | ( select(rename(Name,_),Old,Inter1) -> true % Name no longer visible to renaming |
| 2327 | | ; Old = Inter1), |
| 2328 | | (member(rename(_OldName,Name),Inter1) -> |
| 2329 | | % rename the local identifier Name, to avoid clash with the outer Name |
| 2330 | | % (in case _OldName is used inside) |
| 2331 | | gensym('__FRESH__',FRESHID), |
| 2332 | | %print(variable_capture_in_rename(Name,from(OldName),FRESHID)),nl, |
| 2333 | | Inter2 = [rename(Name,FRESHID)|Inter1] |
| 2334 | | ; Inter2 = Inter1), |
| 2335 | | remove_renamings(Rest,Inter2,New). |
| 2336 | | |
| 2337 | | rename_in_infos(Old,Renamings,New) :- |
| 2338 | | ( has_info_to_rename(Old) -> |
| 2339 | | maplist(rename_in_infos2(Renamings),Old,New) |
| 2340 | | ; |
| 2341 | | Old = New). |
| 2342 | | rename_in_infos2(Renamings,OInfo,NInfo) :- |
| 2343 | | ( infos_to_rename(OInfo,OIds,SortedNIds,NInfo) -> |
| 2344 | | rename_ids(OIds,Renamings,NIds), |
| 2345 | | sort(NIds,SortedNIds) |
| 2346 | | ; |
| 2347 | | OInfo = NInfo). |
| 2348 | | |
| 2349 | | rename_ids([],_,[]). |
| 2350 | | rename_ids([OId|Orest],Renamings,[NId|Nrest]) :- |
| 2351 | | rename_id(OId,Renamings,NId), |
| 2352 | | rename_ids(Orest,Renamings,Nrest). |
| 2353 | | rename_id(Old,Renamings,New) :- |
| 2354 | | ( memberchk(rename(Old,New),Renamings) -> true % we could use ord_member if we sort ! |
| 2355 | | ; Old=New). |
| 2356 | | |
| 2357 | | has_info_to_rename(Infos) :- |
| 2358 | ? | member(I,Infos),infos_to_rename(I,_,_,_),!. |
| 2359 | | |
| 2360 | | infos_to_rename(modifies(O),O,N,modifies(N)). |
| 2361 | | infos_to_rename(reads(O),O,N,reads(N)). |
| 2362 | | infos_to_rename(non_det_modifies(O),O,N,non_det_modifies(N)). |
| 2363 | | infos_to_rename(modifies_locals(O),O,N,modifies_locals(N)). |
| 2364 | | infos_to_rename(reads_locals(O),O,N,reads_locals(N)). |
| 2365 | | infos_to_rename(used_ids(O),O,N,used_ids(N)). |
| 2366 | | %infos_to_rename(lambda_result(O),[O],[N],lambda_result(N)). % whould we no longer assume that we have lambda result, as predicate has possibly changed!? |
| 2367 | | |
| 2368 | | |
| 2369 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2370 | | % remove type information for transformations |
| 2371 | | |
| 2372 | | remove_bt(b(Expr,Type,Infos),Expr,NExpr,b(NExpr,Type,Infos)). |
| 2373 | | |
| 2374 | | remove_bt_and_used_ids(b(OldExpr,T,Infos),OldExpr,NewExpr,b(NewExpr,T,NewInfos)) :- |
| 2375 | | delete(Infos,used_ids(_),NewInfos). % invalidate used_ids info |
| 2376 | | |
| 2377 | | %remove_bt_l([],[],[],[]). |
| 2378 | | %remove_bt_l([OT|OTRest],[O|ORest],[N|NRest],[NT|NTRest]) :- |
| 2379 | | % remove_bt(OT,O,N,NT), |
| 2380 | | % remove_bt_l(OTRest,ORest,NRest,NTRest). |
| 2381 | | |
| 2382 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2383 | | % traversations |
| 2384 | | % Takes a predicate or expression or substitution and extracts: |
| 2385 | | % the expression itself Expr, its type Type, the syntaxnode information Infos |
| 2386 | | % + the subexpressions as a list Subs and the local identifiers declared |
| 2387 | | syntaxtraversion(b(Expr,Type,Infos),Expr,Type,Infos,Subs,Names) :- !, |
| 2388 | | safe_syntaxelement(Expr,Subs,Names,_,_). |
| 2389 | | syntaxtraversion(IExpr,Expr,Type,Infos,Subs,Names) :- |
| 2390 | | add_internal_error('Not properly wrapped', syntaxtraversion(IExpr,Expr,Type,Infos,Subs,Names)), |
| 2391 | | fail. |
| 2392 | | |
| 2393 | | |
| 2394 | | map_over_full_bexpr_no_fail(P,BExpr) :- |
| 2395 | | syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames), |
| 2396 | | call(P,Expr), % the predicate should not fail |
| 2397 | | (Subs=[] -> true ; maplist(map_over_full_bexpr_no_fail(P),Subs)). |
| 2398 | | |
| 2399 | | map_over_bexpr(P,BExpr) :- |
| 2400 | | syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames), |
| 2401 | | (call(P,Expr) % should probably fail so that by backtrack we recurse |
| 2402 | | ; |
| 2403 | | member(Sub,Subs), map_over_bexpr(P,Sub) |
| 2404 | | ). |
| 2405 | | % same as above but gets typed expressions: |
| 2406 | | map_over_typed_bexpr(P,BExpr) :- |
| 2407 | | syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames), |
| 2408 | | (call(P,BExpr) |
| 2409 | | ; |
| 2410 | ? | member(Sub,Subs), map_over_typed_bexpr(P,Sub) |
| 2411 | | ). |
| 2412 | | % same as above but returns value: |
| 2413 | | map_over_typed_bexpr(P,BExpr,Result) :- |
| 2414 | | syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames), |
| 2415 | | (call(P,BExpr,Result) |
| 2416 | | ; |
| 2417 | ? | member(Sub,Subs), map_over_typed_bexpr(P,Sub,Result) |
| 2418 | | ). |
| 2419 | | % this one gets TNames (locally introduced variables as parameter) |
| 2420 | | map_over_typed_bexpr_with_names(P,BExpr) :- |
| 2421 | | syntaxtraversion(BExpr,_Expr,_,_,Subs,TNames), |
| 2422 | | (call(P,BExpr,TNames) |
| 2423 | | ; |
| 2424 | | member(Sub,Subs), map_over_typed_bexpr_with_names(P,Sub) |
| 2425 | | ). |
| 2426 | | |
| 2427 | | % same as map_over_expr but provides an accumulator passed top-down to children; needs to be used by failure driven loop |
| 2428 | | |
| 2429 | | map_over_bexpr_top_down_acc(P,BExpr,TDAcc) :- |
| 2430 | | syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames), |
| 2431 | | (call(P,Expr,TDAcc,NewAcc) |
| 2432 | | -> member(Sub,Subs), map_over_bexpr_top_down_acc(P,Sub,NewAcc) |
| 2433 | | ; member(Sub,Subs), map_over_bexpr_top_down_acc(P,Sub,TDAcc) |
| 2434 | | ). |
| 2435 | | % now a version which gets the typed predicate as argument |
| 2436 | | |
| 2437 | | map_over_typed_bexpr_top_down_acc(P,BExpr,TDAcc) :- |
| 2438 | | syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames), |
| 2439 | | (call(P,BExpr,TDAcc,NewAcc) |
| 2440 | | -> member(Sub,Subs), map_over_typed_bexpr_top_down_acc(P,Sub,NewAcc) |
| 2441 | | ; member(Sub,Subs), map_over_typed_bexpr_top_down_acc(P,Sub,TDAcc) |
| 2442 | | ). |
| 2443 | | |
| 2444 | | % predicate P has 3 arguments: (Expr,ValueSoFar,NewValue) |
| 2445 | | reduce_over_bexpr(P,BExpr,InitialValue,ResultValue) :- |
| 2446 | | syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames), |
| 2447 | | call(P,Expr,InitialValue,I1), % print(reduce(P,Expr,InitialValue,I1)),nl, |
| 2448 | | scanlist(reduce_over_bexpr(P),Subs,I1,ResultValue). |
| 2449 | | |
| 2450 | | % apply a predicate over a syntax tree (bottom-up) |
| 2451 | | |
| 2452 | | transform_bexpr(Pred,b(Expr,Type,Info),NewBExpr) :- !, |
| 2453 | | syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1), |
| 2454 | | l_transform_bexpr(Subs,Pred,NSubs), |
| 2455 | | (call(Pred,b(NewExpr1,Type,Info),NewBExpr) -> true ; NewBExpr = b(NewExpr1,Type,Info)). |
| 2456 | | transform_bexpr(Pred,Expr,NewBExpr) :- |
| 2457 | | add_internal_error('Expression not properly wrapped:',transform_bexpr(Pred,Expr,NewBExpr)), |
| 2458 | | fail. |
| 2459 | | |
| 2460 | | l_transform_bexpr([],_,[]). |
| 2461 | | l_transform_bexpr([SubH|T],Pred,[TSubH|TT]) :- |
| 2462 | | transform_bexpr(Pred,SubH,TSubH), |
| 2463 | | l_transform_bexpr(T,Pred,TT). |
| 2464 | | |
| 2465 | | % apply a predicate over a syntax tree (bottom-up), and provide scoping info about local ids |
| 2466 | | |
| 2467 | | transform_bexpr_with_scoping(Pred,BExpr,NewBExpr) :- |
| 2468 | | transform_bexpr_with_scoping2(Pred,BExpr,NewBExpr,[]). |
| 2469 | | transform_bexpr_with_scoping2(Pred,b(Expr,Type,Info),NewBExpr,LocalIds) :- |
| 2470 | | syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr1), |
| 2471 | | get_texpr_ids(Names,QuantifiedNewIds), list_to_ord_set(QuantifiedNewIds,SQuantifiedNewIds), |
| 2472 | | ord_union(LocalIds,SQuantifiedNewIds,NewLocalIds), |
| 2473 | | l_transform_bexpr_with_scoping(Subs,Pred,NSubs,NewLocalIds), |
| 2474 | | (call(Pred,b(NewExpr1,Type,Info),NewBExpr,LocalIds) -> true ; NewBExpr = b(NewExpr1,Type,Info)). |
| 2475 | | |
| 2476 | | l_transform_bexpr_with_scoping([],_,[],_). |
| 2477 | | l_transform_bexpr_with_scoping([SubH|T],Pred,[TSubH|TT],LocalIds) :- |
| 2478 | | transform_bexpr_with_scoping2(Pred,SubH,TSubH,LocalIds), |
| 2479 | | l_transform_bexpr_with_scoping(T,Pred,TT,LocalIds). |
| 2480 | | |
| 2481 | | % transform a predicate top-down with scoping infos |
| 2482 | | % if Pred succeeds the top-down traversal stops |
| 2483 | | transform_bexpr_td_with_scoping(Pred,BExpr,NewBExpr) :- |
| 2484 | | transform_bexpr_td_with_scoping2(Pred,BExpr,NewBExpr,[]). |
| 2485 | | transform_bexpr_td_with_scoping2(Pred,b(Expr,Type,Info),b(NewExpr1,Type,Info),LocalIds) :- |
| 2486 | ? | (call(Pred,Expr,NewExpr1,LocalIds) |
| 2487 | | -> true |
| 2488 | | ; syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr1), |
| 2489 | | get_texpr_ids(Names,QuantifiedNewIds), list_to_ord_set(QuantifiedNewIds,SQuantifiedNewIds), |
| 2490 | | ord_union(LocalIds,SQuantifiedNewIds,NewLocalIds), |
| 2491 | | l_transform_bexpr_td_with_scoping(Subs,Pred,NSubs,NewLocalIds) |
| 2492 | | ). |
| 2493 | | |
| 2494 | | l_transform_bexpr_td_with_scoping([],_,[],_). |
| 2495 | | l_transform_bexpr_td_with_scoping([SubH|T],Pred,[TSubH|TT],LocalIds) :- |
| 2496 | | transform_bexpr_td_with_scoping2(Pred,SubH,TSubH,LocalIds), |
| 2497 | | l_transform_bexpr_td_with_scoping(T,Pred,TT,LocalIds). |
| 2498 | | |
| 2499 | | |
| 2500 | | % apply a predicate over a syntax tree (bottom-up) with Accumulator result |
| 2501 | | % Accumulator is constructed bottom up; Pred receives *all* accumulators of sub expressions |
| 2502 | | |
| 2503 | | transform_bexpr_with_bup_accs(Pred,b(Expr,Type,Info),NewBExpr,EmptyAcc,Acc) :- |
| 2504 | | syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1), |
| 2505 | | l_transform_bexpr_with_bup_accs(Subs,Pred,NSubs,EmptyAcc,SubAccs), |
| 2506 | | (call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAccs,Acc) -> true |
| 2507 | | ; NewBExpr = b(NewExpr1,Type,Info), Acc = EmptyAcc). |
| 2508 | | |
| 2509 | | l_transform_bexpr_with_bup_accs([],_,[],_,[]). |
| 2510 | | l_transform_bexpr_with_bup_accs([SubH|T],Pred,[TSubH|TT],EmptyAcc,[Acc1|RestAcc]) :- |
| 2511 | | transform_bexpr_with_bup_accs(Pred,SubH,TSubH,EmptyAcc,Acc1), |
| 2512 | | l_transform_bexpr_with_bup_accs(T,Pred,TT,EmptyAcc,RestAcc). |
| 2513 | | |
| 2514 | | % apply a predicate over a syntax tree (bottom-up) with Accumulator result |
| 2515 | | % a single Accumulator is passed along |
| 2516 | | |
| 2517 | | transform_bexpr_with_acc(_Pred,E,NewBExpr,InAcc,Acc) :- var(E),!, |
| 2518 | | NewBExpr=E, Acc=InAcc. |
| 2519 | | transform_bexpr_with_acc(Pred,b(Expr,Type,Info),NewBExpr,InAcc,Acc) :- |
| 2520 | | syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1), |
| 2521 | | l_transform_bexpr_with_acc(Subs,Pred,NSubs,InAcc,SubAcc), |
| 2522 | | (call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAcc,Acc) -> true |
| 2523 | | ; NewBExpr = b(NewExpr1,Type,Info), Acc = SubAcc). |
| 2524 | | |
| 2525 | | l_transform_bexpr_with_acc([],_,[],Acc,Acc). |
| 2526 | | l_transform_bexpr_with_acc([SubH|T],Pred,[TSubH|TT],InAcc,ResAcc) :- |
| 2527 | | transform_bexpr_with_acc(Pred,SubH,TSubH,InAcc,Acc1), |
| 2528 | | l_transform_bexpr_with_acc(T,Pred,TT,Acc1,ResAcc). |
| 2529 | | |
| 2530 | | % a non-deterministic version of this |
| 2531 | | non_det_transform_bexpr_with_acc(_Pred,E,NewBExpr,InAcc,Acc) :- var(E),!, |
| 2532 | | NewBExpr=E, Acc=InAcc. |
| 2533 | | non_det_transform_bexpr_with_acc(Pred,b(Expr,Type,Info),NewBExpr,InAcc,Acc) :- |
| 2534 | | syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1), |
| 2535 | | l_nd_transform_bexpr_with_acc(Subs,Pred,NSubs,InAcc,SubAcc), |
| 2536 | | if(call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAcc,Acc), |
| 2537 | | true, |
| 2538 | | (NewBExpr = b(NewExpr1,Type,Info), Acc = SubAcc)). |
| 2539 | | |
| 2540 | | l_nd_transform_bexpr_with_acc([],_,[],Acc,Acc). |
| 2541 | | l_nd_transform_bexpr_with_acc([SubH|T],Pred,[TSubH|TT],InAcc,ResAcc) :- |
| 2542 | | non_det_transform_bexpr_with_acc(Pred,SubH,TSubH,InAcc,Acc1), |
| 2543 | | l_nd_transform_bexpr_with_acc(T,Pred,TT,Acc1,ResAcc). |
| 2544 | | |
| 2545 | | |
| 2546 | | % ------------------------- |
| 2547 | | |
| 2548 | | min_max_integer_value_used(BExpr,Min,Max) :- |
| 2549 | | min_max_integer_value_used(BExpr,none,none,Min,Max). |
| 2550 | | min_max_integer_value_used(BExpr,IMin,IMax,Min,Max) :- |
| 2551 | | reduce_over_bexpr(min_max_aux,BExpr,minmax(IMin,IMax),minmax(Min,Max)). |
| 2552 | | |
| 2553 | | min_max_aux(sequence_extension(L),minmax(Min,Max),minmax(NMin,NMax)) :- !, |
| 2554 | | length(L,Len), % we use implicitly numbers from 1..Len |
| 2555 | | (number(Min),1>Min -> NMin=Min ; NMin=1), |
| 2556 | | (number(Max),Len<Max -> NMax=Max ; NMax=Len). |
| 2557 | | min_max_aux(integer(N),minmax(Min,Max),minmax(NMin,NMax)) :- !, |
| 2558 | | (number(Min),N>Min -> NMin=Min ; NMin=N), |
| 2559 | | (number(Max),N<Max -> NMax=Max ; NMax=N). |
| 2560 | | min_max_aux(_,V,V). |
| 2561 | | |
| 2562 | | % check if a B expression uses something like NAT,NAT1,INT, MAXINT or MININT. |
| 2563 | | uses_implementable_integers(BExpr) :- |
| 2564 | | map_over_bexpr(uses_implementable_integers_aux,BExpr). |
| 2565 | | |
| 2566 | | uses_implementable_integers_aux(maxint). |
| 2567 | | uses_implementable_integers_aux(minint). |
| 2568 | | uses_implementable_integers_aux(integer_set(X)) :- |
| 2569 | | (X='NAT1' ; X='NAT' ; X='INT'). |
| 2570 | | |
| 2571 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2572 | | % some checks |
| 2573 | | check_if_typed_predicate(b(Pred,X,_)) :- ground(X), X=pred, % at runtime there can be value(X) with variables inside ! |
| 2574 | | syntaxelement(Pred,_,_,_,_,TypePred), (TypePred=pred -> true ; TypePred = pred/only_typecheck). |
| 2575 | | check_if_typed_expression(b(Expr,Type,_)) :- |
| 2576 | | syntaxelement(Expr,_,_,_,_,TypeExpr), |
| 2577 | | (TypeExpr=expr -> true ; TypeExpr = expr/only_typecheck), |
| 2578 | | Type \== pred, Type \== subst, ground(Type). |
| 2579 | | check_if_typed_substitution(b(Subst,X,_)) :- ground(X), X=subst, |
| 2580 | | syntaxelement(Subst,_,_,_,_,subst). |
| 2581 | | |
| 2582 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2583 | | % transformations |
| 2584 | | |
| 2585 | | syntaxtransformation(Expr,Subs,Names,NSubs,NExpr) :- |
| 2586 | | functor(Expr,F,Arity), |
| 2587 | | functor(NExpr,F,Arity), |
| 2588 | | safe_syntaxelement(Expr,Subs,Names,Lists,Constant), |
| 2589 | | all_same_length(Lists,NLists), |
| 2590 | | syntaxelement(NExpr,NSubs,_,NLists,Constant,_). |
| 2591 | | % a faster non-backtracking version: |
| 2592 | | syntaxtransformation_det(Expr,Subs,Names,NSubs,NExpr) :- |
| 2593 | | functor(Expr,F,Arity), |
| 2594 | | functor(NExpr,F,Arity), |
| 2595 | | safe_syntaxelement_det(Expr,Subs,Names,Lists,Constant), |
| 2596 | | all_same_length(Lists,NLists), |
| 2597 | | syntaxelement(NExpr,NSubs,_,NLists,Constant,_). |
| 2598 | | |
| 2599 | | |
| 2600 | | safe_syntaxelement(Expr,Subs,Names,Lists,Constant) :- |
| 2601 | | ( syntaxelement(Expr,SubsX,NamesX,Lists,ConstantX,_) -> |
| 2602 | | Subs=SubsX, Names=NamesX, Constant=ConstantX |
| 2603 | | %(Subs,Names,Constant)=(SubsX,NamesX,ConstantX) |
| 2604 | | ; |
| 2605 | | functor(Expr,F,Arity), |
| 2606 | | add_error_fail(bsyntaxtree,'Uncovered syntax element: ', F/Arity) |
| 2607 | | ). |
| 2608 | | % a faster non-backtracking version of safe_syntaxelement, assuming Subs, Names, ... are fresh vars |
| 2609 | | safe_syntaxelement_det(Expr,Subs,Names,Lists,Constant) :- |
| 2610 | | (syntaxelement(Expr,Subs,Names,Lists,Constant,_) -> true |
| 2611 | | ; functor(Expr,F,Arity), |
| 2612 | | add_error_fail(bsyntaxtree,'Uncovered syntax element: ', F/Arity)). |
| 2613 | | |
| 2614 | | is_subst_syntaxelement(Subst) :- |
| 2615 | | syntaxelement(Subst,_,_,_,_,subst). |
| 2616 | | |
| 2617 | | % check if we have a syntax node without parameters |
| 2618 | | is_syntax_constant(Expr) :- atom(Expr), syntaxelement(Expr,_,_,_,_,_). |
| 2619 | | |
| 2620 | | % syntaxelement(Expr,SubExprs,Identifiers,Lists,Constant,Type): |
| 2621 | | % Expr: the expression itself |
| 2622 | | % SubExprs: a list of sub-expressions |
| 2623 | | % Identifiers: a list of identifiers that are newly introduced (e.g. by a quantifier) |
| 2624 | | % Lists: A list of lists in the expression, to prevent infinite loops when having variable parts |
| 2625 | | % Constant: A part of the expression that is not a sub-expression (e.g. the number in integer(...)) |
| 2626 | | % Type: Fundamental type of the element (predicate, expression, etc) |
| 2627 | | |
| 2628 | | % predicates |
| 2629 | | syntaxelement(truth, [], [], [], [], pred). |
| 2630 | | syntaxelement(falsity, [], [], [], [], pred). |
| 2631 | | syntaxelement(unknown_truth_value(Msg),[], [], [], Msg, pred). % artificial, e.g., created by well_def_analyser |
| 2632 | | syntaxelement(conjunct(A,B), [A,B],[], [], [], pred). |
| 2633 | | %syntaxelement(conjunct(As), As, [], [], [], pred). % TO DO: support associative version of conjunct |
| 2634 | | syntaxelement(negation(A), [A], [], [], [], pred). |
| 2635 | | syntaxelement(disjunct(A,B), [A,B],[], [], [], pred). |
| 2636 | | syntaxelement(implication(A,B), [A,B],[], [], [], pred). |
| 2637 | | syntaxelement(equivalence(A,B), [A,B],[], [], [], pred). |
| 2638 | | syntaxelement(equal(A,B), [A,B],[], [], [], pred). |
| 2639 | | syntaxelement(not_equal(A,B), [A,B],[], [], [], pred). |
| 2640 | | syntaxelement(member(A,B), [A,B],[], [], [], pred). |
| 2641 | | syntaxelement(not_member(A,B), [A,B],[], [], [], pred). |
| 2642 | | syntaxelement(subset(A,B), [A,B],[], [], [], pred). |
| 2643 | | syntaxelement(subset_strict(A,B), [A,B],[], [], [], pred). |
| 2644 | | syntaxelement(not_subset(A,B), [A,B],[], [], [], pred). |
| 2645 | | syntaxelement(not_subset_strict(A,B),[A,B],[], [], [], pred). |
| 2646 | | syntaxelement(less_equal(A,B), [A,B],[], [], [], pred). |
| 2647 | | syntaxelement(less(A,B), [A,B],[], [], [], pred). |
| 2648 | | syntaxelement(less_equal_real(A,B), [A,B],[], [], [], pred). |
| 2649 | | syntaxelement(less_real(A,B), [A,B],[], [], [], pred). |
| 2650 | | syntaxelement(greater_equal(A,B), [A,B],[], [], [], pred). |
| 2651 | | syntaxelement(greater(A,B), [A,B],[], [], [], pred). |
| 2652 | | syntaxelement(forall(Ids,D,P), [D,P|Ids],Ids,[Ids], [], pred). |
| 2653 | | syntaxelement(exists(Ids,P), [P|Ids], Ids,[Ids], [], pred). |
| 2654 | | syntaxelement(finite(A), [A], [], [], [], pred/only_typecheck). |
| 2655 | | syntaxelement(partition(S,Es), [S|Es],[],[Es],[],pred). |
| 2656 | | syntaxelement(kodkod(PId,Ids), Ids,[],[Ids],PId, pred). |
| 2657 | | syntaxelement(external_pred_call(F,Args),Args,[],[Args],F,pred). |
| 2658 | | |
| 2659 | | % expressions |
| 2660 | | syntaxelement(value(V), [], [], [], V, expr). |
| 2661 | | syntaxelement(operation_call_in_expr(Id,As), As, [], [As], Id, expr). % Do not treat Id as a sub-expression for find_identifier_uses, ... |
| 2662 | | %syntaxelement(operation_call_in_expr(Id,As), [Id|As], [], [As], [], expr). % was like this, but changed to avoid op(.) ids in find_identifier_uses |
| 2663 | | syntaxelement(boolean_true, [], [], [], [], expr). |
| 2664 | | syntaxelement(boolean_false, [], [], [], [], expr). |
| 2665 | | syntaxelement(max_int, [], [], [], [], expr). |
| 2666 | | syntaxelement(min_int, [], [], [], [], expr). |
| 2667 | | syntaxelement(empty_set, [], [], [], [], expr). |
| 2668 | | syntaxelement(bool_set, [], [], [], [], expr). |
| 2669 | | syntaxelement(float_set, [], [], [], [], expr). |
| 2670 | | syntaxelement(real(I), [], [], [], I, expr). |
| 2671 | | syntaxelement(real_set, [], [], [], [], expr). |
| 2672 | | syntaxelement(string_set, [], [], [], [], expr). |
| 2673 | | syntaxelement(convert_bool(A), [A], [], [], [], expr). |
| 2674 | | syntaxelement(convert_real(A), [A], [], [], [], expr). |
| 2675 | | syntaxelement(convert_int_floor(A), [A], [], [], [], expr). |
| 2676 | | syntaxelement(convert_int_ceiling(A), [A], [], [], [], expr). |
| 2677 | | syntaxelement(add(A,B), [A,B],[], [], [], expr). |
| 2678 | | syntaxelement(add_real(A,B), [A,B],[], [], [], expr). |
| 2679 | | syntaxelement(minus(A,B), [A,B],[], [], [], expr). |
| 2680 | | syntaxelement(minus_real(A,B), [A,B],[], [], [], expr). |
| 2681 | | syntaxelement(minus_or_set_subtract(A,B),[A,B],[], [], [], expr/only_typecheck). |
| 2682 | | syntaxelement(unary_minus(A), [A], [], [], [], expr). |
| 2683 | | syntaxelement(unary_minus_real(A), [A], [], [], [], expr). |
| 2684 | | syntaxelement(multiplication(A,B), [A,B],[], [], [], expr). |
| 2685 | | syntaxelement(multiplication_real(A,B),[A,B],[], [], [], expr). |
| 2686 | | syntaxelement(mult_or_cart(A,B), [A,B],[], [], [], expr/only_typecheck). |
| 2687 | | syntaxelement(cartesian_product(A,B), [A,B],[], [], [], expr). |
| 2688 | | syntaxelement(div(A,B), [A,B],[], [], [], expr). |
| 2689 | | syntaxelement(div_real(A,B), [A,B],[], [], [], expr). |
| 2690 | | syntaxelement(floored_div(A,B), [A,B],[], [], [], expr). |
| 2691 | | syntaxelement(modulo(A,B), [A,B],[], [], [], expr). |
| 2692 | | syntaxelement(power_of(A,B), [A,B],[], [], [], expr). |
| 2693 | | syntaxelement(power_of_real(A,B), [A,B],[], [], [], expr). |
| 2694 | | syntaxelement(successor, [], [], [], [], expr). |
| 2695 | | syntaxelement(predecessor, [], [], [], [], expr). |
| 2696 | | syntaxelement(max(A), [A], [], [], [], expr). |
| 2697 | | syntaxelement(max_real(A), [A], [], [], [], expr). |
| 2698 | | syntaxelement(min(A), [A], [], [], [], expr). |
| 2699 | | syntaxelement(min_real(A), [A], [], [], [], expr). |
| 2700 | | syntaxelement(card(A), [A], [], [], [], expr). |
| 2701 | | syntaxelement(couple(A,B), [A,B],[], [], [], expr). |
| 2702 | | syntaxelement(pow_subset(A), [A], [], [], [], expr). |
| 2703 | | syntaxelement(pow1_subset(A), [A], [], [], [], expr). |
| 2704 | | syntaxelement(fin_subset(A), [A], [], [], [], expr). |
| 2705 | | syntaxelement(fin1_subset(A), [A], [], [], [], expr). |
| 2706 | | syntaxelement(interval(A,B), [A,B],[], [], [], expr). |
| 2707 | | syntaxelement(union(A,B), [A,B],[], [], [], expr). |
| 2708 | | syntaxelement(intersection(A,B), [A,B],[], [], [], expr). |
| 2709 | | syntaxelement(set_subtraction(A,B), [A,B],[], [], [], expr). |
| 2710 | | syntaxelement(general_union(A), [A], [], [], [], expr). |
| 2711 | | syntaxelement(general_intersection(A), [A] , [], [], [], expr). |
| 2712 | | syntaxelement(relations(A,B), [A,B],[], [], [], expr). |
| 2713 | | syntaxelement(identity(A), [A], [], [], [], expr). |
| 2714 | | syntaxelement(event_b_identity, [], [], [], [], expr). % for Rodin 1.0, TO DO: Daniel please check |
| 2715 | | syntaxelement(reverse(A), [A], [], [], [], expr). |
| 2716 | | syntaxelement(first_projection(A,B), [A,B],[], [], [], expr/only_typecheck). |
| 2717 | | syntaxelement(first_of_pair(A), [A], [], [], [], expr). |
| 2718 | | syntaxelement(event_b_first_projection(A),[A], [], [], [], expr/only_typecheck). |
| 2719 | | syntaxelement(event_b_first_projection_v2,[], [], [], [], expr/only_typecheck). % for Rodin 1.0, TO DO: Daniel please check |
| 2720 | | syntaxelement(second_projection(A,B), [A,B],[], [], [], expr/only_typecheck). |
| 2721 | | syntaxelement(event_b_second_projection_v2,[], [], [], [], expr/only_typecheck). % for Rodin 1.0, TO DO: Daniel please check |
| 2722 | | syntaxelement(second_of_pair(A), [A], [], [], [], expr). |
| 2723 | | syntaxelement(event_b_second_projection(A),[A], [], [], [], expr/only_typecheck). |
| 2724 | | syntaxelement(composition(A,B), [A,B],[], [], [], expr). |
| 2725 | | syntaxelement(ring(A,B), [A,B],[], [], [], expr/only_typecheck). |
| 2726 | | syntaxelement(direct_product(A,B), [A,B],[], [], [], expr). |
| 2727 | | syntaxelement(parallel_product(A,B), [A,B],[], [], [], expr). |
| 2728 | | syntaxelement(trans_function(A), [A], [], [], [], expr). |
| 2729 | | syntaxelement(trans_relation(A), [A], [], [], [], expr). |
| 2730 | | syntaxelement(iteration(A,B), [A,B],[], [], [], expr). |
| 2731 | | syntaxelement(reflexive_closure(A), [A], [], [], [], expr). |
| 2732 | | syntaxelement(closure(A), [A], [], [], [], expr). |
| 2733 | | syntaxelement(domain(A), [A], [], [], [], expr). |
| 2734 | | syntaxelement(range(A), [A], [], [], [], expr). |
| 2735 | | syntaxelement(image(A,B), [A,B],[], [], [], expr). |
| 2736 | | syntaxelement(domain_restriction(A,B), [A,B],[], [], [], expr). |
| 2737 | | syntaxelement(domain_subtraction(A,B), [A,B],[], [], [], expr). |
| 2738 | | syntaxelement(range_restriction(A,B), [A,B],[], [], [], expr). |
| 2739 | | syntaxelement(range_subtraction(A,B), [A,B],[], [], [], expr). |
| 2740 | | syntaxelement(overwrite(A,B), [A,B],[], [], [], expr). |
| 2741 | | syntaxelement(partial_function(A,B), [A,B],[], [], [], expr). |
| 2742 | | syntaxelement(total_function(A,B), [A,B],[], [], [], expr). |
| 2743 | | syntaxelement(partial_injection(A,B), [A,B],[], [], [], expr). |
| 2744 | | syntaxelement(total_injection(A,B), [A,B],[], [], [], expr). |
| 2745 | | syntaxelement(partial_surjection(A,B), [A,B],[], [], [], expr). |
| 2746 | | syntaxelement(total_surjection(A,B), [A,B],[], [], [], expr). |
| 2747 | | syntaxelement(total_bijection(A,B), [A,B],[], [], [], expr). |
| 2748 | | syntaxelement(partial_bijection(A,B), [A,B],[], [], [], expr). |
| 2749 | | syntaxelement(total_relation(A,B), [A,B],[], [], [], expr). |
| 2750 | | syntaxelement(surjection_relation(A,B),[A,B],[], [], [], expr). |
| 2751 | | syntaxelement(total_surjection_relation(A,B),[A,B],[], [], [], expr). |
| 2752 | | syntaxelement(seq(A), [A], [], [], [], expr). |
| 2753 | | syntaxelement(seq1(A), [A], [], [], [], expr). |
| 2754 | | syntaxelement(iseq(A), [A], [], [], [], expr). |
| 2755 | | syntaxelement(iseq1(A), [A], [], [], [], expr). |
| 2756 | | syntaxelement(perm(A), [A], [], [], [], expr). |
| 2757 | | syntaxelement(empty_sequence, [], [], [], [], expr). |
| 2758 | | syntaxelement(size(A), [A], [], [], [], expr). |
| 2759 | | syntaxelement(first(A), [A], [], [], [], expr). |
| 2760 | | syntaxelement(last(A), [A], [], [], [], expr). |
| 2761 | | syntaxelement(front(A), [A], [], [], [], expr). |
| 2762 | | syntaxelement(tail(A), [A], [], [], [], expr). |
| 2763 | | syntaxelement(rev(A), [A], [], [], [], expr). |
| 2764 | | syntaxelement(concat(A,B), [A,B],[], [], [], expr). |
| 2765 | | syntaxelement(insert_front(A,B), [A,B],[], [], [], expr). |
| 2766 | | syntaxelement(insert_tail(A,B), [A,B],[], [], [], expr). |
| 2767 | | syntaxelement(restrict_front(A,B), [A,B],[], [], [], expr). |
| 2768 | | syntaxelement(restrict_tail(A,B), [A,B],[], [], [], expr). |
| 2769 | | syntaxelement(general_concat(A), [A], [], [], [], expr). |
| 2770 | | syntaxelement(function(A,B), [A,B],[], [], [], expr). |
| 2771 | | syntaxelement(external_function_call(F,Args),Args,[],[Args],F,expr). |
| 2772 | | syntaxelement(identifier(I), [], [], [], I, expr). |
| 2773 | | syntaxelement(lazy_lookup_expr(I), [], [], [], I, expr). |
| 2774 | | syntaxelement(lazy_lookup_pred(I), [], [], [], I, pred). |
| 2775 | | syntaxelement(integer(I), [], [], [], I, expr). |
| 2776 | | syntaxelement(integer_set(T), [], [], [], T, expr). |
| 2777 | | syntaxelement(string(S), [], [], [], S, expr). |
| 2778 | | syntaxelement(set_extension(L), L, [], [L], [], expr). |
| 2779 | | syntaxelement(sequence_extension(L), L, [], [L], [], expr). |
| 2780 | | syntaxelement(comprehension_set(Ids,P),[P|Ids], Ids,[Ids], [], expr). |
| 2781 | | syntaxelement(event_b_comprehension_set(Ids,E,P),[E,P|Ids], Ids,[Ids], [], expr/only_typecheck). |
| 2782 | | syntaxelement(lambda(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr). |
| 2783 | | syntaxelement(general_sum(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr). |
| 2784 | | syntaxelement(general_product(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr). |
| 2785 | | syntaxelement(quantified_union(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr). |
| 2786 | | syntaxelement(quantified_intersection(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr). |
| 2787 | | syntaxelement(struct(Rec), [Rec], [], [], [], expr). |
| 2788 | | syntaxelement(rec(Fields), FContent, [], [FContent], FNames, expr) :- syntaxfields(Fields,FContent, FNames). |
| 2789 | | syntaxelement(record_field(R,I), [R], [], [], I, expr). |
| 2790 | | syntaxelement(assertion_expression(Cond,ErrMsg,Expr), [Cond,Expr], [], [], ErrMsg, expr). |
| 2791 | | syntaxelement(typeset, [], [], [], [], expr/only_typecheck). |
| 2792 | | |
| 2793 | | syntaxelement(tree(A), [A], [], [], [], expr). |
| 2794 | | syntaxelement(btree(A), [A], [], [], [], expr). |
| 2795 | | syntaxelement(const(A,B), [A,B],[], [], [], expr). |
| 2796 | | syntaxelement(top(A), [A], [], [], [], expr). |
| 2797 | | syntaxelement(sons(A), [A], [], [], [], expr). |
| 2798 | | syntaxelement(prefix(A), [A], [], [], [], expr). |
| 2799 | | syntaxelement(postfix(A), [A], [], [], [], expr). |
| 2800 | | syntaxelement(sizet(A), [A], [], [], [], expr). |
| 2801 | | syntaxelement(mirror(A), [A], [], [], [], expr). |
| 2802 | | syntaxelement(rank(A,B), [A,B],[], [], [], expr). |
| 2803 | | syntaxelement(father(A,B), [A,B],[], [], [], expr). |
| 2804 | | syntaxelement(son(A,B,C), [A,B,C],[], [], [], expr). |
| 2805 | | syntaxelement(subtree(A,B), [A,B],[], [], [], expr). |
| 2806 | | syntaxelement(arity(A,B), [A,B],[], [], [], expr). |
| 2807 | | syntaxelement(bin(A), [A],[], [], [], expr). |
| 2808 | | syntaxelement(bin(A,B,C), [A,B,C],[], [], [], expr). |
| 2809 | | syntaxelement(infix(A), [A], [], [], [], expr). |
| 2810 | | syntaxelement(left(A), [A], [], [], [], expr). |
| 2811 | | syntaxelement(right(A), [A], [], [], [], expr). |
| 2812 | | |
| 2813 | | % substitutions |
| 2814 | | syntaxelement(skip, [], [], [], [], subst). |
| 2815 | | syntaxelement(precondition(A,B), [A,B],[], [], [], subst). |
| 2816 | | syntaxelement(assertion(A,B), [A,B],[], [], [], subst). |
| 2817 | | syntaxelement(witness_then(A,B), [A,B],[], [], [], subst). |
| 2818 | | syntaxelement(if_elsif(A,B), [A,B],[], [], [], subst/elsif). |
| 2819 | | syntaxelement(while(A,B,C,D), [A,B,C,D],[], [], [], subst). |
| 2820 | | % used only internally in the interpreter, contains last value of variant: |
| 2821 | | syntaxelement(while1(A,B,C,D,E), [A,B,C,D],[], [], E, subst). |
| 2822 | | syntaxelement(select_when(A,B), [A,B],[], [], [], subst/when). |
| 2823 | | syntaxelement(block(S),[S],[],[],[], subst/only_typecheck). |
| 2824 | | syntaxelement(assign(Lhs,Rhs),Exprs,[],[Lhs,Rhs], [], subst) :- append(Lhs,Rhs,Exprs). |
| 2825 | | syntaxelement(assign_single_id(Id,Rhs),[Id,Rhs],[],[], [], subst). |
| 2826 | | syntaxelement(any(Ids,P,S),[P,S|Ids],Ids,[Ids], [], subst). |
| 2827 | | syntaxelement(var(Ids,S), [S|Ids], Ids,[Ids], [], subst). |
| 2828 | | syntaxelement(if(Ifs), Ifs, [], [Ifs], [], subst). |
| 2829 | | syntaxelement(parallel(Ss), Ss, [], [Ss], [], subst). |
| 2830 | | syntaxelement(sequence(Ss), Ss, [], [Ss], [], subst). |
| 2831 | | syntaxelement(becomes_element_of(Ids,E), [E|Ids], [], [Ids], [], subst). |
| 2832 | | syntaxelement(becomes_such(Ids,P), [P|Ids], [], [Ids], [], subst). % Ids are new value, Ids$0 is old value |
| 2833 | | syntaxelement(evb2_becomes_such(Ids,P), [P|Ids], [], [Ids], [], subst/only_typecheck). |
| 2834 | | syntaxelement(let(Ids,P,S), [P,S|Ids], Ids, [Ids], [], subst). |
| 2835 | | syntaxelement(operation_call(Id,Rs,As), [Id|Exprs], [], [Rs,As], [], subst) :- append(Rs,As,Exprs). |
| 2836 | | syntaxelement(case(E,Eithers,Else), [E,Else|Eithers], [], [Eithers], [], subst). |
| 2837 | | syntaxelement(case_or(Es,S), [S|Es], [], [Es], [], subst/caseor). |
| 2838 | | syntaxelement(choice(Ss), Ss, [], [Ss], [], subst). |
| 2839 | | syntaxelement(select(Whens), Whens, [], [Whens], [], subst). |
| 2840 | | syntaxelement(select(Whens,Else), [Else|Whens], [], [Whens], [], subst). |
| 2841 | | syntaxelement(operation(I,Rs,As,B), [I,B|Ids], Ids, [Rs,As], [], subst) :- append(Rs,As,Ids). |
| 2842 | | syntaxelement(external_subst_call(F,Args),Args,[],[Args],F,subst). |
| 2843 | | |
| 2844 | | % elements of a VALUES clause |
| 2845 | | syntaxelement(values_entry(I,E),[I,E],[],[],[],values_entry). |
| 2846 | | |
| 2847 | | % syntax for Event-B events |
| 2848 | | syntaxelement(rlevent(I,Sec,St,Ps,G,Ts,As,VWs,PWs,Ums,Rs), Subs, [], [Ps,Ts,As,VWs,PWs,Ums,Rs], [I,Sec], subst) :- |
| 2849 | | append([[St],Ps,[G],Ts,As,VWs,PWs,Ums,Rs],Subs). |
| 2850 | | syntaxelement(witness(I,P), [I,P], [], [], [], witness). |
| 2851 | | |
| 2852 | | % extended syntax for Z |
| 2853 | | syntaxelement(let_predicate(Ids,As,Pred), Exprs, Ids, [Ids,As], [], pred) :- append([Ids,As,[Pred]],Exprs). |
| 2854 | | syntaxelement(let_expression(Ids,As,Expr), Exprs, Ids, [Ids,As], [], expr) :- append([Ids,As,[Expr]],Exprs). |
| 2855 | | syntaxelement(let_expression_global(Ids,As,Expr), Exprs, Ids, [Ids,As], [], expr) :- % version used by b_compiler |
| 2856 | | append([Ids,As,[Expr]],Exprs). |
| 2857 | | syntaxelement(lazy_let_expr(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], expr). |
| 2858 | | syntaxelement(lazy_let_pred(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], pred). |
| 2859 | | syntaxelement(lazy_let_subst(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], subst). |
| 2860 | | syntaxelement(if_then_else(If,Then,Else),[If,Then,Else], [], [], [], expr). |
| 2861 | | syntaxelement(compaction(A), [A], [], [], [], expr). |
| 2862 | | syntaxelement(mu(A), [A], [], [], [], expr). |
| 2863 | | syntaxelement(bag_items(A), [A], [], [], [], expr). |
| 2864 | | |
| 2865 | | syntaxelement(freetype_set(Id), [], [], [], Id, expr). |
| 2866 | | syntaxelement(freetype_case(Type,Case,Expr), [Expr], [], [], [Type,Case], pred). |
| 2867 | | syntaxelement(freetype_constructor(Type,Case,Expr), [Expr], [], [], [Type,Case], expr). |
| 2868 | | syntaxelement(freetype_destructor(Type,Case,Expr), [Expr], [], [], [Type,Case], expr). |
| 2869 | | |
| 2870 | | syntaxelement(ordinary, [], [], [], [], status). |
| 2871 | | syntaxelement(anticipated(Variant), [Variant], [], [], [], status). |
| 2872 | | syntaxelement(convergent(Variant), [Variant], [], [], [], status). |
| 2873 | | |
| 2874 | | % Just one ID expected |
| 2875 | | syntaxelement(recursive_let(Id,C),[Id,C],[Id],[],[], expr). % Note: Id is not really introduced ! |
| 2876 | | |
| 2877 | | |
| 2878 | | % fields of records |
| 2879 | | %syntaxfields(Fields,C,_) :- var(Fields),var(C),var(N),!, add_internal_error('Illegal call: ',syntaxfields(Fields,C,N)),fail. |
| 2880 | | syntaxfields([],[],[]). |
| 2881 | | syntaxfields([field(N,C)|Rest],[C|CRest],[N|NRest]) :- syntaxfields(Rest,CRest,NRest). |
| 2882 | | |
| 2883 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2884 | | % helper for declaration of quantified identifiers |
| 2885 | | |
| 2886 | | % has_declared_identifier/2 returns a list of identifiers which are declared in |
| 2887 | | % this AST node. The main difference to the Names variable when doing a |
| 2888 | | % syntaxtraversion/6 or similiar is that the identifiers are described by |
| 2889 | | % predicates. |
| 2890 | | has_declared_identifier(TExpr,Ids) :- |
| 2891 | | get_texpr_expr(TExpr,Expr), |
| 2892 | | ( default_declaration(Expr,_,Ids,_) |
| 2893 | | ; non_default_declaration(Expr,Ids)). |
| 2894 | | |
| 2895 | | add_declaration_for_identifier(b(Expr,Type,Infos),Decl,b(NExpr,Type,NewInfos)) :- |
| 2896 | | %delete(Infos,used_ids(_),NewInfos), % we cannot |
| 2897 | | ( default_declaration(Expr,Predicate,Ids,Constant) -> |
| 2898 | | same_functor(Expr,NExpr), |
| 2899 | | conjunct_predicates([Decl,Predicate],NPredicate), |
| 2900 | | default_declaration(NExpr,NPredicate,Ids,Constant) |
| 2901 | | ; non_default_declaration(Expr,Ids) -> |
| 2902 | | add_non_default_declaration(Expr,Decl,NExpr) |
| 2903 | | ), |
| 2904 | | add_used_ids(Infos,Ids,Decl,NewInfos). |
| 2905 | | |
| 2906 | | % add used ids of a predicate within quantification of Ids to current used_ids info; if it is there |
| 2907 | | add_used_ids(Infos,Ids,Pred,NewInfos) :- update_used_ids(Infos,OldUsed,NewInfos,NewUsed), |
| 2908 | | !, % a field needs updating |
| 2909 | | find_identifier_uses(Pred,[],NewIds), get_texpr_ids(Ids,UnsortedIds),sort(UnsortedIds,SIds), |
| 2910 | | ord_subtract(NewIds,SIds,NewIds2), |
| 2911 | | ord_union(NewIds2,OldUsed,NewUsed). |
| 2912 | | add_used_ids(I,_,_,I). |
| 2913 | | |
| 2914 | | % just update used_ids field (e.g., when just computed to store it for later) |
| 2915 | | update_used_ids(Infos,OldUsed,NewInfos,NewUsed) :- select(OldInfo,Infos,I1), |
| 2916 | | used_ids_like_info(OldInfo,F,OldUsed),!, |
| 2917 | | used_ids_like_info(NewInfo,F,NewUsed),NewInfos = [NewInfo|I1]. |
| 2918 | | |
| 2919 | | % info fields which contain used_ids information |
| 2920 | | used_ids_like_info(used_ids(UsedIds),used_ids,UsedIds). |
| 2921 | | used_ids_like_info(reads(UsedIds),reads,UsedIds). |
| 2922 | | |
| 2923 | | :- use_module(probsrc(btypechecker), [prime_identifiers/2]). |
| 2924 | | |
| 2925 | | % default_declaration(Expr,Predicate,Ids,Constant) |
| 2926 | | default_declaration(forall(Ids,D,P),D,Ids,P). |
| 2927 | | default_declaration(exists(Ids,P),P,Ids,[]). |
| 2928 | | default_declaration(comprehension_set(Ids,P),P,Ids,[]). |
| 2929 | | default_declaration(event_b_comprehension_set(Ids,E,P),P,Ids,E). % translated !? |
| 2930 | | default_declaration(lambda(Ids,P,E),P,Ids,E). |
| 2931 | | default_declaration(general_sum(Ids,P,E),P,Ids,E). |
| 2932 | | default_declaration(general_product(Ids,P,E),P,Ids,E). |
| 2933 | | default_declaration(quantified_union(Ids,P,E),P,Ids,E). |
| 2934 | | default_declaration(quantified_intersection(Ids,P,E),P,Ids,E). |
| 2935 | | default_declaration(any(Ids,P,S),P,Ids,S). |
| 2936 | | default_declaration(becomes_such(Ids,P),P,Ids,[]). |
| 2937 | | default_declaration(evb2_becomes_such(Ids,P),P,Primed,[]) :- |
| 2938 | | nl,print(evb2(Ids,Primed)),nl,nl, % no longer used, as it is translated to becomes_such |
| 2939 | | prime_identifiers(Ids,Primed). |
| 2940 | | default_declaration(rlevent(I,Sec,St,Ps,G,Ts,As,VWs,PWs,Ums,Rs),G,Ps, |
| 2941 | | [I,Sec,St,Ps,Ts,As,VWs,PWs,Ums,Rs]). |
| 2942 | | default_declaration(let_predicate(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps |
| 2943 | | default_declaration(let_expression(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps |
| 2944 | | default_declaration(let_expression_global(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps |
| 2945 | | % TODO: lazy let ? |
| 2946 | | |
| 2947 | | non_default_declaration(operation(_I,Rs,As,_TBody),Ids) :- |
| 2948 | | append(Rs,As,Ids). |
| 2949 | | |
| 2950 | | add_non_default_declaration(operation(I,Rs,As,TBody),Decl,operation(I,Rs,As,NTBody)) :- |
| 2951 | | ( get_guard_and_copy(TBody,P,NP,NTBody) -> |
| 2952 | | conjunct_predicates([Decl,P],NP) |
| 2953 | | ; create_texpr(precondition(Decl,TBody),subst,[],NTBody)). |
| 2954 | | |
| 2955 | | get_guard_and_copy(TBody,P,NP,NTBody) :- remove_bt(TBody,Body,NBody,NTBody), |
| 2956 | | get_guard_copy2(Body,P,NP,NBody). |
| 2957 | | |
| 2958 | | get_guard_copy2(precondition(P,S),P,NP,precondition(NP,S)). |
| 2959 | | get_guard_copy2(rlevent(I,Sec,St,Ps, G,Ts,As,VWs,PWs,Ums,Rs), G, NG, |
| 2960 | | rlevent(I,Sec,St,Ps,NG,Ts,As,VWs,PWs,Ums,Rs)). |
| 2961 | | |
| 2962 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 2963 | | % pattern definitions (not yet finished) |
| 2964 | | |
| 2965 | | bsyntax_pattern(Expr,TExpr) :- |
| 2966 | | var(Expr),!,Expr=TExpr. |
| 2967 | | bsyntax_pattern(-Expr,TExpr) :- |
| 2968 | | !,remove_all_infos(Expr,TExpr). |
| 2969 | | bsyntax_pattern(Expr,TExpr) :- |
| 2970 | | functor(Expr,b,3),!,Expr=TExpr. |
| 2971 | | bsyntax_pattern(Expr:Type/Info,TExpr) :- |
| 2972 | | !,bsyntax_pattern2(Expr,Type,Info,TExpr). |
| 2973 | | bsyntax_pattern(Expr:Type,TExpr) :- |
| 2974 | | !,bsyntax_pattern2(Expr,Type,_Info,TExpr). |
| 2975 | | bsyntax_pattern(Expr/Info,TExpr) :- |
| 2976 | | !,bsyntax_pattern2(Expr,_Type,Info,TExpr). |
| 2977 | | bsyntax_pattern(Expr,TExpr) :- |
| 2978 | | !,bsyntax_pattern2(Expr,_Type,_Info,TExpr). |
| 2979 | | |
| 2980 | | bsyntax_pattern2(Pattern,Type,Info,TExpr) :- |
| 2981 | | functor(Pattern,Functor,Arity), |
| 2982 | | functor(R,Functor,Arity), |
| 2983 | | create_texpr(R,Type,Info,TExpr), |
| 2984 | | syntaxelement(Pattern,PSubs,_,PLists,Const,EType), |
| 2985 | | syntaxelement(R,RSubs,_,RLists,Const,EType), |
| 2986 | | ( EType==pred -> Type=pred |
| 2987 | | ; EType==subst -> Type=subst |
| 2988 | | ; true), |
| 2989 | | all_same_length(PLists,RLists), |
| 2990 | | maplist(bsyntax_pattern,PSubs,RSubs). |
| 2991 | | |
| 2992 | | all_same_length([],[]). |
| 2993 | | all_same_length([A|Arest],[B|Brest]) :- |
| 2994 | | ( var(A),var(B) -> |
| 2995 | | add_error_fail(bsyntaxtree,'At least one list should contain nonvar elements for all_same_length',[A,B]) |
| 2996 | | ; |
| 2997 | | same_length(A,B)), |
| 2998 | | all_same_length(Arest,Brest). |
| 2999 | | |
| 3000 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 3001 | | % strip an AST into a more compact form (without b/3 terms) |
| 3002 | | |
| 3003 | | strip_and_norm_ast(TExpr,SNExpr) :- |
| 3004 | | get_texpr_expr(TExpr,Expr), |
| 3005 | | strip_and_norm_ast_aux(Expr,SNExpr). |
| 3006 | | |
| 3007 | | :- use_module(tools,[safe_univ_no_cutoff/2]). |
| 3008 | | strip_and_norm_ast_aux(Expr,Res) :- |
| 3009 | | comm_assoc_subs(Expr,Op,Subs,[]), !, % associative & commutative operator detected |
| 3010 | | maplist(strip_and_norm_ast_aux,Subs,NSubs), % Subs are already unwrapped |
| 3011 | | sort(NSubs,Sorted), % in case there are associative operators that are not commutative: insert is_commutative check |
| 3012 | | safe_univ_no_cutoff(Res,[Op|Sorted]). |
| 3013 | | strip_and_norm_ast_aux(Expr,Res) :- |
| 3014 | | assoc_subs(Expr,Op,Subs,[]), !, % associative operator detected |
| 3015 | | maplist(strip_and_norm_ast_aux,Subs,NSubs), % Subs are already unwrapped |
| 3016 | | safe_univ_no_cutoff(Res,[Op|NSubs]). |
| 3017 | | strip_and_norm_ast_aux(Expr,SNExpr) :- |
| 3018 | | syntaxtransformation(Expr,Subs,_,NSubs,SExpr), |
| 3019 | | strip_and_norm_ast_l(Subs,NSubs), |
| 3020 | | norm_strip(SExpr,SNExpr). |
| 3021 | | |
| 3022 | | strip_and_norm_ast_l([],[]). |
| 3023 | | strip_and_norm_ast_l([TExpr|Trest],[NExpr|Nrest]) :- |
| 3024 | | strip_and_norm_ast(TExpr,NExpr), |
| 3025 | | strip_and_norm_ast_l(Trest,Nrest). |
| 3026 | | |
| 3027 | | norm_strip(greater_equal(A,B),less_equal(B,A)) :- !. |
| 3028 | | norm_strip(greater(A,B),less(B,A)) :- !. |
| 3029 | | norm_strip(set_extension(NL),set_extension(SNL)) :- !, |
| 3030 | | sort(NL,SNL). |
| 3031 | | norm_strip(Old,New) :- |
| 3032 | | functor(Old,Functor,2), |
| 3033 | | is_commutative(Functor),!, |
| 3034 | | arg(1,Old,OA), |
| 3035 | | arg(2,Old,OB), |
| 3036 | | ( OA @> OB -> New =.. [Functor,OB,OA] |
| 3037 | | ; New=Old). |
| 3038 | | norm_strip(Old,Old). |
| 3039 | | % TO DO: flatten associative operators into lists ! |
| 3040 | | |
| 3041 | | comm_assoc_subs(conjunct(TA,TB),conjunct) --> !, |
| 3042 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3043 | | comm_assoc_subs(A,conjunct), comm_assoc_subs(B,conjunct). |
| 3044 | | comm_assoc_subs(disjunct(TA,TB),disjunct) --> !, |
| 3045 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3046 | | comm_assoc_subs(A,disjunct), comm_assoc_subs(B,disjunct). |
| 3047 | | comm_assoc_subs(add(TA,TB),add) --> !, |
| 3048 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3049 | | comm_assoc_subs(A,add), comm_assoc_subs(B,add). |
| 3050 | | comm_assoc_subs(multiplication(TA,TB),multiplication) --> !, |
| 3051 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3052 | | comm_assoc_subs(A,multiplication), comm_assoc_subs(B,multiplication). |
| 3053 | | comm_assoc_subs(union(TA,TB),union) --> !, |
| 3054 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3055 | | comm_assoc_subs(A,union), comm_assoc_subs(B,union). |
| 3056 | | comm_assoc_subs(intersection(TA,TB),intersection) --> !, |
| 3057 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3058 | | comm_assoc_subs(A,intersection), comm_assoc_subs(B,intersection). |
| 3059 | | comm_assoc_subs(Expr,Op) --> {nonvar(Op)},[Expr]. % base case for other operators |
| 3060 | | |
| 3061 | | % detect just associative operators |
| 3062 | | assoc_subs(concat(TA,TB),concat) --> !, |
| 3063 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3064 | | assoc_subs(A,concat), assoc_subs(B,concat). |
| 3065 | | assoc_subs(composition(TA,TB),composition) --> !, |
| 3066 | | {get_texpr_expr(TA,A), get_texpr_expr(TB,B)}, |
| 3067 | | assoc_subs(A,composition), assoc_subs(B,composition). |
| 3068 | | assoc_subs(Expr,Op) --> {nonvar(Op)},[Expr]. % base case for other operators |
| 3069 | | |
| 3070 | | is_commutative(conjunct). |
| 3071 | | is_commutative(disjunct). |
| 3072 | | is_commutative(equivalence). |
| 3073 | | is_commutative(equal). |
| 3074 | | is_commutative(not_equal). |
| 3075 | | is_commutative(add). |
| 3076 | | is_commutative(multiplication). |
| 3077 | | is_commutative(union). |
| 3078 | | is_commutative(intersection). |
| 3079 | | |
| 3080 | | % check if two type expressions are same modulo info fields and reordering of commutative operators |
| 3081 | | % same_texpr does not reorder wrt commutativity. |
| 3082 | | same_norm_texpr(TExpr1,TExpr2) :- |
| 3083 | | strip_and_norm_ast(TExpr1,N1), |
| 3084 | | strip_and_norm_ast(TExpr2,N1). |
| 3085 | | |
| 3086 | | |
| 3087 | | % small utility to get functor of texpr: |
| 3088 | | get_texpr_functor(b(E,_,_),F,N) :- !, functor(E,F,N). |
| 3089 | | get_texpr_functor(E,_,+) :- add_error_fail(get_texpr_functor,'Not a typed expression: ',E). |
| 3090 | | |
| 3091 | | % ------------------------- |
| 3092 | | |
| 3093 | | % check if a ProB type is a set type: |
| 3094 | | is_set_type(set(Type),Type). |
| 3095 | | is_set_type(seq(Type),couple(integer,Type)). |
| 3096 | | % should we have a rule for any ?? : in all cases using is_set_type any seems not possible; better that we generate error message in get_set_type or get_texpr_set_type |
| 3097 | | % is_set_type(any,any). |
| 3098 | | |
| 3099 | | get_set_type(TypeX,Res) :- |
| 3100 | ? | (is_set_type(TypeX,SetType) -> Res=SetType ; add_error_fail(get_set_type,'Not a set type: ',TypeX)). |
| 3101 | | |
| 3102 | | get_texpr_set_type(X,Res) :- get_texpr_type(X,TypeX), |
| 3103 | | get_set_type(TypeX,Res). |
| 3104 | | |
| 3105 | | |
| 3106 | | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| 3107 | | % check if a set contains all elements of a type, i.e., maximal type |
| 3108 | | is_just_type(Expr) :- is_just_type(Expr,[]). |
| 3109 | | % is_just_type(+Expr,+RTT): |
| 3110 | | % like is_just_type/1 but RTT is a list of identifiers (without type information) |
| 3111 | | % of variables or constants that are known to be types, too. |
| 3112 | | % E.g. is_just_type(a ** INTEGER) would fail but is_just_type(a ** INTEGER,[a]) would |
| 3113 | | % succeed. |
| 3114 | | is_just_type(b(E,T,I),RTT) :- is_just_type3(E,T,I,RTT). |
| 3115 | | |
| 3116 | | |
| 3117 | | is_just_type3(identifier(G),SType,Infos,RefsToTypes) :- |
| 3118 | | nonvar(SType), SType = set(Type), nonvar(Type), |
| 3119 | | ( Type = global(G), |
| 3120 | | memberchk(given_set,Infos) % no accidental local variable G that hides global G |
| 3121 | | ; memberchk(G,RefsToTypes) -> true |
| 3122 | | %; Type = freetype(G), |
| 3123 | | % memberchk(given_set,Infos) % no accidental local variable G that hides global G |
| 3124 | | % TODO: we do not know if the Freetype has restrictions (which are encoded in the PROPERTIES) |
| 3125 | | ),!. |
| 3126 | | is_just_type3(freetype_set(_),_,_,_). |
| 3127 | | is_just_type3(pow_subset(E),_,_,RTT) :- is_just_type(E,RTT). |
| 3128 | | is_just_type3(fin_subset(E),T,_,RTT) :- |
| 3129 | | is_finite_type_in_context(proving,T), % animation or proving |
| 3130 | | is_just_type(E,RTT). |
| 3131 | | is_just_type3(integer_set('INTEGER'),set(integer),_,_). |
| 3132 | | is_just_type3(bool_set,set(boolean),_,_). |
| 3133 | | is_just_type3(real_set,set(real),_,_). |
| 3134 | | is_just_type3(string_set,set(string),_,_). |
| 3135 | | is_just_type3(cartesian_product(A,B),_,_,RTT) :- |
| 3136 | | is_just_type(A,RTT),is_just_type(B,RTT). |
| 3137 | | is_just_type3(mult_or_cart(A,B),_,_,RTT) :- % is_just_type/1 could be called before the cleanup |
| 3138 | | is_just_type(A,RTT),is_just_type(B,RTT). % of an expression has finished |
| 3139 | | is_just_type3(relations(A,B),_,_,RTT) :- |
| 3140 | | is_just_type(A,RTT),is_just_type(B,RTT). |
| 3141 | | is_just_type3(struct(b(rec(Fields),_,_)),_,_,RTT) :- |
| 3142 | | maplist(field_is_just_type(RTT),Fields). |
| 3143 | | is_just_type3(typeset,_,_,_). |
| 3144 | | is_just_type3(comprehension_set(_,b(truth,_,_)),_,_,_). |
| 3145 | | is_just_type3(set_extension([V1,V2]),_,_,_) :- get_texpr_boolean(V1,B1), % TODO: also deal with enumerated set elems |
| 3146 | | (B1=boolean_true -> get_texpr_boolean(V2,boolean_false) ; B1=boolean_false -> get_texpr_boolean(V2,boolean_true)). |
| 3147 | | is_just_type3(value(Val),ST,_,_) :- % e.g., {TRUE,FALSE} would usually get translated into this |
| 3148 | | is_set_type(ST,Type), is_maximal_value(Val,Type). % also see: quick_is_definitely_maximal_set(Val). |
| 3149 | | |
| 3150 | | field_is_just_type(RTT,field(_,Set)) :- is_just_type(Set,RTT). |
| 3151 | | |
| 3152 | | |
| 3153 | | get_texpr_boolean(b(X,_,_),Res) :- is_boolan_expr(X,Res). |
| 3154 | | is_boolan_expr(boolean_true,boolean_true). |
| 3155 | | is_boolan_expr(boolean_false,boolean_false). |
| 3156 | | is_boolan_expr(value(X),Res) :- nonvar(X), conv_bool_val(X,Res). |
| 3157 | | conv_bool_val(pred_true,boolean_true). |
| 3158 | | conv_bool_val(pred_false,boolean_false). |
| 3159 | | |
| 3160 | | :- use_module(probsrc(custom_explicit_sets),[quick_definitely_maximal_set_avl/1]). |
| 3161 | | is_maximal_value(V,_) :- var(V),!,fail. |
| 3162 | | is_maximal_value(global_set(GS),Type) :- (GS=='INTEGER' -> true ; Type==global(GS)). |
| 3163 | | % we could call is_maximal_global_set(GS) or b_global_set (but requires compiled) |
| 3164 | | is_maximal_value(avl_set(A),Type) :- |
| 3165 | | type_finite_and_pre_compiled(Type), |
| 3166 | | quick_definitely_maximal_set_avl(A). % note: affects test 2392 |
| 3167 | | |
| 3168 | | :- use_module(probsrc(b_global_sets),[b_global_sets_precompiled/0, enumerated_sets_precompiled/0, enumerated_set/1]). |
| 3169 | | type_finite_and_pre_compiled(boolean). |
| 3170 | | type_finite_and_pre_compiled(global(GS)) :- |
| 3171 | | (enumerated_set(GS) -> true % at least added with pre_register_enumerated_set_with_elems |
| 3172 | | ; b_global_sets_precompiled). |
| 3173 | | type_finite_and_pre_compiled(couple(A,B)) :- type_finite_and_pre_compiled(A), type_finite_and_pre_compiled(B). |
| 3174 | | type_finite_and_pre_compiled(set(A)) :- type_finite_and_pre_compiled(A). |
| 3175 | | % TODO: records?? less-likely we have an exhaustive list |
| 3176 | | |
| 3177 | | % Generate a custom matching / visitor predicate |
| 3178 | | % bsyntaxtree:gen_visitor(bexpr_variables_aux,bexpr_variables) |
| 3179 | | /* |
| 3180 | | gen_visitor(Pred, BodyPred) :- syntaxelement(Expr,SubsX,_NamesX,_Lists,_ConstantX,_), |
| 3181 | | print_clause(Pred,BodyPred,Expr,SubsX), |
| 3182 | | fail. |
| 3183 | | gen_visitor(Pred, BodyPred) :- nl. |
| 3184 | | |
| 3185 | | print_clause(Pred,BodyPred,Expr,SubsX) :- E=..[Op|SubsX], format('~w(~w) :- ',[Pred,Expr]). |
| 3186 | | */ |
| 3187 | | |
| 3188 | | /* |
| 3189 | | * create_recursive_compset(+Ids,+Cond,+Type,+Infos,-RecId,-TCompSet) |
| 3190 | | * creates a recursive comprehension set: |
| 3191 | | * Ids is the list of the introduced typed identifiers |
| 3192 | | * Cond is the condition (a typed predicate) |
| 3193 | | * Infos are additional informations for the comprehension set syntax element |
| 3194 | | * RecId is the identifier (untyped, an atom) that can be used in Cond to refer to the |
| 3195 | | * comprehension set recursively. Usually RecId is used in Cond as a variable |
| 3196 | | * TCompSet is the generated recursive comprehension set, the recursion parameter is introduced |
| 3197 | | * by a recusive(Id,CompSet) syntax element |
| 3198 | | */ |
| 3199 | | create_recursive_compset(Ids,Cond,Type,Infos,RecId,TCompSet) :- |
| 3200 | | unique_id("recursive.",RecId), |
| 3201 | | add_symbolic_annotation(Infos,RInfos), |
| 3202 | | create_texpr(comprehension_set(Ids,Cond),Type,RInfos,TCompSet1), |
| 3203 | | create_typed_id(RecId,Type,TRecId), |
| 3204 | | create_texpr(recursive_let(TRecId,TCompSet1),Type,[],TCompSet). |
| 3205 | | |
| 3206 | | unique_typed_id(Prefix,Type,TId) :- |
| 3207 | | unique_id(Prefix,Id), |
| 3208 | | create_typed_id(Id,Type,TId). |
| 3209 | | |
| 3210 | | |
| 3211 | | mark_bexpr_as_symbolic(b(E,T,I),b(E2,T,RI)) :- |
| 3212 | | add_symbolic_annotation(I,RI), |
| 3213 | | mark_aux(E,E2). |
| 3214 | | mark_aux(union(A,B),R) :- !, R=union(SA,SB), |
| 3215 | | mark_bexpr_as_symbolic(A,SA), mark_bexpr_as_symbolic(B,SB). |
| 3216 | | % union is currently the only operator that is kept symbolically |
| 3217 | | mark_aux(A,A). |
| 3218 | | |
| 3219 | | add_symbolic_annotation([H|I],R) :- H == prob_annotation('SYMBOLIC'),!, R=[H|I]. |
| 3220 | | add_symbolic_annotation(I,R) :- !, R=[prob_annotation('SYMBOLIC')|I]. |
| 3221 | | |
| 3222 | | % identifier_sub_ast(+TExpr,+Identifier,-SubPosition): |
| 3223 | | % Find occurences of an identifier "Identifier" in an expression "TExpr" |
| 3224 | | % Returns a list of positions (beginning with 0) that describes the position of a sub-expression |
| 3225 | | % that contains all occurrences of Identifier in TExpr. |
| 3226 | | % E.g. [1,0,1] means "second sub-expression of TExpr, then the first sub-expression of that, |
| 3227 | | % then the second sub-expression of that". |
| 3228 | | % When an identifier has multiple occurences, the position of the sub-expression is returned |
| 3229 | | % where all occurences of it are located. |
| 3230 | | % If the identifier is not found, the call fails. |
| 3231 | | % Sub-expressions are meant like the ones syntaxtraversion or syntaxtransformation return. |
| 3232 | | identifier_sub_ast(TExpr,Identifier,SubPosition) :- |
| 3233 | | syntaxtraversion(TExpr,Expr,_Type,_Infos,AllSubs,Names), |
| 3234 | | identifier_sub_ast_aux(Expr,AllSubs,Names,Identifier,SubPosition). |
| 3235 | | identifier_sub_ast_aux(identifier(Identifier),[],[],Identifier,[]) :- !. |
| 3236 | | identifier_sub_ast_aux(_Expr,AllSubs,Names,Identifier,SubPosition) :- |
| 3237 | | get_texpr_id(TId,Identifier),nonmember(TId,Names), |
| 3238 | | % For each sub-expression E in the list AllSubs create a term Pos-E |
| 3239 | | % where Pos is E's position (starting with 0) in AllSubs |
| 3240 | | foldl(annotate_pos,AllSubs,AllAnnotatedSubs,0,_), |
| 3241 | | % Introduced identifiers occur alsa as sub-expressions, remove those |
| 3242 | | foldl(select_sub,Names,AllAnnotatedSubs,RealAnnSubs), |
| 3243 | | convlist_max(identifier_sub_ast_aux2(Identifier),2,RealAnnSubs,SubPositions), % find at most 2 sols |
| 3244 | | ( SubPositions = [SubPosition] -> true |
| 3245 | | ; SubPositions = [_,_|_] -> % More then one occurrences - make this the found node |
| 3246 | | SubPosition = []). |
| 3247 | | identifier_sub_ast_aux2(Identifier,Pos-TExpr,[Pos|SubPosition]) :- |
| 3248 | | identifier_sub_ast(TExpr,Identifier,SubPosition). |
| 3249 | | annotate_pos(TExpr,I-TExpr,I,I2) :- I2 is I+1. |
| 3250 | | select_sub(Name,AnnotatedSubs,Result) :- |
| 3251 | | selectchk(_Pos-Name,AnnotatedSubs,Result). |
| 3252 | | |
| 3253 | | |
| 3254 | | |
| 3255 | | % exchange_ast_position(+SubPosition,+OldTExpr,-OldInner,+NewInner,-NewTExpr): |
| 3256 | | % exchanges a sub-expression in the expression "OldTExpr". |
| 3257 | | % SubPosition is a list of positions like identifier_sub_ast/3 returns it. |
| 3258 | | % OldInner is the sub-expression found in OldTExpr. |
| 3259 | | % NewInner is the new sub-expression. |
| 3260 | | % NewTExpr is the new expression that originates from replacing OldInner by NewInner. |
| 3261 | | exchange_ast_position([],Old,Old,New,New). |
| 3262 | | exchange_ast_position([Pos|RestPos],OldTExpr,OldInner,NewInner,NewTExpr) :- |
| 3263 | | remove_bt_and_used_ids(OldTExpr,OldExpr,NewExpr,NewTExpr), % also invalidates used_ids info |
| 3264 | | syntaxtransformation(OldExpr,Subs,_Names,NSubs,NewExpr), |
| 3265 | | nth0(Pos,Subs, OldSelected,Rest), |
| 3266 | | nth0(Pos,NSubs,NewSelected,Rest), |
| 3267 | | exchange_ast_position(RestPos,OldSelected,OldInner,NewInner,NewSelected). |
| 3268 | | |
| 3269 | | |
| 3270 | | % ----------------------- |
| 3271 | | % utility to expand / inline all let expressions and let predicates: |
| 3272 | | % useful for tools that cannot handle the lets |
| 3273 | | |
| 3274 | | expand_all_lets(Expr,NewExpr) :- |
| 3275 | | transform_bexpr(tl_expand_lets,Expr,NewExpr). |
| 3276 | | |
| 3277 | | tl_expand_lets(b(E,_,_),Res) :- tl_expand_lets2(E,Res). |
| 3278 | | tl_expand_lets2(let_expression(Ids,Exprs,Body),NewBody) :- % expand LET expression |
| 3279 | | replace_ids_by_exprs(Body,Ids,Exprs,NewBody). |
| 3280 | | tl_expand_lets2(let_predicate(Ids,Exprs,Body),NewBody) :- % expand LET predicate |
| 3281 | | replace_ids_by_exprs(Body,Ids,Exprs,NewBody). |
| 3282 | | |
| 3283 | | % ----------------------- |
| 3284 | | |
| 3285 | | :- public check_used_ids/2. |
| 3286 | | % a simple checker, only checks used_ids info fields for entire typed expression: |
| 3287 | | check_used_ids(TExpr,PP) :- %format('CHECK AST for ~w~n',[PP]), |
| 3288 | | map_over_typed_bexpr(check_used_ids_texpr_fail(PP),TExpr). |
| 3289 | | check_used_ids(_,_). |
| 3290 | | check_used_ids_texpr_fail(PP,E) :- check_used_ids_texpr(PP,E),!,fail. |
| 3291 | | check_used_ids_texpr(PP,b(P,T,I)) :- member(used_ids(UIds1),I),!, |
| 3292 | | (find_identifier_uses(b(P,T,I),[],UIds2) -> true |
| 3293 | | ; add_internal_error('find_identifier_uses failed',PP),fail), |
| 3294 | | (UIds1==UIds2 -> true |
| 3295 | | ; format('*** Wrong used_ids Info (~w)!!~n Used_ids: ~w~n Comp_ids: ~w~n',[PP,UIds1,UIds2]), |
| 3296 | | translate:print_bexpr(b(P,T,I)),nl, |
| 3297 | | add_error(check_used_ids,'Wrong used_ids: ',PP,I) |
| 3298 | | ). |
| 3299 | | check_used_ids_texpr(_,_). |
| 3300 | | |
| 3301 | | % repair any broken used_ids info in typed expression TExpr and re-compute used_ids if necessary |
| 3302 | | % PP is a program point, will be reported in case of an error |
| 3303 | | repair_used_ids(PP,TExpr,Res) :- |
| 3304 | | (transform_bexpr(bsyntaxtree:repair_used_ids_info(PP),TExpr,NewTExpr) -> Res=NewTExpr |
| 3305 | | ; add_internal_error('Repairing used_ids failed:',PP), |
| 3306 | | Res=TExpr). |
| 3307 | | |
| 3308 | | % we could also simply call recompute_used_ids_inf; but it would not generate any messages |
| 3309 | | repair_used_ids_info(PP,b(P,T,I),b(P,T,NI)) :- %functor(P,FF,_), print(repair(FF)),nl, |
| 3310 | | select(used_ids(OldUsed),I,I2),!, |
| 3311 | | (find_identifier_uses(b(P,T,I),[],NewUsed) |
| 3312 | | -> (NewUsed=OldUsed -> NI=I |
| 3313 | | ; NI = [used_ids(NewUsed)|I2], |
| 3314 | | add_message(repair_used_ids,'Updating used_ids for: ',b(P,T,I),I2) |
| 3315 | | ) |
| 3316 | | ; add_internal_error('find_identifier_uses failed',PP), |
| 3317 | | NI=I |
| 3318 | | ). |
| 3319 | | repair_used_ids_info(PP,b(P,T,I),b(P,T,NI)) :- |
| 3320 | | requires_used_ids(P), |
| 3321 | | (find_identifier_uses(b(P,T,I),[],NewUsed) -> true |
| 3322 | | ; add_internal_error('find_identifier_uses failed',PP),fail |
| 3323 | | ), |
| 3324 | | !, |
| 3325 | | NI=[used_ids(NewUsed)|I]. |
| 3326 | | repair_used_ids_info(_,B,B). |
| 3327 | | |
| 3328 | | requires_used_ids(exists(_,_)). |
| 3329 | | requires_used_ids(forall(_,_,_)). |
| 3330 | | |
| 3331 | | % a simple checker to see if an AST is well-formed: |
| 3332 | | % can be tested e.g. as follows: b_get_invariant_from_machine(I), check_ast(I). |
| 3333 | | % called in prob_safe_mode by clean_up_section |
| 3334 | | |
| 3335 | | check_ast(TE) :- check_ast(false,TE). |
| 3336 | | check_ast(AllowVars,TExpr) :- %nl,print('CHECK AST'),nl, |
| 3337 | | map_over_typed_bexpr(check_ast_texpr(AllowVars),TExpr). |
| 3338 | | check_ast(_,_). |
| 3339 | | |
| 3340 | | :- use_module(typing_tools,[valid_ground_type/1]). |
| 3341 | | %check_ast_texpr(X) :- print(check(X)),nl,fail. |
| 3342 | | check_ast_texpr(AllowVars,AST) :- AST = b(E,Type,Infos), |
| 3343 | | (debug:debug_level_active_for(9) -> write(' check_ast: '),print_bexpr(AST), write(' :: '), write(Type), nl ; true), |
| 3344 | | (check_expr(E,Type,Infos) -> true |
| 3345 | | ; add_error(check_ast_texpr,'Invalid Expr: ', AST) %, trace, check_expr(E,Type,Infos) |
| 3346 | | ), |
| 3347 | | (check_type(Type,AllowVars) -> true |
| 3348 | | ; add_error(check_ast_texpr,'Invalid Type for: ',AST,Infos)), |
| 3349 | | safe_functor(E,F), |
| 3350 | | check_ast_typing(E,Type,Infos), |
| 3351 | | (check_infos(Infos,F) -> true ; add_error(check_ast_texpr,'Invalid Infos: ',AST)), |
| 3352 | | check_special_rules(E,Type,Infos), |
| 3353 | | fail. % to force backtracking in map_over_typed_bexpr |
| 3354 | | |
| 3355 | | |
| 3356 | | check_special_rules(operation_call_in_expr(Operation,_),_,OInfos) :- !, |
| 3357 | | get_texpr_info(Operation,Info), % reads info important for used_ids computation |
| 3358 | | (memberchk(reads(_V),Info) -> true |
| 3359 | | ; add_error(check_ast_texpr,'Missing reads info: ',Operation,OInfos)). |
| 3360 | | |
| 3361 | | |
| 3362 | | safe_functor(V,R) :- var(V),!,R='$VAR'. |
| 3363 | | safe_functor(E,F/N) :- functor(E,F,N). |
| 3364 | | |
| 3365 | | % check whether the type term is ok |
| 3366 | | check_type(X,AllowVars) :- var(X),!, |
| 3367 | | (AllowVars==true -> true ; add_error(check_type,'Variable type: ',X),fail). |
| 3368 | | check_type(pred,_) :- !. |
| 3369 | | check_type(subst,_) :- !. |
| 3370 | | check_type(op(Paras,Returns),AllowVars) :- !, |
| 3371 | | maplist(check_normal_type(AllowVars),Paras), |
| 3372 | | maplist(check_normal_type(AllowVars),Returns). |
| 3373 | | check_type(T,AllowVars) :- check_normal_type(AllowVars,T). |
| 3374 | | |
| 3375 | | check_normal_type(AllowVars,T) :- |
| 3376 | | (AllowVars \== true -> valid_ground_type(T) |
| 3377 | | ; ground(T) -> valid_ground_type(T) |
| 3378 | | ; true). % TO DO: call valid_ground_type but pass AllowVars |
| 3379 | | |
| 3380 | | :- use_module(probsrc(btypechecker), [lookup_type_for_expr/2, unify_types_werrors/4]). |
| 3381 | | % check whether type is compatible with operators |
| 3382 | | check_ast_typing(member(A,B),Type,Pos) :- !, |
| 3383 | | get_texpr_type(B,TB), check_set_type(TB,member,Pos), |
| 3384 | | check_type(Type,pred,member), |
| 3385 | | get_texpr_type(A,TA), |
| 3386 | | unify_types_werrors(set(TA),TB,Pos,member). |
| 3387 | | check_ast_typing(not_equal(A,B),Type,Pos) :- !, check_ast_typing(equal(A,B),Type,Pos). |
| 3388 | | check_ast_typing(equal(A,B),Type,Pos) :- !, |
| 3389 | | get_texpr_type(B,TB), |
| 3390 | | get_texpr_type(A,TA), |
| 3391 | | unify_types_werrors(TA,TB,Pos,'='), |
| 3392 | | (non_value_type(TA) |
| 3393 | | -> add_error(check_ast_typing,'Binary predicate has to have values as arguments:',TA,Pos) |
| 3394 | | ; Type=pred -> true |
| 3395 | | ; add_error(check_ast_typing,'Illegal type for binary predicate:',Type,Pos) |
| 3396 | | ). |
| 3397 | | check_ast_typing(greater_equal(A,B),Type,_) :- !, |
| 3398 | | get_texpr_type(A,TA),check_type(TA,integer,greater_equal), |
| 3399 | | get_texpr_type(B,TB),check_type(TB,integer,greater_equal), check_type(Type,pred,member). |
| 3400 | | check_ast_typing(Expr,Type,Pos) :- |
| 3401 | | syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr), |
| 3402 | | check_names(Names,Pos), |
| 3403 | | (lookup_type(NewExpr,T) -> true |
| 3404 | | ; add_warning(check_ast_typing,'Unable to lookup type for: ',NewExpr), |
| 3405 | | fail |
| 3406 | | ), |
| 3407 | | !, |
| 3408 | | (unify_types_werrors(Type,T,Pos,'check_ast') |
| 3409 | | -> maplist(check_sub_type(Expr,Pos),Subs,NSubs) |
| 3410 | | ; add_error(check_ast_typing,'Type mismatch for expression:',Expr,Pos) |
| 3411 | | ). |
| 3412 | | check_ast_typing(_,subst,_) :- !. % ignore subst for the moment |
| 3413 | | check_ast_typing(operation(_TName,_Res,_Params,_TBody),_,_) :- !. % ignore operations for the moment |
| 3414 | | check_ast_typing(Expr,_,Pos) :- |
| 3415 | | syntaxtransformation(Expr,_,_Names,_,_NewExpr),!, |
| 3416 | | add_message(check_ast_typing,'Cannot lookup type for expression: ',Expr,Pos). |
| 3417 | | check_ast_typing(Expr,_,Pos) :- |
| 3418 | | add_message(check_ast_typing,'No applicable type rule for expression: ',Expr,Pos). |
| 3419 | | |
| 3420 | | non_value_type(X) :- var(X),!,fail. |
| 3421 | | non_value_type(pred). |
| 3422 | | non_value_type(subst). |
| 3423 | | non_value_type(op(_)). |
| 3424 | | |
| 3425 | | |
| 3426 | | check_names([],_). |
| 3427 | | check_names([H|T],Pos) :- |
| 3428 | | (member(H,T) -> add_error(check_ast_name,'Duplicate name:',H,Pos) ; check_names(T,Pos)). |
| 3429 | | |
| 3430 | | check_sub_type(OuterExpr,Pos,Arg,Type) :- get_texpr_type(Arg,T),!, |
| 3431 | | (unify_types_werrors(Type,T,Pos,'check_sub_type') -> true |
| 3432 | | ; add_error(check_ast_typing,'Type mismatch for sub-expression:',Arg,Pos), |
| 3433 | | write('Outer expression: '),translate:print_bexpr(OuterExpr),nl, |
| 3434 | | write('Outer type: '),write(Type),nl, |
| 3435 | | write('Arg type: '),write(T),nl,print(type(T)),nl, tools_printing:print_term_summary(Arg),nl,trace |
| 3436 | | ). |
| 3437 | | check_sub_type(_,Pos,Arg,_) :- |
| 3438 | | add_error(check_ast_typing,'Cannot extract type: ',Arg,Pos). |
| 3439 | | |
| 3440 | | lookup_type(identifier(_),_) :- !. % ignore typing issues for identifiers |
| 3441 | | lookup_type(Expr,Type) :- lookup_type_for_expr(Expr,Type). |
| 3442 | | |
| 3443 | | check_set_type(Var,_,_) :- var(Var),!. |
| 3444 | | check_set_type(set(_),_,_) :- !. |
| 3445 | | check_set_type(seq(_),_,_) :- !. |
| 3446 | | check_set_type(Type,Func,Pos) :- add_error(check_ast_typing,'Invalid type for operator: ',Func:Type,Pos). |
| 3447 | | |
| 3448 | | check_type(Type,Type,_) :- !. |
| 3449 | | check_type(Type,_,Func) :- add_error(check_ast_typing,'Unexpected type for operator: ',Func:Type). |
| 3450 | | |
| 3451 | | check_infos(X,F) :- var(X),!, add_error(check_infos,'Info field list not terminated: ',F:X),fail. |
| 3452 | | check_infos([],_). |
| 3453 | | check_infos([H|_],F) :- \+ ground(H),!, add_error(check_infos,'Info field not ground: ',F:H),fail. |
| 3454 | | check_infos([[H|T]|_],F) :- !, add_error(check_infos,'Info field contains nested list: ',F:[H|T]),fail. |
| 3455 | | check_infos([cse_used_ids(H)|T],F) :- member(cse_used_ids(H2),T),!, |
| 3456 | | add_error(check_infos,'Multiple cse_used_ids entries: ',F:[H,H2]),fail. |
| 3457 | | check_infos([used_ids(H)|T],F) :- member(used_ids(H2),T),!, |
| 3458 | | add_error(check_infos,'Multiple used_ids entries: ',F:[H,H2]),fail. |
| 3459 | | check_infos([nodeid(N1)|T],F) :- member(nodeid(N2),T),!, |
| 3460 | | add_error(check_infos,'Multiple nodeid entries: ',F:[N1,N2],[nodeid(N1)]),fail. |
| 3461 | | check_infos([removed_typing|T],F) :- member(removed_typing,T),!, |
| 3462 | | add_error(check_infos,'Multiple removed_typing entries: ',F,T),fail. |
| 3463 | | check_infos([_|T],F) :- check_infos(T,F). |
| 3464 | | |
| 3465 | | check_expr(Expr,Type,Infos) :- nonmember(contains_wd_condition,Infos), |
| 3466 | | sub_expression_contains_wd_condition(Expr,Sub), |
| 3467 | | TE = b(Expr,Type,Infos), |
| 3468 | | (Type = subst |
| 3469 | | -> fail % AST cleanup is not called for substitutions; WD-info not available for substitutions at the moment |
| 3470 | | ; translate_bexpression(TE,PS)), |
| 3471 | | functor(Expr,Functor,_), |
| 3472 | | functor(Sub,SubFunctor,_), |
| 3473 | | tools:ajoin(['Node for AST node ',Functor,' does not contain WD info from Subexpression ',SubFunctor,' :'],Msg), |
| 3474 | | add_warning(check_expr,Msg,PS,TE). |
| 3475 | | % well_def_analyser:nested_print_wd_bexpr(TE),nl. |
| 3476 | | % TODO: check when we have an unnecessary WD condition |
| 3477 | | check_expr(Expr,Type,Infos) :- nonmember(contains_wd_condition,Infos), |
| 3478 | | always_not_wd_top(Expr), |
| 3479 | | add_warning(check_expr,'AST is not well-defined but does not contain WD info: ',b(Expr,Type,Infos),Infos). |
| 3480 | | check_expr(member(LHS,RHS),Type,Infos) :- is_just_type(RHS), |
| 3481 | | get_preference(optimize_ast,true), |
| 3482 | | !, |
| 3483 | | TE = b(member(LHS,RHS),Type,Infos), |
| 3484 | | translate:translate_bexpression(TE,PS), |
| 3485 | | add_warning(check_expr,'AST contains redundant typing predicate: ',PS,TE). |
| 3486 | | check_expr(identifier(ID),_,_) :- illegal_id(ID),!, |
| 3487 | | add_error(check_infos,'Illegal identifier: ', identifier(ID)). |
| 3488 | | check_expr(lazy_lookup_expr(ID),_,_) :- illegal_id(ID),!, |
| 3489 | | add_error(check_infos,'Illegal identifier: ', lazy_lookup_expr(ID)). |
| 3490 | | check_expr(lazy_lookup_pred(ID),_,_) :- illegal_id(ID),!, |
| 3491 | | add_error(check_infos,'Illegal identifier: ', lazy_lookup_pred(ID)). |
| 3492 | | check_expr(exists(Parameters,Condition),pred,Infos) :- !, |
| 3493 | | check_used_ids(exists,Parameters,Condition,Infos,_Used). |
| 3494 | | check_expr(forall(Parameters,LHS,RHS),pred,Infos) :- !, |
| 3495 | | create_implication(LHS,RHS,Condition), |
| 3496 | | check_used_ids(forall,Parameters,Condition,Infos,_Used). % |
| 3497 | | check_expr(value(V),Type,_) :- !, check_bvalue(V,Type). |
| 3498 | | check_expr(_,_,_). |
| 3499 | | |
| 3500 | | % will check all used_ids fields (not just for exists and forall) |
| 3501 | | :- public check_used_ids_in_ast/1. |
| 3502 | | check_used_ids_in_ast(closure(_,_,TExpr)) :- !, (map_over_typed_bexpr(check_used_ids_aux,TExpr) ; true). |
| 3503 | | check_used_ids_in_ast(TExpr) :- map_over_typed_bexpr(check_used_ids_aux,TExpr). |
| 3504 | | check_used_ids_in_ast(_). |
| 3505 | | |
| 3506 | | check_used_ids_aux(AST) :- AST = b(_,_,Infos), |
| 3507 | | member(used_ids(_),Infos),!, |
| 3508 | | find_identifier_uses_if_necessary(AST,[],_), % will perform check |
| 3509 | | fail. |
| 3510 | | |
| 3511 | | % -------------------- |
| 3512 | | |
| 3513 | | :- use_module(specfile,[eventb_mode/0, z_or_tla_minor_mode/0]). |
| 3514 | | % check if an expression is definitely not WD; looking at the top-level operator only |
| 3515 | | always_not_wd_top(function(X,_)) :- definitely_empty_set(X). % TODO: detect a few more cases, e.g., arg not in dom |
| 3516 | | always_not_wd_top(power_of(X,Y)) :- (get_integer(Y,VY), VY < 0 -> true |
| 3517 | | ; eventb_mode, get_integer(X,VX), VX < 0). |
| 3518 | | always_not_wd_top(div(_,Val)) :- get_integer(Val,VV), VV==0. |
| 3519 | | always_not_wd_top(modulo(X,Y)) :- |
| 3520 | | (get_integer(Y,VY), VY=<0 |
| 3521 | | -> true % there seems to be a def for Z in Z Live, cf modulo2 |
| 3522 | | ; get_integer(X,VX), VX<0, \+ z_or_tla_minor_mode). |
| 3523 | | always_not_wd_top(min(X)) :- definitely_empty_set(X). |
| 3524 | | always_not_wd_top(max(X)) :- definitely_empty_set(X). |
| 3525 | | always_not_wd_top(size(X)) :- definitely_not_sequence(X). % TODO: detect infinite sets; also for card(_) |
| 3526 | | always_not_wd_top(first(X)) :- definitely_not_non_empty_sequence(X). |
| 3527 | | always_not_wd_top(front(X)) :- definitely_not_non_empty_sequence(X). |
| 3528 | | always_not_wd_top(last(X)) :- definitely_not_non_empty_sequence(X). |
| 3529 | | always_not_wd_top(tail(X)) :- definitely_not_non_empty_sequence(X). |
| 3530 | | always_not_wd_top(general_intersection(X)) :- definitely_empty_set(X). |
| 3531 | | |
| 3532 | | definitely_not_non_empty_sequence(X) :- |
| 3533 | | (definitely_empty_set(X) -> true ; definitely_not_sequence(X)). |
| 3534 | | |
| 3535 | | :- use_module(avl_tools,[avl_min_pair/3]). |
| 3536 | | definitely_not_sequence(b(value(A),_,_)) :- nonvar(A), A=avl_set(AVL), |
| 3537 | | avl_min_pair(AVL,int(StartIndex),_), StartIndex \= 1. |
| 3538 | | % TODO: treat set_extension |
| 3539 | | |
| 3540 | | :- use_module(b_ast_cleanup,[check_used_ids_info/4]). |
| 3541 | | check_used_ids(Quantifier,Parameters,Condition,Infos,Used) :- |
| 3542 | | select(used_ids(Used),Infos,Rest) |
| 3543 | | -> check_used_ids_info(Parameters,Condition,Used,Quantifier), %% comment in to check used_ids field |
| 3544 | | (member(used_ids(_),Rest) |
| 3545 | | -> add_internal_error('Multiple used_ids info fields:',Parameters:Infos) ; true) |
| 3546 | | ; |
| 3547 | | add_internal_error( |
| 3548 | | 'Expected information of used identifiers information',Quantifier:Parameters:Infos). |
| 3549 | | |
| 3550 | | illegal_id(ID) :- var(ID),!. |
| 3551 | | illegal_id(op(ID)) :- !, \+ atom(ID). |
| 3552 | | illegal_id(ID) :- \+ atom(ID). |
| 3553 | | |
| 3554 | | :- use_module(btypechecker, [unify_types_strict/2, couplise_list/2]). |
| 3555 | | :- use_module(avl_tools,[check_is_non_empty_avl/1]). |
| 3556 | | % TO DO: we could check type more |
| 3557 | | check_bvalue(V,_) :- var(V),!. |
| 3558 | | check_bvalue(avl_set(A),Type) :- !, unify_types_strict(Type,set(_)), |
| 3559 | | check_is_non_empty_avl(A). |
| 3560 | | check_bvalue(closure(_,T,B),Type) :- !, |
| 3561 | | couplise_list(T,CT), unify_types_strict(set(CT),Type), |
| 3562 | | check_ast(B). |
| 3563 | | check_bvalue(_,_). |
| 3564 | | |
| 3565 | | % ----------------------- |
| 3566 | | |
| 3567 | | |
| 3568 | | indent_ws(X) :- X<1,!. |
| 3569 | | indent_ws(X) :- print(' '), X1 is X-1, indent_ws(X1). |
| 3570 | | |
| 3571 | | print_ast_td(b(E,T,I),Level,L1) :- |
| 3572 | | indent_ws(Level), |
| 3573 | | (E=identifier(_) |
| 3574 | | -> format('~w (~w) -> ~w~n',[E,T,I]) |
| 3575 | | ; functor(E,F,N), |
| 3576 | | format('~w/~w (~w) -> ~w~n',[F,N,T,I]) |
| 3577 | | ), |
| 3578 | | L1 is Level+1. |
| 3579 | | print_ast(TExpr) :- |
| 3580 | | (map_over_typed_bexpr_top_down_acc(print_ast_td,TExpr,0),fail ; true). |
| 3581 | | |
| 3582 | | % --------------------- |
| 3583 | | |
| 3584 | | :- dynamic count_id_usage/2. |
| 3585 | | single_usage_id_count(Expr) :- uses_an_identifier(Expr,Id), |
| 3586 | | retract(count_id_usage(Id,Count)), |
| 3587 | | !, |
| 3588 | | Count=0, |
| 3589 | | C1 is Count+1, |
| 3590 | | assertz(count_id_usage(Id,C1)). |
| 3591 | | single_usage_id_count(_). |
| 3592 | | |
| 3593 | | % check if an identifier is used at most once |
| 3594 | | single_usage_identifier(ID,ExprOrPredicates,Count) :- |
| 3595 | | retractall(count_id_usage(_,_)), |
| 3596 | | assertz(count_id_usage(ID,0)), |
| 3597 | | % TO DO: take care of naming; do not count occurences when we enter scope defining ID |
| 3598 | | maplist(single_usage_cnt,ExprOrPredicates), |
| 3599 | | retract(count_id_usage(ID,Count)). |
| 3600 | | |
| 3601 | | single_usage_cnt(ExprOrPredicate) :- map_over_full_bexpr_no_fail(single_usage_id_count,ExprOrPredicate). |
| 3602 | | |
| 3603 | | gen_fresh_id_if_necessary(Default,Expr,FreshID) :- |
| 3604 | | occurs_in_expr(Default,Expr),!, |
| 3605 | | gensym('__FRESH_ID__',FreshID). % assumes _Fresh_XXX not used |
| 3606 | | gen_fresh_id_if_necessary(Default,_,Default). |
| 3607 | | |
| 3608 | | %% rewrite_if_then_else_expr_to_b(IfThenElseExpr, NExpr). |
| 3609 | | % Rewrite if-then-else expr to B as understood by Atelier-B. |
| 3610 | | % {d,x| d:BOOL & If => x=Then & not(if) => x=Else}(TRUE) |
| 3611 | | rewrite_if_then_else_expr_to_b(if_then_else(If,Then,Else), NExpr) :- |
| 3612 | | get_texpr_type(Then,Type), |
| 3613 | | ARG = b(boolean_true,boolean,[]), AT=boolean, % we could use unit type or BOOL here |
| 3614 | | gen_fresh_id_if_necessary('_zzzz_unary',b(if_then_else(If,Then,Else),Type,[]),AID1), |
| 3615 | | gen_fresh_id_if_necessary('_zzzz_binary',b(if_then_else(If,Then,Else),Type,[]),AID2), |
| 3616 | | safe_create_texpr(identifier(AID1), AT, [], Id1), % a dummy argument |
| 3617 | | safe_create_texpr(identifier(AID2), Type, [], Id2), % The result |
| 3618 | | safe_create_texpr(equal(Id2,Then), pred, [], Eq1), |
| 3619 | | safe_create_texpr(equal(Id2,Else), pred, [], Eq2), |
| 3620 | | safe_create_texpr(implication(If,Eq1), pred, [], Pred1), |
| 3621 | | safe_create_texpr(negation(If), pred, [], NIf), |
| 3622 | | safe_create_texpr(implication(NIf,Eq2), pred, [], Pred2), |
| 3623 | | safe_create_texpr(conjunct(Pred1,Pred2), pred, [], Pred), |
| 3624 | | safe_create_texpr(comprehension_set([Id1,Id2],Pred), set(couple(AT,Type)), [], FUN), |
| 3625 | | NExpr = function(FUN,ARG). |
| 3626 | | |
| 3627 | | |
| 3628 | | % -------------------- |
| 3629 | | |
| 3630 | | % apply normalisation rules from Atlier-B PP/ML provers |
| 3631 | | % see chapter 3 of Atelier-B prover manual |
| 3632 | | |
| 3633 | | normalise_bexpr_for_ml(TExpr,Res) :- |
| 3634 | | transform_bexpr(normalise_bexpr,TExpr,Res). |
| 3635 | | |
| 3636 | | normalise_bexpr(b(E,T,I),b(E2,T,I)) :- norm2(E,E2),!. |
| 3637 | | |
| 3638 | | norm2(equivalence(A,B),conjunct(TIMP1,TIMP2)) :- !, |
| 3639 | | safe_create_texpr(implication(A,B),pred,TIMP1), |
| 3640 | | safe_create_texpr(implication(B,A),pred,TIMP2). |
| 3641 | | norm2(subset_strict(A,B),conjunct(TMEM,TNEQ)) :- !, |
| 3642 | | norm2(subset(A,B),MEM), safe_create_texpr(MEM,pred,TMEM), |
| 3643 | | safe_create_not_equal(A,B,TNEQ). |
| 3644 | | norm2(subset(A,B),member(A,PowB)) :- !, % A <: B <===> A:POW(B) |
| 3645 | | get_texpr_type(A,TA), |
| 3646 | | safe_create_texpr(pow_subset(B),TA,PowB). |
| 3647 | | norm2(not_equal(A,B),negation(TEQ)) :- !, |
| 3648 | | safe_create_texpr(equal(A,B),pred,TEQ). |
| 3649 | | norm2(not_member(A,B),negation(TMEM)) :- !, |
| 3650 | | safe_create_texpr(member(A,B),pred,TMEM). |
| 3651 | | norm2(not_subset(A,B),negation(TMEM)) :- !, |
| 3652 | | norm2(subset(A,B),MEM),safe_create_texpr(MEM,pred,TMEM). |
| 3653 | | norm2(not_subset_strict(A,B),implication(TMEM,TEQ)) :- !, % A /<< : B <===> A:POW(B) => A=B |
| 3654 | | norm2(subset(A,B),MEM),safe_create_texpr(MEM,pred,TMEM), |
| 3655 | | safe_create_texpr(equal(A,B),pred,TEQ). |
| 3656 | | norm2(POW1,set_subtraction(TPOW,TSEMPTY)) :- not_empty_pow(POW1,A,POW), !, |
| 3657 | | % POW1(A) <===> POW(A) - {{}}, FIN1(A) <===> FIN(A) - {{}}, ... |
| 3658 | | safe_create_texpr(POW,pred,TPOW), |
| 3659 | | get_texpr_type(A,TA), TEMPTY = b(empty_set,TA,[]), |
| 3660 | | safe_create_texpr(set_extension([TEMPTY]),set(TA),TSEMPTY). |
| 3661 | | norm2(member(A,b(integer_set('NATURAL'),_,_)),conjunct(TMEM,TLEQ)) :- !, % A <: NATURAL <===> A:INTEGER & 0 <= A |
| 3662 | | INTEGER = b(integer_set('INTEGER'),set(integer),[]), |
| 3663 | | safe_create_texpr(member(A,INTEGER),pred,TMEM), |
| 3664 | | Zero = b(integer(0),integer,[]), |
| 3665 | | safe_create_texpr(less_equal(Zero,A),pred,TLEQ). |
| 3666 | | norm2(set_extension(List),Union) :- List = [H|T], T=[_|_], !, % {A,B} <===> {A} \/ {B} |
| 3667 | | get_texpr_type(H,Type), |
| 3668 | | set_extension_to_union(H,T,set(Type),b(Union,_,_)). |
| 3669 | | norm2(greater_equal(A,B),less_equal(B,A)) :- !. |
| 3670 | | norm2(greater(A,B),less_equal(B1,A)) :- !, plus1(B,B1). |
| 3671 | | norm2(less(A,B),less_equal(A,B1)) :- !, minus1(B,B1). % the normalisation rule in chapter 3 is actually false |
| 3672 | | norm2(integer_set(NAT1),set_subtraction(TNAT,TSZero)) :- nat1(NAT1,NAT), !, % NATURAL1 <===> NATURAL - {0} |
| 3673 | | TNAT = b(integer_set(NAT),set(integer),[]), |
| 3674 | | set_with_zero(TSZero). |
| 3675 | | norm2(empty_sequence,empty_set) :- !. |
| 3676 | | norm2(perm(A),intersection(ISEQ,PSURJ)) :- !, % perm(A) <===> iseq(A) /\ (NATURAL-{0} +->> A) |
| 3677 | | get_texpr_type(A,TA), |
| 3678 | | safe_create_texpr(iseq(A),set(seq(TA)),ISEQ), |
| 3679 | | set_with_zero(TSZero), |
| 3680 | | NATURAL = b(integer_set('NATURAL'),set(integer),[]), |
| 3681 | | safe_create_texpr(set_subtraction(NATURAL,TSZero),set(integer),DOM), |
| 3682 | | safe_create_texpr(partial_surjection(DOM,A),set(seq(TA)),PSURJ). |
| 3683 | | % TODO: total_relation, if_then_else, ...? |
| 3684 | | |
| 3685 | | set_with_zero(TSZero) :- % {0} |
| 3686 | | TZero = b(integer(0),TA,[]), |
| 3687 | | safe_create_texpr(set_extension([TZero]),set(TA),TSZero). |
| 3688 | | |
| 3689 | | % TODO: more intelligent versions like x-1 ==> x ... |
| 3690 | | plus1(A,Plus1) :- One = b(integer(1),integer,[]), |
| 3691 | | safe_create_texpr(add(A,One),integer,Plus1). |
| 3692 | | minus1(A,Plus1) :- One = b(integer(1),integer,[]), |
| 3693 | | safe_create_texpr(minus(A,One),integer,Plus1). |
| 3694 | | |
| 3695 | | not_empty_pow(pow1_subset(A),A,pow_subset(A)). |
| 3696 | | not_empty_pow(fin1_subset(A),A,fin_subset(A)). |
| 3697 | | not_empty_pow(seq1(A),A,seq(A)). |
| 3698 | | not_empty_pow(iseq1(A),A,iseq(A)). |
| 3699 | | |
| 3700 | | nat1('NATURAL1','NATURAL'). |
| 3701 | | nat1('NAT1','NAT'). |
| 3702 | | |
| 3703 | | safe_create_not_equal(A,B,TNEQ) :- |
| 3704 | | safe_create_texpr(equal(A,B),pred,TEQ), |
| 3705 | | safe_create_texpr(negation(TEQ),pred,TNEQ). |
| 3706 | | |
| 3707 | | set_extension_to_union(H,[],Type,Res) :- !, |
| 3708 | | safe_create_texpr(set_extension([H]),Type,Res). |
| 3709 | | set_extension_to_union(H,[H2|T],Type,Res) :- |
| 3710 | | safe_create_texpr(set_extension([H]),Type,TH), |
| 3711 | | set_extension_to_union(H2,T,Type,TUnion), |
| 3712 | | safe_create_texpr(union(TH,TUnion),Type,Res). |