table_tools

check_option(O) :- (valid_option(O) -> true ; add_error(table_tools,'Illegal option:',O)).

expand(Var,Res) :- var(Var),!,Res=[Var].

expand((A,B),[(A,B)]) :- !. % wrap into a singleton set

expand(rec(Fields),[rec(Fields)]) :- !. % wrap into a singleton set

expand(Value,ExpVal) :- is_custom_explicit_set(Value),!,
    try_expand_custom_set_with_catch(Value, ExpVal,table_tools).

expand([H|T],V) :- !, V=[H|T].

expand([],V) :- !, V=[].

expand(Val,[Val]).

expand_and_translate_to_table(Value,Header,Table) :-
    expand_and_translate_to_table(Value,Header,Table,[]).

expand_and_translate_to_table(Value,Header,Table,Opts) :-
    expand(Value, ExpVal),
    translate_to_table(ExpVal,1,Table,Header,Opts). %, print(table(Res)),nl.

expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts) :-
    (get_header_from_expression(TypedExpr,Header,Opts) -> true ; true), % try and get simpler header from typed expression ids and field names
    (expand_and_translate_to_table(Value,Header,Table,Opts)
    -> ResTable=Table
    ; add_internal_error('Failed:',expand_and_translate_to_table_for_expr(TypedExpr,Value,Header,ResTable,Opts)),
    ResTable=[]
).

get_expr_header_ids(comprehension_set([_TID1],_),set(record(FieldTypes)),toplevel,IDs) :- !,
    % special case for set of records
    findall(Field,member(field(Field,_),FieldTypes),IDs).

get_expr_header_ids(comprehension_set(TIDs,_),_,toplevel,IDs) :- !,get_texpr_original_ids(TIDs,IDs).

get_expr_header_ids(identifier(OID),Type,Infos,[ID]) :-
    get_texpr_original_id2(OID,Infos,ID),
    single_col_type(Type). % otherwise the column will be split e.g. using prj1/2,... into multiple ones

get_expr_header_ids(couple(A,B),_,_,IDs) :-
    get_texpr_header_ids(A,inner,I1), get_texpr_header_ids(B,inner,I2),
    % note: the same id/field-name can occur in left and right; in principle we should add path info
    append(I1,I2,IDs).

get_expr_header_ids(rec(FieldTypes),_,_,IDs) :-
    findall(Header,(member(field(Field,Val),FieldTypes),
    (get_texpr_header_ids(Val,inner,InnerIds)
    -> member(II,InnerIds),ajoin([Field,'.',II],Header)
    ; Header=Field)), IDs).

get_header_from_expression(TExpr,ExprHeader,Opts) :-
    get_texpr_header_ids(TExpr,toplevel,Hs),
    (member(latex,Opts) -> maplist(latex_escape_atom,Hs,Header) ; Header=Hs),
    (member('no-row-numbers',Opts) -> ExprHeader = Header ; ExprHeader = ['Nr'|Header]).

get_latex_col(_,108). % 99 is lower-case l

get_list([],_,[],[]).

get_list([H|T],Max,[H|T1],Rest) :- Max>1, !, M1 is Max-1, get_list(T,M1,T1,Rest).

get_list(L,_,[],L).

