View source with formatted comments or as raw
    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(_))