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-2019, VU University Amsterdam
    7			      CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(swish_trace,
   37	  [ '$swish wrapper'/2		% :Goal, ?ContextVars
   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
   70/** <module>
   71
   72Allow tracing pengine execution under SWISH.
   73*/
   74
   75:- multifile
   76	user:prolog_trace_interception/4,
   77	user:message_hook/3.   78:- dynamic
   79	user:message_hook/3.   80
   81intercept_trace_mode_switch :-
   82	asserta((user:message_hook(trace_mode(_), _, _) :-
   83		    pengine_self(_), !)).
   84
   85:- initialization
   86	intercept_trace_mode_switch.   87
   88%!	trace_pengines
   89%
   90%	If true, trace in the browser. If false, use the default tracer.
   91%	This allows for debugging  pengine   issues  using the graphical
   92%	tracer from the Prolog environment using:
   93%
   94%	    ?- retractall(swish_trace:trace_pengines).
   95%	    ?- tspy(<some predicate>).
   96
   97:- dynamic
   98	trace_pengines/0.   99
  100trace_pengines.
  101
  102user:prolog_trace_interception(Port, Frame, CHP, Action) :-
  103	trace_pengines,
  104	State = state(0),
  105	(   catch(trace_interception(Port, Frame, CHP, Action), E, true),
  106	    (   var(E)
  107	    ->  nb_setarg(1, State, Action)
  108	    ;   abort			% tracer ignores non-abort exceptions.
  109	    ),
  110	    fail
  111	;   arg(1, State, Action)
  112	).
  113
  114trace_interception(Port, Frame, _CHP, Action) :-
  115	pengine_self(Pengine),
  116	prolog_frame_attribute(Frame, predicate_indicator, PI),
  117	debug(trace, 'HOOK: ~p ~p', [Port, PI]),
  118	pengine_property(Pengine, module(Module)),
  119	wrapper_frame(Frame, WrapperFrame),
  120	debug(trace, 'Me: ~p, wrapper: ~p', [Frame, WrapperFrame]),
  121	prolog_frame_attribute(WrapperFrame, level, WrapperDepth),
  122	prolog_frame_attribute(Frame, goal, Goal0),
  123	prolog_frame_attribute(Frame, level, Depth0),
  124	Depth is Depth0 - WrapperDepth - 1,
  125	unqualify(Goal0, Module, Goal),
  126	debug(trace, '[~d] ~w: Goal ~p', [Depth0, Port, Goal]),
  127	term_html(Goal, GoalString),
  128	functor(Port, PortName, _),
  129	Prompt0 = _{type:    trace,
  130		    port:    PortName,
  131		    depth:   Depth,
  132		    goal:    GoalString,
  133		    pengine: Pengine
  134		   },
  135	add_context(Port, Frame, Prompt0, Prompt1),
  136	add_source(Port, Frame, Prompt1, Prompt),
  137	pengine_input(Prompt, Reply),
  138	trace_action(Reply, Port, Frame, Action), !,
  139	debug(trace, 'Action: ~p --> ~p', [Reply, Action]).
  140trace_interception(Port, Frame0, _CHP, nodebug) :-
  141	pengine_self(_),
  142	prolog_frame_attribute(Frame0, goal, Goal),
  143	prolog_frame_attribute(Frame0, level, Depth),
  144	debug(trace, '[~d] ~w: Goal ~p --> NODEBUG', [Depth, Port, Goal]).
  145
  146trace_action(continue, _Port, Frame, continue) :-
  147	pengine_self(Me),
  148	prolog_frame_attribute(Frame, predicate_indicator, Me:Name/Arity),
  149	functor(Head, Name, Arity),
  150	\+ pengine_io_predicate(Head), !,
  151	prolog_skip_level(_, very_deep),
  152        debug(trace, '~p', [Me:Name/Arity]).
  153trace_action(continue, Port, _, skip) :-
  154	box_enter(Port), !.
  155trace_action(continue, _, _, continue) :-
  156	prolog_skip_level(_, very_deep).
  157trace_action(nodebug,  _, _, nodebug).
  158trace_action(skip,     _, _, skip).
  159trace_action(retry,    _, _, retry).
  160trace_action(up   ,    _, _, up).
  161trace_action(abort,    _, _, abort).
  162trace_action(nodebug(Breakpoints), _, _, Action) :-
  163	catch(update_breakpoints(Breakpoints), E,
  164	      print_message(warning, E)),
  165	(   Breakpoints == []
  166	->  Action = nodebug
  167	;   Action = continue,
  168	    notrace
  169	).
  170
  171box_enter(call).
  172box_enter(redo(_)).
  173
  174wrapper_frame(Frame0, Frame) :-
  175	parent_frame(Frame0, Frame),
  176	prolog_frame_attribute(Frame, predicate_indicator, PI),
  177	debug(trace, 'Parent: ~p', [PI]),
  178	(   PI == swish_call/1
  179	->  true
  180	;   PI == swish_trace:swish_call/1
  181	), !.
  182
  183parent_frame(Frame, Frame).
  184parent_frame(Frame, Parent) :-
  185	prolog_frame_attribute(Frame, parent, Parent0),
  186	parent_frame(Parent0, Parent).
  187
  188unqualify(M:G, M, G) :- !.
  189unqualify(system:G, _, G) :- !.
  190unqualify(user:G, _, G) :- !.
  191unqualify(G, _, G).
  192
  193term_html(Term, HTMlString) :-
  194	pengine_self(Pengine),
  195	pengine_property(Pengine, module(Module)),
  196	phrase(html(\term(Term,
  197			  [ module(Module),
  198			    quoted(true)
  199			  ])), Tokens),
  200	with_output_to(string(HTMlString), print_html(Tokens)).
  201
  202%%	add_context(+Port, +Frame, +Prompt0, -Prompt) is det.
  203%
  204%	Add additional information  about  the   context  to  the  debug
  205%	prompt.
  206
  207add_context(exception(Exception0), _Frame, Prompt0, Prompt) :-
  208	strip_stack(Exception0, Exception),
  209	message_to_string(Exception, Msg), !,
  210	debug(trace, 'Msg = ~s', [Msg]),
  211	(   term_html(Exception, String)
  212	->  Ex = json{term_html:String, message:Msg}
  213	;   Ex = json{message:Msg}
  214	),
  215	Prompt = Prompt0.put(exception, Ex).
  216add_context(_, _, Prompt, Prompt).
  217
  218strip_stack(error(Error, context(prolog_stack(S), Msg)),
  219	    error(Error, context(_, Msg))) :-
  220	nonvar(S).
  221strip_stack(Error, Error).
  222
  223%%	'$swish wrapper'(:Goal, ?ContextVars)
  224%
  225%	Wrap a SWISH goal in '$swish  wrapper'. This has two advantages:
  226%	we can detect that the tracer is   operating  on a SWISH goal by
  227%	inspecting the stack and we can  save/restore the debug state to
  228%	deal with debugging next solutions.
  229%
  230%	ContextVars is a list of variables   that  have a reserved name.
  231%	The hooks pre_context/3 and post_context/3 can   be used to give
  232%	these variables a value  extracted   from  the environment. This
  233%	allows passing more information than just the query answers.
  234%
  235%	The binding `_residuals = '$residuals'(Residuals)`   is added to
  236%	the   residual   goals   by     pengines:event_to_json/3    from
  237%	pengines_io.pl.
  238
  239:- meta_predicate swish_call(0).  240
  241:- if(\+current_predicate(call_delays/2)).  242:- meta_predicate
  243	call_delays(0, :),
  244	delays_residual_program(:, :).  245
  246call_delays(Goal, _:true) :-
  247	call(Goal).
  248
  249delays_residual_program(_, _:[]).
  250:- endif.  251
  252'$swish wrapper'(Goal, Extra) :-
  253	(   nb_current('$variable_names', Bindings)
  254	->  true
  255	;   Bindings = []
  256	),
  257	debug(projection, 'Pre-context-pre ~p, extra=~p', [Bindings, Extra]),
  258	maplist(call_pre_context(Goal, Bindings), Extra),
  259	debug(projection, 'Pre-context-post ~p, extra=~p', [Bindings, Extra]),
  260	call_delays(catch_with_backtrace(swish_call(Goal),
  261					 E, throw_backtrace(E)), Delays),
  262	deterministic(Det),
  263	(   tracing,
  264	    Det == false
  265	->  (   notrace,
  266	        debug(trace, 'Saved tracer', [])
  267	    ;	debug(trace, 'Restoring tracer', []),
  268	        trace,
  269		fail
  270	    )
  271	;   notrace
  272	),
  273	call_post_context(_{goal:Goal, bindings:Bindings,
  274			    delays:Delays, context:Extra}),
  275	maplist(call_post_context(Goal, Bindings, Delays), Extra).
  276
  277throw_backtrace(error(Formal, context(prolog_stack(Stack0), Msg))) :-
  278	append(Stack1, [Guard|_], Stack0),
  279	is_guard(Guard),
  280	!,
  281	last(Stack1, Frame),
  282	arg(1, Frame, Level),
  283	maplist(re_level(Level), Stack1, Stack),
  284	throw(error(Formal, context(prolog_stack(Stack), Msg))).
  285throw_backtrace(E) :-
  286	throw(E).
  287
  288re_level(Sub,
  289	 frame(Level0, Clause, Goal),
  290	 frame(Level, Clause, Goal)) :-
  291	Level is 1 + Level0 - Sub.
  292
  293is_guard(frame(_Level, _Clause, swish_trace:swish_call(_))).
  294
  295swish_call(Goal) :-
  296	Goal,
  297	no_lco.
  298
  299no_lco.
  300
  301:- '$hide'(swish_call/1).  302:- '$hide'(no_lco/0).  303
  304%!	pre_context(Name, Goal, Var) is semidet.
  305%!	post_context(Name, Goal, Var) is semidet.
  306%
  307%	Multifile hooks to  extract  additional   information  from  the
  308%	Pengine, either just before Goal is   started or after an answer
  309%	was  produced.  Extracting  the  information   is  triggered  by
  310%	introducing a variable with a reserved name.
  311
  312:- multifile
  313	pre_context/3,
  314	post_context/1,
  315	post_context/3,
  316	post_context/4.  317
  318call_pre_context(Goal, Bindings, Var) :-
  319	binding(Bindings, Var, Name),
  320	pre_context(Name, Goal, Var), !.
  321call_pre_context(_, _, _).
  322
  323%!	call_post_context(+Dict)
  324
  325call_post_context(Dict) :-
  326	post_context(Dict), !.
  327call_post_context(_).
  328
  329%!	call_post_context(+Goal, +Bindings, +Delays, +Var)
  330%
  331%	Hook to allow filling Var from  the   context.  I.e., there is a
  332%	binding `Name=Var` in Bindings that gives us the name of what is
  333%	expected in Var.
  334
  335call_post_context(Goal, Bindings, Delays, Var) :-
  336	binding(Bindings, Var, Name),
  337	post_context(Name, Goal, Delays, Var), !.
  338call_post_context(_, _, _, _).
  339
  340post_context(Name, Goal, _Delays, Extra) :-
  341	post_context(Name, Goal, Extra), !.
  342post_context(Name, M:_Goal, _, '$residuals'(Residuals)) :-
  343	swish_config(residuals_var, Name), !,
  344	residuals(M, Residuals).
  345post_context(Name, M:_Goal, Delays,
  346	     '$wfs_residual_program'(TheDelays, Program)) :-
  347	Delays \== true,
  348	swish_config(wfs_residual_program_var, Name), !,
  349	(   current_prolog_flag(toplevel_list_wfs_residual_program, true)
  350	->  delays_residual_program(Delays, M:Program),
  351	    TheDelays = Delays
  352	;   TheDelays = undefined,
  353	    Program = []
  354	).
  355
  356binding([Name=Var|_], V, Name) :-
  357	Var == V, !.
  358binding([_|Bindings], V, Name) :-
  359	binding(Bindings, V, Name).
  360
  361
  362%%	residuals(+PengineModule, -Goals:list(callable)) is det.
  363%
  364%	Find residual goals  that  are  not   bound  to  the  projection
  365%	variables. We must do so while  we   are  in  the Pengine as the
  366%	goals typically live in global variables   that  are not visible
  367%	when formulating the answer  from   the  projection variables as
  368%	done in library(pengines_io).
  369
  370residuals(TypeIn, Goals) :-
  371	phrase(prolog:residual_goals, Goals0),
  372	maplist(unqualify_residual(TypeIn), Goals0, Goals).
  373
  374unqualify_residual(M, M:G, G) :- !.
  375unqualify_residual(T, M:G, G) :-
  376	predicate_property(T:G, imported_from(M)), !.
  377unqualify_residual(_, G, G).
  378
  379
  380		 /*******************************
  381		 *	  SOURCE LOCATION	*
  382		 *******************************/
  383
  384add_source(Port, Frame, Prompt0, Prompt) :-
  385	debug(trace(line), 'Add source?', []),
  386	source_location(Frame, Port, Location), !,
  387	Prompt = Prompt0.put(source, Location),
  388	debug(trace(line), 'Source ~p ~p: ~p', [Port, Frame, Location]).
  389add_source(_, _, Prompt, Prompt).
  390
  391%%	source_location(+Frame, +Port, -Location) is semidet.
  392%
  393%	Determine the appropriate location to show for Frame at Port.
  394%
  395%	  1. If we have a PC (integer), we have a concrete
  396%	  clause-location, so use it if it is in the current file.
  397%	  2. If we have a port, but the parent is not associated
  398%	  with our file, use it.  This ensures that the initial
  399%	  query is shown in the source window.
  400
  401source_location(Frame, Port, Location) :-
  402	parent_frame(Frame, Port, _Steps, ShowFrame, PC),
  403	(   clause_position(PC)
  404	->  true			% real PC
  405	;   prolog_frame_attribute(ShowFrame, parent, Parent),
  406	    frame_file(Parent, ParentFile),
  407	    \+ pengine_file(ParentFile)
  408	),
  409	(   debugging(trace(file))
  410	->  prolog_frame_attribute(ShowFrame, level, Level),
  411	    prolog_frame_attribute(ShowFrame, predicate_indicator, PI),
  412	    debug(trace(file), '\t[~d]: ~p', [Level, PI])
  413	;   true
  414	),
  415	frame_file(ShowFrame, File),
  416	pengine_file(File), !,
  417	source_position(ShowFrame, PC, Location).
  418
  419%%	parent_frame(+FrameIn, +PCOrPortIn, -Steps,
  420%%		     -FrameOut, -PCOrPortOut) is nondet.
  421%
  422%	True  when  FrameOut/PCOrPortOut  is  a  parent  environment  of
  423%	FrameIn/PCOrPortIn. Backtracking yields higher frames.
  424
  425parent_frame(Frame0, Port0, Steps, Frame, Port) :-
  426	parent_frame(Frame0, Port0, 0, Steps, Frame, Port).
  427
  428parent_frame(Frame, Port, Steps, Steps, Frame, Port).
  429parent_frame(Frame, _Port, Steps0, Steps, Parent, PC) :-
  430	direct_parent_frame(Frame, DirectParent, ParentPC),
  431	Steps1 is Steps0+1,
  432	parent_frame(DirectParent, ParentPC, Steps1, Steps, Parent, PC).
  433
  434direct_parent_frame(Frame, Parent, PC) :-
  435	prolog_frame_attribute(Frame, parent, Parent),
  436	prolog_frame_attribute(Frame, pc, PC).
  437
  438
  439%%	frame_file(+Frame, -File) is semidet.
  440%
  441%	True when Frame is associated with   a predicate that is defined
  442%	in File.
  443
  444frame_file(Frame, File) :-
  445	prolog_frame_attribute(Frame, clause, ClauseRef), !,
  446	(   clause_property(ClauseRef, predicate(system:'<meta-call>'/1))
  447	->  prolog_frame_attribute(Frame, parent, Parent),
  448	    frame_file(Parent, File)
  449	;   clause_property(ClauseRef, file(File))
  450	).
  451frame_file(Frame, File) :-
  452	prolog_frame_attribute(Frame, goal, Goal),
  453	qualify(Goal, QGoal),
  454	\+ predicate_property(QGoal, foreign),
  455	clause(QGoal, _Body, ClauseRef), !,
  456	clause_property(ClauseRef, file(File)).
  457
  458%%	pengine_file(+File) is semidet.
  459%
  460%	True if File is a Pengine controlled file. This is currently the
  461%	main file (pengine://) and (swish://) for included files.
  462
  463pengine_file(File) :-
  464	sub_atom(File, 0, _, _, 'pengine://'), !.
  465pengine_file(File) :-
  466	sub_atom(File, 0, _, _, 'swish://').
  467
  468%%	clause_position(+PC) is semidet.
  469%
  470%	True if the position can be related to a clause.
  471
  472clause_position(PC) :- integer(PC), !.
  473clause_position(exit).
  474clause_position(unify).
  475clause_position(choice(_)).
  476
  477%%	subgoal_position(+Clause, +PortOrPC,
  478%%			 -File, -CharA, -CharZ) is semidet.
  479%
  480%	Character  range  CharA..CharZ  in  File   is  the  location  to
  481%	highlight for the given clause at the given location.
  482
  483subgoal_position(ClauseRef, PortOrPC, _, _, _) :-
  484	debugging(trace(save_pc)),
  485	debug(trace(save_pc), 'Position for ~p at ~p', [ClauseRef, PortOrPC]),
  486	asserta(subgoal_position(ClauseRef, PortOrPC)),
  487	fail.
  488subgoal_position(ClauseRef, unify, File, CharA, CharZ) :- !,
  489	clause_info(ClauseRef, File, TPos, _),
  490	head_pos(ClauseRef, TPos, PosTerm),
  491	nonvar(PosTerm),
  492	arg(1, PosTerm, CharA),
  493	arg(2, PosTerm, CharZ).
  494subgoal_position(ClauseRef, choice(CHP), File, CharA, CharZ) :- !,
  495	(   prolog_choice_attribute(CHP, type, jump),
  496	    prolog_choice_attribute(CHP, pc, To)
  497	->  debug(gtrace(position), 'Term-position: choice-jump to ~w', [To]),
  498	    subgoal_position(ClauseRef, To, File, CharA, CharZ)
  499	;   clause_end(ClauseRef, File, CharA, CharZ)
  500	).
  501subgoal_position(ClauseRef, Port, File, CharA, CharZ) :-
  502	end_port(Port), !,
  503	clause_end(ClauseRef, File, CharA, CharZ).
  504subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
  505	debug(trace(source), 'In clause ~p at ~p', [ClauseRef, PC]),
  506	clause_info(ClauseRef, File, TPos, _),
  507	(   '$clause_term_position'(ClauseRef, PC, List)
  508	->  debug(trace(source), 'Term-position: for ref=~w at PC=~w: ~w',
  509		  [ClauseRef, PC, List]),
  510	    (   find_subgoal(List, TPos, PosTerm)
  511	    ->  true
  512	    ;   PosTerm = TPos,
  513		debug(trace(source),
  514		      'Clause source-info could not be parsed', []),
  515		fail
  516	    ),
  517	    nonvar(PosTerm),
  518	    arg(1, PosTerm, CharA),
  519	    arg(2, PosTerm, CharZ)
  520	;   debug(trace(source),
  521		  'No clause-term-position for ref=~p at PC=~p',
  522		  [ClauseRef, PC]),
  523	    fail
  524	).
  525
  526end_port(exit).
  527end_port(fail).
  528end_port(exception).
  529
  530clause_end(ClauseRef, File, CharA, CharZ) :-
  531	clause_info(ClauseRef, File, TPos, _),
  532	nonvar(TPos),
  533	arg(2, TPos, CharA),
  534	CharZ is CharA + 1.
  535
  536head_pos(Ref, Pos, HPos) :-
  537	clause_property(Ref, fact), !,
  538	HPos = Pos.
  539head_pos(_, term_position(_, _, _, _, [HPos,_]), HPos).
  540
  541%	warning, ((a,b),c)) --> compiled to (a, (b, c))!!!  We try to correct
  542%	that in clause.pl.  This is work in progress.
  543
  544find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
  545	nth1(A, PosL, Pos), !,
  546	find_subgoal(T, Pos, SPos).
  547find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :- !,
  548	find_subgoal(T, Pos, SPos).
  549find_subgoal(_, Pos, Pos).
  550
  551
  552%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  553% Extracted from show_source/2 from library(trace/trace)
  554
  555%%	source_position(Frame, PCOrPort, -Position)
  556%
  557%	Get the source location for  Frame   at  PCOrPort. Position is a
  558%	dict.
  559
  560source_position(Frame, PC, _{file:File, from:CharA, to:CharZ}) :-
  561	debug(trace(pos), '~p', [source_position(Frame, PC, _)]),
  562	clause_position(PC),
  563	prolog_frame_attribute(Frame, clause, ClauseRef), !,
  564	subgoal_position(ClauseRef, PC, File, CharA, CharZ).
  565source_position(Frame, _PC, Position) :-
  566	prolog_frame_attribute(Frame, goal, Goal),
  567	qualify(Goal, QGoal),
  568	\+ predicate_property(QGoal, foreign),
  569	(   clause(QGoal, _Body, ClauseRef)
  570	->  subgoal_position(ClauseRef, unify, File, CharA, CharZ),
  571	    Position = _{file:File, from:CharA, to:CharZ}
  572	;   functor(Goal, Functor, Arity),
  573	    functor(GoalTemplate, Functor, Arity),
  574	    qualify(GoalTemplate, QGoalTemplate),
  575	    clause(QGoalTemplate, _TBody, ClauseRef)
  576	->  subgoal_position(ClauseRef, unify, File, CharA, CharZ),
  577	    Position = _{file:File, from:CharA, to:CharZ}
  578	;   find_source(QGoal, File, Line),
  579	    debug(trace(source), 'At ~w:~d', [File, Line]),
  580	    Position = _{file:File, line:Line}
  581	).
  582
  583qualify(Goal, Goal) :-
  584	functor(Goal, :, 2), !.
  585qualify(Goal, user:Goal).
  586
  587find_source(Predicate, File, Line) :-
  588	predicate_property(Predicate, file(File)),
  589	predicate_property(Predicate, line_count(Line)), !.
  590
  591%%	pengines:prepare_goal(+GoalIn, -GoalOut, +Options) is semidet.
  592%
  593%	Handle the breakpoints(List) option to  set breakpoints prior to
  594%	execution of the query. If breakpoints  are present and enabled,
  595%	the goal is executed in debug mode.  `List` is a list, holding a
  596%	dict for each source that  has   breakpoints.  The dict contains
  597%	these keys:
  598%
  599%	  - `file` is the source file.  For the current Pengine source
  600%	    this is =|pengine://<pengine>/src|=.
  601%	  - `breakpoints` is a list of lines (integers) where to put
  602%	    break points.
  603
  604:- multifile pengines:prepare_goal/3.  605
  606pengines:prepare_goal(Goal0, Goal, Options) :-
  607	forall(set_screen_property(Options), true),
  608	option(breakpoints(Breakpoints), Options),
  609	Breakpoints \== [],
  610	pengine_self(Pengine),
  611	pengine_property(Pengine, source(File, Text)),
  612	maplist(set_file_breakpoints(Pengine, File, Text), Breakpoints),
  613	Goal = (debug, Goal0).
  614
  615%!	swish:tty_size(-Rows, -Cols)
  616%
  617%	Emulate obtaining the screen size. Note that the reported number
  618%	of columns is the height  of  the   container  as  the height of
  619%	answer pane itself is determined by the content.
  620
  621set_screen_property(Options) :-
  622	pengine_self(Pengine),
  623	screen_property_decl(Property),
  624	option(Property, Options),
  625	assertz(Pengine:screen_property(Property)).
  626
  627screen_property_decl(height(_)).
  628screen_property_decl(width(_)).
  629screen_property_decl(rows(_)).
  630screen_property_decl(cols(_)).
  631screen_property_decl(tabled(_)).
  632
  633%!	swish:tty_size(-Rows, -Cols) is det.
  634%
  635%	Find the size of the output window. This is only registered when
  636%	running _ask_. Notably during compilation it   is  not known. We
  637%	provided dummy values to avoid failing.
  638
  639swish:tty_size(Rows, Cols) :-
  640	pengine_self(Pengine),
  641	current_predicate(Pengine:screen_property/1), !,
  642	Pengine:screen_property(rows(Rows)),
  643	Pengine:screen_property(cols(Cols)).
  644swish:tty_size(24, 80).
  645
  646%!	set_file_breakpoints(+Pengine, +File, +Text, +Dict)
  647%
  648%	Set breakpoints for included files.
  649
  650set_file_breakpoints(_Pengine, PFile, Text, Dict) :-
  651	debug(trace(break), 'Set breakpoints at ~p', [Dict]),
  652	_{file:FileS, breakpoints:List} :< Dict,
  653	atom_string(File, FileS),
  654	(   PFile == File
  655	->  debug(trace(break), 'Pengine main source', []),
  656	    maplist(set_pengine_breakpoint(File, File, Text), List)
  657	;   source_file_property(PFile, includes(File, _Time)),
  658	    atom_concat('swish://', StoreFile, File)
  659	->  debug(trace(break), 'Pengine included source ~p', [StoreFile]),
  660	    storage_file(StoreFile, IncludedText, _Meta),
  661	    maplist(set_pengine_breakpoint(PFile, File, IncludedText), List)
  662	;   debug(trace(break), 'Not in included source', [])
  663	).
  664
  665%!	set_pengine_breakpoint(+Pengine, +File, +Text, +Dict)
  666%
  667%	Set breakpoints on the main Pengine source
  668
  669set_pengine_breakpoint(Owner, File, Text, Line) :-
  670	debug(trace(break), 'Try break at ~q:~d', [File, Line]),
  671	line_start(Line, Text, Char),
  672	(   set_breakpoint(Owner, File, Line, Char, _0Break)
  673	->  !, debug(trace(break), 'Created breakpoint ~p', [_0Break])
  674	;   print_message(warning, breakpoint(failed(File, Line, 0)))
  675	).
  676
  677line_start(1, _, 0) :- !.
  678line_start(N, Text, Start) :-
  679	N0 is N - 2,
  680	offset(N0, sub_string(Text, Start, _, _, '\n')), !.
  681
  682%%	update_breakpoints(+Breakpoints)
  683%
  684%	Update the active breakpoint  by  comparing   with  the  set  of
  685%	currently active breakpoints.
  686
  687update_breakpoints(Breakpoints) :-
  688	breakpoint_by_file(Breakpoints, NewBPS),
  689	pengine_self(Pengine),
  690	pengine_property(Pengine, source(PFile, Text)),
  691	current_pengine_source_breakpoints(PFile, ByFile),
  692	forall(( member(File-FBPS, ByFile),
  693		 member(Id-Line, FBPS),
  694		 \+ ( member(File-NFBPS, NewBPS),
  695		      member(Line, NFBPS))),
  696	       delete_breakpoint(Id)),
  697	forall(( member(File-NFBPS, NewBPS),
  698		 member(Line, NFBPS),
  699		 \+ ( member(File-FBPS, ByFile),
  700		      member(_-Line, FBPS))),
  701	       add_breakpoint(PFile, File, Text, Line)).
  702
  703breakpoint_by_file(Breakpoints, NewBPS) :-
  704	maplist(bp_by_file, Breakpoints, NewBPS).
  705
  706bp_by_file(Dict, File-Lines) :-
  707	_{file:FileS, breakpoints:Lines} :< Dict,
  708	atom_string(File, FileS).
  709
  710add_breakpoint(PFile, PFile, Text, Line) :- !,
  711	set_pengine_breakpoint(PFile, PFile, Text, Line).
  712add_breakpoint(PFile, File, _Text, Line) :-
  713	atom_concat('swish://', Store, File), !,
  714	storage_file(Store, Text, _Meta),
  715	set_pengine_breakpoint(PFile, File, Text, Line).
  716add_breakpoint(_, _, _, _Line).			% not in our files.
  717
  718%%	current_pengine_source_breakpoints(+PengineFile, -Pairs) is det.
  719%
  720%	Find the currently set breakpoints  for   the  Pengine  with the
  721%	given source file PengineFile. Pairs is a list File-BreakPoints,
  722%	where BreakPoints is a list of breakpoint-ID - Line pairs.
  723
  724current_pengine_source_breakpoints(PFile, ByFile) :-
  725	findall(Pair, current_pengine_breakpoint(PFile, Pair), Pairs0),
  726	keysort(Pairs0, Pairs),
  727	group_pairs_by_key(Pairs, ByFile).
  728
  729current_pengine_breakpoint(PFile, PFile-(Id-Line)) :-
  730	breakpoint_property(Id, file(PFile)),
  731	breakpoint_property(Id, line_count(Line)).
  732current_pengine_breakpoint(PFile, File-(Id-Line)) :-
  733	source_file_property(PFile, includes(File, _Time)),
  734	breakpoint_property(Id, file(File)),
  735	breakpoint_property(Id, line_count(Line)).
  736
  737
  738%%	prolog_clause:open_source(+File, -Stream) is semidet.
  739%
  740%	Open SWISH non-file sources.
  741
  742:- multifile prolog_clause:open_source/2.  743
  744prolog_clause:open_source(File, Stream) :-
  745	sub_atom(File, 0, _, _, 'pengine://'), !,
  746	(   pengine_self(Pengine)
  747	->  true
  748	;   debugging(trace(_))
  749	),
  750	pengine_property(Pengine, source(File, Source)),
  751	open_string(Source, Stream).
  752prolog_clause:open_source(File, Stream) :-
  753	atom_concat('swish://', GittyFile, File), !,
  754	storage_file(GittyFile, Data, _Meta),
  755	open_string(Data, Stream).
  756
  757
  758		 /*******************************
  759		 *	 TRAP EXCEPTIONS	*
  760		 *******************************/
  761
  762:- dynamic
  763	user:prolog_exception_hook/4,
  764	installed/1.  765
  766:- volatile
  767	installed/1.  768
  769exception_hook(Ex, Ex, _Frame, Catcher) :-
  770	Catcher \== none,
  771	Catcher \== 'C',
  772	prolog_frame_attribute(Catcher, predicate_indicator, PI),
  773	debug(trace(exception), 'Ex: ~p, catcher: ~p', [Ex, PI]),
  774	PI == '$swish wrapper'/1,
  775	trace,
  776	fail.
  777
  778%%	install_exception_hook
  779%
  780%	Make sure our handler is the first of the hook predicate.
  781
  782install_exception_hook :-
  783	installed(Ref),
  784	(   nth_clause(_, I, Ref)
  785	->  I == 1, !			% Ok, we are the first
  786	;   retractall(installed(Ref)),
  787	    erase(Ref),			% Someone before us!
  788	    fail
  789	).
  790install_exception_hook :-
  791	asserta((user:prolog_exception_hook(Ex, Out, Frame, Catcher) :-
  792			exception_hook(Ex, Out, Frame, Catcher)), Ref),
  793	assert(installed(Ref)).
  794
  795:- initialization install_exception_hook.  796
  797
  798		 /*******************************
  799		 *	 ALLOW DEBUGGING	*
  800		 *******************************/
  801
  802:- multifile
  803	sandbox:safe_primitive/1,
  804	sandbox:safe_meta_predicate/1.  805
  806sandbox:safe_primitive(system:trace).
  807sandbox:safe_primitive(system:notrace).
  808sandbox:safe_primitive(system:tracing).
  809sandbox:safe_primitive(edinburgh:debug).
  810sandbox:safe_primitive(system:deterministic(_)).
  811sandbox:safe_primitive(swish_trace:residuals(_,_)).
  812sandbox:safe_primitive(swish:tty_size(_Rows, _Cols)).
  813
  814sandbox:safe_meta_predicate(swish_trace:'$swish wrapper'/2).
  815
  816
  817		 /*******************************
  818		 *	      MESSAGES		*
  819		 *******************************/
  820
  821:- multifile
  822	prolog:message/3.  823
  824prolog:message(breakpoint(failed(File, Line, _Char))) -->
  825	[ 'Failed to set breakpoint at ~w:~d'-[File,Line] ]