| 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(debug, | |
| 6 | [(~~)/1, | |
| 7 | debug_print/1, debug_nl/0, | |
| 8 | debug_print/2, debug_nl/1, /* extra argument with urgency of message 0: not urgent */ | |
| 9 | debug_println/2, debug_println/1, debug_flush_output/0, | |
| 10 | debug_format/3, | |
| 11 | debug_format_flush/3, % same with flushing output | |
| 12 | println/2, println/1, % allow easy commenting in of debug_println statements | |
| 13 | log/1, | |
| 14 | debug_stats/1, print_debug_stats/0, | |
| 15 | ||
| 16 | tcltk_turn_debugging_on/0, tcltk_turn_debugging_on/1, | |
| 17 | tcltk_turn_debugging_off/0, | |
| 18 | debug_mode/1, | |
| 19 | debug_level/1, | |
| 20 | debug_level_active_for/1, debug_level_inactive_for/1, | |
| 21 | debug_very_verbose/0, | |
| 22 | ||
| 23 | silent_mode/1, set_silent_mode/1, | |
| 24 | printsilent/1, nls/0, println_silent/1, | |
| 25 | formatsilent/2, formatsilent/3, printsilent_message/1, | |
| 26 | formatsilent_with_colour/4, | |
| 27 | ||
| 28 | print_quoted/1, print_quoted/2, | |
| 29 | print_quoted_with_max_depth/2, | |
| 30 | time/1, % call with timing information, time_call | |
| 31 | time_if_debug/1, time_with_msg/3, | |
| 32 | watch/1, watch/2, watch_det/2, det_check/1, det_check/2, | |
| 33 | nl_time/0, nl_times/0, debug_nl_time/1, | |
| 34 | hit_counter/1, | |
| 35 | ||
| 36 | new_pp/2, new_sol/2, reset_pp/1, | |
| 37 | if_det_check/3, | |
| 38 | ||
| 39 | trace_in_debug_mode/0, | |
| 40 | ||
| 41 | (timer_call)/1, (timer_call)/2, timer_statistics/0, | |
| 42 | ||
| 43 | ||
| 44 | bisect/2 | |
| 45 | ]). | |
| 46 | ||
| 47 | :- use_module(module_information,[module_info/2]). | |
| 48 | :- module_info(group,infrastructure). | |
| 49 | :- module_info(description,'This module provides predicates to output debugging information when needed.'). | |
| 50 | ||
| 51 | :- meta_predicate time_if_debug(0). | |
| 52 | :- meta_predicate time(0). | |
| 53 | :- meta_predicate time_with_msg(-,0,-). | |
| 54 | ||
| 55 | :- meta_predicate time_raw(0,-,-,-). | |
| 56 | ||
| 57 | :- meta_predicate watch_det(*,0). | |
| 58 | :- meta_predicate watch(0). | |
| 59 | :- meta_predicate watch(*,0). | |
| 60 | ||
| 61 | :- meta_predicate det_check(0). | |
| 62 | :- meta_predicate det_check(0,0). | |
| 63 | ||
| 64 | :- meta_predicate if_det_check(0,0,0). | |
| 65 | :- meta_predicate if_det_check_pp(0,0,0,*). | |
| 66 | ||
| 67 | :- meta_predicate ~~(0). | |
| 68 | ~~(G) :- call(G). | |
| 69 | ||
| 70 | :- load_files(library(system), [when(compile_time), imports([environ/2])]). | |
| 71 | :- if(environ(prob_enter_debugger_upon_error,true)). | |
| 72 | % A useful definition that ensures that all standard error exceptions causes the debugger to enter trace mode, is as follows: | |
| 73 | :- multifile user:error_exception/1. | |
| 74 | user:error_exception(error(_,_)). % then use ?- debug,go. e.g. for Tcl/Tk Version | |
| 75 | :- endif. | |
| 76 | ||
| 77 | ||
| 78 | :- if(environ(prob_use_timer,true)). | |
| 79 | :- use_module(extension('timer/timer'),[timer_call/1,timer_call/2,timer_init/0,timer_statistics/0]). | |
| 80 | :- timer_init. | |
| 81 | :- print('Microsecond timer initialised. Use debug:timer_statistics. to obtain statistics.'),nl. | |
| 82 | :- else. | |
| 83 | :- op(300,fx,timer_call). | |
| 84 | :- meta_predicate timer_call(0). | |
| 85 | :- meta_predicate timer_call(-,0). | |
| 86 | timer_call(X) :- call(X). | |
| 87 | timer_call(_PP,Call) :- call(Call). | |
| 88 | timer_statistics :- print('*** timer_statistics NOT available; set enable_timer in debug.pl to true'),nl. | |
| 89 | :- endif. | |
| 90 | ||
| 91 | ||
| 92 | println(_,X) :- print_with_max_depth(X,10),nl. | |
| 93 | println(X) :- print_with_max_depth(X,10),nl. | |
| 94 | ||
| 95 | debug_print(X) :- debug_print(6,X). | |
| 96 | debug_nl :- debug_nl(6). | |
| 97 | debug_println(X) :- debug_println(6,X). | |
| 98 | debug_flush_output :- (debug_mode(on) -> flush_output ; true). | |
| 99 | ||
| 100 | :- dynamic debug_print/2, debug_format/3, debug_nl/1, debug_println/2. | |
| 101 | ||
| 102 | debug_print(_,_). | |
| 103 | debug_println(_,_). | |
| 104 | debug_format(_,_,_). | |
| 105 | debug_nl(_). | |
| 106 | ||
| 107 | :- dynamic debug_mode/1. | |
| 108 | debug_mode(off). | |
| 109 | % TO DO: use DEBUG environment variable for default value | |
| 110 | %:- use_module(library(system),[environ/2]). | |
| 111 | %reset_debug_mode_to_default :- | |
| 112 | % environ('DEBUG',Val), | |
| 113 | % (Val=1 ; Val='1' ; Val='TRUE' ; Val = 'YES'),!, | |
| 114 | ||
| 115 | ||
| 116 | ||
| 117 | % additional flag that can be checked : any non-essential prints should not be printed in silent mode | |
| 118 | :- dynamic silent_mode/1. | |
| 119 | silent_mode(off). | |
| 120 | ||
| 121 | set_silent_mode(X) :- silent_mode(X),!. | |
| 122 | set_silent_mode(X) :- retractall(silent_mode(_)), | |
| 123 | assertz(silent_mode(X)). | |
| 124 | ||
| 125 | ||
| 126 | printsilent(S) :- silent_mode(off) -> print(user_output,S) ; true. % print_silent | |
| 127 | println_silent(S) :- silent_mode(off) -> print(user_output,S),nl(user_output) ; true. | |
| 128 | printsilent_message(S) :- silent_mode(off) -> format(user_output,'~w~n',[S]) ; true. | |
| 129 | nls :- silent_mode(off) -> nl(user_output) ; true. | |
| 130 | formatsilent(FS,Args) :- silent_mode(off) -> format(user_output,FS,Args) ; true. | |
| 131 | formatsilent(Stream,FS,Args) :- silent_mode(off) -> format(Stream,FS,Args) ; true. | |
| 132 | :- use_module(tools_printing,[format_with_colour/4]). | |
| 133 | formatsilent_with_colour(Stream,Colours,FS,Args) :- | |
| 134 | silent_mode(off) -> format_with_colour(Stream,Colours,FS,Args) ; true. | |
| 135 | ||
| 136 | debug_format_flush(Level,Msg,Args) :- | |
| 137 | (debug_mode(on) -> debug_format(Level,Msg,Args), flush_output(user_output) | |
| 138 | ; true). | |
| 139 | ||
| 140 | ||
| 141 | reset_debug :- | |
| 142 | retractall(debug_level(_)), assertz(debug_level(5)), | |
| 143 | tcltk_turn_debugging_off, | |
| 144 | set_silent_mode(off). | |
| 145 | ||
| 146 | ||
| 147 | :- dynamic debug_level/1. | |
| 148 | ||
| 149 | debug_level(5). /* only messages with priority of 5 or higher are printed */ | |
| 150 | ||
| 151 | % does the debug_level print messages of level X. | |
| 152 | debug_level_active_for(X) :- debug_mode(on), debug_level(L), X >= L. | |
| 153 | debug_level_inactive_for(X) :- (debug_mode(off) -> true ; debug_level(L), X < L). | |
| 154 | ||
| 155 | % when -vv set by probcli: | |
| 156 | debug_very_verbose :- debug_level_active_for(5). | |
| 157 | ||
| 158 | tcltk_turn_debugging_on :- debug_level(X),tcltk_turn_debugging_on(X). | |
| 159 | ||
| 160 | tcltk_turn_debugging_on(Level) :- | |
| 161 | debug_mode(on), debug_level(Level),!. % we are already at this level, no change | |
| 162 | tcltk_turn_debugging_on(Level) :- number(Level), | |
| 163 | (Level < 5 -> OptTime=nl_time ; OptTime=true), | |
| 164 | retract(debug_level(_)), | |
| 165 | assertz(debug_level(Level)), | |
| 166 | retract(debug_mode(_)), !, assertz(debug_mode(on)), | |
| 167 | retractall(debug_nl(_)), | |
| 168 | assertz((debug_nl(U) :- (U < Level -> true ; nl))), | |
| 169 | retractall(debug_print(_,_)), | |
| 170 | assertz((debug_print(U,X) :- (U < Level -> true ; print_with_max_depth(X,10)))), | |
| 171 | retractall(debug_println(_,_)), | |
| 172 | assertz((debug_println(U,X) :- (U < Level -> true ; print_with_max_depth(X,10),nl(user_output), OptTime))), | |
| 173 | retractall(debug_format(_,_,_)), | |
| 174 | assertz((debug_format(U,A,V) :- (U < Level -> true ; format(user_output,A,V), OptTime))), | |
| 175 | format(user_output,'Debugging mode: On : ~w~n',[Level]). | |
| 176 | tcltk_turn_debugging_on(_). | |
| 177 | ||
| 178 | tcltk_turn_debugging_off :- | |
| 179 | retract(debug_mode(on)), !, assertz(debug_mode(off)), | |
| 180 | retractall(debug_nl(_)),assertz(debug_nl(_)), | |
| 181 | retractall(debug_print(_,_)), assertz(debug_print(_,_)), | |
| 182 | retractall(debug_println(_,_)), assertz(debug_println(_,_)), | |
| 183 | retractall(debug_format(_,_,_)), assertz(debug_format(_,_,_)), | |
| 184 | format(user_output,'Debugging mode: Off~n',[]). | |
| 185 | tcltk_turn_debugging_off. | |
| 186 | ||
| 187 | trace_in_debug_mode :- (debug_mode(off) -> true ; trace). | |
| 188 | ||
| 189 | print_with_max_depth(X,Max) :- write_term(user_output,X, | |
| 190 | [max_depth(Max),portrayed(true)]). | |
| 191 | print_quoted_with_max_depth(X,Max) :- write_term(user_output,X, | |
| 192 | [quoted(true),ignore_ops(true), | |
| 193 | max_depth(Max),portrayed(true)]). | |
| 194 | print_quoted(X) :- write_term(user_output,X, | |
| 195 | [quoted(true),ignore_ops(true), | |
| 196 | max_depth(0), | |
| 197 | numbervars(true),portrayed(true)]). | |
| 198 | print_quoted(Stream,X) :- write_term(Stream,X, | |
| 199 | [quoted(true),ignore_ops(true), % we could add quoted_charset(portable) | |
| 200 | max_depth(0), | |
| 201 | numbervars(true),portrayed(true)]). | |
| 202 | ||
| 203 | ||
| 204 | debug_stats(Info) :- debug_mode(on),!,print(Info),print_debug_stats. | |
| 205 | debug_stats(_). | |
| 206 | ||
| 207 | print_debug_stats :- | |
| 208 | tools:print_memory_used_wo_gc, | |
| 209 | statistics(runtime,[RT,_]), print(' run/wall = '),print(RT), | |
| 210 | statistics(walltime,[WT,_]), print('/'),print(WT),print(' ms'),nl. | |
| 211 | ||
| 212 | ||
| 213 | time_if_debug(Call) :- debug_mode(off),!,Call. | |
| 214 | time_if_debug(Call) :- time(Call). | |
| 215 | ||
| 216 | :- use_module(tools_printing,[print_term_summary/1]). | |
| 217 | time(Call) :- | |
| 218 | nl,write('Calling: '),print_term_summary(Call), | |
| 219 | time_raw(Call,Tot,TotT,TotW), | |
| 220 | write('Exit: '), print_term_summary(Call), | |
| 221 | format('Runtime: ~w ms, (~w ms total, ~w ms walltime)~n',[Tot,TotT,TotW]), | |
| 222 | tools:print_memory_used_wo_gc,nl. | |
| 223 | ||
| 224 | ||
| 225 | time_with_msg(Msg,Call,TotW) :- | |
| 226 | format(user_output,'Starting: ~w~n',[Msg]), | |
| 227 | time_raw(Call,Tot,TotT,TotW), | |
| 228 | format(user_output,'Finished: ~w, runtime: ~w ms, (~w ms total, ~w ms walltime)~n',[Msg,Tot,TotT,TotW]), | |
| 229 | tools:print_memory_used_wo_gc,nl. | |
| 230 | ||
| 231 | ||
| 232 | time_raw(Call,Tot,TotT,TotW) :- | |
| 233 | statistics(runtime,[Start,_]), | |
| 234 | statistics(total_runtime,[StartT,_]), | |
| 235 | statistics(walltime,[StartW,_]), | |
| 236 | call(Call), | |
| 237 | statistics(runtime,[End,_]), | |
| 238 | statistics(total_runtime,[EndT,_]), | |
| 239 | statistics(walltime,[EndW,_]), | |
| 240 | Tot is End-Start, | |
| 241 | TotT is EndT-StartT, | |
| 242 | TotW is EndW-StartW. | |
| 243 | ||
| 244 | :- volatile sol_found/2. | |
| 245 | :- dynamic det_id/1, sol_found/2. | |
| 246 | det_id(0). | |
| 247 | gen_det_id(X) :- retract(det_id(X)), X1 is X+1, | |
| 248 | assertz(det_id(X1)). | |
| 249 | ||
| 250 | watch_det(Limit,Call) :- | |
| 251 | gen_det_id(ID), | |
| 252 | watch(Limit,Call), | |
| 253 | (retract(sol_found(ID,Nr)) | |
| 254 | -> nl,print('*** '), print_term_summary(Call), | |
| 255 | print('*** NON-DETERMINATE SOLUTION #'), | |
| 256 | N1 is Nr+1, print(N1),nl,nl, | |
| 257 | assertz(sol_found(ID,N1)) %,trace | |
| 258 | ; assertz(sol_found(ID,1)) | |
| 259 | ). | |
| 260 | ||
| 261 | det_check(Call) :- det_check(Call,true). | |
| 262 | ||
| 263 | det_check(Call,ErrCode) :- | |
| 264 | gen_det_id(ID), | |
| 265 | call(Call), %tools:print_bt_message(det_check_sol(ID,Call)), | |
| 266 | (retract(sol_found(ID,Nr)) | |
| 267 | -> nl,print('*** '), print_term_summary(Call), | |
| 268 | print('*** NON-DETERMINATE SOLUTION #'), | |
| 269 | N1 is Nr+1, print(N1),nl, | |
| 270 | assertz(sol_found(ID,N1)), | |
| 271 | call(ErrCode), | |
| 272 | nl | |
| 273 | ; assertz(sol_found(ID,1)) | |
| 274 | ). | |
| 275 | ||
| 276 | watch(Call) :- watch(30,Call). | |
| 277 | ||
| 278 | watch(Limit,Call) :- | |
| 279 | statistics(runtime,[Start,_]), | |
| 280 | call(Call), | |
| 281 | statistics(runtime,[End,_]), | |
| 282 | Tot is End-Start, | |
| 283 | (Tot>Limit -> nl, %nl,print(Call),nl, | |
| 284 | print('*** '),print_term_summary(Call), | |
| 285 | print('*** exceeded limit: '), print(Tot), print(' ms'),nl | |
| 286 | ; true). | |
| 287 | ||
| 288 | % print new line with time info | |
| 289 | nl_time :- statistics(runtime,[Start,SinceLast]), statistics(walltime,[WStart,WSinceLast]), | |
| 290 | (WSinceLast >= 1000 -> Xs = ' ***long***' | |
| 291 | ; WSinceLast >= 100 -> Xs = ' **' | |
| 292 | ; Xs = ''), | |
| 293 | format(user_output,' [total runtime ~w ms, delta: ~w ms; total walltime: ~w ms, delta: ~w ms~w]~n',[Start,SinceLast,WStart,WSinceLast,Xs]), | |
| 294 | flush_output. | |
| 295 | ||
| 296 | % short time info version: | |
| 297 | nl_times :- statistics(walltime,[WStart,_]), | |
| 298 | format(user_output,' [total walltime:~w ms]~n',[WStart]). | |
| 299 | ||
| 300 | debug_nl_time(Msg) :- (debug_mode(on) -> print(Msg), nl_time ; true). | |
| 301 | ||
| 302 | ||
| 303 | % ------------------------ | |
| 304 | % utility similar to det_check; but allows to set spy point for tracing and checks redo | |
| 305 | ||
| 306 | :- volatile pp_nr/1, spy_pp/1, pp_goal/2. | |
| 307 | :- dynamic pp_nr/1, spy_pp/1, pp_goal/2. | |
| 308 | % debug:reset_pp(XX). | |
| 309 | pp_nr(0). pp_goal(0,true). | |
| 310 | %spy_pp(115). | |
| 311 | reset_pp(Spy) :- retract(pp_nr(_)), assertz(pp_nr(0)), | |
| 312 | retractall(pp_goal(_,_)), assertz(spy_pp(Spy)). | |
| 313 | :- volatile sol_found/1. | |
| 314 | :- dynamic sol_found/1. | |
| 315 | new_pp(C,Nr) :- retract(pp_nr(X)), Nr is X+1, assertz(pp_nr(Nr)), | |
| 316 | assertz(pp_goal(Nr,C)), | |
| 317 | (spy_pp(Nr) -> trace ; true). | |
| 318 | new_sol(S,Nr) :- new_sol_no_redo(S,Nr). | |
| 319 | new_sol(S,Nr) :- %spy_pp(Nr), | |
| 320 | print('### REDO PP: '), print(Nr),nl, | |
| 321 | print('### SOL: '), print(S),nl,spy_trace(Nr), | |
| 322 | fail. | |
| 323 | ||
| 324 | new_sol_no_redo(S,Nr) :- | |
| 325 | (sol_found(Nr) -> nl,print('### Non-Deterministic Program Point !'),nl, | |
| 326 | print('### '), print(Nr),nl, | |
| 327 | print('### GOAL: '), pp_goal(Nr,G), print(G),nl, | |
| 328 | print('### SOL: '), print(S),nl, | |
| 329 | nl,trace | |
| 330 | ; assertz(sol_found(Nr)), % print(sol_found(Nr,S)),nl,nl, | |
| 331 | spy_trace(Nr) | |
| 332 | ). | |
| 333 | ||
| 334 | spy_trace(Nr) :- (spy_pp(Nr) -> trace ; true). | |
| 335 | ||
| 336 | % an if predicate which checks if the Test part is deterministic | |
| 337 | if_det_check(Test,Then,Else) :- new_pp(if_det_check_test(Test),PP), | |
| 338 | if_det_check_pp(Test,Then,Else,PP). | |
| 339 | if_det_check_pp(Test,Then,_Else,PP) :- | |
| 340 | Test, | |
| 341 | new_sol_no_redo(Test,PP), | |
| 342 | Then. | |
| 343 | if_det_check_pp(_Test,_Then,Else,PP) :- \+ sol_found(PP), Else. | |
| 344 | ||
| 345 | % ------------------------------------------- | |
| 346 | :- dynamic hit_counter_fact/1. | |
| 347 | hit_counter_fact(1). | |
| 348 | ||
| 349 | % call to get and increase hit_counter; can be used to set trace spy points | |
| 350 | hit_counter(X) :- retract(hit_counter_fact(X)), X1 is X+1, assertz(hit_counter_fact(X1)). | |
| 351 | ||
| 352 | % ------------------------------------------- | |
| 353 | ||
| 354 | ||
| 355 | :- dynamic tdepth/1. | |
| 356 | tdepth(0). | |
| 357 | :- public trace_point/1. | |
| 358 | trace_point(E) :- retract(tdepth(T)), T1 is T+1, assertz(tdepth(T1)), | |
| 359 | print_tab(T), print('> ENTER '),print(T), print(' : '),print_term_summary(E),nl. | |
| 360 | trace_point(E) :- retract(tdepth(T1)), T is T1-1, assertz(tdepth(T)), | |
| 361 | print_tab(T), print('> exit '), print(T), print(' : '), print_term_summary(E),nl,fail. | |
| 362 | :- public print_tabs/0. | |
| 363 | print_tabs :- tdepth(T), print_tab(T). | |
| 364 | print_tab(0) :- !, print(' '). | |
| 365 | print_tab(N) :- N>0, print('|-+-'), N1 is N-1, print_tab(N1). | |
| 366 | ||
| 367 | % ------------------------------------------- | |
| 368 | ||
| 369 | % use to log terms into a file (alternative to writeln_log) | |
| 370 | log(Term) :- F='~/problog.pl', | |
| 371 | open(F,append,S), | |
| 372 | write_term(S,Term,[quoted(true)]), write(S,'.'),nl(S), | |
| 373 | close(S). | |
| 374 | ||
| 375 | ||
| 376 | % ------------------------------------------- | |
| 377 | :- use_module(library(terms),[term_hash/2]). | |
| 378 | % succeeds or fails depending on Term and on bisect_list (a list of 0s and 1s) | |
| 379 | bisect(Term,List) :- term_hash(Term,Hash), | |
| 380 | (mods_match(List,Hash) -> print(match(List,Hash)),nl ; print(no_match(List,Hash)),nl,fail). | |
| 381 | ||
| 382 | mods_match([],_). | |
| 383 | mods_match(['*'|T],Hash) :- !, Hash2 is Hash//2, mods_match(T,Hash2). | |
| 384 | mods_match([H|T],Hash) :- H is Hash mod 2, | |
| 385 | Hash2 is Hash//2, mods_match(T,Hash2). | |
| 386 | ||
| 387 | ||
| 388 | % ------------------------------------------- | |
| 389 | ||
| 390 | :- use_module(eventhandling,[register_event_listener/3]). | |
| 391 | :- register_event_listener(reset_prob,reset_debug, | |
| 392 | 'Reset Debugging Mode just like after starup_prob'). |