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)  2008-2020, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(aggregate,
   38          [ foreach/2,                  % :Generator, :Goal
   39            aggregate/3,                % +Templ, :Goal, -Result
   40            aggregate/4,                % +Templ, +Discrim, :Goal, -Result
   41            aggregate_all/3,            % +Templ, :Goal, -Result
   42            aggregate_all/4,            % +Templ, +Discrim, :Goal, -Result
   43            free_variables/4            % :Generator, :Template, +Vars0, -Vars
   44          ]).   45:- autoload(library(apply),[maplist/4,maplist/5]).   46:- autoload(library(error),
   47	    [instantiation_error/1,type_error/2,domain_error/2]).   48:- autoload(library(lists),
   49	    [append/3,member/2,sum_list/2,max_list/2,min_list/2]).   50:- autoload(library(ordsets),[ord_intersection/3]).   51:- autoload(library(pairs),[pairs_values/2]).   52
   53:- set_prolog_flag(generate_debug_info, false).   54
   55:- meta_predicate
   56    foreach(0,0),
   57    aggregate(?,^,-),
   58    aggregate(?,?,^,-),
   59    aggregate_all(?,0,-),
   60    aggregate_all(?,?,0,-).   61
   62/** <module> Aggregation operators on backtrackable predicates
   63
   64This library provides aggregating operators  over   the  solutions  of a
   65predicate. The operations are a generalisation   of the bagof/3, setof/3
   66and findall/3 built-in predicates.  Aggregations   that  can be computed
   67incrementally avoid findall/3 and run in   constant  memory. The defined
   68aggregation  operations  are  counting,  computing   the  sum,  minimum,
   69maximum, a bag of solutions and a  set   of  solutions.  We first give a
   70simple example, computing the country with the smallest area:
   71
   72```
   73smallest_country(Name, Area) :-
   74    aggregate(min(A, N), country(N, A), min(Area, Name)).
   75```
   76
   77There are four aggregation predicates (aggregate/3, aggregate/4, aggregate_all/3 and aggregate/4), distinguished on two properties.
   78
   79    $ aggregate vs. aggregate_all :
   80    The aggregate predicates use setof/3 (aggregate/4) or bagof/3
   81    (aggregate/3), dealing with existential qualified variables
   82    (`Var^Goal`) and providing multiple solutions for the remaining free
   83    variables in `Goal`. The aggregate_all/3 predicate uses findall/3,
   84    implicitly qualifying all free variables and providing exactly one
   85    solution, while aggregate_all/4 uses sort/2 over solutions that
   86    Discriminator (see below) generated using findall/3.
   87
   88    $ The Discriminator argument :
   89    The versions with 4 arguments deduplicate redundant solutions of
   90    Goal. Solutions for which both the template variables and
   91    Discriminator are identical will be treated as one solution. For
   92    example, if we wish to compute the total population of all
   93    countries, and for some reason =|country(belgium, 11000000)|= may
   94    succeed twice, we can use the following to avoid counting the
   95    population of Belgium twice:
   96
   97    ==
   98        aggregate(sum(P), Name, country(Name, P), Total)
   99    ==
  100
  101All aggregation predicates support  the   following  operators  below in
  102Template. In addition, they allow for  an arbitrary named compound term,
  103where each of the arguments is a term  from the list below. For example,
  104the term r(min(X), max(X)) computes both the minimum and maximum binding
  105for X.
  106
  107        * count
  108        Count number of solutions.  Same as sum(1).
  109        * sum(Expr)
  110        Sum of Expr for all solutions.
  111        * min(Expr)
  112        Minimum of Expr for all solutions.
  113        * min(Expr, Witness)
  114        A term min(Min, Witness), where Min is the minimal version
  115        of Expr over all solutions, and Witness is any other template
  116        applied to solutions that produced Min.  If multiple
  117        solutions provide the same minimum, Witness corresponds to
  118        the first solution.
  119        * max(Expr)
  120        Maximum of Expr for all solutions.
  121        * max(Expr, Witness)
  122        As min(Expr, Witness), but producing the maximum result.
  123        * set(X)
  124        An ordered set with all solutions for X.
  125        * bag(X)
  126        A list of all solutions for X.
  127
  128*Acknowledgements*
  129
  130_|The development of this library was sponsored by SecuritEase,
  131  http://www.securitease.com
  132|_
  133
  134@compat Quintus, SICStus 4. The forall/2 is a SWI-Prolog built-in and
  135        term_variables/3 is a SWI-Prolog built-in with
  136        *|different semantics|*.
  137@tbd    Analysing the aggregation template and compiling a predicate
  138        for the list aggregation can be done at compile time.
  139@tbd    aggregate_all/3 can be rewritten to run in constant space using
  140        non-backtrackable assignment on a term.
  141*/
  142
  143                 /*******************************
  144                 *           AGGREGATE          *
  145                 *******************************/
  146
  147%!  aggregate(+Template, :Goal, -Result) is nondet.
  148%
  149%   Aggregate bindings in Goal according to Template.  The aggregate/3
  150%   version performs bagof/3 on Goal.
  151
  152aggregate(Template, Goal0, Result) :-
  153    template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
  154    bagof(Pattern, Goal, List),
  155    aggregate_list(Aggregate, List, Result).
  156
  157%!  aggregate(+Template, +Discriminator, :Goal, -Result) is nondet.
  158%
  159%   Aggregate bindings in Goal according to Template.  The aggregate/4
  160%   version performs setof/3 on Goal.
  161
  162aggregate(Template, Discriminator, Goal0, Result) :-
  163    template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
  164    setof(Discriminator-Pattern, Goal, Pairs),
  165    pairs_values(Pairs, List),
  166    aggregate_list(Aggregate, List, Result).
  167
  168%!  aggregate_all(+Template, :Goal, -Result) is semidet.
  169%
  170%   Aggregate   bindings   in   Goal   according    to   Template.   The
  171%   aggregate_all/3 version performs findall/3 on   Goal. Note that this
  172%   predicate fails if Template contains one  or more of min(X), max(X),
  173%   min(X,Witness) or max(X,Witness) and Goal   has  no solutions, i.e.,
  174%   the minimum and maximum of an empty set is undefined.
  175%
  176%   The Template values `count`, sum(X),   max(X),  min(X), max(X,W) and
  177%   min(X,W) are processed incrementally rather than using findall/3 and
  178%   run in constant memory.
  179
  180aggregate_all(Var, _, _) :-
  181    var(Var),
  182    !,
  183    instantiation_error(Var).
  184aggregate_all(count, Goal, Count) :-
  185    !,
  186    aggregate_all(sum(1), Goal, Count).
  187aggregate_all(sum(X), Goal, Sum) :-
  188    !,
  189    State = state(0),
  190    (  call(Goal),
  191           arg(1, State, S0),
  192           S is S0 + X,
  193           nb_setarg(1, State, S),
  194           fail
  195    ;  arg(1, State, Sum)
  196    ).
  197aggregate_all(max(X), Goal, Max) :-
  198    !,
  199    State = state(X),
  200    (  call(Goal),
  201           arg(1, State, M0),
  202           M is max(M0,X),
  203           nb_setarg(1, State, M),
  204           fail
  205    ;  arg(1, State, Max),
  206           nonvar(Max)
  207    ).
  208aggregate_all(min(X), Goal, Min) :-
  209    !,
  210    State = state(X),
  211    (  call(Goal),
  212           arg(1, State, M0),
  213           M is min(M0,X),
  214           nb_setarg(1, State, M),
  215           fail
  216    ;  arg(1, State, Min),
  217           nonvar(Min)
  218    ).
  219aggregate_all(max(X,W), Goal, max(Max,Witness)) :-
  220    !,
  221    State = state(false, _Max, _Witness),
  222    (  call(Goal),
  223           (   State = state(true, Max0, _)
  224           ->  X > Max0,
  225               nb_setarg(2, State, X),
  226               nb_setarg(3, State, W)
  227           ;   number(X)
  228           ->  nb_setarg(1, State, true),
  229               nb_setarg(2, State, X),
  230               nb_setarg(3, State, W)
  231           ;   type_error(number, X)
  232           ),
  233           fail
  234    ;  State = state(true, Max, Witness)
  235    ).
  236aggregate_all(min(X,W), Goal, min(Min,Witness)) :-
  237    !,
  238    State = state(false, _Min, _Witness),
  239    (  call(Goal),
  240           (   State = state(true, Min0, _)
  241           ->  X < Min0,
  242               nb_setarg(2, State, X),
  243               nb_setarg(3, State, W)
  244           ;   number(X)
  245           ->  nb_setarg(1, State, true),
  246               nb_setarg(2, State, X),
  247               nb_setarg(3, State, W)
  248           ;   type_error(number, X)
  249           ),
  250           fail
  251    ;  State = state(true, Min, Witness)
  252    ).
  253aggregate_all(Template, Goal0, Result) :-
  254    template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate),
  255    findall(Pattern, Goal, List),
  256    aggregate_list(Aggregate, List, Result).
  257
  258%!  aggregate_all(+Template, +Discriminator, :Goal, -Result) is semidet.
  259%
  260%   Aggregate  bindings  in  Goal   according    to   Template.  The
  261%   aggregate_all/4 version performs findall/3 followed by sort/2 on
  262%   Goal. See aggregate_all/3 to understand   why this predicate can
  263%   fail.
  264
  265aggregate_all(Template, Discriminator, Goal0, Result) :-
  266    template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate),
  267    findall(Discriminator-Pattern, Goal, Pairs0),
  268    sort(Pairs0, Pairs),
  269    pairs_values(Pairs, List),
  270    aggregate_list(Aggregate, List, Result).
  271
  272template_to_pattern(All, Template, Pattern, Goal0, Goal, Aggregate) :-
  273    template_to_pattern(Template, Pattern, Post, Vars, Aggregate),
  274    existential_vars(Goal0, Goal1, AllVars, Vars),
  275    clean_body((Goal1, Post), Goal2),
  276    (   All == bag
  277    ->  add_existential_vars(AllVars, Goal2, Goal)
  278    ;   Goal = Goal2
  279    ).
  280
  281existential_vars(Var, Var) -->
  282    { var(Var) },
  283    !.
  284existential_vars(Var^G0, G) -->
  285    !,
  286    [Var],
  287    existential_vars(G0, G).
  288existential_vars(M:G0, M:G) -->
  289    !,
  290    existential_vars(G0, G).
  291existential_vars(G, G) -->
  292    [].
  293
  294add_existential_vars([], G, G).
  295add_existential_vars([H|T], G0, H^G1) :-
  296    add_existential_vars(T, G0, G1).
  297
  298
  299%!  clean_body(+Goal0, -Goal) is det.
  300%
  301%   Remove redundant =true= from Goal0.
  302
  303clean_body((Goal0,Goal1), Goal) :-
  304    !,
  305    clean_body(Goal0, GoalA),
  306    clean_body(Goal1, GoalB),
  307    (   GoalA == true
  308    ->  Goal = GoalB
  309    ;   GoalB == true
  310    ->  Goal = GoalA
  311    ;   Goal = (GoalA,GoalB)
  312    ).
  313clean_body(Goal, Goal).
  314
  315
  316%!  template_to_pattern(+Template, -Pattern, -Post, -Vars, -Aggregate)
  317%
  318%   Determine which parts of the goal we must remember in the
  319%   findall/3 pattern.
  320%
  321%   @param Post is a body-term that evaluates expressions to reduce
  322%               storage requirements.
  323%   @param Vars is a list of intermediate variables that must be
  324%               added to the existential variables for bagof/3.
  325%   @param Aggregate defines the aggregation operation to execute.
  326
  327template_to_pattern(Term, Pattern, Goal, Vars, Aggregate) :-
  328    templ_to_pattern(Term, Pattern, Goal, Vars, Aggregate),
  329    !.
  330template_to_pattern(Term, Pattern, Goal, Vars, term(MinNeeded, Functor, AggregateArgs)) :-
  331    compound(Term),
  332    !,
  333    Term =.. [Functor|Args0],
  334    templates_to_patterns(Args0, Args, Goal, Vars, AggregateArgs),
  335    needs_one(AggregateArgs, MinNeeded),
  336    Pattern =.. [Functor|Args].
  337template_to_pattern(Term, _, _, _, _) :-
  338    invalid_template(Term).
  339
  340templ_to_pattern(sum(X),           X,         true,    [],   sum) :- var(X), !.
  341templ_to_pattern(sum(X0),          X,         X is X0, [X0], sum) :- !.
  342templ_to_pattern(count,            1,         true,    [],   count) :- !.
  343templ_to_pattern(min(X),           X,         true,    [],   min) :- var(X), !.
  344templ_to_pattern(min(X0),          X,         X is X0, [X0], min) :- !.
  345templ_to_pattern(min(X0, Witness), X-Witness, X is X0, [X0], min_witness) :- !.
  346templ_to_pattern(max(X0),          X,         X is X0, [X0], max) :- !.
  347templ_to_pattern(max(X0, Witness), X-Witness, X is X0, [X0], max_witness) :- !.
  348templ_to_pattern(set(X),           X,         true,    [],   set) :- !.
  349templ_to_pattern(bag(X),           X,         true,    [],   bag) :- !.
  350
  351templates_to_patterns([], [], true, [], []).
  352templates_to_patterns([H0], [H], G, Vars, [A]) :-
  353    !,
  354    sub_template_to_pattern(H0, H, G, Vars, A).
  355templates_to_patterns([H0|T0], [H|T], (G0,G), Vars, [A0|A]) :-
  356    sub_template_to_pattern(H0, H, G0, V0, A0),
  357    append(V0, RV, Vars),
  358    templates_to_patterns(T0, T, G, RV, A).
  359
  360sub_template_to_pattern(Term, Pattern, Goal, Vars, Aggregate) :-
  361    templ_to_pattern(Term, Pattern, Goal, Vars, Aggregate),
  362    !.
  363sub_template_to_pattern(Term, _, _, _, _) :-
  364    invalid_template(Term).
  365
  366invalid_template(Term) :-
  367    callable(Term),
  368    !,
  369    domain_error(aggregate_template, Term).
  370invalid_template(Term) :-
  371    type_error(aggregate_template, Term).
  372
  373%!  needs_one(+Ops, -OneOrZero)
  374%
  375%   If one of the operations in Ops needs at least one answer,
  376%   unify OneOrZero to 1.  Else 0.
  377
  378needs_one(Ops, 1) :-
  379    member(Op, Ops),
  380    needs_one(Op),
  381    !.
  382needs_one(_, 0).
  383
  384needs_one(min).
  385needs_one(min_witness).
  386needs_one(max).
  387needs_one(max_witness).
  388
  389%!  aggregate_list(+Op, +List, -Answer) is semidet.
  390%
  391%   Aggregate the answer  from  the   list  produced  by  findall/3,
  392%   bagof/3 or setof/3. The latter  two   cases  deal  with compound
  393%   answers.
  394%
  395%   @tbd    Compile code for incremental state update, which we will use
  396%           for aggregate_all/3 as well.  We should be using goal_expansion
  397%           to generate these clauses.
  398
  399aggregate_list(bag, List0, List) :-
  400    !,
  401    List = List0.
  402aggregate_list(set, List, Set) :-
  403    !,
  404    sort(List, Set).
  405aggregate_list(sum, List, Sum) :-
  406    sum_list(List, Sum).
  407aggregate_list(count, List, Count) :-
  408    length(List, Count).
  409aggregate_list(max, List, Sum) :-
  410    max_list(List, Sum).
  411aggregate_list(max_witness, List, max(Max, Witness)) :-
  412    max_pair(List, Max, Witness).
  413aggregate_list(min, List, Sum) :-
  414    min_list(List, Sum).
  415aggregate_list(min_witness, List, min(Min, Witness)) :-
  416    min_pair(List, Min, Witness).
  417aggregate_list(term(0, Functor, Ops), List, Result) :-
  418    !,
  419    maplist(state0, Ops, StateArgs, FinishArgs),
  420    State0 =.. [Functor|StateArgs],
  421    aggregate_term_list(List, Ops, State0, Result0),
  422    finish_result(Ops, FinishArgs, Result0, Result).
  423aggregate_list(term(1, Functor, Ops), [H|List], Result) :-
  424    H =.. [Functor|Args],
  425    maplist(state1, Ops, Args, StateArgs, FinishArgs),
  426    State0 =.. [Functor|StateArgs],
  427    aggregate_term_list(List, Ops, State0, Result0),
  428    finish_result(Ops, FinishArgs, Result0, Result).
  429
  430aggregate_term_list([], _, State, State).
  431aggregate_term_list([H|T], Ops, State0, State) :-
  432    step_term(Ops, H, State0, State1),
  433    aggregate_term_list(T, Ops, State1, State).
  434
  435
  436%!  min_pair(+Pairs, -Key, -Value) is det.
  437%!  max_pair(+Pairs, -Key, -Value) is det.
  438%
  439%   True if Key-Value has the  smallest/largest   key  in  Pairs. If
  440%   multiple pairs share the smallest/largest key, the first pair is
  441%   returned.
  442
  443min_pair([M0-W0|T], M, W) :-
  444    min_pair(T, M0, W0, M, W).
  445
  446min_pair([], M, W, M, W).
  447min_pair([M0-W0|T], M1, W1, M, W) :-
  448    (   M0 < M1
  449    ->  min_pair(T, M0, W0, M, W)
  450    ;   min_pair(T, M1, W1, M, W)
  451    ).
  452
  453max_pair([M0-W0|T], M, W) :-
  454    max_pair(T, M0, W0, M, W).
  455
  456max_pair([], M, W, M, W).
  457max_pair([M0-W0|T], M1, W1, M, W) :-
  458    (   M0 > M1
  459    ->  max_pair(T, M0, W0, M, W)
  460    ;   max_pair(T, M1, W1, M, W)
  461    ).
  462
  463%!  step(+AggregateAction, +New, +State0, -State1).
  464
  465step(bag,   X, [X|L], L).
  466step(set,   X, [X|L], L).
  467step(count, _, X0, X1) :-
  468    succ(X0, X1).
  469step(sum,   X, X0, X1) :-
  470    X1 is X0+X.
  471step(max,   X, X0, X1) :-
  472    X1 is max(X0, X).
  473step(min,   X, X0, X1) :-
  474    X1 is min(X0, X).
  475step(max_witness, X-W, X0-W0, X1-W1) :-
  476    (   X > X0
  477    ->  X1 = X, W1 = W
  478    ;   X1 = X0, W1 = W0
  479    ).
  480step(min_witness, X-W, X0-W0, X1-W1) :-
  481    (   X < X0
  482    ->  X1 = X, W1 = W
  483    ;   X1 = X0, W1 = W0
  484    ).
  485step(term(Ops), Row, Row0, Row1) :-
  486    step_term(Ops, Row, Row0, Row1).
  487
  488step_term(Ops, Row, Row0, Row1) :-
  489    functor(Row, Name, Arity),
  490    functor(Row1, Name, Arity),
  491    step_list(Ops, 1, Row, Row0, Row1).
  492
  493step_list([], _, _, _, _).
  494step_list([Op|OpT], Arg, Row, Row0, Row1) :-
  495    arg(Arg, Row, X),
  496    arg(Arg, Row0, X0),
  497    arg(Arg, Row1, X1),
  498    step(Op, X, X0, X1),
  499    succ(Arg, Arg1),
  500    step_list(OpT, Arg1, Row, Row0, Row1).
  501
  502finish_result(Ops, Finish, R0, R) :-
  503    functor(R0, Functor, Arity),
  504    functor(R, Functor, Arity),
  505    finish_result(Ops, Finish, 1, R0, R).
  506
  507finish_result([], _, _, _, _).
  508finish_result([Op|OpT], [F|FT], I, R0, R) :-
  509    arg(I, R0, A0),
  510    arg(I, R, A),
  511    finish_result1(Op, F, A0, A),
  512    succ(I, I2),
  513    finish_result(OpT, FT, I2, R0, R).
  514
  515finish_result1(bag, Bag0, [], Bag) :-
  516    !,
  517    Bag = Bag0.
  518finish_result1(set, Bag,  [], Set) :-
  519    !,
  520    sort(Bag, Set).
  521finish_result1(max_witness, _, M-W, R) :-
  522    !,
  523    R = max(M,W).
  524finish_result1(min_witness, _, M-W, R) :-
  525    !,
  526    R = min(M,W).
  527finish_result1(_, _, A, A).
  528
  529%!  state0(+Op, -State, -Finish)
  530
  531state0(bag,   L, L).
  532state0(set,   L, L).
  533state0(count, 0, _).
  534state0(sum,   0, _).
  535
  536%!  state1(+Op, +First, -State, -Finish)
  537
  538state1(bag, X, L, [X|L]) :- !.
  539state1(set, X, L, [X|L]) :- !.
  540state1(_,   X, X, _).
  541
  542
  543                 /*******************************
  544                 *             FOREACH          *
  545                 *******************************/
  546
  547%!  foreach(:Generator, :Goal)
  548%
  549%   True when the conjunction  of  _instances_   of  Goal  created  from
  550%   solutions for Generator is true. Except for term copying, this could
  551%   be implemented as below.
  552%
  553%   ```
  554%   foreach(Generator, Goal) :-
  555%       findall(Goal, Generator, Goals),
  556%       maplist(call, Goals).
  557%   ```
  558%
  559%   The actual implementation uses findall/3 on  a template created from
  560%   the variables _shared_ between Generator  and Goal. Subsequently, it
  561%   uses every instance of this template  to instantiate Goal, call Goal
  562%   and undo _only_ the instantiation of   the  template and _not_ other
  563%   instantiations created by running Goal.  Here is an example:
  564%
  565%   ```
  566%   ?- foreach(between(1,4,X), dif(X,Y)), Y = 5.
  567%   Y = 5.
  568%   ?- foreach(between(1,4,X), dif(X,Y)), Y = 3.
  569%   false.
  570%   ```
  571%
  572%   The  predicate  foreach/2  is   mostly    used   if   Goal  performs
  573%   backtrackable destructive assignment on  terms. Attributed variables
  574%   (underlying constraints) are  an  example.   Another  example  of  a
  575%   backtrackable data structure is in   library(hashtable).  If we care
  576%   only about the side effects  (I/O,   dynamic  database, etc.) or the
  577%   truth value of Goal,  forall/2 is  a faster and simpler alternative.
  578%   If Goal instantiates its arguments it  is   will  often  fail as the
  579%   argument cannot be instantiated to multiple   values. It is possible
  580%   to incrementally _grow_ an argument:
  581%
  582%   ```
  583%   ?- foreach(between(1,4,X), member(X, L)).
  584%   L = [1,2,3,4|_].
  585%   ```
  586%
  587%   Note that SWI-Prolog up to  version   8.3.4  created  copies of Goal
  588%   using  copy_term/2  for  each  iteration,  this  makes  the  current
  589%   implementation unable to properly handle   compound terms (in Goal's
  590%   arguments) that share variables with the  Generator. As a workaround
  591%   you can define a goal that does not use compound terms, like in this
  592%   example:
  593%
  594%   ```
  595%   mem(E,L) :-  % mem/2 hides the compound argument from foreach/2
  596%      member(r(E),L).
  597%
  598%   ?- foreach(  between(1,5,N), mem(N,L)).
  599%   ```
  600
  601foreach(Generator, Goal) :-
  602    term_variables(Generator, GenVars0), sort(GenVars0, GenVars),
  603    term_variables(Goal, GoalVars0), sort(GoalVars0, GoalVars),
  604    ord_intersection(GenVars, GoalVars, SharedVars),
  605    Templ =.. [v|SharedVars],
  606    findall(Templ, Generator, List),
  607    prove_list(List, Templ, Goal).
  608
  609prove_list([], _, _).
  610prove_list([H|T], Templ, Goal) :-
  611    Templ = H,
  612    call(Goal),
  613    '$unbind_template'(Templ),
  614    prove_list(T, Templ, Goal).
  615
  616
  617%!  free_variables(:Generator, +Template, +VarList0, -VarList) is det.
  618%
  619%   Find free variables in bagof/setof template.  In order to handle
  620%   variables  properly,  we  have  to   find  all  the  universally
  621%   quantified variables in the  Generator.   All  variables  as yet
  622%   unbound are universally quantified, unless
  623%
  624%       1. they occur in the template
  625%       2. they are bound by X^P, setof/3, or bagof/3
  626%
  627%   free_variables(Generator, Template, OldList, NewList) finds this
  628%   set using OldList as an accumulator.
  629%
  630%   @author Richard O'Keefe
  631%   @author Jan Wielemaker (made some SWI-Prolog enhancements)
  632%   @license Public domain (from DEC10 library).
  633%   @tbd Distinguish between control-structures and data terms.
  634%   @tbd Exploit our built-in term_variables/2 at some places?
  635
  636free_variables(Term, Bound, VarList, [Term|VarList]) :-
  637    var(Term),
  638    term_is_free_of(Bound, Term),
  639    list_is_free_of(VarList, Term),
  640    !.
  641free_variables(Term, _Bound, VarList, VarList) :-
  642    var(Term),
  643    !.
  644free_variables(Term, Bound, OldList, NewList) :-
  645    explicit_binding(Term, Bound, NewTerm, NewBound),
  646    !,
  647    free_variables(NewTerm, NewBound, OldList, NewList).
  648free_variables(Term, Bound, OldList, NewList) :-
  649    functor(Term, _, N),
  650    free_variables(N, Term, Bound, OldList, NewList).
  651
  652free_variables(0, _, _, VarList, VarList) :- !.
  653free_variables(N, Term, Bound, OldList, NewList) :-
  654    arg(N, Term, Argument),
  655    free_variables(Argument, Bound, OldList, MidList),
  656    M is N-1,
  657    !,
  658    free_variables(M, Term, Bound, MidList, NewList).
  659
  660%   explicit_binding checks for goals known to existentially quantify
  661%   one or more variables.  In particular \+ is quite common.
  662
  663explicit_binding(\+ _Goal,             Bound, fail,     Bound      ) :- !.
  664explicit_binding(not(_Goal),           Bound, fail,     Bound      ) :- !.
  665explicit_binding(Var^Goal,             Bound, Goal,     Bound+Var) :- !.
  666explicit_binding(setof(Var,Goal,Set),  Bound, Goal-Set, Bound+Var) :- !.
  667explicit_binding(bagof(Var,Goal,Bag),  Bound, Goal-Bag, Bound+Var) :- !.
  668
  669%!  term_is_free_of(+Term, +Var) is semidet.
  670%
  671%   True if Var does not appear  in   Term.  This has been rewritten
  672%   from the DEC10 library source   to exploit our non-deterministic
  673%   arg/3.
  674
  675term_is_free_of(Term, Var) :-
  676    \+ var_in_term(Term, Var).
  677
  678var_in_term(Term, Var) :-
  679    Var == Term,
  680    !.
  681var_in_term(Term, Var) :-
  682    compound(Term),
  683    arg(_, Term, Arg),
  684    var_in_term(Arg, Var),
  685    !.
  686
  687
  688%!  list_is_free_of(+List, +Var) is semidet.
  689%
  690%   True if Var is not in List.
  691
  692list_is_free_of([Head|Tail], Var) :-
  693    Head \== Var,
  694    !,
  695    list_is_free_of(Tail, Var).
  696list_is_free_of([], _).
  697
  698
  699%       term_variables(+Term, +Vars0, -Vars) is det.
  700%
  701%       True if Vars is the union of variables in Term and Vars0.
  702%       We cannot have this as term_variables/3 is already defined
  703%       as a difference-list version of term_variables/2.
  704
  705%term_variables(Term, Vars0, Vars) :-
  706%       term_variables(Term+Vars0, Vars).
  707
  708
  709%!  sandbox:safe_meta(+Goal, -Called) is semidet.
  710%
  711%   Declare the aggregate meta-calls safe. This cannot be proven due
  712%   to the manipulations of the argument Goal.
  713
  714:- multifile sandbox:safe_meta_predicate/1.  715
  716sandbox:safe_meta_predicate(aggregate:foreach/2).
  717sandbox:safe_meta_predicate(aggregate:aggregate/3).
  718sandbox:safe_meta_predicate(aggregate:aggregate/4).
  719sandbox:safe_meta_predicate(aggregate:aggregate_all/3).
  720sandbox:safe_meta_predicate(aggregate:aggregate_all/4)