/**
         
 * Warranty & Liability
         
 * To the extent permitted by applicable law and unless explicitly
         
 * otherwise agreed upon, XLOG Technologies AG makes no warranties
         
 * regarding the provided information. XLOG Technologies AG assumes
         
 * no liability that any problems might be solved with the information
         
 * provided by XLOG Technologies AG.
         
 *
         
 * Rights & License
         
 * All industrial property rights regarding the information - copyright
         
 * and patent rights in particular - are the sole property of XLOG
         
 * Technologies AG. If the company was not the originator of some
         
 * excerpts, XLOG Technologies AG has at least obtained the right to
         
 * reproduce, change and translate the information.
         
 *
         
 * Reproduction is restricted to the whole unaltered document. Reproduction
         
 * of the information is only allowed for non-commercial uses. Selling,
         
 * giving away or letting of the execution of the library is prohibited.
         
 * The library can be distributed as part of your applications and libraries
         
 * for execution provided this comment remains unchanged.
         
 *
         
 * Restrictions
         
 * Only to be distributed with programs that add significant and primary
         
 * functionality to the library. Not to be distributed with additional
         
 * software intended to replace any components of the library.
         
 *
         
 * Trademarks
         
 * Jekejeke is a registered trademark of XLOG Technologies AG.
         
 */
         

         
:- ensure_loaded(library(compat)).
         
:- ensure_loaded(library(lists)).
         
:- ensure_loaded(library(util/hash)).
         

         
/************************************************************/
         
/* bagof/3 and setof/3                                      */
         
/************************************************************/
         

         
/**
         
 * bagof(T, Q, L): [ISO 8.10.2]
         
 * The predicate determines all the solutions to the quantified
         
 * goal Q, whereby collecting copies of the template T and the witness
         
 * to the quantified goal Q. The predicate then repeatedly succeeds
         
 * for the witness and the list of associated templates in L.
         
 */
         
% bagof(+Term, +Quant, -List)
         
bagof(Template, Quant, List) :-
         
   aggregate(bag(Template), Quant, List).
         

         
/**
         
 * setof(T, Q, L): [ISO 8.10.3]
         
 * The predicate determines all the solutions to the quantified
         
 * goal Q, whereby collecting copies of the template T and the witness
         
 * to the quantified goal Q. The predicate then repeatedly succeeds
         
 * for the witness and the set of associated templates in L.
         
 */
         
% setof(+Term, +Quant, -List)
         
setof(Template, Quant, List) :-
         
   aggregate(set(Template), Quant, List).
         

         
/************************************************************/
         
/* aggregate_all/3 and aggregate/3                          */
         
/************************************************************/
         

         
/**
         
 * aggregate_all(A, G, R):
         
 * The predicate aggregates A for the solutions of the
         
 * goal G and unifies the result with R. Works like findall/3,
         
 * without witness grouping. The following aggregates are supported.
         
 * See documentation for the supported aggregates functions.
         
 */
         
% aggregate_all(+Aggregate, +Goal, -Term)
         
aggregate_all(Aggregate, Goal, Result) :-
         
   sys_aggr_init(Aggregate, T),
         
   (Goal, sys_aggr_next(Aggregate, T),
         
      fail; true),
         
   sys_aggr_fini(Aggregate, T, Result).
         

         
/**
         
 * aggregate(A, Q, R):
         
 * The predicate aggregates A for the solutions of the quantified
         
 * goal Q and unifies the result with R. Works like bagof/3, with
         
 * witness grouping.
         
 */
         
% aggregate(+Aggregate, +Quant, -Term)
         
aggregate(Aggregate, Quant, Result) :-
         
   free_variables(Aggregate^Quant, Key, Goal),
         
   hash_new(Hash),
         
   (Goal, numbervars(Key, 0, _),
         
      sys_aggr_init_next(Hash, Key, Aggregate),
         
      fail; true),
         
   hash_pairs(Hash, R),
         
   keysort(R, L),
         
   member(V-T, L),
         
   sys_aggr_fini(Aggregate, T, J),
         
   unnumbervars(V-J, 0, Key-Result).
         

         
% sys_aggr_init_next(+Hash, +Term, +Aggregate)
         
sys_aggr_init_next(Hash, Key, A) :-
         
   hash_current(Hash, Key, T), !,
         
   sys_aggr_next(A, T).
         
