1 | % (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
2 | % Heinrich Heine Universitaet Duesseldorf | |
3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
4 | ||
5 | ||
6 | :- module(b_compiler,[b_compile/6, b_optimize/6, b_compile_closure/2]). | |
7 | ||
8 | :- use_module(library(lists)). | |
9 | ||
10 | :- use_module(self_check). | |
11 | :- use_module(bsyntaxtree). | |
12 | :- use_module(error_manager). | |
13 | :- use_module(debug,[debug_format/3]). | |
14 | :- use_module(btypechecker,[fasttype/2]). | |
15 | :- use_module(bmachine,[b_get_machine_operation_for_animation/6]). | |
16 | :- use_module(b_interpreter). | |
17 | :- use_module(custom_explicit_sets). | |
18 | :- use_module(kernel_waitflags,[add_error_wf/5, add_internal_error_wf/5]). | |
19 | %:- use_module(bmachine,[b_operation_reads_output_variables/3]). | |
20 | :- use_module(probsrc(performance_messages),[performance_monitoring_on/0,perfmessage/3]). | |
21 | ||
22 | :- use_module(module_information,[module_info/2]). | |
23 | :- module_info(group,interpreter). | |
24 | :- module_info(description,'This module compiles set comprehensions into closures; making them independent of the state of the B machine.'). | |
25 | ||
26 | /* compile boolean expression into a closure where the local state and the global | |
27 | state has been incorporated, but any parameter is left in the closure */ | |
28 | ||
29 | :- public test_bexpr/3, test_bexpr2/3. | |
30 | test_bexpr(Expr,[bind(cc,int(1)),bind(nn,int(2))], [bind(db,[(int(1),int(2))])]) :- | |
31 | fasttype( +conjunct( +conjunct( +member( global('Name')<<identifier(nn), +identifier('Name')), | |
32 | +member( global('Code')<<identifier(cc), +identifier('Code'))), | |
33 | +not_member( global('Name')<<identifier(nn), | |
34 | +domain(set(couple(global('Name'),global('Code')))<<identifier(db)))), Expr). | |
35 | ||
36 | test_bexpr2(Expr,[],[]) :- | |
37 | fasttype( +implication( +equal( seq(any)<<identifier(ss), +empty_sequence), | |
38 | +equal( set(any)<<identifier(res), +empty_set)), Expr). | |
39 | ||
40 | ||
41 | ||
42 | b_compile_closure(closure(P,T,Body),Res) :- b_compiler:b_compile(Body,P,[],[],CBody),!, Res=closure(P,T,CBody). | |
43 | b_compile_closure(C,C). | |
44 | ||
45 | ||
46 | % difference with b_compile: the states LS, S will not be thrown away by the interpreter | |
47 | % thus: we do not have to compile all accesses, in particular lazy lookups ! | |
48 | %b_optimize(TExpr,Parameters,_LS,_S,NTExpr,_WF) :- TExpr=b(_,_,Infos), member(already_optimized,Infos), | |
49 | % !, NTExpr=TExpr. | |
50 | b_optimize(TExpr,Parameters,LS,S,NTExpr,WF) :- %print('OPTIMIZE: '),translate:print_bexpr(TExpr),nl, trace, | |
51 | append(LS,[bind('$optimize_do_not_force_lazy_lookups',pred_true)],NewLS), | |
52 | b_compile(TExpr,Parameters,NewLS,S,NTExpr,WF). | |
53 | %bsyntaxtree:add_texpr_info_if_new(NTExpr,already_optimized,ResTExpr). | |
54 | ||
55 | b_compile(TExpr,Parameters,NewLS,S,NTExpr) :- | |
56 | b_compile(TExpr,Parameters,NewLS,S,NTExpr,no_wf_available). % for unit tests | |
57 | ||
58 | :- assert_must_succeed(( b_compiler:test_bexpr(E,L,S), | |
59 | b_compiler:b_compile(E,[nn],L,S,_R) )). | |
60 | :- assert_must_succeed(( b_compiler:test_bexpr2(E,L,S), | |
61 | b_compiler:b_compile(E,[ss,res],L,S,_R) )). | |
62 | :- assert_must_succeed(( b_compiler:b_compile(b(greater(b(value(int(2)),integer,[]), | |
63 | b(value(int(1)),integer,[])),pred,[]),[],[],[],Res), | |
64 | check_eq(Res,b(truth,pred,_)) )). | |
65 | :- assert_must_succeed(( b_compiler:b_compile(b(greater(b(value(int(2)),integer,[]), | |
66 | b(value(int(3)),integer,[])),pred,[]),[],[],[],Res), | |
67 | check_eq(Res,b(falsity,pred,_)) )). | |
68 | :- assert_must_succeed(( E = b(greater(b(value(int(2)),integer,[]), | |
69 | b(value(int(_)),integer,[])),pred,[]), | |
70 | b_compiler:b_compile(E,[],[],[],Res), | |
71 | check_eq(Res,E) )). | |
72 | :- assert_must_succeed(( E = b(greater(b(value(int(2)),integer,[]), | |
73 | b(value(_),integer,[])),pred,[]), | |
74 | b_compiler:b_compile(E,[],[],[],Res), | |
75 | check_eq(Res,E) )). | |
76 | :- assert_must_succeed(( E = b(greater(b(value(int(2)),integer,[]), | |
77 | b(identifier(x),integer,[])),pred,[]), | |
78 | b_compiler:b_compile(E,[],[bind(x,int(1))],[],Res), | |
79 | check_eq(Res,b(truth,pred,_)) )). | |
80 | :- assert_must_succeed(( E = b(greater(b(value(int(2)),integer,[]), | |
81 | b(identifier(x),integer,[])),pred,[]), | |
82 | b_compiler:b_compile(E,[],[bind(x,int(3))],[],Res), | |
83 | check_eq(Res,b(falsity,pred,_)) )). | |
84 | ||
85 | %:- assert_pre(b_compiler:b_compile_boolean_expression(E,Parameters,LS,S,_), | |
86 | % (type_check(E,boolean_expression),type_check(Parameters,list(variable_id)), | |
87 | % type_check(LS,store),type_check(S,store))). | |
88 | %:- assert_post(b_compiler:b_compile_boolean_expression(_,_,_,_,E), type_check(E,boolean_expression)). | |
89 | ||
90 | /* probably not worthwhile: | |
91 | b_compile(TExpr,Parameters,LS,S,NTExpr) :- get_texpr_info(TExpr,Info), | |
92 | (memberchk(compiled(Parameters),Info) -> NTExpr = TExpr ,print(already_compiled(Parameters)),nl, translate:print_bexpr(TExpr),nl | |
93 | ; b_compile0(TExpr,Parameters,LS,S,b(E,T,I)), translate:print(compiling(Parameters)),nl, translate:print_bexpr(TExpr),nl, | |
94 | NTExpr = b(E,T,[compiled(Parameters)|I])). | |
95 | */ | |
96 | :- use_module(closures,[get_recursive_identifier_of_closure_body/2]). | |
97 | b_compile(TExpr,Parameters,LS,S,NTExpr,WF) :- | |
98 | check_is_id_list(Parameters,Parameters0), | |
99 | (get_recursive_identifier_of_closure_body(TExpr,TRID), | |
100 | def_get_texpr_id(TRID,RID), nonmember(bind(RID,_),LS) | |
101 | -> Parameters1=[RID|Parameters0] % add recursive ID virtually to parameters to avoid error messages | |
102 | ; Parameters1=Parameters0), | |
103 | % print('compile : '),translate:print_bexpr(TExpr),nl, statistics(runtime,[Start,_]),%% | |
104 | sort(Parameters1,Parameters2), | |
105 | if(b_compile1(TExpr,Parameters2,LS,S,NTExpr0,eval,FullyKnown,WF), | |
106 | (FullyKnown=true | |
107 | -> copy_pos_infos(TExpr,NTExpr0,NTExpr) | |
108 | % ensure position info is not deleted if full expression compiled away, see PROB-412 (test 1677) | |
109 | ; NTExpr=NTExpr0), | |
110 | (add_internal_error_wf(b_compiler,'Compilation failed: ',TExpr,TExpr,WF), | |
111 | %b_compile1(TExpr,Parameters1,LS,S,NTExpr0,eval,_FullyKnown,WF), | |
112 | NTExpr = TExpr) | |
113 | ). | |
114 | %, bsyntaxtree:check_ast(NTExpr). | |
115 | %, check_infos(TExpr,NTExpr). | |
116 | %, print('compiled: '), translate:print_bexpr(NTExpr), print(' '),statistics(runtime,[Stop,_]), T is Stop-Start, print(T), print(' ms '),nl, bsyntaxtree:check_ast(NTExpr). % , print(NTExpr),nl. check_ast | |
117 | ||
118 | /* | |
119 | check_infos(Old,New) :- bsyntaxtree:get_texpr_info(Old,IO), | |
120 | bsyntaxtree:get_texpr_info(New,IN), | |
121 | member(X,IO), \+ member(X,IN), | |
122 | bsyntaxtree:important_info(X), | |
123 | print(check_infos(Old,New)),nl, | |
124 | print('Not copied: '), print(X),fail. | |
125 | check_infos(_,_). */ | |
126 | ||
127 | :- use_module(bsyntaxtree,[always_well_defined/1]). | |
128 | :- use_module(translate,[translate_bexpression_with_limit/2]). | |
129 | %:- use_module(hit_profiler,[add_profile_hit/1]). | |
130 | ||
131 | % Eval=eval means the expression will be needed in a successful branch and we can pre-compute more aggressively | |
132 | % Eval=false means the expression may not be needed (e.g., in a disjunction) and only perform efficient precomputations | |
133 | b_compile1(TExpr,Parameters,LS,S,ResultTExpr,Eval,FullyKnown1,WF) :- | |
134 | TExpr = b(Expr,Type,Infos), | |
135 | NTExpr = b(NewUntypedExpr,Type,NewInfos), | |
136 | %remove_bt(TExpr,Expr,NewUntypedExpr,NTExpr), % remove top-level Type Information | |
137 | %hit_profiler:add_profile_hit(Expr), | |
138 | %functor(Expr,E1,N1), %print(start_compile(E1/N1,Eval,FullyKnown1)),nl, | |
139 | b_compile1_infos(Expr,Type,Infos,Parameters,LS,S,NewUntypedExpr,NewInfos,Eval,FullyKnown,WF), | |
140 | %functor(NewUntypedExpr,E2,N2), | |
141 | %format(' compiled ~w/~w -> ~w/~w : ',[E1,N1,E2,N2]),translate:print_bexpr_or_subst(NTExpr),nl, | |
142 | %format(' fully=~w, eval=~w~n',[FullyKnown,Eval]), | |
143 | (NTExpr = b(value(_),_,_) | |
144 | -> FullyKnown1=FullyKnown, ResultTExpr=NTExpr | |
145 | ; FullyKnown=true, evaluate_this(Eval,NewUntypedExpr,Type,NewInfos) | |
146 | -> % print('eval : '),translate:print_bexpr(NTExpr),nl, % | |
147 | (nonvar(NewUntypedExpr), | |
148 | % if( would be more prudent !?, also: we used to call b_compute_expression_nowf | |
149 | b_interpreter:b_compute_expression(NTExpr,LS,S,ResultValue,WF) | |
150 | -> %print(result(ResultValue)),nl, | |
151 | %remove_bt(TExpr,Expr,value(ResultValue),ResultTExpr) | |
152 | get_texpr_type(TExpr,TT),ResultTExpr = b(value(ResultValue),TT,[]), | |
153 | FullyKnown1 = FullyKnown | |
154 | %, print(compiled_value(ResultTExpr)),nl | |
155 | ; add_internal_error_wf(b_compiler,'Undefined value marked for evaluation:',NTExpr,Infos,WF), | |
156 | %trace, b_interpreter:b_compute_expression(NTExpr,LS,S,ResultValue,WF), | |
157 | ResultTExpr=NTExpr, FullyKnown1=false | |
158 | ) | |
159 | ; % ((FullyKnown=true, NTExpr\=b(value(_),_,_)) -> format('not eval: ~w (~w)~n',[NTExpr,Eval]) ; true), | |
160 | ResultTExpr=NTExpr, FullyKnown1=false | |
161 | ). | |
162 | ||
163 | ||
164 | :- use_module(library(ordsets),[ord_member/2, ord_union/3]). | |
165 | :- use_module(bsyntaxtree,[create_exists_or_let_predicate/3]). | |
166 | :- use_module(tools_lists,[delete_first/3]). | |
167 | add_parameters(SortedIds,NewIds,NewSortedIds) :- | |
168 | sort(NewIds,SNew), | |
169 | ord_union(SortedIds,SNew,NewSortedIds). | |
170 | ||
171 | b_compile1_infos(exists(ExistsPara,Pred),_,OldInfos,Parameters,LS,S,NExpr,NewInfos,Eval,FullyKnown,WF) :- !, | |
172 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
173 | get_texpr_ids(ExistsPara,AtomicIds), | |
174 | add_parameters(Parameters,AtomicIds,NParameters), | |
175 | b_compile1(Pred,NParameters,LS,S,NPred,Eval,_FullyKnown1,WF), | |
176 | (is_falsity(NPred) -> NExpr = falsity, NewInfos = OldInfos | |
177 | ; is_truth(NPred) -> NExpr = truth, NewInfos = OldInfos | |
178 | %; Pred==NPred, write(unchanged(Parameters)),nl, member(used_ids(Old),OldInfos), print(used(Old)),nl,nl,fail | |
179 | ; create_exists_or_let_predicate(ExistsPara,NPred,b(NExpr,pred,NI)), | |
180 | %print('COMPILED EXISTS: '), translate:print_bexpr(b(NExpr,pred,NI)),nl, | |
181 | (delete_first(OldInfos,used_ids(_),I1), | |
182 | member(used_ids(NewUsedIds),NI) -> NewInfos = [used_ids(NewUsedIds)|I1] | |
183 | ; %nl,print(missing_used_ids(OldInfos,NI)),nl, % can happen when we construt a let_predicate above | |
184 | update_infos(NExpr,OldInfos,Parameters,NewInfos)) | |
185 | ). | |
186 | b_compile1_infos(identifier(Id),Type,OldInfos,Parameters,LS,S,NExpr,NewInfos,_Eval,FullyKnown,WF) :- !, | |
187 | ( ord_member(Id,Parameters) -> | |
188 | NExpr = identifier(Id), FullyKnown=false, NewInfos = OldInfos | |
189 | ; Id=op(_) -> | |
190 | NExpr = identifier(Id), FullyKnown=false, NewInfos = OldInfos | |
191 | ; b_interpreter:lookup_value_in_store_and_global_sets_wf(Id,Type,LS,S,Value,OldInfos,WF) -> | |
192 | NExpr = value(Value), (known_value(Value) -> FullyKnown=true ; FullyKnown=false), | |
193 | NewInfos = [was_identifier(Id)|OldInfos] | |
194 | ; add_internal_error_wf(b_compiler,'Compilation of identifier failed: ',Id,OldInfos,WF), | |
195 | NExpr = identifier(Id), FullyKnown=false, NewInfos = OldInfos | |
196 | ). | |
197 | b_compile1_infos(Expr,_,OldInfos,_Parameters,_LS,_S,NewUntypedExpr,NewInfos,_Eval,FullyKnown,_WF) :- | |
198 | b_ast_cleanup:is_integer_set(Expr,_Set),!, | |
199 | NewUntypedExpr=Expr, NewInfos=OldInfos,FullyKnown=true. | |
200 | b_compile1_infos(operation_call_in_expr(Operation,OpCallParas),_Type,OldInfos,Parameters,LS,S, | |
201 | Compiled,NewInfos,Eval,FullyKnown,WF) :- !, | |
202 | def_get_texpr_id(Operation,op(OperationName)), | |
203 | FullyKnown = false, | |
204 | b_compile_l(OpCallParas,Parameters,LS,S,OpCallParaValues,Eval,_,WF), | |
205 | b_get_operation_normalized_read_write_info(OperationName,ReadVars,Modified), | |
206 | %exclude(operation_identifier,Read,ReadVars), % Read used to contain operations used via operation_call_in_expr; TO DO: check if this is ok in other places of source code of ProB; see test 1957 | |
207 | (Modified=[] -> true | |
208 | ; add_error_wf(b_compiler,'Calling operation that modifies state in expression:',OperationName,OldInfos,WF)), | |
209 | % print(compile_call_op(OperationName,ReadVars,Modified,OpCallParaValues)),nl, | |
210 | (ReadVars=[] | |
211 | -> Compiled = operation_call_in_expr(Operation,OpCallParaValues), | |
212 | NewInfos = OldInfos | |
213 | ; maplist(create_value_for_read_variable(LS,S,WF),ReadVars,TRead,TValues), | |
214 | safe_create_texpr(let_expression_global(TRead,TValues, | |
215 | b(operation_call_in_expr(Operation,OpCallParaValues),any,OldInfos)),any,[generated_by_b_compiler],New), | |
216 | New = b(Compiled,_,NewInfos) | |
217 | %NewInfos = [generated_by_b_compiler], | |
218 | %Compiled = let_expression_global(TRead,TValues, | |
219 | % b(operation_call_in_expr(Operation,OpCallParaValues),any,OldInfos)) | |
220 | ). | |
221 | b_compile1_infos(kodkod(Id,Identifiers),_,OldInfos,Parameters,LS,S,NExpr,NewInfos,_Eval,FullyKnown,WF) :- !, | |
222 | FullyKnown=false, NewInfos=OldInfos, | |
223 | exclude(is_parameter(Parameters),Identifiers,IdsToCompile), | |
224 | (IdsToCompile=[] | |
225 | -> NExpr = kodkod(Id,Identifiers) | |
226 | ; maplist(precompile_id(LS,S,WF),IdsToCompile,Values), | |
227 | % as we cannot inspect kodkod problem: wrap it into a let with the values stored: | |
228 | NExpr = let_predicate(IdsToCompile,Values,b(kodkod(Id,Identifiers),pred,OldInfos)) | |
229 | ). | |
230 | b_compile1_infos(Expr,_,OldInfos,Parameters,LS,S,NewUntypedExpr,NewInfos,Eval,FullyKnown,WF) :- | |
231 | b_compile2(Expr,Parameters,LS,S,NewUntypedExpr,Eval,FullyKnown,WF), | |
232 | update_infos(NewUntypedExpr,OldInfos,Parameters,NewInfos). | |
233 | ||
234 | ||
235 | is_parameter(Parameters,b(identifier(Id),_,_)) :- ord_member(Id,Parameters). | |
236 | ||
237 | precompile_id(LS,S,WF,b(identifier(Id),Type,Info),b(value(Value),Type,[])) :- | |
238 | b_interpreter:lookup_value_in_store_and_global_sets_wf(Id,Type,LS,S,Value,Info,WF). | |
239 | % was_identifier is aded in b_compile1_infos | |
240 | ||
241 | :- use_module(bmachine,[b_get_operation_normalized_read_write_info/3]). | |
242 | ||
243 | %operation_identifier(op(_)). | |
244 | create_value_for_read_variable(LS,S,WF,Variable,TVariable,TValue) :- | |
245 | b_interpreter:lookup_value_in_store_and_global_sets_wf(Variable,_Type,LS,S,Value,unknown,WF),!, | |
246 | % TO DO: try and find type? | |
247 | TVariable = b(identifier(Variable),any,[]), | |
248 | TValue = b(value(Value),any,[]). | |
249 | create_value_for_read_variable(_LS,_S,WF,Variable,TVariable,b(value(term(undefined)),any,[])) :- | |
250 | TVariable = b(identifier(Variable),any,[]), | |
251 | add_internal_error_wf(b_compiler,'Cannot find variable (read) while compiling operation:',Variable,unknown,WF), | |
252 | fail. | |
253 | ||
254 | :- use_module(library(ordsets)). | |
255 | update_infos(forall(EParas,LHS,RHS),Infos,Parameters,NewInfos) :- | |
256 | % forall also has used_ids field as it may call exists in negative context | |
257 | conjunct_predicates([LHS,RHS],Cond), | |
258 | update_infos_aux(EParas,Cond,Infos,Parameters,NewInfos),!. | |
259 | update_infos(exists(EParas,Cond),Infos,Parameters,NewInfos) :- % we create_exists_or_let_predicate above, but other transformations may generate an exists below: | |
260 | update_infos_aux(EParas,Cond,Infos,Parameters,NewInfos),!. | |
261 | update_infos(BOP,Infos,_,NewInfos) :- bsyntaxtree:syntaxelement(BOP, [A,B],[], [], [], _), | |
262 | wd_and_efficient(BOP), % should not generate WD errors itself | |
263 | (select(contains_wd_condition,Infos,NewInfos) % there is a WD condition attached | |
264 | -> fast_check_wd(A), | |
265 | fast_check_wd(B) | |
266 | ), | |
267 | %print(removing_wd_condition(BOP)),nl, | |
268 | !. | |
269 | update_infos(_,I,_,I). | |
270 | ||
271 | update_infos_aux(EParas,Cond,Infos,Parameters,NewInfos) :- | |
272 | select_used_ids(UsedIds,Infos,I1,EParas,Cond), | |
273 | UsedIds \= [],!, | |
274 | % remove those used identifiers which will be compiled into the predicate | |
275 | sort(Parameters,SParas), | |
276 | ord_intersection(UsedIds,SParas,NewUsedIds), | |
277 | %print(update(Parameters,UsedIds,I1,new(NewUsedIds))),nl, | |
278 | NewInfos = [used_ids(NewUsedIds)|I1]. | |
279 | ||
280 | :- use_module(bsyntaxtree,[find_identifier_uses/3]). | |
281 | select_used_ids(UsedIds,Infos,I1,_,_) :- select(used_ids(UsedIds),Infos,I1),!. | |
282 | % check_used_ids_info(Parameters,Condition,UsedIds,b_compiler) | |
283 | select_used_ids(UsedIds,Infos,Infos,_Parameters,Condition) :- | |
284 | %add_error(bcompiler,'Expected information of used identifiers in exists operation information : ',Parameters:Infos), %% missing info can happen due to simplifcation rules below ! | |
285 | find_identifier_uses(Condition, [], UsedIds). % ,print(used(UsedIds,in_exist(Parameters))),nl. | |
286 | % TO DO: avoid re-computing used-ids; we should refactor b_compile2 to return new Info field | |
287 | ||
288 | ||
289 | ||
290 | evaluate_this(eval,X,Type,Info) :- !, worth_it_type(Type,X,Info). | |
291 | evaluate_this(_,function(A,B),Type,Info) :- !, | |
292 | A=b(value(VA),_,_), nonvar(VA), VA=avl_set(_), | |
293 | B=b(value(_),_,_), | |
294 | worth_it_type(Type,function(A,B),Info). % will check well-definedness | |
295 | evaluate_this(_,X,_Type,_Info) :- wd_and_efficient(X). | |
296 | ||
297 | ||
298 | % things which are very quick to compute | |
299 | wd_and_efficient(sequence_extension(_)) :- !. | |
300 | wd_and_efficient(set_extension(_)) :- !. | |
301 | wd_and_efficient(integer_set(_)) :- !. % will be converted into value(global_set(_)) | |
302 | %% wd_and_efficient(value(_)) :- !. % is already computed | |
303 | % the following will reduce the size of the representation; usually a good thing; | |
304 | % we assume only avl_sets apprear here; inner set comprehensions are never computed into symbolic form by b_compile (see known_value below): | |
305 | %wd_and_efficient(identity(_)) :- !. | |
306 | wd_and_efficient(range(_)) :- !. | |
307 | wd_and_efficient(domain(_)) :- !. | |
308 | wd_and_efficient(domain_restriction(_,_)) :- !. | |
309 | wd_and_efficient(domain_subtraction(_,_)) :- !. | |
310 | wd_and_efficient(range_restriction(_,_)) :- !. | |
311 | wd_and_efficient(range_subtraction(_,_)) :- !. | |
312 | wd_and_efficient(intersection(_,_)) :- !. | |
313 | wd_and_efficient(set_subtraction(_,_)) :- !. | |
314 | wd_and_efficient(image(_,_)) :- !. | |
315 | wd_and_efficient(reverse(_)) :- !. % added for rgen_rgen_Worst_Case_Stopping_distance_NCT_trm13 | |
316 | % reverse has n.log(n) complexity, but is always wd and can be beneficial | |
317 | wd_and_efficient(union(A,B)) :- finite_set(A), finite_set(B), !. % has complexity n | |
318 | % usually the union of two avl_sets will be smaller than keeping them separate, what about intervals? | |
319 | wd_and_efficient(interval(_,_)) :- !. % ditto | |
320 | wd_and_efficient(card(S)) :- !, % added for rgen_rgen_Worst_Case_Stopping_distance_NCT_trm13 | |
321 | (finite_set(S) -> true % is wd for finite set; has currently linear complexity but reduces size of closure | |
322 | ; is_interval(S) -> true). % card is simple to compute | |
323 | wd_and_efficient(min(S)) :- !, % logarithmic for avl_set, see test 1338 | |
324 | finite_non_empty_set(S). | |
325 | wd_and_efficient(max(S)) :- !, % logarithmic for avl_set | |
326 | finite_non_empty_set(S). | |
327 | wd_and_efficient(string_set) :- !. | |
328 | % some other efficient operators: | |
329 | % external_function_call CHOOSE (test 1338) ? | |
330 | % first, last, ... need to ensure we have sequence | |
331 | wd_and_efficient(X) :- worth_it_int(X),!. | |
332 | wd_and_efficient(X) :- worth_it_other(X). | |
333 | ||
334 | is_interval(b(value(V),set(_),_)) :- nonvar(V), V=closure(P,T,B), | |
335 | is_fixed_interval(P,T,B,_,_). | |
336 | ||
337 | finite_set(b(value(V),set(_),_)) :- nonvar(V), finite_set_aux(V). | |
338 | finite_set_aux([]). | |
339 | finite_set_aux(avl_set(_)). | |
340 | finite_non_empty_set(b(value(V),set(_),_)) :- nonvar(V), V=avl_set(_). | |
341 | ||
342 | fast_check_wd(b(E,_,Infos)) :- | |
343 | (nonmember(contains_wd_condition,Infos) -> true | |
344 | ; nonvar(E), E=value(_)). | |
345 | ||
346 | check_wd(NTExpr) :- bsyntaxtree:always_well_defined(NTExpr). % ,print(wd(NTExpr)),nl. | |
347 | %(bsyntaxtree:always_well_defined(NTExpr) -> true ; print(not_guaranteed_wd(NTExpr)),nl). | |
348 | ||
349 | % (worth_it_type(Type,X,Info) -> true ; X=value(_) -> true ; print(not_evaluating(X)),nl,fail). | |
350 | worth_it_type(integer,X,Info) :- worth_it_int_wd(X),!, check_wd(b(X,integer,Info)). | |
351 | worth_it_type(T,function(A,B),Info) :- !, | |
352 | (check_wd(b(function(A,B),T,Info)) -> true | |
353 | ; fail). %print('not_precompiling_function '),translate:print_bexpr(A), print(' @ '), translate:print_bexpr(B),nl,fail). | |
354 | worth_it_type(integer,X,_) :- worth_it_int(X),!. | |
355 | worth_it_type(T,X,Info) :- worth_it_wd(X),!, check_wd(b(X,T,Info)). | |
356 | worth_it_type(set(_),X,_) :- worth_it_set(X),!. | |
357 | worth_it_type(seq(_),X,_) :- worth_it_set(X),!. | |
358 | worth_it_type(_,X,_) :- worth_it_other(X). | |
359 | ||
360 | % TO DO: we should use the predicate has_wd_condition from b_ast_cleanup | |
361 | ||
362 | % integer operations that could generate WD-errors | |
363 | worth_it_int_wd(div(_,_)). | |
364 | worth_it_int_wd(max(_)). | |
365 | worth_it_int_wd(min(_)). | |
366 | worth_it_int_wd(mod(_,_)). | |
367 | worth_it_int_wd(power_of(_,_)). | |
368 | worth_it_int_wd(card(_)). % has WD condition !! | |
369 | worth_it_int_wd(size(_)). | |
370 | ||
371 | % other operations that could generate WD-errors | |
372 | worth_it_wd(first(_)). | |
373 | worth_it_wd(last(_)). | |
374 | worth_it_wd(tail(_)). | |
375 | worth_it_wd(front(_)). | |
376 | worth_it_wd(restrict_front(_,_)). | |
377 | worth_it_wd(restrict_tail(_,_)). | |
378 | worth_it_wd(rel_iterate(_,_)). %% could be expensive | |
379 | worth_it_wd(general_intersection(_)). | |
380 | worth_it_wd(general_concat(_)). | |
381 | ||
382 | % to do: check other operators that could be not well-defined ! | |
383 | ||
384 | worth_it_int(unary_minus(_)). | |
385 | worth_it_int(add(_,_)). | |
386 | worth_it_int(minus(_,_)). | |
387 | worth_it_int(multiplication(_,_)). | |
388 | worth_it_int(max_int). | |
389 | worth_it_int(min_int). | |
390 | ||
391 | %worth_it_set(empty_set). % treated below | |
392 | %worth_it_set(empty_sequence). % treated below | |
393 | %worth_it_set(closure(_)). % this is closure1; it is currently always kept symbolic and can be counterproductive to compile; e.g., card(closure1(%x.(x : 1 .. 200|x + 1))) | |
394 | %% ?? need to be more careful here; can be expensive --> need to keep track which parts need definitely to be evaluated | |
395 | worth_it_set(integer_set(_)). % will be converted into value(global_set(_)) | |
396 | worth_it_set(comprehension_set(A,B)) :- b_ast_cleanup:is_integer_set(comprehension_set(A,B),_). | |
397 | worth_it_set(interval(_,_)). | |
398 | worth_it_set(reflexive_closure(A)) :- \+ symbolic_value(A). | |
399 | worth_it_set(reverse(_)). % function inverse | |
400 | worth_it_set(domain(_)). worth_it_set(range(_)). | |
401 | worth_it_set(union(_,_)). worth_it_set(intersection(_,_)). worth_it_set(set_subtraction(_,_)). | |
402 | worth_it_set(image(_,B)) :- \+ symbolic_value(B). | |
403 | worth_it_set(composition(_,_)). | |
404 | worth_it_set(domain_restriction(_,_)). worth_it_set(domain_subtraction(_,_)). | |
405 | worth_it_set(range_restriction(_,_)). worth_it_set(range_subtraction(_,_)). | |
406 | worth_it_set(direct_product(A,B)) :- \+ symbolic_value(A), \+ symbolic_value(B). | |
407 | worth_it_set(parallel_product(A,B)) :- \+ symbolic_value(A), \+ symbolic_value(B). | |
408 | worth_it_set(iteration(_,_)). | |
409 | worth_it_set(set_extension([H|_])) :- \+ symbolic_value(H). % otherwise we may get an enumeration warning | |
410 | worth_it_set(sequence_extension([H|_])) :- \+ symbolic_value(H). % ditto, TODO: check tail unless expensive | |
411 | worth_it_set(rev(_)). % reverse of sequence | |
412 | worth_it_set(concat(_,_)). | |
413 | worth_it_set(seq(_)). % will be kept symbolic anyway | |
414 | worth_it_set(seq1(_)). % will be kept symbolic anyway; relevant for test 1731 | |
415 | % f=%x.(x:iseq(struct(a:seq1(NATURAL),b:BOOL))|x) & f([rec(a:[222],b:TRUE)])=[rec(a:[222],b:xx)] & xx=TRUE | |
416 | % however: value can be put into a set-extension! | |
417 | worth_it_set(iseq(_)). % will be kept symbolic anyway | |
418 | worth_it_set(iseq1(_)). % will be kept symbolic anyway | |
419 | worth_it_set(perm(_)). % will be kept symbolic anyway | |
420 | worth_it_set(pow_subset(_)). % will be kept symbolic anyway | |
421 | worth_it_set(pow1_subset(_)). % will be kept symbolic anyway | |
422 | worth_it_set(fin_subset(_)). % will be kept symbolic anyway | |
423 | worth_it_set(fin1_subset(_)). % will be kept symbolic anyway | |
424 | worth_it_set(general_union(X)) :- \+ symbolic_value(X). % otherwise we can get enumeration warnings | |
425 | worth_it_set(identity(_)). | |
426 | worth_it_set(first_of_pair(_)). % can also produce set | |
427 | worth_it_set(second_of_pair(_)). % can also produce set | |
428 | worth_it_set(cartesian_product(_,_)). % will usually be kept symbolic | |
429 | worth_it_set(string_set). % ensure we have values inside compiled closures, e.g., for custom_explicit_set card computations | |
430 | worth_it_set(bool_set). | |
431 | ||
432 | symbolic_value(b(value(Val),_,_)) :- nonvar(Val), symbolic_val_aux(Val). | |
433 | symbolic_val_aux(closure(P,T,B)) :- \+ is_fixed_interval(P,T,B,_,_). | |
434 | symbolic_val_aux(global_set(_)). | |
435 | ||
436 | :- use_module(external_functions,[not_declarative/1,external_fun_has_wd_condition/1, | |
437 | expects_unevaluated_args/1]). | |
438 | worth_it_other(boolean_true). | |
439 | worth_it_other(boolean_false). | |
440 | worth_it_other(string(_)). | |
441 | worth_it_other(first_of_pair(_)). | |
442 | worth_it_other(second_of_pair(_)). | |
443 | worth_it_other(couple(_,_)). | |
444 | worth_it_other(record_field(_,_)). | |
445 | worth_it_other(external_function_call(FunName,_)) :- | |
446 | \+ not_declarative(FunName), | |
447 | \+ external_fun_has_wd_condition(FunName). %print(compile(FunName)),nl. | |
448 | % CHOOSE for finite_non_empty_set ? | |
449 | worth_it_other(rec(_)). | |
450 | worth_it_other(struct(_)). | |
451 | %worth_it_other(value(_)). % does not have to be evaluted; already a value | |
452 | ||
453 | /* | |
454 | % To do: distinguish which parts definitely need to be evaluated | |
455 | %dont_eval_subexpressions(member). % special membership code can be used | |
456 | %dont_eval_subexpressions(not_member). % special membership code can be used | |
457 | dont_eval_subexpressions(disjunct(_,_)). % it may not be necessary to eval RHS | |
458 | dont_eval_subexpressions(implication(_,_)). % it may not be necessary to eval RHS | |
459 | */ | |
460 | ||
461 | :- use_module(bsyntaxtree, [get_negated_operator_expr/2]). | |
462 | :- use_module(kernel_objects,[equal_object/3]). | |
463 | :- use_module(kernel_mappings,[binary_boolean_operator/3]). | |
464 | :- use_module(kernel_tools,[filter_cannot_match/4, get_template_for_filter_cannot_match/2]). | |
465 | b_compile2(Exp,_Parameters,_LS,_S,NExpr,_Eval,FullyKnown,WF) :- var(Exp), !, | |
466 | add_internal_error_wf(b_compiler,'Variable Expression: ',Exp,unknown,WF), | |
467 | NExpr=Exp, FullyKnown=false. | |
468 | b_compile2(truth,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=truth, FullyKnown=false. % predicates never fully known | |
469 | b_compile2(falsity,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=falsity, FullyKnown=false. % predicates never fully known | |
470 | b_compile2(empty_set,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=value([]), FullyKnown=true. | |
471 | b_compile2(empty_sequence,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=value([]), FullyKnown=true. | |
472 | b_compile2(boolean_false,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=value(pred_false), FullyKnown=true. | |
473 | b_compile2(boolean_true,_,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, NExpr=value(pred_true), FullyKnown=true. | |
474 | b_compile2(value(Val),_Parameters,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, | |
475 | NExpr=value(Val), | |
476 | (known_value(Val) -> % ground(Val) -> known_value ? | |
477 | FullyKnown=true ; FullyKnown=false). | |
478 | b_compile2(integer(Val),_Parameters,_LS,_S,NExpr,_Eval,FullyKnown,_WF) :- !, | |
479 | NExpr=value(int(Val)), (number(Val) -> FullyKnown=true ; FullyKnown=false). | |
480 | b_compile2(lazy_lookup_pred(Id),Parameters,LS,S,NExpr,_Eval,FullyKnown,WF) :- !, | |
481 | ( ord_member(Id,Parameters) -> %print(lazy_lookup_pred_id_as_parameter(Id,Parameters)),nl, | |
482 | NExpr = lazy_lookup_pred(Id), FullyKnown=false | |
483 | ; compute_lazy_lookup(Id,lazy_lookup_pred(Id),LS,S,NExpr,FullyKnown,WF) | |
484 | ). | |
485 | b_compile2(lazy_lookup_expr(Id),Parameters,LS,S,NExpr,_Eval,FullyKnown,WF) :- !, | |
486 | ( ord_member(Id,Parameters) -> %print(lazy_lookup_expr_id_as_parameter(Id,Parameters)),nl, | |
487 | NExpr = lazy_lookup_expr(Id), FullyKnown=false | |
488 | ; compute_lazy_lookup(Id,lazy_lookup_expr(Id),LS,S,NExpr,FullyKnown,WF) | |
489 | ). | |
490 | ||
491 | % treat a few common cases, more efficiently than syntaxtransformation | |
492 | b_compile2(equal(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
493 | FullyKnown=false, % predicates never evaluated in b_compile1 | |
494 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
495 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnownB,WF), | |
496 | ( FullyKnownA=true, FullyKnownB=true, | |
497 | NExprA = b(value(VA),_,_), NExprB = b(value(VB),_,_) | |
498 | -> (equal_object(VA,VB,b_compile2_1) -> NExpr = truth ; NExpr = falsity) | |
499 | ; generate_equality(NExprA,NExprB,NExpr) | |
500 | ). | |
501 | b_compile2(not_equal(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
502 | FullyKnown=false, % predicates never evaluated in b_compile1 | |
503 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
504 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnownB,WF), | |
505 | ( FullyKnownA=true, FullyKnownB=true, | |
506 | NExprA = b(value(VA),_,_), NExprB = b(value(VB),_,_) | |
507 | -> %print(computing_neq(VA,VB)),nl, | |
508 | (kernel_objects:equal_object(VA,VB,b_compile2_2) -> NExpr = falsity ; NExpr = truth) | |
509 | %, print(result(NExpr)),nl | |
510 | ; NExpr = not_equal(NExprA,NExprB) | |
511 | ). | |
512 | b_compile2(member(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
513 | FullyKnown=false, % predicates never evaluated in b_compile1 | |
514 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnownB,WF), | |
515 | (NExprB = b(value(X),BT,BI) | |
516 | -> (X==[], always_well_defined(A) -> NExpr = falsity | |
517 | ; b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
518 | % check if we can decide membership (e.g., 1:{1}) | |
519 | (quick_test_membership1(NExprA,X,PRes) | |
520 | -> convert_pred_res(PRes,NExpr) | |
521 | % TO DO: maybe optimize x: {y|P(y)} --> P(x) ; by commenting in code below | |
522 | % However, ensure test 273 succeeds and closure equality correctly detected (e.g., for BV16 = {bt|bt : BIT_VECTOR & bv_size(bt) = 16}) | |
523 | % ; (get_texpr_id(NExprA,IDA), | |
524 | % get_comprehension_set(NExprB,IDB,Pred), get_texpr_info(NExprB,Info), | |
525 | % print(rename(IDB,IDA,Info)),nl, | |
526 | % bsyntaxtree:rename_bt(Pred,[rename(IDB,IDA)],PredA)) -> get_texpr_expr(PredA,NExpr) | |
527 | ; custom_explicit_sets:singleton_set(X,El) % replace x:{El} -> x=El | |
528 | -> get_texpr_type(NExprA,TA), | |
529 | generate_equality_with_value(NExprA,FullyKnownA,El,FullyKnownB,TA,NExpr) | |
530 | ; get_template_for_filter_cannot_match(NExprA,VA) | |
531 | -> filter_cannot_match(X,VA,NewX,Filtered), | |
532 | % (Filtered=false -> true ; print(filtered(NewX,VA,X)),nl), | |
533 | (Filtered=false -> NExpr = member(NExprA,NExprB) | |
534 | ; (NewX==[], always_well_defined(A)) -> NExpr = falsity | |
535 | ; custom_explicit_sets:singleton_set(NewX,El) | |
536 | -> get_texpr_type(NExprA,TA), | |
537 | %nl,print(create_equal(NExprA,FullyKnownA,El,FullyKnownB,NExprB)),nl,nl, | |
538 | generate_equality_with_value(NExprA,FullyKnownA,El,FullyKnownB,TA,NExpr) | |
539 | ; NExpr = member(NExprA, b(value(NewX),BT,BI)) | |
540 | ) | |
541 | % end fo filtering | |
542 | ; NExpr = member(NExprA,NExprB) | |
543 | ) | |
544 | % , print('compile: '),print(NExpr),nl | |
545 | ) | |
546 | ; NExpr = member(NExprA,NExprB), | |
547 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF) | |
548 | ). | |
549 | % TO DO: also optimize things like: (ev1 |-> 0) |-> eg : #221:{((1|->0)|->3),((2|->0)|->0),...,((233|->0)|->218),((234|->0)|->228)} | |
550 | ||
551 | b_compile2(not_member(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
552 | FullyKnown=false, % predicates never evaluated in b_compile1 | |
553 | b_compile1(B,Parameters,LS,S,NExprB,Eval,_,WF), | |
554 | (NExprB = b(value(X),_,_) | |
555 | -> (X==[], always_well_defined(A) -> NExpr = truth | |
556 | ; b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
557 | (quick_test_membership1(NExprA,X,PRes) | |
558 | -> convert_neg_pred_res(PRes,NExpr) | |
559 | ; NExpr = not_member(NExprA,NExprB)) | |
560 | ) | |
561 | ; NExpr = not_member(NExprA,NExprB), | |
562 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF) | |
563 | ). | |
564 | b_compile2(function(Fun,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
565 | (is_lazy_extension_function_for_fun_app(Fun) | |
566 | -> Eval1=false % extension function applications treated lazily | |
567 | % TO DO: first evaluate B, if known then only evaluate relevant part of extension function | |
568 | ; Eval1=Eval), | |
569 | b_compile1(Fun,Parameters,LS,S,NExprA,Eval1,FullyKnown1,WF), | |
570 | combine_fully_known(FullyKnown1,FullyKnown2,FullyKnown12), | |
571 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown2,WF), | |
572 | %tools_printing:print_term_summary(compiled_function(FullyKnown1,FullyKnown2,NExprA,NExprB)),nl, | |
573 | (FullyKnown2=true, | |
574 | (NExprA=b(value(_),_,_) -> true % no WD issue can be removed by apply, value already computed | |
575 | ; preferences:preference(find_abort_values,false) % in a sequence extension we could remove non-WD elements | |
576 | ), | |
577 | % check if we have enough information to apply a partially specified function as a list | |
578 | % e.g. if the function is [(int(1),A),(int(2),B)] and the argument is int(2): we can apply the function without knowing A or B; can have a dramatic importance when expanding unversal quantifiers ! | |
579 | can_apply_partially_specified_function(NExprA,NExprB,ResultExpr,WF) | |
580 | -> NExpr = ResultExpr, | |
581 | (FullyKnown12=true -> FullyKnown=true | |
582 | ; ResultExpr=value(ResultValue),known_value(ResultValue) -> FullyKnown=true | |
583 | ; FullyKnown = false) | |
584 | ; %tools_printing:print_term_summary(cannot_apply_function(FullyKnown2,NExprA,NExprB)),nl, | |
585 | %translate:print_bexpr(NExprA),nl, translate:print_bexpr(NExprB),nl, | |
586 | NExpr = function(NExprA,NExprB), FullyKnown = FullyKnown12). | |
587 | ||
588 | b_compile2(conjunct(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
589 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
590 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
591 | (is_falsity(NExprA) -> NExpr = falsity | |
592 | ; | |
593 | % TO DO: propagate static information from A to B, e.g. if A :: x=10 -> add x=10 to LS/Parameters | |
594 | % also: try and detect unsatisfiable predicates beforehand | |
595 | b_compile1(B,Parameters,LS,S,NExprB,Eval,_,WF), | |
596 | (is_falsity(NExprB) -> NExpr = falsity | |
597 | ; is_truth(NExprB) -> get_texpr_expr(NExprA,NExpr) | |
598 | ; is_truth(NExprA) -> get_texpr_expr(NExprB,NExpr) | |
599 | ; NExpr = conjunct(NExprA,NExprB)) | |
600 | ). | |
601 | b_compile2(disjunct(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
602 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
603 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
604 | (is_truth(NExprA) -> NExpr = truth | |
605 | ; b_compile1(B,Parameters,LS,S,NExprB,false,_,WF), % does not have to be executed in a successful branch: set Eval to false to avoid computing expensive expressions which may not be needed | |
606 | (is_truth(NExprB) -> NExpr = truth | |
607 | ; is_falsity(NExprA) -> get_texpr_expr(NExprB,NExpr) | |
608 | ; is_falsity(NExprB) -> get_texpr_expr(NExprA,NExpr) | |
609 | ; NExpr = disjunct(NExprA,NExprB)) | |
610 | ). | |
611 | b_compile2(implication(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
612 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
613 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
614 | (is_falsity(NExprA) -> NExpr = truth | |
615 | ; is_truth(NExprA) -> b_compile1(B,Parameters,LS,S,NExprB,Eval,_,WF), get_texpr_expr(NExprB,NExpr) | |
616 | ; NExpr = implication(NExprA,NExprB), | |
617 | b_compile1(B,Parameters,LS,S,NExprB,false,_,WF) % B does not have to be executed in a successful branch: set Eval to false to avoid computing expensive expressions which may not be needed | |
618 | % TO DO: add preference to force pre-computation everywhere and pass Eval instead of false to b_compile1; ditto for disjunction | |
619 | ). | |
620 | b_compile2(negation(A),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
621 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
622 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
623 | ( get_negated_operator_expr(NExprA,NegatedA) -> NExpr = NegatedA | |
624 | ; NExpr = negation(NExprA) | |
625 | ). | |
626 | b_compile2(if_then_else(A,B,C),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
627 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
628 | (is_falsity(NExprA) -> b_compile1(C,Parameters,LS,S,NExprC,Eval,FullyKnown,WF), get_texpr_expr(NExprC,NExpr) | |
629 | ; is_truth(NExprA) -> b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown,WF), get_texpr_expr(NExprB,NExpr) | |
630 | ; NExpr = if_then_else(NExprA,NExprB,NExprC), FullyKnown=false, | |
631 | b_compile1(B,Parameters,LS,S,NExprB,false,_,WF), % set Eval to false as we do not know if B will be needed | |
632 | b_compile1(C,Parameters,LS,S,NExprC,false,_,WF) % ditto for C | |
633 | ). | |
634 | /* b_compile2(comprehension_set(CParas,Body),Parameters,LS,S,NExpr,_Eval,FullyKnown,WF) :- | |
635 | sort(Parameters,SParas), | |
636 | b_ast_cleanup:not_occurs_in_predicate(SParas,Body), %can only be applied if Body does not reference Parameters | |
637 | !, | |
638 | b_generate_inner_closure_if_necessary(Parameters,CParas,Body,LS,S,Result), % will itself call b_compile | |
639 | NExpr = value(Result), | |
640 | (ground(Result) -> FullyKnown=true ; FullyKnown=false). */ | |
641 | b_compile2(forall(ForallPara,A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
642 | FullyKnown=false, % predicates never automatically evaluated in b_compile1 | |
643 | get_texpr_ids(ForallPara,AtomicIds), | |
644 | add_parameters(Parameters,AtomicIds,NParameters), | |
645 | b_compile1(A,NParameters,LS,S,NA,Eval,_FullyKnownA,WF), | |
646 | (is_falsity(NA) -> NExpr = truth | |
647 | ; b_compile1(B,NParameters,LS,S,NB,Eval,_FullyKnownB,WF), | |
648 | (is_truth(NB) -> NExpr = truth | |
649 | ; NExpr = forall(ForallPara,NA,NB) | |
650 | % TO DO ??: if we have an equality -> replace Body by value and remove quantifier | |
651 | %,print('COMPIlED: '),translate:print_bexpr(b(NExpr,pred,[])),nl | |
652 | ) | |
653 | ). | |
654 | % some special cases to avoid calling syntaxtransformation | |
655 | b_compile2(record_field(A,FieldName),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
656 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
657 | % First: we can try compute even if value not fully known !, we just need record field list | |
658 | (get_record_field(NExprA,FieldName,NExpr,FullyKnown) -> true | |
659 | ; NExpr = record_field(NExprA,FieldName), FullyKnown=FullyKnownA). | |
660 | b_compile2(couple(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
661 | %NExpr = couple(NExprA,NExprB), | |
662 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown1,WF), | |
663 | combine_fully_known(FullyKnown1,FullyKnown2,FullyKnown), | |
664 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown2,WF), | |
665 | (FullyKnown \== true, % evaluation will already combine the result | |
666 | NExprA=b(value(VA),_,_),NExprB=b(value(VB),_,_) | |
667 | -> NExpr = value((VA,VB)) | |
668 | ; NExpr = couple(NExprA,NExprB)). | |
669 | b_compile2(image(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
670 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown1,WF), | |
671 | combine_fully_known(FullyKnown1,FullyKnown2,FullyKnown), | |
672 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown2,WF), | |
673 | (FullyKnown \= true, NExprA=b(value(VA),BT,BI), | |
674 | NExprB=b(value(VB),_,_), nonvar(VB), | |
675 | custom_explicit_sets:singleton_set(VB,VBX) | |
676 | -> filter_cannot_match(VA,(VBX,_),NewVA,_Filtered), %nl,print(filtered_image(VBX,VA,NewVA)),nl, | |
677 | NExpr = image(b(value(NewVA),BT,BI),NExprB) | |
678 | % TO DO: add case where VB==[] or VA==[] are the empty set | |
679 | ; NExpr = image(NExprA,NExprB) | |
680 | ). %, print('compile image: '),translate:print_bexpr(NExpr),nl. | |
681 | % TO DO: do something like can_apply_partially_specified_function; or filter_can_match | |
682 | b_compile2(composition(A,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
683 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown1,WF), | |
684 | combine_fully_known(FullyKnown1,FullyKnown2,FullyKnown), | |
685 | NExpr = composition(NExprA,NExprB), | |
686 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown2,WF), | |
687 | (FullyKnown=false, Eval=eval, performance_monitoring_on, | |
688 | ( FullyKnown1=true, NExprB=b(value(_),_,Info), large_known_value(NExprA,2) | |
689 | -> true %translate:nested_print_bexpr(NExprB),nl | |
690 | ; FullyKnown2=true, NExprA=b(value(_),_,Info), large_known_value(NExprB,2) | |
691 | -> true %translate:nested_print_bexpr(NExprA),nl | |
692 | ) | |
693 | -> perfmessage(b_compiler,'Cannot compile relational composition (try lift it out of quantification)',Info) | |
694 | ; true). | |
695 | b_compile2(assertion_expression(A,Msg,B),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
696 | b_compile1(A,Parameters,LS,S,NExprA,Eval,_,WF), | |
697 | (is_truth(NExprA) -> % the ASSERT EXPR is redundant | |
698 | %print(removed_assert),nl, translate:print_bexpr(B),nl, | |
699 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnown,WF), | |
700 | get_texpr_expr(NExprB,NExpr) | |
701 | ; b_compile1(B,Parameters,LS,S,NExprB,Eval,_,WF), | |
702 | FullyKnown=false, % we cannot get rid of WD condition | |
703 | NExpr = assertion_expression(NExprA,Msg,NExprB) | |
704 | ). | |
705 | b_compile2(domain(A),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
706 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown1,WF), | |
707 | (FullyKnown1=false,get_texpr_expr(NExprA,NA),evaluate_domain(NA,Domain) % try and compute domain even if not fully known | |
708 | -> FullyKnown = true, NExpr = value(Domain) | |
709 | ; FullyKnown = FullyKnown1, NExpr = domain(NExprA)). | |
710 | b_compile2(range(A),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
711 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown1,WF), | |
712 | (FullyKnown1=false,evaluate_range(NExprA,Range) % try and compute range even if not fully known | |
713 | -> FullyKnown = true, NExpr = value(Range) | |
714 | ; FullyKnown = FullyKnown1, NExpr = range(NExprA)). | |
715 | b_compile2(assign(LHS_List,RHS_List),Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- !, | |
716 | NExpr = assign(New_LHS_List,NewRHS_List), FullyKnown = false, | |
717 | maplist(b_compile_lhs(Parameters,LS,S,Eval,WF),LHS_List,New_LHS_List), | |
718 | b_compile_l(RHS_List,Parameters,LS,S,NewRHS_List,Eval,_FullyKnown2,WF). | |
719 | b_compile2(assign_single_id(ID,B),Parameters,LS,S,assign_single_id(ID,NExprB),Eval,FullyKnown,WF) :- !, | |
720 | FullyKnown = false, | |
721 | b_compile1(B,Parameters,LS,S,NExprB,Eval,_,WF). | |
722 | b_compile2(operation_call(Operation,OpCallResults,OpCallParas),Parameters,LS,S,InlinedOpCall,Eval,FullyKnown,WF) :- | |
723 | % TO DO: evaluate if we should also use the let_expression_global approach used for operation_call_in_expr | |
724 | !, | |
725 | def_get_texpr_id(Operation,op(OperationName)), | |
726 | FullyKnown = false, | |
727 | b_compile_l(OpCallParas,Parameters,LS,S,OpCallParaValues,Eval,_,WF), | |
728 | TopLevel=false, | |
729 | b_get_machine_operation_for_animation(OperationName,OpResults,OpFormalParameters,Body,_OType,TopLevel), | |
730 | bsyntaxtree:replace_ids_by_exprs(Body,OpResults,OpCallResults,Body2), | |
731 | get_texpr_ids(OpFormalParameters,OpIds), | |
732 | add_parameters(Parameters,OpIds,InnerParas), | |
733 | b_compile1(Body2,InnerParas,[],S,NBody,Eval,FullyKnown,WF), % do not pass local state: this may override constants,... from the called machine | |
734 | % Note: global state S should be valid for all machines in currently loaded specification | |
735 | get_texpr_ids(OpCallResults,OpRIds), | |
736 | add_parameters(Parameters,OpRIds,LocalKnownParas), | |
737 | simplify_assignment(OpFormalParameters,OpCallParaValues,LHSFormalParas,RHSCallVals), %% | |
738 | split_formal_parameters(LHSFormalParas,RHSCallVals,LocalKnownParas, | |
739 | FreshOpParas,FreshCallVals, | |
740 | ClashOpParas, ClashCallVals), % only set up VAR for fresh Paras | |
741 | % print(split(LHSFormalParas,LocalKnownParas,fresh(FreshOpParas),clash(ClashOpParas))),nl, | |
742 | (FreshOpParas=[] -> get_texpr_expr(NBody,Let1) | |
743 | ; create_equality_for_let(FreshOpParas,FreshCallVals,Equality1), | |
744 | Let1 = let(FreshOpParas,Equality1,NBody)), | |
745 | (ClashOpParas = [] | |
746 | -> InlinedOpCall = Let1 | |
747 | ; %nl,print(clash(ClashOpParas)),nl, | |
748 | maplist(create_fresh_id,ClashOpParas,FreshCopy), | |
749 | create_equality_for_let(ClashOpParas,FreshCopy,Equality2), % copy Values from Fresh Ids | |
750 | create_equality_for_let(FreshCopy,ClashCallVals,Equality3), % assign Parameter Vals to Fresh Ids | |
751 | get_texpr_pos(Body,BodyPos), BodyPosInfo = [nodeid(BodyPos)], | |
752 | Let2 = let(ClashOpParas,Equality2,b(Let1,subst,[BodyPosInfo])), | |
753 | InlinedOpCall = let(FreshCopy,Equality3,b(Let2,subst,[BodyPosInfo])) | |
754 | ). | |
755 | %, print('Compiled operation call: '), translate:print_subst(b(InlinedOpCall,subst,BodyPosInfo)),nl,nl. | |
756 | % Maybe this version is faster when no OpCallResults: | |
757 | %b_compile2(operation_call(Operation,OpCallResults,OpCallParas),Parameters,LS,S,InlinedOpCall,Eval,FullyKnown,WF) :- | |
758 | % OpCallResults=[], | |
759 | % !, | |
760 | % def_get_texpr_id(Operation,op(OperationName)), | |
761 | % FullyKnown = false, | |
762 | %% b_compile_l(Results,Parameters,LS,S,NResults,Eval,_,WF), | |
763 | % b_compile_l(OpCallParas,Parameters,LS,S,OpCallParaValues,Eval,_,WF), | |
764 | % TopLevel=false, | |
765 | % b_get_machine_operation_for_animation(OperationName,OpResults,OpParameters,Body,_OType,TopLevel), | |
766 | % % Note: input parameters cannot be assigned to: so replace ids is ok | |
767 | % % However, we cannot replace output parameters: these can be assigned to and we can have aliasing | |
768 | % % Note: no aliasing is allowed in OpCallResults (cf Atelier-B handbook x,x <-- op not allowed) | |
769 | % bsyntaxtree:replace_ids_by_exprs(Body,OpParameters,OpCallParaValues,Body2), | |
770 | % get_texpr_ids(OpResults,OpIds), | |
771 | % append(OpIds,Parameters,InnerParas), | |
772 | % b_compile1(Body2,InnerParas,LS,S,NBody,Eval,FullyKnown,WF), | |
773 | % FinalBody = NBody. | |
774 | b_compile2(Expr,Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- | |
775 | functor(Expr,BOP,2), | |
776 | binary_boolean_operator(BOP,_,_),!, % from kernel_mappings, slightly more efficient than syntaxtransformation | |
777 | arg(1,Expr,A), | |
778 | FullyKnown=false, % predicates never evaluated in b_compile1 | |
779 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
780 | arg(2,Expr,B), | |
781 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnownB,WF), | |
782 | (eval_binary_bool(FullyKnownA,NExprA,FullyKnownB,NExprB,BOP,Result) | |
783 | -> NExpr = Result | |
784 | ; functor(NExpr,BOP,2), arg(1,NExpr,NExprA), arg(2,NExpr,NExprB) | |
785 | ). | |
786 | b_compile2(external_function_call(ExtFun,Args),_Parameters,LS,_S,NExpr,_Eval,FullyKnown,_WF) :- | |
787 | expects_unevaluated_args(ExtFun), | |
788 | memberchk(bind('$optimize_do_not_force_lazy_lookups',_),LS), % this is an optimize call | |
789 | !, | |
790 | debug_format(9,'Not compiling external function call to ~w~n',[ExtFun]), | |
791 | NExpr=external_function_call(ExtFun,Args), | |
792 | FullyKnown=false. | |
793 | b_compile2(Expr,Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- | |
794 | functor(Expr,BOP,2), | |
795 | kernel_mappings:binary_function(BOP,_,_),!, % slightly more efficient than syntaxtransformation | |
796 | arg(1,Expr,A), | |
797 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnownA,WF), | |
798 | combine_fully_known(FullyKnownA,FullyKnownB,FullyKnown), | |
799 | arg(2,Expr,B), | |
800 | b_compile1(B,Parameters,LS,S,NExprB,Eval,FullyKnownB,WF), | |
801 | functor(NExpr,BOP,2), arg(1,NExpr,NExprA), arg(2,NExpr,NExprB). | |
802 | b_compile2(Expr,Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- | |
803 | functor(Expr,UOP,1), | |
804 | kernel_mappings:unary_function(UOP,_,_),!, % slightly more efficient than syntaxtransformation | |
805 | arg(1,Expr,A), | |
806 | b_compile1(A,Parameters,LS,S,NExprA,Eval,FullyKnown,WF), | |
807 | functor(NExpr,UOP,1), arg(1,NExpr,NExprA). | |
808 | b_compile2(Expr,Parameters,LS,S,NExpr,Eval,FullyKnown,WF) :- % GENERAL CASE | |
809 | %hit_profiler:add_profile_hit(Expr), | |
810 | syntaxtransformation(Expr,Subs,Names,NSubs,NExpr), | |
811 | get_texpr_ids(Names,Ids), | |
812 | add_parameters(Parameters,Ids,NParameters), | |
813 | b_compile_l(Subs,NParameters,LS,S,NSubs,Eval,FullyKnown,WF). | |
814 | ||
815 | b_compile_l([],_,_,_,[],_Eval,true,_WF). | |
816 | b_compile_l([Expr|ExprRest],P,LS,S,[NExpr|NExprRest],Eval,FullyKnown,WF) :- | |
817 | b_compile1(Expr,P,LS,S,NExpr,Eval,FullyKnown1,WF), | |
818 | combine_fully_known(FullyKnown1,FullyKnown2,FullyKnown), | |
819 | b_compile_l(ExprRest,P,LS,S,NExprRest,Eval,FullyKnown2,WF). | |
820 | ||
821 | % detecth when a parameter clashes with existing known ids | |
822 | id_clash(LocalKnownParas,TID) :- def_get_texpr_id(TID,ID), member(ID,LocalKnownParas). | |
823 | ||
824 | /* comment in if we want to compile inner comprehension sets: | |
825 | :- use_module(bsyntaxtree,[split_names_and_types/3]). | |
826 | :- use_module(closures,[construct_closure_if_necessary/4]). | |
827 | b_generate_inner_closure_if_necessary(OuterParameters,ClosureParas,Condition,LocalState,State,Result) :- | |
828 | split_names_and_types(ClosureParas,Names,Types), | |
829 | add_parameters(OuterParameters,Names,FullNames), | |
830 | b_compile(Condition,FullNames,LocalState,State,ClosurePred), | |
831 | print('INNER COMPILE: '), translate:print_bexpr(ClosurePred),nl, | |
832 | construct_closure_if_necessary(Names,Types,ClosurePred,Result). | |
833 | */ | |
834 | ||
835 | ||
836 | % the LHS contains l-values which should not be looked up in the environment | |
837 | % however, we need to deal with things like f(i) := RHS and compile i | |
838 | b_compile_lhs(Parameters,LS,S,Eval,WF,TExpr,NewTExpr) :- | |
839 | TExpr = b(Expr,Type,Info), NewTExpr = b(NewExpr,Type,Info), | |
840 | b_compile_lhs_aux(Expr,Parameters,LS,S,NewExpr,Eval,WF). | |
841 | ||
842 | b_compile_lhs_aux(function(A,B),Parameters,LS,S,function(NewA,NewB),Eval,WF) :- !, | |
843 | b_compile_lhs(Parameters,LS,S,Eval,WF,A,NewA), % we can have nexted function calls f(e)(g) := | |
844 | b_compile1(B,Parameters,LS,S,NewB,Eval,_,WF). | |
845 | b_compile_lhs_aux(E,_,_,_,E,_,_WF). % other LHS should be identifier -> just copy | |
846 | ||
847 | get_record_field(b(value(Val),_,_),FieldName,value(Field),FullyKnown) :- !, | |
848 | nonvar(Val), Val=rec(Fields), | |
849 | safe_get_field(Fields,FieldName,Field), | |
850 | known_value(Field,FullyKnown). | |
851 | get_record_field(b(function(FUN,ARG),_Type,_Info),FieldName,function(ReducedFUN,ARG),false) :- | |
852 | % {1|->rec(a:1,b:2),...}(x)'b --> {1|->2,...}(x) | |
853 | %nl,print(get_field(FUN,ARG,FieldName)),nl, | |
854 | % TO DO: also allow nested functions calls {1|->rec(a:1,b:2),...}(x)(y)'b or other reduction operators | |
855 | get_field_in_range(FUN,FieldName,ReducedFUN). | |
856 | safe_get_field(V,FN,_) :- (var(V) ; var(FN)),!,fail. | |
857 | safe_get_field([field(N,V)|T],FieldName,Result) :- nonvar(N), | |
858 | (N=FieldName -> Result=V ; safe_get_field(T,FieldName,Result)). | |
859 | ||
860 | :- use_module(probsrc(custom_explicit_sets),[expand_custom_set_to_list/4, convert_to_avl/2]). | |
861 | :- use_module(probsrc(avl_tools),[avl_height_less_than/2]). | |
862 | get_field_in_range(b(value(OldVal),set(couple(Dom,OldRange)),Info),FieldName, | |
863 | b(value(NewVal),set(couple(Dom,NewRange)),Info)) :- | |
864 | nonvar(OldVal), OldVal=avl_set(AVL), | |
865 | avl_height_less_than(AVL,10), | |
866 | OldRange = record(Fields), | |
867 | member(field(FieldName,NewRange),Fields),!, | |
868 | expand_custom_set_to_list(avl_set(AVL),List,_,get_field_in_range), | |
869 | maplist(safe_get_range_field(FieldName),List,NewList), | |
870 | convert_to_avl(NewList,NewVal). | |
871 | ||
872 | % compute the field access for the range elements: | |
873 | safe_get_range_field(FieldName,(Dom,rec(Fields)),(Dom,Field)) :- safe_get_field(Fields,FieldName,Field). | |
874 | ||
875 | ||
876 | eval_binary_bool(true,b(value(ValA),_,_),true,b(value(ValB),_,_),BOP,Result) :- | |
877 | ground(ValA), | |
878 | ground(ValB), | |
879 | eval_binary_aux(BOP,ValA,ValB,Result). | |
880 | ||
881 | eval_binary_aux(less,int(A),int(B),Result) :- | |
882 | (A < B -> Result = truth ; Result = falsity). | |
883 | eval_binary_aux(greater,int(A),int(B),Result) :- | |
884 | (A > B -> Result = truth ; Result = falsity). | |
885 | eval_binary_aux(less_equal,int(A),int(B),Result) :- | |
886 | (A =< B -> Result = truth ; Result = falsity). | |
887 | eval_binary_aux(greater_equal,int(A),int(B),Result) :- | |
888 | (A >= B -> Result = truth ; Result = falsity). | |
889 | eval_binary_aux(subset,avl_set(A1),avl_set(A2),Result) :- | |
890 | (custom_explicit_sets:check_avl_subset(A1,A2) -> Result = truth ; Result = falsity). | |
891 | eval_binary_aux(subset,[],_,Result) :- Result=truth. | |
892 | %eval_binary_aux(less_real,real(A),real(B),Result) :- % TO DO | |
893 | % (A < B -> Result = truth ; Result = falsity). | |
894 | % TO DO: other operators are not_subset, strict_subset, ... intervals for subset,... | |
895 | ||
896 | ||
897 | ||
898 | :- use_module(store,[lookup_value_for_existing_id_wf/5]). | |
899 | compute_lazy_lookup(Id,Expr,LS,S,NExpr,FullyKnown,WF) :- | |
900 | lookup_value_for_existing_id_wf(Id,LS,S,(Evaluated,Value),WF), | |
901 | % the lazy expression has already been registered, but maybe not yet evaluated | |
902 | !, | |
903 | known_value(Value,FullyKnown), % compute if value fully known | |
904 | (Evaluated==pred_true -> NExpr = value(Value) | |
905 | ; FullyKnown==true -> NExpr = value(Value) | |
906 | ; memberchk(bind('$optimize_do_not_force_lazy_lookups',_),LS) | |
907 | -> NExpr = Expr % we do not force lookup: there could be WD issues ! | |
908 | % TO DO: examine Infos for wd_condition; we could also return NExpr = lazy_value(Id,Evaluated,Value) | |
909 | ; if(Evaluated = pred_true, | |
910 | % will force evaluation ! Note: this means shared expression inside a compiled expression must be well-defined | |
911 | NExpr = value(Value), | |
912 | (add_internal_error_wf(b_compiler,'Compilation failed: ', Id, unknown,WF), | |
913 | fail)) | |
914 | ). | |
915 | compute_lazy_lookup(Id,_E,_LS,_S,_LazyValue,_,WF) :- | |
916 | add_internal_error_wf(b_compiler,'Compilation failed, illegal lazy_lookup_value: ',Id,unknown,WF), | |
917 | fail. | |
918 | ||
919 | combine_fully_known(true,A,A). | |
920 | combine_fully_known(false,_,false). | |
921 | ||
922 | :- use_module(tools_lists,[length_greater/2]). | |
923 | % is an extension function with at least two elements, but not too long | |
924 | % (for long set extensions it is much better to compile them to avl once; see private_examples/ClearSy/2019_Sep/rule_dummy) | |
925 | % extension functions are treated lazily in b_interpreter for function application under the condition: | |
926 | % memberchk(contains_wd_condition,FInfo) ; preferences:preference(use_clpfd_solver,false) ; ground_value(ArgValue) | |
927 | is_lazy_extension_function_for_fun_app(b(A,_,FInfo)) :- | |
928 | preferences:preference(data_validation_mode,false), | |
929 | (memberchk(contains_wd_condition,FInfo) -> Lim=98 ; Lim = 23), | |
930 | is_extension_function_aux(A,Lim). | |
931 | is_extension_function_aux(set_extension([_A,_|T]),Lim) :- \+ length_greater(T,Lim). | |
932 | is_extension_function_aux(sequence_extension([_,_|T]),Lim) :- \+ length_greater(T,Lim). | |
933 | ||
934 | :- use_module(bsyntaxtree,[is_set_type/2]). | |
935 | % check if we can apply an argument to a partially specified function (as a list and now also as AVL) | |
936 | %can_apply_partially_specified_function(Fun,X,_,_) :- print(fun(Fun)),nl,print(val(X)),nl,fail. | |
937 | can_apply_partially_specified_function(b(Expr,TYPE,_), b(value(X),TA,_),ResultExpr,WF) :- | |
938 | can_apply_aux(Expr,TYPE,X,TA,ResultExpr,WF). | |
939 | ||
940 | can_apply_aux(value(VAL),TYPE,X,TA,value(ResultValue),WF) :- | |
941 | is_set_type(TYPE,couple(TA,_TB)), | |
942 | lookup_result(VAL,X,ResultValue,WF). | |
943 | can_apply_aux(sequence_extension(List),_,X,integer,ResultExpr,_WF) :- | |
944 | % important, e.g., for solving test 1551: {b|[a,b,c](2)=333} =res & a : res & b:res | |
945 | nonvar(X), X=int(Index), number(Index), | |
946 | % this will prevent computing rest of sequence extension: can hide WD issues ! | |
947 | % print(apply_seq_extension(Index,List)),nl, | |
948 | nth1(Index,List,b(ResultExpr,_,_)). | |
949 | ||
950 | :- use_module(kernel_equality,[equality_objects_wf/4, equality_can_be_decided_by_unification/1]). | |
951 | %lookup_result(VAR,ArgValue,Result,WF) :- var(VAR),!,kernel_mappings:kernel_call_apply_to(VAR,ArgValue,Result,unknown,unknown,WF). | |
952 | % the clause above is unsound; as apply_to CAN RAISE WD ERRORS !! what if we have IF 1:dom(f) THEN f(1) ELSE f(0) END; we do not want to compute f(1) ! it can also instantiate unbound variables ! | |
953 | % the idea was to avoid that we wait on the full function, before compiled closure can be evaluated; test 1552 | |
954 | % important for e.g. a = {(1, {([]|->2)} ), (2, const(1, [a(1)]))} | |
955 | % or: a = {1 |-> {[] |-> 2}, 2 |-> (dom({pi,ff,p|((pi : seq(INTEGER) & ff : INTEGER) & p : seq(INTEGER)) & (p |-> ff : [a(1)](1) & pi = 1 -> p)}) \/ {[] |-> 1})} | |
956 | % test 1552 is currently skipped | |
957 | % TO DO: think whether there are other deterministic computations that can be done in b_compile: prj1,prj2, record-field access ? this would ensure that closures,... can be computed earlier | |
958 | lookup_result(VAR,_,_,_WF) :- var(VAR),!,fail. | |
959 | lookup_result(avl_set(A),X,Result,_WF) :- | |
960 | (custom_explicit_sets:try_apply_to_avl_set(X,Result,A) | |
961 | -> true % precompiled function application | |
962 | ; debug_format(19,'Function application in b_compiler for avl_set is not well-defined for: ~w~n',[X]), | |
963 | % We could transform the function application into a construct that raises a WD error | |
964 | fail). | |
965 | lookup_result(closure(_P,_T,_B),_X,_Result,_WF) :- !, | |
966 | fail. % TODO: should we replace parameters by values in body? if domain is full type? | |
967 | lookup_result(List,X,Result,WF) :- List = [_|_],equality_can_be_decided_by_unification(X),!, | |
968 | % this is relevant for long lists, | |
969 | % see public_examples/B/ExternalFunctions/Satsolver/QueensBoardVersionTF_Satsolver.mch | |
970 | fast_lookup_result(List,X,Result,WF). | |
971 | lookup_result(List,X,Result,WF) :- | |
972 | regular_lookup_result_in_list(List,X,Result,WF). | |
973 | ||
974 | regular_lookup_result_in_list([],X,_Result,_WF) :- | |
975 | debug_format(19,'Function application in b_compiler for list is not well-defined for: ~w~n',[X]), % ditto | |
976 | fail. | |
977 | regular_lookup_result_in_list([(HFrom,HTo)|T],X,Result,WF) :- | |
978 | equality_objects_wf(HFrom,X,PredRes,WF), | |
979 | %kernel_equality:equality_objects1(HFrom,X,PredRes,WF), % this could be called if X is guaranteed nonvar | |
980 | nonvar(PredRes), % only proceed if we have enough information to determine the result of the comparison | |
981 | (PredRes = pred_true -> Result = HTo % we have found the value; we assume there is no other value later | |
982 | % TO DO: if find_abort_values=true: look later in the list if for all other HFrom PredRes=pred_false | |
983 | ; regular_lookup_result_in_list(T,X,Result,WF)). | |
984 | ||
985 | % a faster version which does not use equality_objects_wf | |
986 | fast_lookup_result([(HFrom,HTo)|T],X,Result,WF) :- !, | |
987 | equality_can_be_decided_by_unification(HFrom), | |
988 | (HFrom=X -> Result = HTo | |
989 | ; fast_lookup_result(T,X,Result,WF) | |
990 | ). | |
991 | fast_lookup_result(List,X,Result,WF) :- | |
992 | regular_lookup_result_in_list(List,X,Result,WF). | |
993 | ||
994 | ||
995 | % get_comprehension_set(b(SET,_,_),ID,PRED) :- get_comprehension_set_aux(SET,ID,PRED). | |
996 | % get_comprehension_set_aux(comprehension_set([TID],PRED),ID,PRED) :- | |
997 | % get_texpr_id(TID,ID). | |
998 | % get_comprehension_set_aux(value(V),ID,PRED) :- nonvar(V), V = closure([ID],_,PRED). | |
999 | ||
1000 | ||
1001 | ||
1002 | ||
1003 | quick_test_membership1(b(value(VA),_,_),VB,Result) :- | |
1004 | quick_test_membership_aux(VB,VA,Result). | |
1005 | quick_test_membership_aux(VAR,_,_) :- var(VAR),!,fail. | |
1006 | quick_test_membership_aux([],_,pred_false). | |
1007 | quick_test_membership_aux(avl_set(AVL),X,Result) :- | |
1008 | custom_explicit_sets:quick_test_avl_membership(AVL,X,Result). % we could also check that in case X is not ground but partially instantiated, whether there is a possible match in AVL (if not Result = pred_false) | |
1009 | quick_test_membership_aux(global_set(GS),X,Result) :- nonvar(X), X=int(IX), nonvar(IX), | |
1010 | custom_explicit_sets:membership_global_set(GS,X,R,_WF), | |
1011 | nonvar(R), Result=R. | |
1012 | quick_test_membership_aux(closure(P,T,B),X,Result) :- nonvar(X), X=int(IX), nonvar(IX), | |
1013 | is_fixed_interval(P,T,B,LOW,UP), | |
1014 | kernel_equality:in_nat_range_test(X,int(LOW),int(UP),R), | |
1015 | nonvar(R), Result=R. | |
1016 | quick_test_membership_aux(closure(P,T,B),X,Result) :- X==[], % check {} : POW(_) / FIN(_) and {} : POW1(_) / FIN1(_) | |
1017 | custom_explicit_sets:is_powerset_closure(closure(P,T,B),Kind,_), | |
1018 | (contains_empty_set(Kind) -> Result = pred_true ; Result=pred_false). | |
1019 | ||
1020 | is_fixed_interval(P,T,B,LOW,UP) :- | |
1021 | custom_explicit_sets:is_interval_closure(P,T,B,LOW,UP), integer(LOW),integer(UP). | |
1022 | ||
1023 | contains_empty_set(pow). | |
1024 | contains_empty_set(fin). | |
1025 | ||
1026 | convert_pred_res(pred_false,falsity). | |
1027 | convert_pred_res(pred_true,truth). | |
1028 | convert_neg_pred_res(pred_true,falsity). | |
1029 | convert_neg_pred_res(pred_false,truth). | |
1030 | ||
1031 | generate_equality(b(A,_,_),b(B,_,_),Res) :- | |
1032 | ( generate_equality_aux(A,B,Res) ; | |
1033 | generate_equality_aux(B,A,Res) ), | |
1034 | !. | |
1035 | generate_equality(A,B,equal(A,B)). | |
1036 | ||
1037 | generate_equality_aux(convert_bool(AA),value(PT),Res) :- | |
1038 | PT==pred_true, | |
1039 | get_texpr_expr(AA,TA), | |
1040 | !, | |
1041 | Res = TA. | |
1042 | generate_equality_aux(convert_bool(AA),value(PF),Res) :- | |
1043 | PF==pred_false,!, | |
1044 | Res = negation(AA). | |
1045 | ||
1046 | % generate an equal(_,_) node where the second one is a Value | |
1047 | generate_equality_with_value(b(value(ValA),_,_),true,ValB,true,_TA,NExpr) :- | |
1048 | % both are FullyKnown | |
1049 | simple_value(ValA), % we should avoid closures | |
1050 | !, | |
1051 | kernel_equality:equality_objects(ValA,ValB,PRes), | |
1052 | convert_pred_res(PRes,NExpr). | |
1053 | generate_equality_with_value(NExprA,_,Value,_,TA,equal(NExprA,b(value(Value),TA,[]))). | |
1054 | ||
1055 | % similar to custom_explicit_sets:simple_value | |
1056 | % values where we can decide equality easily | |
1057 | simple_value(fd(_,_)). | |
1058 | simple_value(pred_true /* bool_true */). | |
1059 | simple_value(pred_false /* bool_false */). | |
1060 | simple_value(int(_)). | |
1061 | simple_value((A,B)) :- simple_value(A), simple_value(B). | |
1062 | simple_value(rec(Fields)) :- maplist(simple_field,Fields). | |
1063 | simple_value(string(_)). | |
1064 | ||
1065 | simple_field(field(_,Val)) :- simple_value(Val). | |
1066 | ||
1067 | known_value(X,FullyKnown) :- (known_value(X) -> FullyKnown=true ; FullyKnown=false). | |
1068 | known_value(X) :- nonvar(X), known_value2(X). | |
1069 | known_value2(global_set(GS)) :- nonvar(GS). | |
1070 | known_value2(freetype(GS)) :- nonvar(GS). | |
1071 | known_value2(closure(P,T,B)) :- known_closure(P,T,B). | |
1072 | %Note: for other closures: they still may have to be computed; some of the computations in wd_and_efficient could be expensive for closures | |
1073 | known_value2(avl_set(_)). % already fully normalised | |
1074 | known_value2((X,Y)) :- known_value(X),known_value(Y). | |
1075 | known_value2(fd(A,B)) :- number(A),atomic(B). | |
1076 | known_value2(int(N)) :- number(N). | |
1077 | known_value2([]). | |
1078 | known_value2(pred_true). | |
1079 | known_value2(pred_false). | |
1080 | known_value2(string(S)) :- atomic(S). | |
1081 | known_value2([H|T]) :- known_value(H), known_value(T). | |
1082 | %known_value2(record(Fields)) :- known_fields(Fields). | |
1083 | known_value2(rec(Fields)) :- known_fields(Fields). | |
1084 | ||
1085 | :- use_module(avl_tools,[avl_height_less_than/2]). | |
1086 | % large known avl_set value; for issueing perfmessage warnings | |
1087 | large_known_value(b(value(V),_,_),Lim) :- nonvar(V), large_known_aux(V,Lim). | |
1088 | large_known_aux(avl_set(A),Lim) :- | |
1089 | \+ avl_height_less_than(A,Lim). | |
1090 | ||
1091 | % something we could do: | |
1092 | %optimize_known_value([H|T],Res) :- (convert_to_avl([H|T],CS) -> Res=CS ; print(failed_to_convert_known_list),nl,fail). | |
1093 | % try_convert_to_avl | |
1094 | ||
1095 | known_closure(P,T,B) :- custom_explicit_sets:is_interval_closure(P,T,B,Low,Up), !, | |
1096 | number(Low), number(Up), | |
1097 | Up < Low+1000. | |
1098 | known_closure(P,T,B) :- | |
1099 | is_cartesian_product_closure(closure(P,T,B),A1,A2), | |
1100 | !,% we could call is_cartesian_product_closure_aux(P,T,B,A1,A2) | |
1101 | known_value(A1), known_value(A2). | |
1102 | ||
1103 | known_fields(X) :- var(X),!,fail. | |
1104 | known_fields([]). | |
1105 | known_fields([field(N,V)|T]) :- ground(N),known_value(V),known_fields(T). | |
1106 | ||
1107 | %b_evaluate1(TExpr,Parameters,LS,S,ResultTExpr,FullyKnown) :- | |
1108 | ||
1109 | check_is_id_list([],[]). | |
1110 | check_is_id_list([H|T],Res) :- | |
1111 | (H=b(identifier(_),_,_) | |
1112 | -> add_internal_error('Typed id list as argument: ',check_is_id_list([H|T],Res)), % use get_texpr_ids or maplist(def_get_texpr_id,P,PIDs) | |
1113 | maplist(def_get_texpr_id,[H|T],Res) | |
1114 | ; Res=[H|T]). | |
1115 | ||
1116 | :- use_module(kernel_frozen_info,[kfi_domain/2]). | |
1117 | ||
1118 | :- use_module(custom_explicit_sets,[construct_interval_closure/3]). | |
1119 | % try and evaluate domain of a list (avl_set already dealt with separately) | |
1120 | %evaluate_domain(X,_) :- print(dom(X)),nl,fail. | |
1121 | evaluate_domain(sequence_extension(L),Domain) :- length(L,Len), | |
1122 | % this will prevent computing range of sequence extension: can hide WD issues ! TO DO: check wd info and/or preference | |
1123 | construct_interval_closure(1,Len,Domain). | |
1124 | % TO DO: set_extension when possible ? | |
1125 | evaluate_domain(value(L),Domain) :- | |
1126 | get_domain(L,Domain). | |
1127 | ||
1128 | get_domain(V,Dom) :- var(V),!,kfi_domain(V,Dom). % try infer domain from attached co-routines | |
1129 | get_domain([],[]). | |
1130 | get_domain([V|VT],Result) :- nonvar(V), V=(D,_), | |
1131 | known_value(D),get_list_domain(VT,DT), | |
1132 | %length(DT,Len),print(got_list_domain(D,Len)),nl, | |
1133 | (custom_explicit_sets:try_convert_to_avl([D|DT],Res) -> Result=Res | |
1134 | ; write(could_not_convert_domain_to_avl(D)),nl, Result=[D|DT]). %sort([D|DT],Result)? | |
1135 | % we could also do this: | |
1136 | %get_domain(closure(Par,Typ,Body),Result) :- | |
1137 | % is_lambda_value_domain_closure(Par,Typ,Body, DomainValue,Expr), check_wd(Expr), | |
1138 | % Result=DomainValue. | |
1139 | get_list_domain(V,_) :- var(V),!,fail. | |
1140 | get_list_domain([],[]). | |
1141 | get_list_domain([V|VT],[D|DT]) :- nonvar(V), V=(D,_), | |
1142 | known_value(D),get_list_domain(VT,DT). | |
1143 | ||
1144 | ||
1145 | :- use_module(kernel_frozen_info,[kfi_range/2]). | |
1146 | ||
1147 | % try and evaluate range of a list (avl_set already dealt with separately) | |
1148 | evaluate_range(b(value(L),_T,_),Range) :- | |
1149 | get_range(L,Range). | |
1150 | get_range(V,Dom) :- var(V),!,kfi_range(V,Dom). % try infer range from attached co-routines | |
1151 | get_range([],[]). | |
1152 | get_range([V|VT],Result) :- nonvar(V), V=(_,D), | |
1153 | known_value(D), | |
1154 | get_list_range(VT,DT), | |
1155 | sort([D|DT],Result). | |
1156 | ||
1157 | get_list_range(V,_) :- var(V),!,fail. | |
1158 | get_list_range([],[]). | |
1159 | get_list_range([V|VT],[D|DT]) :- | |
1160 | nonvar(V), V=(_,D), | |
1161 | known_value(D), | |
1162 | get_list_range(VT,DT). | |
1163 | ||
1164 | create_equality_for_let(LHS,RHS,Conj) :- | |
1165 | maplist(create_eq,LHS,RHS,CL), | |
1166 | conjunct_predicates(CL,Conj). | |
1167 | create_eq(Id,Expr,TPred) :- safe_create_texpr(equal(Id,Expr),pred,TPred). | |
1168 | ||
1169 | % split formal operation call parameters into those which clash and those that do not: | |
1170 | split_formal_parameters([],[],_,[],[],[],[]). | |
1171 | split_formal_parameters([Formal1|FormalT],[Val1|VT],LocalKnownParas,Fresh,FV,Clash,CV) :- | |
1172 | (id_clash(LocalKnownParas,Formal1) | |
1173 | -> Fresh = FreshT, FV=FVT, Clash = [Formal1|ClashT], CV = [Val1|CVT] | |
1174 | ; Fresh = [Formal1|FreshT], FV = [Val1|FVT], Clash = ClashT, CV = CVT | |
1175 | ), split_formal_parameters(FormalT,VT,LocalKnownParas,FreshT,FVT,ClashT,CVT). | |
1176 | ||
1177 | :- use_module(gensym,[gensym/2]). | |
1178 | create_fresh_id(b(identifier(_),T,I),b(identifier(FRESHID),T,I)) :- | |
1179 | gensym('__COMPILED_ID__',FRESHID). | |
1180 | ||
1181 | :- use_module(bsyntaxtree, [get_texpr_pos/2,same_id/3]). | |
1182 | % compute which assignments are really necessary, remove skip assignments x := x | |
1183 | simplify_assignment([],[],[],[]). | |
1184 | simplify_assignment([ID1|T1],[ID2|T2],Res1,Res2) :- | |
1185 | (same_id(ID1,ID2,_) -> Res1=TR1, Res2=TR2 ; Res1=[ID1|TR1], Res2=[ID2|TR2]), | |
1186 | simplify_assignment(T1,T2,TR1,TR2). | |
1187 | ||
1188 | ||
1189 | /* | |
1190 | % check if an AST term is a total lambda without WD condition: | |
1191 | % NExprA=value(closure([x,...,'_lambda_result_'],b(equal())), NExprB=couple(,,,,) -> replace x by parameters | |
1192 | % possibly better to do this via contains_wd_condition or similar Info field?! | |
1193 | ||
1194 | ||
1195 | is_total_lambda(b(value(V),_,_),OtherIDs,LambdaExpr) :- nonvar(V), | |
1196 | V=closure(Args,_Types,Body), | |
1197 | is_total_lambda_closure(Args,Body, OtherIDs, LambdaExpr). | |
1198 | ||
1199 | :- use_module(probsrc(bsyntaxtree),[conjunction_to_list/2,occurs_in_expr/2]). | |
1200 | is_total_lambda_closure(Args,b(equal(TLambda,LambdaExpr),pred,_),OtherIDs,LambdaExpr) :- | |
1201 | get_texpr_id(TLambda,LambdaID), | |
1202 | append(OtherIDs,[LambdaID],Args), | |
1203 | \+ occurs_in_expr(LambdaID,LambdaExpr). | |
1204 | ||
1205 | % try and get arguments from expression | |
1206 | get_actual_arguments([_],Expr,Args) :- !, | |
1207 | % print('arg1: '),tools_printing:print_term_summary(Expr),nl, | |
1208 | check_simple(Expr), | |
1209 | Args= [Expr]. | |
1210 | get_actual_arguments([_|T],b(Couple,_,_),[Arg1|TArgs]) :- | |
1211 | get_couple(Couple,Arg1,Arg2), print('arg: '),tools_printing:print_term_summary(Arg1),nl, | |
1212 | check_simple(Arg1), | |
1213 | get_actual_arguments(T,Arg2,TArgs). | |
1214 | ||
1215 | check_simple(b(V,_,_)) :- simple2(V). | |
1216 | simple2(value(_)). | |
1217 | simple2(identifier(_)). | |
1218 | simple2(integer(_)). | |
1219 | ||
1220 | get_couple(couple(A,B),A,B). | |
1221 | %get_couple(value(V),A,B) :- nonvar(V), V=(V1,V2), ... % TODO | |
1222 | ||
1223 | ||
1224 | Code for bcompile2(function(...)) | |
1225 | ||
1226 | ||
1227 | % ; is_total_lambda(NExprA,Ids,Expr) , | |
1228 | % get_actual_arguments(Ids,NExprB,Args) %, print(ok),nl, translate:l_print_bexpr_or_subst(Args),nl | |
1229 | % -> | |
1230 | % bsyntaxtree:replace_ids_by_exprs(Expr,Ids,Args,Result), | |
1231 | % % only ok if we do not replicate expressions !! we could repeatedly re-apply rule / compilation on result | |
1232 | % print(' replaced: '),translate:print_bexpr(Result),nl, | |
1233 | % Result = b(NExpr,_,_), FullyKnown = FullyKnown12 | |
1234 | ||
1235 | */ |