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