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(translate,
6 [print_bexpr_or_subst/1, l_print_bexpr_or_subst/1,
7 print_bexpr/1, debug_print_bexpr/1,
8 nested_print_bexpr/1, nested_print_bexpr_as_classicalb/1,
9 print_bexpr_stream/2,
10 print_components/1,
11 print_bexpr_with_limit/2,
12 print_unwrapped_bexpr_with_limit/1,print_bvalue/1, l_print_bvalue/1, print_bvalue_stream/2,
13 translate_params_for_dot/2,
14 print_machine/1,
15 translate_machine/3,
16 set_unicode_mode/0, unset_unicode_mode/0, unicode_mode/0,
17 unicode_translation/2, % unicode translation of a symbol/keyword
18 set_latex_mode/0, unset_latex_mode/0, latex_mode/0,
19 set_atelierb_mode/1, unset_atelierb_mode/0,
20 set_force_eventb_mode/0, unset_force_eventb_mode/0,
21 get_translation_mode/1, set_translation_mode/1, unset_translation_mode/1,
22 with_translation_mode/2,
23 get_language_mode/1, set_language_mode/1, with_language_mode/2,
24 translate_bexpression_to_unicode/2,
25 translate_bexpression/2, translate_subst_or_bexpr_in_mode/3,
26 translate_bexpression_with_limit/3, translate_bexpression_with_limit/2,
27 translate_bexpression_to_codes/2,
28 translate_bexpr_to_parseable/2,
29 translate_predicate_into_machine/3, nested_print_sequent_as_classicalb/6,
30 get_bexpression_column_template/4,
31 translate_subst_or_bexpr/2, translate_subst_or_bexpr_with_limit/3,
32 translate_substitution/2, print_subst/1,
33 translate_bvalue/2, translate_bvalue_to_codes/2,
34 translate_bvalue_to_parseable_classicalb/2,
35 translate_bvalue_for_dot/2,
36 translate_bvalue_with_limit/3,
37 translate_bvalue_with_type/3, translate_bvalue_with_type_and_limit/4,
38 translate_bvalue_for_expression/3, translate_bvalue_for_expression_with_limit/4,
39 translate_bvalue_with_tlatype/3,
40 print_state/1,
41 translate_bstate/2, translate_bstate_limited/2, translate_bstate_limited/3,
42 print_bstate/1, translate_context/2, print_context/1,
43 translate_any_state/2, %translate_b_state_to_comma_list_codes/3,
44 print_value_variable/1,
45 print_cspm_state/1, translate_cspm_state/2,
46 print_csp_value/1, translate_csp_value/2,
47 translate_cspm_expression/2,
48 translate_properties_with_limit/2,
49 translate_event/2,translate_events/2,
50 translate_event_with_target_id/4,
51 translate_event_with_src_and_target_id/4, translate_event_with_src_and_target_id/5,
52 get_non_det_modified_vars_in_target_id/3,
53 translate_event_with_limit/3,
54 translate_state_errors/2,translate_state_error/2,
55 translate_event_error/2,
56 translate_call_stack/2,
57 translate_prolog_constructor/2, translate_prolog_constructor_in_mode/2,
58 get_texpr_top_level_symbol/4,
59 pretty_type/2, % pretty-prints a type (pp_type, translate_type)
60 explain_state_error/3, get_state_error_span/2,
61 explain_event_trace/3,
62 generate_typing_predicates/2, % keeps sequence typing info
63
64 print_raw_machine_terms/1,
65 print_raw_bexpr/1, l_print_raw_bexpr/1,
66 translate_raw_bexpr_with_limit/3,
67
68 print_span/1, print_span_nl/1, translate_span/2,
69 translate_span_with_filename/2,
70 get_definition_context_from_span/2,
71
72 %set_type_to_maximal_texpr/2, type_set/2, % now in typing_tools as create_type_set
73
74 translate_error_term/2, translate_error_term/3,
75 translate_prolog_exception/2,
76
77 set_translation_constants/1, set_translation_context/1,
78 clear_translation_constants/0,
79
80 set_print_type_infos/1,
81 suppress_rodin_positions/1, reset_suppress_rodin_positions/1,
82 add_normal_typing_predicates/3,
83
84 install_b_portray_hook/0,remove_b_portray_hook/0,
85
86 translate_eventb_to_classicalb/3,
87 translate_eventb_direct_definition_header/3, translate_eventb_direct_definition_body/2,
88 return_csp_closure_value/2,
89 latex_to_unicode/2, get_latex_keywords/1, get_latex_keywords_with_backslash/1,
90 ascii_to_unicode/2
91
92 ]).
93
94 :- meta_predicate call_pp_with_no_limit_and_parseable(0).
95 :- meta_predicate with_translation_mode(+, 0).
96 :- meta_predicate with_language_mode(+, 0).
97
98 :- use_module(tools).
99 :- use_module(tools_lists,[is_list_simple/1]).
100
101 :- use_module(module_information).
102 :- module_info(group,tools).
103 :- module_info(description,'This module is responsible for pretty-printing B and CSP, source spans, ...').
104
105 :- use_module(library(lists)).
106 :- use_module(library(codesio)).
107 :- use_module(library(terms)).
108 :- use_module(library(avl)).
109
110 :- use_module(debug).
111 :- use_module(error_manager).
112 :- use_module(self_check).
113 :- use_module(b_global_sets).
114 :- use_module(specfile,[csp_with_bz_mode/0,process_algebra_mode/0,
115 animation_minor_mode/1,set_animation_minor_mode/1,
116 remove_animation_minor_mode/0,
117 animation_mode/1,set_animation_mode/1, csp_mode/0,
118 translate_operation_name/2]).
119 :- use_module(bsyntaxtree).
120 %:- use_module('smv/smv_trans',[smv_print_initialisation/2]).
121 :- use_module(preferences,[get_preference/2, set_preference/2, eclipse_preference/2]).
122 :- use_module(bmachine_structure).
123 :- use_module(avl_tools,[check_is_non_empty_avl/1]).
124
125 :- set_prolog_flag(double_quotes, codes).
126
127 % print a list of expressions or substitutions
128 l_print_bexpr_or_subst([]).
129 l_print_bexpr_or_subst([H|T]) :-
130 print_bexpr_or_subst(H),
131 (T=[] -> true
132 ; (get_texpr_type(H,Type),is_subst_type(Type) -> print('; ') ; print(', '),
133 l_print_bexpr_or_subst(T))
134 ).
135
136 is_subst_type(T) :- var(T),!,fail.
137 is_subst_type(subst).
138 is_subst_type(op(_,_)).
139
140 print_bexpr_or_subst(E) :- get_texpr_type(E,T),is_subst_type(T),!, print_subst(E).
141 print_bexpr_or_subst(precondition(A,B)) :- !, print_subst(precondition(A,B)).
142 print_bexpr_or_subst(any(A,B,C)) :- !, print_subst(any(A,B,C)).
143 print_bexpr_or_subst(select(A)) :- !, print_subst(select(A)). % TO DO: add more cases ?
144 print_bexpr_or_subst(E) :- print_bexpr(E).
145
146 print_unwrapped_bexpr_with_limit(Expr) :- print_unwrapped_bexpr_with_limit(Expr,200).
147 print_unwrapped_bexpr_with_limit(Expr,Limit) :-
148 translate:print_bexpr_with_limit(b(Expr,pred,[]),Limit),nl.
149 debug_print_bexpr(E) :- debug:debug_mode(off) -> true ; print_bexpr(E).
150 print_bexpr(Expr) :- translate_bexpression(Expr,R), write(R).
151 print_bexpr_with_limit(Expr,Limit) :- translate_bexpression_with_limit(Expr,Limit,R), write(R).
152 print_bvalue(Val) :- translate_bvalue(Val,TV), write(TV).
153 print_bexpr_stream(S,Expr) :- translate_bexpression(Expr,R), write(S,R).
154 print_bvalue_stream(S,Val) :- translate_bvalue(Val,R), write(S,R).
155
156 print_components(C) :- print_components(C,0).
157 print_components([],Nr) :- write('Nr of components: '),write(Nr),nl.
158 print_components([component(Pred,Vars)|T],Nr) :- N1 is Nr+1,
159 write('Component: '), write(N1), write(' over '), write(Vars),nl,
160 print_bexpr(Pred),nl,
161 print_components(T,N1).
162
163 l_print_bvalue([]).
164 l_print_bvalue([H|T]) :- print_bvalue(H), write(' : '),l_print_bvalue(T).
165
166 nested_print_bexpr_as_classicalb(E) :- nested_print_bexpr_as_classicalb2(E,0).
167
168 nested_print_bexpr_as_classicalb2(E,InitialPeanoIndent) :-
169 (animation_minor_mode(X)
170 -> remove_animation_minor_mode,
171 call_cleanup(nested_print_bexpr2(E,InitialPeanoIndent), set_animation_minor_mode(X))
172 ; nested_print_bexpr2(E,InitialPeanoIndent)).
173
174 % can also print lists of predicates and lists of lists, ...
175 nested_print_bexpr(Expr) :- nested_print_bexpr2(Expr,0).
176
177 % a version where one can specify the initial indent in peano numbering
178 nested_print_bexpr2([],_) :- !.
179 nested_print_bexpr2([H],InitialIndent) :- !,nested_print_bexpr2(H,InitialIndent).
180 nested_print_bexpr2([H|T],II) :- !,
181 nested_print_bexpr2(H,II),
182 print_indent(II), write('&'),nl,
183 nested_print_bexpr2(T,II).
184 nested_print_bexpr2(Expr,II) :- nbp(Expr,conjunct,II).
185
186 nbp(b(E,_,Info),Type,Indent) :- !,nbp2(E,Type,Info,Indent).
187 nbp(E,Type,Indent) :- format(user_error,'Missing b/3 wrapper!~n',[]),
188 nbp2(E,Type,[],Indent).
189 nbp2(E,Type,_Info,Indent) :- get_binary_connective(E,NewType,Ascii,LHS,RHS),!,
190 inc_indent(NewType,Type,Indent,NIndent),
191 print_bracket(Indent,NIndent,'('),
192 nbp(LHS,NewType,NIndent),
193 print_indent(NIndent),
194 translate_in_mode(NewType,Ascii,Symbol), print(Symbol),nl,
195 (is_associative(NewType) -> NewTypeR=NewType % no need for parentheses if same operator on right
196 ; NewTypeR=right(NewType)),
197 nbp(RHS,NewTypeR,NIndent),
198 print_bracket(Indent,NIndent,')').
199 nbp2(lazy_let_pred(TID,LHS,RHS),Type,_Info,Indent) :-
200 def_get_texpr_id(TID,ID),!,
201 NewType=lazy_let_pred(TID),
202 inc_indent(NewType,Type,Indent,NIndent),
203 print_indent(Indent), format('LET ~w = (~n',[ID]),
204 nbp(LHS,NewType,NIndent),
205 print_indent(NIndent), print(') IN ('),nl,
206 nbp(RHS,NewType,NIndent),
207 print_indent(NIndent),print(')'),nl.
208 nbp2(negation(LHS),_Type,_Info,Indent) :- !,
209 inc_indent(negation,false,Indent,NIndent),
210 print_indent(Indent),
211 translate_in_mode(negation,'not',Symbol), format('~s(~n',[Symbol]),
212 nbp(LHS,negation,NIndent),
213 print_indent(Indent), print(')'),nl.
214 nbp2(let_predicate(Ids,Exprs,Pred),_Type,_Info,Indent) :- !,
215 inc_indent(let_predicate,false,Indent,NIndent),
216 pp_expr_ids_in_mode(Ids,_LR,Codes,[]),
217 print_indent(Indent),format('#~s.( /* LET */~n',[Codes]),
218 pp_expr_let_pred_exprs(Ids,Exprs,_LimitReached,Codes2,[]),
219 print_indent(Indent), format('~s~n',[Codes2]),
220 print_indent(NIndent), print('&'),nl,
221 nbp(Pred,let_predicate,NIndent),
222 print_indent(Indent), print(')'),nl.
223 nbp2(exists(Ids,Pred),_Type,_Infos,Indent) :- !,
224 inc_indent(exists,false,Indent,NIndent),
225 pp_expr_ids_in_mode(Ids,_LR,Codes,[]),
226 print_indent(Indent),
227 %(member(allow_to_lift_exists,_Infos) -> write('/* LIFT */ ') ; true),
228 exists_symbol(ExistsSymbol,[]), format('~s~s.(~n',[ExistsSymbol,Codes]),
229 nbp(Pred,exists,NIndent),
230 print_indent(Indent), print(')'),nl.
231 nbp2(forall(Ids,LHS,RHS),_Type,_Info,Indent) :- !,
232 inc_indent(forall,false,Indent,NIndent),
233 pp_expr_ids_in_mode(Ids,_LR,Codes,[]),
234 print_indent(Indent),
235 forall_symbol(ForallSymbol,[]), format('~s~s.(~n',[ForallSymbol,Codes]),
236 nbp(LHS,forall,NIndent),
237 print_indent(NIndent),
238 translate_in_mode(implication,'=>',Symbol),print(Symbol),nl,
239 nbp(RHS,forall,NIndent),
240 print_indent(Indent), print(')'),nl.
241 nbp2(if_then_else(Test,LHS,RHS),_Type,_Info,Indent) :- !,
242 inc_indent(if_then_else,false,Indent,NIndent),
243 print_indent(Indent), print('IF'),nl,
244 nbp(Test,if_then_else,NIndent),
245 print_indent(Indent), print('THEN'),nl,
246 nbp(LHS,if_then_else,NIndent),
247 print_indent(Indent), print('ELSE'),nl,
248 nbp(RHS,if_then_else,NIndent),
249 print_indent(Indent), print('END'),nl.
250 %nbp2(equal(LHS,RHS),pred,_Info,Indent) :-
251 % get_texpr_id(LHS,_Id),!,
252 % print_indent(Indent),print_bexpr(LHS),print(' ='),nl,
253 % inc_indent(equal,false,Indent,NIndent),
254 nbp2(E,_,Info,Indent) :- print_indent(Indent), print_bexpr(b(E,pred,Info)),nl.
255
256 % all left-associative
257 get_binary_connective(conjunct(LHS,RHS),conjunct,'&',LHS,RHS).
258 get_binary_connective(disjunct(LHS,RHS),disjunct,'or',LHS,RHS).
259 get_binary_connective(implication(LHS,RHS),implication,'=>',LHS,RHS).
260 get_binary_connective(equivalence(LHS,RHS),equivalence,'<=>',LHS,RHS).
261
262 inc_indent(Type,CurType,I,NewI) :- (Type=CurType -> NewI=I ; NewI=s(I)).
263 print_bracket(I,I,_) :- !.
264 print_bracket(I,_NewI,Bracket) :-
265 print_indent(I), print(Bracket),nl.
266
267 print_indent(s(X)):- !,
268 print(' '),
269 print_indent(X).
270 print_indent(_).
271
272
273 /* =============================================== */
274 /* Translating expressions and values into strings */
275 /* =============================================== */
276
277 translate_params_for_dot(List,TransList) :- translate_params_for_dot(List,TransList,-3).
278 translate_params_for_dot([],'',_).
279 translate_params_for_dot([H|T],Res,Nr) :-
280 translate_property_with_limit(H,100,TH),
281 (Nr>2 -> N1=1 ; N1 is Nr+1),
282 translate_params_for_dot(T,TT,N1),
283 string_concatenate(TH,TT,Res1),
284 (N1=1 -> string_concatenate(',\n',Res1,Res)
285 ; (Nr>(-3) -> string_concatenate(',',Res1,Res) ; Res=Res1)).
286
287 translate_channel_values(X,['_'|T],T) :- var(X),!.
288 translate_channel_values([],S,S) :- !.
289 translate_channel_values([tuple([])|T],S,R) :- !,
290 translate_channel_values(T,S,R).
291 translate_channel_values([in(tuple([]))|T],S,R) :- !,
292 translate_channel_values(T,S,R).
293 translate_channel_values([H|T],['.'|S],R) :- !,
294 ((nonvar(H),H=in(X))
295 -> Y=X
296 ; Y=H
297 ),
298 pp_csp_value(Y,S,S2),
299 translate_channel_values(T,S2,R).
300 translate_channel_values(tail_in(X),S,T) :-
301 (X=[] ; X=[_|_]), !, translate_channel_values(X,S,T).
302 translate_channel_values(_X,['??'|S],S).
303
304
305
306 pp_single_csp_value(V,'_') :- var(V),!.
307 pp_single_csp_value(X,'_cyclic_') :- cyclic_term(X),!.
308 pp_single_csp_value(int(X),A) :- atomic(X),!,number_chars(X,Chars),atom_chars(A,Chars).
309
310 :- assert_must_succeed((translate_cspm_expression(listExp(rangeOpen(2)),R), R == '<2..>')).
311 :- assert_must_succeed((translate_cspm_expression(listFrom(2),R), R == '<2..>')).
312 :- assert_must_succeed((translate_cspm_expression(listFromTo(2,6),R), R == '<2..6>')).
313 :- assert_must_succeed((translate_cspm_expression(setFromTo(2,6),R), R == '{2..6}')).
314 :- assert_must_succeed((translate_cspm_expression('#'(listFromTo(2,6)),R), R == '#<2..6>')).
315 :- assert_must_succeed((translate_cspm_expression(inGuard(x,setFromTo(1,5)),R), R == '?x:{1..5}')).
316 :- assert_must_succeed((translate_cspm_expression(builtin_call(int(3)),R), R == '3')).
317 :- assert_must_succeed((translate_cspm_expression(set_to_seq(setValue([int(1),int(2)])),R), R == 'seq({1,2})')).
318 :- assert_must_succeed((translate_cspm_expression(diff(setValue([int(1)]),setValue([])),R), R == 'diff({1},{})')).
319 :- assert_must_succeed((translate_cspm_expression(inter(setValue([int(1)]),setValue([])),R), R == 'inter({1},{})')).
320 :- assert_must_succeed((translate_cspm_expression(lambda([x,y],'*'(x,y)),R), R == '\\ x,y @ (x*y)')).
321 :- assert_must_succeed((translate_cspm_expression(lambda([x,y],'/'(x,y)),R), R == '\\ x,y @ (x/y)')).
322 :- assert_must_succeed((translate_cspm_expression(lambda([x,y],'%'(x,y)),R), R == '\\ x,y @ (x%y)')).
323 :- assert_must_succeed((translate_cspm_expression(rename(x,y),R), R == 'x <- y')).
324 :- assert_must_succeed((translate_cspm_expression(link(x,y),R), R == 'x <-> y')).
325 :- assert_must_succeed((translate_cspm_expression(agent_call_curry(f,[[a,b],[c]]),R), R == 'f(a,b)(c)')).
326
327 translate_cspm_expression(Expr, Text) :-
328 (pp_csp_value(Expr,Atoms,[]) -> ajoin(Atoms,Text)
329 ; print('Pretty printing expression failed: '),print(Expr),nl).
330
331 pp_csp_value(X,[A|S],S) :- pp_single_csp_value(X,A),!.
332 pp_csp_value(setValue(L),['{'|S],T) :- !,pp_csp_value_l(L,',',S,['}'|T],inf).
333 pp_csp_value(setExp(rangeEnum(L)),['{'|S],T) :- !,pp_csp_value_l(L,',',S,['}'|T],inf).
334 pp_csp_value(setExp(rangeEnum(L),Gen),['{'|S],T) :- !,
335 copy_term((L,Gen),(L2,Gen2)), numbervars((L2,Gen2),1,_),
336 pp_csp_value_l(L2,',',S,['|'|S2],inf),
337 pp_csp_value_l(Gen2,',',S2,['}'|T],inf).
338 pp_csp_value(avl_set(A),['{'|S],T) :- !, check_is_non_empty_avl(A),
339 avl_domain(A,L),pp_csp_value_l(L,',',S,['}'|T],inf).
340 pp_csp_value(setExp(rangeClosed(L,U)),['{'|S],T) :- !, pp_csp_value(L,S,['..'|S2]),pp_csp_value(U,S2,['}'|T]).
341 pp_csp_value(setExp(rangeOpen(L)),['{'|S],T) :- !, pp_csp_value(L,S,['..}'|T]).
342 % TO DO: pretty print comprehensionGuard; see prints in coz-example.csp ; test 1846
343 pp_csp_value(comprehensionGenerator(Var,Body),S,T) :- !, pp_csp_value(Var,S,['<-'|S1]),
344 pp_csp_value(Body,S1,T).
345 pp_csp_value(listExp(rangeEnum(L)),['<'|S],T) :- !,pp_csp_value_l(L,',',S,['>'|T],inf).
346 pp_csp_value(listExp(rangeClosed(L,U)),['<'|S],T) :- !, pp_csp_value(L,S,['..'|S2]),pp_csp_value(U,S2,['>'|T]).
347 pp_csp_value(listExp(rangeOpen(L)),['<'|S],T) :- !, pp_csp_value(L,S,['..>'|T]).
348 pp_csp_value(setFromTo(L,U),['{'|S],T) :- !,
349 pp_csp_value(L,S,['..'|S2]),pp_csp_value(U,S2,['}'|T]).
350 pp_csp_value(setFrom(L),['{'|S],T) :- !,
351 pp_csp_value(L,S,['..}'|T]).
352 pp_csp_value(closure(L), ['{|'|S],T) :- !,pp_csp_value_l(L,',',S,['|}'|T],inf).
353 pp_csp_value(list(L),['<'|S],T) :- !,pp_csp_value_l(L,',',S,['>'|T],inf).
354 pp_csp_value(listFromTo(L,U),['<'|S],T) :- !,
355 pp_csp_value(L,S,['..'|S2]),pp_csp_value(U,S2,['>'|T]).
356 pp_csp_value(listFrom(L),['<'|S],T) :- !,
357 pp_csp_value(L,S,['..>'|T]).
358 pp_csp_value('#'(L),['#'|S],T) :- !,pp_csp_value(L,S,T).
359 pp_csp_value('^'(X,Y),S,T) :- !,pp_csp_value(X,S,['^'|S1]), pp_csp_value(Y,S1,T).
360 pp_csp_value(linkList(L),S,T) :- !,pp_csp_value_l(L,',',S,T,inf).
361 pp_csp_value(in(X),['?'|S],T) :- !,pp_csp_value(X,S,T).
362 pp_csp_value(inGuard(X,Set),['?'|S],T) :- !,pp_csp_value(X,S,[':'|S1]),
363 pp_csp_value(Set,S1,T).
364 pp_csp_value(out(X),['!'|S],T) :- !,pp_csp_value(X,S,T).
365 pp_csp_value(alsoPat(X,_Y),S,T) :- !,pp_csp_value(X,S,T).
366 pp_csp_value(appendPat(X,_Fun),S,T) :- !,pp_csp_value(X,S,T).
367 pp_csp_value(tuple(vclosure),S,T) :- !, S=T.
368 pp_csp_value(tuple([X]),S,T) :- !,pp_csp_value_in(X,S,T).
369 pp_csp_value(tuple([X|vclosure]),S,T) :- !,pp_csp_value_in(X,S,T).
370 pp_csp_value(tuple([H|TT]),S,T) :- !,pp_csp_value_in(H,S,['.'|S1]),pp_csp_value(tuple(TT),S1,T).
371 pp_csp_value(dotTuple([]),['unit_channel'|S],S) :- ! .
372 pp_csp_value(dotTuple([H]),S,T) :- !, pp_csp_value_in(H,S,T).
373 pp_csp_value(dotTuple([H|TT]),S,T) :- !, pp_csp_value_in(H,S,['.'|S1]),
374 pp_csp_value(dotTuple(TT),S1,T).
375 pp_csp_value(tupleExp(Args),S,T) :- !,pp_csp_args(Args,S,T,'(',')').
376 pp_csp_value(na_tuple(Args),S,T) :- !,pp_csp_args(Args,S,T,'(',')').
377 pp_csp_value(record(Name,Args),['('|S],T) :- !,pp_csp_value(tuple([Name|Args]),S,[')'|T]).
378 pp_csp_value(val_of(Name,_Span),S,T) :- !, pp_csp_value(Name,S,T).
379 pp_csp_value(builtin_call(X),S,T) :- !,pp_csp_value(X,S,T).
380 pp_csp_value(seq_to_set(X),['set('|S],T) :- !,pp_csp_value(X,S,[')'|T]).
381 pp_csp_value(set_to_seq(X),['seq('|S],T) :- !,pp_csp_value(X,S,[')'|T]).
382 %pp_csp_value('\\'(B,C,S),S1,T) :- !, pp_csp_process(ehide(B,C,S),S1,T).
383 pp_csp_value(agent_call(_Span,Agent,Parameters),['('|S],T) :- !,
384 pp_csp_value(Agent,S,S1),
385 pp_csp_args(Parameters,S1,[')'|T],'(',')').
386 pp_csp_value(agent_call_curry(Agent,Parameters),S,T) :- !,
387 pp_csp_value(Agent,S,S1),
388 pp_csp_curry_args(Parameters,S1,T).
389 pp_csp_value(lambda(Parameters,Body),['\\ '|S],T) :- !,
390 pp_csp_args(Parameters,S,[' @ '|S1],'',''),
391 pp_csp_value(Body,S1,T).
392 pp_csp_value(rename(X,Y),S,T) :- !,pp_csp_value(X,S,[' <- '|S1]),
393 pp_csp_value(Y,S1,T).
394 pp_csp_value(link(X,Y),S,T) :- !,pp_csp_value(X,S,[' <-> '|S1]),
395 pp_csp_value(Y,S1,T).
396 % binary operators:
397 pp_csp_value(Expr,['('|S],T) :- bynary_numeric_operation(Expr,E1,E2,OP),!,
398 pp_csp_value(E1,S,[OP|S2]),
399 pp_csp_value(E2,S2,[')'|T]).
400 % built-in functions for sets
401 pp_csp_value(empty(A),[empty,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
402 pp_csp_value(card(A),[card,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
403 pp_csp_value('Set'(A),['Set','('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
404 pp_csp_value('Inter'(A1),['Inter','('|S],T) :- !,pp_csp_value(A1,S,[')'|T]).
405 pp_csp_value('Union'(A1),['Union','('|S],T) :- !,pp_csp_value(A1,S,[')'|T]).
406 pp_csp_value(diff(A1,A2),[diff,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
407 pp_csp_value(inter(A1,A2),[inter,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
408 pp_csp_value(union(A1,A2),[union,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
409 pp_csp_value(member(A1,A2),[member,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
410 % built-in functions for sequences
411 pp_csp_value(null(A),[null,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
412 pp_csp_value(length(A),[length,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
413 pp_csp_value(head(A),[head,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
414 pp_csp_value(tail(A),[tail,'('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
415 pp_csp_value(elem(A1,A2),[elem,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
416 pp_csp_value(concat(A1,A2),[concat,'('|S],T) :- !,pp_csp_args([A1,A2],S,[')'|T],'','').
417 pp_csp_value('Seq'(A),['Seq','('|S],T) :- !, pp_csp_value(A,S,[')'|T]).
418 % vclosure
419 pp_csp_value(Expr,S,T) :- is_list(Expr),!,pp_csp_value(closure(Expr),S,T).
420 % Type expressions
421 pp_csp_value(dotTupleType([H]),S,T) :- !, pp_csp_value_in(H,S,T).
422 pp_csp_value(dotTupleType([H|TT]),S,T) :- !,pp_csp_value_in(H,S,['.'|S1]), pp_csp_value(dotTupleType(TT),S1,T).
423 pp_csp_value(typeTuple(Args),S,T) :- !, pp_csp_args(Args,S,T,'(',')').
424 pp_csp_value(dataType(T),[T|S],S) :- ! .
425 pp_csp_value(boolType,['Bool'|S],S) :- ! .
426 pp_csp_value(intType,['Int'|S],S) :- ! .
427 pp_csp_value(dataTypeDef([H]),S,T) :- !, pp_csp_value(H,S,T).
428 pp_csp_value(dataTypeDef([H|TT]),S,T) :- !, pp_csp_value(H,S,['|'|S1]),
429 pp_csp_value(dataTypeDef(TT),S1,T).
430 pp_csp_value(constructor(Name),[Name|S],S) :- ! .
431 pp_csp_value(constructorC(C,Type),[C,'('|S],T) :- !, pp_csp_value(Type,S,[')'|T]).
432 % Argument of function can be process
433
434 pp_csp_value(Expr,S,T) :- pp_csp_process(Expr,S,T),!. % pp_csp_process has a catch-all !!! TO DO: look at this
435 pp_csp_value(Expr,S,T) :- csp_with_bz_mode,!,pp_value(Expr,S,T).
436 pp_csp_value(X, [A|S], S) :- % ['<< ',A,' >>'|S],S) :- % the << >> pose problems when checking against FDR
437 write_to_codes(X,Codes),atom_codes_with_limit(A,Codes).
438
439 pp_csp_value_in(H,S,T) :- nonvar(H),H=in(X),!, pp_csp_value(X,S,T).
440 pp_csp_value_in(H,S,T) :- pp_csp_value(H,S,T).
441
442 print_csp_value(Val) :- pp_csp_value(Val,Atoms,[]), ajoin(Atoms,Text),
443 print(Text).
444
445 translate_csp_value(Val,Text) :- pp_csp_value(Val,Atoms,[]), ajoin(Atoms,Text).
446
447 return_csp_closure_value(closure(S),List) :- pp_csp_value_l1(S,List).
448 return_csp_closure_value(setValue(S),List) :- pp_csp_value_l1(S,List).
449
450 pp_csp_value_l1([Expr|Rest],List) :-
451 ( nonvar(Rest),Rest=[] ->
452 pp_csp_value(Expr,T,[]),ajoin(T,Value),List=[Value]
453 ; pp_csp_value_l1(Rest,R),pp_csp_value(Expr,T,[]),ajoin(T,Value),List=[Value|R]
454 ).
455
456 pp_csp_args([],T,T,_LPar,_RPar).
457 pp_csp_args([H|TT],[LPar|S],T,LPar,RPar) :- pp_csp_value(H,S,S1), pp_csp_args2(TT,S1,T,RPar).
458 pp_csp_args2([],[RPar|T],T,RPar).
459 pp_csp_args2([H|TT],[','|S],T,RPar) :- pp_csp_value(H,S,S1), pp_csp_args2(TT,S1,T,RPar).
460
461 pp_csp_curry_args([],T,T).
462 pp_csp_curry_args([H|TT],S,T) :- is_list(H), pp_csp_args(H,S,S1,'(',')'), pp_csp_curry_args(TT,S1,T).
463
464 pp_csp_value_l(V,_Sep,['...'|S],S,N) :- (var(V) ; (N \= inf -> N<1;fail)), !.
465 pp_csp_value_l([],_Sep,S,S,_).
466 pp_csp_value_l([Expr|Rest],Sep,S,T,Nr) :-
467 ( nonvar(Rest),Rest=[] ->
468 pp_csp_value(Expr,S,T)
469 ;
470 (Nr=inf -> N1 = Nr ; N1 is Nr-1),
471 pp_csp_value(Expr,S,[Sep|S1]),pp_csp_value_l(Rest,Sep,S1,T,N1)).
472
473 :- assert_must_succeed((translate:convert_set_into_sequence([(int(1),int(5))],Seq),
474 check_eqeq(Seq,[int(5)]))).
475 :- assert_must_succeed((translate:convert_set_into_sequence([(int(2),X),(int(1),int(5))],Seq),
476 check_eq(Seq,[int(5),X]))).
477
478 convert_set_into_sequence(Set,Seq) :-
479 nonvar(Set), \+ eventb_translation_mode,
480 convert_set_into_sequence1(Set,Seq).
481 convert_set_into_sequence1(avl_set(A),Seq) :- !, check_is_non_empty_avl(A),
482 avl_size(A,Sz),size_is_in_set_limit(Sz),convert_avlset_into_sequence(A,Seq).
483 convert_set_into_sequence1([],Seq) :- !, Seq=[].
484 convert_set_into_sequence1(Set,Seq) :-
485 convert_set_into_sequence2(Set,0,_,SetElems,Seq),ground(SetElems).
486 convert_set_into_sequence2([],_Max,([],[]),_,_Seq).
487 convert_set_into_sequence2([Pair|T],Max,Last,SetElems,Seq) :-
488 nonvar(Pair),nonvar(T),Pair=(Index,H),ground(Index),
489 Index=int(Nr),
490 insert_el_into_seq(Nr,H,Seq,SetElems,L),
491 (Nr>Max -> NMax=Nr,NLast=L ; NMax=Max,NLast=Last),
492 convert_set_into_sequence2(T,NMax,NLast,SetElems,Seq).
493 insert_el_into_seq(1,H,[H|L],[set|L2],(L,L2)) :- !.
494 insert_el_into_seq(N,H,[_|T],[_|T2],Last) :- N>1, N1 is N-1, insert_el_into_seq(N1,H,T,T2,Last).
495
496 convert_avlset_into_sequence(Avl,Sequence) :-
497 \+ eventb_translation_mode,
498 convert_avlset_into_sequence2(Avl,1,Sequence).
499 convert_avlset_into_sequence2(Avl,_Index,[]) :-
500 empty_avl(Avl),!.
501 convert_avlset_into_sequence2(Avl,Index,[Head|Tail]) :-
502 avl_del_min(Avl, Min, _ ,NewAvl),
503 nonvar(Min), Min=(L,Head),
504 ground(L), L=int(Index),
505 Index2 is Index + 1,
506 convert_avlset_into_sequence2(NewAvl,Index2,Tail).
507
508 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
509 % translate new syntax tree -- work in progress
510 :- assert_must_succeed((translate_cspm_state(lambda([x,y],'|~|'(prefix(_,[],x,skip(_),_),prefix(_,[],y,skip(_),_),_)),R), R == 'CSP: \\ x,y @ (x->SKIP) |~| (y->SKIP)')).
511 :- assert_must_succeed((translate_cspm_state(agent_call_curry('F',[[a,b],[c]]),R), R == 'CSP: F(a,b)(c)')).
512 :- assert_must_succeed((translate_cspm_state(ifte(bool_not('<'(x,3)),';'(esharing([a],'/\\'('P1','P2',span),procRenaming([rename(r,s)],'Q',span),span),lParallel([link(b,c)],'R','S',span),span),'[>'(elinkParallel([link(h1,h2)],'G1','G2',span),exception([a],'H1','H2',span),span),span1,span2,span3),R), R == 'CSP: if not((x<3)) then ((P1) /\\ (P2) [|{|a|}|] Q[[r <- s]]) ; (R [{|b <-> c|}] S) else (G1 [{|h1 <-> h2|}] G2) [> (H1 [|{|a|}|> H2)')).
513 :- assert_must_succeed((translate_cspm_state(aParallel([a,b],'P',[b,c],'Q',span),R), R == 'CSP: P [{|a,b|} || {|b,c|}] Q')).
514 :- assert_must_succeed((translate_cspm_state(eaParallel([a,b],'P',[b,c],'Q',span),R), R == 'CSP: P [{|a,b|} || {|b,c|}] Q')).
515 :- assert_must_succeed((translate_cspm_state(eexception([a,b],'P','Q',span),R), R == 'CSP: P [|{|a,b|}|> Q')).
516
517 print_cspm_state(State) :- translate_cspm_state(State,T), print(T).
518
519 translate_cspm_state(State,Text) :-
520 ( pp_csp_process(State,Atoms,[]) -> true
521 ; print(pp_csp_process_failed(State)),nl,Atoms=State),
522 ajoin(['CSP: '|Atoms],Text).
523
524 pp_csp_process(skip(_Span),S,T) :- !, S=['SKIP'|T].
525 pp_csp_process(stop(_Span),S,T) :- !, S=['STOP'|T].
526 pp_csp_process('CHAOS'(_Span,Set),['CHAOS('|S],T) :- !,
527 pp_csp_value(Set,S,[')'|T]).
528 pp_csp_process(val_of(Agent,_Span),S,T) :- !,
529 pp_csp_value(Agent,S,T).
530 pp_csp_process(builtin_call(X),S,T) :- !,pp_csp_process(X,S,T).
531 pp_csp_process(agent(F,Body,_Span),S,T) :- !,
532 F =.. [Agent|Parameters],
533 pp_csp_value(Agent,S,S1),
534 pp_csp_args(Parameters,S1,[' = '|S2],'(',')'),
535 pp_csp_value(Body,S2,T).
536 pp_csp_process(agent_call(_Span,Agent,Parameters),S,T) :- !,
537 pp_csp_value(Agent,S,S1),
538 pp_csp_args(Parameters,S1,T,'(',')').
539 pp_csp_process(agent_call_curry(Agent,Parameters),S,T) :- !,
540 pp_csp_value(Agent,S,S1),
541 pp_csp_curry_args(Parameters,S1,T).
542 pp_csp_process(lambda(Parameters,Body),['\\ '|S],T) :- !,
543 pp_csp_args(Parameters,S,[' @ '|S1],'',''),
544 pp_csp_value(Body,S1,T).
545 pp_csp_process('\\'(B,C,S),S1,T) :- !, pp_csp_process(ehide(B,C,S),S1,T).
546 pp_csp_process(ehide(Body,ChList,_Span),['('|S],T) :- !,
547 pp_csp_process(Body,S,[')\\('|S1]),
548 pp_csp_value(ChList,S1,[')'|T]).
549 pp_csp_process(let(Decls,P),['let '| S],T) :- !,
550 maplist(translate_cspm_state,Decls,Texts),
551 ajoin_with_sep(Texts,' ',Text),
552 S=[Text,' within '|S1],
553 pp_csp_process(P,S1,T).
554 pp_csp_process(Expr,['('|S],T) :- binary_csp_op(Expr,X,Y,Op),!,
555 pp_csp_process(X,S,[') ',Op,' ('|S1]),
556 pp_csp_process(Y,S1,[')'|T]).
557 pp_csp_process(Expr,S,T) :- sharing_csp_op(Expr,X,Middle,Y,Op1,Op2),!,
558 pp_csp_process(X,S,[Op1|S1]),
559 pp_csp_value(Middle,S1,[Op2|S2]),
560 pp_csp_process(Y,S2,T).
561 pp_csp_process(Expr,S,T) :- asharing_csp_op(Expr,X,MiddleX,MiddleY,Y,Op1,MOp,Op2),!,
562 pp_csp_process(X,S,[Op1|S1]),
563 pp_csp_value(MiddleX,S1,[MOp|S2]),
564 pp_csp_value(MiddleY,S2,[Op2|S3]),
565 pp_csp_process(Y,S3,T).
566 pp_csp_process(Expr,S,T) :- renaming_csp_op(Expr,X,RList,Op1,Op2),!,
567 pp_csp_process(X,S,[Op1|S1]),
568 pp_csp_value_l(RList,',',S1,[Op2|T],10).
569 pp_csp_process(prefix(_SPAN1,Values,ChannelExpr,CSP,_SPAN2),S,T) :- !,
570 pp_csp_value_l([ChannelExpr|Values],'',S,['->'|S2],20),
571 pp_csp_process(CSP,S2,T).
572 pp_csp_process('&'(Test,Then),S,T) :- !,
573 pp_csp_bool_expr(Test,S,['&'|S2]),
574 pp_csp_process(Then,S2,T).
575 pp_csp_process(ifte(Test,Then,Else,_SPAN1,_SPAN2,_SPAN3),[' if '|S],T) :- !,
576 pp_csp_bool_expr(Test,S,[' then '|S2]),
577 pp_csp_process(Then,S2,[' else '|S3]),
578 pp_csp_process(Else,S3,T).
579 pp_csp_process(head(A),[head,'('|S],T) :- !, pp_csp_process(A,S,[')'|T]).
580 pp_csp_process(X,[X|T],T).
581
582 pp_csp_bool_expr(bool_not(BE),['not('|S],T) :- !, pp_csp_bool_expr(BE,S,[')'|T]).
583 pp_csp_bool_expr(BE,['('|S],T) :- binary_bool_op(BE,BE1,BE2,OP), !,
584 pp_csp_bool_expr(BE1,S,[OP|S2]),
585 pp_csp_bool_expr(BE2,S2,[')'|T]).
586 pp_csp_bool_expr(BE,[OP,'('|S],T) :- binary_pred(BE,BE1,BE2,OP), !,
587 pp_csp_value(BE1,S,[','|S2]),
588 pp_csp_value(BE2,S2,[')'|T]).
589 pp_csp_bool_expr(BE,S,T) :- pp_csp_value(BE,S,T).
590
591 bynary_numeric_operation('+'(X,Y),X,Y,'+').
592 bynary_numeric_operation('-'(X,Y),X,Y,'-').
593 bynary_numeric_operation('*'(X,Y),X,Y,'*').
594 bynary_numeric_operation('/'(X,Y),X,Y,'/').
595 bynary_numeric_operation('%'(X,Y),X,Y,'%').
596
597 binary_pred('member'(X,Y),X,Y,member).
598 binary_pred('<'(X,Y),X,Y,'<').
599 binary_pred('>'(X,Y),X,Y,'>').
600 binary_pred('>='(X,Y),X,Y,'>=').
601 binary_pred('<='(X,Y),X,Y,'=<').
602 binary_pred('elem'(X,Y),X,Y,is_elem_list).
603 binary_pred('=='(X,Y),X,Y,equal_element).
604 binary_pred('!='(X,Y),X,Y,not_equal_element).
605
606
607 binary_bool_op('<'(X,Y),X,Y,'<').
608 binary_bool_op('>'(X,Y),X,Y,'>').
609 binary_bool_op('>='(X,Y),X,Y,'>=').
610 binary_bool_op('<='(X,Y),X,Y,'=<').
611 binary_bool_op('=='(X,Y),X,Y,'==').
612 binary_bool_op('!='(X,Y),X,Y,'!=').
613 binary_bool_op(bool_and(X,Y),X,Y,'&&').
614 binary_bool_op(bool_or(X,Y),X,Y,'||').
615
616 binary_csp_op('|||'(X,Y,_Span),X,Y,'|||').
617 binary_csp_op('[]'(X,Y,_Span),X,Y,'[]').
618 binary_csp_op('|~|'(X,Y,_Span),X,Y,'|~|').
619 binary_csp_op(';'(X,Y,_Span),X,Y,';').
620 binary_csp_op('[>'(P,Q,_SrcSpan),P,Q,'[>').
621 binary_csp_op('/\\'(P,Q,_SrcSpan),P,Q,'/\\').
622
623 sharing_csp_op(esharing(CList,X,Y,_SrcSpan),X,CList,Y,' [|','|] ').
624 sharing_csp_op(sharing(CList,X,Y,_SrcSpan),X,CList,Y,' [|','|] ').
625 sharing_csp_op(lParallel(LinkList,X,Y,_Span),X,LinkList,Y,' [','] ').
626 sharing_csp_op(elinkParallel(LinkList,X,Y,_Span),X,LinkList,Y,' [','] ').
627 sharing_csp_op(exception(CList,X,Y,_SrcSpan),X,CList,Y,' [|','|> ').
628 sharing_csp_op(eexception(CList,X,Y,_SrcSpan),X,CList,Y,' [|','|> ').
629
630 asharing_csp_op(aParallel(CListX,X,CListY,Y,_SrcSpan),X,CListX,CListY,Y,' [',' || ','] ').
631 asharing_csp_op(eaParallel(CListX,X,CListY,Y,_SrcSpan),X,CListX,CListY,Y,' [',' || ','] ').
632
633 renaming_csp_op(procRenaming(RenameList,X,_SrcSpan),X,RenameList,'[[',']]').
634 renaming_csp_op(eprocRenaming(RenameList,X,_SrcSpan),X,RenameList,'[[',']]').
635
636 :- use_module(bmachine,[b_get_machine_operation_parameter_types/2, b_is_operation_name/1]).
637
638 translate_events([],[]).
639 translate_events([E|Erest],[Out|Orest]) :-
640 translate_event(E,Out),
641 translate_events(Erest,Orest).
642
643
644 % a version of translate_event which has access to the target state id:
645 % this allows to translate setup_constants, intialise by inserting target constants or values
646
647 translate_event_with_target_id(Term,Dst,Limit,Str) :-
648 translate_event_with_src_and_target_id(Term,unknown,Dst,Limit,Str).
649 translate_event_with_src_and_target_id(Term,Src,Dst,Str) :-
650 translate_event_with_src_and_target_id(Term,Src,Dst,5000,Str).
651
652 translate_event_with_src_and_target_id(Term,Src,Dst,Limit,Str) :-
653 get_preference(expand_avl_upto,CurLim),
654 SetLim is Limit//2,% at least two symbols per element
655 (CurLim<0 ; SetLim < CurLim),!,
656 temporary_set_preference(expand_avl_upto,SetLim,CHNG),
657 call_cleanup(translate_event_with_target_id2(Term,Src,Dst,Limit,Str),
658 reset_temporary_preference(expand_avl_upto,CHNG)).
659 translate_event_with_src_and_target_id(Term,Src,Dst,Limit,Str) :-
660 translate_event_with_target_id2(Term,Src,Dst,Limit,Str).
661
662 setup_cst_functor('$setup_constants',"SETUP_CONSTANTS").
663 setup_cst_functor('$partial_setup_constants',"PARTIAL_SETUP_CONSTANTS").
664
665 translate_event_with_target_id2(Term,_,Dst,Limit,Str) :-
666 functor(Term,Functor,_),
667 setup_cst_functor(Functor,UI_Name),
668 get_preference(show_initialisation_arguments,true),
669 state_space:visited_expression(Dst,concrete_constants(State)),
670 get_non_det_constant(State,NonDetState),
671 !,
672 translate_b_state_to_comma_list_codes(UI_Name,NonDetState,Limit,Codes),
673 atom_codes_with_limit(Str,Limit,Codes).
674 translate_event_with_target_id2(Term,_,Dst,Limit,Str) :-
675 functor(Term,'$initialise_machine',_),
676 get_preference(show_initialisation_arguments,true),
677 bmachine:b_get_operation_non_det_modifies('$initialise_machine',NDModVars),
678 state_space:visited_expression(Dst,State), get_variables(State,VarsState),
679 (NDModVars \= []
680 ->
681 include(non_det_modified_var(NDModVars),VarsState,ModVarsState) % first show non-det variables
682 % we could add a preference for whether to show the deterministicly assigned variables at all
683 %exclude(non_det_modified_var(NDModVars),VarsState,ModVarsState2),
684 %append(ModVarsState1,ModVarsState2,ModVarsState)
685 ; ModVarsState = VarsState),
686 !,
687 translate_b_state_to_comma_list_codes("INITIALISATION",ModVarsState,Limit,Codes),
688 atom_codes_with_limit(Str,Limit,Codes).
689 translate_event_with_target_id2(Term,Src,Dst,Limit,Str) :-
690 atomic(Term), % only applied to operations without parameters
691 ? specfile:b_mode,
692 get_non_det_modified_vars_in_target_id(Term,Dst,ModVarsState0), % only show non-det variables
693 (Src \= unknown,
694 state_space:visited_expression(Src,SrcState), get_variables(SrcState,PriorVarsState)
695 -> exclude(var_not_really_modified(PriorVarsState),ModVarsState0,ModVarsState)
696 % we could also optionally filter out vars which have the same value for all outgoing transitions of Src
697 ; ModVarsState = ModVarsState0
698 ),
699 !,
700 atom_codes(Term,TermCodes),
701 translate_b_state_to_comma_list_codes(TermCodes,ModVarsState,Limit,Codes),
702 atom_codes_with_limit(Str,Limit,Codes).
703 translate_event_with_target_id2(Term,_,_,Limit,Str) :- translate_event_with_limit(Term,Limit,Str).
704
705
706 get_non_det_modified_vars_in_target_id(OpName,DstId,ModVarsState0) :-
707 bmachine:b_get_operation_non_det_modifies(OpName,NDModVars),
708 NDModVars \= [], % a variable is non-deterministically written
709 state_space:visited_expression(DstId,State), % TO DO: unpack only NModVars
710 get_variables(State,VarsState),
711 include(non_det_modified_var(NDModVars),VarsState,ModVarsState0).
712
713 :- use_module(library(ordsets)).
714 non_det_modified_var(NDModVars,bind(Var,_)) :- ord_member(Var,NDModVars).
715
716 var_not_really_modified(PriorState,bind(Var,Val)) :-
717 ? (member(bind(Var,PVal),PriorState) -> PVal=Val).
718
719 get_variables(const_and_vars(_,VarsState),S) :- !, S=VarsState.
720 get_variables(S,S).
721
722 :- dynamic non_det_constants/2.
723
724 % compute which constants are non-deterministically assigned and which ones not
725 % TODO: maybe move to state space and invalidate info in case execute operation by predicate used
726 get_non_det_constant(Template,Result) :- non_det_constants(A,B),!, (A,B)=(Template,Result).
727 get_non_det_constant(Template,Result) :-
728 ? state_space:transition(root,_,DstID),
729 state_space:visited_expression(DstID,concrete_constants(State)), %print(get_non_det_constant(DstID)),nl,
730 !,
731 findall(D,(state_space:transition(root,_,D),D \= DstID),OtherDst),
732 compute_non_det_constants2(OtherDst,State),
733 non_det_constants(Template,Result).
734 get_non_det_constant(A,A).
735
736 compute_non_det_constants2([],State) :- adapt_state(State,Template,Result),
737 (Result = [] -> assertz(non_det_constants(A,A)) % in case all variables are deterministic: just show them
738 ; assertz(non_det_constants(Template,Result))).
739 compute_non_det_constants2([Dst|T],State) :-
740 state_space:visited_expression(Dst,concrete_constants(State2)),
741 lub_state(State,State2,NewState),
742 compute_non_det_constants2(T,NewState).
743
744 lub_state([],[],[]).
745 lub_state([bind(V,H1)|T1],[bind(V,H2)|T2],[bind(V,H3)|T3]) :-
746 (H1==H2 -> H3=H1 ; H3='$NONDET'), lub_state(T1,T2,T3).
747
748 adapt_state([],[],[]).
749 adapt_state([bind(ID,Val)|T],[bind(ID,X)|TX],[bind(ID,X)|TY]) :- Val='$NONDET',!,
750 adapt_state(T,TX,TY).
751 adapt_state([bind(ID,_)|T],[bind(ID,_)|TX],TY) :- % Value is deterministic: do not copy
752 adapt_state(T,TX,TY).
753
754
755
756 % ------------------------------------
757
758 translate_event_with_limit(Event,Limit,Out) :-
759 translate_event2(Event,Atoms,[]),!,
760 ajoin_with_limit(Atoms,Limit,Out).
761 %,print(done),debug:print_debug_stats,nl.% , print(Out),nl.
762 translate_event_with_limit(Event,_,Out) :- add_error(translate_event_with_limit,'Could not translate event: ', Event),
763 Out = '???'.
764
765 translate_event(Event,Out) :- %print(translate),print_debug_stats,nl,
766 translate_event2(Event,Atoms,[]),!,
767 ajoin(Atoms,Out).
768 %,print(done),debug:print_debug_stats,nl.% , print(Out),nl.
769 translate_event(Event,Out) :-
770 add_error(translate_event,'Could not translate event: ', Event),
771 Out = '???'.
772 /* BEGIN CSP */
773 translate_event2(start_cspm(Process),['start_cspm('|S],T) :- process_algebra_mode,!,pp_csp_value(Process,S,[')'|T]).
774 %% translate_event2(i(_Span),['i'|T],T) :- process_algebra_mode,!. /* CSP */ %% deprecated
775 translate_event2(tick(_Span),['tick'|T],T) :- process_algebra_mode,!. /* CSP */
776 translate_event2(tau(hide(Action)),['tau(hide('|S],T) :- process_algebra_mode,nonvar(Action), !,
777 translate_event2(Action,S,['))'|T]). /* CSP */
778 translate_event2(tau(link(Action1,Action2)),['tau(link('|S],T) :- /* CSP */
779 nonvar(Action1), nonvar(Action2), process_algebra_mode, !,
780 translate_event2(Action1,S,['<->'|S1]),
781 translate_event2(Action2,S1,['))'|T]).
782 translate_event2(tau(Info),['tau(',Fun,')'|T],T) :-
783 nonvar(Info), process_algebra_mode,!, /* CSP */
784 functor(Info,Fun,_). %(translate_event(Info,Fun) -> true ; functor(Info,Fun,_)),
785 translate_event2(io(V,Ch,_Span),S,T) :- process_algebra_mode,!, /* CSP */
786 (specfile:csp_with_bz_mode ->
787 S=['CSP:'|S1],
788 translate_event2(io(V,Ch),S1,T)
789 ;
790 translate_event2(io(V,Ch),S,T)
791 ).
792 translate_event2(io(X,Channel),S,T) :- process_algebra_mode,!, /* CSP */
793 (X=[] -> translate_event2(Channel,S,T)
794 ; (translate_event2(Channel,S,S1),
795 translate_channel_values(X,S1,T))
796 ).
797 /* END CSP */
798 translate_event2('$JUMP'(Name),[A|T],T) :- write_to_codes(Name,Codes),
799 atom_codes_with_limit(A,Codes).
800 translate_event2('-->'(Operation,ResultValues),S,T) :- nonvar(ResultValues),
801 ResultValues=[_|_],!,
802 translate_event2(Operation,S,['-->',ValuesStr|T]),
803 translate_bvalues(ResultValues,ValuesStr).
804 translate_event2(Op,S,T) :-
805 nonvar(Op), Op =.. [OpName|Args],
806 translate_b_operation_call(OpName,Args,S,T),!.
807 translate_event2(Op,[A|T],T) :-
808 %['<< ',A,' >>'|T],T) :- % the << >> pose problems when checking against FDR
809 write_to_codes(Op,Codes),
810 atom_codes_with_limit(A,Codes).
811
812 % translate a B operation call to list of atoms in dcg style
813 translate_b_operation_call(OpName,Args,[TOpName|S],T) :-
814 translate_operation_name(OpName,TOpName),
815 ( Args=[] -> S=T
816 ;
817 S=['(',ValuesStr,')'|T],
818 ( get_preference(show_eventb_any_arguments,false), % otherwise we have additional ANY parameters !
819 \+ is_init(OpName), % order of variables does not always correspond to Variable order used by b_get_machine_operation_parameter_types ! TO DO - Fix this in b_initialise_machine2 (see Interlocking.mch CSP||B model)
820 ? specfile:b_mode,
821 b_is_operation_name(OpName),
822 b_get_machine_operation_parameter_types(OpName,ParTypes),
823 ParTypes \= []
824 -> translate_bvalues_with_types(Args,ParTypes,ValuesStr)
825 %; is_init(OpName) -> b_get_machine_operation_typed_parameters(OpName,TypedParas),
826 ; translate_bvalues(Args,ValuesStr))
827 ).
828
829 % -----------------
830
831 % translate call stacks as stored in wait flag info fields
832 % (managed by push_wait_flag_call_stack_info)
833
834 translate_call_stack(Stack,Msg) :-
835 Opts = [detailed],
836 split_calls(Stack,DStack),
837 get_cs_avl_limit(ALimit),
838 temporary_set_preference(expand_avl_upto,ALimit,CHNG),
839 set_unicode_mode,
840 call_cleanup(render_call_stack(DStack,1,Opts,A,[]),
841 (unset_unicode_mode,
842 reset_temporary_preference(expand_avl_upto,CHNG))),
843 ajoin(['call stack: '|A],Msg).
844 render_call_stack([],_,_) --> [].
845 render_call_stack([H],Nr,Opts) --> !,
846 render_nr(Nr,H,_,Opts), render_call(H,Opts).
847 render_call_stack([H|T],Nr,Opts) -->
848 render_nr(Nr,H,Nr1,Opts),
849 render_call(H,Opts),
850 render_seperator(Opts),
851 render_call_stack(T,Nr1,Opts).
852
853 % render nr of call in call stack
854 render_nr(Pos,H,Pos1,Opts) --> {member(detailed,Opts)},!, ['\n '], render_pos_nr(Pos,H,Pos1).
855 render_nr(Pos,_,Pos,_) --> [].
856
857 render_pos_nr(Pos,definition_call(_,_),Pos) --> !,
858 [' ']. % definition calls are virtual and can appear multiple times for different entries in the call stack
859 % see e.g., public_examples/B/FeatureChecks/DEFINITIONS/DefCallStackDisplay2.mch
860 render_pos_nr(Pos,_,Pos1) --> [Pos] , {Pos1 is Pos+1}, [': '].
861
862 render_seperator(Opts) --> {member(detailed,Opts)},!. % we put newlines in render_nr
863 render_seperator(_Opts) -->
864 {call_stack_arrow_atom_symbol(Symbol)}, [Symbol].
865
866 render_call(definition_call(Name,Pos),Opts) --> !,
867 ['within DEFINITION call '],[Name],
868 render_span(Pos,Opts).
869 render_call(operation_call(Op,Paras,Pos),Opts) --> !,
870 translate_b_operation_call(Op,Paras), % TODO: limit size?
871 render_span(Pos,Opts).
872 render_call(using_state(Name,State),_Opts) --> !,
873 [Name], [' with state: '],
874 {get_cs_limit(Limit),translate_bstate_limited(State,Limit,Str)},
875 [Str].
876 render_call(after_event(OpTerm),_Opts) --> !,
877 ['after event: '],
878 {get_cs_limit(Limit),translate_event_with_limit(OpTerm,Limit,Str)},
879 [Str].
880 render_call(function_call(Fun,Paras,Pos),Opts) --> !,
881 render_function_call(Fun,Paras),
882 render_span(Pos,Opts).
883 render_call(b_operator_call(OP,Paras,Pos),Opts) --> !,
884 render_operator_arg(b_operator(OP,Paras)),
885 render_span(Pos,Opts).
886 render_call(b_operator_arg_evaluation(OP,PosNr,Args,Pos),Opts) --> !,
887 ['arg '],[PosNr],[' of '],
888 render_operator_arg(b_operator(OP,Args)),
889 render_span(Pos,Opts).
890 render_call(external_call(Name,Paras,Pos),Opts) --> !,
891 ['external call '], [Name],['('],
892 {get_cs_limit(Limit),translate_bvalues_with_limit(Paras,Limit,PS)},[PS], [')'],
893 render_span(Pos,Opts).
894 render_call(prob_command_context(Name,Pos),Opts) --> !,
895 ['checking '], render_prob_command(Name),
896 render_span(Pos,Opts).
897 render_call(quantifier_call(comprehension_set,ParaNames,ParaValues,Pos),Opts) --> % special case for lambda
898 {nth1(LPos,ParaNames,LambdaRes,RestParaNames),
899 is_lambda_result_name(LambdaRes,_),
900 nth1(LPos,ParaValues,LambdaVal,RestParaValues)},!, % we have found '_lambda_res_' amongst paras
901 render_quantifier(lambda), ['('],
902 render_paras(RestParaNames,RestParaValues),
903 ['|'], render_para_val(LambdaVal),
904 [')'],
905 render_span(Pos,Opts).
906 render_call(quantifier_call(Kind,ParaNames,ParaValues,Pos),Opts) --> !,
907 render_quantifier(Kind), ['('],
908 render_paras(ParaNames,ParaValues), [')'],
909 render_span(Pos,Opts).
910 render_call(top_level_call(SpanPred),Opts) -->
911 render_call(SpanPred,Opts).
912 render_call(span_predicate(Pred,LS,S),Opts) --> % Pred can also be an expression like function/2
913 % infos could contain was(extended_expr(Op)); special case for: assertion_expression
914 {Pred=b(_,_,Pos),
915 b_compiler:b_compile(Pred,[],LS,S,CPred,no_wf_available) % inline actual parameters
916 },
917 !,
918 render_b_expr(CPred),
919 render_function_name(Pred), % try show function name from uncompiled Expr
920 render_span(Pos,Opts).
921 render_call(Other,_) --> [Other].
922
923 render_operator(OP) -->
924 {(unicode_translation(OP,Unicode) -> FOP=Unicode ; FOP=OP)},
925 [FOP].
926
927 % render b operator arguments/calls:
928 render_operator_arg(Var) --> {var(Var)},!,['_VARIABLE_']. % should not happen
929 render_operator_arg(b_operator(OP,[Arg1,Arg2])) -->
930 {binary_infix_in_mode(OP,Symbol,_,_)},!,
931 {(unicode_translation(OP,Unicode) -> FOP=Unicode ; FOP=Symbol)}, %TODO: add parentheses if necessary
932 render_operator_arg(Arg1),
933 [' '],[FOP], [' '],
934 render_operator_arg(Arg2).
935 render_operator_arg(b_operator(OP,Args)) --> !,
936 {(unicode_translation(OP,Unicode) -> FOP=Unicode ; function_like(OP,FOP) -> true ; FOP=OP)},
937 [FOP], ['('],
938 render_operator_args(Args),
939 [')'].
940 render_operator_arg(bind(Name,Value)) --> !,
941 [Name], ['='],
942 render_operator_arg(Value).
943 render_operator_arg(Val) --> render_para_val(Val).
944
945 render_operator_args([]) --> [].
946 render_operator_args([H]) --> !, render_operator_arg(H).
947 render_operator_args([H|T]) --> render_operator_arg(H), [','], render_operator_args(T).
948
949 render_prob_command(check_pred_command(PredKind,Arg)) --> !, ['predicate '], render_pred_nr(Arg), ['of '],[PredKind].
950 render_prob_command(eval_expr_command(Kind,Arg)) --> !, ['expression '], render_pred_nr(Arg), ['of '],[Kind].
951 render_prob_command(trace_replay(OpName,FromId)) --> !, ['Trace replay predicate for '],[OpName], [' from '],[FromId].
952 render_prob_command(Cmd) --> [Cmd].
953
954 render_pred_nr(0) --> !. % 0 is special value to indicate we have no number/id within outer kind
955 render_pred_nr(Nr) --> {number(Nr)},!,['# '],[Nr],[' '].
956 render_pred_nr('') --> !.
957 render_pred_nr(AtomId) --> ['for '], [AtomId],[' '].
958
959 render_function_name(b(function(Fun,_),_,_)) --> {try_get_identifier(Fun,FID)},!,
960 % TODO: other means of extracting name; maybe we should render anything that is not a value?
961 ['\n (Function applied: '], [FID], [')'].
962 render_function_name(b(_,_,Infos)) --> {member(was(extended_expr(OpID)),Infos)},!,
963 ['\n (Theory operator applied: '], [OpID], [')'].
964 render_function_name(_) --> [].
965
966 try_get_identifier(Expr,Id) :- (get_texpr_id(Expr,Id) -> true ; get_was_identifier(Expr,Id)).
967
968 render_span(Span,Opts) --> {member(detailed,Opts),translate_span(Span,Atom), Atom \= ''},!,
969 ['\n '], [Atom],
970 ({member(additional_descr,Opts),translate_additional_description(Span,Descr)}
971 -> [' within ',Descr]
972 ; []).
973 render_span(_,_) --> [].
974
975 render_function_call(Fun,Paras) -->
976 {(atomic(Fun) -> FS=Fun ; translate_bexpr_for_call_stack(Fun,FS))}, % memoization will only register atomic name
977 [FS],['('], render_para_val(Paras), [')'].
978
979 render_b_expr(b(function(Fun,Paras),_,_)) --> !, % ensure we print both function and paras at least partially
980 {translate_bexpr_for_call_stack(Fun,FS)}, [FS],['('],
981 {translate_bexpr_for_call_stack(Paras,PS)},[PS], [')'].
982 render_b_expr(b(assertion_expression(Pred,Msg,b(value(_),string,_)),_,_)) --> !,
983 % Body is not source of error; probably better to use special call stack entry for assertion_expression
984 ['ASSERT '],[Msg],['\n '],
985 {translate_bexpr_for_call_stack(Pred,PS)}, [PS].
986 render_b_expr(CPred) --> {translate_bexpr_for_call_stack(CPred,PS)}, [PS].
987
988 translate_bexpr_for_call_stack(Expr,TS) :-
989 get_cs_limit(Limit),
990 translate_bexpression_with_limit(Expr,Limit,TS).
991
992 get_cs_limit(2000) :- !.
993 get_cs_limit(Limit) :- debug_mode(on),!, debug_level(Level), % 19 regular, 5 very verbose
994 Limit is 1000 - Level*20.
995 get_cs_limit(200) :- get_preference(provide_trace_information,true),!.
996 get_cs_limit(100).
997
998 get_cs_avl_limit(40) :- debug_mode(on),!.
999 get_cs_avl_limit(6) :- get_preference(provide_trace_information,true),!.
1000 get_cs_avl_limit(4).
1001
1002 get_call_stack_span(operation_call(_,_,Pos),Pos).
1003 %get_call_stack_span(after_event(_),unknown).
1004 get_call_stack_span(function_call(_,_,Pos),Pos).
1005 get_call_stack_span(quantifier_call(_,_,_,Pos),Pos).
1006 get_call_stack_span(definition_call(_,Pos),Pos).
1007 get_call_stack_span(external_call(_,_,Pos),Pos).
1008 get_call_stack_span(prob_command_context(_,Pos),Pos).
1009 get_call_stack_span(top_level_call(Pos),Pos).
1010 get_call_stack_span(b_operator_call(_,_,Pos),Pos).
1011 get_call_stack_span(b_operator_arg_evaluation(_,_,_,Pos),Pos).
1012 get_call_stack_span(span_predicate(A,B,C),span_predicate(A,B,C)).
1013
1014 nop_call(top_level_call(X)) :- \+ is_top_level_function_call(X).
1015 % just there to insert virtual DEFINITION calls at top-level of call-stack
1016 is_top_level_function_call(span_predicate(b(Expr,_,_),_,_)) :-
1017 Expr = function(_,_),
1018 get_preference(provide_trace_information,false).
1019 % otherwise we push function_calls onto the stack; see opt_push_wait_flag_call_stack_info
1020
1021 % expand the call stack by creating entries for the definition calls
1022 split_calls([],[]).
1023 split_calls([Call|T],NewCalls) :- nop_call(Call),!, %print(nop(Call)),nl,
1024 split_calls(T,NewCalls).
1025 split_calls([Call|T],NewCalls) :-
1026 get_call_stack_span(Call,Span),!,
1027 NewCalls = [Call|New2],
1028 extract_def_calls(Span,New2,ST),
1029 split_calls(T,ST).
1030 split_calls([Call|T],[Call|ST]) :-
1031 split_calls(T,ST).
1032
1033 extract_def_calls(Span) -->
1034 {extract_pos_context(Span,MainPos,Context,CtxtPos)},
1035 {Context = definition_call(Name)},
1036 !,
1037 extract_def_calls(MainPos),
1038 [definition_call(Name,CtxtPos)],
1039 extract_def_calls(CtxtPos). % do we need this??
1040 extract_def_calls(_) --> [].
1041
1042 % a shorter version of extract_additional_description only accepting definition_calls
1043 translate_additional_description(Span,Desc) :-
1044 extract_pos_context(Span,MainPos,Context,CtxtPos),
1045 translate_span(CtxtPos,CtxtAtom),
1046 extract_def_context_msg(Context,OuterCMsg),
1047 (translate_additional_description(MainPos,InnerCMsg)
1048 -> ajoin([InnerCMsg,' within ',OuterCMsg, ' ', CtxtAtom],Desc)
1049 ; ajoin([OuterCMsg, ' ', CtxtAtom],Desc)
1050 ).
1051
1052 % try and get an immediate definition call context for a position
1053 get_definition_context_from_span(Span,DefCtxtMsg) :-
1054 extract_pos_context(Span,_MainPos,Context,_CtxtPos),
1055 extract_def_context_msg(Context,DefCtxtMsg).
1056
1057 extract_def_context_msg(definition_call(Name),Msg) :- !, % static Definition macro expansion call stack
1058 ajoin(['DEFINITION call of ',Name],Msg).
1059
1060 render_paras([],[]) --> !, [].
1061 render_paras([],_Vals) --> ['...?...']. % should not happen
1062 render_paras([Name],[Val]) --> !, render_para_name(Name), ['='], render_para_val(Val).
1063 render_paras([Name|TN],[Val|TV]) --> !,
1064 render_para_name(Name), ['='], render_para_val(Val), [','],
1065 render_paras(TN,TV).
1066 render_paras([N|Names],[]) --> !, render_para_name(N), render_paras(Names,[]). % value list can be empty
1067
1068 render_para_val(Val) --> {get_cs_limit(Limit),translate_bvalue_with_limit(Val,Limit,VS)}, [VS].
1069
1070 % accept typed and atomic ids
1071 render_para_name(b(identifier(ID),_,_)) --> !, {translated_identifier(ID,TID)},[TID].
1072 render_para_name(ID) --> {translated_identifier(ID,TID)},[TID].
1073
1074 render_quantifier(lambda) --> !, {unicode_translation(lambda,Symbol)},[Symbol]. % ['{|}'].
1075 render_quantifier(comprehension_set) --> !, ['{|}'].
1076 render_quantifier(comprehension_set(NegationContext)) --> !,
1077 render_negation_context(NegationContext), [' {|}'].
1078 render_quantifier(exists) --> !, {unicode_translation(exists,Symbol)},[Symbol].
1079 render_quantifier(let_quantifier) --> !, ['LET'].
1080 render_quantifier(optimize) --> !, ['#optimize'].
1081 render_quantifier(forall) --> !, {unicode_translation(forall,Symbol)},[Symbol].
1082 render_quantifier(not(Q)) --> !, {unicode_translation(negation,Symbol)}, % not(exists)
1083 [Symbol, '('], render_quantifier(Q), [')'].
1084 render_quantifier(Q) --> !, [Q].
1085
1086 render_negation_context(positive) --> !, ['one solution'].
1087 render_negation_context(negative) --> !, ['no solution'].
1088 render_negation_context(all_solutions) --> !,['all solutions'].
1089 render_negation_context(C) --> [C].
1090
1091 call_stack_arrow_atom_symbol(' \x2192\ '). % see total function
1092 %call_stack_arrow_atom_symbol('\x27FF\ '). % long rightwards squiggle arrow
1093
1094 % -----------------
1095
1096
1097 is_init('$initialise_machine').
1098 is_init('$setup_constants').
1099
1100 translate_bvalues_with_types(Values,Types,Output) :-
1101 %set_up_limit_reached(Codes,1000,LimitReached),
1102 pp_value_l_with_types(Values,',',Types,_LimitReached,Codes,[]),!,
1103 atom_codes_with_limit(Output,Codes).
1104 translate_bvalues_with_types(Values,T,Output) :-
1105 add_internal_error('Call failed: ',translate_bvalues_with_types(Values,T,Output)),
1106 translate_bvalues(Values,Output).
1107
1108 pp_value_l_with_types([],_Sep,[],_) --> !.
1109 pp_value_l_with_types([Expr|Rest],Sep,[TE|TT],LimitReached) -->
1110 ( {nonvar(Rest),Rest=[]} ->
1111 pp_value_with_type(Expr,TE,LimitReached)
1112 ;
1113 pp_value_with_type(Expr,TE,LimitReached),ppatom(Sep),
1114 pp_value_l_with_types(Rest,Sep,TT,LimitReached)).
1115
1116
1117 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1118
1119 % pretty-print properties
1120 translate_properties_with_limit([],[]).
1121 translate_properties_with_limit([P|Prest],[Out|Orest]) :-
1122 translate_property_with_limit(P,320,Out), % reduced limit as we now have evaluation view + possibility to inspect all of value
1123 translate_properties_with_limit(Prest,Orest).
1124
1125 translate_property_with_limit(Prop,Limit,Output) :-
1126 (pp_property(Prop,Limit,Output) -> true ; (add_error(translate_property,'Could not translate property: ',Prop),Output='???')).
1127 pp_property(Prop,Limit,Output) :-
1128 pp_property_without_plugin(Prop,Limit,Output).
1129 pp_property_without_plugin(=(Key,Value),_,A) :-
1130 !,ajoin([Key,' = ',Value],A).
1131 pp_property_without_plugin(':'(Key,Value),_,A) :-
1132 !,ajoin([Key,' : ',Value],A).
1133 pp_property_without_plugin(info(I),_,I) :- !.
1134 pp_property_without_plugin(Prop,Limit,A) :-
1135 write_to_codes(Prop,Codes),
1136 atom_codes_with_limit(A,Limit,Codes).
1137
1138
1139 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1140 :- use_module(tools_meta,[translate_term_into_atom_with_max_depth/3]).
1141
1142 % pretty-print errors belonging to a certain state
1143 translate_error_term(Term,S) :- translate_error_term(Term,unknown,S).
1144 translate_error_term(Var,_,S) :- var(Var),!,
1145 translate_term_into_atom_with_max_depth(Var,5,S).
1146 translate_error_term('@fun'(X,F),Span,S) :-
1147 translate_bvalue(X,TX),
1148 (get_function_from_span(Span,Fun,LocState,State),
1149 translate_bexpression_with_limit(Fun,200,TSF)
1150 -> % we managed to extract the function from the span_predicate
1151 (is_compiled_value(Fun)
1152 -> (get_was_identifier(Fun,WasFunId) -> Rest = [', function: ',WasFunId | Rest1]
1153 ; Rest = Rest1
1154 ),
1155 TVal=TSF % use as value
1156 ; Rest = [', function: ',TSF | Rest1],
1157 % try and extract value from span_predicate (often F=[] after traversing avl)
1158 (get_texpr_id(Fun,FID),
1159 (member(bind(FID,FVal),LocState) ; member(bind(FID,FVal),State))
1160 -> translate_bvalue(FVal,TVal)
1161 ; translate_bvalue(F,TVal)
1162 )
1163 )
1164 ; Rest=[], translate_bvalue(F,TVal)
1165 ),!,
1166 % translate_term_into_atom_with_max_depth('@fun'(TX,TVal),5,S).
1167 (get_error_span_for_value(F,NewSpanTxt) % triggers in test 953
1168 -> Rest1 = [' defined at ',NewSpanTxt]
1169 ; Rest1 = []
1170 ),
1171 ajoin(['Function argument: ',TX, ', function value: ',TVal | Rest],S).
1172 translate_error_term('@rel'(Arg,Res1,Res2),_,S) :-
1173 translate_bvalue(Arg,TA), translate_bvalue(Res1,R1),
1174 translate_bvalue(Res2,R2),!,
1175 ajoin(['Function argument: ',TA, ', two possible values: ',R1,', ',R2],S).
1176 translate_error_term([operation(Name,Env)],_,S) :-
1177 translate_any_state(Env,TEnv), !,
1178 translate_term_into_atom_with_max_depth(operation(Name,TEnv),10,S).
1179 translate_error_term(error(E1,E2),_,S) :- !, translate_prolog_error(E1,E2,S).
1180 translate_error_term(b(B,T,I),_,S) :-
1181 translate_subst_or_bexpr_with_limit(b(B,T,I),1000,do_not_report_errors,S),!. % do not report errors, otherwise we end in an infinite loop of adding errors while adding errors
1182 translate_error_term([H|T],_,S) :- nonvar(H), H=b(_,_,_), % typically a list of typed ids
1183 E=b(sequence_extension([H|T]),any,[]),
1184 translate_subst_or_bexpr_with_limit(E,1000,do_not_report_errors,S),!.
1185 translate_error_term(Term,_,S) :-
1186 is_bvalue(Term),
1187 translate_bvalue_with_limit(Term,1000,S),!.
1188 translate_error_term(T,_,S) :-
1189 (debug_mode(on) -> Depth = 20 ; Depth = 5),
1190 translate_term_into_atom_with_max_depth(T,Depth,S).
1191
1192 get_function_from_span(Var,Fun,_,_) :- var(Var), !,
1193 add_internal_error('Variable span:',get_function_from_span(Var,Fun)),fail.
1194 get_function_from_span(pos_context(Span,_,_),Fun,LS,S) :- get_function_from_span(Span,Fun,LS,S).
1195 get_function_from_span(span_predicate(b(function(Function,_Arg),_T,_I),LocalState,State),Function,LocalState,State).
1196
1197 is_compiled_value(b(value(_),_,_)).
1198
1199 get_was_identifier(b(_,_,Info),Id) :- member(was_identifier(Id),Info). % added e.g. by b_compiler
1200
1201 % TODO: complete this
1202 % for recognising B values as error terms and automatically translating them
1203 is_bvalue(V) :- var(V),!,fail.
1204 is_bvalue([]).
1205 is_bvalue(closure(_,_,_)).
1206 is_bvalue(fd(_,_)).
1207 is_bvalue(freetype(_)).
1208 is_bvalue(freeval(_,_,_)).
1209 is_bvalue(avl_set(_)).
1210 is_bvalue(int(_)).
1211 is_bvalue(global_set(_)).
1212 is_bvalue(pred_true).
1213 is_bvalue(pred_false).
1214 is_bvalue(string(_)).
1215 is_bvalue(term(_)). % typically term(floating(_))
1216 is_bvalue(rec(Fields)) :- nonvar(Fields), Fields=[F1|_], nonvar(F1),
1217 F1=field(_,V1), is_bvalue(V1).
1218 is_bvalue((A,B)) :-
1219 (nonvar(A) -> is_bvalue(A) ; true),
1220 (nonvar(B) -> is_bvalue(B) ; true).
1221
1222 % try and get error location for span:
1223 get_error_span_for_value(Var,_) :- var(Var),!,fail.
1224 get_error_span_for_value(closure(_,_,Body),Span) :- translate_span_with_filename(Body,Span), Span \= ''.
1225
1226
1227 % translate something that was caught with catch/3
1228 translate_prolog_exception(user_interrupt_signal,R) :- !, R='User-Interrupt (CTRL-C)'.
1229 translate_prolog_exception(enumeration_warning(_,_,_,_,_),R) :- !, R='Enumeration Warning'.
1230 translate_prolog_exception(error(E1,E2),S) :- !, translate_prolog_error(E1,E2,S).
1231 translate_prolog_exception(E1,S) :- translate_term_into_atom_with_max_depth(E1,8,S).
1232
1233 % translate a Prolog error(E1,E2) exception
1234 translate_prolog_error(existence_error(procedure,Pred),_,S) :- !,
1235 translate_term_into_atom_with_max_depth('Unknown Prolog predicate:'(Pred),8,S).
1236 translate_prolog_error(existence_error(source_sink,File),_,S) :- !,
1237 translate_term_into_atom_with_max_depth('File does not exist:'(File),8,S).
1238 translate_prolog_error(permission_error(Action,source_sink,File),_,S) :- !, % Action = open, ...
1239 ajoin(['Permission denied to ',Action,' the file: ',File],S).
1240 translate_prolog_error(system_error,system_error('SPIO_E_NET_CONNRESET'),S) :- !,
1241 S = 'System error: connection to process lost (SPIO_E_NET_CONNRESET)'.
1242 translate_prolog_error(system_error,system_error('SPIO_E_ENCODING_UNMAPPABLE'),S) :- !,
1243 S = 'System error: illegal character or encoding encountered (SPIO_E_ENCODING_UNMAPPABLE)'.
1244 translate_prolog_error(system_error,system_error('SPIO_E_NET_HOST_NOT_FOUND'),S) :- !,
1245 S = 'System error: could not find host (SPIO_E_NET_HOST_NOT_FOUND)'.
1246 translate_prolog_error(system_error,system_error('SPIO_E_CHARSET_NOT_FOUND'),S) :- !,
1247 S = 'System error: could not find character set encoding'.
1248 translate_prolog_error(system_error,system_error('SPIO_E_OS_ERROR'),S) :- !,
1249 S = 'System error due to some OS/system call (SPIO_E_OS_ERROR)'.
1250 translate_prolog_error(system_error,system_error('SPIO_E_END_OF_FILE'),S) :- !,
1251 S = 'System error: end of file (SPIO_E_END_OF_FILE)'.
1252 translate_prolog_error(system_error,system_error('SPIO_E_TOO_MANY_OPEN_FILES'),S) :- !,
1253 S = 'System error: too many open files (SPIO_E_TOO_MANY_OPEN_FILES)'.
1254 translate_prolog_error(system_error,system_error(dlopen(Msg)),S) :- !,
1255 translate_term_into_atom_with_max_depth(Msg,4,MS),
1256 ajoin(['System error: could not load dynamic library (you may have to right-click on the library and open it in the macOS Finder): ', MS],S).
1257 translate_prolog_error(system_error,system_error(Err),S) :- !,
1258 % or Err is an atom dlopen( mach-o file, but is an incompatible architecture ...)
1259 % E.g., SPIO_E_NOT_SUPPORTED when doing open('/usr',r,S)
1260 translate_term_into_atom_with_max_depth('System error:'(Err),8,S).
1261 translate_prolog_error(existence_error(procedure,Module:Pred/Arity),_,S) :- !,
1262 ajoin(['Prolog predicate does not exist: ',Module,':', Pred, '/',Arity],S).
1263 translate_prolog_error(instantiation_error,instantiation_error(Call,_ArgNo),S) :- !,
1264 translate_term_into_atom_with_max_depth('Prolog instantiation error:'(Call),8,S).
1265 translate_prolog_error(uninstantiation_error(_),uninstantiation_error(Call,_ArgNo,_Culprit),S) :- !,
1266 translate_term_into_atom_with_max_depth('Prolog uninstantiation error:'(Call),8,S).
1267 translate_prolog_error(evaluation_error(zero_divisor),evaluation_error(Call,_,_,_),S) :- !,
1268 translate_term_into_atom_with_max_depth('Division by zero error:'(Call),8,S).
1269 translate_prolog_error(evaluation_error(float_overflow),evaluation_error(Call,_,_,_),S) :- !,
1270 translate_term_into_atom_with_max_depth('Float overflow:'(Call),8,S).
1271 translate_prolog_error(representation_error(Err),representation_error(Call,_,_),S) :-
1272 memberchk(Err, ['CLPFD integer overflow','max_clpfd_integer','min_clpfd_integer']),!,
1273 translate_term_into_atom_with_max_depth('Prolog CLP(FD) overflow:'(Call),8,S).
1274 translate_prolog_error(syntax_error(Err),_,S) :- !,
1275 translate_term_into_atom_with_max_depth('Prolog syntax error:'(Err),8,S).
1276 :- if(predicate_property(message_to_string(_, _), _)).
1277 translate_prolog_error(E1,E2,S) :-
1278 % SWI-Prolog way to translate an arbitrary message term (such as an exception) to a string,
1279 % the same way that the built-in message handling system would print it.
1280 message_to_string(error(E1,E2), String),
1281 !,
1282 atom_string(S, String).
1283 :- endif.
1284 translate_prolog_error(E1,_,S) :- translate_term_into_atom_with_max_depth(E1,8,S).
1285 % we also have permission_error, context_error, domain_error
1286
1287 translate_state_errors([],[]).
1288 translate_state_errors([E|ERest],[Out|ORest]) :-
1289 ( E = eventerror(Event,EError,_) ->
1290 translate_event_error(EError,Msg),
1291 ajoin([Event,': ',Msg],Out)
1292 ; translate_state_error(E,Out) -> true
1293 ; functor(E,Out,_) ),
1294 translate_state_errors(ERest,ORest).
1295
1296 translate_error_context(E,TE) :- translate_error_context2(E,Codes,[]),
1297 atom_codes_with_limit(TE,Codes).
1298 translate_error_context2(span_context(Span,Context)) --> !,
1299 translate_error_context2(Context),
1300 translate_span(Span,only_subsidiary).
1301 translate_error_context2([H]) --> !,translate_error_context2(H).
1302 translate_error_context2(checking_invariant) --> !,
1303 {get_specification_description_codes(invariant,A)}, A. %"INVARIANT".
1304 translate_error_context2(checking_assertions) --> !,
1305 {get_specification_description_codes(assertions,A)}, A. %"ASSERTIONS".
1306 translate_error_context2(checking_negation_of_invariant(_State)) --> !,
1307 "not(INVARIANT)".
1308 translate_error_context2(operation(OpName,_State)) --> !,
1309 {translate_operation_name(OpName,TOp)},
1310 ppterm(TOp).
1311 translate_error_context2(checking_context(Check,Name)) --> !,
1312 ppterm(Check),ppterm(Name).
1313 translate_error_context2(loading_context(_Name)) --> !.
1314 translate_error_context2(visb_error_context(Class,SvgId,OpNameOrAttr,Span)) --> !,
1315 "VisB ", ppterm(Class), " for SVG ID ",
1316 ppterm(SvgId), " and attribute/event ",
1317 {translate_operation_name(OpNameOrAttr,TOp)},
1318 ppterm(TOp),
1319 translate_span(Span,only_subsidiary).
1320 translate_error_context2(X) --> "???:", ppterm(X).
1321
1322 print_span(Span) :- translate_span(Span,Atom), !, print(Atom).
1323 print_span(S) :- print(span(S)).
1324
1325 print_span_nl(Span) :- translate_span(Span,Atom), !,(Atom='' -> true ; print(Atom)),nl.
1326 print_span_nl(S) :- print(span(S)),nl.
1327
1328
1329 translate_span(Span,Atom) :- translate_span(Span,only_subsidiary,Codes,[]),
1330 atom_codes_with_limit(Atom,Codes).
1331 translate_span_with_filename(Span,Atom) :-
1332 translate_span(Span,always_print_filename,Codes,[]),
1333 atom_codes_with_limit(Atom,Codes).
1334
1335 translate_span(Span,_) --> {var(Span)},!, {add_internal_error('Variable span:',translate_span(Span,_))}, "_".
1336 translate_span(Span,PrintFileNames) --> {extract_line_col(Span,Srow,Scol,_Erow,_Ecol)},!,
1337 "(Line:",ppterm(Srow)," Col:",ppterm(Scol),
1338 %"-",ppterm(Erow),":",ppterm(Ecol),
1339 translate_span_file_opt(Span,PrintFileNames),
1340 % TO DO: print short version of extract_additional_description ?
1341 ")".
1342 translate_span(Span,_PrintFileNames) --> {extract_symbolic_label(Span,Label)},!, "(label @",ppterm(Label),")".
1343 translate_span(Span,PrintFileNames) -->
1344 % for Event-B, e.g., line-col fails but we can get a section/file name
1345 "(File:",translate_span_file(Span,PrintFileNames),!,")".
1346 translate_span(_,_PrintFileNames) --> "".
1347
1348 translate_span_file(Span,always_print_filename) -->
1349 {extract_tail_file_name(Span,Filename)},!,
1350 %{bmachine:b_get_main_filenumber(MainFN), Nr \= MainFN},!,
1351 " File:", ppterm(Filename).
1352 translate_span_file(Span,_) -->
1353 {extract_subsidiary_tail_file_name(Span,Filename)},
1354 %{bmachine:b_get_main_filenumber(MainFN), Nr \= MainFN},!,
1355 !,
1356 " File:", ppterm(Filename).
1357 translate_span_file_opt(Span,Print) --> translate_span_file(Span,Print),!.
1358 translate_span_file_opt(_,_) --> "".
1359
1360
1361 explain_span_file(Span) -->
1362 {extract_subsidiary_tail_file_name(Span,Filename)},
1363 %{bmachine:b_get_main_filenumber(MainFN), Nr \= MainFN},!,
1364 "\n### File: ", ppterm(Filename).
1365 explain_span_file(_) --> "".
1366
1367 explain_span(V) --> {var(V)},!, "Internal error: Illegal variable span".
1368 explain_span(span_predicate(Pred,LS,S)) --> !, explain_span2(span_predicate(Pred,LS,S)),
1369 explain_local_state(LS). %, explain_global_state(S).
1370 explain_span(Span) --> explain_span2(Span).
1371 explain_span2(Span) --> {extract_line_col(Span,Srow,Scol,Erow,Ecol)},!,
1372 "\n### Line: ", ppterm(Srow), ", Column: ", ppterm(Scol),
1373 " until Line: ", ppterm(Erow), ", Column: ", ppterm(Ecol),
1374 explain_span_file(Span),
1375 explain_span_context(Span).
1376 explain_span2(Span) --> {extract_symbolic_label_pos(Span,Msg)},!,
1377 "\n @label: ", ppterm(Msg),
1378 explain_span_context(Span).
1379 explain_span2(Span) --> explain_span_context(Span).
1380
1381 explain_span_context(Span) --> {extract_additional_description(Span,Msg),!},
1382 "\n### within ", ppterm(Msg). % context of span, such as definition call hierarchy
1383 explain_span_context(_) --> "".
1384
1385 explain_local_state([]) --> !, "".
1386 explain_local_state(LS) --> "\n Local State: ", pp_b_state(LS).
1387 %explain_global_state([]) --> !, "".
1388 %explain_global_state(LS) --> "\n Global State: ", pp_b_state(LS).
1389
1390 translate_event_error(Error,Out) :-
1391 ( translate_event_error2(Error,Out) -> true
1392 ;
1393 functor(Error,F,_),
1394 ajoin(['** Unable to translate event error: ',F,' **'],Out)).
1395 translate_event_error2(no_witness_found(Type,Var,_Predicate),Out) :-
1396 def_get_texpr_id(Var,Id),
1397 ajoin(['no witness was found for ',Type,' ',Id],Out).
1398 translate_event_error2(simulation_error(_Events),Out) :-
1399 Out = 'no matching abstract event was found'.
1400 translate_event_error2(action_not_executable(_Action,WDErr),Out) :-
1401 (WDErr=wd_error_possible -> Out = 'action was not executable (maybe with WD error)'
1402 ; Out = 'action was not executable').
1403 translate_event_error2(invalid_modification(Var,_Pre,_Post),Out) :-
1404 def_get_texpr_id(Var,Id),
1405 ajoin(['modification of variable ', Id, ' not allowed'],Out).
1406 translate_event_error2(variant_negative(_CType,_Variant,_Value),Out) :-
1407 Out = 'enabled for negative variant'.
1408 translate_event_error2(invalid_variant(anticipated,_Expr,_Pre,_Post),Out) :-
1409 Out = 'variant increased'.
1410 translate_event_error2(invalid_variant(convergent,_Expr,_Pre,_Post),Out) :-
1411 Out = 'variant not decreased'.
1412 translate_event_error2(invalid_theorem_in_guard(_Theorem),Out) :-
1413 Out = 'theorem in guard evaluates to false'.
1414 translate_event_error2(event_wd_error(_TExpr,Source),Out) :-
1415 ajoin(['WD error for ',Source],Out).
1416 translate_event_error2(event_other_error(Msg),Out) :- Out=Msg.
1417
1418 translate_state_error(abort_error(_TYPE,Msg,ErrTerm,ErrorContext),Out) :- !,
1419 translate_error_term(ErrTerm,ES),
1420 translate_error_context(ErrorContext,EC),
1421 ajoin([EC,': ',Msg,': ',ES],Out).
1422 translate_state_error(clpfd_overflow_error(Context),Out) :- !, % 'CLPFD_integer_overflow'
1423 ajoin(['CLPFD integer overflow while ', Context],Out).
1424 translate_state_error(max_state_errors_reached(Nr),Out) :- !,
1425 ajoin(['Max. number of state errors reached: ', Nr],Out).
1426 translate_state_error(Unknown,Out) :-
1427 add_error(translate_state_error,'Unknown state error: ',Unknown),
1428 Out = '*** Unknown State Error ***'.
1429
1430
1431 get_span_from_context([H],Span) :- !, get_span_from_context(H,Span).
1432 get_span_from_context(span_context(Span,_),Res) :- !, Res=Span.
1433 get_span_from_context(_,unknown).
1434
1435 explain_error_context1([H]) --> !,explain_error_context1(H).
1436 explain_error_context1(span_context(Span,Context)) --> !,
1437 explain_span(Span),"\n",
1438 explain_error_context2(Context).
1439 explain_error_context1(Ctxt) --> explain_error_context2(Ctxt).
1440
1441 explain_error_context2([H]) --> !,explain_error_context2(H).
1442 explain_error_context2(span_context(Span,Context)) --> !,
1443 explain_span(Span),"\n",
1444 explain_error_context2(Context).
1445 explain_error_context2(checking_invariant) --> !,
1446 {get_specification_description_codes(invariant,I)}, I, ":\n ", %"INVARIANT:\n ",
1447 pp_current_state. % assumes explain is called in the right state ! ; otherwise we need to store the state id
1448 explain_error_context2(checking_assertions) --> !,
1449 {get_specification_description_codes(assertions,A)}, A, ":\n ", %"ASSERTIONS:\n ",
1450 pp_current_state. % assumes explain is called in the right state ! ; otherwise we need to store the state id
1451 explain_error_context2(checking_negation_of_invariant(State)) --> !,
1452 "not(INVARIANT):\n State: ",
1453 pp_b_state(State).
1454 explain_error_context2(operation('$setup_constants',StateID)) --> !,
1455 {get_specification_description_codes(properties,P)}, P, ":\n State: ",
1456 pp_context_state(StateID).
1457 explain_error_context2(operation(OpName,StateID)) --> !,
1458 {get_specification_description_codes(operation,OP)}, OP, ": ", %"EVENT/OPERATION: ",
1459 {translate_operation_name(OpName,TOp)},
1460 ppterm(TOp), "\n ",
1461 pp_context_state(StateID).
1462 explain_error_context2(checking_context(Check,Name)) --> !,
1463 ppterm(Check),ppterm(Name), "\n ".
1464 explain_error_context2(loading_context(Name)) --> !,
1465 "Loading: ",ppterm(Name), "\n ".
1466 explain_error_context2(visb_error_context(Class,SvgId,OpNameOrAttr,Span)) --> !,
1467 translate_error_context2(visb_error_context(Class,SvgId,OpNameOrAttr,Span)).
1468 explain_error_context2(X) --> "UNKNOWN ERROR CONTEXT:\n ", ppterm(X).
1469
1470 :- use_module(specfile,[get_specification_description/2]).
1471 get_specification_description_codes(Tag,Codes) :- get_specification_description(Tag,Atom), atom_codes(Atom,Codes).
1472
1473 explain_state_error(Error,Span,Out) :-
1474 explain_state_error2(Error,Span,Out,[]),!.
1475 explain_state_error(_Error,unknown,"Sorry, the detailed output failed.\n").
1476
1477 explain_abort_error_type(well_definedness_error) --> !, "An expression was not well-defined.\n".
1478 explain_abort_error_type(while_variant_error) --> !, "A while-loop VARIANT error occurred.\n".
1479 explain_abort_error_type(while_invariant_violation) --> !, "A while-loop INVARIANT error occurred.\n".
1480 explain_abort_error_type(precondition_error) --> !, "A precondition (PRE) error occurred.\n".
1481 explain_abort_error_type(assert_error) --> !, "An ASSERT error occurred.\n".
1482 explain_abort_error_type(Type) --> "Error occurred: ", ppterm(Type), "\n".
1483
1484 explain_state_error2(abort_error(TYPE,Msg,ErrTerm,ErrContext),Span) -->
1485 explain_abort_error_type(TYPE),
1486 "Reason: ", ppterm(Msg), "\n",
1487 {get_span_from_context(ErrContext,Span)},
1488 ({ErrTerm=''} -> ""
1489 ; "Details: ", {translate_error_term(ErrTerm,Span,ErrS)},ppterm(ErrS), "\n"
1490 ),
1491 "Context: ", explain_error_context1(ErrContext).
1492 explain_state_error2(max_state_errors_reached(Nr),unknown) -->
1493 "Too many error occurred for this state.\n",
1494 "Not all errors are shown.\n",
1495 "Number of errors is at least: ", ppterm(Nr).
1496 explain_state_error2(eventerror(_Event,Error,Trace),Span) --> % TO DO: also extract loc info ?
1497 {translate_event_error(Error,Msg)},
1498 ppatom(Msg),
1499 "\nA detailed trace containing the error:\n",
1500 "--------------------------------------\n",
1501 explain_event_trace(Trace,Span).
1502 explain_state_error2(clpfd_overflow_error(Context),unknown) --> % CLPFD_integer_overflow
1503 "An overflow occurred inside the CLP(FD) library.\n",
1504 "Context: ", ppterm(Context), "\n",
1505 "You may try and set the CLPFD preference to FALSE.\n".
1506
1507 % try and get span from state error:
1508 get_state_error_span(abort_error(_,_,_,Context),Span) :- get_span_context_span(Context,Span).
1509
1510 get_span_context_span(span_context(Span,_),Span).
1511 get_span_context_span([H],Span) :- get_span_context_span(H,Span).
1512
1513
1514
1515 show_parameter_values([],[]) --> !.
1516 show_parameter_values([P|Prest],[V|Vrest]) -->
1517 show_parameter_value(P,V),
1518 show_parameter_values(Prest,Vrest).
1519 show_parameter_value(P,V) -->
1520 " ",pp_expr(P,_,_LR)," = ",pp_value(V),"\n".
1521
1522 % translate an Event-B error trace (error occurred during multi-level animation)
1523 % into a textual description (Codes) and a span_predicate term which can be visualised
1524 explain_event_trace(Trace,Codes,Span) :-
1525 explain_event_trace(Trace,Span,Codes,[]).
1526
1527 explain_event_trace(Trace,span_predicate(SpanPred,[],[])) -->
1528 % evaluating the span predicate will require access to current state, which needs to be added later
1529 explain_event_trace4(Trace,'?','?',SpanPred).
1530
1531 explain_event_trace4([],_,_,b(truth,pred,[])) --> !.
1532 explain_event_trace4([event(Name,Section)|Trest],_,_,SpanPred) --> !,
1533 "\n",
1534 "Event ",ppterm(Name)," in model ",ppterm(Section),
1535 ":\n",
1536 % pass new current event name and section for processing tail:
1537 explain_event_trace4(Trest,Name,Section,SpanPred).
1538 explain_event_trace4([Step|Trest],Name,Section,SpanPred) -->
1539 "\n",
1540 ( explain_event_step4(Step,StepPred) -> ""
1541 ; {functor(Step,F,_)} ->
1542 " (no rule to explain event step ",ppatom(F),")\n"),
1543 explain_event_trace4(Trest,Name,Section,RestSpanPred),
1544 {combine_span_pred(StepPred,RestSpanPred,Name,Section,SpanPred)}.
1545
1546 % create a span predicate from the event error trace to display relevant values and predicates
1547 combine_span_pred(unknown,S,_,_,Res) :- !, Res=S.
1548 combine_span_pred(new_scope(Kind,Paras,Vals,P1),P2,Name,Section,Res) :- !,
1549 maplist(create_tvalue,Paras,Vals,TVals),
1550 add_span_label(Kind,Name,Section,P1,P1L),
1551 conjunct_predicates([P1L,P2],Body),
1552 (Paras=[] -> Res=Body ; Res = b(let_predicate(Paras,TVals,Body),pred,[])). % translate:print_bexpr(Res),nl.
1553 % we could also do: add_texpr_description
1554 combine_span_pred(P1,P2,_,_,Res) :-
1555 conjunct_predicates([P1,P2],Res).
1556
1557 add_span_label(Kind,Name,Section,Pred,NewPred) :-
1558 (Kind=[Label] -> true % already has position info
1559 ; create_label(Kind,Name,Section,Label)),
1560 add_labels_to_texpr(Pred,[Label],NewPred).
1561 create_label(Kind,Name,Section,Label) :- ajoin([Kind,' in ',Section,':',Name],Label).
1562
1563 create_tvalue(b(_,Type,_),Value,b(value(Value),Type,[])).
1564
1565 explain_event_step4(true_guard(Parameters,Values,Guard),new_scope('guard true',Parameters,Values,Guard)) --> !,
1566 ( {Parameters==[]} -> ""
1567 ; " for the parameters:\n",
1568 show_parameter_values(Parameters,Values)),
1569 " the guard is true:",
1570 explain_predicate(Guard,4),"\n".
1571 explain_event_step4(eval_witness(Type,Id,Value,Predicate),new_scope('witness',[Id],[Value],Predicate)) -->
1572 witness_intro(Id,Predicate,Type),
1573 " found witness:\n",
1574 " ", pp_expr(Id,_,_LR), " = ", pp_value(Value), "\n".
1575 explain_event_step4(simulation_error(Errors),SpanPred) -->
1576 " no guard of a refined event was satisfiable:\n",
1577 explain_simulation_errors(Errors,Guards),
1578 {disjunct_predicates(Guards,SpanPred)}.
1579 explain_event_step4(invalid_theorem_in_guard(Theorem),new_scope('false theorem',[],[],Theorem)) -->
1580 " the following theorem evaluates to false:",
1581 explain_predicate(Theorem,4),"\n".
1582 explain_event_step4(invalid_modification(Var,Pre,Post),
1583 new_scope('invalid modification',[Var],[Post],b(falsity,pred,[]))) -->
1584 " the variable ", pp_expr(Var,_,_LR), " has been modified.\n",
1585 " The event is not allowed to modify the variable because its abstract event does not modify it.\n",
1586 " Old value: ", pp_value(Pre), "\n",
1587 " New value: ", pp_value(Post), "\n".
1588 explain_event_step4(action_not_executable(TAction,WDErr),new_scope('action not executable',[],[],Equalities)) -->
1589 {exctract_span_pred_from_subst(TAction,Equalities)},
1590 explain_action_not_executable(TAction,WDErr).
1591 explain_event_step4(Step,unknown) -->
1592 explain_event_step(Step).
1593 % TODO: add span predicates for the errors below:
1594
1595 extract_equality(Infos,TID,NewExpr,b(equal(TID,NewExpr),pred,Infos)). % TODO: introduce TID' primed?
1596 exctract_span_pred_from_subst(b(assign(TIDs,Exprs),subst,Infos),SpanPred) :-
1597 maplist(extract_equality(Infos),TIDs,Exprs,List),
1598 conjunct_predicates(List,SpanPred).
1599 % todo: becomes_such, ...
1600
1601 explain_event_step(variant_checked_pre(CType,Variant,Value)) -->
1602 " ",ppatom(CType)," event: checking if the variant is non-negative:\n",
1603 " variant: ",pp_expr(Variant,_,_LR),"\n",
1604 " its value: ",pp_value(Value),"\n".
1605 explain_event_step(variant_negative(CType,Variant,Value)) -->
1606 explain_event_step(variant_checked_pre(CType,Variant,Value)),
1607 " ERROR: variant is negative\n".
1608 explain_event_step(variant_checked_post(CType,Variant,EntryValue,ExitValue)) -->
1609 " ",ppatom(CType)," event: checking if the variant is ",
1610 ( {CType==convergent} -> "decreased:\n" ; "not increased:\n"),
1611 " variant: ", pp_expr(Variant,_,_LR), "\n",
1612 " its value before: ", pp_value(EntryValue),"\n",
1613 " its value after: ", pp_value(ExitValue),"\n".
1614 explain_event_step(invalid_variant(CType,Variant,EntryValue,ExitValue)) -->
1615 explain_event_step(variant_checked_post(CType,Variant,EntryValue,ExitValue)),
1616 " ERROR: variant has ",
1617 ({CType==convergent} -> "not been decreased\n"; "has been increased\n").
1618 explain_event_step(no_witness_found(Type,Id,Predicate)) -->
1619 witness_intro(Id,Predicate,Type),
1620 " ERROR: no solution for witness predicate found!\n".
1621 explain_event_step(action(Lhs,_Rhs,Values)) -->
1622 " executing an action:\n",
1623 show_assignments(Lhs,Values).
1624 explain_event_step(action_set(Lhs,_Rhs,ValueSet,Values)) -->
1625 " executing an action:\n ",
1626 pp_expr_l(Lhs,_LR)," :: ",pp_value(ValueSet),"\n choosing\n",
1627 show_assignments(Lhs,Values).
1628 explain_event_step(action_pred(Ids,Pred,Values)) -->
1629 " executing an action:\n ",
1630 pp_expr_l(Ids,_LR1)," :| ",pp_expr(Pred,_,_LR2),"\n choosing\n",
1631 show_assignments(Ids,Values).
1632 explain_event_step(error(Error,_Id)) -->
1633 % the error marker serves to link to a stored state-error by its ID
1634 explain_event_step(Error).
1635 explain_event_step(event_wd_error(TExpr,Source)) -->
1636 " Well-Definedness ERROR for ", ppatom(Source), "\n",
1637 " ", pp_expr(TExpr,_,_LR), "\n".
1638 explain_event_step(event_other_error(Msg)) --> ppatom(Msg).
1639
1640 explain_action_not_executable(TAction,no_wd_error) --> {is_assignment_to(TAction,IDs)},!,
1641 " ERROR: the following assignment to ", ppatoms(IDs),"was not executable\n",
1642 " (probably in conflict with another assignment, check SIM or EQL PO):", % or WD error
1643 translate_subst_with_indention_and_label(TAction,4).
1644 explain_action_not_executable(TAction,wd_error_possible) --> !,
1645 " ERROR: the following action was not executable\n",
1646 " (possibly due to a WD error):",
1647 translate_subst_with_indention_and_label(TAction,4).
1648 explain_action_not_executable(TAction,_WDErr) -->
1649 " ERROR: the following action was not executable:",
1650 translate_subst_with_indention_and_label(TAction,4).
1651
1652 is_assignment_to(b(assign(LHS,_),_,_),IDs) :- get_texpr_ids(LHS,IDs).
1653
1654 witness_intro(Id,Predicate,Type) -->
1655 " evaluating witness for abstract ", ppatom(Type), " ", pp_expr(Id,_,_LR1), "\n",
1656 " witness predicate: ", pp_expr(Predicate,_,_LR2), "\n".
1657
1658 show_assignments([],[]) --> !.
1659 show_assignments([Lhs|Lrest],[Val|Vrest]) -->
1660 " ",pp_expr(Lhs,_,_LimitReached), " := ", pp_value(Val), "\n",
1661 show_assignments(Lrest,Vrest).
1662
1663 /* unused at the moment:
1664 explain_state([]) --> !.
1665 explain_state([bind(Varname,Value)|Rest]) --> !,
1666 " ",ppterm(Varname)," = ",pp_value(Value),"\n",
1667 explain_state(Rest).
1668 explain_guards([]) --> "".
1669 explain_guards([Event|Rest]) -->
1670 {get_texpr_expr(Event,rlevent(Name,_Section,_Status,_Params,Guard,_Theorems,_Act,_VWit,_PWit,_Unmod,_Evt))},
1671 "\n",ppatom(Name),":",
1672 explain_predicate(Guard),
1673 explain_guards(Rest).
1674 explain_predicate(Guard,I,O) :-
1675 explain_predicate(Guard,2,I,O).
1676 */
1677 explain_predicate(Guard,Indention,I,O) :-
1678 pred_over_lines(0,'@grd',Guard,(Indention,I),(_,O)).
1679
1680 explain_simulation_errors([],[]) --> !.
1681 explain_simulation_errors([Error|Rest],[Grd|Gs]) -->
1682 explain_simulation_error(Error,Grd),
1683 explain_simulation_errors(Rest,Gs).
1684 explain_simulation_error(event(Name,Section,Guard),SpanPred) -->
1685 {add_span_label('guard false',Name,Section,Guard,SpanPred)},
1686 " guard for event ", ppatom(Name),
1687 " in ", ppatom(Section), ":",
1688 explain_predicate(Guard,6),"\n".
1689
1690 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1691 % pretty-print a state
1692
1693
1694 print_state(State) :- b_state(State), !,print_bstate(State).
1695 print_state(csp_and_b_root) :- csp_with_bz_mode, !,
1696 print('(MAIN || B)').
1697 print_state(csp_and_b(CSPState,BState)) :- csp_with_bz_mode, !,
1698 print_bstate(BState), translate_cspm_state(CSPState,Text), print(Text).
1699 print_state(CSPState) :- csp_mode,!,translate_cspm_state(CSPState,Text), print(Text).
1700 print_state(State) :- animation_mode(xtl),!,print(State).
1701 print_state(State) :- print('*** Unknown state: '),print(State).
1702
1703 b_state(root).
1704 b_state(concrete_constants(_)).
1705 b_state(const_and_vars(_,_)).
1706 b_state(expanded_const_and_vars(_,_,_,_)).
1707 b_state(expanded_vars(_,_)).
1708 b_state([bind(_,_)|_]).
1709 b_state([]).
1710
1711 print_bstate(State) :- translate_bstate(State,Output), print(' '),print(Output).
1712
1713 translate_any_state(State,Output) :-
1714 pp_any_state(State,Codes,[]),
1715 atom_codes_with_limit(Output,Codes).
1716 translate_bstate(State,Output) :-
1717 pp_b_state(State,Codes,[]),
1718 atom_codes_with_limit(Output,Codes).
1719
1720 % a version which tries to generate smaller strings
1721 translate_bstate_limited(State,Output) :-
1722 temporary_set_preference(expand_avl_upto,2,CHNG),
1723 call_cleanup(translate_bstate_limited(State,200,Output),
1724 reset_temporary_preference(expand_avl_upto,CHNG)).
1725
1726 translate_bstate_limited(State,Limit,Output) :-
1727 pp_b_state(State,Codes,[]),
1728 atom_codes_with_limit(Output,Limit,Codes).
1729
1730 pp_b_state(X) --> try_pp_b_state(X),!.
1731 pp_b_state(X) --> {add_error(pp_b_state,'Could not translate state: ',X)}.
1732
1733 try_pp_b_state(VAR) --> {var(VAR)},!, "_?VAR?_", {add_error(pp_b_state,'Variable state: ',VAR)}.
1734 try_pp_b_state(root) --> !, "root".
1735 try_pp_b_state(concrete_constants(Constants)) --> !,"Constants: ",
1736 pp_b_state(Constants).
1737 try_pp_b_state(const_and_vars(ID,Vars)) --> !,
1738 "Constants:",ppterm(ID),", Vars:",
1739 {set_translation_constants(ID)}, /* extract constants which stand for deferred set elements */
1740 pp_b_state(Vars),
1741 {clear_translation_constants}.
1742 try_pp_b_state(expanded_const_and_vars(ID,Vars,_,_Infos)) --> !, "EXPANDED ",
1743 try_pp_b_state(const_and_vars(ID,Vars)).
1744 try_pp_b_state(expanded_vars(Vars,_Infos)) --> !, "EXPANDED ",
1745 try_pp_b_state(Vars).
1746 try_pp_b_state([]) --> !, "/* empty state */".
1747 try_pp_b_state([bind(Varname,Value)|Rest]) --> !,
1748 "( ",ppterm(Varname),"=",
1749 pp_value(Value),
1750 ({Rest = []} -> []; " ",and_symbol,"\n "),
1751 pp_b_state_list(Rest).
1752
1753
1754 pp_b_state_list([]) --> !, " )".
1755 pp_b_state_list([bind(Varname,Value)|Rest]) --> !,
1756 ppterm(Varname),"=",
1757 pp_value(Value),
1758 ({Rest = []} -> [] ; " ",and_symbol,"\n "),
1759 pp_b_state_list(Rest).
1760 pp_b_state_list(X) --> {add_error(pp_b_state_list,'Could not translate: ',X)}.
1761
1762 % a version of pp which generates no newline; can be used for printing SETUP_CONSTANTS, INITIALISATION
1763 pp_b_state_comma_list([],_,_) --> !, ")".
1764 pp_b_state_comma_list(_,Cur,Limit) --> {Cur >= Limit}, !, "...".
1765 pp_b_state_comma_list([bind(Varname,Value)|Rest],Cur,Limit) --> !,
1766 %{print(c(Varname,Cur,Limit)),nl},
1767 start_size(Ref),
1768 ppterm(Varname),"=",
1769 pp_value(Value),
1770 ({Rest = []}
1771 -> ")"
1772 ; ",",
1773 end_size(Ref,Size), % compute size increase wrt Ref point
1774 {Cur1 is Cur+Size},
1775 pp_b_state_comma_list(Rest,Cur1,Limit)
1776 ).
1777 pp_b_state_comma_list(X,_,_) --> {add_error(pp_b_state_comma_list,'Could not translate: ',X)}.
1778
1779 start_size(X,X,X).
1780 end_size(RefVar,Len,X,X) :- % compute how many chars the dcg has added wrt start_size
1781 len(RefVar,X,Len).
1782 len(Var,X,Len) :- (var(Var) ; Var==X),!, Len=0.
1783 len([],_,0).
1784 len([_|T],X,Len) :- len(T,X,L1), Len is L1+1.
1785
1786 % can be used e.g. for setup_constants, initialise
1787 translate_b_state_to_comma_list_codes(FUNCTORCODES,State,Limit,ResCodes) :-
1788 pp_b_state_comma_list(State,0,Limit,Codes,[]),
1789 append("(",Codes,C0),
1790 append(FUNCTORCODES,C0,ResCodes).
1791 % ----------------
1792
1793 % printing and translating error contexts
1794 print_context(State) :- translate_context(State,Output), print(Output).
1795
1796 translate_context(Context,Output) :-
1797 pp_b_context(Context,Codes,[]),
1798 atom_codes_with_limit(Output,250,Codes).
1799
1800 pp_b_context([]) --> !.
1801 pp_b_context([C|Rest]) --> !,
1802 pp_b_context(C),
1803 pp_b_context(Rest).
1804 pp_b_context(translate_context) --> !, " ERROR CONTEXT: translate_context". % error occurred within translate_context
1805 pp_b_context(span_context(Span,Context)) --> !,
1806 pp_b_context(Context), " ", translate_span(Span,only_subsidiary).
1807 pp_b_context(operation(Name,StateID)) --> !,
1808 " ERROR CONTEXT: ",
1809 {get_specification_description_codes(operation,OP)}, OP, ":", % "OPERATION:"
1810 ({var(Name)} -> ppterm('ALL') ; {translate_operation_name(Name,TName)},ppterm(TName)),
1811 ",",pp_context_state(StateID).
1812 pp_b_context(checking_invariant) --> !,
1813 " ERROR CONTEXT: INVARIANT CHECKING,", pp_cur_context_state.
1814 pp_b_context(checking_negation_of_invariant(State)) --> !,
1815 " ERROR CONTEXT: NEGATION_OF_INVARIANT CHECKING, State:", pp_b_state(State).
1816 pp_b_context(checking_assertions) --> !,
1817 " ERROR CONTEXT: ASSERTION CHECKING,", pp_cur_context_state.
1818 pp_b_context(checking_context(Check,Name)) --> !,
1819 ppterm(Check),ppterm(Name).
1820 pp_b_context(loading_context(_FName)) --> !.
1821 pp_b_context(unit_test_context(Module,TotNr,Line,Call)) --> !,
1822 " ERROR CONTEXT: Unit Test ", ppterm(TotNr), " in module ", ppterm(Module),
1823 " at line ", ppterm(Line), " calling ", pp_functor(Call).
1824 pp_b_context(visb_error_context(Class,ID,OpNameOrAttr,Span)) --> !,
1825 " ERROR CONTEXT: VisB ", ppterm(Class), " with ID ", ppterm(ID), " and attribute/event ", ppterm(OpNameOrAttr),
1826 " ", translate_span(Span,only_subsidiary).
1827 pp_b_context(C) --> ppterm(C),pp_cur_context_state.
1828
1829 pp_functor(V) --> {var(V)},!, ppterm(V).
1830 pp_functor(T) --> {functor(T,F,N)}, ppterm(F),"/",ppterm(N).
1831
1832 pp_cur_context_state --> {state_space:get_current_context_state(ID)}, !,pp_context_state(ID).
1833 pp_cur_context_state --> ", unknown context state.".
1834
1835 % assumes we are in the right state:
1836 pp_current_state --> {state_space:current_expression(ID,_)}, !,pp_context_state(ID).
1837 pp_current_state --> ", unknown current context state.".
1838
1839 % TO DO: limit length/size of generated error description
1840 pp_context_state(ID) --> {state_space:visited_expression(ID,State)},!, % we have a state ID
1841 " State ID:", ppterm(ID),
1842 pp_context_state2(State).
1843 pp_context_state(State) --> pp_context_state3(State).
1844
1845 pp_context_state2(_) --> {debug:debug_mode(off)},!.
1846 pp_context_state2(State) --> ",", pp_context_state3(State).
1847
1848 pp_context_state3(State) --> " State: ",pp_any_state_with_limit(State,10).
1849
1850 pp_any_state_with_limit(State,Limit) -->
1851 {get_preference(expand_avl_upto,CurLim),
1852 (CurLim<0 ; Limit < CurLim),
1853 !,
1854 temporary_set_preference(expand_avl_upto,Limit,CHNG)},
1855 pp_any_state(State),
1856 {reset_temporary_preference(expand_avl_upto,CHNG)}.
1857 pp_any_state_with_limit(State,_Limit) --> pp_any_state(State).
1858
1859 pp_any_state(X) --> try_pp_b_state(X),!.
1860 pp_any_state(csp_and_b(P,B)) --> "CSP: ",{pp_csp_process(P,Atoms,[])},!,atoms_to_codelist(Atoms),
1861 " || B: ", try_pp_b_state(B).
1862 pp_any_state(X) --> {animation_mode(xtl)}, !, "XTL: ",ppterm(X). % CSP state
1863 pp_any_state(P) --> "CSP: ",{pp_csp_process(P,Atoms,[])},!,atoms_to_codelist(Atoms).
1864 pp_any_state(X) --> "Other formalism: ",ppterm(X). % CSP state
1865
1866 atoms_to_codelist([]) --> [].
1867 atoms_to_codelist([Atom|T]) --> ppterm(Atom), atoms_to_codelist(T).
1868
1869 % ----------------
1870
1871 :- dynamic deferred_set_constant/3.
1872
1873 set_translation_context(const_and_vars(ConstID,_)) :- !,
1874 %% print_message(setting_translation_constants(ConstID)),
1875 set_translation_constants(ConstID).
1876 set_translation_context(expanded_const_and_vars(ConstID,_,_,_)) :- !,
1877 set_translation_constants(ConstID).
1878 set_translation_context(_).
1879
1880 set_translation_constants(_) :- clear_translation_constants,
1881 get_preference(dot_print_use_constants,false),!.
1882 set_translation_constants(ConstID) :- var(ConstID),!,
1883 add_error(set_translation_constants,'Variable used as ConstID: ',ConstID).
1884 set_translation_constants(ConstID) :-
1885 state_space:visited_expression(ConstID,concrete_constants(ConstantsStore)),!,
1886 %% print_message(setting_constants(ConstID)),%%
1887 (treat_constants(ConstantsStore) -> true ; print_message(fail)).
1888 set_translation_constants(ConstID) :-
1889 add_error(set_translation_constants,'Unknown ConstID: ',ConstID).
1890
1891 clear_translation_constants :- %print_message(clearing),%%
1892 retractall(deferred_set_constant(_,_,_)).
1893
1894 treat_constants([]).
1895 treat_constants([bind(CstName,Val)|T]) :-
1896 ((Val=fd(X,GSet),b_global_deferred_set(GSet))
1897 -> (deferred_set_constant(GSet,X,_)
1898 -> true /* duplicate def of value */
1899 ; assertz(deferred_set_constant(GSet,X,CstName))
1900 )
1901 ; true
1902 ),
1903 treat_constants(T).
1904
1905
1906
1907 translate_bvalue_with_tlatype(Value,Type,Output) :-
1908 ( pp_tla_value(Type,Value,Codes,[]) ->
1909 atom_codes_with_limit(Output,Codes)
1910 ; add_error(translate_bvalue,'Could not translate TLA value: ',Value),
1911 Output='???').
1912
1913 pp_tla_value(function(_Type1,_Type2),[]) --> !,
1914 ppcodes("<<>>").
1915 pp_tla_value(function(integer,T2),avl_set(Set)) -->
1916 {convert_avlset_into_sequence(Set,Seq)}, !,
1917 pp_tla_with_sep("<< "," >>",",",T2,Seq).
1918 pp_tla_value(function(T1,T2),Set) -->
1919 {is_printable_set(Set,Values)},!,
1920 pp_tla_with_sep("(",")"," @@ ",function_value(T1,T2),Values).
1921 pp_tla_value(function_value(T1,T2),(L,R)) -->
1922 !,pp_tla_value(T1,L),":>",pp_tla_value(T2,R).
1923 pp_tla_value(set(Type),Set) -->
1924 {is_printable_set(Set,Values)},!,
1925 pp_tla_with_sep("{","}",",",Type,Values).
1926 pp_tla_value(tuple(Types),Value) -->
1927 {pairs_to_list(Types,Value,Values,[]),!},
1928 pp_tla_with_sep("<< "," >>",",",Types,Values).
1929 pp_tla_value(record(Fields),rec(FieldValues)) -->
1930 % TODO: Check if we can safely assume that Fields and FieldValues have the
1931 % same order
1932 !, {sort_tla_fields(Fields,FieldValues,RFields,RFieldValues)},
1933 pp_tla_with_sep("[","]",", ",RFields,RFieldValues).
1934 pp_tla_value(field(Name,Type),field(_,Value)) -->
1935 !, ppatom_opt_scramble(Name)," |-> ",pp_tla_value(Type,Value).
1936 pp_tla_value(_Type,Value) -->
1937 % fallback: use B's pretty printer
1938 pp_value(Value).
1939
1940 is_printable_set(avl_set(A),List) :- avl_domain(A,List).
1941 is_printable_set([],[]).
1942 is_printable_set([H|T],[H|T]).
1943
1944 pairs_to_list([_],Value) --> !,[Value].
1945 pairs_to_list([_|Rest],(L,R)) -->
1946 pairs_to_list(Rest,L),[R].
1947
1948
1949 sort_tla_fields([],_,[],[]).
1950 sort_tla_fields([Field|RFields],ValueFields,RFieldTypes,ResultValueFields) :-
1951 ( Field=field(Name,Type) -> true
1952 ; Field= opt(Name,Type) -> true),
1953 ( selectchk(field(Name,Value),ValueFields,RestValueFields),
1954 field_value_present(Field,Value,Result) ->
1955 % Found the field in the record value
1956 RFieldTypes = [field(Name,Type) |RestFields],
1957 ResultValueFields = [field(Name,Result)|RestValues],
1958 sort_tla_fields(RFields,RestValueFields,RestFields,RestValues)
1959 ;
1960 % didn't found the field in the value -> igore
1961 sort_tla_fields(RFields,ValueFields,RFieldTypes,ResultValueFields)
1962 ).
1963 field_value_present(field(_,_),RecValue,RecValue). % Obligatory fields are always present
1964 field_value_present(opt(_,_),OptValue,Value) :-
1965 % Optional fields are present if the field is of the form TRUE |-> Value.
1966 ( is_printable_set(OptValue,Values) -> Values=[(_TRUE,Value)]
1967 ;
1968 add_error(translate,'exptected set for TLA optional record field'),
1969 fail
1970 ).
1971
1972 pp_tla_with_sep(Start,End,Sep,Type,Values) -->
1973 ppcodes(Start),pp_tla_with_sep_aux(Values,End,Sep,Type).
1974 pp_tla_with_sep_aux([],End,_Sep,_Type) -->
1975 ppcodes(End).
1976 pp_tla_with_sep_aux([Value|Rest],End,Sep,Type) -->
1977 % If a single type is given, we interpret it as the type
1978 % for each element of the list, if it is a list, we interpret
1979 % it one different type for every value in the list.
1980 { (Type=[CurrentType|RestTypes] -> true ; CurrentType = Type, RestTypes=Type) },
1981 pp_tla_value(CurrentType,Value),
1982 ( {Rest=[_|_]} -> ppcodes(Sep); {true} ),
1983 pp_tla_with_sep_aux(Rest,End,Sep,RestTypes).
1984
1985
1986 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1987 % pretty-print a value
1988
1989 translate_bvalue_for_dot(string(S),Translation) :- !,
1990 % normal quotes confuse dot
1991 %ajoin(['''''',S,''''''],Translation).
1992 string_escape(S,ES),
1993 ajoin(['\\"',ES,'\\"'],Translation).
1994 translate_bvalue_for_dot(Val,ETranslation) :-
1995 translate_bvalue(Val,Translation),
1996 string_escape(Translation,ETranslation).
1997
1998 translate_bvalue_to_codes(V,Output) :-
1999 ( pp_value(V,_LimitReached,Codes,[]) ->
2000 Output=Codes
2001 ; add_error(translate_bvalue_to_codes,'Could not translate bvalue: ',V),
2002 Output="???").
2003 translate_bvalue(V,Output) :-
2004 %set_up_limit_reached(Codes,1000000,LimitReached), % we could set a very high-limit, like max_atom_length
2005 ( pp_value(V,_LimitReached,Codes,[]) ->
2006 atom_codes_with_limit(Output,Codes) % just catches representation error
2007 ; add_error(translate_bvalue,'Could not translate bvalue: ',V),
2008 Output='???').
2009 :- use_module(preferences).
2010 translate_bvalue_with_limit(V,Limit,Output) :-
2011 get_preference(expand_avl_upto,Max),
2012 ((Max>Limit % no sense in printing larger AVL trees
2013 ; Max = -1) % or setting limit to -1 for full value
2014 -> temporary_set_preference(expand_avl_upto,Limit,CHNG)
2015 ; CHNG=false),
2016 call_cleanup(translate_bvalue_with_limit_aux(V,Limit,Output),
2017 reset_temporary_preference(expand_avl_upto,CHNG)).
2018 translate_bvalue_with_limit_aux(V,Limit,Output) :-
2019 set_up_limit_reached(Codes,Limit,LimitReached),
2020 ( pp_value(V,LimitReached,Codes,[]) ->
2021 atom_codes_with_limit(Output,Limit,Codes)
2022 % ,length(Codes,Len), (Len>Limit -> format('pp(~w) codes:~w, limit:~w, String=~s~n~n',[LimitReached,Len,Limit,Codes]) ; true)
2023 ; add_error(translate_bvalue_with_limit,'Could not translate bvalue: ',V),
2024 Output='???').
2025
2026 translate_bvalues(Values,Output) :-
2027 translate_bvalues_with_limit(Values,no_limit,Output). % we could set a very high-limit, like max_atom_length
2028
2029 translate_bvalues_with_limit(Values,Limit,Output) :-
2030 (Limit==no_limit -> true %
2031 ; set_up_limit_reached(Codes,Limit,LimitReached)
2032 ),
2033 pp_value_l(Values,',',LimitReached,Codes,[]),!,
2034 atom_codes_with_limit(Output,Codes).
2035 translate_bvalues_with_limit(Values,Limit,O) :-
2036 add_internal_error('Call failed: ',translate_bvalues(Values,Limit,O)), O='??'.
2037
2038 translate_bvalue_for_expression(Value,TExpr,Output) :-
2039 animation_minor_mode(tla),
2040 expression_has_tla_type(TExpr,TlaType),!,
2041 translate_bvalue_with_tlatype(Value,TlaType,Output).
2042 translate_bvalue_for_expression(Value,TExpr,Output) :-
2043 get_texpr_type(TExpr,Type),
2044 translate_bvalue_with_type(Value,Type,Output).
2045
2046 translate_bvalue_for_expression_with_limit(Value,TExpr,_Limit,Output) :-
2047 animation_minor_mode(tla),
2048 expression_has_tla_type(TExpr,TlaType),!,
2049 translate_bvalue_with_tlatype(Value,TlaType,Output). % TO DO: treat Limit
2050 translate_bvalue_for_expression_with_limit(Value,TExpr,Limit,Output) :-
2051 get_texpr_type(TExpr,Type),
2052 translate_bvalue_with_type_and_limit(Value,Type,Limit,Output).
2053
2054 expression_has_tla_type(TExpr,Type) :-
2055 get_texpr_info(TExpr,Infos),
2056 memberchk(tla_type(Type),Infos).
2057
2058
2059 translate_bvalue_to_parseable_classicalb(Val,Str) :-
2060 % corresponds to set_print_type_infos(needed)
2061 temporary_set_preference(translate_force_all_typing_infos,false,CHNG),
2062 temporary_set_preference(translate_print_typing_infos,true,CHNG2),
2063 (animation_minor_mode(X)
2064 -> remove_animation_minor_mode,
2065 call_cleanup(translate_bvalue_to_parseable_aux(Val,Str),
2066 (reset_temporary_preference(translate_force_all_typing_infos,CHNG),
2067 reset_temporary_preference(translate_print_typing_infos,CHNG2),
2068 set_animation_minor_mode(X)))
2069 ; call_cleanup(translate_bvalue_to_parseable_aux(Val,Str),
2070 (reset_temporary_preference(translate_force_all_typing_infos,CHNG),
2071 reset_temporary_preference(translate_print_typing_infos,CHNG2)))
2072 ).
2073 translate_bvalue_to_parseable_aux(Val,Str) :-
2074 call_pp_with_no_limit_and_parseable(translate_bvalue(Val,Str)).
2075
2076
2077 translate_bexpr_to_parseable(Expr,Str) :-
2078 call_pp_with_no_limit_and_parseable(translate_bexpression(Expr,Str)).
2079
2080 % a more refined pretty printing: takes Type information into account; useful for detecting sequences
2081 translate_bvalue_with_type(Value,_,Output) :- var(Value),!,
2082 translate_bvalue(Value,Output).
2083 translate_bvalue_with_type(Value,Type,Output) :-
2084 adapt_value_according_to_type(Type,Value,NewValue),
2085 translate_bvalue(NewValue,Output).
2086
2087 translate_bvalue_with_type_and_limit(Value,Type,Limit,Output) :-
2088 get_preference(expand_avl_upto,CurLim),
2089 SetLim is Limit//2, % at least two symbols per element
2090 %print(translate(SetLim,CurLim)),nl,
2091 (CurLim<0 ; SetLim < CurLim),!,
2092 temporary_set_preference(expand_avl_upto,SetLim,CHNG),
2093 translate_bvalue_with_type_and_limit2(Value,Type,Limit,Output),
2094 reset_temporary_preference(expand_avl_upto,CHNG).
2095 translate_bvalue_with_type_and_limit(Value,Type,Limit,Output) :-
2096 translate_bvalue_with_type_and_limit2(Value,Type,Limit,Output).
2097 translate_bvalue_with_type_and_limit2(Value,_,Limit,Output) :- var(Value),!,
2098 translate_bvalue_with_limit(Value,Limit,Output).
2099 translate_bvalue_with_type_and_limit2(Value,Type,Limit,Output) :-
2100 adapt_value_according_to_type(Type,Value,NewValue),
2101 translate:translate_bvalue_with_limit(NewValue,Limit,Output).
2102 %debug:watch(translate:translate_bvalue_with_limit(NewValue,Limit,Output)).
2103
2104 :- use_module(avl_tools,[quick_avl_approximate_size/2]).
2105 adapt_value_according_to_type(_,Var,R) :- var(Var),!,R=Var.
2106 adapt_value_according_to_type(T,V,R) :- var(T),!,
2107 add_internal_error('Variable type: ',adapt_value_according_to_type(T,V,R)),
2108 R=V.
2109 adapt_value_according_to_type(integer,V,R) :- !,R=V.
2110 adapt_value_according_to_type(string,V,R) :- !,R=V.
2111 adapt_value_according_to_type(boolean,V,R) :- !,R=V.
2112 adapt_value_according_to_type(global(_),V,R) :- !,R=V.
2113 adapt_value_according_to_type(couple(TA,TB),(VA,VB),R) :- !, R=(RA,RB),
2114 adapt_value_according_to_type(TA,VA,RA),
2115 adapt_value_according_to_type(TB,VB,RB).
2116 adapt_value_according_to_type(set(Type),avl_set(A),Res) :- check_is_non_empty_avl(A),
2117 quick_avl_approximate_size(A,S),S<20,
2118 custom_explicit_sets:expand_custom_set_to_list(avl_set(A),List),!,
2119 maplist(adapt_value_according_to_type(Type),List,Res).
2120 adapt_value_according_to_type(set(_Type),V,R) :- !,R=V.
2121 adapt_value_according_to_type(seq(Type),V,R) :- !, % the type tells us it is a sequence
2122 (convert_set_into_sequence(V,VS)
2123 -> l_adapt_value_according_to_type(VS,Type,AVS),
2124 R=sequence(AVS)
2125 ; R=V).
2126 adapt_value_according_to_type(record(_Fields),Value,R) :- !, % to do: convert inside record
2127 R=Value.
2128 adapt_value_according_to_type(freetype(_),Value,R) :- !, R=Value.
2129 adapt_value_according_to_type(any,Value,R) :- !, R=Value.
2130 adapt_value_according_to_type(_,term(V),R) :- !, R=term(V). % appears for unknown values (no_value_for) when ALLOW_INCOMPLETE_SETUP_CONSTANTS is true
2131 adapt_value_according_to_type(Type,Value,R) :- print(adapt_value_according_to_type_unknown(Type,Value)),nl,
2132 R=Value.
2133
2134 l_adapt_value_according_to_type([],_Type,R) :- !,R=[].
2135 l_adapt_value_according_to_type([H|T],Type,[AH|AT]) :-
2136 adapt_value_according_to_type(Type,H,AH),
2137 l_adapt_value_according_to_type(T,Type,AT).
2138
2139 pp_value_with_type(E,T,LimitReached) --> {adapt_value_according_to_type(T,E,AdaptedE)},
2140 pp_value(AdaptedE,LimitReached).
2141
2142 pp_value(V,In,Out) :- set_up_limit_reached(In,1000,LimitReached),
2143 pp_value(V,LimitReached,In,Out).
2144
2145 % LimitReached is a flag: when it is grounded to limit_reached this instructs pp_value to stop generating output
2146 pp_value(_,LimitReached) --> {LimitReached==limit_reached},!, "...".
2147 pp_value(V,_) --> {var(V)},!, pp_variable(V).
2148 pp_value('$VAR'(N),_) --> !,pp_numberedvar(N).
2149 pp_value(X,_) --> {cyclic_term(X)},!,underscore_symbol,"cyclic",underscore_symbol.
2150 pp_value(fd(X,GSet),_) --> {var(X)},!,
2151 ppatom(GSet),":", ppnumber(X). %":??".
2152 pp_value(fd(X,GSet),_) -->
2153 {b_global_sets:is_b_global_constant_hash(GSet,X,Res)},!,
2154 pp_identifier(Res).
2155 pp_value(fd(X,GSet),_) --> {deferred_set_constant(GSet,X,Cst)},!,
2156 pp_identifier(Cst).
2157 pp_value(fd(X,M),_) --> !,ppatom_opt_scramble(M),ppnumber(X).
2158 pp_value(int(X),_) --> !,ppnumber(X).
2159 pp_value(term(floating(X)),_) --> !,ppnumber(X).
2160 pp_value(string(X),_) --> !,string_start_symbol,ppstring_opt_scramble(X),string_end_symbol.
2161 pp_value(global_set(X),_) --> {atomic(X),integer_set_mapping(X,Kind,Y)},!,
2162 ({Kind=integer_set} -> ppatom(Y) ; ppatom_opt_scramble(X)).
2163 pp_value(term(X),_) --> {var(X)},!,"term(",pp_variable(X),")".
2164 pp_value(freetype(X),_) --> {pretty_freetype(X,P)},!,ppatom_opt_scramble(P).
2165 pp_value(pred_true /* bool_true */,_) --> %!,"TRUE". % TO DO: in latex_mode: surround by mathit
2166 {constants_in_mode(pred_true,Symbol)},!,ppatom(Symbol).
2167 pp_value(pred_false /* bool_false */,_) --> %!,"FALSE".
2168 {constants_in_mode(pred_false,Symbol)},!,ppatom(Symbol).
2169 %pp_value(bool_true) --> !,"TRUE". % old version; still in some test traces which are printed
2170 %pp_value(bool_false) --> !,"FALSE".
2171 pp_value([],_) --> !,empty_set_symbol.
2172 pp_value(sequence(List),LimitReached) --> !,
2173 ({List=[]} -> pp_empty_sequence ; pp_sequence_with_limit(List,LimitReached)).
2174 pp_value([Head|Tail],LimitReached) --> {get_preference(translate_print_all_sequences,true),
2175 convert_set_into_sequence([Head|Tail],Elements)},
2176 !,
2177 pp_sequence(Elements,LimitReached).
2178 pp_value([Head|Tail],LimitReached) --> !, {set_brackets(L,R)},
2179 ppatom(L),
2180 pp_value_l_with_limit([Head|Tail],',',LimitReached),
2181 ppatom(R).
2182 %pp_value([Head|Tail]) --> !,
2183 % {( convert_set_into_sequence([Head|Tail],Elements) ->
2184 % (Start,End) = ('[',']')
2185 % ;
2186 % Elements = [Head|Tail],
2187 % (Start,End) = ('{','}'))},
2188 % ppatom(Start),pp_value_l(Elements,','),ppatom(End).
2189 pp_value( (A,B) ,LimitReached) --> !,
2190 "(",pp_inner_value(A,LimitReached),
2191 maplet_symbol,
2192 pp_value(B,LimitReached),")".
2193 pp_value(avl_set(A),LimitReached) --> !,
2194 {check_is_non_empty_avl(A),avl_size(A,Sz)},
2195 {set_brackets(LBrace,RBrace)},
2196 ( {size_is_in_set_limit(Sz),
2197 %(Sz>2 ; get_preference(translate_print_all_sequences,true)),
2198 get_preference(translate_print_all_sequences,true), % no longer try and convert any sequence longer than 2 to sequence notation
2199 avl_max(A,(int(Sz),_)), % a sequence has minimum int(1) and maximum int(Sz)
2200 convert_avlset_into_sequence(A,Seq)} ->
2201 pp_sequence(Seq,LimitReached)
2202 ;
2203 ( {Sz=0} -> left_set_bracket," /* empty avl_set */ ",right_set_bracket
2204 ; {(size_is_in_set_limit(Sz) ; Sz < 3)} -> % if Sz 3 we will print at least two elements anyway
2205 {avl_domain(A,List)},
2206 ppatom(LBrace),pp_value_l(List,',',LimitReached),ppatom(RBrace)
2207 ; {(Sz<5 ; \+ size_is_in_set_limit(4))} ->
2208 {avl_min(A,Min),avl_max(A,Max)},
2209 hash_card_symbol, % "#"
2210 ppnumber(Sz),":", left_set_bracket,
2211 pp_value(Min,LimitReached),",",ldots,",",pp_value(Max,LimitReached),right_set_bracket
2212 ;
2213 {avl_min(A,Min),avl_next(Min,A,Nxt),avl_max(A,Max),avl_prev(Max,A,Prev)},
2214 hash_card_symbol, % "#",
2215 ppnumber(Sz),":", left_set_bracket,
2216 pp_value(Min,LimitReached),",",pp_value(Nxt,LimitReached),",",ldots,",",
2217 pp_value(Prev,LimitReached),",",pp_value(Max,LimitReached),right_set_bracket )).
2218
2219 pp_value(field(Name,Value),LimitReached) --> !,
2220 pp_identifier(Name),":",pp_value(Value,LimitReached). % : for fields has priority 120 in French manual
2221 pp_value(rec(Rec),LimitReached) --> !,
2222 {function_like_in_mode(rec,Symbol)},
2223 ppatom(Symbol), "(",pp_value_l(Rec,',',LimitReached),")".
2224 pp_value(struct(Rec),LimitReached) --> !,
2225 {function_like_in_mode(struct,Symbol)},
2226 ppatom(Symbol), "(", pp_value_l(Rec,',',LimitReached),")".
2227 pp_value(term(no_value_for(Id)),_) --> !,
2228 "undefined ",ppatom(Id).
2229 pp_value(closure(Variables,Types,Predicate),LimitReached) --> !,
2230 pp_closure_value(Variables,Types,Predicate,LimitReached).
2231 pp_value(freeval(Freetype,Case,Value),LimitReached) --> !,
2232 ({ground(Case),ground(Value),Value=term(Case)} -> ppatom_opt_scramble(Case)
2233 ; {ground(Case)} -> ppatom_opt_scramble(Case),"(",pp_value(Value,LimitReached),")"
2234 ; {pretty_freetype(Freetype,P)},
2235 "FREEVALUE[",ppatom_opt_scramble(P),
2236 ",",write_to_codes(Case),
2237 "](",pp_value(Value,LimitReached),")"
2238 ).
2239 pp_value(X,_) --> {animation_mode(xtl)},!,
2240 write_to_codes(X).
2241 pp_value(X,_) --> % the << >> pose problems when checking against FDR
2242 "<< ",write_to_codes(X)," >>".
2243
2244 pp_variable(V) --> write_to_codes(V). %underscore_symbol.
2245
2246 :- use_module(closures,[is_recursive_closure/3]).
2247
2248 pp_closure_value(Ids,Type,B,_LimitReached) -->
2249 {var(Ids) ; var(Type) ; var(B)},!,
2250 add_internal_error('Illegal value: ',pp_value_illegal_closure(Ids,Type,B)),
2251 "<< ILLEGAL ",write_to_codes(closure(Ids,Type,B))," >>".
2252 pp_closure_value(Variables,Types,Predicate,LimitReached) --> {\+ size_is_in_set_limit(1)},
2253 !, % do not print body; just print hash value
2254 {make_closure_ids(Variables,Types,Ids), term_hash(Predicate,PH)},
2255 left_set_bracket, % { Ids | #PREDICATE#(HASH) }
2256 pp_expr_l_pair_in_mode(Ids,LimitReached),
2257 pp_such_that_bar,
2258 " ",hash_card_symbol,"PREDICATE",hash_card_symbol,"(",ppnumber(PH),") ", right_set_bracket.
2259 pp_closure_value(Variables,Types,Predicate,LimitReached) -->
2260 {get_preference(translate_ids_to_parseable_format,true),
2261 is_recursive_closure(Variables,Types,Predicate),
2262 get_texpr_info(Predicate,Infos),
2263 member(prob_annotation(recursive(TID)),Infos),
2264 def_get_texpr_id(TID,ID)}, !,
2265 % write recursive let for f as : CHOOSE(.) or MU({f|f= SET /*@desc letrec */ })
2266 % an alternate syntax could be RECLET f BE f = SET IN f END
2267 "MU({", pp_identifier(ID), "|",
2268 pp_identifier(ID)," = ",
2269 pp_closure_value2(Variables,Types,Predicate,LimitReached),
2270 "/*@desc letrec */ }) ".
2271 pp_closure_value([Id],[Type],Membership,LimitReached) -->
2272 { get_texpr_expr(Membership,member(Elem,Set)),
2273 get_texpr_id(Elem,Id),
2274 \+ occurs_in_expr(Id,Set), % detect things like {s|s : 1 .. card(s) --> T} (test 1030)
2275 get_texpr_type(Elem,Type),
2276 !},
2277 pp_expr_m(Set,299,LimitReached).
2278 pp_closure_value(Variables,Types,Predicate,LimitReached) --> pp_closure_value2(Variables,Types,Predicate,LimitReached).
2279
2280 pp_closure_value2(Variables,Types,Predicate,LimitReached) --> !,
2281 {make_closure_ids(Variables,Types,Ids)},
2282 pp_comprehension_set(Ids,Predicate,[],LimitReached). % TODO: propagate LimitReached
2283
2284 % avoid printing parentheses:
2285 % (x,y,z) = ((x,y),z)
2286 pp_inner_value( AB , LimitReached) --> {nonvar(AB),AB=(A,B)}, !, % do not print parentheses in this context
2287 pp_inner_value(A,LimitReached),maplet_symbol,
2288 pp_value(B,LimitReached).
2289 pp_inner_value( Value , LimitReached) --> pp_value( Value , LimitReached).
2290
2291 size_is_in_set_limit(Size) :- get_preference(expand_avl_upto,Max),
2292 (Max<0 -> true /* no limit */
2293 ; Size =< Max).
2294
2295 % instantiate LimitReached argument as soon as a list exceeds a certain limit
2296 set_up_limit_reached(_,Neg,_) :- Neg<0,!. % negative number means unlimited
2297 set_up_limit_reached(_,0,LimitReached) :- !, LimitReached = limit_reached.
2298 set_up_limit_reached(List,Limit,LimitReached) :-
2299 block_set_up_limit_reached(List,Limit,LimitReached).
2300 :- block block_set_up_limit_reached(-,?,?).
2301 block_set_up_limit_reached([],_,_).
2302 block_set_up_limit_reached([_|T],Limit,LimitReached) :-
2303 (Limit<1 -> LimitReached=limit_reached
2304 ; L1 is Limit-1, block_set_up_limit_reached(T,L1,LimitReached)).
2305
2306 % pretty print LimitReached, requires %:- block block_set_up_limit_reached(-,?,-).
2307 /*
2308 pp_lr(LR) --> {LR==limit_reached},!, " *LR* ".
2309 pp_lr(LR) --> {frozen(LR,translate:block_set_up_limit_reached(_,Lim,_))},!, " ok(", ppnumber(Lim),") ".
2310 pp_lr(LR) --> {frozen(LR,G)},!, " ok(", ppterm(G),") ".
2311 pp_lr(_) --> " ok ".
2312 */
2313
2314
2315 pp_value_l_with_limit(V,Sep,LimitReached) --> {get_preference(expand_avl_upto,Max)},
2316 pp_value_l(V,Sep,Max,LimitReached).
2317 pp_value_l(V,Sep,LimitReached) --> pp_value_l(V,Sep,-1,LimitReached).
2318
2319 pp_value_l(V,_Sep,_,_) --> {var(V)},!,"...".
2320 pp_value_l(_,_,_,LimitReached) --> {LimitReached==limit_reached},!,"...".
2321 pp_value_l('$VAR'(N),_Sep,_,_) --> !,"}\\/{",pp_numberedvar(N),"}".
2322 pp_value_l([],_Sep,_,_) --> !.
2323 pp_value_l([Expr|Rest],Sep,Limit,LimitReached) -->
2324 ( {nonvar(Rest),Rest=[]} ->
2325 pp_value(Expr,LimitReached)
2326 ; {Limit=0} -> "..."
2327 ;
2328 pp_value(Expr,LimitReached),
2329 % no separator for closure special case
2330 ({nonvar(Rest) , Rest = closure(_,_,_)} -> {true} ; ppatom(Sep)) ,
2331 {L1 is Limit-1} ,
2332 % convert avl_set(_) in a list's tail to a Prolog list
2333 {nonvar(Rest) , Rest = avl_set(_) -> custom_explicit_sets:expand_custom_set_to_list(Rest,LRest) ; LRest = Rest} ,
2334 pp_value_l(LRest,Sep,L1,LimitReached)).
2335 pp_value_l(avl_set(A),_Sep,_,LimitReached) --> pp_value(avl_set(A),LimitReached).
2336 pp_value_l(closure(A,B,C),_Sep,_,LimitReached) --> "}\\/", pp_value(closure(A,B,C),LimitReached).
2337
2338 make_closure_ids([],[],[]).
2339 make_closure_ids([V|Vrest],[T|Trest],[TExpr|TErest]) :-
2340 (var(V) -> V2='_', format('Illegal variable identifier in make_closure_ids: ~w~n',[V])
2341 ; V2=V),
2342 create_texpr(identifier(V2),T,[],TExpr),
2343 make_closure_ids(Vrest,Trest,TErest).
2344
2345 % symbol for starting and ending a sequence:
2346 pp_begin_sequence --> {animation_minor_mode(tla)},!,"<<".
2347 pp_begin_sequence --> {get_preference(translate_print_cs_style_sequences,true)},!,"".
2348 pp_begin_sequence --> "[".
2349 pp_end_sequence --> {animation_minor_mode(tla)},!,">>".
2350 pp_end_sequence --> {get_preference(translate_print_cs_style_sequences,true)},!,"".
2351 pp_end_sequence --> "]".
2352
2353 pp_separator_sequence('') :- get_preference(translate_print_cs_style_sequences,true),!.
2354 pp_separator_sequence(',').
2355
2356 % string for empty sequence
2357 pp_empty_sequence --> {animation_minor_mode(tla)},!, "<< >>".
2358 pp_empty_sequence --> {get_preference(translate_print_cs_style_sequences,true)},!,
2359 ( {latex_mode} -> "\\lambda" ; [955]). % 955 is lambda symbol in Unicode
2360 pp_empty_sequence --> {atelierb_mode(pp)},!, "{}".
2361 pp_empty_sequence --> "[]".
2362
2363 % symbols for function application:
2364 pp_function_left_bracket --> {animation_minor_mode(tla)},!, "[".
2365 pp_function_left_bracket --> "(".
2366
2367 pp_function_right_bracket --> {animation_minor_mode(tla)},!, "]".
2368 pp_function_right_bracket --> ")".
2369
2370 pp_sequence(Elements,LimitReached) --> {pp_separator_sequence(Sep)},
2371 pp_begin_sequence,
2372 pp_value_l(Elements,Sep,LimitReached),
2373 pp_end_sequence.
2374 pp_sequence_with_limit(Elements,LimitReached) --> {pp_separator_sequence(Sep)},
2375 pp_begin_sequence,
2376 pp_value_l_with_limit(Elements,Sep,LimitReached),
2377 pp_end_sequence.
2378
2379 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2380 % machines
2381
2382 :- use_module(eventhandling,[register_event_listener/3]).
2383 :- register_event_listener(clear_specification,reset_translate,
2384 'Reset Translation Caches.').
2385 reset_translate :- retractall(bugly_scramble_id_cache(_,_)), retractall(non_det_constants(_,_)).
2386 %reset_translate :- set_print_type_infos(none),
2387 % set_preference(translate_suppress_rodin_positions_flag,false).
2388
2389 suppress_rodin_positions(CHNG) :- set_suppress_rodin_positions(true,CHNG).
2390 set_suppress_rodin_positions(Value,CHNG) :-
2391 temporary_set_preference(translate_suppress_rodin_positions_flag,Value,CHNG).
2392 reset_suppress_rodin_positions(CHNG) :-
2393 reset_temporary_preference(translate_suppress_rodin_positions_flag,CHNG).
2394
2395 set_print_type_infos(none) :- !,
2396 set_preference(translate_force_all_typing_infos,false),
2397 set_preference(translate_print_typing_infos,false).
2398 set_print_type_infos(needed) :- !,
2399 set_preference(translate_force_all_typing_infos,false),
2400 set_preference(translate_print_typing_infos,true).
2401 set_print_type_infos(all) :- !,
2402 set_preference(translate_force_all_typing_infos,true),
2403 set_preference(translate_print_typing_infos,true).
2404 set_print_type_infos(Err) :-
2405 add_internal_error('Illegal type: ',set_print_type_infos(Err)).
2406
2407
2408 :- use_module(tools_files,[put_codes/2]).
2409 print_machine(M) :-
2410 nl, translate_machine(M,Msg,true), put_codes(Msg,user_output), nl,
2411 flush_output(user_output),!.
2412 print_machine(M) :- add_internal_error('Printing failed: ',print_machine(M)).
2413
2414 %
2415 translate_machine(M,Codes,AdditionalInfo) :-
2416 retractall(print_additional_machine_info),
2417 (AdditionalInfo=true -> assertz(print_additional_machine_info) ; true),
2418 call_pp_with_no_limit_and_parseable(translate_machine1(M,(0,Codes),(_,[]))).
2419
2420 % perform a call by forcing parseable output and removing limit to set
2421 call_pp_with_no_limit_and_parseable(PP_Call) :-
2422 temporary_set_preference(translate_ids_to_parseable_format,true,CHNG),
2423 temporary_set_preference(expand_avl_upto,-1,CHNG2),
2424 call_cleanup(call(PP_Call),
2425 (reset_temporary_preference(translate_ids_to_parseable_format,CHNG),
2426 reset_temporary_preference(expand_avl_upto,CHNG2))).
2427
2428
2429 % useful if we wish to translate just a selection of sections without MACHINE/END
2430 translate_section_list(SL,Codes) :- init_machine_translation,
2431 translate_machine2(SL,SL,no_end,(0,Codes),(_,[])).
2432
2433 translate_machine1(machine(Name,Sections)) -->
2434 indent('MACHINE '), {adapt_machine_name(Name,AName)}, insertstr(AName),
2435 {init_machine_translation},
2436 translate_machine2(Sections,Sections,end).
2437 translate_machine2([],_,end) --> !, insertstr('\nEND\n').
2438 translate_machine2([],_,_) --> !, insertstr('\n').
2439 translate_machine2([P|Rest],All,End) -->
2440 translate_mpart(P,All),
2441 translate_machine2(Rest,All,End).
2442
2443 adapt_machine_name('dummy(uses)',R) :- !,R='MAIN'.
2444 adapt_machine_name(X,X).
2445
2446 :- dynamic section_header_generated/1.
2447 :- dynamic print_additional_machine_info/0.
2448 print_additional_machine_info.
2449
2450 init_machine_translation :- retractall(section_header_generated(_)).
2451
2452 % start a part of a section
2453 mpstart(Title,I) -->
2454 insertstr('\n'),insertstr(Title),
2455 indention_level(I,I2), {I2 is I+2}.
2456 % end a part of a section
2457 mpend(I) -->
2458 indention_level(_,I).
2459
2460 mpstart_section(Section,Title,AltTitle,I,In,Out) :-
2461 (\+ section_header_generated(Section)
2462 -> mpstart(Title,I,In,Out), assertz(section_header_generated(Section))
2463 ; mpstart(AltTitle,I,In,Out) /* use alternative title; section header already generated */
2464 ).
2465
2466 translate_mpart(Section/I,All) --> %{print(Section),nl},
2467 ( {I=[]} -> {true}
2468 ; translate_mpart2(Section,I,All) -> {true}
2469 ;
2470 insertstr('\nSection '),insertstr(Section),insertstr(': '),
2471 insertstr('<< pretty-print failed >>')
2472 ).
2473 translate_mpart2(deferred_sets,I,_) -->
2474 mpstart_section(sets,'SETS /* deferred */',' ; /* deferred */',P),
2475 indent_expr_l_sep(I,';'),mpend(P).
2476 translate_mpart2(enumerated_sets,_I,_) --> []. % these are now pretty printed below
2477 %mpstart('ENUMERATED SETS',P),indent_expr_l_sep(I,';'),mpend(P).
2478 translate_mpart2(enumerated_elements,I,_) --> %{print(enum_els(I)),nl},
2479 {translate_enums(I,[],Res)},
2480 mpstart_section(sets,'SETS /* enumerated */',' ; /* enumerated */',P),
2481 indent_expr_l_sep(Res,';'),mpend(P).
2482 translate_mpart2(parameters,I,_) --> mpstart('PARAMETERS',P),indent_expr_l_sep(I,','),mpend(P).
2483 translate_mpart2(internal_parameters,I,_) --> {print_additional_machine_info},!,
2484 mpstart('/* INTERNAL_PARAMETERS',P),indent_expr_l_sep(I,','),insertstr(' */'),mpend(P).
2485 translate_mpart2(internal_parameters,_I,_) --> [].
2486 translate_mpart2(abstract_variables,I,_) --> mpstart('ABSTRACT_VARIABLES',P),indent_exprs(I),mpend(P).
2487 translate_mpart2(concrete_variables,I,_) --> mpstart('CONCRETE_VARIABLES',P),indent_exprs(I),mpend(P).
2488 translate_mpart2(abstract_constants,I,_) --> mpstart('ABSTRACT_CONSTANTS',P),indent_exprs(I),mpend(P).
2489 translate_mpart2(concrete_constants,I,_) --> mpstart('CONCRETE_CONSTANTS',P),indent_exprs(I),mpend(P).
2490 translate_mpart2(promoted,I,_) --> {print_additional_machine_info},!,
2491 mpstart('/* PROMOTED OPERATIONS',P),indent_expr_l_sep(I,','),insertstr(' */'),mpend(P).
2492 translate_mpart2(promoted,_I,_) --> [].
2493 translate_mpart2(unpromoted,I,_) --> {print_additional_machine_info},!,
2494 mpstart('/* NOT PROMOTED OPERATIONS',P),indent_expr_l_sep(I,','),insertstr(' */'),mpend(P).
2495 translate_mpart2(unpromoted,_I,_) --> [].
2496 translate_mpart2(constraints,I,All) --> mpart_typing(constraints,[parameters],All,I).
2497 translate_mpart2(invariant,I,All) --> mpart_typing(invariant, [abstract_variables,concrete_variables],All,I).
2498 translate_mpart2(linking_invariant,_I,_) --> [].
2499 translate_mpart2(properties,I,All) --> mpart_typing(properties,[abstract_constants,concrete_constants],All,I).
2500 translate_mpart2(assertions,I,_) -->
2501 mpstart_spec_desc(assertions,P),
2502 %indent_expr_l_sep(I,';'),
2503 preds_over_lines(1,'@thm','; ',I),
2504 mpend(P). % TO DO:
2505 translate_mpart2(initialisation,S,_) --> mpstart_spec_desc(initialisation,P),translate_inits(S),mpend(P).
2506 translate_mpart2(definitions,Defs,_) --> {(standard_library_required(Defs,_) ; set_pref_used(Defs))},!,
2507 mpstart('DEFINITIONS',P),
2508 insertstr('\n'),
2509 {findall(Lib,standard_library_required(Defs,Lib),Libs)},
2510 insert_library_usages(Libs),
2511 translate_set_pref_defs(Defs),
2512 mpend(P),
2513 translate_other_defpart(Defs).
2514 translate_mpart2(definitions,Defs,_) --> !, translate_other_defpart(Defs).
2515 translate_mpart2(operation_bodies,Ops,_) --> mpstart_spec_desc(operations,P),translate_ops(Ops),mpend(P).
2516 translate_mpart2(used,Used,_) --> {print_additional_machine_info},!,
2517 mpstart('/* USED',P),translate_used(Used),insertstr(' */'),mpend(P).
2518 translate_mpart2(used,_Used,_) --> [].
2519 translate_mpart2(freetypes,Freetypes,_) -->
2520 mpstart('FREETYPES',P),translate_freetypes(Freetypes),mpend(P).
2521 translate_mpart2(meta,_Infos,_) --> [].
2522 translate_mpart2(operators,Operators,_) -->
2523 insertstr('\n/* Event-B operators:'), % */
2524 indention_level(I,I2), {I2 is I+2},
2525 translate_eventb_operators(Operators),
2526 indention_level(I2,I),
2527 insertstr('\n*/').
2528 translate_mpart2(values,Values,_) -->
2529 mpstart('VALUES',P),indent_expr_l_sep(Values,';'),mpend(P).
2530
2531 indent_exprs(I) --> {force_eventb_rodin_mode},!, indent_expr_l_sep(I,' '). % Event-B Camille style
2532 indent_exprs(I) --> indent_expr_l_sep(I,',').
2533
2534
2535 % Add typing predicates to a predicate
2536 mpart_typing(Title,Section,Sections,PredI) -->
2537 {mpart_typing2(Section,Sections,PredI,PredO)},
2538 ( {is_truth(PredO)} -> [] % TO DO: in animation_minor_mode(z) for INVARIANT: force adding typing predicates (translate_print_typing_infos)
2539 ;
2540 mpstart_spec_desc(Title,P),
2541 section_pred_over_lines(0,Title,PredO),
2542 mpend(P)).
2543
2544 mpstart_spec_desc(Title,P) --> {get_specification_description(Title,Atom)},!, mpstart(Atom,P).
2545 mpstart_spec_desc(Title,P) --> mpstart(Title,P).
2546
2547 mpart_typing2(Sections,AllSections,PredI,PredO) :-
2548 get_preference(translate_print_typing_infos,true),!,
2549 get_all_ids(Sections,AllSections,Ids),
2550 add_typing_predicates(Ids,PredI,PredO).
2551 mpart_typing2(_Section,_Sections,Pred,Pred).
2552
2553 get_all_ids([],_Sections,[]).
2554 get_all_ids([Section|Srest],Sections,Ids) :-
2555 memberchk(Section/Ids1,Sections),
2556 append(Ids1,Ids2,Ids),
2557 get_all_ids(Srest,Sections,Ids2).
2558
2559 add_optional_typing_predicates(Ids,In,Out) :-
2560 ( get_preference(translate_print_typing_infos,true) -> add_typing_predicates(Ids,In,Out)
2561 ; is_truth(In) -> add_typing_predicates(Ids,In,Out)
2562 ; In=Out).
2563
2564 add_normal_typing_predicates(Ids,In,Out) :- % used to call add_typing_predicates directly
2565 (add_optional_typing_predicates(Ids,In,Out) -> true
2566 ; add_internal_error('Failed: ',add_normal_typing_predicates(Ids)), In=Out).
2567
2568 add_typing_predicates([],P,P) :- !.
2569 add_typing_predicates(Ids,Pin,Pout) :-
2570 remove_already_typed_ids(Pin,Ids,UntypedIds),
2571 KeepSeq=false,
2572 generate_typing_predicates(UntypedIds,KeepSeq,Typing),
2573 conjunction_to_list(Pin,Pins),
2574 remove_duplicate_predicates(Typing,Pins,Typing2),
2575 append(Typing2,[Pin],Preds),
2576 conjunct_predicates(Preds,Pout).
2577
2578 remove_already_typed_ids(_TExpr,Ids,Ids) :-
2579 get_preference(translate_force_all_typing_infos,true),!.
2580 remove_already_typed_ids(TExpr,Ids,UntypedIds) :-
2581 get_texpr_expr(TExpr,Expr),!,
2582 remove_already_typed_ids2(Expr,Ids,UntypedIds).
2583 remove_already_typed_ids(TExpr,Ids,Res) :-
2584 add_internal_error('Not a typed expression: ',remove_already_typed_ids(TExpr,Ids,_)),
2585 Res=Ids.
2586 remove_already_typed_ids2(conjunct(A,B),Ids,UntypedIds) :- !,
2587 remove_already_typed_ids(A,Ids,I1),
2588 remove_already_typed_ids(B,I1,UntypedIds).
2589 remove_already_typed_ids2(lazy_let_pred(_,_,A),Ids,UntypedIds) :- !,
2590 remove_already_typed_ids(A,Ids,UntypedIds). % TO DO: check for variable clases with lazy_let ids ???
2591 remove_already_typed_ids2(Expr,Ids,UntypedIds) :-
2592 is_typing_predicate(Expr,Id),
2593 create_texpr(identifier(Id),_,_,TId),
2594 select(TId,Ids,UntypedIds),!.
2595 remove_already_typed_ids2(_,Ids,Ids).
2596 is_typing_predicate(member(A,_),Id) :- get_texpr_id(A,Id).
2597 is_typing_predicate(subset(A,_),Id) :- get_texpr_id(A,Id).
2598 is_typing_predicate(subset_strict(A,_),Id) :- get_texpr_id(A,Id).
2599
2600 remove_duplicate_predicates([],_Old,[]).
2601 remove_duplicate_predicates([Pred|Prest],Old,Result) :-
2602 (is_duplicate_predicate(Pred,Old) -> Result = Rest ; Result = [Pred|Rest]),
2603 remove_duplicate_predicates(Prest,Old,Rest).
2604 is_duplicate_predicate(Pred,List) :-
2605 remove_all_infos(Pred,Pattern),
2606 memberchk(Pattern,List).
2607
2608 :- use_module(typing_tools,[create_type_set/3]).
2609 generate_typing_predicates(TIds,Preds) :-
2610 generate_typing_predicates(TIds,true,Preds).
2611 generate_typing_predicates(TIds,KeepSeq,Preds) :-
2612 maplist(generate_typing_predicate(KeepSeq), TIds, Preds).
2613 generate_typing_predicate(KeepSeq,TId,Pred) :-
2614 get_texpr_type(TId,Type),
2615 remove_all_infos_and_ground(TId,TId2), % clear all infos
2616 (create_type_set(Type,KeepSeq,TSet) -> create_texpr(member(TId2,TSet),pred,[],Pred)
2617 ; TId = b(_,any,[raw]) -> is_truth(Pred) % this comes from transform_raw
2618 ; add_error(generate_typing_predicate,'Illegal type: ',Type),
2619 is_truth(Pred)
2620 ).
2621
2622
2623
2624
2625 % translate enumerated constant list into enumerate set definition
2626 translate_enums([],Acc,Acc).
2627 translate_enums([EnumCst|T],Acc,Res) :- %get_texpr_id(EnumCst,Id),
2628 get_texpr_type(EnumCst,global(GlobalSet)),
2629 insert_enum_cst(Acc,EnumCst,GlobalSet,Acc2),
2630 translate_enums(T,Acc2,Res).
2631
2632 insert_enum_cst([],ID,Type,[enumerated_set_def(Type,[ID])]).
2633 insert_enum_cst([enumerated_set_def(Type,Lst)|T],ID,Type2,[enumerated_set_def(Type,Lst2)|TT]) :-
2634 (Type=Type2
2635 -> Lst2 = [ID|Lst], TT=T
2636 ; Lst2 = Lst, insert_enum_cst(T,ID,Type2,TT)
2637 ).
2638
2639 % pretty-print the initialisation section of a machine
2640 translate_inits(Inits) -->
2641 ( {is_list_simple(Inits)} ->
2642 translate_inits2(Inits)
2643 ;
2644 indention_level(I,I2),{I2 is I+2},
2645 translate_subst_begin_end(Inits),
2646 indention_level(_,I)).
2647 translate_inits2([]) --> !.
2648 translate_inits2([init(Name,Subst)|Rest]) -->
2649 indent('/* '),insertstr(Name),insertstr(': */ '),
2650 translate_subst_begin_end(Subst),
2651 translate_inits2(Rest).
2652
2653 translate_other_defpart(Defs) --> {print_additional_machine_info},!,
2654 mpstart('/* DEFINITIONS',P),translate_defs(Defs),insertstr(' */'),mpend(P).
2655 translate_other_defpart(_) --> [].
2656
2657 % pretty-print the definitions of a machine
2658 translate_defs([]) --> !.
2659 translate_defs([Def|Rest]) --> translate_def(Def),translate_defs(Rest).
2660 translate_def(definition_decl(Name,DefType,_Pos,Args,Expr,_Deps)) -->
2661 {def_description(DefType,Desc)}, indent(Desc),insertstr(Name),
2662 {transform_raw_list(Args,TArgs)},
2663 translate_op_params(TArgs),
2664 ( {show_def_body(Expr)}
2665 -> insertstr(' '),{translate_in_mode(eqeq,'==',EqEqStr)}, insertstr(EqEqStr), insertstr(' '),
2666 {transform_raw(Expr,TExpr)},
2667 (translate_def_body(DefType,TExpr) -> [] ; insertstr('CANNOT PRETTY PRINT'))
2668 ; {true}
2669 ),
2670 insertstr(';').
2671 def_description(substitution,'SUBSTITUTION ').
2672 def_description(expression,'EXPRESSION ').
2673 def_description(predicate,'PREDICATE ').
2674 translate_def_body(substitution,B) --> translate_subst_begin_end(B).
2675 translate_def_body(expression,B) --> indent_expr(B).
2676 translate_def_body(predicate,B) --> indent_expr(B).
2677
2678 show_def_body(integer(_,_)).
2679 show_def_body(boolean_true(_)).
2680 show_def_body(boolean_false(_)).
2681 % show_def_body(_) % comment in to pretty print all defs
2682
2683 ?set_pref_used(Defs) :- member(definition_decl(Name,_,_,[],_,_),Defs),
2684 (is_set_pref_def_name(Name,_,_) -> true).
2685
2686 is_set_pref_def_name(Name,Pref,CurValAtom) :-
2687 atom_codes(Name,Codes),append("SET_PREF_",RestCodes,Codes),
2688 atom_codes(Pref,RestCodes),
2689 (eclipse_preference(Pref,P) -> get_preference(P,CurVal), translate_pref_val(CurVal,CurValAtom)
2690 ; deprecated_eclipse_preference(Pref,_,NewP,Mapping) -> get_preference(NewP,V), member(CurVal/V,Mapping)
2691 ; get_preference(Pref,CurVal), translate_pref_val(CurVal,CurValAtom)),
2692 translate_pref_val(CurVal,CurValAtom).
2693 translate_pref_val(true,'TRUE').
2694 translate_pref_val(false,'FALSE').
2695 translate_pref_val(Nr,NrAtom) :- number(Nr),!, number_codes(Nr,C), atom_codes(NrAtom,C).
2696 translate_pref_val(Atom,Atom) :- atom(Atom).
2697
2698 is_set_pref(definition_decl(Name,_,_Pos,[],_Expr,_Deps)) :-
2699 is_set_pref_def_name(Name,_,_).
2700 translate_set_pref_defs(Defs) -->
2701 {include(is_set_pref,Defs,SPDefs),
2702 sort(SPDefs,SortedDefs)},
2703 translate_set_pref_defs1(SortedDefs).
2704 translate_set_pref_defs1([]) --> !.
2705 translate_set_pref_defs1([Def|Rest]) -->
2706 translate_set_pref_def(Def),translate_set_pref_defs1(Rest).
2707 translate_set_pref_def(definition_decl(Name,_,_Pos,[],_Expr,_Deps)) -->
2708 {is_set_pref_def_name(Name,_Pref,CurValAtom)},!,
2709 insertstr(' '),insertstr(Name),
2710 insertstr(' '),
2711 {translate_in_mode(eqeq,'==',EqEqStr)}, insertstr(EqEqStr), insertstr(' '),
2712 insertstr(CurValAtom), % pretty print current value; Expr could be a more complicated non-atomic expression
2713 insertstr(';\n').
2714 translate_set_pref_def(_) --> [].
2715
2716 standard_library_required(Defs,Library) :-
2717 ? member(Decl,Defs),
2718 definition_decl_from_library(Decl,Library).
2719
2720 % TODO: we could also look in the list of loaded files and search for standard libraries
2721 definition_decl_from_library(definition_decl(printf,predicate,_,[_,_],_,_Deps),'LibraryIO.def').
2722 definition_decl_from_library(definition_decl('STRING_IS_DECIMAL',predicate,_,[_],_,_Deps),'LibraryStrings.def').
2723 definition_decl_from_library(definition_decl('SHA_HASH',expression,_,[_],_,_Deps),'LibraryHash.def').
2724 definition_decl_from_library(definition_decl('CHOOSE',expression,_,[_],_,_Deps),'CHOOSE.def').
2725 definition_decl_from_library(definition_decl('SCCS',expression,_,[_],_,_Deps),'SCCS.def').
2726 definition_decl_from_library(definition_decl('SORT',expression,_,[_],_,_Deps),'SORT.def').
2727 definition_decl_from_library(definition_decl('random_element',expression,_,[_],_,_Deps),'LibraryRandom.def').
2728 definition_decl_from_library(definition_decl('SIN',expression,_,[_],_,_Deps),'LibraryMath.def').
2729 definition_decl_from_library(definition_decl('RMUL',expression,_,[_,_],_,_Deps),'LibraryReals.def').
2730 definition_decl_from_library(definition_decl('REGEX_MATCH',predicate,_,[_,_],_,_Deps),'LibraryRegex.def').
2731 definition_decl_from_library(definition_decl('ASSERT_EXPR',expression,_,[_,_,_],_,_Deps),'LibraryProB.def').
2732 definition_decl_from_library(definition_decl('svg_points',expression,_,[_],_,_Deps),'LibrarySVG.def').
2733 definition_decl_from_library(definition_decl('FULL_FILES',expression,_,[_],_,_Deps),'LibraryFiles.def').
2734 definition_decl_from_library(definition_decl('READ_XML_FROM_STRING',expression,_,[_],_,_Deps),'LibraryXML.def').
2735 definition_decl_from_library(definition_decl('READ_CSV',expression,_,[_],_,_Deps),'LibraryCSV.def').
2736
2737 insert_library_usages([]) --> [].
2738 insert_library_usages([Library|T]) -->
2739 insertstr(' "'),insertstr(Library),insertstr('";\n'), % insert inclusion of ProB standard library
2740 insert_library_usages(T).
2741
2742 % ------------- RAW EXPRESSIONS
2743
2744 % try and print raw machine term or parts thereof (e.g. sections)
2745 print_raw_machine_terms(Var) :- var(Var), !,print('VAR !!'),nl.
2746 print_raw_machine_terms([]) :- !.
2747 print_raw_machine_terms([H|T]) :- !,
2748 print_raw_machine_terms(H), print(' '),
2749 print_raw_machine_terms(T).
2750 print_raw_machine_terms(Term) :- raw_machine_term(Term,String,Sub),!,
2751 format('~n~w ',[String]),
2752 print_raw_machine_terms(Sub),nl.
2753 print_raw_machine_terms(expression_definition(A,B,C,D)) :- !,
2754 print_raw_machine_terms(predicate_definition(A,B,C,D)).
2755 print_raw_machine_terms(substitution_definition(A,B,C,D)) :- !,
2756 print_raw_machine_terms(predicate_definition(A,B,C,D)).
2757 print_raw_machine_terms(predicate_definition(_,Name,Paras,RHS)) :-
2758 Paras==[],!,
2759 format('~n ~w == ',[Name]),
2760 print_raw_machine_terms(RHS),nl.
2761 print_raw_machine_terms(predicate_definition(_,Name,Paras,RHS)) :- !,
2762 format('~n ~w(',[Name]),
2763 print_raw_machine_terms_sep(Paras,','),
2764 format(') == ',[]),
2765 print_raw_machine_terms(RHS),nl.
2766 print_raw_machine_terms(operation(_,Name,Return,Paras,RHS)) :- !,
2767 format('~n ',[]),
2768 (Return=[] -> true
2769 ; print_raw_machine_terms_sep(Return,','),
2770 format(' <-- ',[])
2771 ),
2772 print_raw_machine_terms(Name),
2773 (Paras=[] -> true
2774 ; format(' (',[]),
2775 print_raw_machine_terms_sep(Paras,','),
2776 format(')',[])
2777 ),
2778 format(' = ',[]),
2779 print_raw_machine_terms(RHS),nl.
2780 print_raw_machine_terms(Term) :- print_raw_bexpr(Term).
2781
2782
2783 print_raw_machine_terms_sep([],_) :- !.
2784 print_raw_machine_terms_sep([H],_) :- !,
2785 print_raw_machine_terms(H).
2786 print_raw_machine_terms_sep([H|T],Sep) :- !,
2787 print_raw_machine_terms(H),print(Sep),print_raw_machine_terms_sep(T,Sep).
2788
2789 raw_machine_term(machine(M),'',M).
2790 raw_machine_term(generated(_,M),'',M).
2791 raw_machine_term(machine_header(_,Name,_Params),Name,[]). % TO DO: treat Params
2792 raw_machine_term(abstract_machine(_,_,Header,M),'MACHINE',[Header,M]).
2793 raw_machine_term(properties(_,P),'PROPERTIES',P).
2794 raw_machine_term(operations(_,P),'OPERATIONS',P).
2795 raw_machine_term(definitions(_,P),'DEFINITIONS',P).
2796 raw_machine_term(constants(_,P),'CONSTANTS',P).
2797 raw_machine_term(variables(_,P),'VARIABLES',P).
2798 raw_machine_term(invariant(_,P),'INVARIANT',P).
2799 raw_machine_term(assertions(_,P),'ASSERTIONS',P).
2800 raw_machine_term(constraints(_,P),'CONSTRAINTS',P).
2801 raw_machine_term(sets(_,P),'SETS',P).
2802 raw_machine_term(deferred_set(_,P),P,[]). % TO DO: enumerated_set ...
2803 %raw_machine_term(identifier(_,P),P,[]).
2804
2805 l_print_raw_bexpr([]).
2806 l_print_raw_bexpr([Raw|T]) :- write(' '),
2807 print_raw_bexpr(Raw),nl, l_print_raw_bexpr(T).
2808
2809 print_raw_bexpr(Raw) :- % a tool (not perfect) to print raw ASTs
2810 transform_raw(Raw,TExpr),!,
2811 print_bexpr_or_subst(TExpr).
2812
2813 translate_raw_bexpr_with_limit(Raw,Limit,TS) :- transform_raw(Raw,TExpr),
2814 translate_subst_or_bexpr_with_limit(TExpr,Limit,TS).
2815
2816 transform_raw_list(Var,Res) :- var(Var),!,
2817 add_internal_error('Var raw expression list:',transform_raw_list(Var,Res)),
2818 Res= [b(identifier('$$VARIABLE_LIST$$'),any,[raw])].
2819 transform_raw_list(Args,TArgs) :- maplist(transform_raw,Args,TArgs).
2820
2821
2822 transform_raw(Var,Res) :- %print(raw(Var)),nl,
2823 var(Var), !, add_internal_error('Var raw expression:',transform_raw(Var,Res)),
2824 Res= b(identifier('$$VARIABLE$$'),any,[raw]).
2825 transform_raw(precondition(_,Pre,Body),Res) :- !, Res= b(precondition(TP,TB),subst,[raw]),
2826 transform_raw(Pre,TP),
2827 transform_raw(Body,TB).
2828 transform_raw(typeof(_,E,_Type),Res) :- !, transform_raw(E,Res). % remove typeof operator; TODO: transform
2829 transform_raw(identifier(_,M),Res) :- !, Res= b(identifier(M),any,[raw]).
2830 transform_raw(integer(_,M),Res) :- !, Res= b(integer(M),integer,[raw]).
2831 % rules from btype_rewrite2:
2832 transform_raw(integer_set(_),Res) :- !, generate_typed_int_set('INTEGER',Res).
2833 transform_raw(natural_set(_),Res) :- !, generate_typed_int_set('NATURAL',Res).
2834 transform_raw(natural1_set(_),Res) :- !, generate_typed_int_set('NATURAL1',Res).
2835 transform_raw(nat_set(_),Res) :- !, generate_typed_int_set('NAT',Res).
2836 transform_raw(nat1_set(_),Res) :- !, generate_typed_int_set('NAT1',Res).
2837 transform_raw(int_set(_),Res) :- !, generate_typed_int_set('INT',Res).
2838 transform_raw(let_expression(_,_Ids,Eq,Body),Res) :- !,
2839 transform_raw(conjunct(_,Eq,Body),Res). % TO DO: fix and generate let_expression(Ids,ListofExprs,Body)
2840 transform_raw(let_predicate(_,_Ids,Eq,Body),Res) :- !,
2841 transform_raw(conjunct(_,Eq,Body),Res). % ditto
2842 transform_raw(forall(_,Ids,Body),Res) :- !,
2843 (Body=implication(_,LHS,RHS) -> true ; LHS=truth,RHS=Body),
2844 transform_raw(forall(_,Ids,LHS,RHS),Res).
2845 transform_raw(record_field(_,Rec,identifier(_,Field)),Res) :- !, Res = b(record_field(TRec,Field),any,[]),
2846 transform_raw(Rec,TRec).
2847 transform_raw(rec_entry(_,identifier(_,Field),Rec),Res) :- !, Res = field(Field,TRec),
2848 transform_raw(Rec,TRec).
2849 transform_raw(conjunct(_,List),Res) :- !,
2850 transform_raw_list_to_conjunct(List,Res). % sometimes conjunct/1 with list is used (e.g., .eventb files)
2851 transform_raw(couple(_,L),Res) :- !, transform_raw_list_to_couple(L,Res). % couples are represented by lists
2852 transform_raw(extended_expr(Pos,Op,L,_TypeParas),Res) :- !,
2853 (L=[] -> transform_raw(identifier(none,Op),Res) % no arguments
2854 ; transform_raw(function(Pos,identifier(none,Op),L),Res)).
2855 transform_raw(extended_pred(Pos,Op,L,_TypeParas),Res) :- !,
2856 transform_raw(function(Pos,identifier(none,Op),L),Res). % not of correct type pred, but seems to work
2857 transform_raw(external_function_call_auto(Pos,Name,Para),Res) :- !,
2858 transform_raw(external_function_call(Pos,Name,Para),Res). % we assume expr rather than pred and hope for the best
2859 transform_raw(function(_,F,L),Res) :- !, transform_raw(F,TF),
2860 Res = b(function(TF,Args),any,[]),
2861 transform_raw_list_to_couple(L,Args). % args are represented by lists
2862 transform_raw(Atom,Res) :- atomic(Atom),!,Res=Atom.
2863 transform_raw([H|T],Res) :- !, maplist(transform_raw,[H|T],Res).
2864 transform_raw(Symbolic,Res) :- symbolic_raw(Symbolic,Body),!,
2865 transform_raw(Body,Res).
2866 transform_raw(OtherOp,b(Res,Type,[])) :- OtherOp =..[F,_Pos|Rest],
2867 maplist(transform_raw,Rest,TRest),
2868 (get_type(F,FT) -> Type=FT ; Type=any),
2869 Res =.. [F|TRest].
2870 transform_raw_list_to_couple([R],Res) :- !, transform_raw(R,Res).
2871 transform_raw_list_to_couple([R1|T],Res) :- !, Res=b(couple(TR1,TT),any,[]),
2872 transform_raw(R1,TR1),transform_raw_list_to_couple(T,TT).
2873 transform_raw_list_to_conjunct([R],Res) :- !, transform_raw(R,Res).
2874 transform_raw_list_to_conjunct([R1|T],Res) :- !, Res=b(conjunct(TR1,TT),pred,[]),
2875 transform_raw(R1,TR1),transform_raw_list_to_conjunct(T,TT).
2876 generate_typed_int_set(Name,b(integer_set(Name),set(integer),[])).
2877 get_type(conjunct,pred).
2878 get_type(disjunct,pred).
2879 get_type(implication,pred).
2880 get_type(equivalence,pred).
2881 get_type(member,pred).
2882 get_type(equal,pred).
2883 get_type(not_equal,pred).
2884 get_type(not_member,pred).
2885 get_type(subset,pred).
2886 get_type(not_subset,pred).
2887
2888 symbolic_raw(symbolic_composition(A,B,C),composition(A,B,C)).
2889 symbolic_raw(symbolic_comprehension_set(A,B,C),comprehension_set(A,B,C)).
2890 symbolic_raw(symbolic_lambda(A,B,C,D),lambda(A,B,C,D)).
2891 symbolic_raw(symbolic_quantified_union(A,B,C,D),quantified_union(A,B,C,D)).
2892
2893 % -------------
2894
2895
2896 % pretty-print the operations of a machine
2897 translate_ops([]) --> !.
2898 translate_ops([Op|Rest]) -->
2899 translate_op(Op),
2900 ({Rest=[]} -> {true}; insertstr(';'),indent),
2901 translate_ops(Rest).
2902 translate_op(Op) -->
2903 { get_texpr_expr(Op,operation(Id,Res,Params,Body)) },
2904 translate_operation(Id,Res,Params,Body).
2905 translate_operation(Id,Res,Params,Body) -->
2906 indent,translate_op_results(Res),
2907 pp_expr_indent(Id),
2908 translate_op_params(Params),
2909 insertstr(' = '),
2910 indention_level(I1,I2),{I2 is I1+2,type_infos_in_subst(Params,Body,Body2)},
2911 translate_subst_begin_end(Body2),
2912 indention_level(_,I1).
2913 translate_op_results([]) --> !.
2914 translate_op_results(Ids) --> pp_expr_indent_l(Ids), insertstr(' <-- ').
2915 translate_op_params([]) --> !.
2916 translate_op_params(Ids) --> insertstr('('),pp_expr_indent_l(Ids), insertstr(')').
2917
2918 translate_subst_begin_end(TSubst) -->
2919 {get_texpr_expr(TSubst,Subst),subst_needs_begin_end(Subst),
2920 create_texpr(block(TSubst),subst,[],Block)},!,
2921 translate_subst(Block).
2922 translate_subst_begin_end(Subst) -->
2923 translate_subst(Subst).
2924
2925 subst_needs_begin_end(assign(_,_)).
2926 subst_needs_begin_end(assign_single_id(_,_)).
2927 subst_needs_begin_end(parallel(_)).
2928 subst_needs_begin_end(sequence(_)).
2929 subst_needs_begin_end(operation_call(_,_,_)).
2930
2931 type_infos_in_subst([],Subst,Subst) :- !.
2932 type_infos_in_subst(Ids,SubstIn,SubstOut) :-
2933 get_preference(translate_print_typing_infos,true),!,
2934 type_infos_in_subst2(Ids,SubstIn,SubstOut).
2935 type_infos_in_subst(_Ids,Subst,Subst).
2936 type_infos_in_subst2(Ids,SubstIn,SubstOut) :-
2937 get_texpr_expr(SubstIn,precondition(P1,S)),!,
2938 get_texpr_info(SubstIn,Info),
2939 create_texpr(precondition(P2,S),pred,Info,SubstOut),
2940 add_typing_predicates(Ids,P1,P2).
2941 type_infos_in_subst2(Ids,SubstIn,SubstOut) :-
2942 create_texpr(precondition(P,SubstIn),pred,[],SubstOut),
2943 generate_typing_predicates(Ids,Typing),
2944 conjunct_predicates(Typing,P).
2945
2946
2947
2948
2949
2950 % pretty-print the internal section about included and used machines
2951 translate_used([]) --> !.
2952 translate_used([Used|Rest]) -->
2953 translate_used2(Used),
2954 translate_used(Rest).
2955 translate_used2(includeduse(Name,Id,NewTExpr)) -->
2956 indent,pp_expr_indent(NewTExpr),
2957 insertstr(' --> '), insertstr(Name), insertstr(':'), insertstr(Id).
2958
2959 % pretty-print the internal information about freetypes
2960 translate_freetypes([]) --> !.
2961 translate_freetypes([Freetype|Frest]) -->
2962 translate_freetype(Freetype),
2963 translate_freetypes(Frest).
2964 translate_freetype(freetype(Name,Cases)) -->
2965 {pretty_freetype(Name,PName)},
2966 indent(PName),insertstr('= '),
2967 indention_level(I1,I2),{I2 is I1+2},
2968 translate_freetype_cases(Cases),
2969 indention_level(_,I1).
2970 translate_freetype_cases([]) --> !.
2971 translate_freetype_cases([case(Name,Type)|Rest]) --> {nonvar(Type),Type=constant(_)},
2972 !,indent(Name),insert_comma(Rest),
2973 translate_freetype_cases(Rest).
2974 translate_freetype_cases([case(Name,Type)|Rest]) -->
2975 {pretty_type(Type,PT)},
2976 indent(Name),
2977 insertstr('('),insertstr(PT),insertstr(')'),
2978 insert_comma(Rest),
2979 translate_freetype_cases(Rest).
2980
2981 insert_comma([]) --> [].
2982 insert_comma([_|_]) --> insertstr(',').
2983
2984 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2985 % substitutions
2986
2987 translate_subst_or_bexpr(Stmt,String) :- get_texpr_type(Stmt,subst),!,
2988 translate_substitution(Stmt,String).
2989 translate_subst_or_bexpr(ExprOrPred,String) :-
2990 translate_bexpression(ExprOrPred,String).
2991
2992 translate_subst_or_bexpr_with_limit(Stmt,Limit,String) :-
2993 translate_subst_or_bexpr_with_limit(Stmt,Limit,report_errors,String).
2994 translate_subst_or_bexpr_with_limit(Stmt,_Limit,ReportErrors,String) :- get_texpr_type(Stmt,subst),!,
2995 translate_substitution(Stmt,String,ReportErrors). % TO DO: use limit
2996 translate_subst_or_bexpr_with_limit(ExprOrPred,Limit,ReportErrors,String) :-
2997 translate_bexpression_with_limit(ExprOrPred,Limit,ReportErrors,String).
2998
2999 print_subst(Stmt) :- translate_substitution(Stmt,T), print(T).
3000 translate_substitution(Stmt,String) :- translate_substitution(Stmt,String,report_errors).
3001 translate_substitution(Stmt,String,_) :-
3002 translate_subst_with_indention(Stmt,0,Codes,[]),
3003 (Codes = [10|C] -> true ; Codes=[13|C] -> true ; Codes=C), % peel off leading newline
3004 atom_codes_with_limit(String, C),!.
3005 translate_substitution(Stmt,String,report_errors) :-
3006 add_error(translate_substitution,'Could not translate substitution: ',Stmt),
3007 String='???'.
3008
3009 translate_subst_with_indention(TS,Indention,I,O) :-
3010 translate_subst(TS,(Indention,I),(_,O)).
3011 translate_subst_with_indention_and_label(TS,Indention,I,O) :-
3012 translate_subst_with_label(TS,(Indention,I),(_,O)).
3013
3014 translate_subst(TS) -->
3015 ( {get_texpr_expr(TS,S)} ->
3016 translate_subst2(S)
3017 ; translate_subst2(TS)).
3018
3019 translate_subst_with_label(TS) -->
3020 ( {get_texpr_expr(TS,S)} ->
3021 indent_rodin_label(TS), % pretty print substitution labels
3022 translate_subst2(S)
3023 ; translate_subst2(TS)).
3024
3025 % will print (first) rodin or pragma label indendent
3026 :- public indent_rodin_label/3.
3027 indent_rodin_label(_TExpr) --> {get_preference(translate_suppress_rodin_positions_flag,true),!}.
3028 indent_rodin_label(_TExpr) --> {get_preference(bugly_pp_scrambling,true),!}.
3029 indent_rodin_label(TExpr) --> {get_texpr_labels(TExpr,Names)},!, % note: this will only get the first label
3030 indent('/* @'),pp_ids_indent(Names),insertstr('*/ '). % this Camille syntax cannot be read back in by B parser
3031 indent_rodin_label(_TExpr) --> [].
3032
3033 pp_ids_indent([]) --> !, [].
3034 pp_ids_indent([ID]) --> !,pp_expr_indent(identifier(ID)).
3035 pp_ids_indent([ID|T]) --> !,pp_expr_indent(identifier(ID)), insertstr(' '),pp_ids_indent(T).
3036 pp_ids_indent(X) --> {add_error(pp_ids_indent,'Not a list of atoms: ',pp_ids_indent(X))}.
3037
3038 translate_subst2(skip) -->
3039 indent(skip).
3040 translate_subst2(operation(Id,Res,Params,Body)) --> translate_operation(Id,Res,Params,Body). % not really a substition that can appear normally
3041 translate_subst2(precondition(P,S)) -->
3042 indent('PRE '), pred_over_lines(2,'@grd',P), indent('THEN'), insert_subst(S), indent('END').
3043 translate_subst2(assertion(P,S)) -->
3044 indent('ASSERT '), pp_expr_indent(P), indent('THEN'), insert_subst(S), indent('END').
3045 translate_subst2(block(S)) -->
3046 indent('BEGIN'), insert_subst(S), indent('END').
3047 translate_subst2(assign([L],[R])) --> !,
3048 indent,pp_expr_indent(L),insertstr(' := '),pp_expr_indent(R).
3049 translate_subst2(assign(L,R)) -->
3050 ? {(member(b(E,_,_),R), can_indent_expr(E)
3051 -> maplist(create_assign,L,R,ParAssigns))},!, % split into parallel assignments so that we can indent
3052 translate_subst2(parallel(ParAssigns)).
3053 translate_subst2(assign(L,R)) -->
3054 indent,pp_expr_indent_l(L),insertstr(' := '),pp_expr_indent_l(R).
3055 translate_subst2(assign_single_id(L,R)) -->
3056 translate_subst2(assign([L],[R])).
3057 translate_subst2(becomes_element_of(L,R)) -->
3058 indent,pp_expr_indent_l(L),insertstr(' :: '),pp_expr_indent(R).
3059 translate_subst2(becomes_such(L,R)) -->
3060 indent,pp_expr_indent_l(L),insertstr(' : '), insertstr('('),
3061 { add_optional_typing_predicates(L,R,R1) },
3062 pp_expr_indent(R1), insertstr(')').
3063 translate_subst2(evb2_becomes_such(L,R)) --> translate_subst2(becomes_such(L,R)).
3064 translate_subst2(if([Elsif|Rest])) -->
3065 { get_if_elsif(Elsif,P,S) },
3066 indent('IF '), pp_expr_indent(P), insertstr(' THEN'),
3067 insert_subst(S),
3068 translate_ifs(Rest).
3069 translate_subst2(if_elsif(P,S)) --> % not a legal top-level construct; but can be called in b_portray_hook
3070 indent('IF '), pp_expr_indent(P), insertstr(' THEN'),
3071 insert_subst(S),
3072 indent('END').
3073 translate_subst2(choice(Ss)) --> indent(' CHOICE'),
3074 split_over_lines(Ss,'OR'),
3075 indent('END'). % indentation seems too far
3076 translate_subst2(parallel(Ss)) -->
3077 split_over_lines(Ss,'||').
3078 translate_subst2(init_statement(S)) --> insert_subst(S).
3079 translate_subst2(sequence(Ss)) -->
3080 split_over_lines(Ss,';').
3081 translate_subst2(operation_call(Id,Rs,As)) -->
3082 indent,translate_op_results(Rs),
3083 pp_expr_indent(Id),
3084 translate_op_params(As).
3085 translate_subst2(identifier(op(Id))) --> % shouldn't normally appear
3086 indent,pp_expr_indent(identifier(Id)).
3087 translate_subst2(external_subst_call(Symbol,Args)) -->
3088 indent,
3089 pp_expr_indent(identifier(Symbol)),
3090 translate_op_params(Args).
3091 translate_subst2(any(Ids,Pred,Subst)) -->
3092 indent('ANY '), pp_expr_indent_l(Ids),
3093 indent('WHERE '),
3094 {add_optional_typing_predicates(Ids,Pred,Pred2)},
3095 pred_over_lines(2,'@grd',Pred2), indent('THEN'),
3096 insert_subst(Subst),
3097 indent('END').
3098 translate_subst2(select(Whens)) -->
3099 translate_whens(Whens,'SELECT '),
3100 indent('END').
3101 translate_subst2(select_when(Cond,Then)) --> % not a legal top-level construct; but can be called in b_portray_hook
3102 indent('WHEN'),
3103 pp_expr_indent(Cond),
3104 indent('THEN'),
3105 insert_subst(Then),
3106 indent('END').
3107 translate_subst2(select(Whens,Else)) -->
3108 translate_whens(Whens,'SELECT '),
3109 indent('ELSE'), insert_subst(Else),
3110 indent('END').
3111 translate_subst2(var(Ids,S)) -->
3112 indent('VAR '),
3113 pp_expr_indent_l(Ids),
3114 indent('IN'),insert_subst(S),
3115 indent('END').
3116 translate_subst2(let(Ids,P,S)) -->
3117 indent('LET '),
3118 pp_expr_indent_l(Ids),
3119 insertstr(' BE '), pp_expr_indent(P),
3120 indent('IN'), insert_subst(S),
3121 indent('END').
3122 translate_subst2(lazy_let_subst(TID,P,S)) -->
3123 indent('LET '),
3124 pp_expr_indent_l([TID]),
3125 insertstr(' BE '), pp_expr_indent(P), % could be expr or pred
3126 indent('IN'), insert_subst(S),
3127 indent('END').
3128 translate_subst2(case(Expression,Cases,ELSE)) -->
3129 % CASE E OF EITHER m THEN G OR n THEN H ... ELSE I END END
3130 indent('CASE '),
3131 pp_expr_indent(Expression), insertstr(' OF'),
3132 indent('EITHER '), translate_cases(Cases),
3133 indent('ELSE '), insert_subst(ELSE), % we could drop this if ELSE is skip ?
3134 indent('END END').
3135 translate_subst2(while(Pred,Subst,Inv,Var)) -->
3136 indent('WHILE '), pp_expr_indent(Pred),
3137 indent('DO'),insert_subst(Subst),
3138 indent('INVARIANT '),pp_expr_indent(Inv),
3139 indent('VARIANT '),pp_expr_indent(Var),
3140 indent('END').
3141 translate_subst2(while1(Pred,Subst,Inv,Var)) -->
3142 indent('WHILE /* 1 */ '), pp_expr_indent(Pred),
3143 indent('DO'),insert_subst(Subst),
3144 indent('INVARIANT '),pp_expr_indent(Inv),
3145 indent('VARIANT '),pp_expr_indent(Var),
3146 indent('END').
3147 translate_subst2(rlevent(Id,Section,Status,Parameters,Guard,Theorems,Actions,VWitnesses,PWitnesses,_Unmod,Refines)) -->
3148 indent,
3149 insert_status(Status),
3150 insertstr('EVENT '),
3151 ({Id = 'INITIALISATION'}
3152 -> [] % avoid BLexer error in ProB2-UI, BLexerException: Invalid combination of symbols: 'INITIALISATION' and '='.
3153 ; insertstr(Id), insertstr(' = ')),
3154 insertstr('/'), insertstr('* of machine '),
3155 insertstr(Section),insertstr(' */'),
3156 insert_variant(Status),
3157 ( {Parameters=[], get_texpr_expr(Guard,truth)} ->
3158 {NoGuard=true} % indent('BEGIN ')
3159 ; {Parameters=[]} ->
3160 indent('WHEN '),
3161 pred_over_lines(2,'@grd',Guard)
3162 ;
3163 indent('ANY '),pp_expr_indent_l(Parameters),
3164 indent('WHERE '),
3165 pred_over_lines(2,'@grd',Guard)
3166 ),
3167 ( {VWitnesses=[],PWitnesses=[]} ->
3168 []
3169 ;
3170 {append(VWitnesses,PWitnesses,Witnesses)},
3171 indent('WITH '),pp_witness_l(Witnesses)
3172 ),
3173 {( Actions=[] ->
3174 create_texpr(skip,subst,[],Subst)
3175 ;
3176 create_texpr(parallel(Actions),subst,[],Subst)
3177 )},
3178 ( {Theorems=[]} -> {true}
3179 ;
3180 indent('THEOREMS '),
3181 preds_over_lines(2,'@thm',Theorems)
3182 ),
3183 ({NoGuard==true}
3184 -> indent('BEGIN ') % avoid BLexer errors in ProB2-UI Syntax highlighting
3185 ; indent('THEN ')
3186 ),
3187 insert_subst(Subst),
3188 pp_refines_l(Refines,Id),
3189 indent('END').
3190
3191 % translate cases of a CASE statement
3192 translate_cases([]) --> !,[].
3193 translate_cases([CaseOr|T]) -->
3194 {get_texpr_expr(CaseOr,case_or(Exprs,Subst))},!,
3195 pp_expr_indent_l(Exprs),
3196 insertstr(' THEN '),
3197 insert_subst(Subst),
3198 ({T==[]} -> {true}
3199 ; indent('OR '), translate_cases(T)).
3200 translate_cases(L) -->
3201 {add_internal_error('Cannot translate CASE list: ',translate_cases(L,_,_))}.
3202
3203 insert_status(TStatus) -->
3204 {get_texpr_expr(TStatus,Status),
3205 status_string(Status,String)},
3206 insertstr(String).
3207 status_string(ordinary,'').
3208 status_string(anticipated(_),'ANTICIPATED ').
3209 status_string(convergent(_),'CONVERGENT ').
3210
3211 insert_variant(TStatus) -->
3212 {get_texpr_expr(TStatus,Status)},
3213 insert_variant2(Status).
3214 insert_variant2(ordinary) --> !.
3215 insert_variant2(anticipated(Variant)) --> insert_variant3(Variant).
3216 insert_variant2(convergent(Variant)) --> insert_variant3(Variant).
3217 insert_variant3(Variant) -->
3218 indent('USING VARIANT '),pp_expr_indent(Variant).
3219
3220 pp_refines_l([],_) --> [].
3221 pp_refines_l([Ref|Rest],Id) -->
3222 pp_refines(Ref,Id),pp_refines_l(Rest,Id).
3223 pp_refines(Refined,_Id) -->
3224 % indent(Id), insertstr(' REFINES '),
3225 indent('REFINES '),
3226 insert_subst(Refined).
3227
3228 pp_witness_l([]) --> [].
3229 pp_witness_l([Witness|WRest]) -->
3230 pp_witness(Witness),pp_witness_l(WRest).
3231 pp_witness(Expr) -->
3232 indention_level(I1,I2),
3233 {get_texpr_expr(Expr,witness(Id,Pred)),
3234 I2 is I1+2},
3235 indent, pp_expr_indent(Id), insertstr(': '),
3236 pp_expr_indent(Pred),
3237 indention_level(_,I1).
3238
3239
3240 translate_whens([],_) --> !.
3241 translate_whens([When|Rest],T) -->
3242 {get_texpr_expr(When,select_when(P,S))},!,
3243 indent(T), pred_over_lines(2,'@grd',P),
3244 indent('THEN '),
3245 insert_subst(S),
3246 translate_whens(Rest,'WHEN ').
3247 translate_whens(L,_) -->
3248 {add_internal_error('Cannot translate WHEN: ',translate_whens(L,_,_,_))}.
3249
3250
3251
3252 create_assign(LHS,RHS,b(assign([LHS],[RHS]),subst,[])).
3253
3254 split_over_lines([],_) --> !.
3255 split_over_lines([S|Rest],Symbol) --> !,
3256 indention_level(I1,I2),{atom_codes(Symbol,X),length(X,N),I2 is I1+N+1},
3257 translate_subst_check(S),
3258 split_over_lines2(Rest,Symbol,I1,I2).
3259 split_over_lines(S,Symbol) --> {add_error(split_over_lines,'Illegal argument: ',Symbol:S)}.
3260
3261 split_over_lines2([],_,_,_) --> !.
3262 split_over_lines2([S|Rest],Symbol,I1,I2) -->
3263 indention_level(_,I1), indent(Symbol),
3264 indention_level(_,I2), translate_subst(S),
3265 split_over_lines2(Rest,Symbol,I1,I2).
3266
3267 % print a predicate over several lines, at most one conjunct per line
3268 % N is the increment that should be added to the indentation
3269 %pred_over_lines(N,Pred) --> pred_over_lines(N,'@pred',Pred).
3270 pred_over_lines(N,Lbl,Pred) -->
3271 {conjunction_to_list(Pred,List)},
3272 preds_over_lines(N,Lbl,List).
3273 section_pred_over_lines(N,Title,Pred) -->
3274 ({get_eventb_default_label(Title,Lbl)} -> [] ; {Lbl='@pred'}),
3275 pred_over_lines(N,Lbl,Pred).
3276 get_eventb_default_label(properties,'@axm').
3277 get_eventb_default_label(assertions,'@thm').
3278
3279 % print a list of predicates over several lines, at most one conjunct per line
3280 preds_over_lines(N,Lbl,Preds) --> preds_over_lines(N,Lbl,'& ',Preds).
3281 % preds_over_lines(IndentationIncrease,EventBDefaultLabel,ClassicalBSeperator,ListOfPredicates)
3282 preds_over_lines(N,Lbl,Sep,Preds) -->
3283 indention_level(I1,I2),{I2 is I1+N},
3284 preds_over_lines1(Preds,Lbl,1,Sep),
3285 indention_level(_,I1).
3286 preds_over_lines1([],Lbl,Nr,Sep) --> !,
3287 preds_over_lines1([b(truth,pred,[])],Lbl,Nr,Sep).
3288 preds_over_lines1([H|T],Lbl,Nr,Sep) -->
3289 indent(' '), pp_label(Lbl,Nr),
3290 %({T==[]} -> pp_expr_indent(H) ; pp_expr_m_indent(H,40)),
3291 ({T==[]} -> pp_pred_nested(H,conjunct,0) ; pp_pred_nested(H,conjunct,40)),
3292 {N1 is Nr+1},
3293 preds_over_lines2(T,Lbl,N1,Sep).
3294 preds_over_lines2([],_,_,_Sep) --> !.
3295 preds_over_lines2([E|Rest],Lbl,Nr,Sep) -->
3296 ({force_eventb_rodin_mode} -> indent(' '), pp_label(Lbl,Nr) ; indent(Sep)),
3297 pp_pred_nested(E,conjunct,40),
3298 {N1 is Nr+1},
3299 preds_over_lines2(Rest,Lbl,N1,Sep).
3300
3301 % print event-b label for Rodin/Camille:
3302 pp_label(Lbl,Nr) -->
3303 ({force_eventb_rodin_mode}
3304 -> {atom_codes(Lbl,C1), number_codes(Nr,NC), append(C1,NC,AC), atom_codes(A,AC)},
3305 pp_atom_indent(A), pp_atom_indent(' ')
3306 ; []).
3307
3308 % a version of nested_print_bexpr / nbp that does not directly print to stream conjunct
3309 pp_pred_nested(TExpr,CurrentType,_) --> {TExpr = b(E,pred,_)},
3310 {get_binary_connective(E,NewType,Ascii,LHS,RHS), binary_infix(NewType,Ascii,Prio,left)},
3311 !,
3312 pp_rodin_label_indent(TExpr), % print any label
3313 inc_lvl(CurrentType,NewType),
3314 pp_pred_nested(LHS,NewType,Prio),
3315 {translate_in_mode(NewType,Ascii,Symbol)},
3316 indent(' '),pp_atom_indent(Symbol),
3317 indent(' '),
3318 {(is_associative(NewType) -> NewTypeR=NewType % no need for parentheses if same operator on right
3319 ; NewTypeR=right(NewType))},
3320 pp_pred_nested(RHS,NewTypeR,Prio),
3321 dec_lvl(CurrentType,NewType).
3322 pp_pred_nested(TExpr,_,_) --> {is_nontrivial_negation(TExpr,NExpr,InnerType,Prio)},
3323 !,
3324 pp_rodin_label_indent(TExpr), % print any label
3325 {translate_in_mode(negation,'not',Symbol)},
3326 pp_atom_indent(Symbol),
3327 inc_lvl(other,negation), % always need parentheses for negation
3328 pp_pred_nested(NExpr,InnerType,Prio),
3329 dec_lvl(other,negation).
3330 pp_pred_nested(TExpr,_,_) --> {TExpr = b(exists(Ids,RHS),pred,_)},
3331 !,
3332 pp_rodin_label_indent(TExpr), % print any label
3333 {translate_in_mode(exists,'#',FSymbol)},
3334 %indent(' '),
3335 pp_atom_indent(FSymbol),
3336 pp_expr_ids_in_mode_indent(Ids),pp_atom_indent('.'),
3337 inc_lvl(other,conjunct), % always need parentheses here
3338 {add_normal_typing_predicates(Ids,RHS,RHST), Prio=40}, % Prio of conjunction
3339 pp_pred_nested(RHST,conjunct,Prio),
3340 dec_lvl(other,conjunct).
3341 pp_pred_nested(TExpr,_,_) --> {TExpr = b(forall(Ids,LHS,RHS),pred,_)},
3342 !,
3343 pp_rodin_label_indent(TExpr), % print any label
3344 {translate_in_mode(forall,'!',FSymbol)},
3345 %indent(' '),
3346 pp_atom_indent(FSymbol),
3347 pp_expr_ids_in_mode_indent(Ids),pp_atom_indent('.'),
3348 inc_lvl(other,implication), % always need parentheses here
3349 {add_normal_typing_predicates(Ids,LHS,LHST), Prio=30}, % Prio of implication
3350 pp_pred_nested(LHST,implication,Prio),
3351 {translate_in_mode(implication,'=>',Symbol)},
3352 indent(' '),pp_atom_indent(Symbol),
3353 indent(' '),
3354 pp_pred_nested(RHS,right(implication),Prio),
3355 dec_lvl(other,implication).
3356 pp_pred_nested(TExpr,_,_) -->
3357 {\+ eventb_translation_mode,
3358 TExpr = b(let_predicate(Ids,Exprs,Body),pred,_)
3359 }, %Ids=[_]}, % TODO: enable printing with more than one id; see below
3360 !,
3361 pp_let_nested(Ids,Exprs,Body).
3362 pp_pred_nested(b(BOP,pred,_),_CurrentType,CurMinPrio) -->
3363 {indent_binary_predicate(BOP,LHS,RHS,OpStr),
3364 get_texpr_id(LHS,_),can_indent_texpr(RHS)},!,
3365 pp_expr_m_indent(LHS,CurMinPrio),
3366 insertstr(OpStr),
3367 increase_indentation_level(2),
3368 indent(''),
3369 pp_expr_indent(RHS), % only supports %, {}, bool which do not need parentheses
3370 decrease_indentation_level(2).
3371 pp_pred_nested(Expr,_CurrentType,CurMinPrio) --> {can_indent_texpr(Expr)},!,
3372 pp_expr_m_indent(Expr,CurMinPrio).
3373 pp_pred_nested(Expr,_CurrentType,CurMinPrio) --> pp_expr_m_indent(Expr,CurMinPrio).
3374
3375 indent_binary_predicate(equal(LHS,RHS),LHS,RHS,' = ').
3376 indent_binary_predicate(member(LHS,RHS),LHS,RHS,' : ').
3377
3378 pp_let_nested(Ids,Exprs,Body) -->
3379 indent('LET '),
3380 pp_expr_indent_l(Ids),
3381 insertstr(' BE '),
3382 {maplist(create_equality,Ids,Exprs,Equalities)},
3383 preds_over_lines(2,'@let_eq',Equalities),
3384 indent(' IN '),
3385 increase_indentation_level(2),
3386 pp_pred_nested(Body,let_predicate,40),
3387 decrease_indentation_level(2),
3388 indent(' END').
3389 pp_let_expr_nested(Ids,Exprs,Body) -->
3390 insertstr('LET '),
3391 pp_expr_indent_l(Ids),
3392 insertstr(' BE '),
3393 {maplist(create_equality,Ids,Exprs,Equalities)},
3394 preds_over_lines(2,'@let_eq',Equalities),
3395 indent('IN '),
3396 increase_indentation_level(2),
3397 pp_expr_indent(Body),
3398 decrease_indentation_level(2),
3399 indent('END').
3400
3401 is_nontrivial_negation(b(negation(NExpr),pred,_),NExpr,NewType,Prio) :-
3402 get_texpr_expr(NExpr,E),
3403 (E=negation(_) -> NewType=other,Prio=0
3404 ; get_binary_connective(E,NewType,Ascii,_,_),
3405 binary_infix(NewType,Ascii,Prio,_Assoc)).
3406
3407 pp_rodin_label_indent(b(_,_,Infos),(I,S),(I,T)) :- pp_rodin_label(Infos,S,T).
3408 % note: below we will print unnecessary parentheses in case of Atelier-B mode; but for readability it maye be better to add them
3409 inc_lvl(Old,New) --> {New=Old}, !,[].
3410 inc_lvl(_,_) --> pp_atom_indent('('), % not strictly necessary if higher_prio
3411 increase_indentation_level, indent(' ').
3412 dec_lvl(Old,New) --> {New=Old}, !,[].
3413 dec_lvl(_,_) --> decrease_indentation_level, indent(' '),pp_atom_indent(')').
3414
3415 is_associative(conjunct).
3416 is_associative(disjunct).
3417
3418 %higher_prio(conjunct,implication).
3419 %higher_prio(disjunct,implication).
3420 % priority of equivalence changes in Rodin vs Atelier-B, maybe better add parentheses
3421
3422 translate_ifs([]) --> !,
3423 indent('END').
3424 translate_ifs([Elsif]) -->
3425 {get_if_elsif(Elsif,P,S),
3426 optional_type(P,truth)},!,
3427 indent('ELSE'), insert_subst(S), indent('END').
3428 translate_ifs([Elsif|Rest]) -->
3429 {get_if_elsif(Elsif,P,S)},!,
3430 indent('ELSIF '), pp_expr_indent(P), insertstr(' THEN'),
3431 insert_subst(S),
3432 translate_ifs(Rest).
3433 translate_ifs(ElseList) -->
3434 {functor(ElseList,F,A),add_error(translate_ifs,'Could not translate IF-THEN-ELSE: ',F/A-ElseList),fail}.
3435
3436 get_if_elsif(Elsif,P,S) :-
3437 (optional_type(Elsif,if_elsif(P,S)) -> true
3438 ; add_internal_error('Is not an if_elsif:',get_if_elsif(Elsif,P,S)), fail).
3439
3440 insert_subst(S) -->
3441 indention_level(I,I2),{I2 is I+2},
3442 translate_subst_check(S),
3443 indention_level(_,I).
3444
3445 translate_subst_check(S) --> translate_subst(S),!.
3446 translate_subst_check(S) -->
3447 {b_functor(S,F,A),add_error(translate_subst,'Could not translate substitution: ',F/A-S),fail}.
3448
3449 b_functor(b(E,_,_),F,A) :- !,functor(E,F,A).
3450 b_functor(E,F,A) :- functor(E,F,A).
3451
3452 indent_expr(Expr) -->
3453 indent, pp_expr_indent(Expr).
3454 %indent_expr_l([]) --> !.
3455 %indent_expr_l([Expr|Rest]) -->
3456 % indent_expr(Expr), indent_expr_l(Rest).
3457 indent_expr_l_sep([],_) --> !.
3458 indent_expr_l_sep([Expr|Rest],Sep) -->
3459 indent_expr(Expr),
3460 {(Rest=[] -> RealSep='' ; RealSep=Sep)},
3461 insert_atom(RealSep), % the threaded argument is a pair, not directly a string !
3462 indent_expr_l_sep(Rest,Sep).
3463 %indention_level(L) --> indention_level(L,L).
3464 increase_indentation_level --> indention_level(L,New), {New is L+1}.
3465 increase_indentation_level(N) --> indention_level(L,New), {New is L+N}.
3466 decrease_indentation_level --> indention_level(L,New), {New is L-1}.
3467 decrease_indentation_level(N) --> indention_level(L,New), {New is L-N}.
3468 indention_level(Old,New,(Old,S),(New,S)).
3469 indention_codes(Old,New,(Indent,Old),(Indent,New)).
3470 indent --> indent('').
3471 indent(M,(I,S),(I,T)) :- indent2(I,M,S,T).
3472 indent2(Level,Msg) -->
3473 "\n",do_indention(Level),ppatom(Msg).
3474
3475 insert_atom(Sep,(I,S),(I,T)) :- ppatom(Sep,S,T).
3476
3477 insertstr(M,(I,S),(I,T)) :- ppterm(M,S,T).
3478 insertcodes(M,(I,S),(I,T)) :- ppcodes(M,S,T).
3479
3480 do_indention(0,T,R) :- !, R=T.
3481 do_indention(N,[32|I],O) :-
3482 N>0,N2 is N-1, do_indention(N2,I,O).
3483
3484 optional_type(Typed,Expr) :- get_texpr_expr(Typed,E),!,Expr=E.
3485 optional_type(Expr,Expr).
3486
3487 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3488 % expressions and predicates
3489
3490 % pretty-type an expression in an indent-environment
3491 % currently, the indent level is just thrown away
3492 % TODO: pp_expr_indent dom( comprehension_set ) / union ( ...)
3493 pp_expr_indent(b(comprehension_set(Ids,Body),_,_)) -->
3494 {\+ eventb_translation_mode, % TODO: also print in Event-B mode:
3495 detect_lambda_comprehension(Ids,Body, FrontIDs,LambdaBody,ToExpr)},
3496 {add_normal_typing_predicates(FrontIDs,LambdaBody,TLambdaBody)},
3497 !,
3498 insertstr('%('), % to do: use lambda_symbol and improve layout below
3499 pp_expr_indent_l(FrontIDs),
3500 insertstr(') . ('),
3501 pred_over_lines(2,'@body',TLambdaBody),
3502 indent(' | '), increase_indentation_level(2),
3503 indent(''), pp_expr_indent(ToExpr), decrease_indentation_level(2),
3504 indent(')').
3505 pp_expr_indent(b(comprehension_set(Ids,Body),_,Info),(I,S),(I,T)) :-
3506 pp_comprehension_set5(Ids,Body,Info,_,special(_Kind),S,T),
3507 % throw away indent and check if a special pp rule is applicable
3508 !.
3509 pp_expr_indent(b(comprehension_set(Ids,Body),_,_)) -->
3510 !,
3511 insertstr('{'), pp_expr_indent_l(Ids),
3512 insertstr(' | '),
3513 pred_over_lines(2,'@body',Body),
3514 indent('}').
3515 pp_expr_indent(b(convert_bool(Body),_,_)) -->
3516 !,
3517 insertstr('bool('),
3518 pred_over_lines(2,'@bool',Body),
3519 indent(')').
3520 pp_expr_indent(b(if_then_else(Test,Then,Else),_,_)) -->
3521 !,
3522 insertstr('IF'),
3523 pred_over_lines(2,'@test',Test),
3524 indent('THEN'),increase_indentation_level(2),
3525 indent(''),pp_expr_indent(Then),decrease_indentation_level(2),
3526 indent('ELSE'),increase_indentation_level(2),
3527 indent(''),pp_expr_indent(Else),decrease_indentation_level(2),
3528 indent('END').
3529 pp_expr_indent(b(let_expression(Ids,Exprs,Body),_,_)) -->
3530 !,
3531 pp_let_expr_nested(Ids,Exprs,Body).
3532 % TODO: support a few more like dom/ran(comprehension_set) SIGMA, PI, \/ (union), ...
3533 pp_expr_indent(Expr,(I,S),(I,T)) :-
3534 %get_texpr_expr(Expr,F), functor(F,FF,NN), format(user_output,'Cannot indent: ~w/~w~n',[FF,NN]),
3535 pp_expr(Expr,_,_LimitReached,S,T). % throw away indent
3536
3537 can_indent_texpr(b(E,_,_)) :- can_indent_expr(E).
3538 can_indent_expr(comprehension_set(_,_)).
3539 can_indent_expr(convert_bool(_)).
3540 can_indent_expr(if_then_else(_,_,_)).
3541 can_indent_expr(let_expression(_,_,_)).
3542
3543 pp_expr_indent_l([E]) --> !, pp_expr_indent(E).
3544 pp_expr_indent_l(Exprs,(I,S),(I,T)) :-
3545 pp_expr_l(Exprs,_LR,S,T). % throw away indent
3546 pp_expr_m_indent(Expr,MinPrio,(I,S),(I,T)) :-
3547 pp_expr_m(Expr,MinPrio,_LimitReached,S,T).
3548 pp_atom_indent(A,(I,S),(I,T)) :- ppatom(A,S,T).
3549 pp_expr_ids_in_mode_indent(Ids,(I,S),(I,T)) :- pp_expr_ids_in_mode(Ids,_,S,T).
3550
3551
3552
3553
3554 is_boolean_value(b(B,boolean,_),BV) :- boolean_aux(B,BV).
3555 boolean_aux(boolean_true,pred_true).
3556 boolean_aux(boolean_false,pred_false).
3557 boolean_aux(value(V),BV) :- nonvar(V),!,BV=V.
3558
3559
3560 constants_in_mode(F,S) :-
3561 constants(F,S1), translate_in_mode(F,S1,S).
3562
3563 constants(pred_true,'TRUE').
3564 constants(pred_false,'FALSE').
3565 constants(boolean_true,'TRUE').
3566 constants(boolean_false,'FALSE').
3567 constants(max_int,'MAXINT').
3568 constants(min_int,'MININT').
3569 constants(empty_set,'{}').
3570 constants(bool_set,'BOOL').
3571 constants(float_set,'FLOAT').
3572 constants(real_set,'REAL').
3573 constants(string_set,'STRING').
3574 constants(empty_sequence,'[]').
3575 constants(event_b_identity,'id').
3576
3577 constants(truth,Res) :- eventb_translation_mode,!,Res=true.
3578 constants(truth,Res) :- animation_minor_mode(tla),!,Res='TRUE'.
3579 constants(truth,Res) :- atelierb_mode(_),!,Res='(TRUE:BOOL)'. % __truth; we could also do TRUE=TRUE
3580 constants(truth,'btrue').
3581 constants(falsity,Res) :- eventb_translation_mode,!,Res=false.
3582 constants(falsity,Res) :- animation_minor_mode(tla),!,Res='FALSE'.
3583 constants(falsity,Res) :- atelierb_mode(_),!,Res='(TRUE=FALSE)'.
3584 constants(falsity,'bfalse'). % __falsity
3585 constants(unknown_truth_value(Msg),Res) :- % special internal constant
3586 ajoin(['?(',Msg,')'],Res).
3587
3588 function_like_in_mode(F,S) :-
3589 function_like(F,S1),
3590 translate_in_mode(F,S1,S).
3591
3592 function_like(convert_bool,bool).
3593 function_like(convert_real,real). % cannot be used on its own: dom(real) is not accepted by Atelier-B
3594 function_like(convert_int_floor,floor). % ditto
3595 function_like(convert_int_ceiling,ceiling). % ditto
3596 function_like(successor,succ). % can also be used on its own; e.g., dom(succ)=INTEGER is ok
3597 function_like(predecessor,pred). % ditto
3598 function_like(max,max).
3599 function_like(max_real,max).
3600 function_like(min,min).
3601 function_like(min_real,min).
3602 function_like(card,card).
3603 function_like(pow_subset,'POW').
3604 function_like(pow1_subset,'POW1').
3605 function_like(fin_subset,'FIN').
3606 function_like(fin1_subset,'FIN1').
3607 function_like(identity,id).
3608 function_like(first_projection,prj1).
3609 function_like(first_of_pair,'prj1'). % used to be __first_of_pair, will be dealt with separately to generate parsable representation
3610 function_like(second_projection,prj2).
3611 function_like(second_of_pair,'prj2'). % used to be __second_of_pair, will be dealt with separately to generate parsable representation
3612 function_like(iteration,iterate).
3613 function_like(event_b_first_projection_v2,prj1).
3614 function_like(event_b_second_projection_v2,prj2).
3615 function_like(reflexive_closure,closure).
3616 function_like(closure,closure1).
3617 function_like(domain,dom).
3618 function_like(range,ran).
3619 function_like(seq,seq).
3620 function_like(seq1,seq1).
3621 function_like(iseq,iseq).
3622 function_like(iseq1,iseq1).
3623 function_like(perm,perm).
3624 function_like(size,size).
3625 function_like(first,first).
3626 function_like(last,last).
3627 function_like(front,front).
3628 function_like(tail,tail).
3629 function_like(rev,rev).
3630 function_like(general_concat,conc).
3631 function_like(general_union,union).
3632 function_like(general_intersection,inter).
3633 function_like(trans_function,fnc).
3634 function_like(trans_relation,rel).
3635 function_like(tree,tree).
3636 function_like(btree,btree).
3637 function_like(const,const).
3638 function_like(top,top).
3639 function_like(sons,sons).
3640 function_like(prefix,prefix).
3641 function_like(postfix,postfix).
3642 function_like(sizet,sizet).
3643 function_like(mirror,mirror).
3644 function_like(rank,rank).
3645 function_like(father,father).
3646 function_like(son,son).
3647 function_like(subtree,subtree).
3648 function_like(arity,arity).
3649 function_like(bin,bin).
3650 function_like(left,left).
3651 function_like(right,right).
3652 function_like(infix,infix).
3653
3654 function_like(rec,rec).
3655 function_like(struct,struct).
3656
3657 function_like(negation,not).
3658 function_like(bag_items,items).
3659
3660 function_like(finite,finite). % from Event-B, TO DO: if \+ eventb_translation_mode then print as S:FIN(S)
3661 function_like(witness,'@witness'). % from Event-B
3662
3663 function_like(floored_div,'FDIV') :- \+ animation_minor_mode(tla). % using external function
3664
3665 unary_prefix(unary_minus,-,210).
3666 unary_prefix(unary_minus_real,-,210).
3667 unary_prefix(mu,'MU',210) :- animation_minor_mode(z).
3668
3669 unary_prefix_parentheses(compaction,'compaction').
3670 unary_prefix_parentheses(bag_items,'bag_items').
3671 unary_prefix_parentheses(mu,'MU') :- \+ animation_minor_mode(z). % write with () for external function
3672
3673 unary_postfix(reverse,'~',230). % relational inverse
3674
3675
3676 always_surround_by_parentheses(parallel_product).
3677 always_surround_by_parentheses(composition).
3678
3679 binary_infix_symbol(b(T,_,_),Symbol) :- functor(T,F,2), binary_infix_in_mode(F,Symbol,_,_).
3680
3681 % EXPR * EXPR --> EXPR
3682 binary_infix(composition,';',20,left).
3683 binary_infix(overwrite,'<+',160,left).
3684 binary_infix(direct_product,'><',160,left). % Rodin requires parentheses
3685 binary_infix(parallel_product,'||',20,left).
3686 binary_infix(concat,'^',160,left).
3687 binary_infix(relations,'<->',125,left).
3688 binary_infix(partial_function,'+->',125,left).
3689 binary_infix(total_function,'-->',125,left).
3690 binary_infix(partial_injection,'>+>',125,left).
3691 binary_infix(total_injection,'>->',125,left).
3692 binary_infix(partial_surjection,'+->>',125,left).
3693 binary_infix(total_surjection,Symbol,125,left) :-
3694 (eventb_translation_mode -> Symbol = '->>'; Symbol = '-->>').
3695 binary_infix(total_bijection,'>->>',125,left).
3696 binary_infix(partial_bijection,'>+>>',125,left).
3697 binary_infix(total_relation,'<<->',125,left). % only in Event-B
3698 binary_infix(surjection_relation,'<->>',125,left). % only in Event-B
3699 binary_infix(total_surjection_relation,'<<->>',125,left). % only in Event-B
3700 binary_infix(insert_front,'->',160,left).
3701 binary_infix(insert_tail,'<-',160,left).
3702 binary_infix(domain_restriction,'<|',160,left).
3703 binary_infix(domain_subtraction,'<<|',160,left).
3704 binary_infix(range_restriction,'|>',160,left).
3705 binary_infix(range_subtraction,'|>>',160,left).
3706 binary_infix(intersection,'/\\',160,left).
3707 binary_infix(union,'\\/',160,left).
3708 binary_infix(restrict_front,'/|\\',160,left).
3709 binary_infix(restrict_tail,'\\|/',160,left).
3710 binary_infix(couple,'|->',160,left).
3711 binary_infix(interval,'..',170,left).
3712 binary_infix(add,+,180,left).
3713 binary_infix(add_real,+,180,left).
3714 binary_infix(minus,-,180,left).
3715 binary_infix(minus_real,-,180,left).
3716 binary_infix(set_subtraction,'\\',180,left) :- eventb_translation_mode,!. % symbol is not allowed by Atelier-B
3717 binary_infix(set_subtraction,-,180,left).
3718 binary_infix(minus_or_set_subtract,-,180,left).
3719 binary_infix(multiplication,*,190,left).
3720 binary_infix(multiplication_real,*,190,left).
3721 binary_infix(cartesian_product,**,190,left) :- eventb_translation_mode,!.
3722 binary_infix(cartesian_product,*,190,left).
3723 binary_infix(mult_or_cart,*,190,left). % in case type checker not yet run
3724 binary_infix(div,/,190,left).
3725 binary_infix(div_real,/,190,left).
3726 binary_infix(floored_div,div,190,left) :- animation_minor_mode(tla).
3727 binary_infix(modulo,mod,190,left).
3728 binary_infix(power_of,**,200,right).
3729 binary_infix(power_of_real,**,200,right).
3730 binary_infix(typeof,oftype,60,right). % Event-B oftype operator; usually removed by btypechecker, guessing about priority, associativity probably not relevant
3731
3732 binary_infix(ring,'\x2218\',160,left). % our B Parser gives ring same priority as direct_product or overwrite
3733
3734 % PRED * PRED --> PRED
3735 binary_infix(implication,'=>',30,left).
3736 binary_infix(conjunct,'&',40,left).
3737 binary_infix(disjunct,or,40,left).
3738 binary_infix(equivalence,'<=>',Prio,left) :- % in Rodin this has the same priority as implication
3739 (eventb_translation_mode -> Prio=30 ; Prio=60).
3740
3741
3742 % EXPR * EXPR --> PRED
3743 binary_infix(equal,=,60,left).
3744 binary_infix(not_equal,'/=',160,left).
3745 binary_infix(less_equal,'<=',160,left).
3746 binary_infix(less,'<',160,left).
3747 binary_infix(less_equal_real,'<=',160,left).
3748 binary_infix(less_real,'<',160,left).
3749 binary_infix(greater_equal,'>=',160,left).
3750 binary_infix(greater,'>',160,left).
3751 binary_infix(member,':',60,left).
3752 binary_infix(not_member,'/:',160,left).
3753 binary_infix(subset,'<:',110,left).
3754 binary_infix(subset_strict,'<<:',110,left).
3755 binary_infix(not_subset,'/<:',110,left).
3756 binary_infix(not_subset_strict,'/<<:',110,left).
3757
3758 binary_infix(values_entry,'=',60,left).
3759
3760 % atelierb_mode(pp): translation for AtelierB's PP/ML prover
3761 % atelierb_mode(native): translation to native B supported by AtelierB
3762 :- dynamic latex_mode/0, unicode_mode/0, atelierb_mode/1, force_eventb_rodin_mode/0.
3763
3764 %latex_mode.
3765 %unicode_mode.
3766 %force_eventb_rodin_mode. % Force Event-B output even if not in eventb minor mode
3767
3768 eventb_translation_mode :- animation_minor_mode(eventb),!.
3769 eventb_translation_mode :- force_eventb_rodin_mode.
3770
3771 set_force_eventb_mode :- assertz(force_eventb_rodin_mode).
3772 unset_force_eventb_mode :-
3773 (retract(force_eventb_rodin_mode) -> true ; add_internal_error('Was not in forced Event-B mode: ',force_eventb_rodin_mode)).
3774
3775 set_unicode_mode :- assertz(unicode_mode).
3776 set_latex_mode :- assertz(latex_mode).
3777 unset_unicode_mode :-
3778 (retract(unicode_mode) -> true ; add_internal_error('Was not in Unicode mode: ',unset_unicode_mode)).
3779 unset_latex_mode :-
3780 (retract(latex_mode) -> true
3781 ; add_internal_error('Was not in Latex mode: ',unset_latex_mode)).
3782
3783 set_atelierb_mode(Mode) :- asserta(atelierb_mode(Mode)).
3784 unset_atelierb_mode :-
3785 (retract(atelierb_mode(_)) -> true ; add_internal_error('Was not in Atelier-B mode: ',unset_atelierb_mode)).
3786
3787 get_translation_mode(M) :- unicode_mode, !, M=unicode.
3788 get_translation_mode(M) :- latex_mode, !, M=latex.
3789 get_translation_mode(M) :- atelierb_mode(native), !, M=atelierb.
3790 get_translation_mode(M) :- atelierb_mode(pp), !, M=atelierb_pp.
3791 get_translation_mode(ascii).
3792
3793 % TO DO: provide better stack-based setting/unsetting of modes or use options parameter
3794 set_translation_mode(ascii) :- !, retractall(unicode_mode), retractall(latex_mode), retractall(atelierb_mode(_)).
3795 set_translation_mode(unicode) :- !, set_unicode_mode.
3796 set_translation_mode(latex) :- !, set_latex_mode.
3797 set_translation_mode(atelierb) :- !, set_atelierb_mode(native).
3798 set_translation_mode(atelierb_pp) :- !, set_atelierb_mode(pp).
3799 set_translation_mode(Mode) :- add_internal_error('Illegal mode:',set_translation_mode(Mode)).
3800
3801 unset_translation_mode(ascii) :- !.
3802 unset_translation_mode(unicode) :- !,unset_unicode_mode.
3803 unset_translation_mode(latex) :- !,unset_latex_mode.
3804 unset_translation_mode(atelierb) :- !,unset_atelierb_mode.
3805 unset_translation_mode(atelierb_pp) :- !,unset_atelierb_mode.
3806 unset_translation_mode(Mode) :- add_internal_error('Illegal mode:',unset_translation_mode(Mode)).
3807
3808 with_translation_mode(Mode, Call) :-
3809 get_translation_mode(OldMode),
3810 (OldMode == Mode -> Call ;
3811 set_translation_mode(ascii), % Clear all existing translation mode settings first
3812 set_translation_mode(Mode),
3813 call_cleanup(Call, set_translation_mode(OldMode))
3814 % FIXME This might not restore all translation modes fully!
3815 % For example, if both unicode_mode and latex_mode are set,
3816 % then with_translation_mode(ascii, ...) will only restore unicode_mode.
3817 % Not sure if this might cause problems for some code.
3818 ).
3819
3820 % The language mode is currently linked to the animation minor mode,
3821 % so be careful when changing it!
3822 % TODO Allow overriding the language for translate without affecting the animation mode
3823
3824 get_language_mode(csp_and(Lang)) :-
3825 csp_with_bz_mode,
3826 !,
3827 (animation_minor_mode(Lang) -> true ; Lang = b).
3828 get_language_mode(Lang) :- animation_minor_mode(Lang), !.
3829 get_language_mode(Lang) :- animation_mode(Lang).
3830
3831 set_language_mode(csp_and(Lang)) :-
3832 !,
3833 set_animation_mode(csp_and_b),
3834 (Lang == b -> true ; set_animation_minor_mode(Lang)).
3835 set_language_mode(csp) :- !, set_animation_mode(csp).
3836 set_language_mode(xtl) :- !, set_animation_mode(xtl).
3837 set_language_mode(b) :- !, set_animation_mode(b).
3838 set_language_mode(Lang) :-
3839 set_animation_mode(b),
3840 set_animation_minor_mode(Lang).
3841
3842 with_language_mode(Lang, Call) :-
3843 get_language_mode(OldLang),
3844 (OldLang == Lang -> Call ;
3845 set_language_mode(Lang),
3846 call_cleanup(Call, set_language_mode(OldLang))
3847 % FIXME This might not restore all animation modes fully!
3848 % It's apparently possible to have multiple animation minor modes,
3849 % which get/set_language_mode doesn't handle.
3850 % (Are multiple animation minor modes actually used anywhere?)
3851 ).
3852
3853 exists_symbol --> {latex_mode},!, "\\exists ".
3854 exists_symbol --> {unicode_mode},!, pp_colour_code(magenta),[8707],pp_colour_code(reset).
3855 exists_symbol --> pp_colour_code(blue),"#",pp_colour_code(reset).
3856 forall_symbol --> {latex_mode},!, "\\forall ".
3857 forall_symbol --> {unicode_mode},!, pp_colour_code(magenta),[8704],pp_colour_code(reset).
3858 forall_symbol --> pp_colour_code(blue),"!",pp_colour_code(reset).
3859 dot_symbol --> {latex_mode},!, "\\cdot ".
3860 dot_symbol --> {unicode_mode},!, [183]. %"·". % dot also used in Rodin
3861 dot_symbol --> ".".
3862 dot_bullet_symbol --> {latex_mode},!, "\\cdot ".
3863 dot_bullet_symbol --> [183]. %"·". % dot also used in Rodin
3864 set_brackets(X,Y) :- latex_mode,!,X='\\{', Y='\\}'.
3865 set_brackets('{','}').
3866 left_set_bracket --> {latex_mode},!, "\\{ ".
3867 left_set_bracket --> "{".
3868 right_set_bracket --> {latex_mode},!, "\\} ".
3869 right_set_bracket --> "}".
3870 maplet_symbol --> {latex_mode},!, "\\mapsto ".
3871 maplet_symbol --> {unicode_mode},!, [8614].
3872 maplet_symbol --> "|->". % also provide option to use colours? pp_colour_code(blue) ,...
3873
3874 lambda_symbol --> {unicode_mode},!, [955]. % '\x3BB\'
3875 lambda_symbol --> {latex_mode},!, "\\lambda ".
3876 lambda_symbol --> pp_colour_code(blue),"%",pp_colour_code(reset).
3877
3878 and_symbol --> {unicode_mode},!, [8743]. % ''\x2227\''
3879 and_symbol --> {latex_mode},!, "\\wedge ".
3880 and_symbol --> "&".
3881
3882 hash_card_symbol --> {latex_mode},!, "\\# ".
3883 hash_card_symbol --> "#".
3884 ldots --> {latex_mode},!, "\\ldots ".
3885 ldots --> "...".
3886
3887 empty_set_symbol --> {get_preference(translate_print_all_sequences,true)},!, pp_empty_sequence.
3888 empty_set_symbol --> {unicode_mode},!, [8709].
3889 empty_set_symbol --> {latex_mode},!, "\\emptyset ".
3890 empty_set_symbol --> "{}".
3891
3892 underscore_symbol --> {latex_mode},!, "\\_".
3893 underscore_symbol --> "_".
3894
3895 string_start_symbol --> {latex_mode},!, "\\textnormal{``".
3896 string_start_symbol --> pp_colour_code(blue), """".
3897 string_end_symbol --> {latex_mode},!, "''}".
3898 string_end_symbol --> pp_colour_code(reset), """".
3899
3900
3901 unary_postfix_in_mode(Op,Trans2,Prio) :-
3902 unary_postfix(Op,Trans,Prio), % print(op(Op,Trans)),nl,
3903 translate_in_mode(Op,Trans,Trans2).
3904
3905 binary_infix_in_mode(Op,Trans2,Prio,Assoc) :-
3906 binary_infix(Op,Trans,Prio,Assoc), % print(op(Op,Trans)),nl,
3907 translate_in_mode(Op,Trans,Trans2).
3908
3909 latex_integer_set_translation('NATURAL', '\\mathbb N '). % \nat in bsymb.sty
3910 latex_integer_set_translation('NATURAL1', '\\mathbb N_1 '). % \natn
3911 latex_integer_set_translation('INTEGER', '\\mathbb Z '). % \intg
3912 latex_integer_set_translation('REAL', '\\mathbb R '). % \intg
3913
3914 latex_translation(empty_set, '\\emptyset ').
3915 latex_translation(implication, '\\mathbin\\Rightarrow ').
3916 latex_translation(conjunct,'\\wedge ').
3917 latex_translation(disjunct,'\\vee ').
3918 latex_translation(equivalence,'\\mathbin\\Leftrightarrow ').
3919 latex_translation(negation,'\\neg ').
3920 latex_translation(not_equal,'\\neq ').
3921 latex_translation(less_equal,'\\leq ').
3922 latex_translation(less_equal_real,'\\leq ').
3923 latex_translation(greater_equal,'\\geq ').
3924 latex_translation(member,'\\in ').
3925 latex_translation(not_member,'\\not\\in ').
3926 latex_translation(subset,'\\subseteq ').
3927 latex_translation(subset_strict,'\\subset ').
3928 latex_translation(not_subset,'\\not\\subseteq ').
3929 latex_translation(not_subset_strict,'\\not\\subset ').
3930 latex_translation(union,'\\cup ').
3931 latex_translation(intersection,'\\cap ').
3932 latex_translation(couple,'\\mapsto ').
3933 latex_translation(cartesian_product,'\\times').
3934 latex_translation(rec,'\\mathit{rec}').
3935 latex_translation(struct,'\\mathit{struct}').
3936 latex_translation(convert_bool,'\\mathit{bool}').
3937 latex_translation(max,'\\mathit{max}').
3938 latex_translation(max_real,'\\mathit{max}').
3939 latex_translation(min,'\\mathit{min}').
3940 latex_translation(min_real,'\\mathit{min}').
3941 latex_translation(modulo,'\\mod ').
3942 latex_translation(card,'\\mathit{card}').
3943 latex_translation(successor,'\\mathit{succ}').
3944 latex_translation(predecessor,'\\mathit{pred}').
3945 latex_translation(domain,'\\mathit{dom}').
3946 latex_translation(range,'\\mathit{ran}').
3947 latex_translation(size,'\\mathit{size}').
3948 latex_translation(first,'\\mathit{first}').
3949 latex_translation(last,'\\mathit{last}').
3950 latex_translation(front,'\\mathit{front}').
3951 latex_translation(tail,'\\mathit{tail}').
3952 latex_translation(rev,'\\mathit{rev}').
3953 latex_translation(seq,'\\mathit{seq}').
3954 latex_translation(seq1,'\\mathit{seq}_{1}').
3955 latex_translation(perm,'\\mathit{perm}').
3956 latex_translation(fin_subset,'\\mathit{FIN}').
3957 latex_translation(fin1_subset,'\\mathit{FIN}_{1}').
3958 latex_translation(first_projection,'\\mathit{prj}_{1}').
3959 latex_translation(second_projection,'\\mathit{prj}_{2}').
3960 latex_translation(pow_subset,'\\mathbb P\\hbox{}'). % POW \pow would require bsymb.sty
3961 latex_translation(pow1_subset,'\\mathbb P_1'). % POW1 \pown would require bsymb.sty
3962 latex_translation(concat,'\\stackrel{\\frown}{~}'). % was '\\hat{~}').
3963 latex_translation(relations,'\\mathbin\\leftrightarrow'). % <->, \rel requires bsymb.sty
3964 latex_translation(total_relation,'\\mathbin{\\leftarrow\\mkern-14mu\\leftrightarrow}'). % <<-> \trel requires bsymb.sty
3965 latex_translation(total_surjection_relation,'\\mathbin{\\leftrightarrow\\mkern-14mu\\leftrightarrow}'). % <<->> \strel requires bsymb.sty
3966 latex_translation(surjection_relation,'\\mathbin{\\leftrightarrow\\mkern-14mu\\rightarrow}'). % <->> \srel requires bsymb.sty
3967 latex_translation(partial_function,'\\mathbin{\\mkern6mu\\mapstochar\\mkern-6mu\\rightarrow}'). % +-> \pfun requires bsymb.sty, but \mapstochar is not supported by Mathjax
3968 latex_translation(partial_injection,'\\mathbin{\\mkern9mu\\mapstochar\\mkern-9mu\\rightarrowtail}'). % >+> \pinj requires bsymb.sty
3969 latex_translation(partial_surjection,'\\mathbin{\\mkern6mu\\mapstochar\\mkern-6mu\\twoheadrightarrow}'). % >+> \psur requires bsymb.sty
3970 latex_translation(total_function,'\\mathbin\\rightarrow'). % --> \tfun would require bsymb.sty
3971 latex_translation(total_surjection,'\\mathbin\\twoheadrightarrow'). % -->> \tsur requires bsymb.sty
3972 latex_translation(total_injection,'\\mathbin\\rightarrowtail'). % >-> \tinj requires bsymb.sty
3973 latex_translation(total_bijection,'\\mathbin{\\rightarrowtail\\mkern-18mu\\twoheadrightarrow}'). % >->> \tbij requires bsymb.sty
3974 latex_translation(domain_restriction,'\\mathbin\\lhd'). % <| domres requires bsymb.sty
3975 latex_translation(range_restriction,'\\mathbin\\rhd'). % |> ranres requires bsymb.sty
3976 latex_translation(domain_subtraction,'\\mathbin{\\lhd\\mkern-14mu-}'). % <<| domsub requires bsymb.sty
3977 latex_translation(range_subtraction,'\\mathbin{\\rhd\\mkern-14mu-}'). % |>> ransub requires bsymb.sty
3978 latex_translation(overwrite,'\\mathbin{\\lhd\\mkern-9mu-}'). % <+ \ovl requires bsymb.sty
3979 latex_translation(ring,'\\circ '). % not tested
3980 latex_translation(general_sum,'\\Sigma ').
3981 latex_translation(general_product,'\\Pi ').
3982 latex_translation(lambda,'\\lambda ').
3983 latex_translation(quantified_union,'\\bigcup\\nolimits'). % \Union requires bsymb.sty
3984 latex_translation(quantified_intersection,'\\bigcap\\nolimits'). % \Inter requires bsymb.sty
3985 %latex_translation(truth,'\\top').
3986 %latex_translation(falsity,'\\bot').
3987 latex_translation(truth,'{\\color{olive} \\top}'). % requires \usepackage{xcolor} in Latex
3988 latex_translation(falsity,'{\\color{red} \\bot}').
3989 latex_translation(boolean_true,'{\\color{olive} \\mathit{TRUE}}').
3990 latex_translation(boolean_false,'{\\color{red} \\mathit{FALSE}}').
3991 latex_translation(pred_true,'{\\color{olive} \\mathit{TRUE}}').
3992 latex_translation(pred_false,'{\\color{red} \\mathit{FALSE}}').
3993 latex_translation(reverse,'^{-1}').
3994
3995 ascii_to_unicode(Ascii,Unicode) :-
3996 translate_prolog_constructor(BAst,Ascii), % will not backtrack
3997 unicode_translation(BAst,Unicode).
3998
3999
4000 % can be used to translate Latex shortcuts to B Unicode operators for editors
4001 latex_to_unicode(LatexShortcut,Unicode) :-
4002 latex_to_b_ast(LatexShortcut,BAst),
4003 unicode_translation(BAst,Unicode).
4004 latex_to_unicode(LatexShortcut,Unicode) :- % allow to use B AST names as well
4005 unicode_translation(LatexShortcut,Unicode).
4006 latex_to_unicode(LatexShortcut,Unicode) :-
4007 greek_symbol(LatexShortcut,Unicode).
4008
4009 get_latex_keywords(List) :-
4010 findall(Id,latex_to_unicode(Id,_),Ids),
4011 sort(Ids,List).
4012
4013 get_latex_keywords_with_backslash(BList) :-
4014 get_latex_keywords(List),
4015 maplist(atom_concat('\\'),List,BList).
4016
4017 latex_to_b_ast(and,conjunct).
4018 latex_to_b_ast(bcomp,ring). % bsymb: backwards composition
4019 latex_to_b_ast(bigcap,quantified_intersection).
4020 latex_to_b_ast(bigcup,quantified_union).
4021 latex_to_b_ast(cap,intersection).
4022 latex_to_b_ast(cart,cartesian_product).
4023 latex_to_b_ast(cprod,cartesian_product).
4024 latex_to_b_ast(cdot,dot_symbol).
4025 latex_to_b_ast(cup,union).
4026 latex_to_b_ast(dprod,direct_product).
4027 latex_to_b_ast(dres,domain_restriction).
4028 latex_to_b_ast(dsub,domain_subtraction).
4029 latex_to_b_ast(emptyset,empty_set).
4030 latex_to_b_ast(exp,power_of).
4031 %latex_to_b_ast(fcomp,composition). % bsymb: forwards composition
4032 latex_to_b_ast(geq,greater_equal).
4033 latex_to_b_ast(implies,implication).
4034 latex_to_b_ast(in,member).
4035 latex_to_b_ast(int,'INTEGER').
4036 latex_to_b_ast(intg,'INTEGER'). % from bsymb
4037 latex_to_b_ast(lambda,lambda).
4038 latex_to_b_ast(land,conjunct).
4039 latex_to_b_ast(leq,less_equal).
4040 latex_to_b_ast(leqv,equivalence).
4041 latex_to_b_ast(lhd,domain_restriction).
4042 latex_to_b_ast(limp,implication).
4043 latex_to_b_ast(lor,disjunct).
4044 latex_to_b_ast(lnot,negation).
4045 latex_to_b_ast(mapsto,couple).
4046 latex_to_b_ast(nat,'NATURAL').
4047 latex_to_b_ast(natn,'NATURAL1').
4048 latex_to_b_ast(neg,negation).
4049 latex_to_b_ast(neq,not_equal).
4050 latex_to_b_ast(nin,not_member).
4051 latex_to_b_ast(not,negation).
4052 latex_to_b_ast(nsubseteq,not_subset).
4053 latex_to_b_ast(nsubset,not_subset_strict).
4054 latex_to_b_ast(or,disjunct).
4055 %latex_to_b_ast(ovl,overwrite).
4056 latex_to_b_ast(pfun,partial_function).
4057 latex_to_b_ast(pinj,partial_injection).
4058 latex_to_b_ast(psur,partial_surjection).
4059 latex_to_b_ast(pow,pow_subset).
4060 latex_to_b_ast(pown,pow1_subset).
4061 latex_to_b_ast(pprod,parallel_product).
4062 latex_to_b_ast(qdot,dot_symbol).
4063 latex_to_b_ast(real,'REAL').
4064 latex_to_b_ast(rel,relations).
4065 latex_to_b_ast(rhd,range_restriction).
4066 latex_to_b_ast(rres,range_restriction).
4067 latex_to_b_ast(rsub,range_subtraction).
4068 latex_to_b_ast(srel,surjection_relation).
4069 latex_to_b_ast(subseteq,subset).
4070 latex_to_b_ast(subset,subset_strict).
4071 latex_to_b_ast(tbij,total_bijection).
4072 latex_to_b_ast(tfun,total_function).
4073 latex_to_b_ast(tinj,total_injection).
4074 latex_to_b_ast(trel,total_relation).
4075 latex_to_b_ast(tsrel,total_surjection_relation).
4076 latex_to_b_ast(tsur,total_surjection).
4077 latex_to_b_ast(upto,interval).
4078 latex_to_b_ast(vee,disjunct).
4079 latex_to_b_ast(wedge,conjunct).
4080 latex_to_b_ast('INT','INTEGER').
4081 latex_to_b_ast('NAT','NATURAL').
4082 latex_to_b_ast('N','NATURAL').
4083 latex_to_b_ast('Pi',general_product).
4084 latex_to_b_ast('POW',pow_subset).
4085 latex_to_b_ast('REAL','REAL').
4086 latex_to_b_ast('Rightarrow',implication).
4087 latex_to_b_ast('Sigma',general_sum).
4088 latex_to_b_ast('Leftrightarrow',equivalence).
4089 latex_to_b_ast('Inter',quantified_intersection).
4090 latex_to_b_ast('Union',quantified_union).
4091 latex_to_b_ast('Z','INTEGER').
4092
4093 unicode_translation(implication, '\x21D2\').
4094 unicode_translation(conjunct,'\x2227\').
4095 unicode_translation(disjunct,'\x2228\').
4096 unicode_translation(negation,'\xAC\').
4097 unicode_translation(equivalence,'\x21D4\').
4098 unicode_translation(not_equal,'\x2260\').
4099 unicode_translation(less_equal,'\x2264\').
4100 unicode_translation(less_equal_real,'\x2264\').
4101 unicode_translation(greater_equal,'\x2265\').
4102 unicode_translation(member,'\x2208\').
4103 unicode_translation(not_member,'\x2209\').
4104 unicode_translation(subset,'\x2286\').
4105 unicode_translation(subset_strict,'\x2282\').
4106 unicode_translation(not_subset,'\x2288\').
4107 unicode_translation(not_subset_strict,'\x2284\').
4108 unicode_translation(supseteq,'\x2287\'). % ProB parser supports unicode symbol by reversing arguments
4109 unicode_translation(supset_strict,'\x2283\'). % ditto
4110 unicode_translation(not_supseteq,'\x2289\'). % ditto
4111 unicode_translation(not_supset_strict,'\x2285\'). % ditto
4112 unicode_translation(union,'\x222A\').
4113 unicode_translation(intersection,'\x2229\').
4114 unicode_translation(cartesian_product,'\xD7\'). % also 0x2217 in Camille or 0x2A2F (vector or cross product) in IDP
4115 unicode_translation(couple,'\x21A6\').
4116 unicode_translation(div,'\xF7\').
4117 unicode_translation(dot_symbol,'\xB7\'). % not a B AST operator, cf dot_symbol 183
4118 unicode_translation(floored_div,'\xF7\') :-
4119 animation_minor_mode(tla). % should we provide another Unicode character here for B?
4120 unicode_translation(power_of,'\x02C4\'). % version of ^, does not exist in Rodin ?!, upwards arrow x2191 used below for restrict front
4121 unicode_translation(power_of_real,'\x02C4\').
4122 unicode_translation(interval,'\x2025\').
4123 unicode_translation(domain_restriction,'\x25C1\').
4124 unicode_translation(domain_subtraction,'\x2A64\').
4125 unicode_translation(range_restriction,'\x25B7\').
4126 unicode_translation(range_subtraction,'\x2A65\').
4127 unicode_translation(relations,'\x2194\').
4128 unicode_translation(partial_function,'\x21F8\').
4129 unicode_translation(total_function,'\x2192\').
4130 unicode_translation(partial_injection,'\x2914\').
4131 unicode_translation(partial_surjection,'\x2900\').
4132 unicode_translation(total_injection,'\x21A3\').
4133 unicode_translation(total_surjection,'\x21A0\').
4134 unicode_translation(total_bijection,'\x2916\').
4135 unicode_translation('INTEGER','\x2124\').
4136 unicode_translation('NATURAL','\x2115\').
4137 unicode_translation('NATURAL1','\x2115\\x2081\'). % \x2115\ is subscript 1
4138 unicode_translation('REAL','\x211D\'). % 8477 in decimal
4139 unicode_translation(real_set,'\x211D\').
4140 %unicode_translation(bool_set,'\x1D539\'). % conversion used by IDP, but creates SPIO_E_ENCODING_INVALID problem
4141 unicode_translation(pow_subset,'\x2119\').
4142 unicode_translation(pow1_subset,'\x2119\\x2081\'). % \x2115\ is subscript 1
4143 unicode_translation(lambda,'\x3BB\').
4144 unicode_translation(general_product,'\x220F\').
4145 unicode_translation(general_sum,'\x2211\').
4146 unicode_translation(quantified_union,'\x22C3\'). % 8899 in decimal
4147 unicode_translation(quantified_intersection,'\x22C2\'). % 8898 in decimal
4148 unicode_translation(empty_set,'\x2205\').
4149 unicode_translation(truth,'\x22A4\'). % 8868 in decimal
4150 unicode_translation(falsity,'\x22A5\'). % 8869 in decimal
4151 unicode_translation(direct_product,'\x2297\').
4152 unicode_translation(parallel_product,'\x2225\').
4153 unicode_translation(reverse,'\x207B\\xB9\') :- \+ force_eventb_rodin_mode. % the one ¹ is ASCII 185
4154 % this symbol is not accepted by Rodin
4155 % unicode_translation(infinity,'\x221E\'). % 8734 in decimal
4156 unicode_translation(concat,'\x2312\'). % Arc character
4157 unicode_translation(insert_front,'\x21FE\').
4158 unicode_translation(insert_tail,'\x21FD\').
4159 unicode_translation(restrict_front,'\x2191\'). % up arrow
4160 unicode_translation(restrict_tail,'\x2192\').
4161 unicode_translation(forall, '\x2200\'). % usually forall_symbol used
4162 unicode_translation(exists, '\x2203\'). % usually exists_symbol used
4163 unicode_translation(eqeq,'\x225c\').
4164
4165 %unicode_translation(overwrite,'\xE103\'). % from kernel_lang_20.pdf
4166 unicode_translation(ring,'\x2218\'). % from Event-B
4167 unicode_translation(typeof,'\x2982\'). % Event-B oftype operator
4168
4169 atelierb_pp_translation(set_minus,'_moinsE').
4170 atelierb_pp_translation(cartesian_product,'_multE').
4171 atelierb_pp_translation('INTEGER','INTEGER').
4172 %atelierb_pp_translation('INT','(MININT..MAXINT)'). % does not seem necessary
4173 atelierb_pp_translation('NATURAL','NATURAL').
4174 %atelierb_pp_translation('NAT','(0..MAXINT)'). % does not seem necessary
4175 %atelierb_pp_translation('NAT1','(1..MAXINT)'). % does not seem necessary
4176 atelierb_pp_translation(truth,btrue).
4177 atelierb_pp_translation(falsity,bfalse).
4178 atelierb_pp_translation(boolean_true,'TRUE').
4179 atelierb_pp_translation(boolean_false,'FALSE').
4180 atelierb_pp_translation(empty_sequence,'{}').
4181
4182 quantified_in_mode(F,S) :-
4183 quantified(F,S1), translate_in_mode(F,S1,S).
4184
4185 translate_in_mode(F,S1,Result) :-
4186 ( unicode_mode, unicode_translation(F,S) -> true
4187 ; latex_mode, latex_translation(F,S) -> true
4188 ; atelierb_mode(Mode), Mode == pp, atelierb_pp_translation(F,S) -> true
4189 ; colour_translation(F,S1,S) -> true
4190 ; S1=S),
4191 (colour_translation(F,S,Res) -> Result=Res ; Result=S).
4192
4193 :- use_module(tools_printing,[get_terminal_colour_code/2, no_color/0]).
4194 use_colour_codes :- \+ no_color,
4195 get_preference(pp_with_terminal_colour,true).
4196 colour_translation(F,S1,Result) :- use_colour_codes,
4197 colour_construct(F,Colour),!,
4198 get_terminal_colour_code(Colour,R1),
4199 get_terminal_colour_code(reset,R2),
4200 ajoin([R1,S1,R2],Result).
4201 colour_construct(pred_true,green).
4202 colour_construct(pred_false,red).
4203 colour_construct(boolean_true,green).
4204 colour_construct(boolean_false,red).
4205 colour_construct(truth,green).
4206 colour_construct(falsity,red).
4207 colour_construct(_,blue).
4208
4209 % pretty print a colour code if colours are enabled:
4210 pp_colour_code(Colour) --> {use_colour_codes,get_terminal_colour_code(Colour,C), atom_codes(C,CC)},!,CC.
4211 pp_colour_code(_) --> [].
4212
4213
4214 quantified(general_sum,'SIGMA').
4215 quantified(general_product,'PI').
4216 quantified(quantified_union,'UNION').
4217 quantified(quantified_intersection,'INTER').
4218 quantified(lambda,X) :- atom_codes(X,[37]).
4219 quantified(forall,'!').
4220 quantified(exists,'#').
4221
4222
4223 translate_prolog_constructor(C,R) :- unary_prefix(C,R,_),!.
4224 translate_prolog_constructor(C,R) :- unary_postfix(C,R,_),!.
4225 translate_prolog_constructor(C,R) :- binary_infix_in_mode(C,R,_,_),!.
4226 translate_prolog_constructor(C,R) :- function_like_in_mode(C,R),!.
4227 translate_prolog_constructor(C,R) :- constants_in_mode(C,R),!.
4228 translate_prolog_constructor(C,R) :- quantified_in_mode(C,R),!.
4229
4230 % translate the Prolog constuctor of an AST node into a form for printing to the user
4231 translate_prolog_constructor_in_mode(Constructor,Result) :-
4232 unicode_mode,
4233 unicode_translation(Constructor,Unicode),!, Result=Unicode.
4234 translate_prolog_constructor_in_mode(Constructor,Result) :-
4235 latex_mode,
4236 latex_translation(Constructor,Latex),!, Result=Latex.
4237 translate_prolog_constructor_in_mode(C,R) :- translate_prolog_constructor(C,R).
4238
4239 translate_subst_or_bexpr_in_mode(Mode,TExpr,String) :-
4240 with_translation_mode(Mode, translate_subst_or_bexpr(TExpr,String)).
4241
4242
4243 translate_bexpression_to_unicode(TExpr,String) :-
4244 with_translation_mode(unicode, translate_bexpression(TExpr,String)).
4245
4246 translate_bexpression(TExpr,String) :-
4247 (pp_expr(TExpr,String) -> true
4248 ; add_error(translate_bexpression,'Could not translate bexpression: ',TExpr),String='???').
4249
4250 translate_bexpression_to_codes(TExpr,Codes) :-
4251 reset_pp,
4252 pp_expr(TExpr,_,_LimitReached,Codes,[]).
4253
4254 pp_expr(TExpr,String) :-
4255 translate_bexpression_to_codes(TExpr,Codes),
4256 atom_codes_with_limit(String, Codes).
4257
4258 translate_bexpression_with_limit(T,S) :- translate_bexpression_with_limit(T,200,report_errors,S).
4259 translate_bexpression_with_limit(TExpr,Limit,String) :-
4260 translate_bexpression_with_limit(TExpr,Limit,report_errors,String).
4261 translate_bexpression_with_limit(TExpr,Limit,report_errors,String) :- compound(String),!,
4262 add_internal_error('Result is instantiated to a compound term:',
4263 translate_bexpression_with_limit(TExpr,Limit,report_errors,String)),fail.
4264 translate_bexpression_with_limit(TExpr,Limit,ReportErrors,String) :-
4265 (catch_call(pp_expr_with_limit(TExpr,Limit,String)) -> true
4266 ; (ReportErrors=report_errors,
4267 add_error(translate_bexpression,'Could not translate bexpression: ',TExpr),String='???')).
4268
4269 pp_expr_with_limit(TExpr,Limit,String) :-
4270 set_up_limit_reached(Codes,Limit,LimitReached),
4271 reset_pp,
4272 pp_expr(TExpr,_,LimitReached,Codes,[]),
4273 atom_codes_with_limit(String, Limit, Codes).
4274
4275
4276
4277 % pretty-type an expression, if the expression has a priority >MinPrio, parenthesis
4278 % can be ommitted, if not the expression has to be put into parenthesis
4279 pp_expr_m(TExpr,MinPrio,LimitReached,S,Srest) :-
4280 add_outer_paren(Prio,MinPrio,S,Srest,X,Xrest), % use co-routine to instantiate S as soon as possible
4281 pp_expr(TExpr,Prio,LimitReached,X,Xrest).
4282
4283 :- block add_outer_paren(-,?,?,?,?,?).
4284 add_outer_paren(Prio,MinPrio,S,Srest,X,Xrest) :-
4285 ( Prio > MinPrio -> % was >=, but problem with & / or with same priority or with non associative operators !
4286 S=X, Srest=Xrest
4287 ;
4288 [Open] = "(", [Close] = ")",
4289 S = [Open|X], Xrest = [Close|Srest]).
4290 % warning: if prio not set we will have a pending co-routine and instantiation_error in atom_codes later
4291
4292 :- use_module(translate_keywords,[classical_b_keyword/1, translate_keyword_id/2]).
4293 translated_identifier('_zzzz_binary',R) :- !,
4294 (latex_mode -> R='z''''' ; R='z__'). % TO DO: could cause clash with user IDs
4295 translated_identifier('_zzzz_unary',R) :- !,
4296 (latex_mode -> R='z''' ; R='z_'). % TO DO: ditto
4297 translated_identifier('__RANGE_LAMBDA__',R) :- !,
4298 (latex_mode -> R='\\rho\'' ; unicode_mode -> R= '\x03c1\' % RHO
4299 ; R = 'RANGE_LAMBDA__'). %ditto, could clash with user IDs !!
4300 % TO DO: do we need to treat _prj_arg1__, _prj_arg2__, _lambda_result_ here ?
4301 translated_identifier(ID,Result) :-
4302 latex_mode,!,
4303 my_greek_latex_escape_atom(ID,Greek,Res), %print_message(translate_latex(ID,Greek,Res)),
4304 (Greek=greek -> Result = Res ; ajoin(['\\mathit{',Res,'}'],Result)).
4305 translated_identifier(X,X).
4306
4307 pp_identifier(Atom) --> {id_requires_escaping(Atom), \+ eventb_translation_mode, \+ latex_mode}, !,
4308 ({atelierb_mode(_)}
4309 -> pp_identifier_for_atelierb(Atom)
4310 ; pp_backquoted_identifier(Atom)
4311 ).
4312 pp_identifier(Atom) --> ppatom_opt_scramble(Atom).
4313
4314 % print atom using backquotes, we use same escaping rules as in a string
4315 % requires B parser version 2.9.30 or newer
4316 pp_backquoted_identifier(Atom) --> {atom_codes(Atom,Codes)}, pp_backquoted_id_codes(Codes).
4317 pp_backquoted_id_codes(Codes) --> {append(Prefix,[0'. | Suffix],Codes), Suffix=[_|_]},
4318 !, % we need to split the id and quote each part separately; otherwise the parser will complain
4319 % see issue https://github.com/hhu-stups/prob-issues/issues/321
4320 % However, ids with dots are not accepted for constants and variables; so this does not solve all problems
4321 "`", pp_codes_opt_scramble(Prefix), "`.", % TODO: we could check if id_requires_escaping
4322 pp_backquoted_id_codes(Suffix).
4323 pp_backquoted_id_codes(Codes) --> "`", pp_codes_opt_scramble(Codes), "`".
4324
4325 :- use_module(tools_strings,[is_simple_classical_b_identifier/1]).
4326 id_requires_escaping(ID) :- classical_b_keyword(ID).
4327 ?id_requires_escaping(ID) :- \+ is_simple_classical_b_identifier(ID).
4328
4329 pp_identifier_for_atelierb(Atom) -->
4330 {atom_codes(Atom,Codes),
4331 strip_illegal_id_codes(Codes,Change,Codes2),
4332 Change==true},!,
4333 {atom_codes(A2,Codes2)},
4334 ppatom_opt_scramble(A2).
4335 pp_identifier_for_atelierb(Atom) --> ppatom_opt_scramble(Atom).
4336
4337 % remove illegal codes in an identifier (probably EventB or Z)
4338 strip_illegal_id_codes([0'_ | T ],Change,[946 | TR]) :- !, Change=true, strip_illegal_id_codes(T,_,TR).
4339 strip_illegal_id_codes(Codes,Change,Res) :- strip_illegal_id_codes2(Codes,Change,Res).
4340
4341 strip_illegal_id_codes2([],_,[]).
4342 strip_illegal_id_codes2([H|T],Change,Res) :- strip_code(H,Res,TR),!, Change=true, strip_illegal_id_codes2(T,_,TR).
4343 strip_illegal_id_codes2([H|T],Change,[H|TR]) :- strip_illegal_id_codes2(T,Change,TR).
4344
4345 strip_code(46,[0'_, 0'_ |T],T). % replace dot . by two underscores
4346 strip_code(36,[946|T],T) :- T \= [48]. % replace dollar $ by beta unless it is $0 at the end
4347 strip_code(92,[950|T],T). % replace dollar by zeta; probably from Zed
4348 % TODO: add more symbols and ensure that the new codes do not exist
4349
4350
4351
4352 :- use_module(tools,[latex_escape_atom/2]).
4353
4354 greek_or_math_symbol(Symbol) :- greek_symbol(Symbol,_).
4355 % other Latex math symbols
4356 greek_or_math_symbol('varepsilon').
4357 greek_or_math_symbol('varphi').
4358 greek_or_math_symbol('varpi').
4359 greek_or_math_symbol('varrho').
4360 greek_or_math_symbol('varsigma').
4361 greek_or_math_symbol('vartheta').
4362 greek_or_math_symbol('vdash').
4363 greek_or_math_symbol('models').
4364
4365 greek_symbol('Alpha','\x0391\').
4366 greek_symbol('Beta','\x0392\').
4367 greek_symbol('Chi','\x03A7\').
4368 greek_symbol('Delta','\x0394\').
4369 greek_symbol('Epsilon','\x0395\').
4370 greek_symbol('Eta','\x0397\').
4371 greek_symbol('Gamma','\x0393\').
4372 greek_symbol('Iota','\x0399\').
4373 greek_symbol('Kappa','\x039A\').
4374 greek_symbol('Lambda','\x039B\').
4375 greek_symbol('Mu','\x039C\').
4376 greek_symbol('Nu','\x039D\').
4377 greek_symbol('Phi','\x03A6\').
4378 greek_symbol('Pi','\x03A0\').
4379 greek_symbol('Psi','\x03A8\').
4380 greek_symbol('Rho','\x03A1\').
4381 greek_symbol('Omega','\x03A9\').
4382 greek_symbol('Omicron','\x039F\').
4383 greek_symbol('Sigma','\x03A3\').
4384 greek_symbol('Theta','\x0398\').
4385 greek_symbol('Upsilon','\x03A5\').
4386 greek_symbol('Xi','\x039E\').
4387 greek_symbol('alpha','\x03B1\').
4388 greek_symbol('beta','\x03B2\').
4389 greek_symbol('delta','\x03B4\').
4390 greek_symbol('chi','\x03C7\').
4391 greek_symbol('epsilon','\x03B5\').
4392 greek_symbol('eta','\x03B7\').
4393 greek_symbol('gamma','\x03B3\').
4394 greek_symbol('iota','\x03B9\').
4395 greek_symbol('kappa','\x03BA\').
4396 greek_symbol('lambda','\x03BB\').
4397 greek_symbol('mu','\x03BC\').
4398 greek_symbol('nu','\x03BD\').
4399 greek_symbol('omega','\x03C9\').
4400 greek_symbol('omicron','\x03BF\').
4401 greek_symbol('pi','\x03C0\').
4402 greek_symbol('phi','\x03C6\').
4403 greek_symbol('psi','\x03C8\').
4404 greek_symbol('rho','\x03C1\').
4405 greek_symbol('sigma','\x03C3\').
4406 greek_symbol('tau','\x03C4\').
4407 greek_symbol('theta','\x03B8\').
4408 greek_symbol('upsilon','\x03C5\').
4409 greek_symbol('xi','\x03BE\').
4410 greek_symbol('zeta','\x03B6\').
4411
4412
4413 my_greek_latex_escape_atom(A,greek,Res) :-
4414 greek_or_math_symbol(A),get_preference(latex_pp_greek_ids,true),!,
4415 atom_concat('\\',A,Res).
4416 my_greek_latex_escape_atom(A,no_greek,EA) :- latex_escape_atom(A,EA).
4417
4418 % ppatom + scramble if BUGYLY is TRUE
4419 ppatom_opt_scramble(Name) --> {get_preference(bugly_pp_scrambling,true)},
4420 % {\+ bmachine:b_top_level_operation(Name)}, % comment in to not change name of B operations
4421 !,
4422 {bugly_scramble_id(Name,ScrName)},
4423 ppatom(ScrName).
4424 ppatom_opt_scramble(Name) -->
4425 {primes_to_unicode(Name, UnicodeName)},
4426 pp_atom_opt_latex(UnicodeName).
4427
4428 % Convert ASCII primes (apostrophes) in identifiers to Unicode primes
4429 % so they can be parsed by the classical B parser.
4430 primes_to_unicode(Name, UnicodeName) :-
4431 atom_codes(Name, Codes),
4432 phrase(primes_to_unicode(Codes), UCodes),
4433 atom_codes(UnicodeName, UCodes).
4434 primes_to_unicode([0'\'|T]) --> !,
4435 "\x2032\",
4436 primes_to_unicode(T).
4437 primes_to_unicode([C|T]) --> !,
4438 [C],
4439 primes_to_unicode(T).
4440 primes_to_unicode([]) --> "".
4441
4442 :- use_module(tools,[b_string_escape_codes/2]).
4443 :- use_module(tools_strings,[convert_atom_to_number/2]).
4444 % a version of ppatom which encodes/quotes symbols inside strings such as quotes "
4445 ppstring_opt_scramble(Name) --> {var(Name)},!,ppatom(Name).
4446 ppstring_opt_scramble(Name) --> {get_preference(bugly_pp_scrambling,true)},!,
4447 pp_bugly_composed_string(Name).
4448 ppstring_opt_scramble(Name) --> {atom_codes(Name,Codes),b_string_escape_codes(Codes,EscCodes)},
4449 pp_codes_opt_latex(EscCodes).
4450
4451 % a version of ppstring_opt_scramble with codes list
4452 pp_codes_opt_scramble(Codes) --> {get_preference(bugly_pp_scrambling,true)},!,
4453 pp_bugly_composed_string_codes(Codes,[]).
4454 pp_codes_opt_scramble(Codes) --> {b_string_escape_codes(Codes,EscCodes)},
4455 pp_codes_opt_latex(EscCodes).
4456
4457 pp_bugly_composed_string(Name) --> {atom_codes(Name,Codes)},
4458 !, % we can decompose the string; scramble each string separately; TODO: provide option to define separators
4459 % idea is that if we have a string with spaces or other special separators we preserve the separators
4460 pp_bugly_composed_string_codes(Codes,[]).
4461
4462 pp_bugly_composed_string_codes([],Acc) --> {atom_codes(Atom,Acc)}, pp_bugly_string(Atom).
4463 pp_bugly_composed_string_codes(List,Acc) --> {decompose_string(List,Seps,T)},!,
4464 {reverse(Acc,Rev),atom_codes(Atom,Rev)}, pp_bugly_string(Atom),
4465 ppcodes(Seps),
4466 pp_bugly_composed_string_codes(T,[]).
4467 pp_bugly_composed_string_codes([H|T],Acc) --> pp_bugly_composed_string_codes(T,[H|Acc]).
4468
4469 decompose_string([Sep|T],[Sep],T) :- bugly_separator(Sep).
4470 % comment in and adapt for domain specific separators:
4471 %decompose_string(List,Seps,T) :- member(Seps,["LEU","DEF","BAL"]), append(Seps,T,List).
4472 %bugly_separator(10).
4473 %bugly_separator(13).
4474 bugly_separator(32).
4475 bugly_separator(0'-).
4476 bugly_separator(0'_).
4477 bugly_separator(0',).
4478 bugly_separator(0'.).
4479 bugly_separator(0';).
4480 bugly_separator(0':).
4481 bugly_separator(0'#).
4482 bugly_separator(0'[).
4483 bugly_separator(0']).
4484 bugly_separator(0'().
4485 bugly_separator(0')).
4486
4487 % scramble and pretty print individual strings or components of strings
4488 pp_bugly_string('') --> !, [].
4489 pp_bugly_string(Name) -->
4490 {convert_atom_to_number(Name,_)},!, % do not scramble numbers; we could check if LibraryStrings is available
4491 pp_atom_opt_latex(Name).
4492 pp_bugly_string(Name) -->
4493 {bugly_scramble_id(Name,ScrName)},
4494 ppatom(ScrName).
4495
4496 % ------------
4497
4498 pp_atom_opt_latex(Name) --> {latex_mode},!,
4499 {my_greek_latex_escape_atom(Name,_,EscName)},
4500 % should we add \mathrm{.} or \mathit{.}?
4501 ppatom(EscName).
4502 pp_atom_opt_latex(Name) --> ppatom(Name).
4503
4504 % a version of pp_atom_opt_latex working with codes
4505 pp_codes_opt_latex(Codes) --> {latex_mode},!,
4506 {atom_codes(Name,Codes),my_greek_latex_escape_atom(Name,_,EscName)},
4507 ppatom(EscName).
4508 pp_codes_opt_latex(Codes) --> ppcodes(Codes).
4509
4510 pp_atom_opt_latex_mathit(Name) --> {latex_mode},!,
4511 {latex_escape_atom(Name,EscName)},
4512 "\\mathit{",ppatom(EscName),"}".
4513 pp_atom_opt_latex_mathit(Name) --> ppatom(Name).
4514
4515 pp_atom_opt_mathit(EscName) --> {latex_mode},!,
4516 % we assume already escaped
4517 "\\mathit{",ppatom(EscName),"}".
4518 pp_atom_opt_mathit(Name) --> ppatom(Name).
4519
4520 pp_space --> {latex_mode},!, "\\ ".
4521 pp_space --> " ".
4522
4523 opt_scramble_id(ID,Res) :- get_preference(bugly_pp_scrambling,true),!,
4524 bugly_scramble_id(ID,Res).
4525 opt_scramble_id(ID,ID).
4526
4527 :- use_module(probsrc(gensym),[gensym/2]).
4528 :- dynamic bugly_scramble_id_cache/2.
4529 bugly_scramble_id(ID,Res) :- var(ID),!, add_internal_error('Illegal call: ',bugly_scramble_id(ID,Res)), ID=Res.
4530 bugly_scramble_id(ID,Res) :- bugly_scramble_id_cache(ID,ScrambledID),!,
4531 Res=ScrambledID.
4532 bugly_scramble_id(ID,Res) :- %print(gen_id(ID,Res)),nl,
4533 genbuglynr(Nr),
4534 gen_bugly_id(Nr,ScrambledID),
4535 assertz(bugly_scramble_id_cache(ID,ScrambledID)),
4536 %format(user_output,'BUGLY scramble ~w --> ~w~n',[ID,ScrambledID]),
4537 Res = ScrambledID.
4538
4539 gen_bugly_id_codes(Nr,[Char|TC]) :- Char is 97+ Nr mod 26,
4540 (Nr> 25 -> N1 is Nr // 26, gen_bugly_id_codes(N1,TC) ; TC=[]).
4541 gen_bugly_id(Nr,ScrambledID) :- gen_bugly_id_codes(Nr,Codes), atom_codes(ScrambledID,[97,97|Codes]).
4542 %gen_bugly_id(Nr,ScrambledID) :- ajoin(['aa',Nr],ScrambledID). % old version using aaNr
4543
4544 :- dynamic bugly_count/1.
4545 bugly_count(0).
4546 genbuglynr(Nr) :-
4547 retract(bugly_count(Nr)), N1 is Nr + 1,
4548 assertz(bugly_count(N1)).
4549
4550
4551 is_lambda_result_id(b(identifier(ID),_,_INFO),Suffix) :- % _INFO=[lambda_result], sometiems _INFO=[]
4552 is_lambda_result_name(ID,Suffix).
4553 is_lambda_result_name(LAMBDA_RESULT,Suffix) :- atomic(LAMBDA_RESULT),
4554 atom_codes(LAMBDA_RESULT,[95,108,97,109,98,100,97,95,114,101,115,117,108,116,95|Suffix]). % _lambda_result_
4555
4556 pp_expr(TE,P) --> %{print('OBSOLETE'),nl,nl},
4557 pp_expr(TE,P,_LimitReached).
4558
4559 pp_expr(TExpr,Prio,_) --> {var(TExpr)},!,"_",{Prio=500}.
4560 pp_expr(_,Prio,LimitReached) --> {LimitReached==limit_reached},!,"...",{Prio=500}.
4561 pp_expr(b(Expr,Type,Info),Prio,LimitReached) --> !,
4562 pp_expr0(Expr,Type,Info,Prio,LimitReached).
4563 pp_expr(Expr,Prio,LimitReached) -->
4564 pp_expr1(Expr,any,[],Prio,LimitReached).
4565
4566 pp_expr0(identifier(ID),_Type,_Info,Prio,_LimitReached) --> {is_lambda_result_name(ID,Suffix)},!, {Prio=500},
4567 {append("LAMBDA_RESULT___",Suffix,ASCII), atom_codes(R,ASCII)}, ppatom(R).
4568 pp_expr0(Expr,_Type,Info,Prio,_LimitReached) -->
4569 {eventb_translation_mode},
4570 pp_theory_operator(Expr,Info,Prio),!.
4571 pp_expr0(Expr,Type,Info,Prio,LimitReached) -->
4572 {check_info(Expr,Type,Info)},
4573 pp_rodin_label(Info),
4574 (pp_expr1(Expr,Type,Info,Prio,LimitReached) -> {true}
4575 ; {add_error(translate,'Could not translate:',Expr,Expr),fail}
4576 ).
4577
4578 check_info(Expr,_,Info) :- var(Info), add_error(translate,'Illegal variable info field for expression: ', Expr),fail.
4579 check_info(_,_,_).
4580
4581 pp_theory_operator(general_sum(_,Membercheck,_),_Info,500) -->
4582 {get_texpr_expr(Membercheck,member(_,Arg))},
4583 ppatom('SUM('),pp_expr(Arg,_),ppatom(')').
4584 pp_theory_operator(general_product(_,Membercheck,_),_Info,500) -->
4585 {get_texpr_expr(Membercheck,member(_Couple,Arg))},
4586 ppatom('PRODUCT('),pp_expr(Arg,_),ppatom(')').
4587 pp_theory_operator(function(_,Arg),Info,500) -->
4588 {memberchk_in_info(theory_operator(O,N),Info),decouplise_expr(N,Arg,Args)},
4589 ppatom(O),"(",pp_expr_l_sep(Args,",",_LR),")".
4590 pp_theory_operator(member(Arg,_),Info,500) -->
4591 {memberchk_in_info(theory_operator(O,N),Info),decouplise_expr(N,Arg,Args)},
4592 ppatom(O),"(",pp_expr_l_sep(Args,",",_LR),")".
4593
4594 decouplise_expr(1,E,R) :- !,R=[E].
4595 decouplise_expr(N,E,R) :-
4596 get_texpr_expr(E,couple(A,B)),!,
4597 N2 is N-1,
4598 decouplise_expr(N2,A,R1),append(R1,[B],R).
4599 decouplise_expr(N,E,[E]) :-
4600 print_message(call_failed(decouplise_expr(N,E,_))),nl.
4601
4602 % will pretty print (first) rodin or pragma label
4603 pp_rodin_label(_Infos) --> {preference(translate_suppress_rodin_positions_flag,true),!}.
4604 pp_rodin_label(_Infos) --> {preference(bugly_pp_scrambling,true),!}.
4605 pp_rodin_label(Infos) --> {var(Infos)},!, "/* ILLEGAL VARIABLE INFO FIELD */".
4606 pp_rodin_label(Infos) --> {get_info_labels(Infos,Label)},!,
4607 pp_start_label_pragma,
4608 ppatoms_opt_latex(Label),
4609 pp_end_label_pragma.
4610 pp_rodin_label(Infos) --> {preference(pp_wd_infos,true)},!, pp_wd_info(Infos).
4611 pp_rodin_label(_Infos) --> [].
4612
4613 % print infos about well-definedness attached to AST node:
4614 pp_wd_info(Infos) --> {member(discharged_wd_po,Infos)},!, "/*D",
4615 ({member(contains_wd_condition,Infos)} -> "-WD*/ " ; "*/ ").
4616 pp_wd_info(Infos) --> {member(contains_wd_condition,Infos)},!, "/*WD*/ ".
4617 pp_wd_info(_Infos) --> [].
4618
4619 pp_start_label_pragma -->
4620 {(atelierb_mode(Mode), Mode == pp
4621 ; get_preference(translate_print_typing_infos,true))}, % proxy for parseable;
4622 % set by translate_bvalue_to_parseable_classicalb; important for parsertests with labels
4623 !,
4624 "/*@label ".
4625 pp_start_label_pragma --> "/* @". % shorter version, for viewing in UI
4626 pp_end_label_pragma --> " */ ".
4627
4628 ppatoms([]) --> !, [].
4629 ppatoms([ID|T]) --> !,ppatom(ID), " ", ppatoms(T).
4630 ppatoms(X) --> {add_error(ppatoms,'Not a list of atoms: ',ppatoms(X))}.
4631
4632 ppatoms_opt_latex([]) --> !, [].
4633 ppatoms_opt_latex([ID]) --> !,pp_atom_opt_latex(ID).
4634 ppatoms_opt_latex([ID|T]) --> !,pp_atom_opt_latex(ID), " ", ppatoms_opt_latex(T).
4635 ppatoms_opt_latex(X) --> {add_error(ppatoms_opt_latex,'Not a list of atoms: ',ppatoms_opt_latex(X))}.
4636
4637 %:- use_module(bsyntaxtree,[is_set_type/2]).
4638 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
4639 pp_expr1(Expr,_,_,Prio,_) --> {var(Expr)},!,"_",{Prio=500}.
4640 pp_expr1(event_b_comprehension_set(Ids,E,P),Type,_Info,Prio,LimitReached) -->
4641 {b_ast_cleanup:rewrite_event_b_comprehension_set(Ids,E,P,Type, NewExpression)},!,
4642 pp_expr(NewExpression,Prio,LimitReached).
4643 pp_expr1(union(b(event_b_identity,Type,_), b(closure(Rel),Type,_)),_,Info,500,LimitReached) -->
4644 /* closure(Rel) = id \/ closure1(Rel) */
4645 ? {member_in_info(was(reflexive_closure),Info)},!,
4646 "closure(",pp_expr(Rel,_,LimitReached),")".
4647 pp_expr1(comprehension_set([_],_),_,Info,500,_LimitReached) -->
4648 {memberchk_in_info(freetype(P),Info),!},ppatom(P).
4649 % used instead of constants(Expr,Symbol) case below:
4650 pp_expr1(greater_equal(A,Y),Type,Info,Prio,LimitReached) --> % x:NATURAL was rewritten to x>=0, see test 499, 498
4651 {memberchk_in_info(was(member(A,B)),Info), get_integer(Y,_)},
4652 pp_expr1(member(A,B),Type,Info,Prio,LimitReached).
4653 pp_expr1(comprehension_set([TID],b(B,_,_)),Type,Info,Prio,LimitReached) -->
4654 {memberchk_in_info(was(integer_set(S)),Info)},
4655 {S='INTEGER' -> B=truth
4656 ; get_texpr_id(TID,ID),
4657 B=greater_equal(TID2,Y), get_integer(Y,I),
4658 get_texpr_id(TID2,ID),
4659 (I=0 -> S='NATURAL' ; I=1,S='NATURAL1')}, % TO DO: check bounds
4660 !,
4661 pp_expr1(integer_set(S),Type,Info,Prio,LimitReached).
4662 pp_expr1(interval(b(A,_,_),B),Type,Info,Prio,LimitReached) -->
4663 {memberchk_in_info(was(integer_set(S)),Info)},
4664 {B=b(max_int,integer,_)}, % TO DO ? allow value(int(Mx))
4665 {A=min_int -> S='INT' ; A=integer(0) -> S='NAT' ; A=integer(1),S='NAT1'},
4666 !,
4667 pp_expr1(integer_set(S),Type,Info,Prio,LimitReached).
4668 pp_expr1(falsity,_,Info,Prio,LimitReached) --> {memberchk_in_info(was(Pred),Info)},!,
4669 ({(unicode_mode ; latex_mode)}
4670 -> {translate_in_mode(falsity,'falsity',Symbol)},
4671 ppatom(Symbol),
4672 ({get_preference(pp_propositional_logic_mode,true)} -> {true}
4673 ; " ", enter_comment, " ", pp_expr2(Pred,Prio,LimitReached), " ", exit_comment)
4674 ; enter_comment, " falsity ",exit_comment, " ",
4675 pp_expr2(Pred,Prio,LimitReached)). % Pred is not wrapped
4676 pp_expr1(truth,_,Info,Prio,LimitReached) --> {memberchk_in_info(was(Pred),Info)},!,
4677 ({(unicode_mode ; latex_mode)}
4678 -> {translate_in_mode(truth,'truth',Symbol)},
4679 ppatom(Symbol),
4680 ({get_preference(pp_propositional_logic_mode,true)} -> {true}
4681 ; " ",enter_comment, " ", pp_expr2(Pred,Prio,LimitReached), " ", exit_comment)
4682 ; enter_comment, " truth ", exit_comment, " ",
4683 pp_expr2(Pred,Prio,LimitReached)). % Pred is not wrapped
4684 % TO DO: do this for other expressions as well; but then we have to ensure that ast_cleanup generates complete was(_) infos
4685 % :- load_files(library(system), [when(compile_time), imports([environ/2])]). % directive moved above to avoid Spider warning
4686 pp_expr1(event_b_identity,Type,_Info,500,_LimitReached) -->
4687 {\+ eventb_translation_mode}, %{atelierb_mode(Mode), Mode == pp},
4688 {is_set_type(Type,couple(ElType,ElType))},
4689 !,
4690 "id(", {pretty_normalized_type(ElType,S)},ppatom(S), ")".
4691 pp_expr1(typeset,SType,_Info,500,_LimitReached) --> % normally removed by ast_cleanup
4692 {is_set_type(SType,Type)},
4693 !,
4694 "(", {pretty_normalized_type(Type,S)},ppatom(S), ")".
4695 :- if(environ(prob_safe_mode,true)).
4696 pp_expr1(exists(Parameters,_),_,Info,_Prio,_LimitReached) -->
4697 {\+ member_in_info(used_ids(_),Info),
4698 add_error(translate,'Missing used_ids Info for exists: ',Parameters:Info),fail}.
4699 %pp_expr1(exists(Ids,P1),_,Info,250) --> !, { member_in_info(used_ids(Used),Info)},
4700 % exists_symbol,pp_expr_ids_in_mode(Ids,LimitReached),
4701 % {add_normal_typing_predicates(Ids,P1,P)},
4702 % " /* Used = ", ppterm(Used), " */ ",
4703 % ".",pp_expr_m(P,221).
4704 :- endif.
4705 pp_expr1(Expr,_,Info,Prio,LimitReached) --> {member_in_info(sharing(ID,Count,_,_),Info),number(Count),Count>1},!,
4706 "( ",enter_comment," CSE ",ppnumber(ID), ":#", ppnumber(Count),
4707 ({member_in_info(negated_cse,Info)} -> " (neg) " ; " "),
4708 ({member_in_info(contains_wd_condition,Info)} -> " (wd) " ; " "),
4709 exit_comment, " ",
4710 pp_expr2(Expr,Prio,LimitReached), ")".
4711 %pp_expr1(Expr,_,Info,Prio) --> {member_in_info(contains_wd_condition,Info)},!,
4712 % "( /* (wd) */ ", pp_expr2(Expr,Prio), ")".
4713 % pp_expr1(Expr,subst,_Info,Prio) --> !, translate_subst2(Expr,Prio). % TO DO: also allow substitutions here
4714 pp_expr1(value(V),Type,_,Prio,LimitReached) --> !,
4715 {(nonvar(V),V=closure(_,_,_) -> Prio=300 ; Prio=500)}, pp_value_with_type(V,Type,LimitReached).
4716 pp_expr1(comprehension_set(Ids,P1),_,Info,500,LimitReached) --> !,
4717 pp_comprehension_set(Ids,P1,Info,LimitReached).
4718 %pp_expr1(Expr,_,Info,Prio,LimitReached) --> {pp_is_important_info_field(Expr,Info,_)},
4719 % !, pp_important_infos(Expr,Info), pp_expr2(Expr,Prio,LimitReached).
4720 pp_expr1(first_of_pair(X),_,Info,500,LimitReached) --> {was_eventb_destructor(Info,X,Op,Arg)},!,
4721 ppatom(Op), "(",pp_expr(Arg,_,LimitReached), ")".
4722 pp_expr1(second_of_pair(X),_,Info,500,LimitReached) --> {was_eventb_destructor(Info,X,Op,Arg)},!,
4723 ppatom(Op), "(",pp_expr(Arg,_,LimitReached), ")".
4724 %pp_expr1(let_expression(_Ids,Exprs,_P),_Type,Info,500,LimitReached) -->
4725 % % pretty print direct definition operator calls, which get translated using create_z_let
4726 % % However: the lets can get removed; in which case the translated direct definition will be pretty printed
4727 % % also: what if the body of the let has been modified ??
4728 % {member(was(extended_expr(DirectDefOp)),Info),
4729 % bmachine_eventb:stored_operator_direct_definition(DirectDefOp,_Proj,_Theory,Parameters,_Def,_WD,_TypeParas,_Kind),
4730 % %length(Exprs,Arity),,length(Parameters,Arity1), write(found_dd(DirectDefOp,Arity1,Arity2,Proj,Theory)),nl,
4731 % same_length(Parameters,ActualParas), %same_length(TypeParameters,TP),
4732 % append(ActualParas,_TP,Exprs)
4733 % },
4734 % !,
4735 % ppatom(DirectDefOp),
4736 % pp_expr_wrap_l('(',ActualParas,')',LimitReached).
4737 pp_expr1(Expr,_,_Info,Prio,LimitReached) --> pp_expr2(Expr,Prio,LimitReached).
4738
4739 was_eventb_destructor(Info,X,Op,Arg) :- eventb_translation_mode,
4740 member(was(extended_expr(Op)),Info),peel_projections(X,Arg).
4741 is_projection(first_of_pair(A),A).
4742 is_projection(second_of_pair(A),A).
4743 % peel projections constructed for Event-B destructor operator
4744 peel_projections(b(A,_,_),R) :-
4745 (is_projection(A,RA) -> peel_projections(RA,R)
4746 ; A = freetype_destructor(_,_,R)).
4747
4748
4749 :- public pp_important_infos/4. % debugging utility
4750 pp_important_infos(Expr,Info) -->
4751 {findall(PPI,pp_is_important_info_field(Expr,Info,PPI),PPInfos), PPInfos \= []},
4752 " ", enter_comment, ppterm(PPInfos), exit_comment, " ".
4753 pp_is_important_info_field(_,Infos,'DO_NOT_ENUMERATE'(X)) :- member(prob_annotation('DO_NOT_ENUMERATE'(X)),Infos).
4754 pp_is_important_info_field(exists(_,_),Infos,'LIFT') :- member(allow_to_lift_exists,Infos).
4755 pp_is_important_info_field(exists(_,_),Infos,used_ids(Used)) :- member(used_ids(Used),Infos).
4756 pp_is_important_info_field(exists(_,_),Infos,'(wd)') :- member(contains_wd_condition,Infos).
4757
4758
4759 pp_expr2(Expr,_,_LimitReached) --> {var(Expr)},!,"_".
4760 pp_expr2(_,_,LimitReached) --> {LimitReached==limit_reached},!,"...".
4761 pp_expr2(atom_string(V),500,_) --> !,pp_atom_opt_latex_mathit(V). % hardwired_atom
4762 pp_expr2(global_set(V),500,_) --> !, pp_identifier(V).
4763 pp_expr2(freetype_set(V),500,_) --> !,{pretty_freetype(V,P)},ppatom_opt_scramble(P).
4764 pp_expr2(lazy_lookup_expr(I),500,_) --> !, pp_identifier(I).
4765 pp_expr2(lazy_lookup_pred(I),500,_) --> !, pp_identifier(I).
4766 pp_expr2(identifier(I),500,_) --> !,
4767 {( I=op(Id) -> true; I=Id)},
4768 ( {atomic(Id)} -> ({translated_identifier(Id,TId)},
4769 ({latex_mode} -> ppatom(TId) ; pp_identifier(TId)))
4770 ;
4771 "'",ppterm(Id), "'").
4772 pp_expr2(integer(N),500,_) --> !, ppnumber(N).
4773 pp_expr2(real(N),500,_) --> !, ppatom(N).
4774 pp_expr2(integer_set(S),500,_) --> !,
4775 {integer_set_mapping(S,T)},ppatom(T).
4776 pp_expr2(string(S),500,_) --> !, string_start_symbol, ppstring_opt_scramble(S), string_end_symbol.
4777 pp_expr2(set_extension(Ext),500,LimitReached) --> !, {set_brackets(L,R)},
4778 pp_expr_wrap_l(L,Ext,R,LimitReached).
4779 pp_expr2(sequence_extension(Ext),500,LimitReached) --> !,
4780 pp_begin_sequence,
4781 ({get_preference(translate_print_cs_style_sequences,true)} -> pp_expr_l_sep(Ext,"",LimitReached)
4782 ; pp_expr_l_sep(Ext,",",LimitReached)),
4783 pp_end_sequence.
4784 pp_expr2(assign(LHS,RHS),10,LimitReached) --> !,
4785 pp_expr_wrap_l(',',LHS,'',LimitReached), ":=", pp_expr_wrap_l(',',RHS,'',LimitReached).
4786 pp_expr2(assign_single_id(LHS,RHS),10,LimitReached) --> !, pp_expr2(assign([LHS],[RHS]),10,LimitReached).
4787 pp_expr2(parallel(RHS),10,LimitReached) --> !,
4788 pp_expr_wrap_l('||',RHS,'',LimitReached).
4789 pp_expr2(sequence(RHS),10,LimitReached) --> !,
4790 pp_expr_wrap_l(';',RHS,'',LimitReached).
4791 pp_expr2(event_b_comprehension_set(Ids,E,P1),500,LimitReached) --> !, % normally conversion above should trigger; this is if we call pp_expr for untyped expressions
4792 pp_event_b_comprehension_set(Ids,E,P1,LimitReached).
4793 pp_expr2(recursive_let(Id,S),500,LimitReached) --> !,
4794 ({eventb_translation_mode} -> "" % otherwise we get strange characters in Rodin
4795 ; enter_comment," recursive ID ", pp_expr(Id,_,LimitReached), " ", exit_comment),
4796 pp_expr(S,_,LimitReached).
4797 pp_expr2(image(A,B),300,LimitReached) --> !,
4798 pp_expr_m(A,249,LimitReached),"[", % was 0; but we may have to bracket A; e.g., f <| {2} [{2}] is not ok; 250 is priority of lambda
4799 pp_expr_m(B,0,LimitReached),"]". % was 500, now set to 0: we never need an outer pair of () !?
4800 pp_expr2(function(A,B),300,LimitReached) --> !,
4801 pp_expr_m(A,249,LimitReached), % was 0; but we may have to bracket A; e.g., f <| {2} (2) is not ok; 250 is priority of lambda
4802 pp_function_left_bracket,
4803 pp_expr_m(B,0,LimitReached), % was 500, now set to 0: we never need an outer pair of () !?
4804 pp_function_right_bracket.
4805 pp_expr2(definition(A,B),300,LimitReached) --> !, % definition call; usually inlined,...
4806 ppatom(A),
4807 pp_function_left_bracket,
4808 pp_expr_l_sep(B,",",LimitReached),
4809 pp_function_right_bracket.
4810 pp_expr2(operation_call_in_expr(A,B),300,LimitReached) --> !,
4811 pp_expr_m(A,249,LimitReached),
4812 pp_function_left_bracket,
4813 pp_expr_l_sep(B,",",LimitReached),
4814 pp_function_right_bracket.
4815 pp_expr2(enumerated_set_def(GS,ListEls),200,LimitReached) --> !, % for pretty printing enumerate set defs
4816 {reverse(ListEls,RLE)}, /* they have been inserted in inverse order */
4817 pp_identifier(GS), "=", pp_expr_wrap_l('{',RLE,'}',LimitReached).
4818 pp_expr2(forall(Ids,D1,P),Prio,LimitReached) --> !,
4819 ({eventb_translation_mode} -> {Prio=60} ; {Prio=250}), % in Rodin forall/exists cannot be mixed with &, or, <=>, ...
4820 forall_symbol,pp_expr_ids_in_mode(Ids,LimitReached),
4821 {add_normal_typing_predicates(Ids,D1,D)},
4822 dot_symbol,pp_expr_m(b(implication(D,P),pred,[]),221,LimitReached).
4823 pp_expr2(exists(Ids,P1),Prio,LimitReached) --> !,
4824 ({eventb_translation_mode} -> {Prio=60} ; {Prio=250}),
4825 exists_symbol,pp_expr_ids_in_mode(Ids,LimitReached),
4826 {add_normal_typing_predicates(Ids,P1,P)},
4827 dot_symbol,
4828 ({eventb_translation_mode} -> {MinPrio=29} ; {MinPrio=500}), % used to be 221, but #x.x>7 or #x.not(...) are not parsed by Atelier-B or ProB, x.x and x.not are parsed as composed identifiers
4829 pp_expr_m(P,MinPrio,LimitReached).
4830 pp_expr2(record_field(R,I),250,LimitReached) --> !,
4831 pp_expr_m(R,251,LimitReached),"'",pp_identifier(I).
4832 pp_expr2(rec(Fields),500,LimitReached) --> !,
4833 {function_like_in_mode(rec,Symbol)},
4834 ppatom(Symbol), "(",pp_expr_fields(Fields,LimitReached),")".
4835 pp_expr2(struct(Rec),500,LimitReached) -->
4836 {get_texpr_expr(Rec,rec(Fields)),Val=false ; get_texpr_expr(Rec,value(rec(Fields)))},!,
4837 {function_like_in_mode(struct,Symbol)},
4838 ppatom(Symbol), "(",
4839 ({Val==false} -> pp_expr_fields(Fields,LimitReached)
4840 ; pp_value_l(Fields,',',LimitReached)),
4841 ")".
4842 pp_expr2(freetype_case(FT,L,Expr),500,LimitReached) --> !,
4843 pp_freetype_term('__is_ft_case',FT,L,Expr,LimitReached).
4844 pp_expr2(freetype_constructor(_FT,L,Expr),500,LimitReached) --> !,
4845 ppatom_opt_scramble(L),ppatom('('),pp_expr(Expr,_,LimitReached),ppatom(')').
4846 pp_expr2(freetype_destructor(FT,Case,Expr),500,LimitReached) --> !,
4847 ({unicode_mode}
4848 -> {unicode_translation(reverse,PowMinus1Symbol)},
4849 ppatom(Case),ppatom(PowMinus1Symbol), % Note: we do not print the freetype's name FT
4850 "(",pp_expr_m(Expr,0,LimitReached),")"
4851 ; pp_freetype_term('__ft~',FT,Case,Expr,LimitReached) % TODO: maybe find better print
4852 ).
4853 pp_expr2(let_predicate(Ids,Exprs,P),1,LimitReached) --> !,
4854 pp_expr_let_exists(Ids,Exprs,P,LimitReached). % instead of pp_expr_let
4855 pp_expr2(let_expression(Ids,Exprs,P),1,LimitReached) --> !,
4856 pp_expr_let(Ids,Exprs,P,LimitReached).
4857 pp_expr2(let_expression_global(Ids,Exprs,P),1,LimitReached) --> !, " /", "* global *", "/ ",
4858 pp_expr_let(Ids,Exprs,P,LimitReached).
4859 pp_expr2(lazy_let_pred(Id,Expr,P),Pr,LimitReached) --> !, pp_expr2(lazy_let_expr(Id,Expr,P),Pr,LimitReached).
4860 pp_expr2(lazy_let_subst(Id,Expr,P),Pr,LimitReached) --> !, pp_expr2(lazy_let_expr(Id,Expr,P),Pr,LimitReached).
4861 pp_expr2(lazy_let_expr(Id,Expr,P),1,LimitReached) --> !,
4862 pp_expr_let([Id],[Expr],P,LimitReached).
4863 pp_expr2(norm_conjunct(Cond,[]),1,LimitReached) --> !, % norm_conjunct: flattened version generated by b_interpreter_check,...
4864 "( ",pp_expr(Cond,_,LimitReached), ")".
4865 pp_expr2(norm_conjunct(Cond,[H|T]),1,LimitReached) --> !,
4866 "( ",pp_expr(Cond,_,LimitReached), ") ", and_symbol, " (", pp_expr2(norm_conjunct(H,T),_,LimitReached), ")".
4867 pp_expr2(assertion_expression(Cond,Msg,Expr),1,LimitReached) --> !,
4868 " ASSERT_EXPR (",
4869 pp_expr_m(b(convert_bool(Cond),pred,[]),30,LimitReached), ",",
4870 pp_expr_m(string(Msg),30,LimitReached), ",",
4871 pp_expr_m(Expr,30,LimitReached),
4872 " )".
4873 %pp_expr2(assertion_expression(Cond,_Msg,Expr),1) --> !,
4874 % "__ASSERT ",pp_expr_m(Cond,30),
4875 % " IN ", pp_expr_m(Expr,30).
4876 pp_expr2(partition(S,Elems),500,LimitReached) -->
4877 {eventb_translation_mode ;
4878 \+ atelierb_mode(_), length(Elems,Len), Len>50 % we need to print a quadratic number of disjoints
4879 },!,
4880 "partition(",pp_expr(S,_,LimitReached),
4881 ({Elems=[]} -> ")" ; pp_expr_wrap_l(',',Elems,')',LimitReached)).
4882 pp_expr2(partition(S,Elems),500,LimitReached) --> !,
4883 "(",pp_expr(S,_,LimitReached), " = ",
4884 ({Elems=[]} -> "{})"
4885 ; pp_expr_l_sep(Elems,"\\/",LimitReached), pp_all_disjoint(Elems,LimitReached),")").
4886 pp_expr2(finite(S),Prio,LimitReached) --> {\+ eventb_translation_mode}, %{atelierb_mode(_)},
4887 !,
4888 pp_expr2(member(S,b(fin_subset(S),set(any),[])),Prio,LimitReached).
4889 pp_expr2(if_then_else(If,Then,Else),1,LimitReached) --> {animation_minor_mode(z)},!,
4890 "\\IF ",pp_expr_m(If,30,LimitReached),
4891 " \\THEN ",pp_expr_m(Then,30,LimitReached),
4892 " \\ELSE ",pp_expr_m(Else,30,LimitReached).
4893 %pp_expr2(if_then_else(If,Then,Else),1) --> {unicode_mode},!,
4894 % "if ",pp_expr_m(If,30), " then ",pp_expr_m(Then,30), " else ",pp_expr_m(Else,30).
4895 pp_expr2(if_then_else(If,Then,Else),Prio,LimitReached) --> {atelierb_mode(_)},!,
4896 % print IF-THEN-ELSE using a translation that Atelier-B can understand:
4897 {rewrite_if_then_else_expr_to_b(if_then_else(If,Then,Else), NExpr),
4898 get_texpr_type(Then,Type),
4899 NAst = b(NExpr,Type,[])},
4900 % construct {d,x| If => x=Then & not(if) => x=Else}(TRUE)
4901 pp_expr(NAst,Prio,LimitReached).
4902 pp_expr2(if_then_else(If,Then,Else),1,LimitReached) --> !,
4903 pp_atom_opt_mathit('IF'),pp_space, % "IF ",
4904 pp_expr_m(If,30,LimitReached),
4905 pp_space, pp_atom_opt_mathit('THEN'),pp_space, %" THEN ",
4906 pp_expr_m(Then,30,LimitReached),
4907 pp_space, pp_atom_opt_mathit('ELSE'),pp_space, %" ELSE ",
4908 pp_expr_m(Else,30,LimitReached),
4909 pp_space, pp_atom_opt_mathit('END'). %" END"
4910 pp_expr2(kodkod(Id,Identifiers),300,LimitReached) --> !,
4911 "KODKOD_CALL(",ppnumber(Id),": ",pp_expr_ids(Identifiers,LimitReached),")".
4912 pp_expr2(Expr,500,_) -->
4913 {constants_in_mode(Expr,Symbol)},!,ppatom(Symbol).
4914 pp_expr2(equal(A,B),Prio,LimitReached) -->
4915 {get_preference(pp_propositional_logic_mode,true), % a mode for printing propositional logic formuli
4916 is_boolean_value(B,BV),
4917 get_texpr_id(A,_)},!,
4918 ({BV=pred_true} -> pp_expr(A,Prio,LimitReached)
4919 ; pp_expr2(negation(b(equal(A,b(boolean_true,boolean,[])),pred,[])),Prio,LimitReached)).
4920 pp_expr2(Expr,Prio,LimitReached) -->
4921 {functor(Expr,F,1),
4922 unary_prefix(F,Symbol,Prio),!,
4923 arg(1,Expr,Arg),APrio is Prio+1},
4924 ppatom(Symbol), " ",
4925 pp_expr_m(Arg,APrio,LimitReached).
4926 pp_expr2(Expr,500,LimitReached) -->
4927 {functor(Expr,F,1),
4928 unary_prefix_parentheses(F,Symbol),!,
4929 arg(1,Expr,Arg)},
4930 pp_atom_opt_latex(Symbol), "(", pp_expr(Arg,_,LimitReached), ")".
4931 pp_expr2(Expr,Prio,LimitReached) -->
4932 {functor(Expr,F,1),
4933 unary_postfix_in_mode(F,Symbol,Prio),!,
4934 arg(1,Expr,Arg),APrio is Prio+1},
4935 pp_expr_m(Arg,APrio,LimitReached),ppatom(Symbol).
4936 pp_expr2(power_of(Left,Right),Prio,LimitReached) --> {latex_mode},!, % special case, as we need to put {} around RHS
4937 {Prio=200, LPrio is Prio+1, RPrio = Prio},
4938 pp_expr_m(Left,LPrio,LimitReached),
4939 "^{",
4940 pp_expr_m(Right,RPrio,LimitReached),
4941 "}".
4942 pp_expr2(power_of_real(Left,Right),Prio,LimitReached) --> !,
4943 ({get_texpr_expr(Right,convert_real(RI))}
4944 -> pp_expr2(power_of(Left,RI),Prio,LimitReached) % the Atelier-B power_of expects integer exponent
4945 ; pp_external_call('RPOW',[Left,Right],expression,Prio,LimitReached)
4946 ).
4947 pp_expr2(Expr,OPrio,LimitReached) -->
4948 {functor(Expr,F,2),
4949 binary_infix_in_mode(F,Symbol,Prio,Ass),!,
4950 arg(1,Expr,Left),
4951 arg(2,Expr,Right),
4952 ( Ass = left, binary_infix_symbol(Left,Symbol) -> LPrio is Prio-1, RPrio is Prio+1
4953 ; Ass = right, binary_infix_symbol(Right,Symbol) -> LPrio is Prio+1, RPrio is Prio-1
4954 ; LPrio is Prio+1, RPrio is Prio+1)},
4955 % Note: Prio+1 is actually not necessary, Prio would be sufficient, as pp_expr_m uses a strict comparison <
4956 ({always_surround_by_parentheses(F)} -> "(",{OPrio=1000} ; {OPrio=Prio}),
4957 pp_expr_m(Left,LPrio,LimitReached),
4958 " ", ppatom(Symbol), " ",
4959 pp_expr_m(Right,RPrio,LimitReached),
4960 ({always_surround_by_parentheses(F)} -> ")" ; []).
4961 pp_expr2(first_of_pair(X),500,LimitReached) --> {get_texpr_type(X,couple(From,To))},!,
4962 "prj1(", % TO DO: Latex version
4963 ({\+ atelierb_mode(_)} % eventb_translation_mode
4964 -> "" % no need to print types in Event-B or with new parser;
4965 % TODO: also with new parser no longer required; only print in Atelier-B mode
4966 ; {pretty_normalized_type(From,FromT),
4967 pretty_normalized_type(To,ToT)},
4968 pp_atom_opt_latex(FromT), ",", pp_atom_opt_latex(ToT),
4969 ")("
4970 ),
4971 pp_expr(X,_,LimitReached),")".
4972 pp_expr2(second_of_pair(X),500,LimitReached) --> {get_texpr_type(X,couple(From,To))},!,
4973 "prj2(", % TO DO: Latex version
4974 ({\+ atelierb_mode(_)} -> "" % no need to print types in Event-B or with new parser
4975 ; {pretty_normalized_type(From,FromT),
4976 pretty_normalized_type(To,ToT)},
4977 pp_atom_opt_latex(FromT), ",", pp_atom_opt_latex(ToT),
4978 ")("
4979 ),
4980 pp_expr(X,_,LimitReached),")".
4981 pp_expr2(Call,Prio,LimitReached) --> {external_call(Call,Kind,Symbol,Args)},!,
4982 pp_external_call(Symbol,Args,Kind,Prio,LimitReached).
4983 pp_expr2(card(A),500,LimitReached) --> {latex_mode, get_preference(latex_pp_greek_ids,true)},!,
4984 "|",pp_expr_m(A,0,LimitReached),"|".
4985 pp_expr2(Expr,500,LimitReached) -->
4986 {functor(Expr,F,_),
4987 function_like_in_mode(F,Symbol),!,
4988 Expr =.. [F|Args]},
4989 ppatom(Symbol),
4990 ({Args=[]}
4991 -> "" % some operators like pred and succ do not expect arguments
4992 ; pp_expr_wrap_l('(',Args,')',LimitReached)).
4993 pp_expr2(Expr,250,LimitReached) -->
4994 {functor(Expr,F,3),
4995 quantified_in_mode(F,Symbol),
4996 Expr =.. [F,Ids,P1,E],
4997 !,
4998 add_normal_typing_predicates(Ids,P1,P)},
4999 ppatom(Symbol),pp_expr_ids(Ids,LimitReached),".(",
5000 pp_expr_m(P,11,LimitReached),pp_such_that_bar(E),
5001 pp_expr_m(E,11,LimitReached),")".
5002 pp_expr2(Expr,Prio,LimitReached) -->
5003 {functor(Expr,F,N),
5004 (debug_mode(on)
5005 -> format('**** Unknown functor ~w/~w in pp_expr2~n expression: ~w~n',[F,N,Expr])
5006 ; format('**** Unknown functor ~w/~w in pp_expr2~n',[F,N])
5007 ),
5008 %add_internal_error('Unknown Expression: ',pp_expr2(Expr,Prio)),
5009 Prio=20},
5010 ppterm_with_limit_reached(Expr,LimitReached).
5011
5012 :- use_module(external_function_declarations,[synonym_for_external_predicate/2]).
5013
5014 pp_external_call('MEMOIZE_STORED_FUNCTION',[TID],_,500,LimitReached) -->
5015 {get_integer(TID,ID),memoization:get_registered_function_name(ID,Name)},!,
5016 pp_expr_m(atom_string(Name),20,LimitReached),
5017 " /*@memo ", pp_expr_m(TID,20,LimitReached), "*/".
5018 pp_external_call('STRING_LENGTH',[Arg],_,Prio,LimitReached) -->
5019 {get_preference(allow_sequence_operators_on_strings,true)},!,
5020 pp_expr2(size(Arg),Prio,LimitReached).
5021 pp_external_call('STRING_APPEND',[Arg1,Arg2],_,Prio,LimitReached) -->
5022 {get_preference(allow_sequence_operators_on_strings,true)},!,
5023 pp_expr2(concat(Arg1,Arg2),Prio,LimitReached).
5024 pp_external_call('STRING_CONC',[Arg1],_,Prio,LimitReached) -->
5025 {get_preference(allow_sequence_operators_on_strings,true)},!,
5026 pp_expr2(general_concat(Arg1),Prio,LimitReached).
5027 % we could also pretty-print RMUL, ...
5028 pp_external_call(PRED,Args,pred,Prio,LimitReached) -->
5029 {get_preference(translate_ids_to_parseable_format,true),
5030 synonym_for_external_predicate(PRED,FUNC)},
5031 !, % print external predicate as function, as parser can only parse the latter without access to DEFINITIONS
5032 pp_expr2(equal(b(external_function_call(FUNC,Args),boolean,[]),
5033 b(boolean_true,boolean,[])),Prio,LimitReached).
5034 pp_external_call(Symbol,Args,_,Prio,LimitReached) -->
5035 ({invisible_external_pred(Symbol)}
5036 -> pp_expr2(truth,Prio,LimitReached),
5037 " /* ",pp_expr_m(atom_string(Symbol),20,LimitReached),pp_expr_wrap_l('(',Args,') */',LimitReached)
5038 ; {Prio=500},pp_expr_m(atom_string(Symbol),20,LimitReached),
5039 pp_expr_wrap_l('(',Args,')',LimitReached) % pp_expr_wrap_l('/*EXT:*/(',Args,')')
5040 ).
5041
5042 invisible_external_pred('LEQ_SYM').
5043 invisible_external_pred('LEQ_SYM_BREAK'). % just for symmetry breaking foralls,...
5044 external_call(external_function_call(Symbol,Args),expression,Symbol,Args).
5045 external_call(external_pred_call(Symbol,Args),pred,Symbol,Args).
5046 external_call(external_subst_call(Symbol,Args),subst,Symbol,Args).
5047
5048 pp_all_disjoint([H1,H2],LimitReached) --> !, " ",and_symbol," ", pp_disjoint(H1,H2,LimitReached).
5049 pp_all_disjoint([H1|T],LimitReached) --> pp_all_disjoint_aux(T,H1,LimitReached), pp_all_disjoint(T,LimitReached).
5050 pp_all_disjoint([],_) --> "".
5051
5052 pp_all_disjoint_aux([],_,_) --> "".
5053 pp_all_disjoint_aux([H2|T],H1,LimitReached) --> " ",and_symbol," ",
5054 pp_disjoint(H1,H2,LimitReached), pp_all_disjoint_aux(T,H1,LimitReached).
5055
5056 pp_disjoint(H1,H2,LimitReached) --> pp_expr(H1,_), "/\\", pp_expr(H2,_,LimitReached), " = {}".
5057
5058 % extract a lambda equality from a body; we suppose the equality is the last conjunct
5059 get_lambda_equality(b(equal(TID,ResultExpr),pred,_),ID,[],ResultExpr) :- get_texpr_id(TID,ID).
5060 get_lambda_equality(b(conjunct(LHS,RHS),pred,_),ID,[LHS|T],ResultExpr) :-
5061 ? get_lambda_equality(RHS,ID,T,ResultExpr).
5062
5063 % given a list of predicates and an ID either extract ID:Set and return Set or return its type as string
5064 select_membership([],TID,[],atom_string(TS)) :- % atom_string used as wrapper for pp_expr2
5065 get_texpr_type(TID,Type), pretty_type(Type,TS).
5066 select_membership([Pred|Rest],TID,Rest,Set) :-
5067 Pred = b(member(TID2,Set),pred,_),
5068 same_id(TID2,TID,_),!.
5069 select_membership([Pred|Rest],TID,Rest,Set) :-
5070 Pred = b(equal(TID2,EqValue),pred,_),
5071 same_id(TID2,TID,_),!, get_texpr_type(TID,Type),
5072 Set = b(set_extension([EqValue]),set(Type),[]).
5073 select_membership([Pred|T],TID,[Pred|Rest],Set) :-
5074 select_membership(T,TID,Rest,Set).
5075
5076 % pretty print prj1/prj2
5077 pp_prj12(Prj,Set1,Set2,LimitReached) -->
5078 ppatom(Prj),"(",pp_expr(Set1,_,LimitReached),",",pp_expr(Set2,_),")".
5079
5080 %:- use_module(bsyntaxtree,[is_a_disjunct/3, get_integer/2]).
5081
5082 pp_comprehension_set(Ids,P1,Info,LimitReached) -->
5083 pp_comprehension_set5(Ids,P1,Info,LimitReached,_).
5084
5085 % the extra argument of pp_comprehension_set5 indicates whether a special(Rule) was applied or not
5086 %pp_comprehension_set(IDs,Body,Info,LimitReached,_) --> {print(pp(IDs,Body,Info)),nl,fail}.
5087 pp_comprehension_set5([TID1,TID2,TID3],Body,_Info,LimitReached,special(Proj)) -->
5088 /* This comprehension set was a projection function (prj1/prj2) */
5089 % %(z_,z__).(z__ : NATURAL|z_) -> prj1(INTEGER,NATURAL)
5090 {get_texpr_id(TID1,ID1), % sometimes _zzzz_unary or _prj_arg1__
5091 get_texpr_id(TID2,ID2), % sometimes _zzzz_binary or _prj_arg2__
5092 get_texpr_id(TID3,LambdaID),
5093 ? get_lambda_equality(Body,LambdaID,RestBody,ResultExpr),
5094 get_texpr_id(ResultExpr,ResultID),
5095 (ResultID = ID1 -> Proj = prj1 ; ResultID = ID2, Proj = prj2),
5096 flatten_conjunctions(RestBody,Rest1),
5097 select_membership(Rest1,TID1,Rest2,Set1),
5098 select_membership(Rest2,TID2,[],Set2)},
5099 !,
5100 pp_prj12(Proj,Set1,Set2,LimitReached).
5101 pp_comprehension_set5([ID1|T],Body,Info,LimitReached,special(disjunct)) --> {is_a_disjunct(Body,B1,B2),
5102 get_last(T,ID1,_FrontIDs,LastID),
5103 is_lambda_result_id(LastID,_Suffix)},!, % we seem to have the union of two lambda expressions
5104 "(", pp_comprehension_set([ID1|T],B1,Info,LimitReached),
5105 " \\/ ", pp_comprehension_set([ID1|T],B2,Info,LimitReached), ")".
5106 pp_comprehension_set5([b(identifier('_pred_'),integer,_),
5107 b(identifier(LAMBDARES),integer,_)],Body,_,_,special(pred)) --> % '_lambda_result_'
5108 {Body = b(equal(LR,T),pred,_),
5109 LR = b(identifier(LAMBDARES),integer,_),
5110 T = b(minus(ARG,One),integer,_),
5111 get_integer(One,1),
5112 ARG = b(identifier('_pred_'),integer,_)},
5113 !,
5114 "pred".
5115 pp_comprehension_set5([b(identifier('_succ_'),integer,_),
5116 b(identifier(LAMBDARES),integer,_)],Body,_,_,special(succ)) --> % '_lambda_result_'
5117 {Body = b(equal(LR,T),pred,_),
5118 LR = b(identifier(LAMBDARES),integer,_),
5119 T = b(add(ARG,One),integer,_),
5120 get_integer(One,1),
5121 ARG = b(identifier('_succ_'),integer,_)},
5122 !,
5123 "succ".
5124 pp_comprehension_set5(Paras,Body,Info,LimitReached,special(lambda)) -->
5125 {detect_lambda_comprehension(Paras,Body, FrontIDs,LambdaBody,ToExpr)},
5126 !,
5127 {add_normal_typing_predicates(FrontIDs,LambdaBody,TLambdaBody)},
5128 ({eventb_translation_mode} -> "(" ; ""), % put brackets around the lambda in Rodin
5129 pp_annotations(Info,Body),
5130 lambda_symbol, % "%"
5131 pp_lambda_identifiers(FrontIDs,LimitReached),
5132 ".",
5133 ({eventb_translation_mode} -> {IPrio=30} ; {IPrio=11}, "("), % In Rodin it is not ok to write (P|E)
5134 pp_expr_m(TLambdaBody,IPrio,LimitReached), % Check 11 against prio of . and |
5135 pp_such_that_bar(ToExpr),
5136 pp_expr_m(ToExpr,IPrio,LimitReached),
5137 ")".
5138 pp_comprehension_set5(TIds,Body,Info,LimitReached,special(event_b_comprehension_set)) -->
5139 % detect Event-B style set comprehensions and use bullet • or Event-B notation such as {x·x ∈ 1 ‥ 3|x * 10}
5140 % gets translated to {`__comp_result__`|∃x·(x ∈ 1 ‥ 3 ∧ `__comp_result__` = x * 10)}
5141 ? {is_eventb_comprehension_set(TIds,Body,Info,Ids,P1,EXPR)},!,
5142 pp_annotations(Info,P1),
5143 left_set_bracket,
5144 pp_expr_l_pair_in_mode(Ids,LimitReached),
5145 {add_normal_typing_predicates(Ids,P1,P)},
5146 dot_bullet_symbol,
5147 pp_expr_m(P,11,LimitReached),
5148 pp_such_that_bar(P),
5149 pp_expr_m(EXPR,11,LimitReached),
5150 right_set_bracket.
5151 pp_comprehension_set5(Ids,P1,Info,LimitReached,normal) -->
5152 pp_annotations(Info,P1),
5153 left_set_bracket,
5154 pp_expr_l_pair_in_mode(Ids,LimitReached),
5155 {add_normal_typing_predicates(Ids,P1,P)},
5156 pp_such_that_bar(P),
5157 pp_expr_m(P,11,LimitReached),
5158 right_set_bracket.
5159
5160
5161 detect_lambda_comprehension([ID1|T],Body, FrontIDs,LambdaBody,ToExpr) :-
5162 get_last(T,ID1,FrontIDs,LastID),
5163 FrontIDs=[_|_], % at least one identifier for the lambda
5164 is_lambda_result_id(LastID,Suffix),
5165 % nl, print(lambda(Body,T,ID1)),nl,
5166 (is_an_equality(Body,From,ToExpr) -> LambdaBody = b(truth,pred,[])
5167 ; is_a_conjunct(Body,LambdaBody,Equality),
5168 is_an_equality(Equality,From,ToExpr)),
5169 is_lambda_result_id(From,Suffix).
5170
5171 pp_annotations(V,_) --> {var(V), format('Illegal variable info field in pp_annotations: ~w~n',[V])},!,
5172 "/* ILLEGAL VARIABLE INFO FIED */".
5173 ?pp_annotations(INFO,_) --> {member(prob_annotation('SYMBOLIC'),INFO)},!,
5174 "/*@symbolic*/ ".
5175 ?pp_annotations(_,b(_,_,INFO)) --> {nonvar(INFO),member(prob_annotation('SYMBOLIC'),INFO)},!,
5176 "/*@symbolic*/ ".
5177 % TO DO: maybe also print other annotations like memoize, recursive ?
5178 pp_annotations(_,_) --> "".
5179
5180 pp_event_b_comprehension_set(Ids,E,P1,LimitReached) -->
5181 left_set_bracket,pp_expr_l_pair_in_mode(Ids,LimitReached),
5182 {add_normal_typing_predicates(Ids,P1,P)},
5183 pp_such_that_bar(P),pp_expr_m(P,11,LimitReached),
5184 " . ", pp_expr_m(E,11,LimitReached),right_set_bracket.
5185
5186 pp_lambda_identifiers([H1,H2|T],LimitReached) --> {\+ eventb_translation_mode},!,
5187 "(",pp_expr_l([H1,H2|T],LimitReached),")".
5188 pp_lambda_identifiers(L,LimitReached) --> pp_expr_l_pair_in_mode(L,LimitReached).
5189
5190 pp_such_that_bar(_) --> {latex_mode},!, "\\mid ".
5191 pp_such_that_bar(b(unary_minus(_),_,_)) --> !, " | ". % otherwise AtelierB complains about illegal token |-
5192 pp_such_that_bar(b(unary_minus_real(_),_,_)) --> !, " | ". % otherwise AtelierB complains about illegal token |-
5193 pp_such_that_bar(_Next) --> "|".
5194 pp_such_that_bar --> {latex_mode},!, "\\mid ".
5195 pp_such_that_bar --> "|".
5196
5197 is_an_equality(b(equal(A,B),_,_),A,B).
5198
5199 integer_set_mapping(A,B) :- integer_set_mapping(A,_,B).
5200 integer_set_mapping(A,integer_set,B) :- unicode_mode, unicode_translation(A,B),!.
5201 integer_set_mapping(A,integer_set,B) :- latex_mode, latex_integer_set_translation(A,B),!.
5202 integer_set_mapping(A,integer_set,B) :- atelierb_mode(Mode), Mode == pp, atelierb_pp_translation(A,B),!.
5203 integer_set_mapping(A,integer_set,B) :-
5204 eventb_translation_mode, eventb_integer_mapping(A,B),!.
5205 integer_set_mapping(ISet,user_set,Res) :- atomic(ISet),!,Res=ISet.
5206 integer_set_mapping(_ISet,unknown_set,'integer_set(??)').
5207
5208 eventb_integer_mapping('INTEGER','INT').
5209 eventb_integer_mapping('NATURAL','NAT').
5210 eventb_integer_mapping('NATURAL1','NAT1').
5211
5212 real_set_mapping(A,B) :- unicode_mode, unicode_translation(A,B),!.
5213 real_set_mapping(X,X). % TO DO: unicode_mode,...
5214
5215 :- dynamic comment_level/1.
5216 reset_pp :- retractall(comment_level(_)).
5217 enter_comment --> {retract(comment_level(N))},!, "(*", {N1 is N+1, assertz(comment_level(N1))}.
5218 enter_comment --> "/*", {assertz(comment_level(1))}.
5219 exit_comment --> {retract(comment_level(N))},!,
5220 ({N>1} -> "*)", {N1 is N-1, assertz(comment_level(N1))} ; "*/").
5221 exit_comment --> "*/", {add_internal_error('Unmatched closing comment:',exit_comment)}.
5222 % TO DO: ensure reset_pp is called when starting to pretty print, in case timeout occurs in previous pretty prints
5223
5224 %get_last([b(identifier(_lambda_result_10),set(couple(integer,set(couple(integer,integer)))),[])],b(identifier(i),integer,[]),[b(identifier(i),integer,[])],b(identifier(_lambda_result_10),set(couple(integer,set(couple(integer,integer)))),[]))
5225
5226 get_last([],Last,[],Last).
5227 get_last([H2|T],H1,[H1|LT],Last) :- get_last(T,H2,LT,Last).
5228
5229 pp_expr_wrap_l(Pre,Expr,Post,LimitReached) -->
5230 ppatom(Pre),pp_expr_l(Expr,LimitReached),ppatom(Post).
5231 pp_freetype_term(Term,FT,L,Expr,LimitReached) -->
5232 {pretty_freetype(FT,P)},
5233 ppatom(Term),"(",ppatom_opt_scramble(P),",",
5234 ppatom(L),",",pp_expr_m(Expr,500,LimitReached),")".
5235
5236 % print a list of expressions, seperated by commas
5237 pp_expr_l_pair_in_mode(List,LimitReached) --> {eventb_translation_mode},!,
5238 {maplet_symbol(MapletStr,[])},
5239 pp_expr_l_sep(List,MapletStr,LimitReached).
5240 pp_expr_l_pair_in_mode(List,LimitReached) --> pp_expr_l_sep(List,",",LimitReached).
5241 pp_expr_l(List,LimitReached) --> pp_expr_l_sep(List,",",LimitReached).
5242
5243 pp_expr_l_sep([Expr],_,LimitReached) --> !,
5244 pp_expr_m(Expr,0,LimitReached).
5245 pp_expr_l_sep(List,Sep,LimitReached) --> pp_expr_l2(List,Sep,LimitReached).
5246 pp_expr_l2([],_Sep,_) --> !.
5247 pp_expr_l2([Expr|Rest],Sep,LimitReached) -->
5248 {get_sep_prio(Sep,Prio)},
5249 pp_expr_m(Expr,Prio,LimitReached),
5250 pp_expr_l3(Rest,Sep,LimitReached).
5251 pp_expr_l3([],_Sep,_) --> !.
5252 pp_expr_l3(Rest,Sep,LimitReached) -->
5253 Sep,pp_expr_l2(Rest,Sep,LimitReached).
5254
5255 get_sep_prio(",",Prio) :- !, Prio=116. % Prio of , is 115
5256 get_sep_prio("\\/",Prio) :- !, Prio=161.
5257 get_sep_prio("/\\",Prio) :- !, Prio=161.
5258 get_sep_prio("|->",Prio) :- !, Prio=161.
5259 get_sep_prio([8614],Prio) :- !, Prio=161.
5260 %
5261 get_sep_prio(_,161).
5262
5263 % print the fields of a record
5264 pp_expr_fields([field(Name,Expr)],LimitReached) --> !,
5265 pp_identifier(Name),":",pp_expr_m(Expr,120,LimitReached).
5266 pp_expr_fields(Fields,LimitReached) -->
5267 pp_expr_fields2(Fields,LimitReached).
5268 pp_expr_fields2([],_) --> !.
5269 pp_expr_fields2([field(Name,Expr)|Rest],LimitReached) -->
5270 pp_identifier(Name),":",
5271 pp_expr_m(Expr,116,LimitReached),
5272 pp_expr_fields3(Rest,LimitReached).
5273 pp_expr_fields3([],_) --> !.
5274 pp_expr_fields3(Rest,LimitReached) -->
5275 ",",pp_expr_fields2(Rest,LimitReached).
5276
5277 % TO DO: test more fully; identifiers seem to be wrapped in brackets
5278 pp_expr_let_exists(Ids,Exprs,P,LimitReached) -->
5279 exists_symbol,
5280 ({eventb_translation_mode} -> % otherwise we get strange characters in Rodin, no (.) allowed in Rodin
5281 pp_expr_ids_in_mode(Ids,LimitReached),
5282 ".("
5283 ; " /* LET */ (",
5284 pp_expr_l_pair_in_mode(Ids,LimitReached),
5285 ").("
5286 ),
5287 pp_expr_let_pred_exprs(Ids,Exprs,LimitReached),
5288 ({is_truth(P)} -> ""
5289 ; " ",and_symbol," ", pp_expr_m(P,40,LimitReached)),
5290 ")".
5291
5292 pp_expr_let_pred_exprs([],[],_) --> !.
5293 pp_expr_let_pred_exprs([Id|Irest],[Expr|Erest],LimitReached) -->
5294 " ",pp_expr_let_id(Id,LimitReached),
5295 "=",pp_expr_m(Expr,400,LimitReached),
5296 ( {Irest=[]} -> [] ; " ", and_symbol),
5297 pp_expr_let_pred_exprs(Irest,Erest,LimitReached).
5298
5299 % print a LET expression
5300 pp_expr_let(_Ids,Exprs,P,LimitReached) -->
5301 {eventb_translation_mode,
5302 P=b(_,_,I), member(was(extended_expr(Op)),I)},!, % let was created by direct_definition for a theory operator call
5303 ppatom(Op),
5304 pp_function_left_bracket,
5305 pp_expr_l_sep(Exprs,",",LimitReached),
5306 %pp_expr_let_pred_exprs(Ids,Exprs,LimitReached) % write entire predicate with parameter names
5307 pp_function_right_bracket.
5308 pp_expr_let(Ids,Exprs,P,LimitReached) -->
5309 "LET ", pp_expr_ids_no_parentheses(Ids,LimitReached),
5310 " BE ", pp_expr_let_pred_exprs(Ids,Exprs,LimitReached),
5311 " IN ",pp_expr_m(P,5,LimitReached),
5312 " END".
5313
5314 pp_expr_let_id(ID,LimitReached) --> {atomic(ID),!, print(unwrapped_let_id(ID)),nl},
5315 pp_expr_m(identifier(ID),500,LimitReached).
5316 pp_expr_let_id(ID,LimitReached) --> pp_expr_m(ID,499,LimitReached).
5317
5318 % print a list of identifiers
5319 pp_expr_ids_in_mode([],_) --> !.
5320 pp_expr_ids_in_mode(Ids,LimitReached) --> {eventb_translation_mode ; Ids=[_]},!,
5321 pp_expr_l(Ids,LimitReached). % no (.) allowed in Event-B; not necessary in B if only one id
5322 pp_expr_ids_in_mode(Ids,LimitReached) --> "(",pp_expr_l(Ids,LimitReached),")".
5323
5324 pp_expr_ids([],_) --> !.
5325 pp_expr_ids(Ids,LimitReached) -->
5326 % ( {Ids=[Id]} -> pp_expr_m(Id,221)
5327 % ;
5328 "(",pp_expr_l(Ids,LimitReached),")".
5329
5330 pp_expr_ids_no_parentheses(Ids,LimitReached) --> pp_expr_l(Ids,LimitReached).
5331
5332
5333 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5334 % pretty print types for error messages
5335
5336 %:- use_module(probsrc(typing_tools), [normalize_type/2]).
5337 % replace seq(.) types before pretty printing:
5338 pretty_normalized_type(Type,String) :- typing_tools:normalize_type(Type,NT),!,
5339 pretty_type(NT,String).
5340 pretty_normalized_type(Type,String) :-
5341 add_internal_error('Cannot normalize type:',pretty_normalized_type(Type,String)),
5342 pretty_type(Type,String).
5343
5344 pretty_type(Type,String) :-
5345 pretty_type_l([Type],[String]).
5346
5347 pretty_type_l(Types,Strings) :-
5348 extract_vartype_names(Types,N),
5349 pretty_type2_l(Types,N,Strings).
5350 pretty_type2_l([],_,[]).
5351 pretty_type2_l([T|TRest],Names,[S|SRest]) :-
5352 pretty_type2(T,Names,noparen,S),
5353 pretty_type2_l(TRest,Names,SRest).
5354
5355 extract_vartype_names(Types,names(Variables,Names)) :-
5356 term_variables(Types,Variables),
5357 name_variables(Variables,1,Names).
5358
5359 pretty_type2(X,names(Vars,Names),_,Name) :- var(X),!,exact_member_lookup(X,Name,Vars,Names).
5360 pretty_type2(any,_,_,'?').
5361 pretty_type2(set(T),N,_,Text) :- nonvar(T),T=couple(A,B),!,
5362 pretty_type2(A,N,paren,AT), pretty_type2(B,N,paren,BT),
5363 binary_infix_in_mode(relations,Symbol,_,_), % <->
5364 ajoin(['(',AT,Symbol,BT,')'],Text).
5365 pretty_type2(set(T),N,_,Text) :-
5366 pretty_type2(T,N,noparen,TT), function_like_in_mode(pow_subset,POW),
5367 ajoin([POW,'(',TT,')'],Text).
5368 pretty_type2(seq(T),N,_,Text) :-
5369 pretty_type2(T,N,noparen,TT), ajoin(['seq(',TT,')'],Text).
5370 pretty_type2(couple(A,B),N,Paren,Text) :-
5371 pretty_type2(A,N,paren,AT),pretty_type2(B,N,paren,BT),
5372 binary_infix_in_mode(cartesian_product,Cart,_,_),
5373 ajoin([AT,Cart,BT],Prod),
5374 ( Paren == noparen ->
5375 Text = Prod
5376 ;
5377 ajoin(['(',Prod,')'],Text)).
5378 pretty_type2(string,_,_,'STRING').
5379 pretty_type2(integer,_,_,Atom) :- integer_set_mapping('INTEGER',Atom).
5380 pretty_type2(real,_,_,Atom) :- real_set_mapping('REAL',Atom).
5381 pretty_type2(boolean,_,_,'BOOL').
5382 pretty_type2(global(G_Id),_,_,A) :- opt_scramble_id(G_Id,G), ajoin([G],A).
5383 pretty_type2(freetype(Id),N,_,A) :- pretty_freetype2(Id,N,A).
5384 pretty_type2(pred,_,_,predicate).
5385 pretty_type2(subst,_,_,substitution).
5386 pretty_type2(constant(List),_,_,A) :-
5387 (var(List) -> '{??VAR??...}' % should not happen
5388 ; ajoin_with_sep(List,',',P), ajoin(['{',P,'}'],A)).
5389 pretty_type2(record(Fields),N,_,Text) :-
5390 pretty_type_fields(Fields,N,FText),
5391 ajoin(['struct(',FText,')'],Text).
5392 pretty_type2(op(Params,Results),N,_,Text) :-
5393 pretty_type_l(Params,N,PText),
5394 ( nonvar(Results),Results=[] ->
5395 ajoin(['operation(',PText,')'],Text)
5396 ;
5397 pretty_type_l(Results,N,RText),
5398 ajoin([RText,'<--operation(',PText,')'],Text) ).
5399 pretty_type2(definition(DefType,_,_),_,_,DefType).
5400 pretty_type2(witness,_,_,witness).
5401 pretty_type2([],_,_,'[]') :- add_error(pretty_type,'Illegal list in type:','[]').
5402 pretty_type2([H|T],_,_,'[_]') :- add_error(pretty_type,'Illegal list in type:',[H|T]).
5403 pretty_type2(b(E,T,I),_,_,'?') :- add_error(pretty_type,'Illegal b/3 term in type:',b(E,T,I)).
5404
5405 pretty_type_l(L,_,'...') :- var(L),!.
5406 pretty_type_l([],_,'') :- !.
5407 pretty_type_l([E|Rest],N,Text) :-
5408 pretty_type2(E,N,noparen,EText),
5409 ( nonvar(Rest),Rest=[] ->
5410 EText=Text
5411 ;
5412 pretty_type_l(Rest,N,RText),
5413 ajoin([EText,',',RText],Text)).
5414
5415 pretty_type_fields(L,_,'...') :- var(L),!.
5416 pretty_type_fields([],_,'') :- !.
5417 pretty_type_fields([field(Name,Type)|FRest],N,Text) :- !,
5418 pretty_type2(Type,N,noparen,TText),
5419 ptf_seperator(FRest,Sep),
5420 pretty_type_fields(FRest,N,RestText),
5421 opt_scramble_id(Name,ScrName),
5422 ajoin([ScrName,':',TText,Sep,RestText],Text).
5423 pretty_type_fields(Err,N,Text) :-
5424 add_internal_error('Illegal field type: ',pretty_type_fields(Err,N,Text)), Text='??'.
5425 ptf_seperator(L,', ') :- var(L),!.
5426 ptf_seperator([],'') :- !.
5427 ptf_seperator(_,', ').
5428
5429 pretty_freetype(Id,A) :-
5430 extract_vartype_names(Id,N),
5431 pretty_freetype2(Id,N,A).
5432 pretty_freetype2(Id,_,A) :- var(Id),!,A='_'.
5433 pretty_freetype2(Id,_,A) :- atomic(Id),!,Id=A.
5434 pretty_freetype2(Id,N,A) :-
5435 Id=..[Name|TypeArgs],
5436 pretty_type2_l(TypeArgs,N,PArgs),
5437 ajoin_with_sep(PArgs,',',P),
5438 ajoin([Name,'(',P,')'],A).
5439
5440 name_variables([],_,[]).
5441 name_variables([_|VRest],Index,[Name|NRest]) :-
5442 (nth1(Index,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",C) -> SName = [C] ; number_codes(Index,SName)),
5443 append("_",SName,CName),atom_codes(Name,CName),
5444 Next is Index+1,
5445 name_variables(VRest,Next,NRest).
5446
5447 ppatom(Var) --> {var(Var)},!, ppatom('$VARIABLE').
5448 ppatom(Cmp) --> {compound(Cmp)},!, ppatom('$COMPOUND_TERM').
5449 ppatom(Atom) --> {safe_atom_codes(Atom,Codes)}, ppcodes(Codes).
5450
5451 ppnumber(Number) --> {var(Number)},!,pp_clpfd_variable(Number).
5452 ppnumber(inf) --> !,"inf".
5453 ppnumber(minus_inf) --> !,"minus_inf".
5454 ppnumber(Number) --> {number(Number),number_codes(Number,Codes)},!, ppcodes(Codes).
5455 ppnumber(Number) --> {add_internal_error('Not a number: ',ppnumber(Number,_,_))}, "<<" ,ppterm(Number), ">>".
5456
5457 pp_numberedvar(N) --> "_",ppnumber(N),"_".
5458
5459 pp_clpfd_variable(X) --> "?:",{fd_dom(X,Dom)},write_to_codes(Dom), pp_frozen_info(X).
5460
5461 pp_frozen_info(_X) --> {get_preference(translate_print_frozen_infos,false)},!,[].
5462 pp_frozen_info(X) -->
5463 ":(",{frozen(X,Goal)},
5464 write_goal_with_max_depth(Goal),
5465 ")".
5466
5467 write_goal_with_max_depth((A,B)) --> !, "(",write_goal_with_max_depth(A),
5468 ", ", write_goal_with_max_depth(B), ")".
5469 write_goal_with_max_depth(Term) --> write_with_max_depth(3,Term).
5470
5471 write_with_max_depth(Depth,Term,S1,S2) :- write_term_to_codes(Term,S1,S2,[max_depth(Depth)]).
5472
5473 ppterm(Term) --> write_to_codes(Term).
5474
5475 ppcodes([],S,S).
5476 ppcodes([C|Rest],[C|In],Out) :- ppcodes(Rest,In,Out).
5477
5478 ppterm_with_limit_reached(Term,LimitReached) -->
5479 {write_to_codes(Term,Codes,[])}, ppcodes_with_limit_reached(Codes,LimitReached).
5480
5481 ppcodes_with_limit_reached([C|Rest],LimitReached,[C|In],Out) :- var(LimitReached), !,
5482 ppcodes_with_limit_reached(Rest,LimitReached,In,Out).
5483 ppcodes_with_limit_reached(_,_LimitReached,S,S).
5484
5485 % for debugging:
5486 :- public b_portray_hook/1.
5487 b_portray_hook(X) :-
5488 nonvar(X),
5489 (is_texpr(X), ground(X) -> write('{# '),print_bexpr_or_subst(X),write(' #}')
5490 ; X=avl_set(_), ground(X) -> write('{#avl '), print_bvalue(X), write(')}')
5491 ; X=wfx(WF0,_,WFE,Info) -> format('wfx(~w,$mutable,~w,~w)',[WF0,WFE,Info]) % to do: short summary of prios & call stack
5492 ).
5493
5494 install_b_portray_hook :- % register portray hook mainly for the Prolog debugger
5495 assertz(( user:portray(X) :- translate:b_portray_hook(X) )).
5496 remove_b_portray_hook :-
5497 retractall( user:portray(_) ).
5498
5499
5500 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5501 % Pretty-print of Event-B models as classical B
5502
5503 translate_eventb_to_classicalb(EBMachine,AddInfo,Rep) :-
5504 ( conversion_check(EBMachine) ->
5505 convert_eventb_classicalb(EBMachine,CBMachine),
5506 call_cleanup(( set_animation_mode(b), % clear minor mode "eventb"
5507 translate_machine(CBMachine,Rep,AddInfo),!),
5508 set_animation_minor_mode(eventb))
5509 ; \+ animation_minor_mode(eventb) -> add_error(translate,'Conversion only applicable to Event-B models')
5510 ;
5511 add_error_and_fail(translate,'Conversion not applicable, check if you limited the number of abstract level to 0')
5512 ).
5513
5514 convert_eventb_classicalb(EBMachine,CBMachine) :-
5515 select_section(operation_bodies,In,Out,EBMachine,CBMachine1),
5516 maplist(convert_eventop,In,Out),
5517 select_section(initialisation,IIn,IOut,CBMachine1,CBMachine),
5518 convert_event(IIn,[],IOut).
5519 convert_eventop(EBOp,CBOp) :-
5520 get_texpr_expr(EBOp,operation(Id,[],Args,EBBody)),
5521 get_texpr_info(EBOp,Info),
5522 convert_event(EBBody,Args,CBBody),
5523 % Remove the arguments
5524 create_texpr(operation(Id,[],[],CBBody),op([],[]),Info,CBOp).
5525 convert_event(TEvent,Parameters,TSubstitution) :-
5526 get_texpr_expr(TEvent,rlevent(_Id,_Section,_Status,_Parameters,Guard,_Theorems,Actions,_VariableWitnesses,_ParameterWitnesses,_Ums,_Refined)),
5527 in_parallel(Actions,PAction),
5528 convert_event2(Parameters,Guard,PAction,TSubstitution).
5529 convert_event2([],Guard,Action,Action) :-
5530 is_truth(Guard),!.
5531 convert_event2([],Guard,Action,Select) :-
5532 !,create_texpr(select([When]),subst,[],Select),
5533 create_texpr(select_when(Guard,Action),subst,[],When).
5534 convert_event2(Parameters,Guard,Action,Any) :-
5535 create_texpr(any(Parameters,Guard,Action),subst,[],Any).
5536 in_parallel([],Skip) :- !,create_texpr(skip,subst,[],Skip).
5537 in_parallel([A],A) :- !.
5538 in_parallel(Actions,Parallel) :- create_texpr(parallel(Actions),subst,[],Parallel).
5539
5540 conversion_check(Machine) :-
5541 animation_mode(b),
5542 animation_minor_mode(eventb),
5543 get_section(initialisation,Machine,Init),
5544 get_texpr_expr(Init,rlevent(_Id,_Sec,_St,_Par,_Grd,_Thms,_Act,_VW,_PW,_Ums,[])).
5545
5546 % ------------------------------------------------------------
5547
5548 % divide a B typed expression into columns for CSV export or Table viewing of its values
5549 get_bexpression_column_template(b(couple(A,B),_,_),(AVal,BVal),ColHeaders,Columns) :- !,
5550 get_bexpression_column_template(A,AVal,AHeaders,AColumns),
5551 get_bexpression_column_template(B,BVal,BHeaders,BColumns),
5552 append(AHeaders,BHeaders,ColHeaders),
5553 append(AColumns,BColumns,Columns).
5554 get_bexpression_column_template(TypedExpr,Value,[ColHeader],[Value]) :-
5555 translate:translate_bexpression_with_limit(TypedExpr,100,ColHeader).
5556
5557
5558 % a version of member that creates an error when info list not instantiated
5559 member_in_info(X,T) :- var(T),!, add_internal_error('Illegal info field:', member_in_info(X,T)),fail.
5560 member_in_info(X,[X|_]).
5561 member_in_info(X,[_|T]) :- member_in_info(X,T).
5562
5563 memberchk_in_info(X,T) :- var(T),!, add_internal_error('Illegal info field:', memberchk_in_info(X,T)),fail.
5564 memberchk_in_info(X,[X|_]) :- !.
5565 memberchk_in_info(X,[_|T]) :- memberchk_in_info(X,T).
5566
5567 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
5568
5569 :- use_module(library(clpfd)).
5570
5571 % print also partially instantiated variables with CLP(FD) Info
5572 print_value_variable(X) :- var(X), !, print(X).
5573 print_value_variable(int(X)) :- print('int('), print_clpfd_variable(X), print(')').
5574 print_value_variable(fd(X,T)) :- print('fd('), print_clpfd_variable(X), print(','), print(T),print(')').
5575 print_value_variable(X) :- print(X).
5576
5577 print_clpfd_variable(X) :- var(X),!,print(X), print(':'), fd_dom(X,Dom), print(Dom), print_frozen_info(X).
5578 print_clpfd_variable(X) :- print(X).
5579
5580 %print_clpfd_variables([]).
5581 %print_clpfd_variables([H|T]) :- print('CLPFD: '),print_clpfd_variable(H), nl, print_clpfd_variables(T).
5582
5583
5584 :- public l_print_frozen_info/1.
5585 l_print_frozen_info([]).
5586 l_print_frozen_info([H|T]) :- print(H), print(' '),
5587 (var(H) -> print_frozen_info(H) ;
5588 H=fd_var(V,_) -> print_frozen_info(V) ; true), l_print_frozen_info(T).
5589
5590 print_frozen_info(X) :- frozen(X,Goal), print_frozen_goal(Goal).
5591 print_frozen_goal((A,B)) :- !, print_frozen_goal(A), print(','), print_frozen_goal(B).
5592 print_frozen_goal(prolog:trig_nondif(_A,_B,R,_S)) :- !, frozen(R,G2), print_frozen_goal2(G2).
5593 print_frozen_goal(G) :- print_frozen_goal2(G).
5594 print_frozen_goal2(V) :- var(V),!, print(V).
5595 print_frozen_goal2(true) :- !.
5596 print_frozen_goal2((A,B)) :- !, print_frozen_goal2(A), print(','), print_frozen_goal2(B).
5597 print_frozen_goal2(G) :- print(' :: '), tools_printing:print_term_summary(G).
5598
5599
5600 /* Event-B operators */
5601 translate_eventb_operators([]) --> !.
5602 translate_eventb_operators([Name-Call|Rest]) -->
5603 translate_eventb_operator(Call,Name),
5604 translate_eventb_operators(Rest).
5605
5606 translate_eventb_operator(Module:Call,Name) -->
5607 insertcodes("\n "),
5608 indention_codes(In,Out),
5609 {Call =.. [Functor|Args],
5610 translate_eventb_operator2(Functor,Args,Module,Call,Name,In,Out)}.
5611
5612
5613 translate_eventb_operator2(direct_definition,[Args,_RawWD,RawBody,TypeParas|_],_Module,_Call,Name) -->
5614 pp_eventb_direct_definition_header(Name,Args),!,
5615 ppcodes(" direct_definition ["),
5616 pp_eventb_operator_args(TypeParas),
5617 ppcodes("] "),
5618 {translate_in_mode(eqeq,'==',EqEqStr)}, ppatom(EqEqStr),
5619 ppcodes(" "),
5620 pp_raw_formula(RawBody). % TO DO: use indentation
5621 translate_eventb_operator2(axiomatic_definition,[Tag|_],_Module,_Call,Name) --> !,
5622 ppterm(Name),
5623 ppcodes(": Operator implemented by axiomatic definition using "),
5624 ppatom(Tag).
5625 translate_eventb_operator2(Functor,_,Module,_Call,Name) -->
5626 ppterm(Name),
5627 ppcodes(": Operator implemented by "),
5628 ppatom(Module),ppcodes(":"),ppatom(Functor).
5629
5630 % example direct definition:
5631 %direct_definition([argument(curM,integer_set(none)),argument(curH,integer_set(none))],truth(none),add(none,identifier(none,curM),multiplication(none,identifier(none,curH),integer(none,60))),[])
5632
5633 pp_eventb_direct_definition_header(Name,Args) -->
5634 ppterm(Name), ppcodes("("),
5635 pp_eventb_operator_args(Args), ppcodes(")").
5636
5637 translate_eventb_direct_definition_header(Name,Args,ResAtom) :-
5638 (pp_eventb_direct_definition_header(Name,Args,C,[])
5639 -> atom_codes(ResAtom,C) ; ResAtom='<<UNABLE TO PRETTY-PRINT OPERATOR HEADER>>').
5640 translate_eventb_direct_definition_body(RawBody,ResAtom) :-
5641 (pp_raw_formula(RawBody,C,[]) -> atom_codes(ResAtom,C) ; ResAtom='<<UNABLE TO PRETTY-PRINT OPERATOR BODY>>').
5642
5643 pp_raw_formula(RawExpr) --> {transform_raw(RawExpr,TExpr)},!, pp_expr(TExpr,_,_LR).
5644 pp_raw_formula(_) --> ppcodes("<<UNABLE TO PRETTY-PRINT>>").
5645
5646
5647 pp_eventb_operator_args([]) --> [].
5648 pp_eventb_operator_args([Arg]) --> !, pp_argument(Arg).
5649 pp_eventb_operator_args([Arg|T]) --> pp_argument(Arg), ppcodes(","),
5650 pp_eventb_operator_args(T).
5651 pp_argument(argument(ID,_RawType)) --> !, ppatom(ID).
5652 pp_argument(identifier(_,ID)) --> !, "<",ppatom(ID),">".
5653 pp_argument(Atom) --> ppatom(Atom).
5654
5655 % ---------------------------------------
5656
5657 % translate a predicate into B machine for manipulation
5658 translate_predicate_into_machine(Pred,MchName,ResultAtom) :-
5659 get_global_identifiers(Ignored,ignore_promoted_constants),
5660 find_typed_identifier_uses(Pred, Ignored, TUsedIds),
5661 get_texpr_ids(TUsedIds,UsedIds),
5662 add_typing_predicates(TUsedIds,Pred,TPred),
5663 set_print_type_infos(all),
5664 specfile:set_animation_mode(b), % clear eventb minor mode; to do: set back
5665 translate_bexpression(TPred,PredAtom), %print(res(UsedIds,ResultAtom)),nl,
5666 set_print_type_infos(none),
5667 convert_and_ajoin_ids(UsedIds,AllIds),
5668 bmachine:get_full_b_machine(_Name,BMachine),
5669 include(relevant_section,BMachine,RelevantSections),
5670 % TO DO: we could filter out enumerate/deferred sets not occuring in Pred
5671 translate_section_list(RelevantSections,SetsParas),
5672 atom_codes(ASP,SetsParas),
5673 ajoin(['MACHINE ', MchName, '\n',ASP,'CONSTANTS ',AllIds,'\nPROPERTIES\n ',PredAtom,'\nEND\n'],ResultAtom).
5674
5675 relevant_section(deferred_sets/_).
5676 relevant_section(enumerated_elements/_).
5677 relevant_section(parameters/_).
5678
5679 :- use_module(library(system),[ datime/1]).
5680 :- use_module(specfile,[currently_opened_file/1]).
5681 :- use_module(probsrc(version), [format_prob_version/1]).
5682 % print a Proof Obligation aka Sequent as a B machine
5683 nested_print_sequent_as_classicalb(Stream,HypsList,Goal,AllHypsList,MchName,ProofInfos) :-
5684 set_suppress_rodin_positions(false,Chng), % ensure we print Rodin labels if available
5685 call_cleanup(nested_print_sequent_as_classicalb_aux(Stream,HypsList,Goal,AllHypsList,MchName,ProofInfos),
5686 reset_suppress_rodin_positions(Chng)).
5687
5688 % convert identifier by adding backquote if necessary for unicode, reserved keywords, ...
5689 convert_id(Atom,CAtom) :- pp_identifier(Atom,Codes,[]), atom_codes(CAtom,Codes).
5690 convert_and_ajoin_ids(UsedIds,AllIdsWithCommas) :-
5691 maplist(convert_id,UsedIds,ConvUsedIds),
5692 ajoin_with_sep(ConvUsedIds,', ',AllIdsWithCommas).
5693
5694 nested_print_sequent_as_classicalb_aux(Stream,HypsList,Goal,AllHypsList,MchName,ProofInfos) :-
5695 conjunct_predicates(HypsList,HypsPred),
5696 conjunct_predicates([Goal|HypsList],Pred),
5697 get_global_identifiers(Ignored,ignore_promoted_constants), % the sets section below will not print the promoted enumerated set constants, they may also not be valid for the selected hyps only
5698 find_typed_identifier_uses(Pred, Ignored, TUsedIds),
5699 get_texpr_ids(TUsedIds,UsedIds),
5700 convert_and_ajoin_ids(UsedIds,AllIds),
5701 bmachine:get_full_b_machine(_Name,BMachine),
5702 include(relevant_section,BMachine,RelevantSections),
5703 % TO DO: we could filter out enumerate/deferred sets not occuring in Pred
5704 translate_section_list(RelevantSections,SetsParas),
5705 set_print_type_infos(all),
5706 datime(datime(Yr,Mon,Day,Hr,Min,_Sec)),
5707 format(Stream,'MACHINE ~w~n /* Exported: ~w/~w/~w ~w:~w */~n',[MchName,Day,Mon,Yr,Hr,Min]),
5708 (currently_opened_file(File), bmachine:b_machine_name(Name)
5709 -> format(Stream,' /* Origin: ~w : ~w */~n',[Name,File]) ; true),
5710 write(Stream,' /* '),format_prob_version(Stream), format(Stream,' */~n',[]),
5711 format(Stream,' /* Use static asssertion checking (probcli -cbc_assertions) to look for counter examples */~n',[]),
5712 maplist(format_proof_infos(Stream),ProofInfos),
5713 format(Stream,'~sCONSTANTS~n ~w~nPROPERTIES /* Selected Hypotheses: */~n',[SetsParas,AllIds]),
5714 add_typing_predicates(TUsedIds,HypsPred,HypsT),
5715 current_output(OldStream),
5716 set_output(Stream),
5717 nested_print_bexpr_as_classicalb2(HypsT,s(0)), % TODO: pass stream to this predicate
5718 format(Stream,'~nASSERTIONS /* Proof Goal: */~n',[]),
5719 nested_print_bexpr_as_classicalb2(Goal,s(0)), % TODO: pass stream to this predicate
5720 (AllHypsList = [] -> true
5721 ; sort(AllHypsList,SAL), sort(HypsList,SL),
5722 ord_subtract(SAL,SL,RemainingHypsList), % TODO: we could preserve order
5723 conjunct_predicates(RemainingHypsList,AllHypsPred),
5724 find_typed_identifier_uses(AllHypsPred, Ignored, TAllUsedIds),
5725 get_texpr_ids(TAllUsedIds,AllUsedIds),
5726 ord_subtract(AllUsedIds,UsedIds,NewIds), % compute new ids not used in selected hyps and goal
5727 (NewIds = []
5728 -> format(Stream,'OPERATIONS~n CheckRemainingHypotheses = SELECT~n',[])
5729 ; ajoin_with_sep(NewIds,', ',NIdLst),
5730 format(Stream,'OPERATIONS~n CheckRemainingHypotheses(~w) = SELECT~n',[NIdLst])
5731 ),
5732 nested_print_bexpr_as_classicalb2(AllHypsPred,s(0)), % TODO: pass stream to this predicate
5733 format(Stream,' THEN skip~n END /* CheckRemainingHypotheses */~n',[])
5734 ),
5735 set_output(OldStream),
5736 set_print_type_infos(none),
5737 format(Stream,'DEFINITIONS~n SET_PREF_DISPROVER_MODE == TRUE~n ; SET_PREF_TRY_FIND_ABORT == FALSE~n',[]),
5738 format(Stream,' ; SET_PREF_ALLOW_REALS == FALSE~n',[]),
5739 % The Rodin DisproverCommand.java usually enables CHR;
5740 % TODO: we could also look for options(List) in ProofInfos and check use_chr_solver/true in List, ...
5741 (get_preference(use_clpfd_solver,false) -> format(Stream,' ; SET_PREF_CHR == FALSE~n',[]) ; true),
5742 (get_preference(use_chr_solver,true) -> format(Stream,' ; SET_PREF_CHR == TRUE~n',[]) ; true),
5743 (get_preference(use_smt_mode,true) -> format(Stream,' ; SET_PREF_SMT == TRUE~n',[]) ; true),
5744 (get_preference(use_smt_mode,true) -> format(Stream,' ; SET_PREF_SMT == TRUE~n',[]) ; true),
5745 (get_preference(use_common_subexpression_elimination,true) -> format(Stream,' ; SET_PREF_CSE == TRUE~n',[]) ; true),
5746 (get_preference(smt_supported_interpreter,true) -> format(Stream,' ; SET_PREF_SMT_SUPPORTED_INTERPRETER == TRUE~n',[]) ; true),
5747 format(Stream,'END~n',[]).
5748
5749 format_proof_infos(_,Var) :- var(Var),!.
5750 format_proof_infos(Stream,disprover_result(Prover,Hyps,Result)) :- nonvar(Result),functor(Result,FR,_),!,
5751 format(Stream,' /* ProB Disprover ~w result on ~w : ~w */~n',[Prover,Hyps,FR]).
5752 format_proof_infos(Stream,E) :- format(Stream,' /* ~w */~n',[E]).
5753
5754
5755 % ---------------------------------------
5756
5757
5758 % show non obvious functors
5759 get_texpr_top_level_symbol(TExpr,Symbol,2,infix) :-
5760 translate:binary_infix_symbol(TExpr,Symbol),!.
5761 get_texpr_top_level_symbol(b(E,_,_),Symbol,1,postfix) :-
5762 functor(E,F,1), translate:unary_postfix_in_mode(F,Symbol,_),!.
5763 get_texpr_top_level_symbol(b(E,_,_),Symbol,3,prefix) :-
5764 functor(E,F,Arity), (Arity=3 ; Arity=2), % 2 for exists
5765 quantified_in_mode(F,Symbol),!.
5766 get_texpr_top_level_symbol(b(E,_,_),Symbol,N,prefix) :-
5767 functor(E,F,N),
5768 function_like_in_mode(F,Symbol).