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