| 1 | | % (c) 2009-2025 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(tools_printing,[ |
| 6 | | print_term_summary/1, print_term_summary_hash/1, |
| 7 | | print_term_summary_wo_nl/1, |
| 8 | | print_value_summary/1, |
| 9 | | print_functor/1, |
| 10 | | print_var/1, print_vars/1, |
| 11 | | watch/3, |
| 12 | | trace_unify/2, trace_print/1, trace_print/2, |
| 13 | | print_error/1, |
| 14 | | print_message_on_stream/3, |
| 15 | | format_error/2, format_error_with_nl/2, |
| 16 | | no_color/0, |
| 17 | | set_no_color/1, reset_no_color_to_default/0, |
| 18 | | print_red/2, print_red/1, print_green/1, |
| 19 | | format_with_colour/4, format_with_colour_nl/4, |
| 20 | | start_terminal_colour/2, |
| 21 | | reset_terminal_colour/1, |
| 22 | | get_terminal_colour_code/2, |
| 23 | | print_time_stamp/1, |
| 24 | | print_dynamic_pred/3, print_dynamic_pred/4, |
| 25 | | print_dynamic_fact/2, |
| 26 | | print_goal/1, |
| 27 | | nested_print_term/2, nested_print_term/1, |
| 28 | | nested_write_term_to_codes/2, |
| 29 | | tcltk_nested_read_prolog_file_as_codes/2, |
| 30 | | write_canonical_to_codes/2,write_canonical_to_codes/3, |
| 31 | | better_write_canonical_to_codes/2,better_write_canonical_to_codes/3 |
| 32 | | ]). |
| 33 | | |
| 34 | | |
| 35 | | :- use_module(module_information). |
| 36 | | :- module_info(group,infrastructure). |
| 37 | | :- module_info(description,'This module contains printing/debug helper predicates.'). |
| 38 | | |
| 39 | | |
| 40 | | :- use_module(library(terms),[term_hash/2]). |
| 41 | | print_term_summary_hash(T) :- print_term_summary(T), |
| 42 | | term_hash(T,H), %% (H=179896960 -> trace ; true), %% |
| 43 | | format('Hash = ~w~n',H). |
| 44 | | |
| 45 | | %:- use_module(library(terms),[term_size/2]). |
| 46 | | print_term_summary(T) :- print_term_summary_wo_nl(T), |
| 47 | | %term_size(T,Sz), format(' term_size: ~w',[Sz]), |
| 48 | | nl. |
| 49 | | |
| 50 | | % a special version for user friendly B Value information |
| 51 | | print_value_summary(BValue) :- print_arg(BValue),nl. |
| 52 | | |
| 53 | | print_term_summary_wo_nl(N) :- var(N),!,write('VARIABLE: '),write(N). |
| 54 | | print_term_summary_wo_nl((A,B)) :- write('('), print_term_summary_wo_nl(A), |
| 55 | | write(','), print_term_summary_wo_nl(B),write(')'). |
| 56 | | print_term_summary_wo_nl(clpfd:Call) :- !, write(clpfd:Call). |
| 57 | | print_term_summary_wo_nl(Module:Call) :- !, |
| 58 | | write(Module), write(':'),print_term_summary_wo_nl(Call). |
| 59 | | print_term_summary_wo_nl(bind(Var,Val)) :- !,print_arg(bind(Var,Val)). |
| 60 | | print_term_summary_wo_nl(N) :- functor(N,F,Arity), write(F), write('/'),write(Arity), |
| 61 | | N=..[F|Args], l_print_arg(Args). |
| 62 | | |
| 63 | | l_print_arg(V) :- var(V),!, write('...'). |
| 64 | | l_print_arg([]). |
| 65 | | l_print_arg([H|T]) :- write(': '), print_arg(H), l_print_arg(T). |
| 66 | | |
| 67 | | % print nested args: avoid nesting any further to avoid blowup |
| 68 | | l_print_nested_arg(V) :- var(V),!, write('...'). |
| 69 | | l_print_nested_arg([]). |
| 70 | | l_print_nested_arg([H|T]) :- write(': '), print_nested_arg(H), l_print_nested_arg(T). |
| 71 | | |
| 72 | | print_nested_arg(N) :- var(N),!,print_var(N). |
| 73 | | print_nested_arg([H|T]) :- list_skeleton_size([H|T],Sz,Type), !, |
| 74 | | write(Type), |
| 75 | | (Type=closed,ground([H|T]) -> write('&ground') ; true), write(' LIST.size='), write(Sz). |
| 76 | | print_nested_arg(avl_set(A)) :- ground(A), avl_size(A,Sz),!, write('AVL.size='),write(Sz). |
| 77 | | print_nested_arg(A) :- print_arg(A). |
| 78 | | |
| 79 | | :- use_module(library(avl)). |
| 80 | | % USE MODULE NOT PERFORMED TO AVOID LOADING translate and all dependent modules |
| 81 | | %:- use_module(translate,[print_bexpr_with_limit/2, print_bstate/1]). |
| 82 | | |
| 83 | | print_arg(N) :- var(N),!,print_var(N). |
| 84 | | print_arg(int(N)) :- !, (var(N) -> print_var_integer(N) ; write(int(N))). |
| 85 | | print_arg(term(F)) :- nonvar(F), F=floating(N),!, (var(N) -> write(F) ; write(N)). |
| 86 | | print_arg(float(N)) :- !, write(float(N)). |
| 87 | | print_arg(freeval(ID,Case,Value)) :- !, format('freeval ~w.~w : ',[ID,Case]), print_arg(Value). |
| 88 | | print_arg(fd(N,GS)) :- !, |
| 89 | | (number(N),b_global_sets:is_b_global_constant(GS,N,Res) -> write(Res) |
| 90 | | ; write('fd('),print_integer(N),format(',~w)',GS)). |
| 91 | | print_arg(rec(Fields)) :- !, write('rec('), print_arg(Fields),write(')'). |
| 92 | | print_arg(bind(Var,Val)) :- atomic(Var), !, write(Var),write('/'),print_arg(Val). |
| 93 | | print_arg(field(Var,Val)) :- atomic(Var), !, write('field('),write(Var),write('/'),print_arg(Val),write(')'). |
| 94 | | print_arg(typedvalc(Val,Type,VarID,EnumWarningInfos,Card)) :- |
| 95 | | atomic(VarID), !, format('typedvalc for ~w :(',[VarID]),print_arg(Val), |
| 96 | | format(',~w,~w,~w) ',[Type,EnumWarningInfos,Card]). |
| 97 | | print_arg(wfx(WF0,_Store,WFE,_Infos)) :- !, write(wfx(WF0,'...',WFE,'...')). % do not print store and Infos: TODO we could show call_stack summary |
| 98 | | print_arg(Module:Call) :- atomic(Module),!, |
| 99 | | write(Module), write(':'),print_arg(Call). |
| 100 | | print_arg(A) :- atomic(A),!, write(A). |
| 101 | | print_arg(A) :- A=node(_,_,_,_,_),ground(A), !, write('AVLnode.size='),avl_size(A,Sz), write(Sz). |
| 102 | | print_arg(avl_set(A)) :- ground(A), !, |
| 103 | | (custom_explicit_sets:singleton_set(avl_set(A),El) -> write('AVL{'),print_arg(El),write('}') |
| 104 | | ; avl_size(A,Sz), |
| 105 | | (Sz>3 -> write('AVL.size='),write(Sz) |
| 106 | | ; custom_explicit_sets:expand_custom_set_to_list(avl_set(A),ESet,_,print_arg), |
| 107 | | write('AVL{'), l_print_nested_arg(ESet), write('}') |
| 108 | | ) |
| 109 | | ). |
| 110 | | print_arg((A,B)) :- !, write('('),print_arg(A), write(','), print_arg(B), write(')'). |
| 111 | | print_arg(string(A)) :- !, write('string('),print_arg(A), write(')'). |
| 112 | | print_arg([]) :- !, write('[]'). |
| 113 | | print_arg([H|T]) :- T==[], !, write('['),print_arg(H),write(']'). |
| 114 | | print_arg([H|T]) :- nonvar(T),T=[H2|T2],T2==[], !, |
| 115 | | write('['),print_arg(H),write(','),print_arg(H2),write(']'). |
| 116 | | print_arg([H|T]) :- nonvar(H), H=bind(_,_),!, get_list_up_to([H|T],10,S,ALL), |
| 117 | | translate:print_bstate(S), |
| 118 | | (ALL=all -> true ; write(', ... ')). |
| 119 | | print_arg([H|T]) :- list_skeleton_size([H|T],Sz,Type), !, |
| 120 | | write(Type), |
| 121 | | (Type=closed,ground([H|T]) -> write('&ground') ; true), |
| 122 | | write(' LIST.size='), write(Sz), |
| 123 | | (Sz<35 -> write(' ['), l_print_nested_arg([H|T]), write(']') ; true). |
| 124 | | print_arg(closure(P,T,B)) :- !, |
| 125 | | (custom_explicit_sets:is_interval_closure(P,T,B,Low,Up) |
| 126 | | -> write('SYMBOLIC-INTERVAL ['), |
| 127 | | print_integer_with_var(Low), write('..'), |
| 128 | | print_integer_with_var(Up), write(']') |
| 129 | | ; B=b(_,_,INFO), |
| 130 | | findall(Ann,member(prob_annotation(Ann),INFO),Anns), |
| 131 | | (closures:is_symbolic_closure(P,T,B) -> INF='ANNOTATED-' |
| 132 | | ; custom_explicit_sets:is_infinite_or_very_large_closure(P,T,B,200000) -> INF='INF_OR_LARGE-' |
| 133 | | ; INF=''), |
| 134 | | format('SYMBOLIC-~wSET(~w) ~w ',[INF,Anns,P]) |
| 135 | | %terms:term_size(B,BSz), format('SYMBOLIC-~wSET(sz:~w,~w) ~w ',[INF,BSz,Anns,P]) |
| 136 | | ). %, write(' | '), write(_B). |
| 137 | | print_arg(mnf(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')'). |
| 138 | | print_arg(pp_mnf(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')'). |
| 139 | | print_arg(pp_cll(Call)) :- !, write('mnf('),print_term_summary_wo_nl(Call), write(')'). |
| 140 | | print_arg(b(Expr,T,I)) :- !, |
| 141 | | (T==pred -> write('PRED(') ; write('BEXPR(')), |
| 142 | | print_functor(Expr), write(','), |
| 143 | | translate:print_bexpr_with_limit(b(Expr,T,I),200), |
| 144 | | (error_manager:extract_line_col(b(Expr,T,I),Srow,Scol,_,_) -> format(', lne:col=~w:~w)',[Srow,Scol]) |
| 145 | | ; write(')')). |
| 146 | | print_arg(span_predicate(A,B,C)) :- |
| 147 | | error_manager:extract_line_col(span_predicate(A,B,C),Srow,Scol,Erow,Ecol), !, |
| 148 | | format('span_predicate(~w:~w-~w:~w)',[Srow,Scol,Erow,Ecol]). |
| 149 | | print_arg(N) :- print_functor(N). |
| 150 | | |
| 151 | | :- use_module(library(clpfd),[fd_dom/2, fd_degree/2, fd_size/2]). |
| 152 | | print_var(V) :- fd_dom(V,D), D \= inf..sup, fd_size(V,Sz), fd_degree(V,Dg),!, |
| 153 | | format('INT VAR: ~w:~w [sz:~w,dg:~w] ',[V,D,Sz,Dg]). |
| 154 | | %write(':('),frozen(V,Goal),write_term(Goal,[max_depth(3)]),write(')'). |
| 155 | | print_var(V) :- write('VARIABLE: '),write(V), print_frozen_var_info(V). |
| 156 | | print_var_integer(X) :- write('int(?:'),fd_dom(X,Dom),write(Dom), |
| 157 | | %write(':('),frozen(X,Goal),write(Goal),write(')') |
| 158 | | write(')'). |
| 159 | | |
| 160 | | % try determine variable type from frozen info |
| 161 | | print_frozen_var_info(V) :- frozen(V,G), (print_frozen_var_info2(G,V) -> true ; true). |
| 162 | ? | print_frozen_var_info2((A,B),V) :- !,(print_frozen_var_info2(A,V) -> true ; print_frozen_var_info2(B,V) -> true). |
| 163 | | print_frozen_var_info2(true,_) :- !,fail. |
| 164 | | print_frozen_var_info2(b_interpreter_check:imply_true(_,_,_),_) :- write(' : BOOL'). |
| 165 | | print_frozen_var_info2(bool_pred:blocking_force_eq(V,_,_),Var) :- Var==V, write(' : BOOL'). |
| 166 | | print_frozen_var_info2(kernel_equality:eq_empty_set(V,_),Var) :- Var==V, write(' : SET'). |
| 167 | | print_frozen_var_info2(kernel_equality:eq_empty_set_wf(V,_,_),Var) :- Var==V, write(' : SET'). |
| 168 | | print_frozen_var_info2(_:non_free(V),Var) :- Var==V, write(' : NON-FREE'). % kernel_objects |
| 169 | | print_frozen_var_info2(_:ground_value_check(V,_),Var) :- Var==V, write(' : GRVAL-CHECK'). |
| 170 | | print_frozen_var_info2(_:Call,_Var) :- functor(Call,Functor,Arity),format(' : ~w/~w',[Functor,Arity]). |
| 171 | | print_frozen_var_info2(Call,_Var) :- functor(Call,Functor,Arity),format(' : ~w/~w',[Functor,Arity]). |
| 172 | | % TO DO: add other co-routines for boolean values,... |
| 173 | | |
| 174 | | :- use_module(library(lists),[maplist/2]). |
| 175 | | print_vars(V) :- maplist(tools_printing:print_var,V),nl. |
| 176 | | |
| 177 | | print_integer(I) :- (var(I) -> fd_dom(I,Dom), write('?:'),write(Dom) ; write(I)). |
| 178 | | print_integer_with_var(I) :- (var(I) -> print_var(I) ; write(I)). |
| 179 | | |
| 180 | | get_list_up_to([],_,[],all). |
| 181 | | get_list_up_to([H|T],N,R,ALL) :- |
| 182 | | (N<1 -> R=[],ALL=no ; N1 is N-1, R=[H|TR], get_list_up_to(T,N1,TR,ALL)). |
| 183 | | |
| 184 | | list_skeleton_size(X,Sz,Type) :- var(X),!,Sz=0,Type=open. |
| 185 | | list_skeleton_size([],0,closed). |
| 186 | | list_skeleton_size([_|T],N,Type) :- list_skeleton_size(T,NT,Type), N is NT+1. |
| 187 | | |
| 188 | | |
| 189 | | print_functor(N) :- var(N),!,write('VARIABLE: '),write(N). |
| 190 | | print_functor(N) :- functor(N,F,Arity), write(F), write('/'),write(Arity). |
| 191 | | |
| 192 | | % --------------- |
| 193 | | |
| 194 | | :- block watch(-,?,?). |
| 195 | | watch([],N,Pos) :- !,print_data([],N,Pos). |
| 196 | | watch([H|T],N,Pos) :- !,print_data(H,N,Pos), P1 is Pos+1, watch(H,N,Pos), watch(T,N,P1). |
| 197 | | watch((P1,P2),N,Pos) :- print_data((P1,P2),N,Pos), watch(P2,N,Pos). |
| 198 | | watch(Other,N,Pos) :- print_data(Other,N,Pos). |
| 199 | | print_data(Data,N,Pos) :- write(N), write(' @ '), write(Pos),write(' : '), write(Data),nl. |
| 200 | | |
| 201 | | % --------------- |
| 202 | | |
| 203 | | :- use_module(library(lists),[maplist/3]). |
| 204 | | trace_unify(A,B) :- trace_unify_aux(A,B,0). |
| 205 | | trace_unify_aux(A,B,Lvl) :- (var(A);var(B)),!,indent(Lvl),write(A),write(' <-> '), write(B), |
| 206 | | if(A=B,true,(write(' FAILS'),nl,fail)),nl. |
| 207 | | trace_unify_aux(A,B,Lvl) :- functor(A,FA,FAN), functor(B,FB,FBN), |
| 208 | | indent(Lvl),write(FA/FAN), |
| 209 | | A=..[_|As], B=..[_|Bs], |
| 210 | | ((FA,FAN)=(FB,FBN) |
| 211 | | -> (As=[] -> nl ; write('('),nl,l_trace_unify(As,Bs,Lvl)) |
| 212 | | ; format(' FUNCTOR MISMATCH : ~w/~w <-> ~w/~w~n',[FA,FAN,FB,FBN]), |
| 213 | | maplist(abstract_top_level,As,AAs), AA =..[FA|AAs], |
| 214 | | maplist(abstract_top_level,Bs,ABs), AB =..[FB|ABs], |
| 215 | | indent(Lvl), |
| 216 | | format(' TOP: ~w <-> ~w~n',[AA,AB]), |
| 217 | | fail |
| 218 | | ). |
| 219 | | indent(0) :- !. |
| 220 | | indent(X) :- X>800, !, write('*800*-'), X1 is X-800, indent(X1). |
| 221 | | indent(X) :- X>80, !, write('*80*-'), X1 is X-80, indent(X1). |
| 222 | | indent(X) :- X>0, write('+-'), X1 is X-1, indent(X1). |
| 223 | | |
| 224 | | abstract_top_level(X,R) :- \+ compound(X),!,R=X. |
| 225 | | abstract_top_level(X,AX) :- functor(X,F,N), functor(AX,F,N). |
| 226 | | |
| 227 | | |
| 228 | | l_trace_unify([],[],L) :- indent(L), write(')'),nl. |
| 229 | | l_trace_unify([A|TA],[B|TB],Lvl) :- L1 is Lvl+1, trace_unify_aux(A,B,L1), |
| 230 | | l_trace_unify(TA,TB,Lvl). |
| 231 | | |
| 232 | | % --------------- |
| 233 | | |
| 234 | | trace_print(A) :- trace_print(A,0,4). |
| 235 | | trace_print(A,Max) :- trace_print(A,0,Max). |
| 236 | | |
| 237 | | trace_print(A,Lvl,MaxLvl) :- Lvl >= MaxLvl,!, indent(Lvl), print(A),nl. |
| 238 | | trace_print(A,Lvl,_MaxLvl) :- treat_as_atomic(A),!, indent(Lvl), print(A),nl. |
| 239 | | trace_print([H|T],Lvl,MaxLvl) :- !, indent(Lvl), print('['),nl, |
| 240 | | l_trace_print([H|T],Lvl,MaxLvl), |
| 241 | | indent(Lvl), print(']'),nl. |
| 242 | | %trace_print(A,Lvl,_MaxLvl) :- functor(A,_,1), arg(1,A,AN), atomic(AN),!, indent(Lvl), print(A),nl. |
| 243 | | trace_print(A,Lvl,_MaxLvl) :- A=..[_|Args], maplist(atomic,Args),!, |
| 244 | | indent(Lvl), print(A),nl. |
| 245 | | trace_print(A,Lvl,MaxLvl) :- functor(A,FA,FAN), |
| 246 | | indent(Lvl),print(FA/FAN),print('('),nl, |
| 247 | | A=..[_|As], l_trace_print(As,Lvl,MaxLvl). |
| 248 | | |
| 249 | | :- use_module(tools_positions, [is_position/1]). |
| 250 | | treat_as_atomic(A) :- var(A). |
| 251 | | treat_as_atomic(A) :- atomic(A). |
| 252 | | treat_as_atomic(nodeid(Pos)) :- is_position(Pos). |
| 253 | | treat_as_atomic(sharing(_,_,_,_)). |
| 254 | | treat_as_atomic(ID/V) :- treat_as_atomic(ID),treat_as_atomic(V). |
| 255 | | treat_as_atomic([H|T]) :- T==[], treat_as_atomic(H). |
| 256 | | |
| 257 | | l_trace_print([],L,_MaxLvl) :- indent(L), print(')'),nl. |
| 258 | | l_trace_print([A|TA],Lvl,MaxLvl) :- L1 is Lvl+1, trace_print(A,L1,MaxLvl), |
| 259 | | l_trace_print(TA,Lvl,MaxLvl). |
| 260 | | |
| 261 | | % ----------------------------------- |
| 262 | | |
| 263 | | % print on error stream |
| 264 | | print_error(Error) :- |
| 265 | | stream_is_interactive(user_error),!, |
| 266 | | start_terminal_colour([red,bold],user_error), |
| 267 | | call_cleanup(print_no_col(user_error,Error),reset_terminal_colour_and_nl(user_error)). |
| 268 | | %% flush_output(user_error), %%. |
| 269 | | print_error(Error) :- print_no_col(user_error,Error), nl(user_error). |
| 270 | | |
| 271 | | print_no_col(Stream,ErrorTerm) :- |
| 272 | | write(Stream,'! '), |
| 273 | | (var(ErrorTerm) -> write(Stream,'_') |
| 274 | | ; write_term(Stream,ErrorTerm,[max_depth(20),numbervars(true)])). |
| 275 | | |
| 276 | | reset_terminal_colour_and_nl(Stream) :- |
| 277 | | reset_terminal_colour(Stream), |
| 278 | | nl(Stream). % for SICS prompt it is important to have nl after code to reset colour |
| 279 | | |
| 280 | | print_message_on_stream(Stream,Color,Message) :- |
| 281 | | stream_is_interactive(Stream),!, |
| 282 | | start_terminal_colour(Color,Stream), |
| 283 | | call_cleanup(print_no_col(Stream,Message),reset_terminal_colour_and_nl(Stream)). |
| 284 | | print_message_on_stream(Stream,_Color,Message) :- |
| 285 | | print_no_col(Stream,Message), |
| 286 | | nl(Stream). |
| 287 | | |
| 288 | | format_error_with_nl(Str,Args) :- format_with_colour_nl(user_error,[red,bold],Str,Args). |
| 289 | | format_error(Str,Args) :- format_with_colour(user_error,[red,bold],Str,Args). |
| 290 | | |
| 291 | | format_with_colour_nl(Stream,Colour,Str,Args) :- |
| 292 | | format_with_colour(Stream,Colour,Str,Args), |
| 293 | | nl(Stream). % followed by a newline *after* resetting the colours; important for SICStus prompt |
| 294 | | |
| 295 | | format_with_colour(Stream,Colour,Str,Args) :- |
| 296 | | stream_is_interactive(Stream),!, |
| 297 | | start_terminal_colour(Colour,Stream), |
| 298 | | call_cleanup(format(Stream,Str,Args), |
| 299 | | reset_terminal_colour(Stream)). |
| 300 | | format_with_colour(Stream,_Colour,Str,Args) :- format(Stream,Str,Args). |
| 301 | | |
| 302 | | % we could provide a preference to override this; in case we do want to see the colour escape codes in a file |
| 303 | | stream_is_interactive(S) :- |
| 304 | | intelligent_get_stream(S,RealStream), stream_property(RealStream,interactive). |
| 305 | | |
| 306 | | intelligent_get_stream(user_output,S) :- !, current_output(S). |
| 307 | | intelligent_get_stream(user_intput,S) :- !, current_input(S). |
| 308 | | intelligent_get_stream(user_error,S) :- !, prolog_flag(user_error,S). |
| 309 | | intelligent_get_stream(S,S). |
| 310 | | |
| 311 | | :- load_files(library(system), [when(compile_time), imports([environ/2])]). |
| 312 | | :- if(environ(no_terminal_colors,true)). |
| 313 | | no_color. |
| 314 | | set_no_color(_). |
| 315 | | reset_no_color_to_default. |
| 316 | | print_red(X) :- write(X). |
| 317 | | print_red(Stream,T) :- write(Stream,T). |
| 318 | | print_green(X) :- write(X). |
| 319 | | reset_terminal_colour(_). |
| 320 | | start_terminal_colour(_,_). |
| 321 | | :- else. |
| 322 | | :- use_module(library(system),[environ/2]). |
| 323 | | :- dynamic colours_disabled/0. |
| 324 | | no_color :- colours_disabled. |
| 325 | | set_no_color(false) :- retractall(colours_disabled). |
| 326 | | set_no_color(true) :- % useful e.g. for --no-color cli flag |
| 327 | | (colours_disabled -> true ; assertz(colours_disabled)). |
| 328 | | reset_no_color_to_default :- |
| 329 | | (no_col_env -> set_no_color(true) ; retractall(colours_disabled)). |
| 330 | | %TODO: we could try and detect Windows 8 or earlier where no terminal colours are supported |
| 331 | | no_col_env :- environ('NO_COLOR',_),!. % see http://no-color.org |
| 332 | | no_col_env :- environ('NOCOLOR',_),!. |
| 333 | | no_col_env :- environ('CLICOLOR',V), (V=0 ; V='NO' ; V='FALSE'),!. |
| 334 | | no_col_env :- environ('TERM',dumb). |
| 335 | | % | ?- environ('TERM',X). |
| 336 | | % X = 'xterm-256color' |
| 337 | | |
| 338 | | print_red(Stream,Term) :- no_color,!, |
| 339 | | format(Stream,'~w',[Term]). |
| 340 | | print_red(Stream,Term) :- |
| 341 | | format(Stream,'\e[31m~w\e[0m',[Term]). |
| 342 | | |
| 343 | | print_red(Term) :- no_color,!, |
| 344 | | format('~w',[Term]). |
| 345 | | print_red(Term) :- |
| 346 | | format('\e[31m~w\e[0m',[Term]). |
| 347 | | |
| 348 | | print_green(Term) :- no_color,!, |
| 349 | | format('~w',[Term]). |
| 350 | | print_green(Term) :- |
| 351 | | format('\e[32m~w\e[0m',[Term]). |
| 352 | | |
| 353 | | reset_terminal_colour(_) :- no_color,!. |
| 354 | | reset_terminal_colour(Stream) :- write(Stream,'\e[0m'). |
| 355 | | |
| 356 | | % see https://misc.flogisoft.com/bash/tip_colors_and_formatting |
| 357 | | start_terminal_colour(_,_) :- no_color,!. |
| 358 | | start_terminal_colour(black,Stream) :- !, write(Stream,'\e[30m'). |
| 359 | | start_terminal_colour(red,Stream) :- !, write(Stream,'\e[31m'). |
| 360 | | start_terminal_colour(green,Stream) :- !, write(Stream,'\e[32m'). |
| 361 | | start_terminal_colour(yellow,Stream) :- !, write(Stream,'\e[33m'). |
| 362 | | start_terminal_colour(blue,Stream) :- !, write(Stream,'\e[34m'). |
| 363 | | start_terminal_colour(magenta,Stream) :- !, write(Stream,'\e[35m'). |
| 364 | | start_terminal_colour(cyan,Stream) :- !, write(Stream,'\e[36m'). |
| 365 | | start_terminal_colour(light_gray,Stream) :- !, write(Stream,'\e[37m'). |
| 366 | | start_terminal_colour(dark_gray,Stream) :- !, write(Stream,'\e[90m'). |
| 367 | | start_terminal_colour(light_red,Stream) :- !, write(Stream,'\e[91m'). |
| 368 | | start_terminal_colour(light_green,Stream) :- !, write(Stream,'\e[92m'). |
| 369 | | start_terminal_colour(white,Stream) :- !, write(Stream,'\e[97m'). |
| 370 | | start_terminal_colour(bold,Stream) :- !, write(Stream,'\e[1m'). |
| 371 | | start_terminal_colour(underline,Stream) :- !, write(Stream,'\e[4m'). |
| 372 | | start_terminal_colour(dim,Stream) :- !, write(Stream,'\e[2m'). |
| 373 | | start_terminal_colour(black_background,Stream) :- !, write(Stream,'\e[49m'). |
| 374 | | start_terminal_colour(red_background,Stream) :- !, write(Stream,'\e[41m'). |
| 375 | | start_terminal_colour(green_background,Stream) :- !, write(Stream,'\e[42m'). |
| 376 | | start_terminal_colour(yellow_background,Stream) :- !, write(Stream,'\e[43m'). |
| 377 | | start_terminal_colour(white_background,Stream) :- !, write(Stream,'\e[107m'). |
| 378 | | start_terminal_colour(blink,Stream) :- !, write(Stream,'\e[5m'). |
| 379 | | start_terminal_colour(reverse,Stream) :- !, write(Stream,'\e[7m'). % reversed |
| 380 | | start_terminal_colour(hidden,Stream) :- !, write(Stream,'\e[8m'). |
| 381 | | start_terminal_colour(reset,Stream) :- !, write(Stream,'\e[0m'). |
| 382 | | % cursor nagivation: |
| 383 | | start_terminal_colour(go_left,Stream) :- !, write(Stream,'\e[1000Dm'). % go to left of terminal |
| 384 | | start_terminal_colour(go_up(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wA',[Nr]). |
| 385 | | start_terminal_colour(go_down(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wB',[Nr]). |
| 386 | | start_terminal_colour(go_right(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wC',[Nr]). |
| 387 | | start_terminal_colour(go_left(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wD',[Nr]). |
| 388 | | start_terminal_colour(clear_screen,Stream) :- write(Stream,'\e[2J'). |
| 389 | | start_terminal_colour(clear_screen_to_start,Stream) :- write(Stream,'\e[1J'). |
| 390 | | start_terminal_colour(clear_screen_to_end,Stream) :- write(Stream,'\e[0J'). |
| 391 | | start_terminal_colour(clear_line,Stream) :- write(Stream,'\e[2K'). |
| 392 | | start_terminal_colour(clear_line_to_start,Stream) :- write(Stream,'\e[1K'). |
| 393 | | start_terminal_colour(clear_line_to_end,Stream) :- write(Stream,'\e[0K'). |
| 394 | | start_terminal_colour(set_column(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wG',[Nr]). |
| 395 | | start_terminal_colour(set_position(Row,Col),Stream) :- number(Row), number(Col),!, |
| 396 | | format(Stream,'\e[~w;~wHm',[Row,Col]). |
| 397 | | start_terminal_colour(next_line(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wE',[Nr]). |
| 398 | | start_terminal_colour(prev_line(Nr),Stream) :- number(Nr),!, format(Stream,'\e[~wF',[Nr]). |
| 399 | | start_terminal_colour(save_position,Stream) :- !, write(Stream,'\e[s'). |
| 400 | | start_terminal_colour(restore_position,Stream) :- !, write(Stream,'\e[u'). |
| 401 | | % more colors, not supported by all terminals: |
| 402 | | start_terminal_colour(bright_red,Stream) :- !, write(Stream,'\e[31;1m'). % also 91m ? |
| 403 | | start_terminal_colour(bright_green,Stream) :- !, write(Stream,'\e[32;1m'). |
| 404 | | start_terminal_colour(orange,Stream) :- !, write(Stream,'\e[38;5;202m'). |
| 405 | | start_terminal_colour(gray,Stream) :- !, write(Stream,'\e[38;5;241m'). |
| 406 | | start_terminal_colour(grey,Stream) :- !, write(Stream,'\e[38;5;241m'). |
| 407 | | start_terminal_colour(dark_red,Stream) :- !, write(Stream,'\e[38;5;52m'). |
| 408 | | start_terminal_colour(col256(Nr),Stream) :- number(Nr), Nr>=0, Nr=<255,!, format(Stream,'\e[38;5;~wm',[Nr]). |
| 409 | | start_terminal_colour([],_Stream) :- !. |
| 410 | | start_terminal_colour([H|T],Stream) :- !, start_terminal_colour(H,Stream),start_terminal_colour(T,Stream). |
| 411 | | start_terminal_colour(C,_Stream) :- format(user_error,'*** UNKNOWN COLOUR: ~w~n',[C]). |
| 412 | | :- endif. |
| 413 | | |
| 414 | | get_terminal_colour_code(black,'\e[30m'). |
| 415 | | get_terminal_colour_code(red,'\e[31m'). |
| 416 | | get_terminal_colour_code(green,'\e[32m'). |
| 417 | | get_terminal_colour_code(yellow,'\e[33m'). |
| 418 | | get_terminal_colour_code(blue,'\e[34m'). |
| 419 | | get_terminal_colour_code(magenta,'\e[35m'). |
| 420 | | get_terminal_colour_code(cyan,'\e[36m'). |
| 421 | | get_terminal_colour_code(light_gray,'\e[37m'). |
| 422 | | get_terminal_colour_code(reset,'\e[0m'). |
| 423 | | get_terminal_colour_code(light_red,'\e[91m'). |
| 424 | | get_terminal_colour_code(light_green,'\e[92m'). |
| 425 | | get_terminal_colour_code(light_yellow,'\e[93m'). |
| 426 | | get_terminal_colour_code(light_blue,'\e[94m'). |
| 427 | | get_terminal_colour_code(light_magenta,'\e[95m'). |
| 428 | | get_terminal_colour_code(light_cyan,'\e[96m'). |
| 429 | | get_terminal_colour_code(white,'\e[97m'). |
| 430 | | % TODO: extend and use above |
| 431 | | |
| 432 | | % To print out colors: between:between(0,255,Nr),format(user_output,'\e[38;5;~wm Number=~w~n',[Nr,Nr]),fail. |
| 433 | | % See: https://www.lihaoyi.com/post/BuildyourownCommandLinewithANSIescapecodes.html |
| 434 | | |
| 435 | | % ----------------------------------- |
| 436 | | |
| 437 | | :- use_module(library(system),[datime/1]). |
| 438 | | |
| 439 | | print_time_stamp(Stream) :- |
| 440 | | datime(datime(Year,Month,Day,Hour,Min,Sec)), |
| 441 | | (Min<10 |
| 442 | | -> format(Stream,'~w/~w/~w - ~wh0~w ~ws',[Day,Month,Year,Hour,Min,Sec]) |
| 443 | | ; format(Stream,'~w/~w/~w - ~wh~w ~ws',[Day,Month,Year,Hour,Min,Sec]) |
| 444 | | ). |
| 445 | | |
| 446 | | % ----------------------------------- |
| 447 | | print_dynamic_pred(InModule,Pred,N) :- print_dynamic_pred(user_output,InModule,Pred,N). |
| 448 | | |
| 449 | | print_dynamic_pred(Stream,InModule,Pred,N) :- nl(Stream), |
| 450 | | format(Stream,':- dynamic ~w/~w.~n',[Pred,N]), |
| 451 | | functor(Call,Pred,N), |
| 452 | | call(InModule:Call), |
| 453 | | write_term(Stream,Call,[quoted(true)]),write(Stream,'.'),nl(Stream),fail. |
| 454 | | print_dynamic_pred(Stream,InModule,Pred,N) :- |
| 455 | | functor(Call,Pred,N), |
| 456 | | (call(InModule:Call) -> true |
| 457 | | ; write_with_numbervars(Stream,Call), write(Stream,' :- fail.'),nl(Stream)), |
| 458 | | nl(Stream). |
| 459 | | |
| 460 | | write_with_numbervars(Stream,Term) :- copy_term(Term,T), numbervars(T,0,_), |
| 461 | | write_term(Stream,T,[quoted(true),numbervars(true)]). |
| 462 | | |
| 463 | | print_dynamic_fact(Stream,Fact) :- |
| 464 | | functor(Fact,Pred,N), |
| 465 | | format(Stream,':- dynamic ~w/~w.~n',[Pred,N]), |
| 466 | | write_term(Stream,Fact,[quoted(true)]),write(Stream,'.'),nl(Stream). |
| 467 | | |
| 468 | | % ----------------------------------- |
| 469 | | |
| 470 | | % typically used for printing call residues: |
| 471 | | print_goal(V) :- var(V),!, format(' ~p~n',[V]). |
| 472 | | print_goal([A|B]) :- !,print_goal(A), print_goal(B). |
| 473 | | print_goal((A,B)) :- !,print_goal(A), print_goal(B). |
| 474 | | print_goal(Module:(A,B)) :- !, format(' ~p:~n',[Module]), print_goal((A,B)). |
| 475 | | print_goal(when(C,G)) :- !, write(' when('), |
| 476 | | write_term(C,[max_depth(6)]), write(','), |
| 477 | | write_term(G,[max_depth(5)]), write(')'),nl. |
| 478 | | print_goal(A) :- write(' '), write_term(A,[max_depth(5)]), nl. % avoid printing huge terms |
| 479 | | %print_goal(A) :- format(' ~p~n',[A]). |
| 480 | | |
| 481 | | |
| 482 | | % ----------------------------------- |
| 483 | | |
| 484 | | % possible applicaton: inspect size of terms transmitted to ProB2: |
| 485 | | % prob2_interface:get_machine_formulas(Formulas), tell('formulasnest.pl'), nested_print_term(Formulas,6),told. |
| 486 | | |
| 487 | | nested_print_term(Term) :- nested_print_term(Term,10). |
| 488 | | nested_print_term(Term,MaxNest) :- nested_print_term(0,MaxNest,Term). |
| 489 | | |
| 490 | | indentws(0) :- !. |
| 491 | | indentws(X) :- X>0, write(' '), X1 is X-1, indentws(X1). |
| 492 | | |
| 493 | | :- use_module(library(terms),[term_size/2]). |
| 494 | | nested_print_term(CurNesting,_Max,T) :- var(T),!, indent(CurNesting),write(T),nl. |
| 495 | | nested_print_term(CurNesting,_,T) :- atom(T), !, atom_length(T,Len), |
| 496 | | indent(CurNesting), |
| 497 | | (Len > 100 |
| 498 | | -> atom_codes(T,Codes), length(Prefix,50), append(Prefix,_,Codes), |
| 499 | | format('atom: len(~w): ~s...~n',[Len,Prefix]) |
| 500 | | ; format('~w~n',[T])). |
| 501 | | nested_print_term(CurNesting,_,T) :- number(T),!, indent(CurNesting), format('~w~n',[T]). |
| 502 | | nested_print_term(CurNesting,MaxNesting,T) :- CurNesting >= MaxNesting,!, |
| 503 | | term_size(T,Sz), functor(T,F,N), |
| 504 | | indentws(CurNesting), |
| 505 | | (Sz>25000 -> Msg='****' ; Msg=''), format('~w/~w :: sz(~w)~w~n',[F,N,Sz,Msg]). |
| 506 | | nested_print_term(CurNesting,MaxNesting,T) :- |
| 507 | | list_skeleton_size(T,Len,closed), term_size(T,Sz),!, |
| 508 | | indentws(CurNesting),format('[ list_len_sz(~w,~w)~n',[Len,Sz]), |
| 509 | | C1 is CurNesting+1, |
| 510 | | maplist(nested_print_term(C1,MaxNesting),T), |
| 511 | | indentws(CurNesting),format('] list_len(~w)~n',[Len]). |
| 512 | | nested_print_term(CurNesting,MaxNesting,T) :- |
| 513 | | term_size(T,Sz), functor(T,F,N), |
| 514 | | indentws(CurNesting),format('~w/~w( sz(~w)~n',[F,N,Sz]), |
| 515 | | T =.. [_|Args], C1 is CurNesting+1, |
| 516 | | maplist(nested_print_term(C1,MaxNesting),Args), |
| 517 | | indentws(CurNesting),format('~w/~w)~n',[F,N]). |
| 518 | | |
| 519 | | |
| 520 | | % a version of write_term_to_codes that nests the Prolog term |
| 521 | | nested_write_term_to_codes(Term,Codes) :- |
| 522 | | nested_write(Term,0,Codes,[]). |
| 523 | | |
| 524 | | :- use_module(library(codesio)). |
| 525 | | % Note: write_term_to_codes(+Term, -Codes, +Options) with option indented(true) only indents clauses |
| 526 | | |
| 527 | | nested_write(Atom,Level) --> {simple(Atom)},!, indent(Level), format_to_codes('~q',[Atom]). |
| 528 | | nested_write(Term,Level) --> {Level>40},!, indent(Level), format_to_codes('~q',[Term]). |
| 529 | | nested_write([H|T],Level) --> !, |
| 530 | | indent(Level), "[\n", |
| 531 | | {L1 is Level+1}, |
| 532 | | l_nested_write([H|T],L1), |
| 533 | | indent(Level), "]". |
| 534 | | nested_write(Compound,Level) --> {decompose_compound(Compound,F,Args)}, |
| 535 | | indent(Level), |
| 536 | | ({maplist(simple,Args)} |
| 537 | | -> format_to_codes('~q',[Compound]) |
| 538 | | ; write_to_codes(F), "(\n", |
| 539 | | {L1 is Level+1}, |
| 540 | | l_nested_write(Args,L1), |
| 541 | | indent(Level), ")" |
| 542 | | ). |
| 543 | | |
| 544 | | decompose_compound(Module:Compound,Functor,Args) :- nonvar(Compound), !, |
| 545 | | Compound =.. [F|Args], Functor = Module:F. |
| 546 | | decompose_compound(Compound,F,Args) :- Compound =.. [F|Args]. |
| 547 | | |
| 548 | | indent(0) --> !, "". |
| 549 | | indent(L) --> {L>0, L1 is L-1}, " ", indent(L1). |
| 550 | | |
| 551 | | l_nested_write([],_) --> "". |
| 552 | | l_nested_write([H],Level) --> !, |
| 553 | | nested_write(H,Level), "\n". |
| 554 | | l_nested_write([H|T],Level) --> |
| 555 | | nested_write(H,Level), ",\n", |
| 556 | | l_nested_write(T,Level). |
| 557 | | |
| 558 | | % use_module(probsrc(tools_printing)), nested_write_term_to_codes(f(a,[0,s(X)]),C), format('~s~n',[C]). |
| 559 | | |
| 560 | | tcltk_nested_read_prolog_file_as_codes(File,list(Codes)) :- |
| 561 | | open(File, read, Stream, [encoding(utf8)]), |
| 562 | | call_cleanup(nested_read_terms(Stream, Codes, []), close(Stream)). |
| 563 | | |
| 564 | | nested_read_terms(Stream) --> {safe_read_stream(Stream,Term)}, |
| 565 | | ({Term=end_of_file} -> "\n" |
| 566 | | ; nested_write(Term,0), ".\n", |
| 567 | | nested_read_terms(Stream) |
| 568 | | ). |
| 569 | | |
| 570 | | safe_read_stream(Stream,T) :- |
| 571 | | catch(read(Stream,T), E, ( |
| 572 | | error_manager:add_error(nested_read_prolog_file_as_codes,'Exception reading term from file:',E), |
| 573 | | T=end_of_file)). |
| 574 | | |
| 575 | | % write_canonical that generates a code list |
| 576 | | %% write_canonical_to_codes(+Term, -Codes) |
| 577 | | write_canonical_to_codes(Term, Codes) :- write_canonical_to_codes(Term, Codes, []). |
| 578 | | |
| 579 | | write_canonical_to_codes(Term, Codes, CodesOut) :- |
| 580 | | write_term_to_codes(Term,Codes,CodesOut,[quoted(true),ignore_ops(true),quoted_charset(portable)]). |
| 581 | | |
| 582 | | |
| 583 | | % A variant of write_canonical_to_codes that writes lists with square-brackets. |
| 584 | | %% write_canonical_to_codes(+Term, -Codes) |
| 585 | | better_write_canonical_to_codes(Term, Codes) :- better_write_canonical_to_codes(Term, Codes, []). |
| 586 | | |
| 587 | | better_write_canonical_to_codes(Term, Codes, CodesOut) :- |
| 588 | | proper_list(Term), |
| 589 | | !, |
| 590 | | Codes = [0'[ | C1], |
| 591 | | better_write_canonical_to_codes_list(Term, C1, [0'] | CodesOut]). |
| 592 | | better_write_canonical_to_codes(Term, Codes, CodesOut) :- |
| 593 | | compound(Term), |
| 594 | | !, |
| 595 | | Term =.. [Functor | Args], |
| 596 | | write_canonical_to_codes(Functor, Codes, C1), |
| 597 | | (length(Args, L), L=0 -> CodesOut=C1 ; ( |
| 598 | | C1 = [0'( | C2], |
| 599 | | better_write_canonical_to_codes_list(Args, C2, [0') | CodesOut]) |
| 600 | | )). |
| 601 | | better_write_canonical_to_codes(Term, Codes, CodesOut) :- |
| 602 | | !, % fallback for variables and atomic terms |
| 603 | | write_canonical_to_codes(Term, Codes, CodesOut). |
| 604 | | |
| 605 | | better_write_canonical_to_codes_list([], Codes, CodesOut) :- |
| 606 | | !, |
| 607 | | CodesOut=Codes. |
| 608 | | better_write_canonical_to_codes_list([H|T], Codes, CodesOut) :- |
| 609 | | !, |
| 610 | | better_write_canonical_to_codes(H, Codes, C1), |
| 611 | | (T=[] -> C1=C2 ; C1=[0', | C2]), |
| 612 | | better_write_canonical_to_codes_list(T, C2, CodesOut). |
| 613 | | |
| 614 | | proper_list(L) :- nonvar(L), L=[], !. |
| 615 | | proper_list(L) :- nonvar(L), L=[_|T], !, proper_list(T). |