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