35
36:- module(swish_trace,
37 [ '$swish wrapper'/2 38 ]). 39:- use_module(library(debug)). 40:- use_module(library(prolog_stack)). 41:- use_module(library(settings)). 42:- use_module(library(pengines)). 43:- use_module(library(apply)). 44:- use_module(library(lists)). 45:- use_module(library(option)). 46:- use_module(library(solution_sequences)). 47:- use_module(library(edinburgh), [debug/0]). 48:- use_module(library(pengines_io), [pengine_io_predicate/1]). 49:- use_module(library(sandbox), []). 50:- use_module(library(prolog_clause)). 51:- use_module(library(prolog_breakpoints)). 52:- use_module(library(http/term_html)). 53:- use_module(library(http/html_write)). 54:- if(exists_source(library(wfs))). 55:- use_module(library(wfs)). 56:- endif. 57
58:- use_module(storage). 59:- use_module(config). 60
61:- if(current_setting(swish:debug_info)). 62:- set_setting(swish:debug_info, true). 63:- endif. 64
65:- set_prolog_flag(generate_debug_info, false). 66
67:- meta_predicate
68 '$swish wrapper'(0, -). 69
74
75:- multifile
76 user:prolog_trace_interception/4,
77 user:message_hook/3. 78
79user:message_hook(trace_mode(_), _, _) :-
80 pengine_self(_), !.
81
90
91:- dynamic
92 trace_pengines/0. 93
94trace_pengines.
95
96user:prolog_trace_interception(Port, Frame, CHP, Action) :-
97 trace_pengines,
98 catch(trace_interception(Port, Frame, CHP, Action), E, true),
99 ( var(E)
100 -> true
101 ; abort 102 ).
103
104trace_interception(Port, Frame, _CHP, Action) :-
105 pengine_self(Pengine),
106 prolog_frame_attribute(Frame, predicate_indicator, PI),
107 debug(trace, 'HOOK: ~p ~p', [Port, PI]),
108 pengine_property(Pengine, module(Module)),
109 wrapper_frame(Frame, WrapperFrame),
110 debug(trace, 'Me: ~p, wrapper: ~p', [Frame, WrapperFrame]),
111 prolog_frame_attribute(WrapperFrame, level, WrapperDepth),
112 prolog_frame_attribute(Frame, goal, Goal0),
113 prolog_frame_attribute(Frame, level, Depth0),
114 Depth is Depth0 - WrapperDepth - 1,
115 unqualify(Goal0, Module, Goal),
116 debug(trace, '[~d] ~w: Goal ~p', [Depth0, Port, Goal]),
117 term_html(Goal, GoalString),
118 functor(Port, PortName, _),
119 Prompt0 = _{type: trace,
120 port: PortName,
121 depth: Depth,
122 goal: GoalString,
123 pengine: Pengine
124 },
125 add_context(Port, Frame, Prompt0, Prompt1),
126 add_source(Port, Frame, Prompt1, Prompt),
127 pengine_input(Prompt, Reply),
128 trace_action(Reply, Port, Frame, Action), !,
129 debug(trace, 'Action: ~p --> ~p', [Reply, Action]).
130trace_interception(Port, Frame0, _CHP, nodebug) :-
131 pengine_self(_),
132 prolog_frame_attribute(Frame0, goal, Goal),
133 prolog_frame_attribute(Frame0, level, Depth),
134 debug(trace, '[~d] ~w: Goal ~p --> NODEBUG', [Depth, Port, Goal]).
135
136trace_action(continue, _Port, Frame, continue) :-
137 pengine_self(Me),
138 prolog_frame_attribute(Frame, predicate_indicator, Me:Name/Arity),
139 functor(Head, Name, Arity),
140 \+ pengine_io_predicate(Head), !,
141 prolog_skip_level(_, very_deep),
142 debug(trace, '~p', [Me:Name/Arity]).
143trace_action(continue, Port, _, skip) :-
144 box_enter(Port), !.
145trace_action(continue, _, _, continue) :-
146 prolog_skip_level(_, very_deep).
147trace_action(nodebug, _, _, nodebug).
148trace_action(skip, _, _, skip).
149trace_action(retry, _, _, retry).
150trace_action(up , _, _, up).
151trace_action(abort, _, _, abort).
152trace_action(nodebug(Breakpoints), _, _, Action) :-
153 catch(update_breakpoints(Breakpoints), E,
154 print_message(warning, E)),
155 ( Breakpoints == []
156 -> Action = nodebug
157 ; Action = continue,
158 notrace
159 ).
160
161box_enter(call).
162box_enter(redo(_)).
163
164wrapper_frame(Frame0, Frame) :-
165 parent_frame(Frame0, Frame),
166 prolog_frame_attribute(Frame, predicate_indicator, PI),
167 debug(trace, 'Parent: ~p', [PI]),
168 ( PI == swish_call/1
169 -> true
170 ; PI == swish_trace:swish_call/1
171 ), !.
172
173parent_frame(Frame, Frame).
174parent_frame(Frame, Parent) :-
175 prolog_frame_attribute(Frame, parent, Parent0),
176 parent_frame(Parent0, Parent).
177
178unqualify(M:G, M, G) :- !.
179unqualify(system:G, _, G) :- !.
180unqualify(user:G, _, G) :- !.
181unqualify(G, _, G).
182
183term_html(Term, HTMlString) :-
184 pengine_self(Pengine),
185 pengine_property(Pengine, module(Module)),
186 phrase(html(\term(Term,
187 [ module(Module),
188 quoted(true)
189 ])), Tokens),
190 with_output_to(string(HTMlString), print_html(Tokens)).
191
196
197add_context(exception(Exception0), _Frame, Prompt0, Prompt) :-
198 strip_stack(Exception0, Exception),
199 message_to_string(Exception, Msg), !,
200 debug(trace, 'Msg = ~s', [Msg]),
201 ( term_html(Exception, String)
202 -> Ex = json{term_html:String, message:Msg}
203 ; Ex = json{message:Msg}
204 ),
205 Prompt = Prompt0.put(exception, Ex).
206add_context(_, _, Prompt, Prompt).
207
208strip_stack(error(Error, context(prolog_stack(S), Msg)),
209 error(Error, context(_, Msg))) :-
210 nonvar(S).
211strip_stack(Error, Error).
212
228
229:- meta_predicate swish_call(0). 230
231:- if(\+current_predicate(call_delays/2)). 232:- meta_predicate
233 call_delays(0, :),
234 delays_residual_program(:, :). 235
236call_delays(Goal, _:true) :-
237 call(Goal).
238
239delays_residual_program(_, _:[]).
240:- endif. 241
242'$swish wrapper'(Goal, Extra) :-
243 ( nb_current('$variable_names', Bindings)
244 -> true
245 ; Bindings = []
246 ),
247 debug(projection, 'Pre-context-pre ~p, extra=~p', [Bindings, Extra]),
248 maplist(call_pre_context(Goal, Bindings), Extra),
249 debug(projection, 'Pre-context-post ~p, extra=~p', [Bindings, Extra]),
250 call_delays(catch_with_backtrace(swish_call(Goal),
251 E, throw_backtrace(E)), Delays),
252 deterministic(Det),
253 ( tracing,
254 Det == false
255 -> ( notrace,
256 debug(trace, 'Saved tracer', [])
257 ; debug(trace, 'Restoring tracer', []),
258 trace,
259 fail
260 )
261 ; notrace
262 ),
263 call_post_context(_{goal:Goal, bindings:Bindings,
264 delays:Delays, context:Extra}),
265 maplist(call_post_context(Goal, Bindings, Delays), Extra).
266
267throw_backtrace(error(Formal, context(prolog_stack(Stack0), Msg))) :-
268 append(Stack1, [Guard|_], Stack0),
269 is_guard(Guard),
270 !,
271 last(Stack1, Frame),
272 arg(1, Frame, Level),
273 maplist(re_level(Level), Stack1, Stack),
274 throw(error(Formal, context(prolog_stack(Stack), Msg))).
275throw_backtrace(E) :-
276 throw(E).
277
278re_level(Sub,
279 frame(Level0, Clause, Goal),
280 frame(Level, Clause, Goal)) :-
281 Level is 1 + Level0 - Sub.
282
283is_guard(frame(_Level, _Clause, swish_trace:swish_call(_))).
284
285swish_call(Goal) :-
286 Goal,
287 no_lco.
288
289no_lco.
290
291:- '$hide'(swish_call/1). 292:- '$hide'(no_lco/0). 293
301
302:- multifile
303 pre_context/3,
304 post_context/1,
305 post_context/3,
306 post_context/4. 307
308call_pre_context(Goal, Bindings, Var) :-
309 binding(Bindings, Var, Name),
310 pre_context(Name, Goal, Var), !.
311call_pre_context(_, _, _).
312
314
315call_post_context(Dict) :-
316 post_context(Dict), !.
317call_post_context(_).
318
324
325call_post_context(Goal, Bindings, Delays, Var) :-
326 binding(Bindings, Var, Name),
327 post_context(Name, Goal, Delays, Var), !.
328call_post_context(_, _, _, _).
329
330post_context(Name, Goal, _Delays, Extra) :-
331 post_context(Name, Goal, Extra), !.
332post_context(Name, M:_Goal, _, '$residuals'(Residuals)) :-
333 swish_config(residuals_var, Name), !,
334 residuals(M, Residuals).
335post_context(Name, M:_Goal, Delays,
336 '$wfs_residual_program'(TheDelays, Program)) :-
337 Delays \== true,
338 swish_config(wfs_residual_program_var, Name), !,
339 ( current_prolog_flag(toplevel_list_wfs_residual_program, true)
340 -> delays_residual_program(Delays, M:Program),
341 TheDelays = Delays
342 ; TheDelays = undefined,
343 Program = []
344 ).
345
346binding([Name=Var|_], V, Name) :-
347 Var == V, !.
348binding([_|Bindings], V, Name) :-
349 binding(Bindings, V, Name).
350
351
359
360residuals(TypeIn, Goals) :-
361 phrase(prolog:residual_goals, Goals0),
362 maplist(unqualify_residual(TypeIn), Goals0, Goals).
363
364unqualify_residual(M, M:G, G) :- !.
365unqualify_residual(T, M:G, G) :-
366 predicate_property(T:G, imported_from(M)), !.
367unqualify_residual(_, G, G).
368
369
370 373
374add_source(Port, Frame, Prompt0, Prompt) :-
375 debug(trace(line), 'Add source?', []),
376 source_location(Frame, Port, Location), !,
377 Prompt = Prompt0.put(source, Location),
378 debug(trace(line), 'Source ~p ~p: ~p', [Port, Frame, Location]).
379add_source(_, _, Prompt, Prompt).
380
390
391source_location(Frame, Port, Location) :-
392 parent_frame(Frame, Port, _Steps, ShowFrame, PC),
393 ( clause_position(PC)
394 -> true 395 ; prolog_frame_attribute(ShowFrame, parent, Parent),
396 frame_file(Parent, ParentFile),
397 \+ pengine_file(ParentFile)
398 ),
399 ( debugging(trace(file))
400 -> prolog_frame_attribute(ShowFrame, level, Level),
401 prolog_frame_attribute(ShowFrame, predicate_indicator, PI),
402 debug(trace(file), '\t[~d]: ~p', [Level, PI])
403 ; true
404 ),
405 frame_file(ShowFrame, File),
406 pengine_file(File), !,
407 source_position(ShowFrame, PC, Location).
408
414
415parent_frame(Frame0, Port0, Steps, Frame, Port) :-
416 parent_frame(Frame0, Port0, 0, Steps, Frame, Port).
417
418parent_frame(Frame, Port, Steps, Steps, Frame, Port).
419parent_frame(Frame, _Port, Steps0, Steps, Parent, PC) :-
420 direct_parent_frame(Frame, DirectParent, ParentPC),
421 Steps1 is Steps0+1,
422 parent_frame(DirectParent, ParentPC, Steps1, Steps, Parent, PC).
423
424direct_parent_frame(Frame, Parent, PC) :-
425 prolog_frame_attribute(Frame, parent, Parent),
426 prolog_frame_attribute(Frame, pc, PC).
427
428
433
434frame_file(Frame, File) :-
435 prolog_frame_attribute(Frame, clause, ClauseRef), !,
436 ( clause_property(ClauseRef, predicate(system:'<meta-call>'/1))
437 -> prolog_frame_attribute(Frame, parent, Parent),
438 frame_file(Parent, File)
439 ; clause_property(ClauseRef, file(File))
440 ).
441frame_file(Frame, File) :-
442 prolog_frame_attribute(Frame, goal, Goal),
443 qualify(Goal, QGoal),
444 \+ predicate_property(QGoal, foreign),
445 clause(QGoal, _Body, ClauseRef), !,
446 clause_property(ClauseRef, file(File)).
447
452
453pengine_file(File) :-
454 sub_atom(File, 0, _, _, 'pengine://'), !.
455pengine_file(File) :-
456 sub_atom(File, 0, _, _, 'swish://').
457
461
462clause_position(PC) :- integer(PC), !.
463clause_position(exit).
464clause_position(unify).
465clause_position(choice(_)).
466
472
473subgoal_position(ClauseRef, PortOrPC, _, _, _) :-
474 debugging(trace(save_pc)),
475 debug(trace(save_pc), 'Position for ~p at ~p', [ClauseRef, PortOrPC]),
476 asserta(subgoal_position(ClauseRef, PortOrPC)),
477 fail.
478subgoal_position(ClauseRef, unify, File, CharA, CharZ) :- !,
479 clause_info(ClauseRef, File, TPos, _),
480 head_pos(ClauseRef, TPos, PosTerm),
481 nonvar(PosTerm),
482 arg(1, PosTerm, CharA),
483 arg(2, PosTerm, CharZ).
484subgoal_position(ClauseRef, choice(CHP), File, CharA, CharZ) :- !,
485 ( prolog_choice_attribute(CHP, type, jump),
486 prolog_choice_attribute(CHP, pc, To)
487 -> debug(gtrace(position), 'Term-position: choice-jump to ~w', [To]),
488 subgoal_position(ClauseRef, To, File, CharA, CharZ)
489 ; clause_end(ClauseRef, File, CharA, CharZ)
490 ).
491subgoal_position(ClauseRef, Port, File, CharA, CharZ) :-
492 end_port(Port), !,
493 clause_end(ClauseRef, File, CharA, CharZ).
494subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
495 debug(trace(source), 'In clause ~p at ~p', [ClauseRef, PC]),
496 clause_info(ClauseRef, File, TPos, _),
497 ( '$clause_term_position'(ClauseRef, PC, List)
498 -> debug(trace(source), 'Term-position: for ref=~w at PC=~w: ~w',
499 [ClauseRef, PC, List]),
500 ( find_subgoal(List, TPos, PosTerm)
501 -> true
502 ; PosTerm = TPos,
503 debug(trace(source),
504 'Clause source-info could not be parsed', []),
505 fail
506 ),
507 nonvar(PosTerm),
508 arg(1, PosTerm, CharA),
509 arg(2, PosTerm, CharZ)
510 ; debug(trace(source),
511 'No clause-term-position for ref=~p at PC=~p',
512 [ClauseRef, PC]),
513 fail
514 ).
515
516end_port(exit).
517end_port(fail).
518end_port(exception).
519
520clause_end(ClauseRef, File, CharA, CharZ) :-
521 clause_info(ClauseRef, File, TPos, _),
522 nonvar(TPos),
523 arg(2, TPos, CharA),
524 CharZ is CharA + 1.
525
526head_pos(Ref, Pos, HPos) :-
527 clause_property(Ref, fact), !,
528 HPos = Pos.
529head_pos(_, term_position(_, _, _, _, [HPos,_]), HPos).
530
533
534find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
535 nth1(A, PosL, Pos), !,
536 find_subgoal(T, Pos, SPos).
537find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :- !,
538 find_subgoal(T, Pos, SPos).
539find_subgoal(_, Pos, Pos).
540
541
544
549
550source_position(Frame, PC, _{file:File, from:CharA, to:CharZ}) :-
551 debug(trace(pos), '~p', [source_position(Frame, PC, _)]),
552 clause_position(PC),
553 prolog_frame_attribute(Frame, clause, ClauseRef), !,
554 subgoal_position(ClauseRef, PC, File, CharA, CharZ).
555source_position(Frame, _PC, Position) :-
556 prolog_frame_attribute(Frame, goal, Goal),
557 qualify(Goal, QGoal),
558 \+ predicate_property(QGoal, foreign),
559 ( clause(QGoal, _Body, ClauseRef)
560 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ),
561 Position = _{file:File, from:CharA, to:CharZ}
562 ; functor(Goal, Functor, Arity),
563 functor(GoalTemplate, Functor, Arity),
564 qualify(GoalTemplate, QGoalTemplate),
565 clause(QGoalTemplate, _TBody, ClauseRef)
566 -> subgoal_position(ClauseRef, unify, File, CharA, CharZ),
567 Position = _{file:File, from:CharA, to:CharZ}
568 ; find_source(QGoal, File, Line),
569 debug(trace(source), 'At ~w:~d', [File, Line]),
570 Position = _{file:File, line:Line}
571 ).
572
573qualify(Goal, Goal) :-
574 functor(Goal, :, 2), !.
575qualify(Goal, user:Goal).
576
577find_source(Predicate, File, Line) :-
578 predicate_property(Predicate, file(File)),
579 predicate_property(Predicate, line_count(Line)), !.
580
593
594:- multifile pengines:prepare_goal/3. 595
596pengines:prepare_goal(Goal0, Goal, Options) :-
597 forall(set_screen_property(Options), true),
598 option(breakpoints(Breakpoints), Options),
599 Breakpoints \== [],
600 pengine_self(Pengine),
601 pengine_property(Pengine, source(File, Text)),
602 maplist(set_file_breakpoints(Pengine, File, Text), Breakpoints),
603 Goal = (debug, Goal0).
604
610
611set_screen_property(Options) :-
612 pengine_self(Pengine),
613 screen_property_decl(Property),
614 option(Property, Options),
615 assertz(Pengine:screen_property(Property)).
616
617screen_property_decl(height(_)).
618screen_property_decl(width(_)).
619screen_property_decl(rows(_)).
620screen_property_decl(cols(_)).
621screen_property_decl(tabled(_)).
622
628
629swish:tty_size(Rows, Cols) :-
630 pengine_self(Pengine),
631 current_predicate(Pengine:screen_property/1), !,
632 Pengine:screen_property(rows(Rows)),
633 Pengine:screen_property(cols(Cols)).
634swish:tty_size(24, 80).
635
639
640set_file_breakpoints(_Pengine, PFile, Text, Dict) :-
641 debug(trace(break), 'Set breakpoints at ~p', [Dict]),
642 _{file:FileS, breakpoints:List} :< Dict,
643 atom_string(File, FileS),
644 ( PFile == File
645 -> debug(trace(break), 'Pengine main source', []),
646 maplist(set_pengine_breakpoint(File, File, Text), List)
647 ; source_file_property(PFile, includes(File, _Time)),
648 atom_concat('swish://', StoreFile, File)
649 -> debug(trace(break), 'Pengine included source ~p', [StoreFile]),
650 storage_file(StoreFile, IncludedText, _Meta),
651 maplist(set_pengine_breakpoint(PFile, File, IncludedText), List)
652 ; debug(trace(break), 'Not in included source', [])
653 ).
654
658
659set_pengine_breakpoint(Owner, File, Text, Line) :-
660 debug(trace(break), 'Try break at ~q:~d', [File, Line]),
661 line_start(Line, Text, Char),
662 ( set_breakpoint(Owner, File, Line, Char, _0Break)
663 -> !, debug(trace(break), 'Created breakpoint ~p', [_0Break])
664 ; print_message(warning, breakpoint(failed(File, Line, 0)))
665 ).
666
667line_start(1, _, 0) :- !.
668line_start(N, Text, Start) :-
669 N0 is N - 2,
670 offset(N0, sub_string(Text, Start, _, _, '\n')), !.
671
676
677update_breakpoints(Breakpoints) :-
678 breakpoint_by_file(Breakpoints, NewBPS),
679 pengine_self(Pengine),
680 pengine_property(Pengine, source(PFile, Text)),
681 current_pengine_source_breakpoints(PFile, ByFile),
682 forall(( member(File-FBPS, ByFile),
683 member(Id-Line, FBPS),
684 \+ ( member(File-NFBPS, NewBPS),
685 member(Line, NFBPS))),
686 delete_breakpoint(Id)),
687 forall(( member(File-NFBPS, NewBPS),
688 member(Line, NFBPS),
689 \+ ( member(File-FBPS, ByFile),
690 member(_-Line, FBPS))),
691 add_breakpoint(PFile, File, Text, Line)).
692
693breakpoint_by_file(Breakpoints, NewBPS) :-
694 maplist(bp_by_file, Breakpoints, NewBPS).
695
696bp_by_file(Dict, File-Lines) :-
697 _{file:FileS, breakpoints:Lines} :< Dict,
698 atom_string(File, FileS).
699
700add_breakpoint(PFile, PFile, Text, Line) :- !,
701 set_pengine_breakpoint(PFile, PFile, Text, Line).
702add_breakpoint(PFile, File, _Text, Line) :-
703 atom_concat('swish://', Store, File), !,
704 storage_file(Store, Text, _Meta),
705 set_pengine_breakpoint(PFile, File, Text, Line).
706add_breakpoint(_, _, _, _Line). 707
713
714current_pengine_source_breakpoints(PFile, ByFile) :-
715 findall(Pair, current_pengine_breakpoint(PFile, Pair), Pairs0),
716 keysort(Pairs0, Pairs),
717 group_pairs_by_key(Pairs, ByFile).
718
719current_pengine_breakpoint(PFile, PFile-(Id-Line)) :-
720 breakpoint_property(Id, file(PFile)),
721 breakpoint_property(Id, line_count(Line)).
722current_pengine_breakpoint(PFile, File-(Id-Line)) :-
723 source_file_property(PFile, includes(File, _Time)),
724 breakpoint_property(Id, file(File)),
725 breakpoint_property(Id, line_count(Line)).
726
727
731
732:- multifile prolog_clause:open_source/2. 733
734prolog_clause:open_source(File, Stream) :-
735 sub_atom(File, 0, _, _, 'pengine://'), !,
736 ( pengine_self(Pengine)
737 -> true
738 ; debugging(trace(_))
739 ),
740 pengine_property(Pengine, source(File, Source)),
741 open_string(Source, Stream).
742prolog_clause:open_source(File, Stream) :-
743 atom_concat('swish://', GittyFile, File), !,
744 storage_file(GittyFile, Data, _Meta),
745 open_string(Data, Stream).
746
747
748 751
752:- dynamic
753 user:prolog_exception_hook/4,
754 installed/1. 755
756:- volatile
757 installed/1. 758
759exception_hook(Ex, Ex, _Frame, Catcher) :-
760 Catcher \== none,
761 Catcher \== 'C',
762 prolog_frame_attribute(Catcher, predicate_indicator, PI),
763 debug(trace(exception), 'Ex: ~p, catcher: ~p', [Ex, PI]),
764 PI == '$swish wrapper'/1,
765 trace,
766 fail.
767
771
772install_exception_hook :-
773 installed(Ref),
774 ( nth_clause(_, I, Ref)
775 -> I == 1, ! 776 ; retractall(installed(Ref)),
777 erase(Ref), 778 fail
779 ).
780install_exception_hook :-
781 asserta((user:prolog_exception_hook(Ex, Out, Frame, Catcher) :-
782 exception_hook(Ex, Out, Frame, Catcher)), Ref),
783 assert(installed(Ref)).
784
785:- initialization install_exception_hook. 786
787
788 791
792:- multifile
793 sandbox:safe_primitive/1,
794 sandbox:safe_meta_predicate/1. 795
796sandbox:safe_primitive(system:trace).
797sandbox:safe_primitive(system:notrace).
798sandbox:safe_primitive(system:tracing).
799sandbox:safe_primitive(edinburgh:debug).
800sandbox:safe_primitive(system:deterministic(_)).
801sandbox:safe_primitive(swish_trace:residuals(_,_)).
802sandbox:safe_primitive(swish:tty_size(_Rows, _Cols)).
803
804sandbox:safe_meta_predicate(swish_trace:'$swish wrapper'/2).
805
806
807 810
811:- multifile
812 prolog:message/3. 813
814prolog:message(breakpoint(failed(File, Line, _Char))) -->
815 [ 'Failed to set breakpoint at ~w:~d'-[File,Line] ]