| 1 | % (c) 2009-2024 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, | |
| 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 | ||
| 98 | :- dynamic debug_print/2, debug_format/3, debug_nl/1, debug_println/2. | |
| 99 | ||
| 100 | debug_print(_,_). | |
| 101 | debug_println(_,_). | |
| 102 | debug_format(_,_,_). | |
| 103 | debug_nl(_). | |
| 104 | ||
| 105 | :- dynamic debug_mode/1. | |
| 106 | debug_mode(off). | |
| 107 | % TO DO: use DEBUG environment variable for default value | |
| 108 | %:- use_module(library(system),[environ/2]). | |
| 109 | %reset_debug_mode_to_default :- | |
| 110 | % environ('DEBUG',Val), | |
| 111 | % (Val=1 ; Val='1' ; Val='TRUE' ; Val = 'YES'),!, | |
| 112 | ||
| 113 | ||
| 114 | ||
| 115 | % additional flag that can be checked : any non-essential prints should not be printed in silent mode | |
| 116 | :- dynamic silent_mode/1. | |
| 117 | silent_mode(off). | |
| 118 | ||
| 119 | set_silent_mode(X) :- retractall(silent_mode(_)),assertz(silent_mode(X)). | |
| 120 | ||
| 121 | ||
| 122 | printsilent(S) :- silent_mode(off) -> print(user_output,S) ; true. % print_silent | |
| 123 | println_silent(S) :- silent_mode(off) -> print(user_output,S),nl(user_output) ; true. | |
| 124 | printsilent_message(S) :- silent_mode(off) -> format(user_output,'~w~n',[S]) ; true. | |
| 125 | nls :- silent_mode(off) -> nl(user_output) ; true. | |
| 126 | formatsilent(FS,Args) :- silent_mode(off) -> format(user_output,FS,Args) ; true. | |
| 127 | formatsilent(Stream,FS,Args) :- silent_mode(off) -> format(Stream,FS,Args) ; true. | |
| 128 | :- use_module(tools_printing,[format_with_colour/4]). | |
| 129 | formatsilent_with_colour(Stream,Colours,FS,Args) :- | |
| 130 | silent_mode(off) -> format_with_colour(Stream,Colours,FS,Args) ; true. | |
| 131 | ||
| 132 | debug_format_flush(Level,Msg,Args) :- | |
| 133 | (debug_mode(on) -> debug_format(Level,Msg,Args), flush_output(user_output) | |
| 134 | ; true). | |
| 135 | ||
| 136 | ||
| 137 | reset_debug :- | |
| 138 | retractall(debug_level(_)), assertz(debug_level(5)), | |
| 139 | tcltk_turn_debugging_off, | |
| 140 | set_silent_mode(off). | |
| 141 | ||
| 142 | ||
| 143 | :- dynamic debug_level/1. | |
| 144 | ||
| 145 | debug_level(5). /* only messages with priority of 5 or higher are printed */ | |
| 146 | ||
| 147 | % does the debug_level print messages of level X. | |
| 148 | debug_level_active_for(X) :- debug_mode(on), debug_level(L), X >= L. | |
| 149 | ||
| 150 | tcltk_turn_debugging_on :- debug_level(X),tcltk_turn_debugging_on(X). | |
| 151 | ||
| 152 | tcltk_turn_debugging_on(Level) :- atomic(Level), number(Level), | |
| 153 | retract(debug_level(_)), | |
| 154 | assertz(debug_level(Level)), | |
| 155 | retract(debug_mode(_)), !, assertz(debug_mode(on)), | |
| 156 | retractall(debug_nl(_)), | |
| 157 | assertz((debug_nl(U) :- (U < Level -> true ; nl))), | |
| 158 | retractall(debug_print(_,_)), | |
| 159 | assertz((debug_print(U,X) :- (U < Level -> true ; print_with_max_depth(X,10)))), | |
| 160 | retractall(debug_println(_,_)), | |
| 161 | assertz((debug_println(U,X) :- (U < Level -> true ; print_with_max_depth(X,10),nl(user_output)))), | |
| 162 | retractall(debug_format(_,_,_)), | |
| 163 | assertz((debug_format(U,A,V) :- (U < Level -> true ; format(user_output,A,V)))), | |
| 164 | format(user_output,'Debugging mode: On : ~w~n',[Level]). | |
| 165 | tcltk_turn_debugging_on(_). | |
| 166 | ||
| 167 | tcltk_turn_debugging_off :- | |
| 168 | retract(debug_mode(on)), !, assertz(debug_mode(off)), | |
| 169 | retractall(debug_nl(_)),assertz(debug_nl(_)), | |
| 170 | retractall(debug_print(_,_)), assertz(debug_print(_,_)), | |
| 171 | retractall(debug_println(_,_)), assertz(debug_println(_,_)), | |
| 172 | retractall(debug_format(_,_,_)), assertz(debug_format(_,_,_)), | |
| 173 | format(user_output,'Debugging mode: Off~n',[]). | |
| 174 | tcltk_turn_debugging_off. | |
| 175 | ||
| 176 | trace_in_debug_mode :- (debug_mode(off) -> true ; trace). | |
| 177 | ||
| 178 | print_with_max_depth(X,Max) :- write_term(user_output,X, | |
| 179 | [max_depth(Max),portrayed(true)]). | |
| 180 | print_quoted_with_max_depth(X,Max) :- write_term(user_output,X, | |
| 181 | [quoted(true),ignore_ops(true), | |
| 182 | max_depth(Max),portrayed(true)]). | |
| 183 | print_quoted(X) :- write_term(user_output,X, | |
| 184 | [quoted(true),ignore_ops(true), | |
| 185 | max_depth(0), | |
| 186 | numbervars(true),portrayed(true)]). | |
| 187 | print_quoted(Stream,X) :- write_term(Stream,X, | |
| 188 | [quoted(true),ignore_ops(true), % we could add quoted_charset(portable) | |
| 189 | max_depth(0), | |
| 190 | numbervars(true),portrayed(true)]). | |
| 191 | ||
| 192 | ||
| 193 | debug_stats(Info) :- debug_mode(on),!,print(Info),print_debug_stats. | |
| 194 | debug_stats(_). | |
| 195 | ||
| 196 | print_debug_stats :- | |
| 197 | tools:print_memory_used_wo_gc, | |
| 198 | statistics(runtime,[RT,_]), print(' run/wall = '),print(RT), | |
| 199 | statistics(walltime,[WT,_]), print('/'),print(WT),print(' ms'),nl. | |
| 200 | ||
| 201 | ||
| 202 | time_if_debug(Call) :- debug_mode(off),!,Call. | |
| 203 | time_if_debug(Call) :- time(Call). | |
| 204 | ||
| 205 | :- use_module(tools_printing,[print_term_summary/1]). | |
| 206 | time(Call) :- | |
| 207 | nl,write('Calling: '),print_term_summary(Call), | |
| 208 | time_raw(Call,Tot,TotT,TotW), | |
| 209 | write('Exit: '), print_term_summary(Call), | |
| 210 | format('Runtime: ~w ms, (~w ms total, ~w ms walltime)~n',[Tot,TotT,TotW]), | |
| 211 | tools:print_memory_used_wo_gc,nl. | |
| 212 | ||
| 213 | ||
| 214 | time_with_msg(Msg,Call) :- | |
| 215 | format(user_output,'Starting: ~w~n',[Msg]), | |
| 216 | time_raw(Call,Tot,TotT,TotW), | |
| 217 | format(user_output,'Finished: ~w, runtime: ~w ms, (~w ms total, ~w ms walltime)~n',[Msg,Tot,TotT,TotW]), | |
| 218 | tools:print_memory_used_wo_gc,nl. | |
| 219 | ||
| 220 | ||
| 221 | time_raw(Call,Tot,TotT,TotW) :- | |
| 222 | statistics(runtime,[Start,_]), | |
| 223 | statistics(total_runtime,[StartT,_]), | |
| 224 | statistics(walltime,[StartW,_]), | |
| 225 | call(Call), | |
| 226 | statistics(runtime,[End,_]), | |
| 227 | statistics(total_runtime,[EndT,_]), | |
| 228 | statistics(walltime,[EndW,_]), | |
| 229 | Tot is End-Start, | |
| 230 | TotT is EndT-StartT, | |
| 231 | TotW is EndW-StartW. | |
| 232 | ||
| 233 | :- volatile sol_found/2. | |
| 234 | :- dynamic det_id/1, sol_found/2. | |
| 235 | det_id(0). | |
| 236 | gen_det_id(X) :- retract(det_id(X)), X1 is X+1, | |
| 237 | assertz(det_id(X1)). | |
| 238 | ||
| 239 | watch_det(Limit,Call) :- | |
| 240 | gen_det_id(ID), | |
| 241 | watch(Limit,Call), | |
| 242 | (retract(sol_found(ID,Nr)) | |
| 243 | -> nl,print('*** '), print_term_summary(Call), | |
| 244 | print('*** NON-DETERMINATE SOLUTION #'), | |
| 245 | N1 is Nr+1, print(N1),nl,nl, | |
| 246 | assertz(sol_found(ID,N1)) %,trace | |
| 247 | ; assertz(sol_found(ID,1)) | |
| 248 | ). | |
| 249 | ||
| 250 | det_check(Call) :- det_check(Call,true). | |
| 251 | ||
| 252 | det_check(Call,ErrCode) :- | |
| 253 | gen_det_id(ID), | |
| 254 | call(Call), %tools:print_bt_message(det_check_sol(ID,Call)), | |
| 255 | (retract(sol_found(ID,Nr)) | |
| 256 | -> nl,print('*** '), print_term_summary(Call), | |
| 257 | print('*** NON-DETERMINATE SOLUTION #'), | |
| 258 | N1 is Nr+1, print(N1),nl, | |
| 259 | assertz(sol_found(ID,N1)), | |
| 260 | call(ErrCode), | |
| 261 | nl | |
| 262 | ; assertz(sol_found(ID,1)) | |
| 263 | ). | |
| 264 | ||
| 265 | watch(Call) :- watch(30,Call). | |
| 266 | ||
| 267 | watch(Limit,Call) :- | |
| 268 | statistics(runtime,[Start,_]), | |
| 269 | call(Call), | |
| 270 | statistics(runtime,[End,_]), | |
| 271 | Tot is End-Start, | |
| 272 | (Tot>Limit -> nl, %nl,print(Call),nl, | |
| 273 | print('*** '),print_term_summary(Call), | |
| 274 | print('*** exceeded limit: '), print(Tot), print(' ms'),nl | |
| 275 | ; true). | |
| 276 | ||
| 277 | % print new line with time info | |
| 278 | nl_time :- statistics(runtime,[Start,SinceLast]), statistics(walltime,[WStart,WSinceLast]), | |
| 279 | (WSinceLast >= 1000 -> Xs = ' ***long***' | |
| 280 | ; WSinceLast >= 100 -> Xs = ' **' | |
| 281 | ; Xs = ''), | |
| 282 | format(user_output,' [total runtime ~w ms, delta: ~w ms (total walltime: ~w ms, delta: ~w ms)~w]~n',[Start,SinceLast,WStart,WSinceLast,Xs]). | |
| 283 | ||
| 284 | debug_nl_time(Msg) :- (debug_mode(on) -> print(Msg), nl_time ; true). | |
| 285 | ||
| 286 | % ------------------------ | |
| 287 | % utility similar to det_check; but allows to set spy point for tracing and checks redo | |
| 288 | ||
| 289 | :- volatile pp_nr/1, spy_pp/1, pp_goal/2. | |
| 290 | :- dynamic pp_nr/1, spy_pp/1, pp_goal/2. | |
| 291 | % debug:reset_pp(XX). | |
| 292 | pp_nr(0). pp_goal(0,true). | |
| 293 | %spy_pp(115). | |
| 294 | reset_pp(Spy) :- retract(pp_nr(_)), assertz(pp_nr(0)), | |
| 295 | retractall(pp_goal(_,_)), assertz(spy_pp(Spy)). | |
| 296 | :- volatile sol_found/1. | |
| 297 | :- dynamic sol_found/1. | |
| 298 | new_pp(C,Nr) :- retract(pp_nr(X)), Nr is X+1, assertz(pp_nr(Nr)), | |
| 299 | assertz(pp_goal(Nr,C)), | |
| 300 | (spy_pp(Nr) -> trace ; true). | |
| 301 | new_sol(S,Nr) :- new_sol_no_redo(S,Nr). | |
| 302 | new_sol(S,Nr) :- %spy_pp(Nr), | |
| 303 | print('### REDO PP: '), print(Nr),nl, | |
| 304 | print('### SOL: '), print(S),nl,spy_trace(Nr), | |
| 305 | fail. | |
| 306 | ||
| 307 | new_sol_no_redo(S,Nr) :- | |
| 308 | (sol_found(Nr) -> nl,print('### Non-Deterministic Program Point !'),nl, | |
| 309 | print('### '), print(Nr),nl, | |
| 310 | print('### GOAL: '), pp_goal(Nr,G), print(G),nl, | |
| 311 | print('### SOL: '), print(S),nl, | |
| 312 | nl,trace | |
| 313 | ; assertz(sol_found(Nr)), % print(sol_found(Nr,S)),nl,nl, | |
| 314 | spy_trace(Nr) | |
| 315 | ). | |
| 316 | ||
| 317 | spy_trace(Nr) :- (spy_pp(Nr) -> trace ; true). | |
| 318 | ||
| 319 | % an if predicate which checks if the Test part is deterministic | |
| 320 | if_det_check(Test,Then,Else) :- new_pp(if_det_check_test(Test),PP), | |
| 321 | if_det_check_pp(Test,Then,Else,PP). | |
| 322 | if_det_check_pp(Test,Then,_Else,PP) :- | |
| 323 | Test, | |
| 324 | new_sol_no_redo(Test,PP), | |
| 325 | Then. | |
| 326 | if_det_check_pp(_Test,_Then,Else,PP) :- \+ sol_found(PP), Else. | |
| 327 | ||
| 328 | % ------------------------------------------- | |
| 329 | :- dynamic hit_counter_fact/1. | |
| 330 | hit_counter_fact(1). | |
| 331 | ||
| 332 | % call to get and increase hit_counter; can be used to set trace spy points | |
| 333 | hit_counter(X) :- retract(hit_counter_fact(X)), X1 is X+1, assertz(hit_counter_fact(X1)). | |
| 334 | ||
| 335 | % ------------------------------------------- | |
| 336 | ||
| 337 | ||
| 338 | :- dynamic tdepth/1. | |
| 339 | tdepth(0). | |
| 340 | :- public trace_point/1. | |
| 341 | trace_point(E) :- retract(tdepth(T)), T1 is T+1, assertz(tdepth(T1)), | |
| 342 | print_tab(T), print('> ENTER '),print(T), print(' : '),print_term_summary(E),nl. | |
| 343 | trace_point(E) :- retract(tdepth(T1)), T is T1-1, assertz(tdepth(T)), | |
| 344 | print_tab(T), print('> exit '), print(T), print(' : '), print_term_summary(E),nl,fail. | |
| 345 | :- public print_tabs/0. | |
| 346 | print_tabs :- tdepth(T), print_tab(T). | |
| 347 | print_tab(0) :- !, print(' '). | |
| 348 | print_tab(N) :- N>0, print('|-+-'), N1 is N-1, print_tab(N1). | |
| 349 | ||
| 350 | % ------------------------------------------- | |
| 351 | ||
| 352 | % use to log terms into a file (alternative to writeln_log) | |
| 353 | log(Term) :- F='~/problog.pl', | |
| 354 | open(F,append,S), | |
| 355 | write_term(S,Term,[quoted(true)]), write(S,'.'),nl(S), | |
| 356 | close(S). | |
| 357 | ||
| 358 | ||
| 359 | % ------------------------------------------- | |
| 360 | :- use_module(library(terms),[term_hash/2]). | |
| 361 | % succeeds or fails depending on Term and on bisect_list (a list of 0s and 1s) | |
| 362 | bisect(Term,List) :- term_hash(Term,Hash), | |
| 363 | (mods_match(List,Hash) -> print(match(List,Hash)),nl ; print(no_match(List,Hash)),nl,fail). | |
| 364 | ||
| 365 | mods_match([],_). | |
| 366 | mods_match(['*'|T],Hash) :- !, Hash2 is Hash//2, mods_match(T,Hash2). | |
| 367 | mods_match([H|T],Hash) :- H is Hash mod 2, | |
| 368 | Hash2 is Hash//2, mods_match(T,Hash2). | |
| 369 | ||
| 370 | ||
| 371 | % ------------------------------------------- | |
| 372 | ||
| 373 | :- use_module(eventhandling,[register_event_listener/3]). | |
| 374 | :- register_event_listener(reset_prob,reset_debug, | |
| 375 | 'Reset Debugging Mode just like after starup_prob'). |