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). |