1		% (c) 2014-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(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		% note: the same id/field-name can occur in left and right; in principle we should add path info
53		append(I1,I2,IDs).
54		get_expr_header_ids(rec(FieldTypes),_,_,IDs) :-
55		findall(Header,(member(field(Field,Val),FieldTypes),
56		(get_texpr_header_ids(Val,inner,InnerIds)
57		-> member(II,InnerIds),ajoin([Field,'.',II],Header)
58		; Header=Field)), IDs).
59
60
61		get_texpr_original_ids(TIDs,IDs) :-
62		% variation of get_texpr_original_ids, to rewrite _lambda_result_ into original form before detect_lambdas
63		% relevant for test 1840
64		maplist(get_texpr_original_id,TIDs,IDs).
65		get_texpr_original_id(b(identifier(OID),_,I),ID) :- get_texpr_original_id2(OID,I,ID).
66		get_texpr_original_id2(OID,Infos,ID) :-
67		(member(lambda_result_id_was(ID),Infos) -> true ; ID=OID).
68
69		single_col_type(integer).
70		single_col_type(boolean).
71		single_col_type(string).
72		single_col_type(global(_)).
73		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
74
75		% expand a SetValue into a Header List and a Table List
76
77		expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts) :-
78		(get_header_from_expression(TypedExpr,Header,Opts) -> true ; true), % try and get simpler header from typed expression ids and field names
79		(expand_and_translate_to_table(Value,Header,Table,Opts)
80		-> ResTable=Table
81		; add_internal_error('Failed:',expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts)),
82		ResTable=[]
83		).
84
85		:- assert_must_succeed(( expand_and_translate_to_table([rec([field(a,int(1)),field(b,int(2))])],H,T),
86		H == ['Nr',a,b], T==[list([1,'1','2'])] )).
87		:- assert_must_succeed(( expand_and_translate_to_table([(int(1),int(2)),(int(33),int(44))],H,T),
88		H == ['Nr',prj1,prj2], T==[list([1,'1','2']),list([2,'33','44'])] )).
89		:- assert_must_succeed(( expand_and_translate_to_table([(int(1),rec([field(f,int(2)),field(g,int(3))]))],H,T),
90		H==['Nr',prj1,'prj2\'f','prj2\'g'], T==[list([1,'1','2','3'])] )).
91		expand_and_translate_to_table(Value,Header,Table) :-
92		expand_and_translate_to_table(Value,Header,Table,[]).
93		expand_and_translate_to_table(Value,Header,Table,Opts) :-
94		expand(Value, ExpVal),
95		translate_to_table(ExpVal,1,Table,Header,Opts). %, print(table(Res)),nl.
96
97		:- use_module(probsrc(custom_explicit_sets),[is_custom_explicit_set/1,try_expand_custom_set_with_catch/3]).
98		expand(Var,Res) :- var(Var),!,Res=[Var].
99		expand((A,B),[(A,B)]) :- !. % wrap into a singleton set
100		expand(rec(Fields),[rec(Fields)]) :- !. % wrap into a singleton set
101		expand(Value,ExpVal) :- is_custom_explicit_set(Value),!,
102		try_expand_custom_set_with_catch(Value, ExpVal,table_tools).
103		expand([H|T],V) :- !, V=[H|T].
104		expand([],V) :- !, V=[].
105		expand(Val,[Val]).
106
107
108		set_header([Header|T],[El|TE]) :- !,
109		(set_header_el(Header,El) -> true ; add_warning(table_tools,'set_header failed: ',Header:El)),
110		set_header(T,TE).
111		set_header([],TE) :- !, (TE=[] -> true ; add_warning(table_tools,'set_header extra elements: ',TE)).
112		set_header(Hs,[]) :- !, add_warning(table_tools,'set_header extra headers: ',Hs).
113		set_header_el(H,_) :- atomic(H),!. % header already set by caller
114		set_header_el(Header,El) :- Header=El.
115
116		translate_to_table(A,RowNr,[list(L)],Header,Opts) :- var(A),!,
117		(member('no-row-numbers',Opts) -> set_header(Header,['Value']),L=AT
118		; set_header(Header,['Nr','Value']),L=[RowNr|AT]),
119		translate:translate:translate_bvalue(A,AT).
120		translate_to_table([],_RowNr,[],Header,Opts) :- !,
121		(ground(Header) -> true % we already have a header
122		; member('no-row-numbers',Opts) -> set_header(Header,['Elements']) ; set_header(Header,['Nr','Elements'])).
123		translate_to_table([A|T],RowNr,[list(LA)|TT],Header,Opts) :- member('no-row-numbers',Opts),
124		!,
125		get_table_entry(A,LA,Header,Opts),
126		R1 is RowNr+1,
127		translate_to_table(T,R1,TT,_,Opts).
128		translate_to_table([A|T],RowNr,[list([RowNr|LA])|TT],['Nr'|Header],Opts) :- !,
129		get_table_entry(A,LA,Header,Opts),
130		R1 is RowNr+1,
131		translate_to_table(T,R1,TT,_,Opts).
132		translate_to_table(A,_RowNr,[list(AT)],['Value'],Opts) :- member('no-row-numbers',Opts),!,
133		translate:translate:translate_bvalue(A,AT).
134		translate_to_table(A,RowNr,[list([RowNr|AT])],Header,_) :- !,
135		set_header(Header,['Nr','Value']),
136		translate:translate:translate_bvalue(A,AT).
137		translate_to_table(ExpVal,Row,Table,Header,Opts) :-
138		add_internal_error('Failed:',translate_to_table(ExpVal,Row,Table,Header,Opts)),fail.
139
140		:- use_module(library(lists),[maplist/3]).
141		get_table_entry(Var,LA,Header,_) :- var(Var),!, LA = [VT], set_header(Header,['prj1']),
142		translate:translate:translate_bvalue(Var,VT).
143		get_table_entry(rec(Fields),Vals,FieldNames,Opts) :-
144		maplist(get_record_field_val_name(Opts),Fields,Vals,FieldNames),!.
145		get_table_entry(A,[AT],Header,_) :- A \= (_,_),!,
146		set_header(Header,['Elements']),
147		translate:translate:translate_bvalue(A,AT).
148		get_table_entry(A,AT,HA,Opts) :- %A=(A1,A2), (A1 = (_,_) ; A2=(_,_)),
149		!,
150		get_table_entry2(A,[],AT,HA,Opts).
151		%get_table_entry((A,B),[AT,BT],['prj1','prj2']) :- !,
152		% translate:translate:translate_bvalue(A,AT),
153		% translate:translate:translate_bvalue(B,BT).
154
155		get_record_field_val_name(Opts,field(Name,Value),ValS,ColName) :-
156		(member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
157		translate:translate:translate_bvalue(Value,ValS).
158
159		get_table_entry2(A,Path,[AT],Header,_Opts) :- var(A),!,
160		reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
161		set_header(Header,[PRJRP]),
162		translate:translate:translate_bvalue(A,AT).
163		get_table_entry2((A,B),Path,ABT,Header,Opts) :- !,
164		get_table_entry2(A,[1|Path],AT,HA,Opts),
165		get_table_entry2(B,[2|Path],BT,HB,Opts),
166		append(AT,BT,ABT), append(HA,HB,HAB),
167		% TO DO: fix issue when Header given and not same length as HAB, :table {lhs,rhs| lhs |-> rhs : delta} for PDA_to_CFG.mch
168		set_header(Header,HAB).
169		get_table_entry2(rec([field(Name,Val)|Rest]),Path,Values,Header,Opts) :- !,
170		(member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
171		get_table_entry2(Val,[ColName,'\''|Path],AT,HA,Opts),
172		(Rest=[] -> Values=AT, HAB=HA
173		; get_table_entry2(rec(Rest),Path,BT,HB,Opts),
174		append(AT,BT,Values), append(HA,HB,HAB)
175		), set_header(Header,HAB).
176		get_table_entry2(A,Path,[AT],Header,_Opts) :- !,
177		reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
178		set_header(Header,[PRJRP]),
179		translate:translate:translate_bvalue(A,AT).
180
181
182		valid_option(latex).
183		valid_option('no-tabular').
184		valid_option('no-hline').
185		valid_option('no-headings').
186		valid_option('no-row-numbers').
187		valid_option(argument_value('max-table-size',_)).
188		check_option(O) :- (valid_option(O) -> true ; add_error(table_tools,'Illegal option:',O)).
189
190
191		print_table(Header,Table) :- print_table(user_output,Header,Table,[]).
192
193		print_table(Stream,Header,Table,Opts) :-
194		maplist(check_option,Opts),
195		(member(argument_value('max-table-size',Sze),Opts)
196		-> split_list(Table,Sze,Tables), % split into individual tables, each with own header; useful for Latex
197		maplist(print_table_aux_nl(Stream,Header,Opts),Tables)
198		; print_table_aux(Stream,Header,Opts,Table)
199		).
200		print_table_aux_nl(Stream,Header,Opts,Table) :- print_table_aux(Stream,Header,Opts,Table),nl(Stream).
201
202		print_table_aux(Stream,Header,Opts,Table) :-
203		print_table_header(Stream,Header,Opts),
204		(member('no-headings',Opts) -> true ;
205		print_row(Stream,Opts,list(Header)),
206		print_header_terminator(Stream,Opts)
207		),
208		maplist(print_row(Stream,Opts),Table),
209		print_table_footer(Stream,Opts).
210
211
212		print_row(Stream,Opts,list(Row)) :-
213		print_row_aux(Row,Stream,Opts),
214		print_row_terminator(Stream,Opts).
215
216		print_row_aux(V,Stream,_Opts) :- var(V),!, format(Stream,'~w ... ',[V]).
217		print_row_aux([],_,_) :- !.
218		print_row_aux([H|T],Stream,Opts) :- !, print_entry(Stream,H,T,Opts),
219		print_row_aux(T,Stream,Opts).
220		print_row_aux(list(L),Stream,Opts) :- !, % alternative format also for Tcl/Tk
221		print_row_aux(L,Stream,Opts).
222		print_row_aux(Other,Stream,_Opts) :- format(Stream,'~w ... ',[Other]).
223
224		get_latex_col(_,108). % 99 is lower-case l
225		%get_latex_col(_,99). % 99 is lower-case c
226
227		print_table_header(Stream,list(Header),Opts) :- !,
228		print_table_header(Stream,Header,Opts).
229		print_table_header(Stream,Header,Opts) :- member(latex,Opts),
230		nonmember('no-tabular',Opts),
231		!,
232		maplist(get_latex_col,Header,LatexColSpec),
233		format(Stream,'\\begin{tabular}{~s}~n',[LatexColSpec]),
234		hline(Stream,Opts).
235		print_table_header(_,_,_).
236
237		print_row_terminator(Stream,Opts) :- member(latex,Opts),!, format(Stream,'\\\\~n',[]).
238		print_row_terminator(Stream,_) :- nl(Stream).
239
240		print_header_terminator(Stream,Opts) :- member(latex,Opts),!,
241		format('\\\\~n',[]),
242		hline(Stream,Opts).
243		print_header_terminator(_,_).
244
245		print_table_footer(Stream,Opts) :- member(latex,Opts),
246		nonmember('no-tabular',Opts),
247		!,
248		hline(Stream,Opts),
249		format(Stream,'\\end{tabular}~n',[]).
250		print_table_footer(_,_).
251
252		hline(_,Opts) :- member('no-hline',Opts),!.
253		hline(Stream,_) :- format(Stream,'\\hline ~n',[]).
254
255		% TO DO: determine column length dynamically
256		print_entry(Stream,E,T,Opts) :- member(latex,Opts),!,
257		print(Stream,' $'),print(Stream,E), (T==[] -> print(Stream,'$ ') ; print(Stream,'$ & ')).
258		print_entry(Stream,E,_,_) :- print(Stream,E), my_atom_length(E,Len), WS is 10-Len, print_ws(Stream,WS),!.
259		print_entry(Stream,E,_,_) :- add_internal_error('Failed: ',print_entry(Stream,E,_,_)),
260		print(Stream,print_entry_failed(E)),nl(Stream).
261
262		print_ws(Stream,X) :- X>1, !, print(Stream,' '), X1 is X-1, print_ws(Stream,X1).
263		print_ws(Stream,_) :- print(Stream,' ').
264
265		my_atom_length(AtomOrNumber,Len) :- atom(AtomOrNumber),!, atom_length(AtomOrNumber,Len).
266		my_atom_length(Var,Len) :- var(Var),!, Len=6. % no idea how long a variable is
267		my_atom_length(C,Len) :- compound(C),!, Len=6. % no idea how long a compound is
268		my_atom_length(A,Len) :- number(A),!,number_codes(A,List), length(List,Len).
269		my_atom_length(A,Len) :- atom_codes(A,List), length(List,Len).
270
271		% split lists into sub-lists of at most length Maxlen
272		split_list([],_,[]).
273		split_list([H|T],Maxlen,[ [H|T1] |Rest]) :- get_list(T,Maxlen,T1,RT), split_list(RT,Maxlen,Rest).
274
275		get_list([],_,[],[]).
276		get_list([H|T],Max,[H|T1],Rest) :- Max>1, !, M1 is Max-1, get_list(T,M1,T1,Rest).
277		get_list(L,_,[],L).