sys_aggr_init_next(Hash, Key, A) :-
         
   sys_aggr_init(A, T),
         
   copy_term(Key, Key2),
         
   hash_add(Hash, Key2, T),
         
   sys_aggr_next(A, T).
         

         
/************************************************************/
         
/* Procedural Aggregates                                    */
         
/************************************************************/
         

         
% sys_aggr_init(+Aggregate, -Term)
         
sys_aggr_init(A, _) :- var(A),
         
   throw(error(instantiation_error,_)).
         
sys_aggr_init(count, X) :- !, X = v(_), change_arg(1, X, 0).
         
sys_aggr_init(sum(_), X) :- !, X = v(_), change_arg(1, X, 0).
         
sys_aggr_init(mul(_), X) :- !, X = v(_), change_arg(1, X, 1).
         
sys_aggr_init(min(_), X) :- !, X = v(_), change_arg(1, X, sup).
         
sys_aggr_init(max(_), X) :- !, X = v(_), change_arg(1, X, inf).
         
sys_aggr_init(bag(_), X) :- !, sys_find_init(X).
         
sys_aggr_init(set(_), X) :- !, sys_find_init(X).
         
sys_aggr_init((F,G), Z) :- !, Z = (_,_),
         
   sys_aggr_init(F, X), change_arg(1, Z, X),
         
   sys_aggr_init(G, Y), change_arg(2, Z, Y).
         
sys_aggr_init(A, _) :-
         
   throw(error(type_error(aggregate,A),_)).
         

         
% sys_aggr_next(+Aggregate, +Term)
         
sys_aggr_next(count, Y) :- arg(1, Y, H), J is H+1, change_arg(1, Y, J).
         
sys_aggr_next(sum(X), Y) :- arg(1, Y, H), J is H+X, change_arg(1, Y, J).
         
sys_aggr_next(mul(X), Y) :- arg(1, Y, H), J is H*X, change_arg(1, Y, J).
         
sys_aggr_next(min(X), Y) :- arg(1, Y, H), sys_min(H, X, J), change_arg(1, Y, J).
         
sys_aggr_next(max(X), Y) :- arg(1, Y, H), sys_max(H, X, J), change_arg(1, Y, J).
         
sys_aggr_next(bag(X), Y) :- sys_find_next(X, Y).
         
sys_aggr_next(set(X), Y) :- sys_find_next(X, Y).
         
sys_aggr_next((F,G), (X,Y)) :-
         
   sys_aggr_next(F, X),
         
   sys_aggr_next(G, Y).
         

         
% sys_aggr_fini(+Aggregate, +Term, -Term)
         
sys_aggr_fini(count, X, A) :- arg(1, X, A).
         
sys_aggr_fini(sum(_), X, A) :- arg(1, X, A).
         
sys_aggr_fini(mul(_), X, A) :- arg(1, X, A).
         
sys_aggr_fini(min(_), X, A) :- arg(1, X, A).
         
sys_aggr_fini(max(_), X, A) :- arg(1, X, A).
         
sys_aggr_fini(bag(_), X, A) :- sys_find_fini(X, A).
         
sys_aggr_fini(set(_), X, A) :- sys_find_fini(X, H), sort(H, A).
         
sys_aggr_fini((F,G), (X,Y), (C,D)) :-
         
   sys_aggr_fini(F, X, C),
         
   sys_aggr_fini(G, Y, D).
         

         
/********************************************************************/
         
/* min/3 and max/3 Helper                                           */
         
/********************************************************************/
         

         
% sys_min(+ExtNumber, +ExtNumber, -ExtNumber)
         
sys_min(sup, X, R) :- !, R = X.
         
sys_min(X, sup, R) :- !, R = X.
         
sys_min(inf, _, R) :- !, R = inf.
         
sys_min(_, inf, R) :- !, R = inf.
         
sys_min(X, Y, R) :- R is min(X, Y).
         

         
% sys_max(+ExtNumber, +ExtNumber, -ExtNumber)
         
sys_max(inf, X, R) :- !, R = X.
         
sys_max(X, inf, R) :- !, R = X.
         
sys_max(sup, _, R) :- !, R = sup.
         
sys_max(_, sup, R) :- !, R = sup.
         
sys_max(X, Y, R) :- R is max(X, Y).