1		% (c) 2014-2023 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(table_tools, [expand_and_translate_to_table/3,
6		expand_and_translate_to_table_for_expr/5,
7		print_table/4, print_table/2,
8		print_value_as_table/4, print_value_as_table/2
9		]).
10
11		:- use_module(probsrc(module_information),[module_info/2]).
12		:- module_info(group,pltables).
13		:- module_info(description,'This module provides utilities to print tables.').
14
15		:- use_module(probsrc(translate)).
16		:- use_module(probsrc(tools_strings),[ajoin/2]).
17		:- use_module(library(lists)).
18		:- use_module(probsrc(self_check)).
19		:- use_module(probsrc(error_manager)).
20
21		print_value_as_table(Expr,Value) :- print_value_as_table(user_output,Expr,Value,[]).
22
23		print_value_as_table(Stream,Expr,Value,Opts) :-
24		expand_and_translate_to_table(Value,Header,Table,Opts),
25		print_value_as_table2(Stream,Expr,Header,Table,Opts).
26
27		print_value_as_table2(Stream,Expr,Header,Table,Opts) :-
28		get_header_from_expression(Expr,ExprHeader,Opts),
29		% check if ExprHeader is valid:
30		same_length(Header,ExprHeader),
31		!,
32		print_table(Stream,ExprHeader,Table,Opts).
33		print_value_as_table2(Stream,_Expr,Header,Table,Opts) :-
34		print_table(Stream,Header,Table,Opts).
35
36		:- use_module(probsrc(tools),[latex_escape_atom/2]).
37		get_header_from_expression(TExpr,ExprHeader,Opts) :-
38		get_texpr_header_ids(TExpr,toplevel,Hs),
39	?	(member(latex,Opts) -> maplist(latex_escape_atom,Hs,Header) ; Header=Hs),
40		(member('no-row-numbers',Opts) -> ExprHeader = Header ; ExprHeader = ['Nr'|Header]).
41
42		get_texpr_header_ids(b(E,Type,_),Top,IDs) :- get_expr_header_ids(E,Type,Top,IDs).
43		get_expr_header_ids(comprehension_set([_TID1],_),set(record(FieldTypes)),toplevel,IDs) :- !,
44		% special case for set of records
45		findall(Field,member(field(Field,_),FieldTypes),IDs).
46		get_expr_header_ids(comprehension_set(TIDs,_),_,toplevel,IDs) :- !,get_texpr_original_ids(TIDs,IDs).
47		get_expr_header_ids(identifier(OID),Type,Infos,[ID]) :-
48		get_texpr_original_id2(OID,Infos,ID),
49		single_col_type(Type). % otherwise the column will be split e.g. using prj1/2,... into multiple ones
50		get_expr_header_ids(couple(A,B),_,_,IDs) :-
51		get_texpr_header_ids(A,inner,I1), get_texpr_header_ids(B,inner,I2),
52		append(I1,I2,IDs).
53		get_expr_header_ids(rec(FieldTypes),_,_,IDs) :-
54		findall(Field,member(field(Field,_),FieldTypes),IDs).
55
56
57		get_texpr_original_ids(TIDs,IDs) :-
58		% variation of get_texpr_original_ids, to rewrite _lambda_result_ into original form before detect_lambdas
59		% relevant for test 1840
60		maplist(get_texpr_original_id,TIDs,IDs).
61		get_texpr_original_id(b(identifier(OID),_,I),ID) :- get_texpr_original_id2(OID,I,ID).
62		get_texpr_original_id2(OID,Infos,ID) :-
63	?	(member(lambda_result_id_was(ID),Infos) -> true ; ID=OID).
64
65		single_col_type(integer).
66		single_col_type(boolean).
67		single_col_type(string).
68		single_col_type(global(_)).
69		single_col_type(set(X)) :- single_col_type(X). % set is ok if outer ID is not the only one in a couple; TO DO: merge header and value extraction in a single predicate to avoid such issues
70
71		% expand a SetValue into a Header List and a Table List
72
73		expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts) :-
74		(get_header_from_expression(TypedExpr,Header,Opts) -> true ; true),
75		(expand_and_translate_to_table(Value,Header,Table,Opts)
76		-> ResTable=Table
77		; add_internal_error('Failed:',expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts)),
78		ResTable=[]
79		).
80
81		:- assert_must_succeed(( expand_and_translate_to_table([rec([field(a,int(1)),field(b,int(2))])],H,T),
82		H == ['Nr',a,b], T==[list([1,'1','2'])] )).
83		:- assert_must_succeed(( expand_and_translate_to_table([(int(1),int(2)),(int(33),int(44))],H,T),
84		H == ['Nr',prj1,prj2], T==[list([1,'1','2']),list([2,'33','44'])] )).
85		:- assert_must_succeed(( expand_and_translate_to_table([(int(1),rec([field(f,int(2)),field(g,int(3))]))],H,T),
86		H==['Nr',prj1,'prj2\'f','prj2\'g'], T==[list([1,'1','2','3'])] )).
87		expand_and_translate_to_table(Value,Header,Table) :-
88		expand_and_translate_to_table(Value,Header,Table,[]).
89		expand_and_translate_to_table(Value,Header,Table,Opts) :-
90		expand(Value, ExpVal),
91		translate_to_table(ExpVal,1,Table,Header,Opts). %, print(table(Res)),nl.
92
93		:- use_module(probsrc(custom_explicit_sets),[is_custom_explicit_set/1,try_expand_custom_set_with_catch/3]).
94		expand(Var,Res) :- var(Var),!,Res=[Var].
95		expand((A,B),[(A,B)]) :- !. % wrap into a singleton set
96		expand(rec(Fields),[rec(Fields)]) :- !. % wrap into a singleton set
97		expand(Value,ExpVal) :- is_custom_explicit_set(Value),!,
98		try_expand_custom_set_with_catch(Value, ExpVal,table_tools).
99		expand([H|T],V) :- !, V=[H|T].
100		expand([],V) :- !, V=[].
101		expand(Val,[Val]).
102
103		:- use_module(library(lists),[maplist/3]).
104		set_header(Header,Els) :-
105		(maplist(set_header_el,Header,Els) -> true ; add_internal_error('Cannot set header:',set_header(Header,Els))).
106		set_header_el(H,_) :- atomic(H),!. % header already set by caller
107		set_header_el(Header,El) :- Header=El.
108
109		translate_to_table(A,RowNr,[list(L)],Header,Opts) :- var(A),!,
110		(member('no-row-numbers',Opts) -> set_header(Header,['Value']),L=AT
111		; set_header(Header,['Nr','Value']),L=[RowNr|AT]),
112		translate:translate:translate_bvalue(A,AT).
113		translate_to_table([],_RowNr,[],Header,Opts) :- !,
114		(ground(Header) -> true % we already have a header
115		; member('no-row-numbers',Opts) -> set_header(Header,['Elements']) ; set_header(Header,['Nr','Elements'])).
116		translate_to_table([A|T],RowNr,[list(LA)|TT],Header,Opts) :- member('no-row-numbers',Opts),
117		!,
118		get_table_entry(A,LA,Header,Opts),
119		R1 is RowNr+1,
120		translate_to_table(T,R1,TT,_,Opts).
121		translate_to_table([A|T],RowNr,[list([RowNr|LA])|TT],['Nr'|Header],Opts) :- !,
122		get_table_entry(A,LA,Header,Opts),
123		R1 is RowNr+1,
124		translate_to_table(T,R1,TT,_,Opts).
125		translate_to_table(A,_RowNr,[list(AT)],['Value'],Opts) :- member('no-row-numbers',Opts),!,
126		translate:translate:translate_bvalue(A,AT).
127		translate_to_table(A,RowNr,[list([RowNr|AT])],Header,_) :- !,
128		set_header(Header,['Nr','Value']),
129		translate:translate:translate_bvalue(A,AT).
130		translate_to_table(ExpVal,Row,Table,Header,Opts) :-
131		add_internal_error('Failed:',translate_to_table(ExpVal,Row,Table,Header,Opts)),fail.
132
133		get_table_entry(Var,LA,Header,_) :- var(Var),!, LA = [VT], set_header(Header,['prj1']),
134		translate:translate:translate_bvalue(Var,VT).
135		get_table_entry(rec(Fields),Vals,FieldNames,Opts) :-
136		maplist(get_record_field_val_name(Opts),Fields,Vals,FieldNames),!.
137		get_table_entry(A,[AT],Header,_) :- A \= (_,_),!,
138		set_header(Header,['Elements']),
139		translate:translate:translate_bvalue(A,AT).
140		get_table_entry(A,AT,HA,Opts) :- %A=(A1,A2), (A1 = (_,_) ; A2=(_,_)),
141		!,
142		get_table_entry2(A,[],AT,HA,Opts).
143		%get_table_entry((A,B),[AT,BT],['prj1','prj2']) :- !,
144		% translate:translate:translate_bvalue(A,AT),
145		% translate:translate:translate_bvalue(B,BT).
146
147		get_record_field_val_name(Opts,field(Name,Value),ValS,ColName) :-
148		(member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
149		translate:translate:translate_bvalue(Value,ValS).
150
151		get_table_entry2(A,Path,[AT],Header,_Opts) :- var(A),!,
152		reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
153		set_header(Header,[PRJRP]),
154		translate:translate:translate_bvalue(A,AT).
155		get_table_entry2((A,B),Path,ABT,Header,Opts) :- !,
156		get_table_entry2(A,[1|Path],AT,HA,Opts),
157		get_table_entry2(B,[2|Path],BT,HB,Opts),
158		append(AT,BT,ABT), append(HA,HB,HAB),
159		% TO DO: fix issue when Header given and not same length as HAB, :table {lhs,rhs| lhs |-> rhs : delta} for PDA_to_CFG.mch
160		set_header(Header,HAB).
161		get_table_entry2(rec([field(Name,Val)|Rest]),Path,Values,Header,Opts) :- !,
162		(member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
163		get_table_entry2(Val,[ColName,'\''|Path],AT,HA,Opts),
164		(Rest=[] -> Values=AT, HAB=HA
165		; get_table_entry2(rec(Rest),Path,BT,HB,Opts),
166		append(AT,BT,Values), append(HA,HB,HAB)
167		), set_header(Header,HAB).
168		get_table_entry2(A,Path,[AT],Header,_Opts) :- !,
169		reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
170		set_header(Header,[PRJRP]),
171		translate:translate:translate_bvalue(A,AT).
172
173
174		valid_option(latex).
175		valid_option('no-tabular').
176		valid_option('no-hline').
177		valid_option('no-headings').
178		valid_option('no-row-numbers').
179		valid_option(argument_value('max-table-size',_)).
180		check_option(O) :- (valid_option(O) -> true ; add_error(table_tools,'Illegal option:',O)).
181
182
183		print_table(Header,Table) :- print_table(user_output,Header,Table,[]).
184
185		print_table(Stream,Header,Table,Opts) :-
186		maplist(check_option,Opts),
187		(member(argument_value('max-table-size',Sze),Opts)
188		-> split_list(Table,Sze,Tables), % split into individual tables, each with own header; useful for Latex
189		maplist(print_table_aux_nl(Stream,Header,Opts),Tables)
190		; print_table_aux(Stream,Header,Opts,Table)
191		).
192		print_table_aux_nl(Stream,Header,Opts,Table) :- print_table_aux(Stream,Header,Opts,Table),nl(Stream).
193
194		print_table_aux(Stream,Header,Opts,Table) :-
195		print_table_header(Stream,Header,Opts),
196	?	(member('no-headings',Opts) -> true ;
197		print_row(Stream,Opts,list(Header)),
198		print_header_terminator(Stream,Opts)
199		),
200		maplist(print_row(Stream,Opts),Table),
201		print_table_footer(Stream,Opts).
202
203
204		print_row(Stream,Opts,list(Row)) :-
205		print_row_aux(Row,Stream,Opts),
206		print_row_terminator(Stream,Opts).
207
208		print_row_aux(V,Stream,_Opts) :- var(V),!, format(Stream,'~w ... ',[V]).
209		print_row_aux([],_,_) :- !.
210		print_row_aux([H|T],Stream,Opts) :- !, print_entry(Stream,H,T,Opts),
211		print_row_aux(T,Stream,Opts).
212		print_row_aux(list(L),Stream,Opts) :- !, % alternative format also for Tcl/Tk
213		print_row_aux(L,Stream,Opts).
214		print_row_aux(Other,Stream,_Opts) :- format(Stream,'~w ... ',[Other]).
215
216		get_latex_col(_,108). % 99 is lower-case l
217		%get_latex_col(_,99). % 99 is lower-case c
218
219		print_table_header(Stream,list(Header),Opts) :- !,
220		print_table_header(Stream,Header,Opts).
221	?	print_table_header(Stream,Header,Opts) :- member(latex,Opts),
222		nonmember('no-tabular',Opts),
223		!,
224		maplist(get_latex_col,Header,LatexColSpec),
225		format(Stream,'\\begin{tabular}{~s}~n',[LatexColSpec]),
226		hline(Stream,Opts).
227		print_table_header(_,_,_).
228
229	?	print_row_terminator(Stream,Opts) :- member(latex,Opts),!, format(Stream,'\\\\~n',[]).
230		print_row_terminator(Stream,_) :- nl(Stream).
231
232	?	print_header_terminator(Stream,Opts) :- member(latex,Opts),!,
233		format('\\\\~n',[]),
234		hline(Stream,Opts).
235		print_header_terminator(_,_).
236
237	?	print_table_footer(Stream,Opts) :- member(latex,Opts),
238		nonmember('no-tabular',Opts),
239		!,
240		hline(Stream,Opts),
241		format(Stream,'\\end{tabular}~n',[]).
242		print_table_footer(_,_).
243
244		hline(_,Opts) :- member('no-hline',Opts),!.
245		hline(Stream,_) :- format(Stream,'\\hline ~n',[]).
246
247		% TO DO: determine column length dynamically
248	?	print_entry(Stream,E,T,Opts) :- member(latex,Opts),!,
249		print(Stream,' $'),print(Stream,E), (T==[] -> print(Stream,'$ ') ; print(Stream,'$ & ')).
250		print_entry(Stream,E,_,_) :- print(Stream,E), my_atom_length(E,Len), WS is 10-Len, print_ws(Stream,WS),!.
251		print_entry(Stream,E,_,_) :- add_internal_error('Failed: ',print_entry(Stream,E,_,_)),
252		print(Stream,print_entry_failed(E)),nl(Stream).
253
254		print_ws(Stream,X) :- X>1, !, print(Stream,' '), X1 is X-1, print_ws(Stream,X1).
255		print_ws(Stream,_) :- print(Stream,' ').
256
257		my_atom_length(AtomOrNumber,Len) :- atom(AtomOrNumber),!, atom_length(AtomOrNumber,Len).
258		my_atom_length(Var,Len) :- var(Var),!, Len=6. % no idea how long a variable is
259		my_atom_length(C,Len) :- compound(C),!, Len=6. % no idea how long a compound is
260		my_atom_length(A,Len) :- number(A),!,number_codes(A,List), length(List,Len).
261		my_atom_length(A,Len) :- atom_codes(A,List), length(List,Len).
262
263		% split lists into sub-lists of at most length Maxlen
264		split_list([],_,[]).
265		split_list([H|T],Maxlen,[ [H|T1] |Rest]) :- get_list(T,Maxlen,T1,RT), split_list(RT,Maxlen,Rest).
266
267		get_list([],_,[],[]).
268		get_list([H|T],Max,[H|T1],Rest) :- Max>1, !, M1 is Max-1, get_list(T,M1,T1,Rest).
269		get_list(L,_,[],L).