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