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