tools_printing

abstract_top_level(X,R) :- \+ compound(X),!,R=X.

abstract_top_level(X,AX) :- functor(X,F,N), functor(AX,F,N).

decompose_compound(Module:Compound,Functor,Args) :- nonvar(Compound), !,
    Compound =.. [F|Args], Functor = Module:F.

decompose_compound(Compound,F,Args) :- Compound =.. [F|Args].

format_error(Str,Args) :- format_with_colour(user_error,[red,bold],Str,Args).

format_error_with_nl(Str,Args) :- format_with_colour_nl(user_error,[red,bold],Str,Args).

format_with_colour(Stream,Colour,Str,Args) :-
    stream_is_interactive(Stream),!,
    start_terminal_colour(Colour,Stream),
    call_cleanup(format(Stream,Str,Args),
    reset_terminal_colour(Stream)).

format_with_colour(Stream,_Colour,Str,Args) :- format(Stream,Str,Args).

format_with_colour_nl(Stream,Colour,Str,Args) :-
    format_with_colour(Stream,Colour,Str,Args),
    nl(Stream). % followed by a newline *after* resetting the colours; important for SICStus prompt

get_list_up_to([],_,[],all).

get_list_up_to([H|T],N,R,ALL) :-
    (N<1 -> R=[],ALL=no ; N1 is N-1, R=[H|TR], get_list_up_to(T,N1,TR,ALL)).

get_terminal_colour_code(black,'\e[30m').

get_terminal_colour_code(red,'\e[31m').

get_terminal_colour_code(green,'\e[32m').

get_terminal_colour_code(yellow,'\e[33m').

get_terminal_colour_code(blue,'\e[34m').

get_terminal_colour_code(magenta,'\e[35m').

get_terminal_colour_code(cyan,'\e[36m').

get_terminal_colour_code(light_gray,'\e[37m').

get_terminal_colour_code(reset,'\e[0m').

get_terminal_colour_code(light_red,'\e[91m').

get_terminal_colour_code(light_green,'\e[92m').

get_terminal_colour_code(light_yellow,'\e[93m').

get_terminal_colour_code(light_blue,'\e[94m').

get_terminal_colour_code(light_magenta,'\e[95m').

get_terminal_colour_code(light_cyan,'\e[96m').

get_terminal_colour_code(white,'\e[97m').

indent(0) :- !.

indent(X) :- X>800, !, write('*800*-'), X1 is X-800, indent(X1).

indent(X) :- X>80, !, write('*80*-'), X1 is X-80, indent(X1).

indent(X) :- X>0, write('+-'), X1 is X-1, indent(X1).

indent(0) --> !, "".

indent(L) --> {L>0, L1 is L-1}, " ", indent(L1).

indentws(0) :- !.

indentws(X) :- X>0, write(' '), X1 is X-1, indentws(X1).

intelligent_get_stream(user_output,S) :- !, current_output(S).

intelligent_get_stream(user_intput,S) :- !, current_input(S).

intelligent_get_stream(user_error,S) :- !, prolog_flag(user_error,S).

intelligent_get_stream(S,S).

l_nested_write([],_) --> "".

l_nested_write([H],Level) --> !,
    nested_write(H,Level), "\n".

l_nested_write([H|T],Level) -->
    nested_write(H,Level), ",\n",
    l_nested_write(T,Level).

l_print_arg(V) :- var(V),!, write('...').

l_print_arg([]).

l_print_arg([H|T]) :- write(': '), print_arg(H), l_print_arg(T).

l_print_nested_arg(V) :- var(V),!, write('...').

l_print_nested_arg([]).

l_print_nested_arg([H|T]) :- write(': '), print_nested_arg(H), l_print_nested_arg(T).

l_trace_print([],L,_MaxLvl) :- indent(L), print(')'),nl.