get_record_field_val_name(Opts,field(Name,Value),ValS,ColName) :-
    (member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
    translate:translate:translate_bvalue(Value,ValS).

get_table_entry(Var,LA,Header,_) :- var(Var),!, LA = [VT], set_header(Header,['prj1']),
    translate:translate:translate_bvalue(Var,VT).

get_table_entry(rec(Fields),Vals,FieldNames,Opts) :-
    maplist(get_record_field_val_name(Opts),Fields,Vals,FieldNames),!.

get_table_entry(A,[AT],Header,_) :- A \= (_,_),!,
    set_header(Header,['Elements']),
    translate:translate:translate_bvalue(A,AT).

get_table_entry(A,AT,HA,Opts) :- %A=(A1,A2), (A1 = (_,_) ; A2=(_,_)),
    !,
    get_table_entry2(A,[],AT,HA,Opts).

get_table_entry2(A,Path,[AT],Header,_Opts) :- var(A),!,
    reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
    set_header(Header,[PRJRP]),
    translate:translate:translate_bvalue(A,AT).

get_table_entry2((A,B),Path,ABT,Header,Opts) :- !,
    get_table_entry2(A,[1|Path],AT,HA,Opts),
    get_table_entry2(B,[2|Path],BT,HB,Opts),
    append(AT,BT,ABT), append(HA,HB,HAB),
    % TO DO: fix issue when Header given and not same length as HAB, :table {lhs,rhs| lhs |-> rhs : delta} for PDA_to_CFG.mch
    set_header(Header,HAB).

get_table_entry2(rec([field(Name,Val)|Rest]),Path,Values,Header,Opts) :- !,
    (member(latex,Opts) -> latex_escape_atom(Name,ColName) ; ColName=Name),
    get_table_entry2(Val,[ColName,'\''|Path],AT,HA,Opts),
    (Rest=[] -> Values=AT, HAB=HA
    ; get_table_entry2(rec(Rest),Path,BT,HB,Opts),
    append(AT,BT,Values), append(HA,HB,HAB)
    ), set_header(Header,HAB).

get_table_entry2(A,Path,[AT],Header,_Opts) :- !,
    reverse(Path,RP), ajoin(['prj'|RP],PRJRP), % to do: do all this more efficiently
    set_header(Header,[PRJRP]),
    translate:translate:translate_bvalue(A,AT).

get_texpr_header_ids(b(E,Type,_),Top,IDs) :- get_expr_header_ids(E,Type,Top,IDs).

get_texpr_original_id(b(identifier(OID),_,I),ID) :- get_texpr_original_id2(OID,I,ID).

get_texpr_original_id2(OID,Infos,ID) :-
    (member(lambda_result_id_was(ID),Infos) -> true ; ID=OID).

get_texpr_original_ids(TIDs,IDs) :-
    % variation of get_texpr_original_ids, to rewrite _lambda_result_ into original form before detect_lambdas
    % relevant for test 1840
    maplist(get_texpr_original_id,TIDs,IDs).

hline(_,Opts) :- member('no-hline',Opts),!.

hline(Stream,_) :- format(Stream,'\\hline ~n',[]).

my_atom_length(AtomOrNumber,Len) :- atom(AtomOrNumber),!, atom_length(AtomOrNumber,Len).

my_atom_length(Var,Len) :- var(Var),!, Len=6. % no idea how long a variable is

my_atom_length(C,Len) :- compound(C),!, Len=6. % no idea how long a compound is

my_atom_length(A,Len) :- number(A),!,number_codes(A,List), length(List,Len).

my_atom_length(A,Len) :- atom_codes(A,List), length(List,Len).

print_entry(Stream,E,T,Opts) :- member(latex,Opts),!,
    print(Stream,' $'),print(Stream,E), (T==[] -> print(Stream,'$ ') ; print(Stream,'$ & ')).

print_entry(Stream,E,_,_) :- print(Stream,E), my_atom_length(E,Len), WS is 10-Len, print_ws(Stream,WS),!.

print_entry(Stream,E,_,_) :- add_internal_error('Failed: ',print_entry(Stream,E,_,_)),
    print(Stream,print_entry_failed(E)),nl(Stream).

print_header_terminator(Stream,Opts) :- member(latex,Opts),!,
    format('\\\\~n',[]),
    hline(Stream,Opts).

print_header_terminator(_,_).

print_row(Stream,Opts,list(Row)) :-
    print_row_aux(Row,Stream,Opts),
    print_row_terminator(Stream,Opts).

print_row_aux(V,Stream,_Opts) :- var(V),!, format(Stream,'~w ... ',[V]).

print_row_aux([],_,_) :- !.

print_row_aux([H|T],Stream,Opts) :- !, print_entry(Stream,H,T,Opts),
    print_row_aux(T,Stream,Opts).

print_row_aux(list(L),Stream,Opts) :- !, % alternative format also for Tcl/Tk
    print_row_aux(L,Stream,Opts).

print_row_aux(Other,Stream,_Opts) :- format(Stream,'~w ... ',[Other]).

print_row_terminator(Stream,Opts) :- member(latex,Opts),!, format(Stream,'\\\\~n',[]).

print_row_terminator(Stream,_) :- nl(Stream).

print_table(Header,Table) :- print_table(user_output,Header,Table,[]).

print_table(Stream,Header,Table,Opts) :-
    maplist(check_option,Opts),
    (member(argument_value('max-table-size',Sze),Opts)
    -> split_list(Table,Sze,Tables), % split into individual tables, each with own header; useful for Latex
    maplist(print_table_aux_nl(Stream,Header,Opts),Tables)
    ; print_table_aux(Stream,Header,Opts,Table)
).

print_table_aux(Stream,Header,Opts,Table) :-
    print_table_header(Stream,Header,Opts),
    (member('no-headings',Opts) -> true ;
    print_row(Stream,Opts,list(Header)),
    print_header_terminator(Stream,Opts)
    ),
    maplist(print_row(Stream,Opts),Table),
    print_table_footer(Stream,Opts).

print_table_aux_nl(Stream,Header,Opts,Table) :- print_table_aux(Stream,Header,Opts,Table),nl(Stream).

print_table_footer(Stream,Opts) :- member(latex,Opts),
    nonmember('no-tabular',Opts),
    !,
    hline(Stream,Opts),
    format(Stream,'\\end{tabular}~n',[]).

print_table_footer(_,_).

print_table_header(Stream,list(Header),Opts) :- !,
    print_table_header(Stream,Header,Opts).

print_table_header(Stream,Header,Opts) :- member(latex,Opts),
    nonmember('no-tabular',Opts),
    !,
    maplist(get_latex_col,Header,LatexColSpec),
    format(Stream,'\\begin{tabular}{~s}~n',[LatexColSpec]),
    hline(Stream,Opts).

print_table_header(_,_,_).

print_value_as_table(Expr,Value) :- print_value_as_table(user_output,Expr,Value,[]).

print_value_as_table(Stream,Expr,Value,Opts) :-
    expand_and_translate_to_table(Value,Header,Table,Opts),
    print_value_as_table2(Stream,Expr,Header,Table,Opts).

print_value_as_table2(Stream,Expr,Header,Table,Opts) :-
    get_header_from_expression(Expr,ExprHeader,Opts),
    % check if ExprHeader is valid:
    same_length(Header,ExprHeader),
    !,
    print_table(Stream,ExprHeader,Table,Opts).

print_value_as_table2(Stream,_Expr,Header,Table,Opts) :-
    print_table(Stream,Header,Table,Opts).

print_ws(Stream,X) :- X>1, !, print(Stream,' '), X1 is X-1, print_ws(Stream,X1).

print_ws(Stream,_) :- print(Stream,' ').

set_header([Header|T],[El|TE]) :- !,
    (set_header_el(Header,El) -> true ; add_warning(table_tools,'set_header failed: ',Header:El)),
    set_header(T,TE).

set_header([],TE) :- !, (TE=[] -> true ; add_warning(table_tools,'set_header extra elements: ',TE)).

set_header(Hs,[]) :- !, add_warning(table_tools,'set_header extra headers: ',Hs).

set_header_el(H,_) :- atomic(H),!. % header already set by caller

set_header_el(Header,El) :- Header=El.

single_col_type(integer).

single_col_type(boolean).

single_col_type(string).

single_col_type(global(_)).

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

split_list([],_,[]).

split_list([H|T],Maxlen,[ [H|T1] |Rest]) :- get_list(T,Maxlen,T1,RT), split_list(RT,Maxlen,Rest).

translate_to_table(A,RowNr,[list(L)],Header,Opts) :- var(A),!,
    (member('no-row-numbers',Opts) -> set_header(Header,['Value']),L=AT
    ; set_header(Header,['Nr','Value']),L=[RowNr|AT]),
    translate:translate:translate_bvalue(A,AT).

translate_to_table([],_RowNr,[],Header,Opts) :- !,
    (ground(Header) -> true % we already have a header
    ; member('no-row-numbers',Opts) -> set_header(Header,['Elements']) ; set_header(Header,['Nr','Elements'])).

translate_to_table([A|T],RowNr,[list(LA)|TT],Header,Opts) :- member('no-row-numbers',Opts),
    !,
    get_table_entry(A,LA,Header,Opts),
    R1 is RowNr+1,
    translate_to_table(T,R1,TT,_,Opts).

translate_to_table([A|T],RowNr,[list([RowNr|LA])|TT],['Nr'|Header],Opts) :- !,
    get_table_entry(A,LA,Header,Opts),
    R1 is RowNr+1,
    translate_to_table(T,R1,TT,_,Opts).

translate_to_table(A,_RowNr,[list(AT)],['Value'],Opts) :- member('no-row-numbers',Opts),!,
    translate:translate:translate_bvalue(A,AT).

translate_to_table(A,RowNr,[list([RowNr|AT])],Header,_) :- !,
    set_header(Header,['Nr','Value']),
    translate:translate:translate_bvalue(A,AT).

translate_to_table(ExpVal,Row,Table,Header,Opts) :-
    add_internal_error('Failed:',translate_to_table(ExpVal,Row,Table,Header,Opts)),fail.

valid_option(latex).

valid_option('no-tabular').

valid_option('no-hline').

valid_option('no-headings').

valid_option('no-row-numbers').

valid_option(argument_value('max-table-size',_)).