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