l_trace_print([A|TA],Lvl,MaxLvl) :- L1 is Lvl+1, trace_print(A,L1,MaxLvl),
    l_trace_print(TA,Lvl,MaxLvl).

l_trace_unify([],[],L) :- indent(L), write(')'),nl.

l_trace_unify([A|TA],[B|TB],Lvl) :- L1 is Lvl+1, trace_unify_aux(A,B,L1),
    l_trace_unify(TA,TB,Lvl).

list_skeleton_size(X,Sz,Type) :- var(X),!,Sz=0,Type=open.

list_skeleton_size([],0,closed).

list_skeleton_size([_|T],N,Type) :- list_skeleton_size(T,NT,Type), N is NT+1.

nested_print_term(Term) :- nested_print_term(Term,10).

nested_print_term(Term,MaxNest) :- nested_print_term(0,MaxNest,Term).

nested_print_term(CurNesting,_Max,T) :- var(T),!, indent(CurNesting),write(T),nl.

nested_print_term(CurNesting,_,T) :- atom(T), !, atom_length(T,Len),
    indent(CurNesting),
    (Len > 100
    -> atom_codes(T,Codes), length(Prefix,50), append(Prefix,_,Codes),
    format('atom: len(~w): ~s...~n',[Len,Prefix])
    ; format('~w~n',[T])).

nested_print_term(CurNesting,_,T) :- number(T),!, indent(CurNesting), format('~w~n',[T]).

nested_print_term(CurNesting,MaxNesting,T) :- CurNesting >= MaxNesting,!,
    term_size(T,Sz), functor(T,F,N),
    indentws(CurNesting),
    (Sz>25000 -> Msg='****' ; Msg=''), format('~w/~w :: sz(~w)~w~n',[F,N,Sz,Msg]).

nested_print_term(CurNesting,MaxNesting,T) :-
    list_skeleton_size(T,Len,closed), term_size(T,Sz),!,
    indentws(CurNesting),format('[ list_len_sz(~w,~w)~n',[Len,Sz]),
    C1 is CurNesting+1,
    maplist(nested_print_term(C1,MaxNesting),T),
    indentws(CurNesting),format('] list_len(~w)~n',[Len]).

nested_print_term(CurNesting,MaxNesting,T) :-
    term_size(T,Sz), functor(T,F,N),
    indentws(CurNesting),format('~w/~w( sz(~w)~n',[F,N,Sz]),
    T =.. [_|Args], C1 is CurNesting+1,
    maplist(nested_print_term(C1,MaxNesting),Args),
    indentws(CurNesting),format('~w/~w)~n',[F,N]).

nested_read_terms(Stream) --> {safe_read_stream(Stream,Term)},
    ({Term=end_of_file} -> "\n"
    ; nested_write(Term,0), ".\n",
    nested_read_terms(Stream)
).

nested_write(Atom,Level) --> {simple(Atom)},!, indent(Level), format_to_codes('~q',[Atom]).

nested_write(Term,Level) --> {Level>40},!, indent(Level), format_to_codes('~q',[Term]).

nested_write([H|T],Level) --> !,
    indent(Level), "[\n",
    {L1 is Level+1},
    l_nested_write([H|T],L1),
    indent(Level), "]".

nested_write(Compound,Level) --> {decompose_compound(Compound,F,Args)},
    indent(Level),
    ({maplist(simple,Args)}
    -> format_to_codes('~q',[Compound])
    ; write_to_codes(F), "(\n",
    {L1 is Level+1},
    l_nested_write(Args,L1),
    indent(Level), ")"
).

nested_write_term_to_codes(Term,Codes) :-
    nested_write(Term,0,Codes,[]).

no_col_env :- environ('NO_COLOR',_),!. % see http://no-color.org

no_col_env :- environ('NOCOLOR',_),!.

no_col_env :- environ('CLICOLOR',V), (V=0 ; V='NO' ; V='FALSE'),!.

no_col_env :- environ('TERM',dumb).

