| 1 | % (c) 2015-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | ||
| 5 | :- module(model_translation, [translate_smt_model_to_b_values/4, | |
| 6 | store_explicit_set_unique_id/2, | |
| 7 | consistent_deferred_set_sizes/0, | |
| 8 | assert_virtual_deferred_set_id/2, | |
| 9 | clear_translation_state/0]). | |
| 10 | ||
| 11 | :- use_module(library(lists), [maplist/3,maplist/4, | |
| 12 | append/2,select/3,max_member/2]). | |
| 13 | :- use_module(library(avl)). | |
| 14 | :- use_module(library(codesio), [read_from_codes/2]). | |
| 15 | ||
| 16 | :- use_module(probsrc(preferences), [get_preference/2]). | |
| 17 | :- use_module(probsrc(b_ast_cleanup), [clean_up/3]). | |
| 18 | :- use_module(probsrc(translate), [translate_bvalue/2]). | |
| 19 | :- use_module(probsrc(tools), [arg_is_number/2,split_atom/3,atom_to_number/2,ajoin/2]). | |
| 20 | :- use_module(probsrc(tools_strings), [convert_to_number/2, atom_prefix/2]). | |
| 21 | :- use_module(probsrc(error_manager),[]). | |
| 22 | :- use_module(probsrc(tools),[]). | |
| 23 | :- use_module(probsrc(error_manager), [add_error/3,add_error/4, | |
| 24 | add_internal_error/2,add_error_fail/3,check_error_occured/2]). | |
| 25 | :- use_module(probsrc(bsyntaxtree), [safe_create_texpr/3, | |
| 26 | create_texpr/4, | |
| 27 | unique_typed_id/3, | |
| 28 | create_equality/3, | |
| 29 | conjunction_to_list/2, | |
| 30 | conjunct_predicates/2, | |
| 31 | disjunct_predicates/2, | |
| 32 | get_texpr_type/2, | |
| 33 | find_identifier_uses/3, | |
| 34 | create_negation/2]). | |
| 35 | :- use_module(probsrc(custom_explicit_sets), [try_expand_custom_set_to_list/4]). | |
| 36 | :- use_module(probsrc(b_global_sets), [b_global_deferred_set/1, b_global_set/1, b_type2_set/2, global_type/2, get_user_defined_scope/4, unfixed_deferred_set/1]). | |
| 37 | :- use_module(probsrc(b_interpreter),[b_test_boolean_expression_cs/5, b_compute_expression_nowf/6]). | |
| 38 | ||
| 39 | %:- use_module(probsrc(self_check), [assert_must_succeed/1]). | |
| 40 | ||
| 41 | :- use_module(solver_dispatcher). | |
| 42 | ||
| 43 | :- use_module(probsrc(module_information),[module_info/2]). | |
| 44 | :- module_info(group,smt_solvers). | |
| 45 | :- module_info(description,'This module translates the models found by an SMT-solvers to a ProB state.'). | |
| 46 | ||
| 47 | :- set_prolog_flag(double_quotes, codes). | |
| 48 | ||
| 49 | :- dynamic explicit_set_cache/2, fd_var_of_z3/2, virtual_deferred_set_id/2, linecount/1. | |
| 50 | ||
| 51 | clear_translation_state :- | |
| 52 | retractall(virtual_deferred_set_id(_,_)), | |
| 53 | retractall(fd_var_of_z3(_,_)), | |
| 54 | retractall(explicit_set_cache(_, _)). | |
| 55 | ||
| 56 | assert_virtual_deferred_set_id(EnumElm, FdVar) :- | |
| 57 | asserta(virtual_deferred_set_id(EnumElm, FdVar)). | |
| 58 | ||
| 59 | % Store explicit sets for universally quantified translations to prevent vanishing type information | |
| 60 | % when translating universal quantifiers from SMT-Lib to B (e.g., for general_intersection). | |
| 61 | store_explicit_set_unique_id(SetAst, UniqueIdName) :- | |
| 62 | get_texpr_type(SetAst, Type), | |
| 63 | unique_typed_id("inner_set", Type, UniqueId), | |
| 64 | UniqueId = b(identifier(UniqueIdName),_,_), | |
| 65 | asserta(explicit_set_cache(UniqueIdName, SetAst)). | |
| 66 | ||
| 67 | %% consistent_deferred_set_sizes. | |
| 68 | % We collect all global FD variables during the translation of a model found by Z3 to | |
| 69 | % check if the considered deferred set size (maximum of all global FD variables) is smaller | |
| 70 | % than the value considered by ProB (preference DEFAULT_SETSIZE). | |
| 71 | % If such models are refuted, Z3 behaves as ProB. | |
| 72 | % Otherwise, we might translate a solution using less global FD variables than defined by ProB. | |
| 73 | consistent_deferred_set_sizes :- | |
| 74 | findall(DS, (b_global_deferred_set(DS), unfixed_deferred_set(DS)), DeferredSets), | |
| 75 | consistent_deferred_set_sizes(DeferredSets). | |
| 76 | ||
| 77 | %% consistent_deferred_set_sizes(DeferredSets). | |
| 78 | consistent_deferred_set_sizes([]). | |
| 79 | consistent_deferred_set_sizes([DeferredSet|T]) :- | |
| 80 | findall(FdVarOfZ3, retract(fd_var_of_z3(DeferredSet,FdVarOfZ3)), FdVarsOfZ3), | |
| 81 | FdVarsOfZ3 \== [], | |
| 82 | !, | |
| 83 | max_member(MaxFdVarOfZ3, FdVarsOfZ3), | |
| 84 | ( get_user_defined_scope(DeferredSet,Low,Up,_Span) | |
| 85 | -> DeferredSetSize is 1+Up-Low | |
| 86 | ; get_preference(globalsets_fdrange, DeferredSetSize) | |
| 87 | ), | |
| 88 | % the case for MaxFdVarOfZ3 > DeferredSetSize is already handled in handle_globalsets_fdrange_contradiction | |
| 89 | MaxFdVarOfZ3 == DeferredSetSize, | |
| 90 | consistent_deferred_set_sizes(T). | |
| 91 | consistent_deferred_set_sizes([_|T]) :- | |
| 92 | % this deferred set is not part of the solution and can be ignored | |
| 93 | consistent_deferred_set_sizes(T). | |
| 94 | ||
| 95 | translate_smt_model_to_b_values(Solver,State,Identifiers,Bindings) :- | |
| 96 | get_full_model_as_avl(Solver,AVL), % parse it only once for all identifiers | |
| 97 | maplist(translate_smt_model_to_b_value(Solver,State,AVL),Identifiers,Bindings). | |
| 98 | ||
| 99 | translate_smt_model_to_b_value(Solver,State,FullModelAVL, | |
| 100 | b(identifier(Id),Type,_Infos),binding(Id,Value,PPValue)) :- | |
| 101 | member(id(Id,Expr),State), | |
| 102 | smt_solver_interface_call(Solver,get_model_string(Expr,String)), !, | |
| 103 | atom_codes(String,Codes), | |
| 104 | %format('Result of get_model_string:~n~s~n---~n',[Codes]), | |
| 105 | parse_lisp_style_expressions([E],Codes,[]), !, | |
| 106 | (Solver == cvc4 -> translate_cvc4_tree(E,Type,Value) ; | |
| 107 | Solver == z3 -> translate_z3_tree_for_id(Id,E,FullModelAVL,Type,Value) ; | |
| 108 | fail), | |
| 109 | ||
| 110 | (translate_bvalue(Value,PPValue) -> true ; PPValue='**pretty-print failed**'). | |
| 111 | ||
| 112 | translate_z3_tree_for_id(Id,EscapedId,_,Type,Result) :- | |
| 113 | % the id might have been escaped in z3 (e.g. due to ticks) | |
| 114 | ajoin(['|',Id,'|'],EscapedId), !, | |
| 115 | % variable is not assigned (hence z3 returns its name) | |
| 116 | % just ground it somehow | |
| 117 | z3_ground_result(Type,Result). | |
| 118 | translate_z3_tree_for_id(_,E,FullModelAVL,Type,Result) :- | |
| 119 | translate_z3_tree_and_check(E,FullModelAVL,Type,Result,translate_z3_tree4). | |
| 120 | ||
| 121 | ||
| 122 | translate_z3_record(Env, field(Name,BType), CVCVal, field(Name,BVal)) :- | |
| 123 | translate_z3_expr(CVCVal, Env, BType, BVal). | |
| 124 | ||
| 125 | % ----------------------------- | |
| 126 | ||
| 127 | % performs additional sanity check of computed values: | |
| 128 | translate_z3_tree_and_check(SingleVal,FullModelAVL,ReturnType,Value,PP) :- | |
| 129 | translate_z3_tree_aux(SingleVal,FullModelAVL,ReturnType,Value), | |
| 130 | check_value(ReturnType,Value,SingleVal,PP). | |
| 131 | ||
| 132 | translate_z3_tree_aux(Tree,FullModelAVL,boolean,Res) :- | |
| 133 | % Z3 might return a quantifier for Boolean values since version 4.12.0 | |
| 134 | !, | |
| 135 | translate_z3_predicate(Tree,env([],FullModelAVL),BPred), | |
| 136 | ( b_test_boolean_expression_cs(BPred, [], [],'translating Z3 Boolean value',0) | |
| 137 | -> Res = pred_true | |
| 138 | ; Res = pred_false | |
| 139 | ). | |
| 140 | translate_z3_tree_aux(Tree,FullModelAVL,Type,Res) :- | |
| 141 | translate_z3_expr(Tree,env([],FullModelAVL),Type,BExpr), | |
| 142 | b_compute_expression_nowf(BExpr,[],[],Res,'translating Z3 value',0). | |
| 143 | ||
| 144 | check_value(_,identifier(A),_,_) :- atom(A),!. | |
| 145 | check_value(integer,I,SV,PP) :- \+ (I=int(Nr), number(Nr)),!, | |
| 146 | add_internal_error('Illegal Z3 value, not number computed:', PP:SV:I), fail. | |
| 147 | check_value(boolean,B,SV,PP) :- B \= pred_true , B\= pred_false, !, | |
| 148 | add_internal_error('Illegal Z3 value, not boolean computed:', PP:SV:B), fail. | |
| 149 | check_value(_,_,_,_). | |
| 150 | ||
| 151 | %% get_typing_predicates(+BVars, -TypingPredList). | |
| 152 | % Create typing predicates for variables either from explicit_set_cache/2 | |
| 153 | % or more generally using generate_typing_predicates/2. | |
| 154 | get_typing_predicates(BVars, TypingPredList) :- | |
| 155 | get_typing_predicates(BVars, [], [], TypingPredList). | |
| 156 | ||
| 157 | get_typing_predicates([], NotCached, Acc, TypingPredList) :- | |
| 158 | translate:generate_typing_predicates(NotCached, TTypingPredList), | |
| 159 | append(Acc, TTypingPredList, TypingPredList). | |
| 160 | get_typing_predicates([BVar|T], NotCached, Acc, TypingPredList) :- | |
| 161 | BVar = b(identifier(IdName),_,_), | |
| 162 | explicit_set_cache(IdName, ExplicitSet), | |
| 163 | !, | |
| 164 | TypingPred = b(member(BVar,ExplicitSet),pred,[]), | |
| 165 | get_typing_predicates(T, NotCached, [TypingPred|Acc], TypingPredList). | |
| 166 | get_typing_predicates([BVar|T], NotCached, Acc, TypingPredList) :- | |
| 167 | get_typing_predicates(T, [BVar|NotCached], Acc, TypingPredList). | |
| 168 | ||
| 169 | is_global_type_variable_name(env(Ids,_), VarName, GlobalType) :- | |
| 170 | member(b(identifier(VarName),GlobalType,_), Ids), | |
| 171 | GlobalType = global(_). | |
| 172 | is_global_type_variable_name(_, VarName, global(Set)) :- | |
| 173 | split_atom(VarName, ['!'], [Set,_,_]), | |
| 174 | b_global_set(Set). | |
| 175 | ||
| 176 | % enumerated and deferred sets are translated as integers | |
| 177 | % we have to check for global types to identify integers as such, see e.g. (= 0 c) where c is a global type variable | |
| 178 | typecheck_for_global_type(Left, _, Env, Type) :- | |
| 179 | atom(Left), | |
| 180 | is_global_type_variable_name(Env, Left, GlobalType), | |
| 181 | !, | |
| 182 | Type = GlobalType. | |
| 183 | typecheck_for_global_type(_, Right, Env, Type) :- | |
| 184 | atom(Right), | |
| 185 | is_global_type_variable_name(Env, Right, GlobalType), | |
| 186 | !, | |
| 187 | Type = GlobalType. | |
| 188 | typecheck_for_global_type(_, _, _, _). % no global type; use a variable which is set afterwards | |
| 189 | ||
| 190 | % ------------------------------- | |
| 191 | ||
| 192 | % TODO: do we really need this function anymore: | |
| 193 | translate_z3_expr_using_full_model(Expr,Type,Result) :- | |
| 194 | get_full_model_as_avl(z3,AVL), | |
| 195 | translate_z3_expr(Expr,env([],AVL),Type,Result). | |
| 196 | ||
| 197 | get_full_model_as_avl(z3,AVL) :- !, | |
| 198 | % get and parse the full model | |
| 199 | smt_solver_interface_call(z3,get_full_model_string(FullModel)), | |
| 200 | %format('z3 full model:~n~w~n',[FullModel]), | |
| 201 | z3_model_to_avl(FullModel,AVL). | |
| 202 | get_full_model_as_avl(_,AVL) :- empty_avl(AVL). | |
| 203 | ||
| 204 | map_translate_z3_predicate([], _, Acc, Acc). | |
| 205 | map_translate_z3_predicate([Z3Pred|T], Env, Acc, Preds) :- | |
| 206 | translate_z3_predicate(Z3Pred, Env, Pred), | |
| 207 | map_translate_z3_predicate(T, Env, [Pred|Acc], Preds). | |
| 208 | ||
| 209 | translate_z3_quantified_vars([], _, Acc, Acc). | |
| 210 | translate_z3_quantified_vars([[Name,Type]|T], Env, Acc, Preds) :- | |
| 211 | z3_type_to_b_type(Type,BType), | |
| 212 | Id = b(identifier(Name),BType,[]), | |
| 213 | translate_z3_quantified_vars(T, Env, [Id|Acc], Preds). | |
| 214 | ||
| 215 | % translate a z3 predicate to a B AST predicate | |
| 216 | translate_z3_predicate([not,Left], Env, Res) :- | |
| 217 | !, | |
| 218 | translate_z3_predicate(Left, Env, TL), | |
| 219 | create_negation(TL,Res). | |
| 220 | translate_z3_predicate([ZOP|T], Env, Res) :- | |
| 221 | z3_connective_to_b(ZOP, BOP), | |
| 222 | !, | |
| 223 | translate_z3_connective(BOP, T, Env, Res). | |
| 224 | translate_z3_predicate([let,[[Id,Val]],Function], Env, Res) :- | |
| 225 | !, | |
| 226 | z3_replace_let_id_by_value(Id, Val, Function, NewFunction), | |
| 227 | translate_z3_predicate(NewFunction, Env, Res). | |
| 228 | translate_z3_predicate([let,[[Id,Val]|T],Function], Env, Res) :- | |
| 229 | !, | |
| 230 | T \== [], | |
| 231 | z3_replace_let_id_by_value(Id, Val, Function, NewFunction), | |
| 232 | translate_z3_predicate([let,T,NewFunction], Env, Res). | |
| 233 | translate_z3_predicate([=,Left,Right], Env, Res) :- | |
| 234 | !, | |
| 235 | typecheck_for_global_type(Left, Right, Env, Type), | |
| 236 | translate_z3_expr(Left, Env, Type, TL), | |
| 237 | translate_z3_expr(Right, Env, Type, TR), | |
| 238 | create_equality(TL,TR,Res). | |
| 239 | translate_z3_predicate([ZOP,Left,Right], Env, Res) :- | |
| 240 | z3_integer_comparison(ZOP, BOP), | |
| 241 | !, | |
| 242 | translate_z3_expr(Left, Env, IntegerOrReal, TL), | |
| 243 | translate_z3_expr(Right, Env, IntegerOrReal, TR), | |
| 244 | Pred =.. [BOP,TL,TR], | |
| 245 | safe_create_texpr(Pred,pred,Res). | |
| 246 | translate_z3_predicate([select,Array,Entry], Env, Res) :- | |
| 247 | !, | |
| 248 | translate_z3_expr(Array, Env, _, BSet), | |
| 249 | translate_z3_expr(Entry, Env, _, BEntry), | |
| 250 | Res = b(member(BEntry,BSet),pred,[]). | |
| 251 | translate_z3_predicate([exists,Vars,[Body]], Env, Res) :- | |
| 252 | translate_z3_quantified_vars(Vars, Env, [], BVars), | |
| 253 | Env = env(Ids,AVL), | |
| 254 | append(Ids, BVars, NewIds), | |
| 255 | translate_z3_predicate(Body, env(NewIds,AVL), BBody), | |
| 256 | !, | |
| 257 | find_identifier_uses(BBody, [], UsedIds), | |
| 258 | Res = b(exists(BVars,BBody),pred,[used_ids(UsedIds)]). | |
| 259 | translate_z3_predicate([exists,Vars,Body], Env, Res) :- | |
| 260 | translate_z3_quantified_vars(Vars, Env, [], BVars), | |
| 261 | Env = env(Ids,AVL), | |
| 262 | append(Ids, BVars, NewIds), | |
| 263 | translate_z3_predicate(Body, env(NewIds,AVL), BBody), | |
| 264 | !, | |
| 265 | find_identifier_uses(BBody, [], UsedIds), | |
| 266 | Res = b(exists(BVars,BBody),pred,[used_ids(UsedIds)]). | |
| 267 | translate_z3_predicate([forall,Vars,[Body]], Env, Res) :- | |
| 268 | translate_z3_quantified_vars(Vars, Env, [], BVars), | |
| 269 | Env = env(Ids,AVL), | |
| 270 | append(Ids, BVars, NewIds), | |
| 271 | translate_z3_predicate(Body, env(NewIds,AVL), BBody), | |
| 272 | !, | |
| 273 | find_identifier_uses(BBody, [], UsedIds), | |
| 274 | get_typing_predicates(BVars, TypingPredList), | |
| 275 | conjunct_predicates(TypingPredList, TypingPred), | |
| 276 | Res = b(forall(BVars,TypingPred,BBody),pred,[used_ids(UsedIds)]). | |
| 277 | translate_z3_predicate([forall,Vars,Body], Env, Res) :- | |
| 278 | translate_z3_quantified_vars(Vars, Env, [], BVars), | |
| 279 | Env = env(Ids,AVL), | |
| 280 | append(Ids, BVars, NewIds), | |
| 281 | translate_z3_predicate(Body, env(NewIds,AVL), BBody), | |
| 282 | !, | |
| 283 | find_identifier_uses(BBody, [], UsedIds), | |
| 284 | get_typing_predicates(BVars, TypingPredList), | |
| 285 | conjunct_predicates(TypingPredList, TypingPred), | |
| 286 | Res = b(forall(BVars,TypingPred,BBody),pred,[used_ids(UsedIds)]). | |
| 287 | translate_z3_predicate([ite, Test, Left, Right], Env, Res) :- !, | |
| 288 | translate_z3_predicate(Test,Env, BTest), | |
| 289 | translate_z3_predicate(Left, Env, BThen), | |
| 290 | translate_z3_predicate(Right,Env, BElse), | |
| 291 | safe_create_texpr(convert_bool(BThen),boolean,BThenBool), | |
| 292 | safe_create_texpr(convert_bool(BElse),boolean,BElseBool), | |
| 293 | safe_create_texpr(if_then_else(BTest,BThenBool,BElseBool),boolean,TRes), | |
| 294 | Res = b(equal(TRes,b(boolean_true,boolean,[])),pred,[]). | |
| 295 | translate_z3_predicate(In, Env, Res) :- | |
| 296 | translate_z3_expr(In, Env, boolean, TRes), | |
| 297 | !, | |
| 298 | % expr to pred | |
| 299 | Res = b(equal(TRes,b(boolean_true,boolean,[])),pred,[]). | |
| 300 | translate_z3_predicate(Pred,_,_) :- | |
| 301 | add_error_fail(translate_z3_predicate, 'Missing translation for Z3 predicate:', Pred). | |
| 302 | ||
| 303 | % see also smt_id_to_prob_id_preds in smtlib_solver | |
| 304 | z3_connective_to_b(and, conjunct). | |
| 305 | z3_connective_to_b(or, disjunct). | |
| 306 | z3_connective_to_b('=>', implication). | |
| 307 | ||
| 308 | % see also smt_id_to_prob_id in smtlib_solver | |
| 309 | z3_integer_comparison(<=, less_equal). | |
| 310 | z3_integer_comparison(<, less). | |
| 311 | z3_integer_comparison(>, greater). % not used ? | |
| 312 | z3_integer_comparison(>=, greater_equal). % not used ? | |
| 313 | ||
| 314 | %% create_nested_binary_expr(+BOP, +Env, +Type, +TypeA, +TypeB, Args, BExpr). | |
| 315 | % Z3 model might contain for instance [*,x,x,x] which needs to | |
| 316 | % be nested using binary operators in B. | |
| 317 | create_nested_binary_expr(BOP, Env, Type, TA, TB, [Arg1,Arg2|T], Expr) :- | |
| 318 | translate_z3_expr(Arg1, Env, TA, TArg1), | |
| 319 | get_texpr_type(TArg1, TA), | |
| 320 | translate_z3_expr(Arg2, Env, TB, TArg2), | |
| 321 | get_texpr_type(TArg2, TB), | |
| 322 | TExpr =.. [BOP,TArg1,TArg2], | |
| 323 | Acc = b(TExpr,Type,[]), | |
| 324 | create_nested_binary_expr(BOP, Env, Type, TA, TB, Acc, T, Expr). | |
| 325 | ||
| 326 | create_nested_binary_expr(_, _, _, _, _, Acc, [], Acc). | |
| 327 | create_nested_binary_expr(BOP, Env, Type, _, TB, Acc, [Arg], Expr) :- | |
| 328 | !, | |
| 329 | translate_z3_expr(Arg, Env, TB, TArg), | |
| 330 | TExpr =.. [BOP,Acc,TArg], | |
| 331 | Expr = b(TExpr,Type,[]). | |
| 332 | create_nested_binary_expr(BOP, Env, Type, TA, TB, Acc, [Arg|T], Expr) :- | |
| 333 | translate_z3_expr(Arg, Env, TA, TArg), | |
| 334 | TExpr =.. [BOP,Acc,TArg], | |
| 335 | NAcc = b(TExpr,Type,[]), | |
| 336 | create_nested_binary_expr(BOP, Env, Type, TA, TB, NAcc, T, Expr). | |
| 337 | ||
| 338 | map_translate_z3_expr([], _, Acc, Acc). | |
| 339 | map_translate_z3_expr([Z3Pred|T], Env, Acc, Preds) :- | |
| 340 | translate_z3_expr(Z3Pred, Env, _, Pred), | |
| 341 | map_translate_z3_expr(T, Env, [Pred|Acc], Preds). | |
| 342 | ||
| 343 | handle_globalsets_fdrange_contradiction(Z3sResNumber,Set) :- | |
| 344 | get_user_defined_scope(Set,Low,Up,Span),!, | |
| 345 | DeferredSetSize is 1+Up-Low, | |
| 346 | Z3sResNumber > DeferredSetSize, | |
| 347 | add_error(translate_z3_expr_globalsets_fdrange, | |
| 348 | 'Z3\'s solution contradicts the size set for the deferred set. Try to increase the set size by adapting the DEFINITION or -card command-line argument.', | |
| 349 | z3:Z3sResNumber:Set:DeferredSetSize,Span), | |
| 350 | fail. | |
| 351 | handle_globalsets_fdrange_contradiction(Z3sResNumber,_Set) :- | |
| 352 | get_preference(globalsets_fdrange, DeferredSetSize), | |
| 353 | ( Z3sResNumber > DeferredSetSize | |
| 354 | -> % Z3 does not consider globalsets_fdrange; its solution might contradict ProB's preference | |
| 355 | add_error_fail(translate_z3_expr_globalsets_fdrange, | |
| 356 | 'Z3\'s solution contradicts ProB\'s preference DEFAULT_SETSIZE. Try to increase the preference.', | |
| 357 | z3:Z3sResNumber:'DEFAULT_SETSIZE':DeferredSetSize) | |
| 358 | ; % this is any other bug and should not happen | |
| 359 | fail | |
| 360 | ). | |
| 361 | ||
| 362 | % translate a z3 expression to a B AST expression | |
| 363 | %translate_z3_expr(Pred,E,T,_) :- print(translate_z3_expr(Pred,E,T)),nl,fail. | |
| 364 | translate_z3_expr(['-',Number],_,integer,Res) :- | |
| 365 | !, | |
| 366 | Number1 is -Number, | |
| 367 | Res=b(integer(Number1),integer,[]). | |
| 368 | translate_z3_expr(Int,_,integer,Res) :- integer(Int),!, Res=b(integer(Int),integer,[]). | |
| 369 | translate_z3_expr(true,_,boolean,Res) :- !, Res=b(boolean_true,boolean,[]). | |
| 370 | translate_z3_expr(false,_,boolean,Res) :- !, Res=b(boolean_false,boolean,[]). | |
| 371 | translate_z3_expr([ZOP|T], Env, boolean, Res) :- | |
| 372 | z3_connective_to_b(ZOP, BOP), | |
| 373 | !, | |
| 374 | translate_z3_connective(BOP, T, Env, PredRes), | |
| 375 | Res = b(convert_bool(PredRes),boolean,[]). | |
| 376 | translate_z3_expr(['-',RealAtom], Env, real, Res) :- | |
| 377 | atom(RealAtom), | |
| 378 | atom_concat('-', RealAtom, NRealAtom), | |
| 379 | translate_z3_expr(NRealAtom, Env, real, Res). | |
| 380 | translate_z3_expr(Atom, _, Type, Res) :- | |
| 381 | atom(Atom), | |
| 382 | virtual_deferred_set_id(Atom, FdVar), | |
| 383 | FdVar = fd(_,DefSet), | |
| 384 | Type = global(DefSet), | |
| 385 | !, | |
| 386 | Res = b(value(FdVar),Type,[]). | |
| 387 | translate_z3_expr(Atom, _, Type, Res) :- | |
| 388 | atom(Atom), | |
| 389 | ( ( split_atom(Atom,['!'],Splitted), | |
| 390 | Splitted = [Set,val,InternalNumber] | |
| 391 | ) | |
| 392 | -> Type = global(Set), | |
| 393 | !, | |
| 394 | convert_to_number(InternalNumber,Nr), | |
| 395 | ResNumber is Nr + 1, | |
| 396 | Val = fd(ResNumber,Set), | |
| 397 | asserta(fd_var_of_z3(Set,ResNumber)), | |
| 398 | ( global_type(Val,Set) | |
| 399 | -> true | |
| 400 | ; handle_globalsets_fdrange_contradiction(ResNumber,Set) | |
| 401 | ), | |
| 402 | safe_create_texpr(value(Val), global(Set), Res) | |
| 403 | ; % atom could represent a real number | |
| 404 | Type = real, | |
| 405 | atom_to_number(Atom, Real), | |
| 406 | float(Real), !, | |
| 407 | safe_create_texpr(real(Atom), real, Res) | |
| 408 | ). | |
| 409 | translate_z3_expr(Nr,_,global(GS),Res) :- number(Nr),!, % Z3 represents first element of GS by 0, ... | |
| 410 | Nr1 is Nr+1, Val = fd(Nr1,GS), | |
| 411 | asserta(fd_var_of_z3(GS,Nr1)), | |
| 412 | ( global_type(Val,GS) | |
| 413 | -> true | |
| 414 | ; handle_globalsets_fdrange_contradiction(Nr1,GS) | |
| 415 | ), | |
| 416 | safe_create_texpr(value(Val), global(GS), Res). | |
| 417 | translate_z3_expr([Couple,A,B],Env,couple(T1,T2),b(couple(AT,BT),couple(T1,T2),[])) :- | |
| 418 | atom(Couple), | |
| 419 | get_couple_type_from_atom(Couple, T1, T2), | |
| 420 | translate_z3_expr(A, Env, T1, AT), | |
| 421 | translate_z3_expr(B, Env, T2, BT). | |
| 422 | translate_z3_expr([CouplePrj,Arg], Env, Type, Res) :- | |
| 423 | atom(CouplePrj), | |
| 424 | translate_z3_expr(Arg, Env, _, RArg), | |
| 425 | get_texpr_type(RArg, CType), | |
| 426 | ( atom_prefix('get_x_couple', CouplePrj), | |
| 427 | PrjNode = first_of_pair(RArg), | |
| 428 | CType = couple(ResType,_) | |
| 429 | ; atom_prefix('get_y_couple', CouplePrj), | |
| 430 | PrjNode = second_of_pair(RArg), | |
| 431 | CType = couple(_,ResType) | |
| 432 | ), | |
| 433 | !, | |
| 434 | Type = ResType, | |
| 435 | safe_create_texpr(PrjNode, ResType, Res). | |
| 436 | translate_z3_expr(Id, env(Env,_AVL), Type, Res) :- | |
| 437 | atom(Id), | |
| 438 | TId = b(identifier(Id),Type,_), | |
| 439 | member(TId, Env), | |
| 440 | !, | |
| 441 | Res = TId. | |
| 442 | translate_z3_expr(Id, _, Type, Res) :- | |
| 443 | atom(Id), | |
| 444 | Type = global(_), | |
| 445 | % global ids which are not in the environment | |
| 446 | !, | |
| 447 | safe_create_texpr(identifier(Id), Type, Res). | |
| 448 | translate_z3_expr(CstFunc,env(Env,AVL),Type,CompSet) :- atom(CstFunc), | |
| 449 | Type = set(couple(PType,RType)), | |
| 450 | avl_fetch(CstFunc,AVL,'z3-define-fun'([[ParamName,ParameterType]],ReturnType,BodyTree)), | |
| 451 | z3_type_to_b_type(ParameterType,PType), % check if type matches | |
| 452 | z3_type_to_b_type(ReturnType,RType), % ditto | |
| 453 | !, | |
| 454 | PID = b(identifier(ParamName),PType,[]), | |
| 455 | %print(translate_body(CstFunc,PID)),nl, | |
| 456 | translate_z3_expr(BodyTree,env([PID|Env],AVL),RType,BodyExpr), | |
| 457 | %print(body(CstFunc)),translate:print_bexpr(BodyExpr),nl, | |
| 458 | unique_typed_id("lambda",RType,LambdaID), | |
| 459 | create_equality(LambdaID,BodyExpr,CPred), | |
| 460 | % {PID,lambda | lambda = BodyExpr} | |
| 461 | safe_create_texpr(comprehension_set([PID,LambdaID],CPred), set(couple(PType,RType)), CompSet). | |
| 462 | translate_z3_expr([CstFunc,Arg],env(Env,AVL),Type,Res) :- % function application | |
| 463 | avl_fetch(CstFunc,AVL,'z3-define-fun'([[ParamID,ParameterType]],ReturnType,BodyTree)), | |
| 464 | z3_type_to_b_type(ReturnType,Type), % check if type matches | |
| 465 | !, | |
| 466 | ( ParamID == Arg % special case if argument and parameter identical | |
| 467 | -> translate_z3_expr(BodyTree,env(Env,AVL),Type,Res) | |
| 468 | ; z3_type_to_b_type(ParameterType,PType), % TO DO: couple-> ground type; PType could be not ground ! | |
| 469 | translate_z3_expr(CstFunc,env(Env,AVL),set(couple(PType,Type)),TFun), | |
| 470 | translate_z3_expr(Arg,env(Env,AVL),PType,TArg), | |
| 471 | create_texpr(function(TFun,TArg),Type,[contains_wd_condition],Res) | |
| 472 | ). | |
| 473 | translate_z3_expr([let,[[Id,Val]],Function],Env,Type,Res) :- !, | |
| 474 | z3_replace_let_id_by_value(Id,Val,Function,NewFunction), | |
| 475 | translate_z3_expr(NewFunction,Env,Type,Res). | |
| 476 | translate_z3_expr([let,[[Id,Val]|T],Function],Env,Type,Res) :- | |
| 477 | T \== [], | |
| 478 | z3_replace_let_id_by_value(Id,Val,Function,NewFunction), | |
| 479 | translate_z3_expr([let,T,NewFunction],Env,Type,Res). | |
| 480 | translate_z3_expr([ZOP, Left], Env, Type,Res) :- | |
| 481 | z3_unary_expr_to_b(ZOP, BOP, Type),!, | |
| 482 | translate_z3_expr(Left, Env, Type, TL), | |
| 483 | Expr =.. [BOP,TL], | |
| 484 | safe_create_texpr(Expr, Type, Res). | |
| 485 | translate_z3_expr([ZOP|Args], Env, Type, Res) :- | |
| 486 | % operators such as multiplication can have an arbitrary arity like [*,x,x,x] | |
| 487 | z3_binary_expr_to_b(ZOP, BOP, TA, TB, Type), !, | |
| 488 | create_nested_binary_expr(BOP, Env, Type, TA, TB, Args, Res). | |
| 489 | translate_z3_expr([ite, Test, Left, Right], Env, Type, Res) :- !, | |
| 490 | translate_z3_predicate(Test,Env, BTest), | |
| 491 | translate_z3_expr(Left, Env, Type, BThen), | |
| 492 | translate_z3_expr(Right,Env, Type, BElse), get_texpr_type(BThen,Type), | |
| 493 | safe_create_texpr(if_then_else(BTest,BThen,BElse),Type,Res). | |
| 494 | translate_z3_expr(String,_,string,Res) :- | |
| 495 | atom(String), | |
| 496 | !, | |
| 497 | Res = b(string(String),string,[]). | |
| 498 | translate_z3_expr(['_','as-array',AuxFunName],_,set(X),Res) :- !, | |
| 499 | % set is represented by aux function | |
| 500 | translate_z3_expr_using_full_model(AuxFunName,set(couple(X,boolean)),ChFunSet), | |
| 501 | % we computed the characteristic function of the set; now convert it to a set | |
| 502 | % Now we need to compute dom(ChFunSet |> {TRUE}) = ChFunSet~[{TRUE}] = {x|ChFunSet(x)=TRUE} | |
| 503 | unique_typed_id("el!",X,Element), | |
| 504 | create_texpr(function(ChFunSet,Element),boolean,[contains_wd_condition],FCall), | |
| 505 | create_equality(b(boolean_true,boolean,[]),FCall,NewNewPred), | |
| 506 | safe_create_texpr(comprehension_set([Element],NewNewPred),set(X),CompSet), | |
| 507 | % translate:print_bexpr(CompSet),nl, | |
| 508 | compute_bcomp_set(CompSet,Set), | |
| 509 | Res = b(value(Set),set(X),[]). | |
| 510 | translate_z3_expr([store,Sub,Entry,TStoreRes],Env,set(Type),Res) :- | |
| 511 | % TStoreRes can be true, false or a predicate which needs to be evaluated first | |
| 512 | translate_z3_expr(Sub,Env,set(Type),S1), | |
| 513 | translate_z3_expr(Entry,Env,Type,El2), | |
| 514 | S2 = b(set_extension([El2]),set(Type),[]), | |
| 515 | ( (TStoreRes = true; TStoreRes = false) | |
| 516 | -> StoreRes = TStoreRes | |
| 517 | ; translate_z3_predicate(TStoreRes, Env, BStoreRes), | |
| 518 | ( b_test_boolean_expression_cs(BStoreRes, [], [],'translating Z3 value',0) | |
| 519 | -> StoreRes = true | |
| 520 | ; StoreRes = false | |
| 521 | ) | |
| 522 | ), | |
| 523 | ( StoreRes = true | |
| 524 | -> Expr = union(S1,S2) | |
| 525 | ; StoreRes = false, | |
| 526 | Expr = set_subtraction(S1,S2) | |
| 527 | ), | |
| 528 | !, | |
| 529 | b_compute_expression_nowf(b(Expr,set(Type),[]), [], [], List,'translating Z3 value',0), | |
| 530 | Res = b(value(List),set(Type),[]). | |
| 531 | translate_z3_expr([[as,const,['Array',Z3Type,'Bool']],false],_,Type,b(value([]),Type,[])) :- | |
| 532 | ( (Type = set(BType), z3_type_to_b_type(Z3Type,BType)) | |
| 533 | -> true | |
| 534 | ; add_error(translate_z3_expr,'Unexpected type in Z3 model: ',types(Z3Type,Type)) | |
| 535 | ), | |
| 536 | !. | |
| 537 | translate_z3_expr([[as,const,['Array',Z3Type,'Bool']],true],_,Type,b(value(Res),Type,[])) :- | |
| 538 | ( (Type = set(BType), z3_type_to_b_type(Z3Type,BType)) | |
| 539 | -> b_type2_set(BType,Res), | |
| 540 | ! | |
| 541 | ; add_error(translate_z3_expr,'Unexpected type in Z3 model: ',types(Z3Type,Type)), | |
| 542 | fail | |
| 543 | ). | |
| 544 | translate_z3_expr(['record'|Z3Fields],Env,record(Fields),b(rec(FieldsOut),record(Fields),[])) :- | |
| 545 | maplist(translate_z3_record(Env),Fields,Z3Fields,FieldsOut). | |
| 546 | translate_z3_expr([iteration,Rel,Int],Env,set(CoupleType),Res) :- | |
| 547 | translate_z3_expr(Rel,Env,set(CoupleType),TRel), | |
| 548 | translate_z3_expr(Int,Env,integer,BInt), | |
| 549 | Iteration = b(iteration(TRel,BInt),set(CoupleType),[]), | |
| 550 | ( BInt = b(integer(_),_,_) | |
| 551 | -> compute_bcomp_set(Iteration,Set), | |
| 552 | Res = b(value(Set),set(CoupleType),[]) | |
| 553 | ; Res = Iteration | |
| 554 | ). | |
| 555 | % Some special cases to improve lambda translations | |
| 556 | translate_z3_expr([lambda,[[ClosureVar,ClosureVarType]],Body],Env,SetType,Res) :- | |
| 557 | ( ClosureVar = refl_closure_g_u_var | |
| 558 | -> Functor = reflexive_closure | |
| 559 | ; ClosureVar = closure_g_u_var, | |
| 560 | Functor = closure | |
| 561 | ), | |
| 562 | !, | |
| 563 | z3_type_to_b_type(ClosureVarType,BType), | |
| 564 | TClosureVar = b(identifier(ClosureVar),BType,[]), | |
| 565 | % compute closure with ProB if Z3 does not unfold lambda, | |
| 566 | % the translated model itself (lambda(exists(...))) is too complex so we catch translated closures here | |
| 567 | Env = env(Ids,B), | |
| 568 | translate_z3_predicate(Body, env([TClosureVar|Ids],B), TBody), | |
| 569 | TBody = b(exists(_,ExistsBody),pred,_), | |
| 570 | conjunction_to_list(ExistsBody, ExistsBodyConj), | |
| 571 | member(b(exists(_,ExistsBody2),pred,_), ExistsBodyConj), | |
| 572 | conjunction_to_list(ExistsBody2, ExistsBodyConj2), | |
| 573 | member(b(equal(b(identifier(_),SetType,_),b(iteration(TRel,_),SetType,_)),pred,[]), ExistsBodyConj2), | |
| 574 | !, | |
| 575 | BNode =.. [Functor,TRel], | |
| 576 | TRes = b(BNode,SetType,[]), | |
| 577 | clean_up(TRes, [], Res). | |
| 578 | translate_z3_expr([lambda,Args,Body],env(Ids,_),set(BType),Res) :- | |
| 579 | % see for instance ':z3-double-check f = %x.(x : INTEGER|x * x * x) & f(f(x)) = y & y = 512' | |
| 580 | Args = [[ID,Z3Type]], | |
| 581 | z3_type_to_b_type(Z3Type,BType), | |
| 582 | TID = b(identifier(ID),BType,[]), | |
| 583 | Body = [exists|_], | |
| 584 | translate_z3_predicate(Body,env([TID|Ids],empty),TBody), | |
| 585 | TBody = b(exists([LambdaID],ExistsBody),pred,_), | |
| 586 | conjunction_to_list(ExistsBody, ExistsList), | |
| 587 | select(ExistsBody, ExistsList, RestExistsList), | |
| 588 | ExistsBody = b(equal(CoupleCst,ExistCouple),pred,_), | |
| 589 | CoupleCst = b(identifier('_couple_cst'),couple(_,_),_), | |
| 590 | conjunct_predicates(RestExistsList, RestExistsBody), | |
| 591 | !, | |
| 592 | ExistCouple = b(couple(_,ExistsExpr),_,_), | |
| 593 | safe_create_texpr(lambda([LambdaID],RestExistsBody,ExistsExpr), set(BType), BLambda), | |
| 594 | clean_up(BLambda, [], CompSet), | |
| 595 | compute_bcomp_set(CompSet,Set), | |
| 596 | Res = b(value(Set),set(BType),[]). | |
| 597 | translate_z3_expr([lambda,Args,Body],env(Ids,B),set(BType),Res) :- | |
| 598 | Args = [[ID,Z3Type]], % TO DO: more than one argument? | |
| 599 | z3_type_to_b_type(Z3Type,BType), | |
| 600 | !, | |
| 601 | TID = b(identifier(ID),BType,[]), | |
| 602 | translate_z3_predicate(Body,env([TID|Ids],B),TBody), | |
| 603 | safe_create_texpr(comprehension_set([TID],TBody),set(BType),CompSet), | |
| 604 | %print('lambda: '),translate:print_bexpr(CompSet),nl, print(CompSet),nl, | |
| 605 | compute_bcomp_set(CompSet,Set), | |
| 606 | Res = b(value(Set),set(BType),[]). | |
| 607 | % | |
| 608 | translate_z3_expr([['_',map,AndOrTerm]|T], Env, _, Res) :- | |
| 609 | ( AndOrTerm = [AndOr,['Bool','Bool'],'Bool'] % prior version 4.12.2 | |
| 610 | ; AndOrTerm = AndOr % since version 4.12.2 | |
| 611 | ), | |
| 612 | ( AndOr == and | |
| 613 | ; AndOr == or | |
| 614 | ), | |
| 615 | !, | |
| 616 | map_translate_z3_expr(T, Env, [], TT), | |
| 617 | TT = [b(_,SetType,_)|_], | |
| 618 | ( AndOr == and | |
| 619 | -> unfold_general_intersection(TT, SetType, Res) | |
| 620 | ; unfold_general_union(TT, SetType, Res) | |
| 621 | ). | |
| 622 | translate_z3_expr([mod,A,B], Env, integer, Res) :- | |
| 623 | !, | |
| 624 | translate_z3_expr(A, Env, integer, BA), | |
| 625 | translate_z3_expr(B, Env, integer, BB), | |
| 626 | BIsZero = b(equal(BB,b(integer(0),integer,[])),pred,[]), | |
| 627 | % return 0 if B is zero, otherwise (= (mod x y) (- x (* y (div x y)))) holds | |
| 628 | ModEq = b(minus(BA,b(multiplication(BB, | |
| 629 | b(floored_div(BA,BB),integer,[contains_wd_condition])),integer,[contains_wd_condition])), | |
| 630 | integer,[contains_wd_condition]), | |
| 631 | safe_create_texpr(if_then_else(BIsZero,b(integer(0),integer,[]),ModEq),integer,TRes), | |
| 632 | clean_up(TRes, [], Res). | |
| 633 | translate_z3_expr([rem,A,B], Env, integer, Res) :- | |
| 634 | !, | |
| 635 | translate_z3_expr(A, Env, integer, BA), | |
| 636 | translate_z3_expr(B, Env, integer, BB), | |
| 637 | BIsZero = b(equal(BB,b(integer(0),integer,[])),pred,[]), | |
| 638 | BLowerZero = b(less(BB,b(integer(0),integer,[])),pred,[]), | |
| 639 | % return 0 if B is zero, otherwise (= (rem x y) (ite (< y 0) (* (- x (* y (div x y))) -1) (- x (* y (div x y))))) holds | |
| 640 | ModEq = b(minus(BA,b(multiplication(BB, | |
| 641 | b(floored_div(BA,BB),integer,[contains_wd_condition])),integer,[contains_wd_condition])), | |
| 642 | integer,[contains_wd_condition]), | |
| 643 | safe_create_texpr(if_then_else(BLowerZero,b(unary_minus(ModEq),integer,[]),ModEq),integer,IfExpr), | |
| 644 | safe_create_texpr(if_then_else(BIsZero,b(integer(0),integer,[]),IfExpr),integer,TRes), | |
| 645 | clean_up(TRes, [], Res). | |
| 646 | translate_z3_expr(Expr,_,Type,_) :- | |
| 647 | \+ check_error_occured(translate_z3_expr_globalsets_fdrange, _), | |
| 648 | add_error_fail(translate_z3_expr, 'Missing translation for Z3 expression:', Expr:Type). | |
| 649 | ||
| 650 | translate_z3_connective(BOP, T, Env, PredRes) :- | |
| 651 | map_translate_z3_predicate(T, Env, [], NT), | |
| 652 | ( BOP == conjunct | |
| 653 | -> conjunct_predicates(NT, PredRes) | |
| 654 | ; BOP == disjunct | |
| 655 | -> disjunct_predicates(NT, PredRes) | |
| 656 | ; Pred =.. [BOP|NT], | |
| 657 | safe_create_texpr(Pred, pred, PredRes) | |
| 658 | ). | |
| 659 | ||
| 660 | unfold_general_intersection([A], _, A). | |
| 661 | unfold_general_intersection([A,B|T], SetType, Res) :- | |
| 662 | !, | |
| 663 | Acc = b(intersection(A,B),SetType,[]), | |
| 664 | unfold_general_intersection_acc(T, SetType, Acc, Res). | |
| 665 | ||
| 666 | unfold_general_intersection_acc([], _, Acc, Acc). | |
| 667 | unfold_general_intersection_acc([A,B|T], SetType, Acc, Res) :- | |
| 668 | NewAcc = b(intersection(Acc,b(intersection(A,B),SetType,[])),SetType,[]), | |
| 669 | unfold_general_intersection_acc(T, SetType, NewAcc, Res). | |
| 670 | ||
| 671 | unfold_general_union([A], _, A). | |
| 672 | unfold_general_union([A,B|T], SetType, Res) :- | |
| 673 | !, | |
| 674 | Acc = b(union(A,B),SetType,[]), | |
| 675 | unfold_general_union_acc(T, SetType, Acc, Res). | |
| 676 | ||
| 677 | unfold_general_union_acc([], _, Acc, Acc). | |
| 678 | unfold_general_union_acc([A,B|T], SetType, Acc, Res) :- | |
| 679 | NewAcc = b(union(Acc,b(union(A,B),SetType,[])),SetType,[]), | |
| 680 | unfold_general_union_acc(T, SetType, NewAcc, Res). | |
| 681 | ||
| 682 | z3_unary_expr_to_b('-',unary_minus ,integer). | |
| 683 | ||
| 684 | ||
| 685 | % z3_binary_expr_to_b(Z3Op,BOp,TypeLeftArg,TypeRightArg,TypeOfExpr) | |
| 686 | z3_binary_expr_to_b('*', multiplication, integer, integer, integer). | |
| 687 | z3_binary_expr_to_b('+', add, integer, integer, integer). | |
| 688 | z3_binary_expr_to_b('-', minus, integer, integer, integer). | |
| 689 | z3_binary_expr_to_b('/', floored_div, integer, integer, integer). | |
| 690 | z3_binary_expr_to_b('div', floored_div, integer, integer, integer). | |
| 691 | z3_binary_expr_to_b(Z3Couple, couple, TA, TB, couple(TA,TB)) :- | |
| 692 | atom(Z3Couple), | |
| 693 | atom_prefix('couple', Z3Couple). | |
| 694 | ||
| 695 | % -------------------- | |
| 696 | ||
| 697 | z3_ground_result(real,real(0.0)). | |
| 698 | z3_ground_result(integer,int(0)). | |
| 699 | z3_ground_result(boolean,pred_true). | |
| 700 | z3_ground_result(couple(X,Y),(XG,YG)) :- | |
| 701 | z3_ground_result(X,XG), z3_ground_result(Y,YG). | |
| 702 | z3_ground_result(set(_),[]). | |
| 703 | z3_ground_result(record(Fields),rec(FieldsOut)) :- | |
| 704 | maplist(z3_ground_record_fields,Fields,FieldsOut). | |
| 705 | ||
| 706 | z3_ground_record_fields(field(Name,BType),field(Name,BVal)) :- | |
| 707 | z3_ground_result(BType,BVal). | |
| 708 | ||
| 709 | % -------------------- | |
| 710 | ||
| 711 | compute_bcomp_set(CompSet,ResultOut) :- | |
| 712 | % translate:set_unicode_mode,translate:print_bexpr(CompSet), | |
| 713 | b_compute_expression_nowf(CompSet,[],[],Res,'translating Z3 value',0), | |
| 714 | (try_expand_custom_set_to_list(Res,ResultOut,true,z3_set_to_b_set) | |
| 715 | -> true | |
| 716 | ; ResultOut = Res). | |
| 717 | ||
| 718 | atom_to_term(Atom, Term) :- | |
| 719 | atom_concat(Atom, '.', AtomWithStop), | |
| 720 | atom_codes(AtomWithStop, AtomWithStopC), | |
| 721 | read_from_codes(AtomWithStopC, Term). | |
| 722 | ||
| 723 | z3_type_to_b_type(record, Type) :- !, Type =.. [record|_]. % record type in SMT-LIB is just 'record' | |
| 724 | z3_type_to_b_type('String', Type) :- !, Type = string. | |
| 725 | z3_type_to_b_type('Int', Type) :- !, Type = integer. | |
| 726 | z3_type_to_b_type('Bool', Type) :- !, Type = boolean. | |
| 727 | z3_type_to_b_type('Real', Type) :- !, Type = real. | |
| 728 | z3_type_to_b_type(Z3Couple, BType) :- | |
| 729 | atom(Z3Couple), | |
| 730 | get_couple_type_from_atom(Z3Couple, CoupleType1, CoupleType2), | |
| 731 | !, | |
| 732 | BType = couple(CoupleType1,CoupleType2). | |
| 733 | z3_type_to_b_type(GlobalSet, BType) :- | |
| 734 | b_global_set(GlobalSet), | |
| 735 | !, | |
| 736 | BType = global(GlobalSet). | |
| 737 | z3_type_to_b_type(['Array',SetType,'Bool'], BType) :- | |
| 738 | !, | |
| 739 | z3_type_to_b_type(SetType, BSetType), | |
| 740 | BType = set(BSetType). | |
| 741 | z3_type_to_b_type(A, _) :- | |
| 742 | add_error_fail(z3_type_to_b_type, "Missing translation for Z3 type in model translation.", [A]). | |
| 743 | ||
| 744 | get_couple_type_from_atom(CoupleAtom, CoupleType1, CoupleType2) :- | |
| 745 | atom(CoupleAtom), | |
| 746 | atom_codes(CoupleAtom, Codes), | |
| 747 | get_couple_type_from_codes([TT1,TT2], Codes, []), | |
| 748 | atom_codes(T1Atom, TT1), | |
| 749 | atom_to_term(T1Atom, CoupleType1), | |
| 750 | atom_codes(T2Atom, TT2), | |
| 751 | atom_to_term(T2Atom, CoupleType2). | |
| 752 | ||
| 753 | get_couple_type_from_codes([T1,T2]) --> | |
| 754 | "couple(", | |
| 755 | type_symbol(T1), | |
| 756 | ",", | |
| 757 | type_symbol(T2), | |
| 758 | ")". | |
| 759 | ||
| 760 | z3_replace_let_id_by_value_maplist([], _, _, Res) :- !, Res=[]. | |
| 761 | z3_replace_let_id_by_value_maplist([let,LetVals|T], Id, _, Out) :- | |
| 762 | % prevent that the let ids of a nested let expression are mistakenly replaced | |
| 763 | % I.e., Id is now being overwritten by another let; | |
| 764 | % TODO: but what if Id is used in RHS of some LetVals? Can that be? | |
| 765 | member([Id,_], LetVals), | |
| 766 | !, | |
| 767 | Out = [let,LetVals|T]. | |
| 768 | z3_replace_let_id_by_value_maplist([H|T], Id, Val, [NH|NT]) :- | |
| 769 | z3_replace_let_id_by_value(Id, Val, H, NH), | |
| 770 | z3_replace_let_id_by_value_maplist(T, Id, Val, NT). | |
| 771 | ||
| 772 | ||
| 773 | z3_replace_let_id_by_value(Id,Val,Function,NewFunction) :- | |
| 774 | Function = [_|_], % is_list(Function), is_list also does a cyclic check | |
| 775 | !, | |
| 776 | z3_replace_let_id_by_value_maplist(Function,Id,Val,NewFunction). | |
| 777 | z3_replace_let_id_by_value(Id,Val,Function,NewFunction) :- | |
| 778 | ( Id = Function | |
| 779 | -> NewFunction = Val | |
| 780 | ; %atomic(Function), % do we need this test? | |
| 781 | NewFunction = Function | |
| 782 | ). | |
| 783 | ||
| 784 | z3_model_to_avl(FullModel,AVL) :- | |
| 785 | atom_codes(FullModel,Codes), | |
| 786 | %format('Full model:~n~s~n',[Codes]),nl, | |
| 787 | parse_lisp_style_expressions(E,Codes,[]),!, | |
| 788 | z3_lisp_to_avl(E,AVL). | |
| 789 | ||
| 790 | z3_lisp_to_avl(E,AVL) :- | |
| 791 | empty_avl(In), | |
| 792 | z3_lisp_to_avl(E,In,AVL). | |
| 793 | ||
| 794 | z3_lisp_to_avl([],A,A). | |
| 795 | z3_lisp_to_avl([['define-fun',Name,Param,Return,Tree]|T],AIn,AOut) :- | |
| 796 | avl_store(Name,AIn,'z3-define-fun'(Param,Return,Tree),ATemp), | |
| 797 | z3_lisp_to_avl(T,ATemp,AOut). | |
| 798 | % currently I think I do not need these facts... | |
| 799 | % as far as I understand they represent enumerated set Elements | |
| 800 | z3_lisp_to_avl([['declare-fun',_Name,_Params,_Type0]|T],AIn,AOut) :- | |
| 801 | z3_lisp_to_avl(T,AIn,AOut). | |
| 802 | % these occur for cardinality constraints | |
| 803 | z3_lisp_to_avl([['forall',_Vars,_Pred]|T],AIn,AOut) :- | |
| 804 | z3_lisp_to_avl(T,AIn,AOut). | |
| 805 | ||
| 806 | ||
| 807 | % ----------------------------- | |
| 808 | ||
| 809 | translate_cvc4_tree(['CONST_RATIONAL',Arg],integer,int(Val)) :- | |
| 810 | arg_is_number(Arg,Val). | |
| 811 | translate_cvc4_tree(['CONST_BOOLEAN',1],boolean,pred_true). | |
| 812 | translate_cvc4_tree(['CONST_BOOLEAN',0],boolean,pred_false). | |
| 813 | translate_cvc4_tree(['CONST_STRING',Content],string,string(Content)). | |
| 814 | translate_cvc4_tree(['SINGLETON',ValIn],set(X),[ValOut]) :- | |
| 815 | translate_cvc4_tree(ValIn,X,ValOut). | |
| 816 | translate_cvc4_tree(['EMPTYSET',emptyset,_Type],set(_),[]). | |
| 817 | translate_cvc4_tree(['TUPLE',V1,V2],couple(Type1,Type2),(TV1,TV2)) :- | |
| 818 | translate_cvc4_tree(V1,Type1,TV1), | |
| 819 | translate_cvc4_tree(V2,Type2,TV2). | |
| 820 | translate_cvc4_tree(['APPLY_CONSTRUCTOR','__cvc4_tuple_ctor',V1,V2],couple(Type1,Type2),(TV1,TV2)) :- | |
| 821 | translate_cvc4_tree(V1,Type1,TV1), | |
| 822 | translate_cvc4_tree(V2,Type2,TV2). | |
| 823 | translate_cvc4_tree(['UNION',V1,V2],set(X),Val) :- | |
| 824 | translate_cvc4_tree(V1,set(X),TV1), | |
| 825 | translate_cvc4_tree(V2,set(X),TV2), | |
| 826 | append(TV1,TV2,Val). | |
| 827 | translate_cvc4_tree(['UNINTERPRETED_CONSTANT',C],global(SId),fd(PBCId,SId)) :- | |
| 828 | atom_codes(C,CCodes), | |
| 829 | parse_uc(CId,CCodes,[]), | |
| 830 | PBCId is CId + 1. | |
| 831 | translate_cvc4_tree(['RECORD',_CVCRecordType|Fields],record(RFields),rec(FieldsOut)) :- | |
| 832 | maplist(translate_cvc4_record,RFields,Fields,FieldsOut). | |
| 833 | ||
| 834 | translate_cvc4_record(field(Name,BType),CVCVal,field(Name,BVal)) :- | |
| 835 | translate_cvc4_tree(CVCVal,BType,BVal). | |
| 836 | ||
| 837 | parse_uc(Id) --> | |
| 838 | "uc__SORT_TYPE_var_", number(_), | |
| 839 | "__", number(N), {number_codes(Id,N)}. | |
| 840 | ||
| 841 | parse_lisp_style_expressions(L) --> | |
| 842 | {reset_line_count}, | |
| 843 | lisp_style_expressions(L),!. | |
| 844 | ||
| 845 | lisp_style_expressions(Res) --> real_ws,!, | |
| 846 | lisp_style_expressions(Res). | |
| 847 | lisp_style_expressions([E|Es]) --> | |
| 848 | lisp_style_expression(E), !, | |
| 849 | lisp_style_expressions(Es). | |
| 850 | lisp_style_expressions([]) --> []. | |
| 851 | %lisp_style_expressions(_,In,_) :- linecount(Line), | |
| 852 | % format("lisp-style parser failed on line ~w on: ~s~n",[Line,In]),fail. | |
| 853 | ||
| 854 | ||
| 855 | closed_lisp_style_expressions(Res) --> real_ws,!, | |
| 856 | closed_lisp_style_expressions(Res). | |
| 857 | closed_lisp_style_expressions([]) --> ")",!. | |
| 858 | closed_lisp_style_expressions([E|Es]) --> | |
| 859 | lisp_style_expression(E), !, | |
| 860 | closed_lisp_style_expressions(Es). | |
| 861 | ||
| 862 | linecount(1). | |
| 863 | reset_line_count :- retractall(linecount(_)), assertz(linecount(1)). | |
| 864 | inc_linecount :- retract(linecount(Nr)), N1 is Nr+1, assertz(linecount(N1)). | |
| 865 | ||
| 866 | % real whitespace | |
| 867 | real_ws --> "\n", {inc_linecount},!, ws. | |
| 868 | real_ws --> [W], {W = 32 ; W = 10 ; W = 13}, !, ws. | |
| 869 | real_ws --> ";;", !, any_but_newline. | |
| 870 | ||
| 871 | % optional whitespace | |
| 872 | ws --> real_ws,!. | |
| 873 | ws --> []. | |
| 874 | any_but_newline --> [C], {C \= 10}, !, any_but_newline. | |
| 875 | any_but_newline -->"\n", {inc_linecount},!, ws. | |
| 876 | ||
| 877 | z3_op([42]) --> [42]. % * | |
| 878 | z3_op([43]) --> [43]. % + | |
| 879 | z3_op([45]) --> [45]. % - | |
| 880 | z3_op([47]) --> [47]. % / | |
| 881 | % TO DO: support all operators | |
| 882 | ||
| 883 | lisp_style_expression(Iteration) --> "((_ |iteration_", rel_type_skip, "| 0)", ws, | |
| 884 | closed_lisp_style_expressions([Arg1,Arg2]), ws, !, {Iteration = [iteration,Arg1,Arg2]}. | |
| 885 | lisp_style_expression(A) --> real(Cs), !, {atom_codes(A, Cs)}. | |
| 886 | lisp_style_expression(L) --> "!", !, ws, lisp_style_expression(L), ws, ":weight", ws, number(_). % optional term parameter | |
| 887 | lisp_style_expression(A) --> "/0", !, {A = '/0'}. % weird special case when using reals, e.g., for ':z3 a:REAL & b/=0.0 & a=1.2/b' a function called '/0' is defined | |
| 888 | lisp_style_expression(A) --> z3_op(Cs), !, {atom_codes(A, Cs)}. | |
| 889 | lisp_style_expression(A) --> typed_couple_top_level(Cs), !, {atom_codes(A, Cs)}. | |
| 890 | lisp_style_expression(A) --> non_empty_symbol(Cs), !, {atom_codes(A, Cs)}. | |
| 891 | lisp_style_expression(N) --> number(Cs), !, {number_codes(N, Cs)}. | |
| 892 | lisp_style_expression(N) --> "-", number(Cs), !, {number_codes(N2,Cs), N is -N2}. | |
| 893 | lisp_style_expression(A) --> string(Codes), !, {atom_codes(A,Codes)}. | |
| 894 | lisp_style_expression(List) --> "(", !, closed_lisp_style_expressions(List). | |
| 895 | lisp_style_expression(record_type(Fields)) --> | |
| 896 | "[#", !, ws, record_type_fields(Fields),!, | |
| 897 | ws, expect("#]",record_type). | |
| 898 | lisp_style_expression(_,In,_) :- In \= [], % not at end of string | |
| 899 | linecount(Line), | |
| 900 | format("lisp-style parser failed on line ~w on: ~s~n",[Line,In]),fail. | |
| 901 | ||
| 902 | expect(L,_) --> L,!. | |
| 903 | expect(L,Ctxt,In,_) :- linecount(Line), | |
| 904 | format("lisp-style parser failed on line ~w expecting ~s for ~w on: ~s~n",[Line,L,Ctxt, In]),fail. | |
| 905 | ||
| 906 | record_type_fields([F|Fields]) --> | |
| 907 | record_type_field(F), ws, expect(",",record_type_field), !, | |
| 908 | ws, record_type_fields(Fields). | |
| 909 | record_type_fields([F]) --> record_type_field(F). | |
| 910 | ||
| 911 | record_type_field(field(NameA,TypeA)) --> | |
| 912 | non_empty_symbol(Name), ":(TYPE_CONSTANT ", non_empty_symbol(Type), " type)", | |
| 913 | {atom_codes(NameA,Name),atom_codes(TypeA,Type)}. | |
| 914 | ||
| 915 | real(R) --> | |
| 916 | number(I), | |
| 917 | ".", | |
| 918 | number(D), | |
| 919 | ( "?", | |
| 920 | ! | |
| 921 | ; "" | |
| 922 | ), | |
| 923 | {append([I,[46],D],R)}. | |
| 924 | ||
| 925 | number([D|Ds]) --> digit(D), number(Ds). | |
| 926 | number([D]) --> digit(D). | |
| 927 | ||
| 928 | rel_type_skip --> | |
| 929 | "set(couple(", type_symbol(_), ",", type_symbol(_), "))". | |
| 930 | ||
| 931 | % top-level couple types are escaped with | in an SMT-Lib model | |
| 932 | typed_couple_top_level(Cs) --> | |
| 933 | "|couple(", | |
| 934 | in_couple(Cs1,Cs2), | |
| 935 | expect(")|", typed_couple_top_level), | |
| 936 | {append(["couple(",Cs1,",",Cs2,")"], Cs)}. | |
| 937 | ||
| 938 | typed_couple_inner(Cs) --> | |
| 939 | "couple(", | |
| 940 | in_couple(Cs1,Cs2), | |
| 941 | expect(")", typed_couple_inner), | |
| 942 | {append(["couple(",Cs1,",",Cs2,")"], Cs)}. | |
| 943 | ||
| 944 | in_couple(Cs1, Cs2) --> | |
| 945 | type_symbol(Cs1), !, | |
| 946 | expect(",", in_couple), | |
| 947 | type_symbol(Cs2). | |
| 948 | ||
| 949 | digit(D) --> [D], {48 =< D, D =< 57}. | |
| 950 | ||
| 951 | string(Codes) --> "\"", string_symbol(Codes), "\"". | |
| 952 | ||
| 953 | % already escaped | |
| 954 | type_symbol(Cs) --> typed_couple_inner(Cs). | |
| 955 | type_symbol(A) --> non_empty_symbol(Global), {Global == "global"}, "('", !, | |
| 956 | non_empty_symbol(GlobalType), ")", {append([Global,[40,39],GlobalType,[41]], A)}. | |
| 957 | % the global type has to be escaped for global(_) since it can be capitalised which results in a variable in Prolog | |
| 958 | type_symbol(A) --> non_empty_symbol(Global), {Global == "global"}, !, | |
| 959 | "(", non_empty_symbol(GlobalType), ")", {append([Global,[40,39],GlobalType,[39,41]], A)}. | |
| 960 | type_symbol(A) --> non_empty_symbol(A1), type_symbol_term(A2,0), !, {append(A1, A2, A)}. | |
| 961 | type_symbol(_,In,_) :- linecount(Line), | |
| 962 | format("lisp-style parser failed on line ~w expecting type_symbol on: ~s~n",[Line, In]),fail. | |
| 963 | ||
| 964 | type_symbol_term([40|A],Lvl) --> "(", {L1 is Lvl+1}, type_symbol_term(A,L1). | |
| 965 | type_symbol_term([41|A],Lvl) --> ")", {Lvl>0, L1 is Lvl-1}, type_symbol_term(A,L1). | |
| 966 | type_symbol_term(A,Lvl) --> non_empty_symbol(A1), type_symbol_term(A2,Lvl), {append(A1, A2, A)}. | |
| 967 | type_symbol_term(A,Lvl) --> typed_couple_inner(A1), !, type_symbol_term(A2,Lvl), {append(A1, A2, A)}. | |
| 968 | type_symbol_term(A,0) --> non_empty_symbol(A). | |
| 969 | type_symbol_term([],0) --> "". | |
| 970 | ||
| 971 | non_empty_symbol([A|As]) --> | |
| 972 | [A], | |
| 973 | { 65 =< A, A =< 90 | |
| 974 | ; 97 =< A, A =< 122 | |
| 975 | % ; 48 =< A, A =< 57 | |
| 976 | ; 913 =< A, A =< 937 % upper-case greek letters | |
| 977 | ; 945 =< A, A =< 969 % lower-case greek letters | |
| 978 | ; A = 124 % "|" | |
| 979 | ; A = 95 % "_", | |
| 980 | ; A = 45 % "-" | |
| 981 | ; A = 39 % "'" | |
| 982 | ; A = 33 % "!" | |
| 983 | ; 60 =< A, A =< 62 % "<", "=", ">" | |
| 984 | },!, | |
| 985 | symbol(As). | |
| 986 | ||
| 987 | symbol([A|As]) --> | |
| 988 | [A], | |
| 989 | { 65 =< A, A =< 90 | |
| 990 | ; 97 =< A, A =< 122 | |
| 991 | ; 48 =< A, A =< 57 | |
| 992 | ; 913 =< A, A =< 937 % upper-case greek letters | |
| 993 | ; 945 =< A, A =< 969 % lower-case greek letters | |
| 994 | ; A = 124 % "|" | |
| 995 | ; A = 95 % "_", | |
| 996 | ; A = 45 % "-" | |
| 997 | ; A = 39 % "'" | |
| 998 | ; A = 33 % "!" | |
| 999 | ; 60 =< A, A =< 62 % "<", "=", ">" | |
| 1000 | ; A = 8242 % Unicode Prime, should we also allow this as first symbol? | |
| 1001 | },!, | |
| 1002 | symbol(As). | |
| 1003 | symbol([]) --> "". | |
| 1004 | ||
| 1005 | string_symbol([34|As]) --> | |
| 1006 | % Z3 escapes double quotes with double quotes while ProB uses \" | |
| 1007 | [34,34], | |
| 1008 | string_symbol(As). | |
| 1009 | string_symbol([A|As]) --> | |
| 1010 | [A], | |
| 1011 | { 35 =< A, A =< 126 | |
| 1012 | ; A = 33 % "!" | |
| 1013 | }, | |
| 1014 | string_symbol(As). | |
| 1015 | string_symbol([]) --> "". |