1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  2020, VU University Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(intercept,
36          [ intercept/3,                        % :Goal, ?Ball, :Handler
37            intercept/4,                        % :Goal, ?Ball, :Handler, +Arg
38            intercept_all/4,                    % +Templ, :Goal, ?Ball, -List
39            nb_intercept_all/4,                 % +Templ, :Goal, ?Ball, -List
40            send_signal/1,                      % +Ball
41            send_silent_signal/1                % +Ball
42          ]).
43:- autoload(library(error),[must_be/2]).
44
45
46/** <module> Intercept and signal interface
47
48This library allows for  creating  an   execution  context  (goal) which
49defines  how  calls  to  send_signal/1  are  handled.  This  library  is
50typically used to fetch  values  from   the  context  or process results
51depending on the context.
52
53For example, assume we  parse  a  (large)   file  using  a  grammar (see
54phrase_from_file/3) that has  some  sort   of  _record_  structure. What
55should we do with the recognised records? We  can return them in a list,
56but if the input is large this is a  huge overhead if the records are to
57be asserted or written to a file.  Using this interface we can use
58
59```
60document -->
61    record(Record),
62    !,
63    { send_signal(record(Record)) },
64    document.
65document -->
66    [].
67```
68
69Given the above, we can assert all   records into the database using the
70following query:
71
72```
73    ...,
74    intercept(phrase_from_file(File, document),
75              record(Record),
76              assertz(Record)).
77```
78
79Or, we can collect all records in a list using intercept_all/4:
80
81```
82    ...,
83    intercept_all(Record,
84                  phrase_from_file(File, document), record(Record),
85                  Records).
86```
87*/
88
89:- meta_predicate
90    intercept(0,?,0),
91    intercept(0,?,1,?),
92    intercept_all(?,0,?,-),
93    nb_intercept_all(?,0,?,-).
94
95%!  intercept(:Goal, ?Ball, :Handler)
96%
97%   Run Goal as call/1.  If  somewhere   during  the  execution  of Goal
98%   send_signal/1 is called with a _Signal_  that unifies with Ball, run
99%   Handler and continue the execution.
100%
101%   This predicate is related to catch/3,   but rather than aborting the
102%   execution of Goal and running Handler  it continues the execution of
103%   Goal. This construct is also   related  to _delimited continuations_
104%   (see reset/3 and shift/1). It only covers  one (common) use case for
105%   delimited continuations, but does so with   a  simpler interface, at
106%   lower overhead and without suffering from  poor interaction with the
107%   cut.
108%
109%   Note that Ball and Handler are _copied_ before calling the (copy) of
110%   Handler to avoid instantiation of Ball and/or Handler which can make
111%   a subsequent signal fail.
112%
113%   @see intercept/4, reset/3, catch/4, broadcast_request/1.
114%   @compat Ciao
115
116intercept(Goal, Ball, Handler) :-
117    do_intercept(Goal, Ball, Handler, args).
118
119%!  intercept(:Goal, ?Ball, :Handler, +Arg)
120%
121%   Similar to intercept/3,  but  the  copy   of  Handler  is  called as
122%   call(Copy,Arg), which allows passing  large   context  arguments  or
123%   arguments subject to unification or   _destructive  assignment_. For
124%   example:
125%
126%       ?- intercept(send_signal(x), X, Y=X).
127%       true.
128%
129%       ?- intercept(send_signal(x), X, =(X), Y).
130%       Y = x.
131
132intercept(Goal, Ball, Handler, Context) :-
133    do_intercept(Goal, Ball, Handler, args(Context)).
134
135do_intercept(Goal, Ball, Handler, Context) :-
136    Goal,
137    no_lco(Ball, Handler, Context).
138
139no_lco(_,_,_).
140
141%!  intercept_all(+Template, :Goal, ?Ball, -List).
142%
143%   True when List contains all  instances   of  Template that have been
144%   sent using send_signal/1 where the argument  unifies with Ball. Note
145%   that backtracking in Goal resets the List.  For example, given
146%
147%   ```
148%   enum(I, Max) :- I =< Max, !, send_signal(emit(I)),
149%                   I2 is I+1, enum(I2, Max).
150%   enum(_, _).
151%   ```
152%
153%   Consider the following queries
154%
155%       ?- intercept_all(I, enum(1,6), emit(I), List).
156%       List = [1, 2, 3, 4, 5, 6].
157%
158%       ?- intercept_all(I, (between(1,3,Max),enum(1,Max)),
159%                        emit(I), List).
160%       Max = 1, List = [1] ;
161%	Max = 2, List = [1, 2] ;
162%	Max = 3, List = [1, 2, 3].
163%
164%   @see nb_intercept_all/4
165
166intercept_all(Template, Goal, Ball, List) :-
167    List0 = [_],
168    State = list(List0, List0),
169    intercept(Goal, Ball, add_ball(Template), State),
170    arg(1, State, [_|List]).
171
172add_ball(Elem, State) :-
173    Tail = [Elem],
174    arg(2, State, List),
175    setarg(2, List, Tail),
176    setarg(2, State, Tail).
177
178%!  nb_intercept_all(+Template, :Goal, ?Ball, -List)
179%
180%   As intercept_all/4, but backtracing inside Goal does not reset List.
181%   Consider this program and the subsequent queries
182%
183%   ```
184%   enum_b(F, T) :- forall(between(F, T, I), send_signal(emit(I))).
185%   ```
186%
187%       ?- intercept_all(I, enum_b(1, 6), emit(I), List).
188%       List = [].
189%
190%       ?- nb_intercept_all(I, enum_b(1, 6), emit(I), List).
191%       List = [1, 2, 3, 4, 5, 6].
192
193nb_intercept_all(Template, Goal, Ball, List) :-
194    List0 = [_],
195    State = list(List0, List0),
196    intercept(Goal, Ball, nb_add_ball(Template), State),
197    arg(1, State, [_|List]).
198
199nb_add_ball(Elem, State) :-
200    duplicate_term(Elem, Copy),
201    Tail = [Copy],
202    arg(2, State, List),
203    nb_linkarg(2, List, Tail),
204    nb_linkarg(2, State, Tail).
205
206%!  send_signal(+Signal)
207%
208%   If this predicate is called from a sub-goal of intercept/3, execute
209%   the associated _Handler_ of the intercept/3 environment.
210%
211%   @error  unintercepted_signal(Signal)  if  there    is   no  matching
212%   intercept environment.
213
214send_signal(Signal) :-
215    must_be(nonvar, Signal),
216    prolog_current_frame(Frame),
217    (   interceptor(Frame, Signal, Handler, Context)
218    ->  call_handler(Context, Handler)
219    ;   throw(error(unintercepted_signal(Signal), _))
220    ).
221
222%!  send_silent_signal(+Signal)
223%
224%   As send_signal/1, but succeed  silently  if   there  is  no matching
225%   intercept environment.
226
227send_silent_signal(Signal) :-
228    must_be(nonvar, Signal),
229    prolog_current_frame(Frame),
230    (   interceptor(Frame, Signal, Handler, Context)
231    ->  call_handler(Context, Handler)
232    ;   true
233    ).
234
235call_handler(args, Handler) :-
236    call(Handler).
237call_handler(args(A0), Handler) :-
238    call(Handler, A0).
239
240interceptor(Frame, Signal, Handler, Context) :-
241    prolog_frame_attribute(Frame, parent_goal(Next),
242                           intercept:do_intercept(_Goal, Signal0, Handler0, Context)),
243    (   copy_term(Signal0+Handler0, Signal+Handler)
244    ->  true
245    ;   interceptor(Next, Signal, Handler, Context)
246    ).
247
248
249		 /*******************************
250		 *            SANDBOX		*
251		 *******************************/
252
253:- multifile
254    sandbox:safe_meta_predicate/1,
255    sandbox:safe_primitive/1.
256
257sandbox:safe_meta_predicate(intercept:intercept/3).
258sandbox:safe_meta_predicate(intercept:intercept/4).
259sandbox:safe_meta_predicate(intercept:intercept_all/4).
260sandbox:safe_meta_predicate(intercept:nb_intercept_all/4).
261
262sandbox:safe_primitive(intercept:send_signal(_)).
263sandbox:safe_primitive(intercept:send_silent_signal(_)).
264