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
   79user:message_hook(trace_mode(_), _, _) :-
   80	pengine_self(_), !.
   81
   82%!	trace_pengines
   83%
   84%	If true, trace in the browser. If false, use the default tracer.
   85%	This allows for debugging  pengine   issues  using the graphical
   86%	tracer from the Prolog environment using:
   87%
   88%	    ?- retractall(swish_trace:trace_pengines).
   89%	    ?- tspy(<some predicate>).
   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			% tracer ignores non-abort exceptions.
  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
  192%%	add_context(+Port, +Frame, +Prompt0, -Prompt) is det.
  193%
  194%	Add additional information  about  the   context  to  the  debug
  195%	prompt.
  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
  213%%	'$swish wrapper'(:Goal, ?ContextVars)
  214%
  215%	Wrap a SWISH goal in '$swish  wrapper'. This has two advantages:
  216%	we can detect that the tracer is   operating  on a SWISH goal by
  217%	inspecting the stack and we can  save/restore the debug state to
  218%	deal with debugging next solutions.
  219%
  220%	ContextVars is a list of variables   that  have a reserved name.
  221%	The hooks pre_context/3 and post_context/3 can   be used to give
  222%	these variables a value  extracted   from  the environment. This
  223%	allows passing more information than just the query answers.
  224%
  225%	The binding `_residuals = '$residuals'(Residuals)`   is added to
  226%	the   residual   goals   by     pengines:event_to_json/3    from
  227%	pengines_io.pl.
  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
  294%!	pre_context(Name, Goal, Var) is semidet.
  295%!	post_context(Name, Goal, Var) is semidet.
  296%
  297%	Multifile hooks to  extract  additional   information  from  the
  298%	Pengine, either just before Goal is   started or after an answer
  299%	was  produced.  Extracting  the  information   is  triggered  by
  300%	introducing a variable with a reserved name.
  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
  313%!	call_post_context(+Dict)
  314
  315call_post_context(Dict) :-
  316	post_context(Dict), !.
  317call_post_context(_).
  318
  319%!	call_post_context(+Goal, +Bindings, +Delays, +Var)
  320%
  321%	Hook to allow filling Var from  the   context.  I.e., there is a
  322%	binding `Name=Var` in Bindings that gives us the name of what is
  323%	expected in Var.
  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
  352%%	residuals(+PengineModule, -Goals:list(callable)) is det.
  353%
  354%	Find residual goals  that  are  not   bound  to  the  projection
  355%	variables. We must do so while  we   are  in  the Pengine as the
  356%	goals typically live in global variables   that  are not visible
  357%	when formulating the answer  from   the  projection variables as
  358%	done in library(pengines_io).
  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		 /*******************************
  371		 *	  SOURCE LOCATION	*
  372		 *******************************/
  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
  381%%	source_location(+Frame, +Port, -Location) is semidet.
  382%
  383%	Determine the appropriate location to show for Frame at Port.
  384%
  385%	  1. If we have a PC (integer), we have a concrete
  386%	  clause-location, so use it if it is in the current file.
  387%	  2. If we have a port, but the parent is not associated
  388%	  with our file, use it.  This ensures that the initial
  389%	  query is shown in the source window.
  390
  391source_location(Frame, Port, Location) :-
  392	parent_frame(Frame, Port, _Steps, ShowFrame, PC),
  393	(   clause_position(PC)
  394	->  true			% real PC
  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
  409%%	parent_frame(+FrameIn, +PCOrPortIn, -Steps,
  410%%		     -FrameOut, -PCOrPortOut) is nondet.
  411%
  412%	True  when  FrameOut/PCOrPortOut  is  a  parent  environment  of
  413%	FrameIn/PCOrPortIn. Backtracking yields higher frames.
  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
  429%%	frame_file(+Frame, -File) is semidet.
  430%
  431%	True when Frame is associated with   a predicate that is defined
  432%	in File.
  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
  448%%	pengine_file(+File) is semidet.
  449%
  450%	True if File is a Pengine controlled file. This is currently the
  451%	main file (pengine://) and (swish://) for included files.
  452
  453pengine_file(File) :-
  454	sub_atom(File, 0, _, _, 'pengine://'), !.
  455pengine_file(File) :-
  456	sub_atom(File, 0, _, _, 'swish://').
  457
  458%%	clause_position(+PC) is semidet.
  459%
  460%	True if the position can be related to a clause.
  461
  462clause_position(PC) :- integer(PC), !.
  463clause_position(exit).
  464clause_position(unify).
  465clause_position(choice(_)).
  466
  467%%	subgoal_position(+Clause, +PortOrPC,
  468%%			 -File, -CharA, -CharZ) is semidet.
  469%
  470%	Character  range  CharA..CharZ  in  File   is  the  location  to
  471%	highlight for the given clause at the given location.
  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
  531%	warning, ((a,b),c)) --> compiled to (a, (b, c))!!!  We try to correct
  532%	that in clause.pl.  This is work in progress.
  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
  542%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  543% Extracted from show_source/2 from library(trace/trace)
  544
  545%%	source_position(Frame, PCOrPort, -Position)
  546%
  547%	Get the source location for  Frame   at  PCOrPort. Position is a
  548%	dict.
  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
  581%%	pengines:prepare_goal(+GoalIn, -GoalOut, +Options) is semidet.
  582%
  583%	Handle the breakpoints(List) option to  set breakpoints prior to
  584%	execution of the query. If breakpoints  are present and enabled,
  585%	the goal is executed in debug mode.  `List` is a list, holding a
  586%	dict for each source that  has   breakpoints.  The dict contains
  587%	these keys:
  588%
  589%	  - `file` is the source file.  For the current Pengine source
  590%	    this is =|pengine://<pengine>/src|=.
  591%	  - `breakpoints` is a list of lines (integers) where to put
  592%	    break points.
  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
  605%!	swish:tty_size(-Rows, -Cols)
  606%
  607%	Emulate obtaining the screen size. Note that the reported number
  608%	of columns is the height  of  the   container  as  the height of
  609%	answer pane itself is determined by the content.
  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
  623%!	swish:tty_size(-Rows, -Cols) is det.
  624%
  625%	Find the size of the output window. This is only registered when
  626%	running _ask_. Notably during compilation it   is  not known. We
  627%	provided dummy values to avoid failing.
  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
  636%!	set_file_breakpoints(+Pengine, +File, +Text, +Dict)
  637%
  638%	Set breakpoints for included files.
  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
  655%!	set_pengine_breakpoint(+Pengine, +File, +Text, +Dict)
  656%
  657%	Set breakpoints on the main Pengine source
  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
  672%%	update_breakpoints(+Breakpoints)
  673%
  674%	Update the active breakpoint  by  comparing   with  the  set  of
  675%	currently active breakpoints.
  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).			% not in our files.
  707
  708%%	current_pengine_source_breakpoints(+PengineFile, -Pairs) is det.
  709%
  710%	Find the currently set breakpoints  for   the  Pengine  with the
  711%	given source file PengineFile. Pairs is a list File-BreakPoints,
  712%	where BreakPoints is a list of breakpoint-ID - Line pairs.
  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
  728%%	prolog_clause:open_source(+File, -Stream) is semidet.
  729%
  730%	Open SWISH non-file sources.
  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		 /*******************************
  749		 *	 TRAP EXCEPTIONS	*
  750		 *******************************/
  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
  768%%	install_exception_hook
  769%
  770%	Make sure our handler is the first of the hook predicate.
  771
  772install_exception_hook :-
  773	installed(Ref),
  774	(   nth_clause(_, I, Ref)
  775	->  I == 1, !			% Ok, we are the first
  776	;   retractall(installed(Ref)),
  777	    erase(Ref),			% Someone before us!
  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		 /*******************************
  789		 *	 ALLOW DEBUGGING	*
  790		 *******************************/
  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		 /*******************************
  808		 *	      MESSAGES		*
  809		 *******************************/
  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] ]