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