1 | | % (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
2 | | % Heinrich Heine Universitaet Duesseldorf |
3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
4 | | |
5 | | :- module(solver_interface, [solve_predicate/3, solve_predicate/4, solve_predicate/5, |
6 | | valid_solver_option/1, |
7 | | set_up_typed_localstate_for_pred/4, |
8 | | strip_outer_exists/2, |
9 | | type_check_in_machine_context/2, |
10 | | predicate_uses_unfixed_deferred_set/1, predicate_uses_unfixed_deferred_set/2, |
11 | | unfixed_typed_id_in_list/3, |
12 | | call_with_smt_mode_enabled/1, |
13 | | apply_kodkod_or_other_optimisations/3, apply_kodkod_or_other_optimisations/4, |
14 | | solver_pp_bvalue/4 |
15 | | ]). |
16 | | |
17 | | :- use_module(module_information,[module_info/2]). |
18 | | :- module_info(group,cbc). |
19 | | :- module_info(description,'This module provides an interface to ProB\'s constraint solving kernel.'). |
20 | | |
21 | | :- meta_predicate call_with_smt_mode_enabled(0). |
22 | | %:- meta_predicate call_with_chr(0). |
23 | | |
24 | | :- use_module(library(lists), [include/3,keys_and_values/3]). |
25 | | |
26 | | :- use_module(bmachine, [b_get_machine_variables/1, b_get_machine_constants/1, full_b_machine/1]). |
27 | | :- use_module(btypechecker,[env_empty/1,opentype/5, add_identifiers_to_environment/3, env_store_operator/4, env_store_definition/3]). |
28 | | :- use_module(b_global_sets, [is_b_global_constant/3, |
29 | | b_global_set/1, unfixed_deferred_set_exists/0, |
30 | | contains_unfixed_deferred_set/1, contains_unfixed_deferred_set/2]). |
31 | | :- use_module(b_interpreter, [set_up_typed_localstate/6]). |
32 | | :- use_module(tools_timeout, [time_out_with_factor_call/4]). |
33 | | :- use_module(bsyntaxtree, [find_typed_identifier_uses/2, |
34 | | map_over_typed_bexpr/3, get_texpr_id/2, get_texpr_type/2]). |
35 | | :- use_module(error_manager). |
36 | | :- use_module(tools,[foldl/5,foldl/4]). |
37 | | :- use_module(translate, [translate_bvalue/2, translate_bvalue_with_limit/3]). |
38 | | :- use_module(bmachine_structure,[get_section/3]). |
39 | | :- use_module(debug,[debug_println/2, debug_mode/1]). |
40 | | :- use_module(preferences). |
41 | | :- use_module(eventhandling,[announce_event/1]). |
42 | | :- use_module(smt_solvers_interface(smt_solvers_interface),[smt_solve_predicate/4]). |
43 | | :- use_module(store, [normalise_value_for_var/4]). |
44 | | |
45 | | %call_with_chr(Call) :- call_with_preference(Call,use_chr_solver,true). |
46 | | |
47 | | |
48 | | % :- meta_predicate call_with_smt_mode_enabled(0). % directive above for Spider |
49 | | call_with_smt_mode_enabled(Call) :- |
50 | | temporary_set_preference(use_smt_mode,true,SMT), |
51 | | temporary_set_preference(use_clpfd_solver,true,CLPFD), % we also enable CLPFD |
52 | | % TO DO: also enable CHR |
53 | | call_cleanup( (Call,!), |
54 | | (reset_temporary_preference(use_smt_mode,SMT), |
55 | | reset_temporary_preference(use_clpfd_solver,CLPFD) |
56 | | )). |
57 | | |
58 | | |
59 | | % ------------------------------------- |
60 | | |
61 | | :- use_module(kodkodsrc(kodkod), [replace_by_kodkod/3]). |
62 | | :- use_module(bsyntaxtree, [get_texpr_ids/2]). |
63 | | :- use_module(b_ast_cleanup, [perform_do_not_enumerate_analysis/5]). |
64 | | |
65 | | % high-level interface to Kodkod transformation |
66 | | apply_kodkod_or_other_optimisations(Identifiers,Predicate,NewPredicate) :- |
67 | | get_preference(use_solver_on_load,kodkod), |
68 | | !, |
69 | | (replace_by_kodkod(Identifiers,Predicate,NewPredicate) -> true |
70 | | ; get_texpr_ids(Identifiers,Ids), |
71 | | add_warning(kodkod_fail,'Could not use KODKOD to translate predicate to SAT, identifiers = ', Ids, Predicate), |
72 | | (get_preference(kodkod_for_components,full) |
73 | | -> throw(enumeration_warning(translating_for_kodkod,Ids,[],kodkod,critical)) |
74 | | ; true), |
75 | | NewPredicate = Predicate |
76 | | ). |
77 | | apply_kodkod_or_other_optimisations(Identifiers,Predicate,NewPredicate) :- |
78 | | Span=Predicate, |
79 | | perform_do_not_enumerate_analysis(Identifiers,Predicate,'EXISTS',Span,NewPredicate). |
80 | | % TODO: other top-level optimisations?? |
81 | | |
82 | | |
83 | | create_id(Id,Type,b(identifier(Id),Type,[])). |
84 | | |
85 | | % a version which takes ids and types list: |
86 | | apply_kodkod_or_other_optimisations(Ids,Types,Predicate,NewPredicate) :- |
87 | | get_preference(use_solver_on_load,kodkod), |
88 | | maplist(create_id,Ids,Types,Identifiers), |
89 | | !, |
90 | | apply_kodkod_or_other_optimisations(Identifiers,Predicate,NewPredicate). |
91 | | apply_kodkod_or_other_optimisations(_Identifiers,_Types,Predicate,Predicate). |
92 | | |
93 | | % ------------------------------------- |
94 | | |
95 | | % strip_outer_exists: remove outer exists of let_predicate, putting them as full decision variables |
96 | | % can be useful in improving solving performance, e.g., public_examples/SMT/QF_IDL/queens_bench/n_queen/queen3-1.smt2 |
97 | | :- use_module(probsrc(bsyntaxtree), [conjunct_predicates/2]). |
98 | | :- use_module(library(lists), [maplist/4]). |
99 | | strip_outer_exists(b(exists(Paras,Pred),pred,_),Res) :- |
100 | | debug_println(9,stripping_exists(Paras)), |
101 | | strip_outer_exists(Pred,Res). |
102 | | strip_outer_exists(b(let_predicate(Paras,Exprs,Pred),pred,_),R) :- !, |
103 | | debug_println(9,stripping_let(Paras,Exprs)), |
104 | | maplist(create_equality,Paras,Exprs,Equals), |
105 | | append(Equals,[Pred],List), |
106 | | conjunct_predicates(List,NewPred), |
107 | | strip_outer_exists(NewPred,R). |
108 | | strip_outer_exists(R,R). |
109 | | |
110 | | :- use_module(probsrc(bsyntaxtree), [create_equality/3]). |
111 | | |
112 | | |
113 | | % ------------------------------------------------------- |
114 | | |
115 | | % solve predicate finds *one* solution for predicate in State |
116 | | solve_predicate(Pred,State,Res) :- solve_predicate(Pred,State,1,Res). |
117 | | % TimeoutFactor can also be fixed_time_out(Nr) |
118 | | solve_predicate(Pred,State,TimeoutFactor,Res) :- |
119 | | solve_predicate(Pred,State,TimeoutFactor,[use_smt_mode/true,use_clpfd_solver/true],Res). |
120 | | |
121 | | % one could add a preference to try Z3 instead/or first: |
122 | | %solve_predicate(Pred,State,TimeoutFactor,Options,RealRes) :- |
123 | | % % preference(solve_predicates_with_z3,true), |
124 | | % !, print(solve_with_z3),nl, translate:print_bexpr(Pred),nl, |
125 | | % ((TimeoutFactor=1,Options=[]) -> true |
126 | | % ; format('TO DO; ignoring Timeout Factor ~w and Options ~w for Z3~n',[TimeoutFactor,Options])), |
127 | | % smt_solvers_interface:smt_solve_predicate(z3,Pred,State,RealRes), |
128 | | % print(z3_result(RealRes)),nl. |
129 | | solve_predicate(Pred,State,TimeoutFactor,Options,RealRes) :- |
130 | | solve_predicate_with_options(Options,[],Pred,State,TimeoutFactor,Res), !, |
131 | | if(solver_result(Res,Pred,State,Options,RealResBeforeFallback),true, |
132 | | (add_internal_error('Unknown solver_result: ',Res),RealResBeforeFallback=error)), |
133 | | fallback_to_smt_if_requested(RealResBeforeFallback,Pred,State,RealRes). |
134 | | |
135 | | % no fallback if solution / contradiction |
136 | | fallback_to_smt_if_requested(solution(S),_,_,Res) :- !, Res=solution(S). |
137 | | fallback_to_smt_if_requested(contradiction_found,_,_,Res) :- !,Res=contradiction_found. |
138 | | fallback_to_smt_if_requested(S,_,_,Res) :- |
139 | | \+ preferences:get_preference(smt_supported_interpreter,true), ! , Res = S. |
140 | | fallback_to_smt_if_requested(_,Pred,State,Res) :- |
141 | | smt_solve_predicate(z3,Pred,State,Res), !. |
142 | | |
143 | | solve_predicate_with_options([],RestOptions,Pred,State,TimeoutFactor,Res) :- |
144 | | solve_predicate_direct(Pred,State,TimeoutFactor,RestOptions,Res). |
145 | | solve_predicate_with_options([Option|T],RestOptions,Pred,State,TimeoutFactor,Res) :- |
146 | | solve_with_option(Option,T,RestOptions,Pred,State,TimeoutFactor,Res). |
147 | | |
148 | | solve_with_option('CHR',T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
149 | | solve_with_option(use_chr_solver/true,T,Rest,Pred,State,TimeoutFactor,Res). |
150 | | solve_with_option('SMT',T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
151 | | solve_with_option(use_smt_mode/true,T,Rest,Pred,State,TimeoutFactor,Res). |
152 | | solve_with_option('KODKOD',T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
153 | | solve_with_option(use_solver_on_load/kodkod,T,Rest,Pred,State,TimeoutFactor,Res). |
154 | | solve_with_option('SMT_SUPPORTED_INTERPRETER',T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
155 | | solve_with_option(smt_supported_interpreter/true,T,Rest,Pred,State,TimeoutFactor,Res). |
156 | | solve_with_option('CLPFD',T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
157 | | solve_with_option(use_clpfd_solver/true,T,Rest,Pred,State,TimeoutFactor,Res). |
158 | | solve_with_option(Pref/Val,T,Rest,Pred,State,TimeoutFactor,Res) :- !, |
159 | | call_with_preference(solve_predicate_with_options(T,Rest,Pred,State,TimeoutFactor,Res),Pref,Val). |
160 | | solve_with_option(Opt,T,Rest,Pred,State,TimeoutFactor,Res) :- |
161 | | valid_solver_option(Opt),!, |
162 | | solve_predicate_with_options(T,[Opt|Rest],Pred,State,TimeoutFactor,Res). |
163 | | solve_with_option(Opt,T,Rest,Pred,State,TimeoutFactor,Res) :- |
164 | | add_warning(solve_with_option,'Unrecognised option: ',Opt), |
165 | | solve_predicate_with_options(T,Rest,Pred,State,TimeoutFactor,Res). |
166 | | |
167 | | valid_solver_option(full_machine_state). |
168 | | valid_solver_option(ignore_wd_errors). |
169 | | valid_solver_option(clean_up_pred). |
170 | | valid_solver_option(allow_improving_wd_mode/_). % enable left-propagation of falsity/truth in clean_up |
171 | | valid_solver_option(repair_used_ids). |
172 | | valid_solver_option(solve_in_visited_state(S)) :- atomic(S). |
173 | | valid_solver_option(truncate(Limit)) :- number(Limit). % truncate pretty printing |
174 | | valid_solver_option(truncate). % 10000 |
175 | | valid_solver_option(force_evaluation). % force evaluation of symbolic results |
176 | | valid_solver_option(use_smt_mode/_). |
177 | | valid_solver_option(use_clpfd_solver/_). |
178 | | valid_solver_option(use_chr_solver/_). |
179 | | valid_solver_option(use_solver_on_load/_). |
180 | | valid_solver_option(smt_supported_interpreter/_). |
181 | | valid_solver_option(solver_strength/_). |
182 | | |
183 | | solve_predicate_direct(Pred,State,TimeoutFactor,Options,Res) :- |
184 | | %temporary_set_preference(randomise_enumeration_order,true), |
185 | | %temporary_set_preference(find_abort_values,true), % I am not sure we should do this; we want to find counter-examples quickly, we are less worried with finding WD-problems ?! |
186 | | |
187 | | %temporary_set_preference(minint,-2147483648), % disabled to pass tests 1004,1015,.. |
188 | | %temporary_set_preference(maxint,2147483647), |
189 | | get_total_number_of_errors(Errs), |
190 | | |
191 | | announce_event(start_solving), |
192 | | solve_predicate_aux(Pred,State,TimeoutFactor,Options,InnerRes), |
193 | | announce_event(end_solving), |
194 | | |
195 | | get_total_number_of_errors(ErrsAfter), |
196 | | (InnerRes = overflow -> Res = overflow ; ErrsAfter>Errs -> Res = error; Res = InnerRes). |
197 | | |
198 | | %:- use_module(clpfd_interface,[clpfd_overflow_error_message/0]). |
199 | | solve_predicate_aux(Pred,State,TimeoutFactor,Options,Res) :- |
200 | | enter_new_error_scope(ScopeID,solve_predicate), %print(enter_scope(ScopeID)),nl, |
201 | | call_cleanup(solve_predicate_aux0(Pred,State,TimeoutFactor,Options,Res), |
202 | | exit_err_scope(ScopeID,Options,Res)). |
203 | | |
204 | | solve_predicate_aux0(Pred,State,TimeoutFactor,Options,Res) :- |
205 | | clean_solver_predicate(Pred,Options,CleanedPred), |
206 | | (solve_predicate_aux1(CleanedPred,State,TimeoutFactor,Options,SRes) |
207 | | -> (SRes = time_out |
208 | | -> fail % fail if we have a time_out to avoid pending co-routines and return time_out in clause below |
209 | | ; !, Res=SRes |
210 | | ) |
211 | | ; !, |
212 | | add_warning(solver_interface,'solve_predicate failed:',CleanedPred), % this should normally not happen |
213 | | fail % the above can fail when state is provided |
214 | | ). |
215 | | solve_predicate_aux0(_,_,_,_,time_out). |
216 | | |
217 | | :- use_module(probsrc(b_ast_cleanup), [clean_up_pred/3]). |
218 | | :- use_module(probsrc(bsyntaxtree), [repair_used_ids/3]). |
219 | | |
220 | | clean_solver_predicate(Pred,Options,CleanedPred) :- |
221 | | (nonmember(repair_used_ids,Options) -> Pred0=Pred |
222 | | ; repair_used_ids(solve_predicate,Pred,Pred0)), % ideally we should not need this; some BMC monolithic predicates are faulty and this allows a repair |
223 | | (nonmember(clean_up_pred,Options) -> CleanedPred=Pred0 |
224 | | ; clean_up_pred(Pred0, [], CleanedPred) |
225 | | -> (debug_mode(off) -> true ; print(cleaned),nl, translate:print_bexpr(CleanedPred),nl) |
226 | | ; add_internal_error('Clean up failed ', solve_predicate_aux3), CleanedPred=Pred0 |
227 | | ). |
228 | | |
229 | | :- use_module(probsrc(error_manager),[wd_error_occured/0, clear_wd_errors/0]). |
230 | | :- use_module(probsrc(debug),[debug_format/3]). |
231 | | exit_err_scope(ScopeID,Options,Res) :- |
232 | | (member(ignore_wd_errors,Options),wd_error_occured |
233 | | -> debug_format(19,'Ignoring WD-Error(s) in solve_predicate (scope: ~w, result: ~w)~n',[ScopeID,Res]), |
234 | | clear_wd_errors |
235 | | ; true), |
236 | | exit_error_scope(ScopeID,_,solve_predicate_aux). |
237 | | |
238 | | :- use_module(probsrc(store),[normalise_store/2]). |
239 | | solve_predicate_aux1(Pred,State,TimeoutFactor,Options,Res) :- var(State), |
240 | ? | solve_predicate_aux2(Pred,CState,TimeoutFactor,Options,Res), |
241 | | !, % we only look for one solution |
242 | | normalise_solver_store(Res,CState,State), |
243 | | clear_enumeration_warnings. % avoid propagating them higher up |
244 | | solve_predicate_aux1(Pred,State,TimeoutFactor,Options,Res) :- nonvar(State), |
245 | ? | solve_predicate_aux2(Pred,State,TimeoutFactor,Options,Res), |
246 | | !, % we only look for one solution |
247 | | clear_enumeration_warnings. % avoid propagating them higher up |
248 | | solve_predicate_aux1(_Pred,State,_TimeoutFactor,_Options,Res) :- |
249 | ? | critical_enumeration_warning_occured_in_error_scope(A,B,C,D), % we did not find a solution: check for enum warnings |
250 | | !, |
251 | | clear_enumeration_warnings, |
252 | | set_no_state(State), |
253 | | Res = virtual_time_out(enumeration_warning(A,B,C,D,critical)). |
254 | | solve_predicate_aux1(Pred,State,_TimeoutFactor,_Options,Res) :- var(State),!, |
255 | | % a variable state means we are in a disprover context; check if deferred sets are involved |
256 | | set_no_state(State), |
257 | | % print('Checking for use of deferred sets in: '), translate:print_bexpr(Pred),nl, |
258 | ? | (predicate_uses_unfixed_deferred_set(Pred,CType) |
259 | | -> debug_println(10,solver_predicate_contains_unfixed_deferred_set(CType)), |
260 | | Res=unfixed_deferred_sets |
261 | | % if no unfixed global sets involved -> real contradiction found |
262 | | ; Res=no |
263 | | ). |
264 | | solve_predicate_aux1(_Pred,_State,_TimeoutFactor,_Options,Res) :- |
265 | | % if state is set: we are looking for a solution in the context of the current state |
266 | | % which implicitly includes the valuation of the unfixed deferred sets, hence |
267 | | % we can return no rather than unfixed_deferred_sets |
268 | | %set_no_state(State), |
269 | | Res = no. |
270 | | |
271 | | set_no_state(State) :- var(State),!,State=no_state. |
272 | | set_no_state(_). |
273 | | |
274 | | normalise_solver_store(yes,Store,NormStore) :- !, normalise_solver_store2(Store,NormStore). |
275 | | normalise_solver_store(_,S,Res) :- !, |
276 | | Res=S. % for error, time_out, ... Store irrelevant; just copy to avoid call_residues |
277 | | normalise_solver_store2(no_state,R) :- !, R=no_state. |
278 | | normalise_solver_store2(CState,State) :- normalise_store(CState,State),!. |
279 | | normalise_solver_store2(CState,Res) :- |
280 | | add_internal_error('Normalising store failed:',normalise_solver_store2(CState,Res)), |
281 | | Res=CState. |
282 | | |
283 | | :- use_module(clpfd_interface,[catch_clpfd_overflow_call2/2]). |
284 | | |
285 | | solve_predicate_aux2(Pred,State,TimeoutFactor,Options,Res) :- |
286 | | %predicate_level_optimizations(Pred,OptPred), |
287 | | % is now done in b_interpreter_components; to avoid that CSE disrupts partitioning |
288 | ? | catch_clpfd_overflow_call2( |
289 | | solve_predicate_aux3(Pred,State,TimeoutFactor,Options,Res), |
290 | | ( debug_println(19,overflow_in_solve_predicate), |
291 | | %clpfd_interface:clpfd_overflow_warning_message, % message is already printed by catch_clpfd_overflow_call2 |
292 | | % we could try and solve without CLPFD ?!! |
293 | | Res=overflow,State=no_state)). |
294 | | |
295 | | |
296 | | |
297 | | :- use_module(b_interpreter_components). |
298 | | |
299 | | :- use_module(specfile,[state_corresponds_to_set_up_constants/2]). |
300 | | :- use_module(state_space,[visited_expression/2]). |
301 | | :- use_module(library(lists),[maplist/2]). |
302 | | |
303 | | |
304 | | solve_predicate_aux3(Pred,State,TimeoutFactor,Options,Res) :- |
305 | | % find all identifiers used in the predicate and create a state |
306 | | % was done by the caller, leading to code duplication |
307 | | (member(full_machine_state,Options) -> get_full_machine_state_typed_identifiers(FilteredIdentifiers) |
308 | | ; find_typed_identifier_uses(Pred,FilteredIdentifiers)), |
309 | | !, |
310 | | % global constants should not appear in the state |
311 | | % otherwise they treated are as variables by the solver |
312 | | % -> we now call find_typed_identifier_uses; we used to call filter_global_identifiers(Identifiers,FilteredIdentifiers), |
313 | | % state may be predefined / partially set up |
314 | | apply_kodkod_or_other_optimisations(FilteredIdentifiers,Pred,Pred2), |
315 | | (member(solve_in_visited_state(StateID),Options) |
316 | | -> set_up_typed_localstate_for_pred(FilteredIdentifiers,Pred2,TypedVals,State), |
317 | | (visited_expression(StateID,StateExpr), |
318 | | state_corresponds_to_set_up_constants(StateExpr,FullStore) |
319 | | -> maplist(initialise_localstate(FullStore),State) |
320 | | ; StateID=root -> true |
321 | | ; add_internal_error('Illegal State:',use_visited_state(StateID)) |
322 | | ) |
323 | | ; var(State) |
324 | | -> set_up_typed_localstate_for_pred(FilteredIdentifiers,Pred2,TypedVals,State) |
325 | | % TypedVals contains typedval(Val,Type,Var,TriggersEnumWarning) |
326 | | % TO DO: add static_symmetry detection b_global_sets:static_symmetry_reduction_for_global_sets(State), |
327 | | ; |
328 | ? | set_up_typed_localstate_for_pred(FilteredIdentifiers,Pred2,TypedVals,State2), |
329 | | sort(State,S1),sort(State2,S2), |
330 | ? | link_bindings(S1,S2) |
331 | | ), |
332 | | %tools_printing:print_term_summary(b_trace_test_components(Pred2,State,TypedVals)),nl, |
333 | | b_interpreter_components:reset_component_info(false), |
334 | ? | time_out_with_factor_call( |
335 | | solver_interface:solve_components(Pred2,State,TypedVals), |
336 | | TimeoutFactor, [silent], |
337 | | TO='time_out'), |
338 | | (TO==time_out -> Res = TO ; Res = yes). |
339 | | |
340 | | % link up state provided with state set-up by solve_predicate |
341 | | link_bindings([],[]). |
342 | | link_bindings([],[bind(ID,_)|_T]) :- add_error(solve_predicate,'Provided state has no entry for identifier: ',ID),fail. |
343 | ? | link_bindings([bind(ID,Val)|T1],[bind(ID,Val)|T2]) :- !,link_bindings(T1,T2). |
344 | | link_bindings([bind(_,_)|T],S2) :- % ignore ID in state provided to solver |
345 | ? | link_bindings(T,S2). |
346 | | |
347 | | |
348 | | :- public solve_components/3. |
349 | | :- use_module(tools_meta,[call_residue/2]). |
350 | | solve_components(Pred2,State,TypedVals) :- |
351 | ? | call_residue( |
352 | | b_interpreter_components:b_trace_test_components(Pred2,State,TypedVals), |
353 | | Residue), |
354 | | (Residue=[] -> true |
355 | | ; add_internal_error('Call residue in solve_predicate: ',Residue) |
356 | | %add_message(solver_interface,'Call residue in solve_predicate: ',Residue) |
357 | | ). |
358 | | |
359 | | % set up a complete typed solver state for machine with all constants and variables, even if typing invariants removed and no reference anymore to variable in Invariant |
360 | | % TypedVals need to be enumerated after calling solve_predicate, in case some variables are not constrained |
361 | | get_full_machine_state_typed_identifiers(TIds) :- |
362 | | b_get_machine_variables(Variables), |
363 | | b_get_machine_constants(Constants), append(Constants,Variables,TIds). |
364 | | |
365 | | :- use_module(static_ordering,[sort_ids_by_usage/4,reorder_state/3]). |
366 | | :- use_module(preferences,[preference/2]). |
367 | | set_up_typed_localstate_for_pred(CV,Pred,TypedVals,State) :- |
368 | | (preference(use_static_ordering,true) |
369 | | -> sort_ids_by_usage(CV,Pred,SortedVarlist,no_warnings) , |
370 | | set_up_typed_localstate(SortedVarlist,_FreshVars,TypedVals,[],SortedState,positive), |
371 | | reorder_state(CV,SortedState,State) % SortedState can have issues with pack_state skeleton |
372 | ? | ; set_up_typed_localstate(CV,_FreshVars,TypedVals,[],State,positive)). |
373 | | |
374 | | % initialise local state with values found in bind list |
375 | | initialise_localstate(FullStore,bind(Var,Val)) :- |
376 | | (member(bind(Var,VarVal),FullStore) |
377 | | -> Val=VarVal ; true). |
378 | | |
379 | | % translate solver_result for use by Disprover/Prover or similar: |
380 | | solver_result(time_out,_P,_State,_,Res) :- !,Res=time_out. |
381 | | solver_result(error,_P,_State,_,Res) :- !,Res=error. |
382 | | solver_result(no,_P,_State,_,Res) :- !, Res=contradiction_found. |
383 | | solver_result(unfixed_deferred_sets,_,_,_,Res) :- !, |
384 | | Res=no_solution_found(unfixed_deferred_sets). |
385 | | solver_result(virtual_time_out(Reason),_P,_State,_,Res) :- !, |
386 | | Res=no_solution_found(Reason). |
387 | | % this is now checked in solve_predicate_aux1: event_occurred_in_error_scope(enumeration_warning(A,B,C,D,critical)). |
388 | | solver_result(overflow,_P,_State,_,Res) :- !, Res=no_solution_found(clpfd_overflow). |
389 | | solver_result(yes,_P,State,Options,Res) :- !,Res=solution(Solution), |
390 | | findall(binding(Id,EValue,PPValue), |
391 | | (member(bind(Id,Value),State), |
392 | | (solver_pp_bvalue(Value,Options,EValue,PPValue) -> true |
393 | | ; EValue=Value, PPValue='**pretty-print failed**')), |
394 | | Solution). |
395 | | solver_result(OTHER,_P,_State,_,no_solution_found(OTHER)) :- |
396 | | add_internal_error('Unknown solver_result:',OTHER). |
397 | | |
398 | | % expand and pretty print solver result values: |
399 | | solver_pp_bvalue(Value,Options,EValue,PPValue) :- member(force_evaluation,Options),!, |
400 | | EXPAND=force, |
401 | | normalise_value_for_var(solver_result,EXPAND,Value,EValue), % will suspend if timeout occurs! |
402 | | solver_pp_bvalue2(EValue,Options,PPValue). |
403 | | solver_pp_bvalue(Value,Options,Value,PPValue) :- solver_pp_bvalue2(Value,Options,PPValue). |
404 | | |
405 | | solver_pp_bvalue2(Value,Options,PPValue) :- member(truncate(Limit),Options),!, |
406 | | translate_bvalue_with_limit(Value,Limit,PPValue). % should we also control expand_avl_upto ?? |
407 | | solver_pp_bvalue2(Value,Options,PPValue) :- member(truncate,Options),!, |
408 | | translate_bvalue_with_limit(Value,10000,PPValue). |
409 | | solver_pp_bvalue2(Value,_,PPValue) :- translate_bvalue(Value,PPValue). |
410 | | |
411 | | % check if a typed expression references an unfixed deferred set in some inner node |
412 | | predicate_uses_unfixed_deferred_set(TExpr) :- predicate_uses_unfixed_deferred_set(TExpr,_). |
413 | | |
414 | | predicate_uses_unfixed_deferred_set(TExpr,CType) :- |
415 | | unfixed_deferred_set_exists, % check first if some unfixed deferred set exists |
416 | ? | map_over_typed_bexpr(solver_interface:uses_unfixed_ds_aux,TExpr,CType). |
417 | | :- public uses_unfixed_ds_aux/2. |
418 | | uses_unfixed_ds_aux(TExpr,DSType) :- get_texpr_type(TExpr,Type), |
419 | ? | contains_unfixed_deferred_set(Type,DSType). |
420 | | |
421 | | % find a typed id whose type references an unfixed deferred set |
422 | | unfixed_typed_id_in_list(TID,CType,Constants) :- |
423 | | unfixed_deferred_set_exists, % check first if some unfixed deferred set exists |
424 | ? | member(TID,Constants), get_texpr_type(TID,CType), |
425 | | contains_unfixed_deferred_set(CType). |
426 | | |
427 | | :- use_module(library(lists),[maplist/3, include/3]). |
428 | | type_check_in_machine_context(Predicates, TPredicates) :- |
429 | | % create an empty type environment |
430 | | % and store the known types of variables / constants |
431 | | % otherwise, we might be unable to type variables from |
432 | | % machines somewhere in the refinement hierarchy |
433 | | % (their typing predicate might not be in the hypothesis) |
434 | | % Definitions are also added to the environment since the typechecker |
435 | | % inlines definitions. |
436 | | env_empty(E), |
437 | | b_get_machine_variables(V), b_get_machine_constants(C), |
438 | | % add theory operators |
439 | | full_b_machine(Machine), |
440 | | get_section(operators,Machine,Operators), |
441 | | keys_and_values(Operators,Ids,Ops), |
442 | | foldl(env_store_operator,Ids,Ops,E,EWithTheories), |
443 | | get_section(definitions, Machine, Definitions), |
444 | | foldl(env_store_definition, Definitions, EWithTheories, EWithDefinitions), |
445 | | % constants and variables |
446 | | findall(b(identifier(Name),global(GlobalSet),[enumerated_set_element]),is_b_global_constant(GlobalSet,_Nr,Name),GC), |
447 | | findall(b(identifier(Set),set(global(Set)),[given_set]),b_global_set(Set),GS), |
448 | | add_identifiers_to_environment(V,EWithDefinitions,EV), |
449 | | add_identifiers_to_environment(C,EV,EVC), |
450 | | add_identifiers_to_environment(GC,EVC,EVCGC), |
451 | | add_identifiers_to_environment(GS,EVCGC,EOut), |
452 | | opentype(Predicates, EOut, Identifiers, DeferredSets, TPredicates), |
453 | | % DeferredSets should be empty? I.e. should this be allowed to create new types? |
454 | | % currently this would not work as these types have not been added/registered in b_global_sets ! kernel_objects:basic_type would fail |
455 | | (DeferredSets = [] -> true |
456 | | ; include(problematic_id(DeferredSets),Identifiers,TErrIds), |
457 | | maplist(get_texpr_id,TErrIds,ErrIds), |
458 | | add_warning(solver_interface,'The types of some variables could not be determined: ',ErrIds), |
459 | | fail). |
460 | | % a possible refactoring for the above - however, it does not type with open identifiers |
461 | | % reverted it for now |
462 | | % bmachine:b_type_expressions(Predicates,[constants],_Types,TPredicates,Errors), |
463 | | % add_all_perrors(Errors,[],type_expression_error), |
464 | | % no_real_perror_occurred(Errors). |
465 | | |
466 | | problematic_id(DeferredSets,TID) :- get_texpr_type(TID,Type), |
467 | | uses_def_set(Type,DeferredSets). |
468 | | |
469 | | uses_def_set(global(T),DeferredSets) :- member(T,DeferredSets). |
470 | | uses_def_set(set(A),DeferredSets) :- uses_def_set(A,DeferredSets). |
471 | | uses_def_set(seq(A),DeferredSets) :- uses_def_set(A,DeferredSets). |
472 | | uses_def_set(couple(A,_),DeferredSets) :- uses_def_set(A,DeferredSets). |
473 | | uses_def_set(couple(_,A),DeferredSets) :- uses_def_set(A,DeferredSets). |
474 | | uses_def_set(record(F),DS) :- member(field(_,T),F), uses_def_set(T,DS). |
475 | | % TO DO: add freetypes |