no_color :- colours_disabled.

print_arg(N) :- var(N),!,print_var(N).

print_arg(int(N)) :- !, (var(N) -> print_var_integer(N) ; write(int(N))).

print_arg(term(F)) :- nonvar(F), F=floating(N),!, (var(N) -> write(F) ; write(N)).

print_arg(float(N)) :- !, write(float(N)).

print_arg(freeval(ID,Case,Value)) :- !, format('freeval ~w.~w : ',[ID,Case]), print_arg(Value).

print_arg(fd(N,GS)) :- !,
    (number(N),b_global_sets:is_b_global_constant(GS,N,Res) -> write(Res)
    ; write('fd('),print_integer(N),format(',~w)',GS)).

print_arg(rec(Fields)) :- !, write('rec('), print_arg(Fields),write(')').

print_arg(bind(Var,Val)) :- atomic(Var), !, write(Var),write('/'),print_arg(Val).

print_arg(field(Var,Val)) :- atomic(Var), !, write('field('),write(Var),write('/'),print_arg(Val),write(')').

print_arg(typedvalc(Val,Type,VarID,EnumWarningInfos,Card)) :-
    atomic(VarID), !, format('typedvalc for ~w :(',[VarID]),print_arg(Val),
    format(',~w,~w,~w) ',[Type,EnumWarningInfos,Card]).

print_arg(wfx(WF0,_Store,WFE,_Infos)) :- !, write(wfx(WF0,'...',WFE,'...')). % do not print store and Infos: TODO we could show call_stack summary

print_arg(Module:Call) :- atomic(Module),!,
    write(Module), write(':'),print_arg(Call).

print_arg(A) :- atomic(A),!, write(A).

print_arg(A) :- A=node(_,_,_,_,_),ground(A), !, write('AVLnode.size='),avl_size(A,Sz), write(Sz).

print_arg(avl_set(A)) :- ground(A), !,
    (custom_explicit_sets:singleton_set(avl_set(A),El) -> write('AVL{'),print_arg(El),write('}')
    ; avl_size(A,Sz),
    (Sz>3 -> write('AVL.size='),write(Sz)
    ; custom_explicit_sets:expand_custom_set_to_list(avl_set(A),ESet,_,print_arg),
    write('AVL{'), l_print_nested_arg(ESet), write('}')
)
).

print_arg((A,B)) :- !, write('('),print_arg(A), write(','), print_arg(B), write(')').

print_arg(string(A)) :- !, write('string('),print_arg(A), write(')').

print_arg([]) :- !, write('[]').

print_arg([H|T]) :- T==[], !, write('['),print_arg(H),write(']').

print_arg([H|T]) :- nonvar(T),T=[H2|T2],T2==[], !,
    write('['),print_arg(H),write(','),print_arg(H2),write(']').

print_arg([H|T]) :- nonvar(H), H=bind(_,_),!, get_list_up_to([H|T],10,S,ALL),
    translate:print_bstate(S),
    (ALL=all -> true ; write(', ... ')).

print_arg([H|T]) :- list_skeleton_size([H|T],Sz,Type), !,
    write(Type),
    (Type=closed,ground([H|T]) -> write('&ground') ; true),
    write(' LIST.size='), write(Sz),
    (Sz<35 -> write(' ['), l_print_nested_arg([H|T]), write(']') ; true).

print_arg(closure(P,T,B)) :- !,
    (custom_explicit_sets:is_interval_closure(P,T,B,Low,Up)
    -> write('SYMBOLIC-INTERVAL ['),
    print_integer_with_var(Low), write('..'),
    print_integer_with_var(Up), write(']')
    ; B=b(_,_,INFO),
    findall(Ann,member(prob_annotation(Ann),INFO),Anns),
    (closures:is_symbolic_closure(P,T,B) -> INF='ANNOTATED-'
    ; custom_explicit_sets:is_infinite_or_very_large_closure(P,T,B,200000) -> INF='INF_OR_LARGE-'
    ; INF=''),
    format('SYMBOLIC-~wSET(~w) ~w ',[INF,Anns,P])
). %, write(' | '), write(_B).

