34
35:- module(swish_trace,
36 [ '$swish wrapper'/2 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:- use_module(config). 55
56:- if(current_setting(swish:debug_info)). 57:- set_setting(swish:debug_info, true). 58:- endif. 59
60:- set_prolog_flag(generate_debug_info, false). 61
62:- meta_predicate
63 '$swish wrapper'(0, -). 64
69
70:- multifile
71 user:prolog_trace_interception/4,
72 user:message_hook/3. 73
74user:message_hook(trace_mode(_), _, _) :-
75 pengine_self(_), !.
76
85
86:- dynamic
87 trace_pengines/0. 88
89trace_pengines.
90
91user:prolog_trace_interception(Port, Frame, _CHP, Action) :-
92 trace_pengines,
93 pengine_self(Pengine),
94 prolog_frame_attribute(Frame, predicate_indicator, PI),
95 debug(trace, 'HOOK: ~p ~p', [Port, PI]),
96 pengine_property(Pengine, module(Module)),
97 wrapper_frame(Frame, WrapperFrame),
98 debug(trace, 'Me: ~p, wrapper: ~p', [Frame, WrapperFrame]),
99 prolog_frame_attribute(WrapperFrame, level, WrapperDepth),
100 prolog_frame_attribute(Frame, goal, Goal0),
101 prolog_frame_attribute(Frame, level, Depth0),
102 Depth is Depth0 - WrapperDepth - 1,
103 unqualify(Goal0, Module, Goal),
104 debug(trace, '[~d] ~w: Goal ~p', [Depth0, Port, Goal]),
105 term_html(Goal, GoalString),
106 functor(Port, PortName, _),
107 Prompt0 = _{type: trace,
108 port: PortName,
109 depth: Depth,
110 goal: GoalString,
111 pengine: Pengine
112 },
113 add_context(Port, Frame, Prompt0, Prompt1),
114 add_source(Port, Frame, Prompt1, Prompt),
115 pengine_input(Prompt, Reply),
116 trace_action(Reply, Port, Frame, Action), !,
117 debug(trace, 'Action: ~p --> ~p', [Reply, Action]).
118user:prolog_trace_interception(Port, Frame0, _CHP, nodebug) :-
119 trace_pengines,
120 pengine_self(_),
121 prolog_frame_attribute(Frame0, goal, Goal),
122 prolog_frame_attribute(Frame0, level, Depth),
123 debug(trace, '[~d] ~w: Goal ~p --> NODEBUG', [Depth, Port, Goal]).
124
125trace_action(continue, _Port, Frame, continue) :-
126 pengine_self(Me),
127 prolog_frame_attribute(Frame, predicate_indicator, Me:Name/Arity),
128 functor(Head, Name, Arity),
129 \+ pengine_io_predicate(Head), !,
130 prolog_skip_level(_, very_deep),
131 debug(trace, '~p', [Me:Name/Arity]).
132trace_action(continue, Port, _, skip) :-
133 box_enter(Port), !.
134trace_action(continue, _, _, continue) :-
135 prolog_skip_level(_, very_deep).
136trace_action(nodebug, _, _, nodebug).
137trace_action(skip, _, _, skip).
138trace_action(retry, _, _, retry).
139trace_action(up , _, _, up).
140trace_action(abort, _, _, abort).
141trace_action(nodebug(Breakpoints), _, _, Action) :-
142 catch(update_breakpoints(Breakpoints), E,
143 print_message(warning, E)),
144 ( Breakpoints == []
145 -> Action = nodebug
146 ; Action = continue,
147 notrace
148 ).
149
150box_enter(call).
151box_enter(redo(_)).
152
153wrapper_frame(Frame0, Frame) :-
154 parent_frame(Frame0, Frame),
155 prolog_frame_attribute(Frame, predicate_indicator, PI),
156 debug(trace, 'Parent: ~p', [PI]),
157 ( PI == swish_call/1
158 -> true
159 ; PI == swish_trace:swish_call/1
160 ), !.
161
162parent_frame(Frame, Frame).
163parent_frame(Frame, Parent) :-
164 prolog_frame_attribute(Frame, parent, Parent0),
165 parent_frame(Parent0, Parent).
166
167unqualify(M:G, M, G) :- !.
168unqualify(system:G, _, G) :- !.
169unqualify(user:G, _, G) :- !.
170unqualify(G, _, G).
171
172term_html(Term, HTMlString) :-
173 pengine_self(Pengine),
174 pengine_property(Pengine, module(Module)),
175 phrase(html(\term(Term,
176 [ module(Module),
177 quoted(true)
178 ])), Tokens),
179 with_output_to(string(HTMlString), print_html(Tokens)).
180
185
186add_context(exception(Exception0), _Frame, Prompt0, Prompt) :-
187 strip_stack(Exception0, Exception),
188 message_to_string(Exception, Msg), !,
189 debug(trace, 'Msg = ~s', [Msg]),
190 ( term_html(Exception, String)
191 -> Ex = json{term_html:String, message:Msg}
192 ; Ex = json{message:Msg}
193 ),
194 Prompt = Prompt0.put(exception, Ex).
195add_context(_, _, Prompt, Prompt).
196
197strip_stack(error(Error, context(prolog_stack(S), Msg)),
198 error(Error, context(_, Msg))) :-
199 nonvar(S).
200strip_stack(Error, Error).
201
217
218:- meta_predicate swish_call(0). 219
220'$swish wrapper'(Goal, Extra) :-
221 ( nb_current('$variable_names', Bindings)
222 -> true
223 ; Bindings = []
224 ),
225 debug(projection, 'Pre-context-pre ~p, extra=~p', [Bindings, Extra]),
226 maplist(call_pre_context(Goal, Bindings), Extra),
227 debug(projection, 'Pre-context-post ~p, extra=~p', [Bindings, Extra]),
228 catch(swish_call(Goal), E, throw(E)),
229 deterministic(Det),
230 ( tracing,
231 Det == false
232 -> ( notrace,
233 debug(trace, 'Saved tracer', [])
234 ; debug(trace, 'Restoring tracer', []),
235 trace,
236 fail
237 )
238 ; notrace
239 ),
240 maplist(call_post_context(Goal, Bindings), Extra).
241
242swish_call(Goal) :-
243 Goal,
244 no_lco.
245
246no_lco.
247
248:- '$hide'(swish_call/1). 249:- '$hide'(no_lco/0). 250
258
259:- multifile
260 pre_context/3,
261 post_context/3. 262
263call_pre_context(Goal, Bindings, Var) :-
264 binding(Bindings, Var, Name),
265 pre_context(Name, Goal, Var), !.
266call_pre_context(_, _, _).
267
268
269call_post_context(Goal, Bindings, Var) :-
270 binding(Bindings, Var, Name),
271 post_context(Name, Goal, Var), !.
272call_post_context(_, _, _).
273
274post_context(Name, M:_Goal, '$residuals'(Residuals)) :-
275 swish_config(residuals_var, Name),
276 residuals(M, Residuals).
277
278binding([Name=Var|_], V, Name) :-
279 Var == V, !.
280binding([_|Bindings], V, Name) :-
281 binding(Bindings, V, Name).
282
283
291
292residuals(TypeIn, Goals) :-
293 phrase(prolog:residual_goals, Goals0),
294 maplist(unqualify_residual(TypeIn), Goals0, Goals).
295
296unqualify_residual(M, M:G, G) :- !.
297unqualify_residual(T, M:G, G) :-
298 predicate_property(T:G, imported_from(M)), !.
299unqualify_residual(_, G, G).
300
301
302 305
306add_source(Port, Frame, Prompt0, Prompt) :-
307 debug(trace(line), 'Add source?', []),
308 source_location(Frame, Port, Location), !,
309 Prompt = Prompt0.put(source, Location),
310 debug(trace(line), 'Source ~p ~p: ~p', [Port, Frame, Location]).
311add_source(_, _, Prompt, Prompt).
312
322
323source_location(Frame, Port, Location) :-
324 parent_frame(Frame, Port, _Steps, ShowFrame, PC),
325 ( clause_position(PC)
326 -> true 327 ; prolog_frame_attribute(ShowFrame, parent, Parent),
328 frame_file(Parent, ParentFile),
329 \+ pengine_file(ParentFile)
330 ),
331 ( debugging(trace(file))
332 -> prolog_frame_attribute(ShowFrame, level, Level),
333 prolog_frame_attribute(ShowFrame, predicate_indicator, PI),
334 debug(trace(file), '\t[~d]: ~p', [Level, PI])
335 ; true
336 ),
337 frame_file(ShowFrame, File),
338 pengine_file(File), !,
339 source_position(ShowFrame, PC, Location).
340
346
347parent_frame(Frame0, Port0, Steps, Frame, Port) :-
348 parent_frame(Frame0, Port0, 0, Steps, Frame, Port).
349
350parent_frame(Frame, Port, Steps, Steps, Frame, Port).
351parent_frame(Frame, _Port, Steps0, Steps, Parent, PC) :-
352 direct_parent_frame(Frame, DirectParent, ParentPC),
353 Steps1 is Steps0+1,
354 parent_frame(DirectParent, ParentPC, Steps1, Steps, Parent, PC).
355
356direct_parent_frame(Frame, Parent, PC) :-
357 prolog_frame_attribute(Frame, parent, Parent),
358 prolog_frame_attribute(Frame, pc, PC).
359
360
365
366frame_file(Frame, File) :-
367 prolog_frame_attribute(Frame, clause, ClauseRef), !,
368 ( clause_property(ClauseRef, predicate(system:'<meta-call>'/1))
369 -> prolog_frame_attribute(Frame, parent, Parent),
370 frame_file(Parent, File)
371 ; clause_property(ClauseRef, file(File))
372 ).
373frame_file(Frame, File) :-
374 prolog_frame_attribute(Frame, goal, Goal),
375 qualify(Goal, QGoal),
376 \+ predicate_property(QGoal, foreign),
377 clause(QGoal, _Body, ClauseRef), !,
378 clause_property(ClauseRef, file(File)).
379
384
385pengine_file(File) :-
386 sub_atom(File, 0, _, _, 'pengine://'), !.
387pengine_file(File) :-
388 sub_atom(File, 0, _, _, 'swish://').
389
393
394clause_position(PC) :- integer(PC), !.
395clause_position(exit).
396clause_position(unify).
397clause_position(choice(_)).
398
404
405subgoal_position(ClauseRef, PortOrPC, _, _, _) :-
406 debugging(trace(save_pc)),
407 debug(trace(save_pc), 'Position for ~p at ~p', [ClauseRef, PortOrPC]),
408 asserta(subgoal_position(ClauseRef, PortOrPC)),
409 fail.
410subgoal_position(ClauseRef, unify, File, CharA, CharZ) :- !,
411 clause_info(ClauseRef, File, TPos, _),
412 head_pos(ClauseRef, TPos, PosTerm),
413 nonvar(PosTerm),
414 arg(1, PosTerm, CharA),
415 arg(2, PosTerm, CharZ).
416subgoal_position(ClauseRef, choice(CHP), File, CharA, CharZ) :- !,
417 ( prolog_choice_attribute(CHP, type, jump),
418 prolog_choice_attribute(CHP, pc, To)
419 -> debug(gtrace(position), 'Term-position: choice-jump to ~w', [To]),
420 subgoal_position(ClauseRef, To, File, CharA, CharZ)
421 ; clause_end(ClauseRef, File, CharA, CharZ)
422 ).
423subgoal_position(ClauseRef, Port, File, CharA, CharZ) :-
424 end_port(Port), !,
425 clause_end(ClauseRef, File, CharA, CharZ).
426subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
427 debug(trace(source), 'In clause ~p at ~p', [ClauseRef, PC]),
428 clause_info(ClauseRef, File, TPos, _),
429 ( '$clause_term_position'(ClauseRef, PC, List)
430 -> debug(trace(source), 'Term-position: for ref=~w at PC=~w: ~w',
431 [ClauseRef, PC, List]),
432 ( find_subgoal(List, TPos, PosTerm)
433 -> true
434 ; PosTerm = TPos,
435 debug(trace(source),
436 'Clause source-info could not be parsed', []),
437 fail
438 ),
439 nonvar(PosTerm),
440 arg(1, PosTerm, CharA),
441 arg(2, PosTerm, CharZ)
442 ; debug(trace(source),
443 'No clause-term-position for ref=~p at PC=~p',
444 [ClauseRef, PC]),
445 fail
446 ).
447
448end_port(exit).
449end_port(fail).
450end_port(exception).
451
452clause_end(ClauseRef, File, CharA, CharZ) :-
453 clause_info(ClauseRef, File, TPos, _),
454 nonvar(TPos),
455 arg(2, TPos, CharA),
456 CharZ is CharA + 1.
457
458head_pos(Ref, Pos, HPos) :-
459 clause_property(Ref, fact), !,
460 HPos = Pos.
461head_pos(_, term_position(_, _, _, _, [HPos,_]), HPos).
462
465
466find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
467 nth1(A, PosL, Pos), !,
468 find_subgoal(T, Pos, SPos).
469find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :- !,
470 find_subgoal(T, Pos, SPos).
471find_subgoal(_, Pos, Pos).
472
473
476
481
482source_position(Frame, PC, _{file:File, from:CharA, to:CharZ}) :-
483 debug(trace(pos), '~p', [source_position(Frame, PC, _)]),
484 clause_position(PC),
485 prolog_frame_attribute(Frame, clause, ClauseRef), !,
486 subgoal_position(ClauseRef, PC, File, CharA, CharZ).
487source_position(Frame, _PC, Position) :-
488 prolog_frame_attribute(Frame, goal, Goal),
489 qualify(Goal, QGoal),
490 \+ predicate_property(QGoal, foreign),
491 ( clause(QGoal, _Body, ClauseRef)
492 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ),
493 Position = _{file:File, from:CharA, to:CharZ}
494 ; functor(Goal, Functor, Arity),
495 functor(GoalTemplate, Functor, Arity),
496 qualify(GoalTemplate, QGoalTemplate),
497 clause(QGoalTemplate, _TBody, ClauseRef)
498 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ),
499 Position = _{file:File, from:CharA, to:CharZ}
500 ; find_source(QGoal, File, Line),
501 debug(trace(source), 'At ~w:~d', [File, Line]),
502 Position = _{file:File, line:Line}
503 ).
504
505qualify(Goal, Goal) :-
506 functor(Goal, :, 2), !.
507qualify(Goal, user:Goal).
508
509find_source(Predicate, File, Line) :-
510 predicate_property(Predicate, file(File)),
511 predicate_property(Predicate, line_count(Line)), !.
512
525
526:- multifile pengines:prepare_goal/3. 527
528pengines:prepare_goal(Goal0, Goal, Options) :-
529 forall(set_screen_property(Options), true),
530 option(breakpoints(Breakpoints), Options),
531 Breakpoints \== [],
532 pengine_self(Pengine),
533 pengine_property(Pengine, source(File, Text)),
534 maplist(set_file_breakpoints(Pengine, File, Text), Breakpoints),
535 Goal = (debug, Goal0).
536
542
543set_screen_property(Options) :-
544 pengine_self(Pengine),
545 screen_property(Property),
546 option(Property, Options),
547 assertz(Pengine:screen_property(Property)).
548
549screen_property(height(_)).
550screen_property(width(_)).
551screen_property(rows(_)).
552screen_property(cols(_)).
553
559
560swish:tty_size(Rows, Cols) :-
561 pengine_self(Pengine),
562 current_predicate(Pengine:screen_property/1), !,
563 Pengine:screen_property(rows(Rows)),
564 Pengine:screen_property(cols(Cols)).
565swish:tty_size(24, 80).
566
570
571set_file_breakpoints(_Pengine, PFile, Text, Dict) :-
572 debug(trace(break), 'Set breakpoints at ~p', [Dict]),
573 _{file:FileS, breakpoints:List} :< Dict,
574 atom_string(File, FileS),
575 ( PFile == File
576 -> debug(trace(break), 'Pengine main source', []),
577 maplist(set_pengine_breakpoint(File, File, Text), List)
578 ; source_file_property(PFile, includes(File, _Time)),
579 atom_concat('swish://', StoreFile, File)
580 -> debug(trace(break), 'Pengine included source ~p', [StoreFile]),
581 storage_file(StoreFile, IncludedText, _Meta),
582 maplist(set_pengine_breakpoint(PFile, File, IncludedText), List)
583 ; debug(trace(break), 'Not in included source', [])
584 ).
585
589
590set_pengine_breakpoint(Owner, File, Text, Line) :-
591 debug(trace(break), 'Try break at ~q:~d', [File, Line]),
592 line_start(Line, Text, Char),
593 ( set_breakpoint(Owner, File, Line, Char, _0Break)
594 -> !, debug(trace(break), 'Created breakpoint ~p', [_0Break])
595 ; print_message(warning, breakpoint(failed(File, Line, 0)))
596 ).
597
598line_start(1, _, 0) :- !.
599line_start(N, Text, Start) :-
600 N0 is N - 2,
601 offset(N0, sub_string(Text, Start, _, _, '\n')), !.
602
607
608update_breakpoints(Breakpoints) :-
609 breakpoint_by_file(Breakpoints, NewBPS),
610 pengine_self(Pengine),
611 pengine_property(Pengine, source(PFile, Text)),
612 current_pengine_source_breakpoints(PFile, ByFile),
613 forall(( member(File-FBPS, ByFile),
614 member(Id-Line, FBPS),
615 \+ ( member(File-NFBPS, NewBPS),
616 member(Line, NFBPS))),
617 delete_breakpoint(Id)),
618 forall(( member(File-NFBPS, NewBPS),
619 member(Line, NFBPS),
620 \+ ( member(File-FBPS, ByFile),
621 member(_-Line, FBPS))),
622 add_breakpoint(PFile, File, Text, Line)).
623
624breakpoint_by_file(Breakpoints, NewBPS) :-
625 maplist(bp_by_file, Breakpoints, NewBPS).
626
627bp_by_file(Dict, File-Lines) :-
628 _{file:FileS, breakpoints:Lines} :< Dict,
629 atom_string(File, FileS).
630
631add_breakpoint(PFile, PFile, Text, Line) :- !,
632 set_pengine_breakpoint(PFile, PFile, Text, Line).
633add_breakpoint(PFile, File, _Text, Line) :-
634 atom_concat('swish://', Store, File), !,
635 storage_file(Store, Text, _Meta),
636 set_pengine_breakpoint(PFile, File, Text, Line).
637add_breakpoint(_, _, _, _Line). 638
644
645current_pengine_source_breakpoints(PFile, ByFile) :-
646 findall(Pair, current_pengine_breakpoint(PFile, Pair), Pairs0),
647 keysort(Pairs0, Pairs),
648 group_pairs_by_key(Pairs, ByFile).
649
650current_pengine_breakpoint(PFile, PFile-(Id-Line)) :-
651 breakpoint_property(Id, file(PFile)),
652 breakpoint_property(Id, line_count(Line)).
653current_pengine_breakpoint(PFile, File-(Id-Line)) :-
654 source_file_property(PFile, includes(File, _Time)),
655 breakpoint_property(Id, file(File)),
656 breakpoint_property(Id, line_count(Line)).
657
658
662
663:- multifile prolog_clause:open_source/2. 664
665prolog_clause:open_source(File, Stream) :-
666 sub_atom(File, 0, _, _, 'pengine://'), !,
667 ( pengine_self(Pengine)
668 -> true
669 ; debugging(trace(_))
670 ),
671 pengine_property(Pengine, source(File, Source)),
672 open_string(Source, Stream).
673prolog_clause:open_source(File, Stream) :-
674 atom_concat('swish://', GittyFile, File), !,
675 storage_file(GittyFile, Data, _Meta),
676 open_string(Data, Stream).
677
678
679 682
683:- dynamic
684 user:prolog_exception_hook/4,
685 installed/1. 686
687:- volatile
688 installed/1. 689
690exception_hook(Ex, Ex, _Frame, Catcher) :-
691 Catcher \== none,
692 Catcher \== 'C',
693 prolog_frame_attribute(Catcher, predicate_indicator, PI),
694 debug(trace(exception), 'Ex: ~p, catcher: ~p', [Ex, PI]),
695 PI == '$swish wrapper'/1,
696 trace,
697 fail.
698
702
703install_exception_hook :-
704 installed(Ref),
705 ( nth_clause(_, I, Ref)
706 -> I == 1, ! 707 ; retractall(installed(Ref)),
708 erase(Ref), 709 fail
710 ).
711install_exception_hook :-
712 asserta((user:prolog_exception_hook(Ex, Out, Frame, Catcher) :-
713 exception_hook(Ex, Out, Frame, Catcher)), Ref),
714 assert(installed(Ref)).
715
716:- initialization install_exception_hook. 717
718
719 722
723:- multifile
724 sandbox:safe_primitive/1,
725 sandbox:safe_meta_predicate/1. 726
727sandbox:safe_primitive(system:trace).
728sandbox:safe_primitive(system:notrace).
729sandbox:safe_primitive(system:tracing).
730sandbox:safe_primitive(edinburgh:debug).
731sandbox:safe_primitive(system:deterministic(_)).
732sandbox:safe_primitive(swish_trace:residuals(_,_)).
733sandbox:safe_primitive(swish:tty_size(_Rows, _Cols)).
734
735sandbox:safe_meta_predicate(swish_trace:'$swish wrapper'/2).
736
737
738 741
742:- multifile
743 prolog:message/3. 744
745prolog:message(breakpoint(failed(File, Line, _Char))) -->
746 [ 'Failed to set breakpoint at ~w:~d'-[File,Line] ]