1/* Part of SWISH 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2015-2016, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(swish_trace, 36 [ '$swish wrapper'/2 % +Goal, -Residuals 37 ]). 38:- use_module(library(debug)). 39:- use_module(library(settings)). 40:- use_module(library(pengines)). 41:- use_module(library(apply)). 42:- use_module(library(lists)). 43:- use_module(library(option)). 44:- use_module(library(solution_sequences)). 45:- use_module(library(edinburgh), [debug/0]). 46:- use_module(library(pengines_io), [pengine_io_predicate/1]). 47:- use_module(library(sandbox), []). 48:- use_module(library(prolog_clause)). 49:- use_module(library(prolog_breakpoints)). 50:- use_module(library(http/term_html)). 51:- use_module(library(http/html_write)). 52 53:- use_module(storage). 54 55:- if(current_setting(swish:debug_info)). 56:- set_setting(swish:debug_info, true). 57:- endif. 58 59:- set_prolog_flag(generate_debug_info, false). 60 61:- meta_predicate 62 '$swish wrapper'(, ).
69:- multifile 70 user:prolog_trace_interception/4, 71 user:message_hook/3. 72 73user:message_hook(trace_mode(_), _, _) :- 74 pengine_self(_), !. 75 76user:prolog_trace_interception(Port, Frame, _CHP, Action) :- 77 pengine_self(Pengine), 78 prolog_frame_attribute(Frame, predicate_indicator, PI), 79 debug(trace, 'HOOK: ~p ~p', [Port, PI]), 80 pengine_property(Pengine, module(Module)), 81 wrapper_frame(Frame, WrapperFrame), 82 debug(trace, 'Me: ~p, wrapper: ~p', [Frame, WrapperFrame]), 83 prolog_frame_attribute(WrapperFrame, level, WrapperDepth), 84 prolog_frame_attribute(Frame, goal, Goal0), 85 prolog_frame_attribute(Frame, level, Depth0), 86 Depth is Depth0 - WrapperDepth - 1, 87 unqualify(Goal0, Module, Goal), 88 debug(trace, '[~d] ~w: Goal ~p', [Depth0, Port, Goal]), 89 term_html(Goal, GoalString), 90 functor(Port, PortName, _), 91 Prompt0 = _{type: trace, 92 port: PortName, 93 depth: Depth, 94 goal: GoalString, 95 pengine: Pengine 96 }, 97 add_context(Port, Frame, Prompt0, Prompt1), 98 add_source(Port, Frame, Prompt1, Prompt), 99 pengine_input(Prompt, Reply), 100 trace_action(Reply, Port, Frame, Action), !, 101 debug(trace, 'Action: ~p --> ~p', [Reply, Action]). 102user:prolog_trace_interception(Port, Frame0, _CHP, nodebug) :- 103 pengine_self(_), 104 prolog_frame_attribute(Frame0, goal, Goal), 105 prolog_frame_attribute(Frame0, level, Depth), 106 debug(trace, '[~d] ~w: Goal ~p --> NODEBUG', [Depth, Port, Goal]). 107 108trace_action(continue, _Port, Frame, continue) :- 109 pengine_self(Me), 110 prolog_frame_attribute(Frame, predicate_indicator, Me:Name/Arity), 111 functor(Head, Name, Arity), 112 \+ pengine_io_predicate(Head), !, 113 prolog_skip_level(_, very_deep), 114 debug(trace, '~p', [Me:Name/Arity]). 115trace_action(continue, Port, _, skip) :- 116 box_enter(Port), !. 117trace_action(continue, _, _, continue) :- 118 prolog_skip_level(_, very_deep). 119trace_action(nodebug, _, _, nodebug). 120trace_action(skip, _, _, skip). 121trace_action(retry, _, _, retry). 122trace_action(up , _, _, up). 123trace_action(abort, _, _, abort). 124trace_action(nodebug(Breakpoints), _, _, Action) :- 125 catch(update_breakpoints(Breakpoints), E, 126 print_message(warning, E)), 127 ( Breakpoints == [] 128 -> Action = nodebug 129 ; Action = continue, 130 notrace 131 ). 132 133box_enter(call). 134box_enter(redo(_)). 135 136wrapper_frame(Frame0, Frame) :- 137 parent_frame(Frame0, Frame), 138 prolog_frame_attribute(Frame, predicate_indicator, PI), 139 debug(trace, 'Parent: ~p', [PI]), 140 ( PI == swish_call/1 141 -> true 142 ; PI == swish_trace:swish_call/1 143 ), !. 144 145parent_frame(Frame, Frame). 146parent_frame(Frame, Parent) :- 147 prolog_frame_attribute(Frame, parent, Parent0), 148 parent_frame(Parent0, Parent). 149 150unqualify(M:G, M, G) :- !. 151unqualify(system:G, _, G) :- !. 152unqualify(user:G, _, G) :- !. 153unqualify(G, _, G). 154 155term_html(Term, HTMlString) :- 156 pengine_self(Pengine), 157 pengine_property(Pengine, module(Module)), 158 phrase(html(\term(Term, 159 [ module(Module), 160 quoted(true) 161 ])), Tokens), 162 with_output_to(string(HTMlString), print_html(Tokens)).
169add_context(exception(Exception0), _Frame, Prompt0, Prompt) :- 170 strip_stack(Exception0, Exception), 171 message_to_string(Exception, Msg), !, 172 debug(trace, 'Msg = ~s', [Msg]), 173 ( term_html(Exception, String) 174 -> Ex = json{term_html:String, message:Msg} 175 ; Ex = json{message:Msg} 176 ), 177 Prompt = Prompt0.put(exception, Ex). 178add_context(_, _, Prompt, Prompt). 179 180strip_stack(error(Error, context(prolog_stack(S), Msg)), 181 error(Error, context(_, Msg))) :- 182 nonvar(S). 183strip_stack(Error, Error).
192:- meta_predicate swish_call(). 193 194'$swish wrapper'(Goal, '$residuals'(Residuals)) :- 195 catch(swish_call(), E, throw(E)), 196 deterministic(Det), 197 ( tracing, 198 Det == false 199 -> ( notrace, 200 debug(trace, 'Saved tracer', []) 201 ; debug(trace, 'Restoring tracer', []), 202 trace, 203 fail 204 ) 205 ; notrace 206 ), 207 Goal = M:_, 208 residuals(M, Residuals). 209 210swish_call(Goal) :- 211 , 212 no_lco. 213 214no_lco. 215 216:- '$hide'(swish_call/1). 217:- '$hide'(no_lco/0).
library(pengines_io).
This relies on the SWI-Prolog 7.3.14 residual goal extension.
230:- if(current_predicate(prolog:residual_goals//0)). 231residuals(TypeIn, Goals) :- 232 phrase(prolog:residual_goals, Goals0), 233 maplist(unqualify_residual(TypeIn), Goals0, Goals). 234 235unqualify_residual(M, M:G, G) :- !. 236unqualify_residual(T, M:G, G) :- 237 predicate_property(T:G, imported_from(M)), !. 238unqualify_residual(_, G, G). 239:- else. 240residuals(_, []). 241:- endif. 242 243 244 /******************************* 245 * SOURCE LOCATION * 246 *******************************/ 247 248add_source(Port, Frame, Prompt0, Prompt) :- 249 debug(trace(line), 'Add source?', []), 250 source_location(Frame, Port, Location), !, 251 Prompt = Prompt0.put(source, Location), 252 debug(trace(line), 'Source ~p ~p: ~p', [Port, Frame, Location]). 253add_source(_, _, Prompt, Prompt).
265source_location(Frame, Port, Location) :-
266 parent_frame(Frame, Port, _Steps, ShowFrame, PC),
267 ( clause_position(PC)
268 -> true % real PC
269 ; prolog_frame_attribute(ShowFrame, parent, Parent),
270 frame_file(Parent, ParentFile),
271 \+ pengine_file(ParentFile)
272 ),
273 ( debugging(trace(file))
274 -> prolog_frame_attribute(ShowFrame, level, Level),
275 prolog_frame_attribute(ShowFrame, predicate_indicator, PI),
276 debug(trace(file), '\t[~d]: ~p', [Level, PI])
277 ; true
278 ),
279 frame_file(ShowFrame, File),
280 pengine_file(File), !,
281 source_position(ShowFrame, PC, Location).289parent_frame(Frame0, Port0, Steps, Frame, Port) :- 290 parent_frame(Frame0, Port0, 0, Steps, Frame, Port). 291 292parent_frame(Frame, Port, Steps, Steps, Frame, Port). 293parent_frame(Frame, _Port, Steps0, Steps, Parent, PC) :- 294 direct_parent_frame(Frame, DirectParent, ParentPC), 295 Steps1 is Steps0+1, 296 parent_frame(DirectParent, ParentPC, Steps1, Steps, Parent, PC). 297 298direct_parent_frame(Frame, Parent, PC) :- 299 prolog_frame_attribute(Frame, parent, Parent), 300 prolog_frame_attribute(Frame, pc, PC).
308frame_file(Frame, File) :- 309 prolog_frame_attribute(Frame, clause, ClauseRef), !, 310 ( clause_property(ClauseRef, predicate(system:'<meta-call>'/1)) 311 -> prolog_frame_attribute(Frame, parent, Parent), 312 frame_file(Parent, File) 313 ; clause_property(ClauseRef, file(File)) 314 ). 315frame_file(Frame, File) :- 316 prolog_frame_attribute(Frame, goal, Goal), 317 qualify(Goal, QGoal), 318 \+ predicate_property(QGoal, foreign), 319 clause(QGoal, _Body, ClauseRef), !, 320 clause_property(ClauseRef, file(File)).
327pengine_file(File) :- 328 sub_atom(File, 0, _, _, 'pengine://'), !. 329pengine_file(File) :- 330 sub_atom(File, 0, _, _, 'swish://').
336clause_position(PC) :- integer(PC), !. 337clause_position(exit). 338clause_position(unify). 339clause_position(choice(_)).
347subgoal_position(ClauseRef, PortOrPC, _, _, _) :- 348 debugging(trace(save_pc)), 349 debug(trace(save_pc), 'Position for ~p at ~p', [ClauseRef, PortOrPC]), 350 asserta(subgoal_position(ClauseRef, PortOrPC)), 351 fail. 352subgoal_position(ClauseRef, unify, File, CharA, CharZ) :- !, 353 clause_info(ClauseRef, File, TPos, _), 354 head_pos(ClauseRef, TPos, PosTerm), 355 nonvar(PosTerm), 356 arg(1, PosTerm, CharA), 357 arg(2, PosTerm, CharZ). 358subgoal_position(ClauseRef, choice(CHP), File, CharA, CharZ) :- !, 359 ( prolog_choice_attribute(CHP, type, jump), 360 prolog_choice_attribute(CHP, pc, To) 361 -> debug(gtrace(position), 'Term-position: choice-jump to ~w', [To]), 362 subgoal_position(ClauseRef, To, File, CharA, CharZ) 363 ; clause_end(ClauseRef, File, CharA, CharZ) 364 ). 365subgoal_position(ClauseRef, Port, File, CharA, CharZ) :- 366 end_port(Port), !, 367 clause_end(ClauseRef, File, CharA, CharZ). 368subgoal_position(ClauseRef, PC, File, CharA, CharZ) :- 369 debug(trace(source), 'In clause ~p at ~p', [ClauseRef, PC]), 370 clause_info(ClauseRef, File, TPos, _), 371 ( '$clause_term_position'(ClauseRef, PC, List) 372 -> debug(trace(source), 'Term-position: for ref=~w at PC=~w: ~w', 373 [ClauseRef, PC, List]), 374 ( find_subgoal(List, TPos, PosTerm) 375 -> true 376 ; PosTerm = TPos, 377 debug(trace(source), 378 'Clause source-info could not be parsed', []), 379 fail 380 ), 381 nonvar(PosTerm), 382 arg(1, PosTerm, CharA), 383 arg(2, PosTerm, CharZ) 384 ; debug(trace(source), 385 'No clause-term-position for ref=~p at PC=~p', 386 [ClauseRef, PC]), 387 fail 388 ). 389 390end_port(exit). 391end_port(fail). 392end_port(exception). 393 394clause_end(ClauseRef, File, CharA, CharZ) :- 395 clause_info(ClauseRef, File, TPos, _), 396 nonvar(TPos), 397 arg(2, TPos, CharA), 398 CharZ is CharA + 1. 399 400head_pos(Ref, Pos, HPos) :- 401 clause_property(Ref, fact), !, 402 HPos = Pos. 403head_pos(_, term_position(_, _, _, _, [HPos,_]), HPos). 404 405% warning, ((a,b),c)) --> compiled to (a, (b, c))!!! We try to correct 406% that in clause.pl. This is work in progress. 407 408find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :- 409 nth1(A, PosL, Pos), !, 410 find_subgoal(T, Pos, SPos). 411find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :- !, 412 find_subgoal(T, Pos, SPos). 413find_subgoal(_, Pos, Pos). 414 415 416%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 417% Extracted from show_source/2 from library(trace/trace)
424source_position(Frame, PC, _{file:File, from:CharA, to:CharZ}) :- 425 debug(trace(pos), '~p', [source_position(Frame, PC, _)]), 426 clause_position(PC), 427 prolog_frame_attribute(Frame, clause, ClauseRef), !, 428 subgoal_position(ClauseRef, PC, File, CharA, CharZ). 429source_position(Frame, _PC, Position) :- 430 prolog_frame_attribute(Frame, goal, Goal), 431 qualify(Goal, QGoal), 432 \+ predicate_property(QGoal, foreign), 433 ( clause(QGoal, _Body, ClauseRef) 434 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ), 435 Position = _{file:File, from:CharA, to:CharZ} 436 ; functor(Goal, Functor, Arity), 437 functor(GoalTemplate, Functor, Arity), 438 qualify(GoalTemplate, QGoalTemplate), 439 clause(QGoalTemplate, _TBody, ClauseRef) 440 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ), 441 Position = _{file:File, from:CharA, to:CharZ} 442 ; find_source(QGoal, File, Line), 443 debug(trace(source), 'At ~w:~d', [File, Line]), 444 Position = _{file:File, line:Line} 445 ). 446 447qualify(Goal, Goal) :- 448 functor(Goal, :, 2), !. 449qualify(Goal, user:Goal). 450 451find_source(Predicate, File, Line) :- 452 predicate_property(Predicate, file(File)), 453 predicate_property(Predicate, line_count(Line)), !.
breakpoints(List) option to set breakpoints prior to
execution of the query. If breakpoints are present and enabled,
the goal is executed in debug mode. List is a list, holding a
dict for each source that has breakpoints. The dict contains
these keys:
file is the source file. For the current Pengine source
this is pengine://<pengine>/src.breakpoints is a list of lines (integers) where to put
break points.468:- multifile pengines:prepare_goal/3. 469 470penginesprepare_goal(Goal0, Goal, Options) :- 471 option(breakpoints(Breakpoints), Options), 472 Breakpoints \== [], 473 pengine_self(Pengine), 474 pengine_property(Pengine, source(File, Text)), 475 maplist(set_file_breakpoints(Pengine, File, Text), Breakpoints), 476 Goal = (debug, Goal0). 477 478set_file_breakpoints(_Pengine, PFile, Text, Dict) :- 479 debug(trace(break), 'Set breakpoints at ~p', [Dict]), 480 _{file:FileS, breakpoints:List} :< Dict, 481 atom_string(File, FileS), 482 ( PFile == File 483 -> debug(trace(break), 'Pengine main source', []), 484 maplist(set_pengine_breakpoint(File, File, Text), List) 485 ; source_file_property(PFile, includes(File, _Time)), 486 atom_concat('swish://', StoreFile, File) 487 -> debug(trace(break), 'Pengine included source ~p', [StoreFile]), 488 storage_file(StoreFile, IncludedText, _Meta), 489 maplist(set_pengine_breakpoint(PFile, File, IncludedText), List) 490 ; debug(trace(break), 'Not in included source', []) 491 ). 492 493set_pengine_breakpoint(Owner, File, Text, Line) :- 494 debug(trace(break), 'Try break at ~q:~d', [File, Line]), 495 line_start(Line, Text, Char), 496 ( set_breakpoint(Owner, File, Line, Char, Break) 497 -> !, debug(trace(break), 'Created breakpoint ~p', [Break]) 498 ; print_message(warning, breakpoint(failed(File, Line, 0))) 499 ). 500 501line_start(1, _, 0) :- !. 502line_start(N, Text, Start) :- 503 N0 is N - 2, 504 offset(N0, sub_string(Text, Start, _, _, '\n')), !.
511update_breakpoints(Breakpoints) :- 512 breakpoint_by_file(Breakpoints, NewBPS), 513 pengine_self(Pengine), 514 pengine_property(Pengine, source(PFile, Text)), 515 current_pengine_source_breakpoints(PFile, ByFile), 516 forall(( member(File-FBPS, ByFile), 517 member(Id-Line, FBPS), 518 \+ ( member(File-NFBPS, NewBPS), 519 member(Line, NFBPS))), 520 delete_breakpoint(Id)), 521 forall(( member(File-NFBPS, NewBPS), 522 member(Line, NFBPS), 523 \+ ( member(File-FBPS, ByFile), 524 member(_-Line, FBPS))), 525 add_breakpoint(PFile, File, Text, Line)). 526 527breakpoint_by_file(Breakpoints, NewBPS) :- 528 maplist(bp_by_file, Breakpoints, NewBPS). 529 530bp_by_file(Dict, File-Lines) :- 531 _{file:FileS, breakpoints:Lines} :< Dict, 532 atom_string(File, FileS). 533 534add_breakpoint(PFile, PFile, Text, Line) :- !, 535 set_pengine_breakpoint(PFile, PFile, Text, Line). 536add_breakpoint(PFile, File, _Text, Line) :- 537 atom_concat('swish://', Store, File), !, 538 storage_file(Store, Text, _Meta), 539 set_pengine_breakpoint(PFile, File, Text, Line). 540add_breakpoint(_, _, _, _Line). % not in our files.
548current_pengine_source_breakpoints(PFile, ByFile) :- 549 findall(Pair, current_pengine_breakpoint(PFile, Pair), Pairs0), 550 keysort(Pairs0, Pairs), 551 group_pairs_by_key(Pairs, ByFile). 552 553current_pengine_breakpoint(PFile, PFile-(Id-Line)) :- 554 breakpoint_property(Id, file(PFile)), 555 breakpoint_property(Id, line_count(Line)). 556current_pengine_breakpoint(PFile, File-(Id-Line)) :- 557 source_file_property(PFile, includes(File, _Time)), 558 breakpoint_property(Id, file(File)), 559 breakpoint_property(Id, line_count(Line)).
566:- multifile prolog_clause:open_source/2. 567 568prolog_clauseopen_source(File, Stream) :- 569 sub_atom(File, 0, _, _, 'pengine://'), !, 570 ( pengine_self(Pengine) 571 -> true 572 ; debugging(trace(_)) 573 ), 574 pengine_property(Pengine, source(File, Source)), 575 open_string(Source, Stream). 576prolog_clauseopen_source(File, Stream) :- 577 atom_concat('swish://', GittyFile, File), !, 578 storage_file(GittyFile, Data, _Meta), 579 open_string(Data, Stream). 580 581 582 /******************************* 583 * TRAP EXCEPTIONS * 584 *******************************/ 585 586:- dynamic 587 user:prolog_exception_hook/4, 588 installed/1. 589 590exception_hook(Ex, Ex, _Frame, Catcher) :- 591 Catcher \== none, 592 Catcher \== 'C', 593 prolog_frame_attribute(Catcher, predicate_indicator, PI), 594 debug(trace(exception), 'Ex: ~p, catcher: ~p', [Ex, PI]), 595 PI == '$swish wrapper'/1, 596 trace, 597 fail.
603install_exception_hook :- 604 installed(Ref), 605 ( nth_clause(_, I, Ref) 606 -> I == 1, ! % Ok, we are the first 607 ; retractall(installed(Ref)), 608 erase(Ref), % Someone before us! 609 fail 610 ). 611install_exception_hook :- 612 asserta((user:prolog_exception_hook(Ex, Out, Frame, Catcher) :- 613 exception_hook(Ex, Out, Frame, Catcher)), Ref), 614 assert(installed(Ref)). 615 616:- install_exception_hook. 617 618 619 /******************************* 620 * ALLOW DEBUGGING * 621 *******************************/ 622 623:- multifile 624 sandbox:safe_primitive/1. 625 626sandbox:safe_primitive(system:trace). 627sandbox:safe_primitive(system:notrace). 628sandbox:safe_primitive(system:tracing). 629sandbox:safe_primitive(edinburgh:debug). 630sandbox:safe_primitive(system:deterministic(_)). 631sandbox:safe_primitive(swish_trace:residuals(_,_)). 632 633 634 /******************************* 635 * MESSAGES * 636 *******************************/ 637 638:- multifile 639 prolog:message/3. 640 641prologmessage(breakpoint(failed(File, Line, _Char))) --> 642 [ 'Failed to set breakpoint at ~w:~d'-[File,Line] ]
Allow tracing pengine execution under SWISH. */