print_arg(mnf(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')').

print_arg(pp_mnf(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')').

print_arg(pp_cll(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')').

print_arg(b(Expr,T,I)) :- !,
    (T==pred -> write('PRED(') ; write('BEXPR(')),
    print_functor(Expr), write(','),
    translate:print_bexpr_with_limit(b(Expr,T,I),200),
    (error_manager:extract_line_col(b(Expr,T,I),Srow,Scol,_,_) -> format(', lne:col=~w:~w)',[Srow,Scol])
    ; write(')')).

print_arg(span_predicate(A,B,C)) :-
    error_manager:extract_line_col(span_predicate(A,B,C),Srow,Scol,Erow,Ecol), !,
    format('span_predicate(~w:~w-~w:~w)',[Srow,Scol,Erow,Ecol]).

print_arg(N) :- print_functor(N).

print_data(Data,N,Pos) :- write(N), write(' @ '), write(Pos),write(' : '), write(Data),nl.

print_dynamic_fact(Stream,Fact) :-
    functor(Fact,Pred,N),
    format(Stream,':- dynamic ~w/~w.~n',[Pred,N]),
    write_term(Stream,Fact,[quoted(true)]),write(Stream,'.'),nl(Stream).

print_dynamic_pred(InModule,Pred,N) :- print_dynamic_pred(user_output,InModule,Pred,N).

print_dynamic_pred(Stream,InModule,Pred,N) :- nl(Stream),
    format(Stream,':- dynamic ~w/~w.~n',[Pred,N]),
    functor(Call,Pred,N),
    call(InModule:Call),
    write_term(Stream,Call,[quoted(true)]),write(Stream,'.'),nl(Stream),fail.

print_dynamic_pred(Stream,InModule,Pred,N) :-
    functor(Call,Pred,N),
    (call(InModule:Call) -> true
    ; write_with_numbervars(Stream,Call), write(Stream,' :- fail.'),nl(Stream)),
    nl(Stream).

print_error(Error) :-
    stream_is_interactive(user_error),!,
    start_terminal_colour([red,bold],user_error),
    call_cleanup(print_no_col(user_error,Error),reset_terminal_colour_and_nl(user_error)).

print_error(Error) :- print_no_col(user_error,Error), nl(user_error).

print_frozen_var_info(V) :- frozen(V,G), (print_frozen_var_info2(G,V) -> true ; true).

print_frozen_var_info2((A,B),V) :- !,(print_frozen_var_info2(A,V) -> true ; print_frozen_var_info2(B,V) -> true).

print_frozen_var_info2(true,_) :- !,fail.

print_frozen_var_info2(b_interpreter_check:imply_true(_,_,_),_) :- write(' : BOOL').

print_frozen_var_info2(bool_pred:blocking_force_eq(V,_,_),Var) :- Var==V, write(' : BOOL').

print_frozen_var_info2(kernel_equality:eq_empty_set(V,_),Var) :- Var==V, write(' : SET').

print_frozen_var_info2(kernel_equality:eq_empty_set_wf(V,_,_),Var) :- Var==V, write(' : SET').

print_frozen_var_info2(_:non_free(V),Var) :- Var==V, write(' : NON-FREE'). % kernel_objects

print_frozen_var_info2(_:ground_value_check(V,_),Var) :- Var==V, write(' : GRVAL-CHECK').

print_frozen_var_info2(_:Call,_Var) :- functor(Call,Functor,Arity),format(' : ~w/~w',[Functor,Arity]).

print_frozen_var_info2(Call,_Var) :- functor(Call,Functor,Arity),format(' : ~w/~w',[Functor,Arity]).

print_functor(N) :- var(N),!,write('VARIABLE: '),write(N).

print_functor(N) :- functor(N,F,Arity), write(F), write('/'),write(Arity).

print_goal(V) :- var(V),!, format(' ~p~n',[V]).

print_goal([A|B]) :- !,print_goal(A), print_goal(B).

print_goal((A,B)) :- !,print_goal(A), print_goal(B).

print_goal(Module:(A,B)) :- !, format(' ~p:~n',[Module]), print_goal((A,B)).

print_goal(A) :- format(' ~p~n',[A]).

print_green(Term) :- no_color,!,
    format('~w',[Term]).

print_green(Term) :-
    format('\e[32m~w\e[0m',[Term]).

print_integer(I) :- (var(I) -> fd_dom(I,Dom), write('?:'),write(Dom) ; write(I)).

print_integer_with_var(I) :- (var(I) -> print_var(I) ; write(I)).

print_message_on_stream(Stream,Color,Message) :-
    stream_is_interactive(Stream),!,
    start_terminal_colour(Color,Stream),
    call_cleanup(print_no_col(Stream,Message),reset_terminal_colour_and_nl(Stream)).

print_message_on_stream(Stream,_Color,Message) :-
    print_no_col(Stream,Message),
    nl(Stream).

print_nested_arg(N) :- var(N),!,print_var(N).

print_nested_arg([H|T]) :- list_skeleton_size([H|T],Sz,Type), !,
    write(Type),
    (Type=closed,ground([H|T]) -> write('&ground') ; true), write(' LIST.size='), write(Sz).

print_nested_arg(avl_set(A)) :- ground(A), avl_size(A,Sz),!, write('AVL.size='),write(Sz).

print_nested_arg(A) :- print_arg(A).

print_no_col(Stream,ErrorTerm) :-
    write(Stream,'! '),
    (var(ErrorTerm) -> write(Stream,'_')
    ; write_term(Stream,ErrorTerm,[max_depth(20),numbervars(true)])).

print_red(Term) :- no_color,!,
    format('~w',[Term]).

print_red(Term) :-
    format('\e[31m~w\e[0m',[Term]).

print_red(Stream,Term) :- no_color,!,
    format(Stream,'~w',[Term]).

print_red(Stream,Term) :-
    format(Stream,'\e[31m~w\e[0m',[Term]).

print_term_summary(T) :- print_term_summary_wo_nl(T),
    %term_size(T,Sz), format(' term_size: ~w',[Sz]),
    nl.

print_term_summary_hash(T) :- print_term_summary(T),
    term_hash(T,H), %% (H=179896960 -> trace ; true),
    format('Hash = ~w~n',H).

print_term_summary_wo_nl(N) :- var(N),!,write('VARIABLE: '),write(N).

print_term_summary_wo_nl((A,B)) :- write('('), print_term_summary_wo_nl(A),
    write(','), print_term_summary_wo_nl(B),write(')').

print_term_summary_wo_nl(clpfd:Call) :- !, write(clpfd:Call).

print_term_summary_wo_nl(Module:Call) :- !,
    write(Module), write(':'),print_term_summary_wo_nl(Call).

print_term_summary_wo_nl(bind(Var,Val)) :- !,print_arg(bind(Var,Val)).

print_term_summary_wo_nl(N) :- functor(N,F,Arity), write(F), write('/'),write(Arity),
    N=..[F|Args], l_print_arg(Args).

print_time_stamp(Stream) :-
    datime(datime(Year,Month,Day,Hour,Min,Sec)),
    (Min<10
    -> format(Stream,'~w/~w/~w - ~wh0~w ~ws',[Day,Month,Year,Hour,Min,Sec])
    ; format(Stream,'~w/~w/~w - ~wh~w ~ws',[Day,Month,Year,Hour,Min,Sec])
).

print_value_summary(BValue) :- print_arg(BValue),nl.