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