add missing files
This commit is contained in:
Vítor Santos Costa
parent
f499115573
commit
d96461f04c
544
library/aggregate.pl
Executable file
544
library/aggregate.pl
Executable file
@ -0,0 +1,544 @@
|
|||||||
|
/* $Id: aggregate.pl,v 1.4 2008-07-22 23:34:49 vsc Exp $
|
||||||
|
|
||||||
|
Part of SWI-Prolog
|
||||||
|
|
||||||
|
Author: Jan Wielemaker
|
||||||
|
E-mail: wielemak@science.uva.nl
|
||||||
|
WWW: http://www.swi-prolog.org
|
||||||
|
Copyright (C): 2008, University of Amsterdam
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License
|
||||||
|
as published by the Free Software Foundation; either version 2
|
||||||
|
of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public
|
||||||
|
License along with this library; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
As a special exception, if you link this library with other files,
|
||||||
|
compiled with a Free Software compiler, to produce an executable, this
|
||||||
|
library does not by itself cause the resulting executable to be covered
|
||||||
|
by the GNU General Public License. This exception does not however
|
||||||
|
invalidate any other reasons why the executable file might be covered by
|
||||||
|
the GNU General Public License.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- module(aggretate,
|
||||||
|
[ foreach/2, % :Generator, :Goal
|
||||||
|
aggregate/3, % +Templ, :Goal, -Result
|
||||||
|
aggregate/4, % +Templ, +Discrim, :Goal, -Result
|
||||||
|
aggregate_all/3, % +Templ, :Goal, -Result
|
||||||
|
aggregate_all/4, % +Templ, +Discrim, :Goal, -Result
|
||||||
|
free_variables/4 % :Generator, :Template, +Vars0, -Vars
|
||||||
|
]).
|
||||||
|
:- use_module(library(ordsets)).
|
||||||
|
:- use_module(library(pairs)).
|
||||||
|
:- use_module(library(error)).
|
||||||
|
:- use_module(library(lists)).
|
||||||
|
|
||||||
|
:- module_transparent
|
||||||
|
foreach/2,
|
||||||
|
aggregate/3,
|
||||||
|
aggregate/4,
|
||||||
|
aggregate_all/3,
|
||||||
|
aggregate_all/4.
|
||||||
|
|
||||||
|
/** <module> Aggregation operators on backtrackable predicates
|
||||||
|
|
||||||
|
This library provides aggregating operators over the solutions of a
|
||||||
|
predicate. The operations are a generalisation of the bagof/3, setof/3
|
||||||
|
and findall/3 built-in predicates. The defined aggregation operations
|
||||||
|
are counting, computing the sum, minimum, maximum, a bag of solutions
|
||||||
|
and a set of solutions. We first give a simple example, computing the
|
||||||
|
country with the smallest area:
|
||||||
|
|
||||||
|
==
|
||||||
|
average_country_area(Name, Area) :-
|
||||||
|
aggregate(min(A, N), country(N, A), min(Area, Name)).
|
||||||
|
==
|
||||||
|
|
||||||
|
There are four aggregation predicates, distinguished on two properties.
|
||||||
|
|
||||||
|
$ aggregate vs. aggregate_all :
|
||||||
|
The aggregate predicates use setof/3 (aggregate/4) or bagof/3
|
||||||
|
(aggregate/3), dealing with existential qualified variables
|
||||||
|
(Var^Goal) and providing multiple solutions for the remaining free
|
||||||
|
variables in Goal. The aggregate_all/3 predicate uses findall/3,
|
||||||
|
implicitely qualifying all free variables and providing exactly one
|
||||||
|
solution, while aggregate_all/4 uses sort/2 over solutions and
|
||||||
|
Distinguish (see below) generated using findall/3.
|
||||||
|
|
||||||
|
$ The Distinguish argument :
|
||||||
|
The versions with 4 arguments provide a Distinguish argument that
|
||||||
|
allow for keeping duplicate bindings of a variable in the result.
|
||||||
|
For example, if we wish to compute the total population of all
|
||||||
|
countries we do not want to loose results because two countries
|
||||||
|
have the same population. Therefore we use:
|
||||||
|
|
||||||
|
==
|
||||||
|
aggregate(sum(P), Name, country(Name, P), Total)
|
||||||
|
==
|
||||||
|
|
||||||
|
All aggregation predicates support the following operator below in
|
||||||
|
Template. In addition, they allow for an arbitrary named compound term
|
||||||
|
where each of the arguments is a term from the list below. I.e. the term
|
||||||
|
r(min(X), max(X)) computes both the minimum and maximum binding for X.
|
||||||
|
|
||||||
|
* count
|
||||||
|
Count number of solutions. Same as sum(1).
|
||||||
|
* sum(Expr)
|
||||||
|
Sum of Expr for all solutions.
|
||||||
|
* min(Expr)
|
||||||
|
Minimum of Expr for all solutions.
|
||||||
|
* min(Expr, Witness)
|
||||||
|
A term min(Min, Witness), where Min is the minimal version
|
||||||
|
of Expr over all Solution and Witness is any other template
|
||||||
|
the applied to the solution that produced Min. If multiple
|
||||||
|
solutions provide the same minimum, Witness corresponds to
|
||||||
|
the first solution.
|
||||||
|
* max(Expr)
|
||||||
|
Maximum of Expr for all solutions.
|
||||||
|
* max(Expr, Witness)
|
||||||
|
As min(Expr, Witness), but producing the maximum result.
|
||||||
|
* set(X)
|
||||||
|
An ordered set with all solutions for X.
|
||||||
|
* bag(X)
|
||||||
|
A list of all solutions for X.
|
||||||
|
|
||||||
|
---+++ Acknowledgements
|
||||||
|
|
||||||
|
_|The development of this library was sponsored by SecuritEase,
|
||||||
|
http://www.securitease.com
|
||||||
|
|_
|
||||||
|
|
||||||
|
@compat Quintus, SICStus 4. The forall/2 is a SWI-Prolog built-in and
|
||||||
|
term_variables/3 is a SWI-Prolog with a *|different definition|*.
|
||||||
|
@tbd Analysing the aggregation template and compiling a predicate
|
||||||
|
for the list aggregation can be done at compile time.
|
||||||
|
@tbd aggregate_all/3 can be rewritten to run in constant space using
|
||||||
|
non-backtrackable assignment on a term.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/*******************************
|
||||||
|
* AGGREGATE *
|
||||||
|
*******************************/
|
||||||
|
|
||||||
|
%% aggregate(+Template, :Goal, -Result) is nondet.
|
||||||
|
%
|
||||||
|
% Aggregate bindings in Goal according to Template. The aggregate/3
|
||||||
|
% version performs bagof/3 on Goal.
|
||||||
|
|
||||||
|
aggregate(Template, Goal0, Result) :-
|
||||||
|
template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
|
||||||
|
bagof(Pattern, Goal, List),
|
||||||
|
aggregate_list(Aggregate, List, Result).
|
||||||
|
|
||||||
|
%% aggregate(+Template, +Discriminator, :Goal, -Result) is nondet.
|
||||||
|
%
|
||||||
|
% Aggregate bindings in Goal according to Template. The aggregate/3
|
||||||
|
% version performs setof/3 on Goal.
|
||||||
|
|
||||||
|
aggregate(Template, Discriminator, Goal0, Result) :-
|
||||||
|
template_to_pattern(bag, Template, Pattern, Goal0, Goal, Aggregate),
|
||||||
|
setof(Discriminator-Pattern, Goal, Pairs),
|
||||||
|
pairs_values(Pairs, List),
|
||||||
|
aggregate_list(Aggregate, List, Result).
|
||||||
|
|
||||||
|
%% aggregate_all(+Template, :Goal, -Result) is semidet.
|
||||||
|
%
|
||||||
|
% Aggregate bindings in Goal according to Template. The aggregate_all/3
|
||||||
|
% version performs findall/3 on Goal.
|
||||||
|
|
||||||
|
aggregate_all(Template, Goal0, Result) :-
|
||||||
|
template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate),
|
||||||
|
findall(Pattern, Goal, List),
|
||||||
|
aggregate_list(Aggregate, List, Result).
|
||||||
|
|
||||||
|
%% aggregate_all(+Template, +Discriminator, :Goal, -Result) is semidet.
|
||||||
|
%
|
||||||
|
% Aggregate bindings in Goal according to Template. The aggregate_all/3
|
||||||
|
% version performs findall/3 followed by sort/2 on Goal.
|
||||||
|
|
||||||
|
aggregate_all(Template, Discriminator, Goal0, Result) :-
|
||||||
|
template_to_pattern(all, Template, Pattern, Goal0, Goal, Aggregate),
|
||||||
|
findall(Discriminator-Pattern, Goal, Pairs0),
|
||||||
|
sort(Pairs0, Pairs),
|
||||||
|
pairs_values(Pairs, List),
|
||||||
|
aggregate_list(Aggregate, List, Result).
|
||||||
|
|
||||||
|
|
||||||
|
template_to_pattern(_All, Template, Pattern, Goal0, Goal, Aggregate) :-
|
||||||
|
template_to_pattern(Template, Pattern, Post, Vars, Aggregate),
|
||||||
|
existential_vars(Goal0, Goal1, AllVars, Vars),
|
||||||
|
clean_body((Goal1, Post), Goal2),
|
||||||
|
add_existential_vars(AllVars, Goal2, Goal).
|
||||||
|
|
||||||
|
existential_vars(Var, Var) -->
|
||||||
|
{ var(Var) }, !.
|
||||||
|
existential_vars(Var^G0, G) --> !,
|
||||||
|
[Var],
|
||||||
|
existential_vars(G0, G).
|
||||||
|
existential_vars(G, G) -->
|
||||||
|
[].
|
||||||
|
|
||||||
|
add_existential_vars([], G, G).
|
||||||
|
add_existential_vars([H|T], G0, H^G1) :-
|
||||||
|
add_existential_vars(T, G0, G1).
|
||||||
|
|
||||||
|
|
||||||
|
%% clean_body(+Goal0, -Goal) is det.
|
||||||
|
%
|
||||||
|
% Remove redundant =true= from Goal0.
|
||||||
|
|
||||||
|
clean_body((Goal0,Goal1), Goal) :- !,
|
||||||
|
clean_body(Goal0, GoalA),
|
||||||
|
clean_body(Goal1, GoalB),
|
||||||
|
( GoalA == true
|
||||||
|
-> Goal = GoalB
|
||||||
|
; GoalB == true
|
||||||
|
-> Goal = GoalA
|
||||||
|
; Goal = (GoalA,GoalB)
|
||||||
|
).
|
||||||
|
clean_body(Goal, Goal).
|
||||||
|
|
||||||
|
|
||||||
|
%% template_to_pattern(+Template, -Pattern, -Post, -Vars, -Agregate)
|
||||||
|
%
|
||||||
|
% Determine which parts of the goal we must remember in the
|
||||||
|
% findall/3 pattern.
|
||||||
|
%
|
||||||
|
% @param Post is a body-term that evaluates expressions to reduce
|
||||||
|
% storage requirements.
|
||||||
|
% @param Vars is a list of intermediate variables that must be
|
||||||
|
% added to the existential variables for bagof/3.
|
||||||
|
% @param Agregate defines the aggregation operation to execute.
|
||||||
|
|
||||||
|
template_to_pattern(sum(X), X, true, [], sum) :- var(X), !.
|
||||||
|
template_to_pattern(sum(X0), X, X is X0, [X0], sum) :- !.
|
||||||
|
template_to_pattern(count, 1, true, [], count) :- !.
|
||||||
|
template_to_pattern(min(X), X, true, [], min) :- var(X), !.
|
||||||
|
template_to_pattern(min(X0), X, X is X0, [X0], min) :- !.
|
||||||
|
template_to_pattern(min(X0, Witness), X-Witness, X is X0, [X0], min_witness) :- !.
|
||||||
|
template_to_pattern(max(X0), X, X is X0, [X0], max) :- !.
|
||||||
|
template_to_pattern(max(X0, Witness), X-Witness, X is X0, [X0], max_witness) :- !.
|
||||||
|
template_to_pattern(set(X), X, true, [], set) :- !.
|
||||||
|
template_to_pattern(bag(X), X, true, [], bag) :- !.
|
||||||
|
template_to_pattern(Term, Pattern, Goal, Vars, term(MinNeeded, Functor, AggregateArgs)) :-
|
||||||
|
compound(Term), !,
|
||||||
|
Term =.. [Functor|Args0],
|
||||||
|
templates_to_patterns(Args0, Args, Goal, Vars, AggregateArgs),
|
||||||
|
needs_one(AggregateArgs, MinNeeded),
|
||||||
|
Pattern =.. [Functor|Args].
|
||||||
|
template_to_pattern(Term, _, _, _, _) :-
|
||||||
|
type_error(aggregate_template, Term).
|
||||||
|
|
||||||
|
templates_to_patterns([], [], true, [], []).
|
||||||
|
templates_to_patterns([H0], [H], G, Vars, [A]) :- !,
|
||||||
|
template_to_pattern(H0, H, G, Vars, A).
|
||||||
|
templates_to_patterns([H0|T0], [H|T], (G0,G), Vars, [A0|A]) :-
|
||||||
|
template_to_pattern(H0, H, G0, V0, A0),
|
||||||
|
append(V0, RV, Vars),
|
||||||
|
templates_to_patterns(T0, T, G, RV, A).
|
||||||
|
|
||||||
|
%% needs_one(+Ops, -OneOrZero)
|
||||||
|
%
|
||||||
|
% If one of the operations in Ops needs at least one answer,
|
||||||
|
% unify OneOrZero to 1. Else 0.
|
||||||
|
|
||||||
|
needs_one(Ops, 1) :-
|
||||||
|
member(Op, Ops),
|
||||||
|
needs_one(Op), !.
|
||||||
|
needs_one(_, 0).
|
||||||
|
|
||||||
|
needs_one(min).
|
||||||
|
needs_one(min_witness).
|
||||||
|
needs_one(max).
|
||||||
|
needs_one(max_witness).
|
||||||
|
|
||||||
|
%% aggregate_list(+Op, +List, -Answer) is semidet.
|
||||||
|
%
|
||||||
|
% Aggregate the answer from the list produced by findall/3,
|
||||||
|
% bagof/3 or setof/3. The latter two cases deal with compound
|
||||||
|
% answers.
|
||||||
|
%
|
||||||
|
% @tbd Compile code for incremental state update, which we will use
|
||||||
|
% for aggregate_all/3 as well. We should be using goal_expansion
|
||||||
|
% to generate these clauses.
|
||||||
|
|
||||||
|
aggregate_list(bag, List0, List) :- !,
|
||||||
|
List = List0.
|
||||||
|
aggregate_list(set, List, Set) :- !,
|
||||||
|
sort(List, Set).
|
||||||
|
aggregate_list(sum, List, Sum) :-
|
||||||
|
sumlist(List, Sum).
|
||||||
|
aggregate_list(count, List, Count) :-
|
||||||
|
length(List, Count).
|
||||||
|
aggregate_list(max, List, Sum) :-
|
||||||
|
max_list(List, Sum).
|
||||||
|
aggregate_list(max_witness, List, max(Max, Witness)) :-
|
||||||
|
max_pair(List, Max, Witness).
|
||||||
|
aggregate_list(min, List, Sum) :-
|
||||||
|
min_list(List, Sum).
|
||||||
|
aggregate_list(min_witness, List, min(Min, Witness)) :-
|
||||||
|
min_pair(List, Min, Witness).
|
||||||
|
aggregate_list(term(0, Functor, Ops), List, Result) :- !,
|
||||||
|
maplist(state0, Ops, StateArgs, FinishArgs),
|
||||||
|
State0 =.. [Functor|StateArgs],
|
||||||
|
aggregate_term_list(List, Ops, State0, Result0),
|
||||||
|
finish_result(Ops, FinishArgs, Result0, Result).
|
||||||
|
aggregate_list(term(1, Functor, Ops), [H|List], Result) :-
|
||||||
|
H =.. [Functor|Args],
|
||||||
|
maplist(state1, Ops, Args, StateArgs, FinishArgs),
|
||||||
|
State0 =.. [Functor|StateArgs],
|
||||||
|
aggregate_term_list(List, Ops, State0, Result0),
|
||||||
|
finish_result(Ops, FinishArgs, Result0, Result).
|
||||||
|
|
||||||
|
aggregate_term_list([], _, State, State).
|
||||||
|
aggregate_term_list([H|T], Ops, State0, State) :-
|
||||||
|
step_term(Ops, H, State0, State1),
|
||||||
|
aggregate_term_list(T, Ops, State1, State).
|
||||||
|
|
||||||
|
|
||||||
|
%% min_pair(+Pairs, -Key, -Value) is det.
|
||||||
|
%% max_pair(+Pairs, -Key, -Value) is det.
|
||||||
|
%
|
||||||
|
% True if Key-Value has the smallest/largest key in Pairs. If
|
||||||
|
% multiple pairs share the smallest/largest key, the first pair is
|
||||||
|
% returned.
|
||||||
|
|
||||||
|
min_pair([M0-W0|T], M, W) :-
|
||||||
|
min_pair(T, M0, W0, M, W).
|
||||||
|
|
||||||
|
min_pair([], M, W, M, W).
|
||||||
|
min_pair([M0-W0|T], M1, W1, M, W) :-
|
||||||
|
( M0 > M1
|
||||||
|
-> min_pair(T, M0, W0, M, W)
|
||||||
|
; min_pair(T, M1, W1, M, W)
|
||||||
|
).
|
||||||
|
|
||||||
|
max_pair([M0-W0|T], M, W) :-
|
||||||
|
max_pair(T, M0, W0, M, W).
|
||||||
|
|
||||||
|
max_pair([], M, W, M, W).
|
||||||
|
max_pair([M0-W0|T], M1, W1, M, W) :-
|
||||||
|
( M0 > M1
|
||||||
|
-> max_pair(T, M0, W0, M, W)
|
||||||
|
; max_pair(T, M1, W1, M, W)
|
||||||
|
).
|
||||||
|
|
||||||
|
%% step(+AggregateAction, +New, +State0, -State1).
|
||||||
|
|
||||||
|
step(bag, X, [X|L], L).
|
||||||
|
step(set, X, [X|L], L).
|
||||||
|
step(count, _, X0, X1) :-
|
||||||
|
succ(X0, X1).
|
||||||
|
step(sum, X, X0, X1) :-
|
||||||
|
X1 is X0+X.
|
||||||
|
step(max, X, X0, X1) :-
|
||||||
|
X1 is max(X0, X).
|
||||||
|
step(min, X, X0, X1) :-
|
||||||
|
X1 is min(X0, X).
|
||||||
|
step(max_witness, X-W, X0-W0, X1-W1) :-
|
||||||
|
( X > X0
|
||||||
|
-> X1 = X, W1 = W
|
||||||
|
; X1 = X0, W1 = W0
|
||||||
|
).
|
||||||
|
step(min_witness, X-W, X0-W0, X1-W1) :-
|
||||||
|
( X < X0
|
||||||
|
-> X1 = X, W1 = W
|
||||||
|
; X1 = X0, W1 = W0
|
||||||
|
).
|
||||||
|
step(term(Ops), Row, Row0, Row1) :-
|
||||||
|
step_term(Ops, Row, Row0, Row1).
|
||||||
|
|
||||||
|
step_term(Ops, Row, Row0, Row1) :-
|
||||||
|
functor(Row, Name, Arity),
|
||||||
|
functor(Row1, Name, Arity),
|
||||||
|
step_list(Ops, 1, Row, Row0, Row1).
|
||||||
|
|
||||||
|
step_list([], _, _, _, _).
|
||||||
|
step_list([Op|OpT], Arg, Row, Row0, Row1) :-
|
||||||
|
arg(Arg, Row, X),
|
||||||
|
arg(Arg, Row0, X0),
|
||||||
|
arg(Arg, Row1, X1),
|
||||||
|
step(Op, X, X0, X1),
|
||||||
|
succ(Arg, Arg1),
|
||||||
|
step_list(OpT, Arg1, Row, Row0, Row1).
|
||||||
|
|
||||||
|
finish_result(Ops, Finish, R0, R) :-
|
||||||
|
functor(R0, Functor, Arity),
|
||||||
|
functor(R, Functor, Arity),
|
||||||
|
finish_result(Ops, Finish, 1, R0, R).
|
||||||
|
|
||||||
|
finish_result([], _, _, _, _).
|
||||||
|
finish_result([Op|OpT], [F|FT], I, R0, R) :-
|
||||||
|
arg(I, R0, A0),
|
||||||
|
arg(I, R, A),
|
||||||
|
finish_result1(Op, F, A0, A),
|
||||||
|
succ(I, I2),
|
||||||
|
finish_result(OpT, FT, I2, R0, R).
|
||||||
|
|
||||||
|
finish_result1(bag, Bag0, [], Bag) :- !,
|
||||||
|
Bag = Bag0.
|
||||||
|
finish_result1(set, Bag, [], Set) :- !,
|
||||||
|
sort(Bag, Set).
|
||||||
|
finish_result1(max_witness, _, M-W, R) :- !,
|
||||||
|
R = max(M,W).
|
||||||
|
finish_result1(min_witness, _, M-W, R) :- !,
|
||||||
|
R = min(M,W).
|
||||||
|
finish_result1(_, _, A, A).
|
||||||
|
|
||||||
|
%% state0(+Op, -State, -Finish)
|
||||||
|
|
||||||
|
state0(bag, L, L).
|
||||||
|
state0(set, L, L).
|
||||||
|
state0(count, 0, _).
|
||||||
|
state0(sum, 0, _).
|
||||||
|
|
||||||
|
%% state1(+Op, +First, -State, -Finish)
|
||||||
|
|
||||||
|
state1(bag, X, [X|L], L).
|
||||||
|
state1(set, X, [X|L], L).
|
||||||
|
state1(_, X, X, _).
|
||||||
|
|
||||||
|
|
||||||
|
/*******************************
|
||||||
|
* FOREACH *
|
||||||
|
*******************************/
|
||||||
|
|
||||||
|
%% foreach(:Generator, :Goal)
|
||||||
|
%
|
||||||
|
% True if the conjunction of instances of Goal using the bindings
|
||||||
|
% from Generator is true. Unlike forall/2, which runs a
|
||||||
|
% failure-driven loop that proves Goal for each solution of
|
||||||
|
% Generator, foreach creates a conjunction. Each member of the
|
||||||
|
% conjunction is a copy of Goal, where the variables it shares
|
||||||
|
% with Generator are filled with the values from the corresponding
|
||||||
|
% solution.
|
||||||
|
%
|
||||||
|
% The implementation executes forall/2 if Goal does not contain
|
||||||
|
% any variables that are not shared with Generator.
|
||||||
|
%
|
||||||
|
% Here is an example:
|
||||||
|
%
|
||||||
|
% ==
|
||||||
|
% ?- foreach(between(1,4,X), dif(X,Y)), Y = 5.
|
||||||
|
% Y = 5
|
||||||
|
% ?- foreach(between(1,4,X), dif(X,Y)), Y = 3.
|
||||||
|
% No
|
||||||
|
% ==
|
||||||
|
%
|
||||||
|
% @bug Goal is copied repeatetly, which may cause problems if
|
||||||
|
% attributed variables are involved.
|
||||||
|
|
||||||
|
foreach(Generator, Goal0) :-
|
||||||
|
strip_module(Goal0, M, G),
|
||||||
|
Goal = M:G,
|
||||||
|
term_variables(Generator, GenVars0), sort(GenVars0, GenVars),
|
||||||
|
term_variables(Goal, GoalVars0), sort(GoalVars0, GoalVars),
|
||||||
|
ord_subtract(GoalVars, GenVars, SharedGoalVars),
|
||||||
|
( SharedGoalVars == []
|
||||||
|
-> \+ (Generator, \+Goal) % = forall(Generator, Goal)
|
||||||
|
; ord_intersection(GenVars, GoalVars, SharedVars),
|
||||||
|
Templ =.. [v|SharedVars],
|
||||||
|
SharedTempl =.. [v|SharedGoalVars],
|
||||||
|
findall(Templ, Generator, List),
|
||||||
|
prove_list(List, Templ, SharedTempl, Goal)
|
||||||
|
).
|
||||||
|
|
||||||
|
prove_list([], _, _, _).
|
||||||
|
prove_list([H|T], Templ, SharedTempl, Goal) :-
|
||||||
|
copy_term(Templ+SharedTempl+Goal,
|
||||||
|
H+SharedTempl+Copy),
|
||||||
|
Copy,
|
||||||
|
prove_list(T, Templ, SharedTempl, Goal).
|
||||||
|
|
||||||
|
|
||||||
|
%% free_variables(:Generator, +Template, +VarList0, -VarList) is det.
|
||||||
|
%
|
||||||
|
% In order to handle variables properly, we have to find all the
|
||||||
|
% universally quantified variables in the Generator. All variables
|
||||||
|
% as yet unbound are universally quantified, unless
|
||||||
|
%
|
||||||
|
% 1. they occur in the template
|
||||||
|
% 2. they are bound by X^P, setof, or bagof
|
||||||
|
%
|
||||||
|
% free_variables(Generator, Template, OldList, NewList) finds this
|
||||||
|
% set, using OldList as an accumulator.
|
||||||
|
%
|
||||||
|
% @author Richard O'Keefe
|
||||||
|
% @author Jan Wielemaker (made some SWI-Prolog enhancements)
|
||||||
|
% @license Public domain (from DEC10 library).
|
||||||
|
% @tbd Distinguish between control-structures and data terms.
|
||||||
|
% @tbd Exploit our built-in term_variables/2 at some places?
|
||||||
|
|
||||||
|
free_variables(Term, Bound, VarList, [Term|VarList]) :-
|
||||||
|
var(Term),
|
||||||
|
term_is_free_of(Bound, Term),
|
||||||
|
list_is_free_of(VarList, Term), !.
|
||||||
|
free_variables(Term, _Bound, VarList, VarList) :-
|
||||||
|
var(Term), !.
|
||||||
|
free_variables(Term, Bound, OldList, NewList) :-
|
||||||
|
explicit_binding(Term, Bound, NewTerm, NewBound), !,
|
||||||
|
free_variables(NewTerm, NewBound, OldList, NewList).
|
||||||
|
free_variables(Term, Bound, OldList, NewList) :-
|
||||||
|
functor(Term, _, N),
|
||||||
|
free_variables(N, Term, Bound, OldList, NewList).
|
||||||
|
|
||||||
|
free_variables(0, _, _, VarList, VarList) :- !.
|
||||||
|
free_variables(N, Term, Bound, OldList, NewList) :-
|
||||||
|
arg(N, Term, Argument),
|
||||||
|
free_variables(Argument, Bound, OldList, MidList),
|
||||||
|
M is N-1, !,
|
||||||
|
free_variables(M, Term, Bound, MidList, NewList).
|
||||||
|
|
||||||
|
% explicit_binding checks for goals known to existentially quantify
|
||||||
|
% one or more variables. In particular \+ is quite common.
|
||||||
|
|
||||||
|
explicit_binding(\+ _Goal, Bound, fail, Bound ) :- !.
|
||||||
|
explicit_binding(not(_Goal), Bound, fail, Bound ) :- !.
|
||||||
|
explicit_binding(Var^Goal, Bound, Goal, Bound+Var) :- !.
|
||||||
|
explicit_binding(setof(Var,Goal,Set), Bound, Goal-Set, Bound+Var) :- !.
|
||||||
|
explicit_binding(bagof(Var,Goal,Bag), Bound, Goal-Bag, Bound+Var) :- !.
|
||||||
|
|
||||||
|
%% term_is_free_of(+Term, +Var) is semidet.
|
||||||
|
%
|
||||||
|
% True if Var does not appear in Term. This has been rewritten
|
||||||
|
% from the DEC10 library source to exploit our non-deterministic
|
||||||
|
% arg/3.
|
||||||
|
|
||||||
|
term_is_free_of(Term, Var) :-
|
||||||
|
\+ var_in_term(Term, Var).
|
||||||
|
|
||||||
|
var_in_term(Term, Var) :-
|
||||||
|
Var == Term, !.
|
||||||
|
var_in_term(Term, Var) :-
|
||||||
|
compound(Term),
|
||||||
|
genarg(_, Term, Arg),
|
||||||
|
var_in_term(Arg, Var), !.
|
||||||
|
|
||||||
|
|
||||||
|
%% list_is_free_of(+List, +Var) is semidet.
|
||||||
|
%
|
||||||
|
% True if Var is not in List.
|
||||||
|
|
||||||
|
list_is_free_of([Head|Tail], Var) :-
|
||||||
|
Head \== Var, !,
|
||||||
|
list_is_free_of(Tail, Var).
|
||||||
|
list_is_free_of([], _).
|
||||||
|
|
||||||
|
|
||||||
|
% term_variables(+Term, +Vars0, -Vars) is det.
|
||||||
|
%
|
||||||
|
% True if Vars is the union of variables in Term and Vars0.
|
||||||
|
% We cannot have this as term_variables/3 is already defined
|
||||||
|
% as a difference-list version of term_variables/2.
|
||||||
|
|
||||||
|
%term_variables(Term, Vars0, Vars) :-
|
||||||
|
% term_variables(Term+Vars0, Vars).
|
||||||
262
library/error.pl
Executable file
262
library/error.pl
Executable file
@ -0,0 +1,262 @@
|
|||||||
|
/* $Id: error.pl,v 1.3 2008-07-22 23:34:49 vsc Exp $
|
||||||
|
|
||||||
|
Part of SWI-Prolog
|
||||||
|
|
||||||
|
Author: Jan Wielemaker
|
||||||
|
E-mail: wielemak@science.uva.nl
|
||||||
|
WWW: http://www.swi-prolog.org
|
||||||
|
Copyright (C): 1985-2007, University of Amsterdam
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License
|
||||||
|
as published by the Free Software Foundation; either version 2
|
||||||
|
of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public
|
||||||
|
License along with this library; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
As a special exception, if you link this library with other files,
|
||||||
|
compiled with a Free Software compiler, to produce an executable, this
|
||||||
|
library does not by itself cause the resulting executable to be covered
|
||||||
|
by the GNU General Public License. This exception does not however
|
||||||
|
invalidate any other reasons why the executable file might be covered by
|
||||||
|
the GNU General Public License.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- module(error,
|
||||||
|
[ type_error/2, % +Type, +Term
|
||||||
|
domain_error/2, % +Domain, +Term
|
||||||
|
existence_error/2, % +Type, +Term
|
||||||
|
permission_error/3, % +Action, +Type, +Term
|
||||||
|
instantiation_error/1, % +Term
|
||||||
|
representation_error/1, % +Reason
|
||||||
|
|
||||||
|
must_be/2, % +Type, +Term
|
||||||
|
is_of_type/2 % +Type, +Term
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- if(current_prolog_flag(dialect, yap)).
|
||||||
|
|
||||||
|
:- use_module(library(lists),[memberchk/2]).
|
||||||
|
|
||||||
|
:- endif.
|
||||||
|
|
||||||
|
/** <module> Error generating support
|
||||||
|
|
||||||
|
This module provides predicates to simplify error generation and
|
||||||
|
checking. It's implementation is based on a discussion on the SWI-Prolog
|
||||||
|
mailinglist on best practices in error handling. The utility predicate
|
||||||
|
must_be/2 provides simple run-time type validation. The *_error
|
||||||
|
predicates are simple wrappers around throw/1 to simplify throwing the
|
||||||
|
most common ISO error terms.
|
||||||
|
|
||||||
|
@author Jan Wielemaker
|
||||||
|
@author Richard O'Keefe
|
||||||
|
@see library(debug) and library(prolog_stack).
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- multifile
|
||||||
|
has_type/2.
|
||||||
|
|
||||||
|
%% type_error(+Type, +Term).
|
||||||
|
%% domain_error(+Type, +Term).
|
||||||
|
%% existence_error(+Type, +Term).
|
||||||
|
%% permission_error(+Action, +Type, +Term).
|
||||||
|
%% instantiation_error(+Term).
|
||||||
|
%% representation_error(+Reason).
|
||||||
|
%
|
||||||
|
% Throw ISO compliant error messages.
|
||||||
|
|
||||||
|
type_error(Type, Term) :-
|
||||||
|
throw(error(type_error(Type, Term), _)).
|
||||||
|
domain_error(Type, Term) :-
|
||||||
|
throw(error(domain_error(Type, Term), _)).
|
||||||
|
existence_error(Type, Term) :-
|
||||||
|
throw(error(existence_error(Type, Term), _)).
|
||||||
|
permission_error(Action, Type, Term) :-
|
||||||
|
throw(error(permission_error(Action, Type, Term), _)).
|
||||||
|
instantiation_error(_Term) :-
|
||||||
|
throw(error(instantiation_error, _)).
|
||||||
|
representation_error(Reason) :-
|
||||||
|
throw(error(representation_error(Reason), _)).
|
||||||
|
|
||||||
|
%% must_be(+Type, @Term) is det.
|
||||||
|
%
|
||||||
|
% True if Term satisfies the type constraints for Type. Defined
|
||||||
|
% types are =atom=, =atomic=, =between=, =boolean=, =callable=,
|
||||||
|
% =chars=, =codes=, =text=, =compound=, =constant=, =float=,
|
||||||
|
% =integer=, =nonneg=, =positive_integer=, =negative_integer=,
|
||||||
|
% =nonvar=, =number=, =oneof=, =list=, =list_or_partial_list=,
|
||||||
|
% =symbol=, =var=, =rational= and =string=.
|
||||||
|
%
|
||||||
|
% Most of these types are defined by an arity-1 built-in predicate
|
||||||
|
% of the same name. Below is a brief definition of the other
|
||||||
|
% types.
|
||||||
|
%
|
||||||
|
% | boolean | one of =true= or =false= |
|
||||||
|
% | chars | Proper list of 1-character atoms |
|
||||||
|
% | codes | Proper list of Unicode character codes |
|
||||||
|
% | text | One of =atom=, =string=, =chars= or =codes= |
|
||||||
|
% | between(L,U) | Number between L and U (including L and U) |
|
||||||
|
% | nonneg | Integer >= 0 |
|
||||||
|
% | positive_integer | Integer > 0 |
|
||||||
|
% | negative_integer | Integer < 0 |
|
||||||
|
% | oneof(L) | Ground term that is member of L |
|
||||||
|
% | list(Type) | Proper list with elements of Type |
|
||||||
|
% | list_or_partial_list | A list or an open list (ending in a variable |
|
||||||
|
%
|
||||||
|
% @throws instantiation_error if Term is insufficiently
|
||||||
|
% instantiated and type_error(Type, Term) if Term is not of Type.
|
||||||
|
|
||||||
|
must_be(Type, X) :-
|
||||||
|
( has_type(Type, X)
|
||||||
|
-> true
|
||||||
|
; is_not(Type, X)
|
||||||
|
).
|
||||||
|
|
||||||
|
%% is_not(+Type, @Term)
|
||||||
|
%
|
||||||
|
% Throws appropriate error. It is _known_ that Term is not of type
|
||||||
|
% Type.
|
||||||
|
%
|
||||||
|
% @throws type_error(Type, Term)
|
||||||
|
% @throws instantiation_error
|
||||||
|
|
||||||
|
is_not(list, X) :- !,
|
||||||
|
not_a_list(list, X).
|
||||||
|
is_not(list(_), X) :- !,
|
||||||
|
not_a_list(list, X).
|
||||||
|
is_not(list_or_partial_list, X) :- !,
|
||||||
|
type_error(list, X).
|
||||||
|
is_not(chars, X) :- !,
|
||||||
|
not_a_list(chars, X).
|
||||||
|
is_not(codes, X) :- !,
|
||||||
|
not_a_list(codes, X).
|
||||||
|
is_not(var,_X) :- !,
|
||||||
|
representation_error(variable).
|
||||||
|
is_not(rational, X) :- !,
|
||||||
|
not_a_rational(X).
|
||||||
|
is_not(Type, X) :-
|
||||||
|
( var(X)
|
||||||
|
-> instantiation_error(X)
|
||||||
|
; ground_type(Type), \+ ground(X)
|
||||||
|
-> instantiation_error(X)
|
||||||
|
; type_error(Type, X)
|
||||||
|
).
|
||||||
|
|
||||||
|
ground_type(ground).
|
||||||
|
ground_type(oneof(_)).
|
||||||
|
ground_type(stream).
|
||||||
|
ground_type(text).
|
||||||
|
ground_type(string).
|
||||||
|
|
||||||
|
not_a_list(Type, X) :-
|
||||||
|
'$skip_list'(_, X, Rest),
|
||||||
|
( var(Rest)
|
||||||
|
-> instantiation_error(X)
|
||||||
|
; type_error(Type, X)
|
||||||
|
).
|
||||||
|
|
||||||
|
not_a_rational(X) :-
|
||||||
|
( var(X)
|
||||||
|
-> instantiation_error(X)
|
||||||
|
; X = rdiv(N,D)
|
||||||
|
-> must_be(integer, N), must_be(integer, D),
|
||||||
|
type_error(rational,X)
|
||||||
|
; type_error(rational,X)
|
||||||
|
).
|
||||||
|
|
||||||
|
%% is_of_type(+Type, @Term) is semidet.
|
||||||
|
%
|
||||||
|
% True if Term satisfies Type.
|
||||||
|
|
||||||
|
is_of_type(Type, Term) :-
|
||||||
|
has_type(Type, Term).
|
||||||
|
|
||||||
|
|
||||||
|
%% has_type(+Type, @Term) is semidet.
|
||||||
|
%
|
||||||
|
% True if Term satisfies Type.
|
||||||
|
|
||||||
|
has_type(impossible, _) :- instantiation_error(_).
|
||||||
|
has_type(any, _).
|
||||||
|
has_type(atom, X) :- atom(X).
|
||||||
|
has_type(atomic, X) :- atomic(X).
|
||||||
|
has_type(between(L,U), X) :- ( integer(L)
|
||||||
|
-> integer(X), between(L,U,X)
|
||||||
|
; number(X), X >= L, X =< U
|
||||||
|
).
|
||||||
|
has_type(boolean, X) :- (X==true;X==false), !.
|
||||||
|
has_type(callable, X) :- callable(X).
|
||||||
|
has_type(chars, X) :- chars(X).
|
||||||
|
has_type(codes, X) :- codes(X).
|
||||||
|
has_type(text, X) :- text(X).
|
||||||
|
has_type(compound, X) :- compound(X).
|
||||||
|
has_type(constant, X) :- atomic(X).
|
||||||
|
has_type(float, X) :- float(X).
|
||||||
|
has_type(ground, X) :- ground(X).
|
||||||
|
has_type(integer, X) :- integer(X).
|
||||||
|
has_type(nonneg, X) :- integer(X), X >= 0.
|
||||||
|
has_type(positive_integer, X) :- integer(X), X > 0.
|
||||||
|
has_type(negative_integer, X) :- integer(X), X < 0.
|
||||||
|
has_type(nonvar, X) :- nonvar(X).
|
||||||
|
has_type(number, X) :- number(X).
|
||||||
|
has_type(oneof(L), X) :- ground(X), memberchk(X, L).
|
||||||
|
has_type(proper_list, X) :- is_list(X).
|
||||||
|
has_type(list, X) :- is_list(X).
|
||||||
|
has_type(list_or_partial_list, X) :- is_list_or_partial_list(X).
|
||||||
|
has_type(symbol, X) :- atom(X).
|
||||||
|
has_type(var, X) :- var(X).
|
||||||
|
has_type(rational, X) :- rational(X).
|
||||||
|
has_type(string, X) :- string(X).
|
||||||
|
has_type(stream, X) :- is_stream(X).
|
||||||
|
has_type(list(Type), X) :- is_list(X), element_types(X, Type).
|
||||||
|
|
||||||
|
chars(0) :- !, fail.
|
||||||
|
chars([]).
|
||||||
|
chars([H|T]) :-
|
||||||
|
atom(H), atom_length(H, 1),
|
||||||
|
chars(T).
|
||||||
|
|
||||||
|
codes(x) :- !, fail.
|
||||||
|
codes([]).
|
||||||
|
codes([H|T]) :-
|
||||||
|
integer(H), between(1, 0x10ffff, H),
|
||||||
|
codes(T).
|
||||||
|
|
||||||
|
text(X) :-
|
||||||
|
( atom(X)
|
||||||
|
; string(X)
|
||||||
|
; chars(X)
|
||||||
|
; codes(X)
|
||||||
|
), !.
|
||||||
|
|
||||||
|
element_types([], _).
|
||||||
|
element_types([H|T], Type) :-
|
||||||
|
must_be(Type, H),
|
||||||
|
element_types(T, Type).
|
||||||
|
|
||||||
|
is_list_or_partial_list(L0) :-
|
||||||
|
'$skip_list'(_, L0,L),
|
||||||
|
( var(L) -> true ; L == [] ).
|
||||||
|
|
||||||
|
:- if(current_prolog_flag(dialect, yap)).
|
||||||
|
|
||||||
|
% vsc: I hope it works like this
|
||||||
|
'$skip_list'(_, Rest, Rest) :- var(Rest), !.
|
||||||
|
'$skip_list'(_, [], _) :- !, fail.
|
||||||
|
'$skip_list'(Anything, [_|More], Rest) :-
|
||||||
|
'$skip_list'(Anything, [_|More], Rest).
|
||||||
|
'$skip_list'(Anything, [_|More], Rest) :-
|
||||||
|
'$skip_list'(Anything, More, Rest).
|
||||||
|
'$skip_list'(_Anything, Rest, Rest).
|
||||||
|
|
||||||
|
:- endif.
|
||||||
|
|
||||||
|
|
||||||
103
library/maplist.pl
Executable file
103
library/maplist.pl
Executable file
@ -0,0 +1,103 @@
|
|||||||
|
/* $Id: maplist.pl,v 1.2 2008-06-05 19:33:51 rzf Exp $
|
||||||
|
|
||||||
|
Part of SWI-Prolog
|
||||||
|
|
||||||
|
Author: Jan Wielemaker
|
||||||
|
E-mail: jan@swi.psy.uva.nl
|
||||||
|
WWW: http://www.swi-prolog.org
|
||||||
|
Copyright (C): 1985-2002, University of Amsterdam
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License
|
||||||
|
as published by the Free Software Foundation; either version 2
|
||||||
|
of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this library; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
As a special exception, if you link this library with other files,
|
||||||
|
compiled with a Free Software compiler, to produce an executable, this
|
||||||
|
library does not by itself cause the resulting executable to be covered
|
||||||
|
by the GNU General Public License. This exception does not however
|
||||||
|
invalidate any other reasons why the executable file might be covered by
|
||||||
|
the GNU General Public License.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- module(maplist,
|
||||||
|
[ maplist/2, % :Goal, +List
|
||||||
|
maplist/3, % :Goal, ?List1, ?List2
|
||||||
|
maplist/4, % :Goal, ?List1, ?List2, ?List3
|
||||||
|
maplist/5, % :Goal, ?List1, ?List2, ?List3, List4
|
||||||
|
forall/2 % :Goal, :Goal
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- module_transparent
|
||||||
|
maplist/2,
|
||||||
|
maplist2/2,
|
||||||
|
maplist/3,
|
||||||
|
maplist2/3,
|
||||||
|
maplist/4,
|
||||||
|
maplist2/4,
|
||||||
|
maplist/5,
|
||||||
|
maplist2/5,
|
||||||
|
forall/2.
|
||||||
|
|
||||||
|
% maplist(:Goal, +List)
|
||||||
|
%
|
||||||
|
% True if Goal can succesfully be applied on all elements of List.
|
||||||
|
% Arguments are reordered to gain performance as well as to make
|
||||||
|
% the predicate deterministic under normal circumstances.
|
||||||
|
|
||||||
|
maplist(Goal, List) :-
|
||||||
|
maplist2(List, Goal).
|
||||||
|
|
||||||
|
maplist2([], _).
|
||||||
|
maplist2([Elem|Tail], Goal) :-
|
||||||
|
call(Goal, Elem),
|
||||||
|
maplist2(Tail, Goal).
|
||||||
|
|
||||||
|
% maplist(:Goal, ?List1, ?List2)
|
||||||
|
%
|
||||||
|
% True if Goal can succesfully be applied to all succesive pairs
|
||||||
|
% of elements of List1 and List2.
|
||||||
|
|
||||||
|
maplist(Goal, List1, List2) :-
|
||||||
|
maplist2(List1, List2, Goal).
|
||||||
|
|
||||||
|
maplist2([], [], _).
|
||||||
|
maplist2([Elem1|Tail1], [Elem2|Tail2], Goal) :-
|
||||||
|
call(Goal, Elem1, Elem2),
|
||||||
|
maplist2(Tail1, Tail2, Goal).
|
||||||
|
|
||||||
|
% maplist(:Goal, ?List1, ?List2, ?List3)
|
||||||
|
%
|
||||||
|
% True if Goal can succesfully be applied to all succesive triples
|
||||||
|
% of elements of List1..List3.
|
||||||
|
|
||||||
|
maplist(Goal, List1, List2, List3) :-
|
||||||
|
maplist2(List1, List2, List3, Goal).
|
||||||
|
|
||||||
|
maplist2([], [], [], _).
|
||||||
|
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], Goal) :-
|
||||||
|
call(Goal, Elem1, Elem2, Elem3),
|
||||||
|
maplist2(Tail1, Tail2, Tail3, Goal).
|
||||||
|
|
||||||
|
% maplist(:Goal, ?List1, ?List2, ?List3, List4)
|
||||||
|
%
|
||||||
|
% True if Goal can succesfully be applied to all succesive
|
||||||
|
% quadruples of elements of List1..List4
|
||||||
|
|
||||||
|
maplist(Goal, List1, List2, List3, List4) :-
|
||||||
|
maplist2(List1, List2, List3, List4, Goal).
|
||||||
|
|
||||||
|
maplist2([], [], [], [], _).
|
||||||
|
maplist2([Elem1|Tail1], [Elem2|Tail2], [Elem3|Tail3], [Elem4|Tail4], Goal) :-
|
||||||
|
call(Goal, Elem1, Elem2, Elem3, Elem4),
|
||||||
|
maplist2(Tail1, Tail2, Tail3, Tail4, Goal).
|
||||||
|
|
||||||
141
library/occurs.yap
Executable file
141
library/occurs.yap
Executable file
@ -0,0 +1,141 @@
|
|||||||
|
/* $Id: occurs.yap,v 1.1 2008-02-12 17:03:52 vsc Exp $
|
||||||
|
|
||||||
|
Part of SWI-Prolog
|
||||||
|
|
||||||
|
Author: Jan Wielemaker
|
||||||
|
E-mail: jan@swi.psy.uva.nl
|
||||||
|
WWW: http://www.swi-prolog.org
|
||||||
|
Copyright (C): 1985-2002, University of Amsterdam
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License
|
||||||
|
as published by the Free Software Foundation; either version 2
|
||||||
|
of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU Lesser General Public
|
||||||
|
License along with this library; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
As a special exception, if you link this library with other files,
|
||||||
|
compiled with a Free Software compiler, to produce an executable, this
|
||||||
|
library does not by itself cause the resulting executable to be covered
|
||||||
|
by the GNU General Public License. This exception does not however
|
||||||
|
invalidate any other reasons why the executable file might be covered by
|
||||||
|
the GNU General Public License.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- module(occurs,
|
||||||
|
[ contains_term/2, % +SubTerm, +Term
|
||||||
|
contains_var/2, % +SubTerm, +Term
|
||||||
|
free_of_term/2, % +SubTerm, +Term
|
||||||
|
free_of_var/2, % +SubTerm, +Term
|
||||||
|
occurrences_of_term/3, % +SubTerm, +Term, ?Tally
|
||||||
|
occurrences_of_var/3, % +SubTerm, +Term, ?Tally
|
||||||
|
sub_term/2, % -SubTerm, +Term
|
||||||
|
sub_var/2 % -SubTerm, +Term (SWI extra)
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- use_module(library(arg),
|
||||||
|
[genarg/3]).
|
||||||
|
|
||||||
|
|
||||||
|
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||||
|
This is a SWI-Prolog implementation of the corresponding Quintus
|
||||||
|
library, based on the generalised arg/3 predicate of SWI-Prolog.
|
||||||
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||||
|
|
||||||
|
%% contains_term(+Sub, +Term) is semidet.
|
||||||
|
%
|
||||||
|
% Succeeds if Sub is contained in Term (=, deterministically)
|
||||||
|
|
||||||
|
contains_term(X, X) :- !.
|
||||||
|
contains_term(X, Term) :-
|
||||||
|
compound(Term),
|
||||||
|
genarg(_, Term, Arg),
|
||||||
|
contains_term(X, Arg), !.
|
||||||
|
|
||||||
|
|
||||||
|
%% contains_var(+Sub, +Term) is det.
|
||||||
|
%
|
||||||
|
% Succeeds if Sub is contained in Term (==, deterministically)
|
||||||
|
|
||||||
|
contains_var(X0, X1) :-
|
||||||
|
X0 == X1, !.
|
||||||
|
contains_var(X, Term) :-
|
||||||
|
compound(Term),
|
||||||
|
genarg(_, Term, Arg),
|
||||||
|
contains_var(X, Arg), !.
|
||||||
|
|
||||||
|
%% free_of_term(+Sub, +Term)
|
||||||
|
%
|
||||||
|
% Succeeds of Sub does not unify to any subterm of Term
|
||||||
|
|
||||||
|
free_of_term(Sub, Term) :-
|
||||||
|
\+ contains_term(Sub, Term).
|
||||||
|
|
||||||
|
%% free_of_var(+Sub, +Term)
|
||||||
|
%
|
||||||
|
% Succeeds of Sub is not equal (==) to any subterm of Term
|
||||||
|
|
||||||
|
free_of_var(Sub, Term) :-
|
||||||
|
\+ contains_var(Sub, Term).
|
||||||
|
|
||||||
|
%% occurrences_of_term(+SubTerm, +Term, ?Count)
|
||||||
|
%
|
||||||
|
% Count the number of SubTerms in Term
|
||||||
|
|
||||||
|
occurrences_of_term(Sub, Term, Count) :-
|
||||||
|
count(sub_term(Sub, Term), Count).
|
||||||
|
|
||||||
|
%% occurrences_of_var(+SubTerm, +Term, ?Count)
|
||||||
|
%
|
||||||
|
% Count the number of SubTerms in Term
|
||||||
|
|
||||||
|
occurrences_of_var(Sub, Term, Count) :-
|
||||||
|
count(sub_var(Sub, Term), Count).
|
||||||
|
|
||||||
|
%% sub_term(-Sub, +Term)
|
||||||
|
%
|
||||||
|
% Generates (on backtracking) all subterms of Term.
|
||||||
|
|
||||||
|
sub_term(X, X).
|
||||||
|
sub_term(X, Term) :-
|
||||||
|
compound(Term),
|
||||||
|
genarg(_, Term, Arg),
|
||||||
|
sub_term(X, Arg).
|
||||||
|
|
||||||
|
%% sub_var(-Sub, +Term)
|
||||||
|
%
|
||||||
|
% Generates (on backtracking) all subterms (==) of Term.
|
||||||
|
|
||||||
|
sub_var(X0, X1) :-
|
||||||
|
X0 == X1.
|
||||||
|
sub_var(X, Term) :-
|
||||||
|
compound(Term),
|
||||||
|
genarg(_, Term, Arg),
|
||||||
|
sub_var(X, Arg).
|
||||||
|
|
||||||
|
|
||||||
|
/*******************************
|
||||||
|
* UTIL *
|
||||||
|
*******************************/
|
||||||
|
|
||||||
|
%% count(+Goal, -Count)
|
||||||
|
%
|
||||||
|
% Count number of times Goal succeeds.
|
||||||
|
|
||||||
|
count(Goal, Count) :-
|
||||||
|
State = count(0),
|
||||||
|
( Goal,
|
||||||
|
arg(1, State, N0),
|
||||||
|
N is N0 + 1,
|
||||||
|
nb_setarg(1, State, N),
|
||||||
|
fail
|
||||||
|
; arg(1, State, Count)
|
||||||
|
).
|
||||||
|
|
||||||
162
library/pairs.pl
Executable file
162
library/pairs.pl
Executable file
@ -0,0 +1,162 @@
|
|||||||
|
/* $Id: pairs.pl,v 1.1 2008-02-12 17:03:52 vsc Exp $
|
||||||
|
|
||||||
|
Part of SWI-Prolog
|
||||||
|
|
||||||
|
Author: Jan Wielemaker
|
||||||
|
E-mail: wielemak@science.uva.nl
|
||||||
|
WWW: http://www.swi-prolog.org
|
||||||
|
Copyright (C): 1985-2006, University of Amsterdam
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or
|
||||||
|
modify it under the terms of the GNU General Public License
|
||||||
|
as published by the Free Software Foundation; either version 2
|
||||||
|
of the License, or (at your option) any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public
|
||||||
|
License along with this library; if not, write to the Free Software
|
||||||
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
As a special exception, if you link this library with other files,
|
||||||
|
compiled with a Free Software compiler, to produce an executable, this
|
||||||
|
library does not by itself cause the resulting executable to be covered
|
||||||
|
by the GNU General Public License. This exception does not however
|
||||||
|
invalidate any other reasons why the executable file might be covered by
|
||||||
|
the GNU General Public License.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- module(pairs,
|
||||||
|
[ pairs_keys_values/3,
|
||||||
|
pairs_values/2,
|
||||||
|
pairs_keys/2,
|
||||||
|
group_pairs_by_key/2,
|
||||||
|
transpose_pairs/2,
|
||||||
|
map_list_to_pairs/3
|
||||||
|
]).
|
||||||
|
|
||||||
|
/** <module> Operations on key-value lists
|
||||||
|
|
||||||
|
This module implements common operations on Key-Value lists, also known
|
||||||
|
as _Pairs_. Pairs have great practical value, especially due to
|
||||||
|
keysort/2 and the library assoc.pl.
|
||||||
|
|
||||||
|
This library is based on disussion in the SWI-Prolog mailinglist,
|
||||||
|
including specifications from Quintus and a library proposal by Richard
|
||||||
|
O'Keefe.
|
||||||
|
|
||||||
|
@see keysort/2, library(assoc)
|
||||||
|
@author Jan Wielemaker
|
||||||
|
*/
|
||||||
|
|
||||||
|
%% pairs_keys_values(?Pairs, ?Keys, ?Values) is det.
|
||||||
|
%
|
||||||
|
% True if Keys holds the keys of Pairs and Values the values.
|
||||||
|
%
|
||||||
|
% Deterministic if any argument is instantiated to a finite list
|
||||||
|
% and the others are either free or finite lists.
|
||||||
|
|
||||||
|
pairs_keys_values(Pairs, Keys, Values) :-
|
||||||
|
( nonvar(Pairs) ->
|
||||||
|
pairs_keys_values_(Pairs, Keys, Values)
|
||||||
|
; nonvar(Keys) ->
|
||||||
|
keys_values_pairs(Keys, Values, Pairs)
|
||||||
|
; values_keys_pairs(Values, Keys, Pairs)
|
||||||
|
).
|
||||||
|
|
||||||
|
pairs_keys_values_([], [], []).
|
||||||
|
pairs_keys_values_([K-V|Pairs], [K|Keys], [V|Values]) :-
|
||||||
|
pairs_keys_values_(Pairs, Keys, Values).
|
||||||
|
|
||||||
|
keys_values_pairs([], [], []).
|
||||||
|
keys_values_pairs([K|Ks], [V|Vs], [K-V|Pairs]) :-
|
||||||
|
keys_values_pairs(Ks, Vs, Pairs).
|
||||||
|
|
||||||
|
values_keys_pairs([], [], []).
|
||||||
|
values_keys_pairs([V|Vs], [K|Ks], [K-V|Pairs]) :-
|
||||||
|
values_keys_pairs(Vs, Ks, Pairs).
|
||||||
|
|
||||||
|
%% pairs_values(+Pairs, -Values) is det.
|
||||||
|
%
|
||||||
|
% Remove the keys from a list of Key-Value pairs. Same as
|
||||||
|
% pairs_keys_values(Pairs, _, Values)
|
||||||
|
|
||||||
|
pairs_values([], []).
|
||||||
|
pairs_values([_-V|T0], [V|T]) :-
|
||||||
|
pairs_values(T0, T).
|
||||||
|
|
||||||
|
|
||||||
|
%% pairs_keys(+Pairs, -Keys) is det.
|
||||||
|
%
|
||||||
|
% Remove the values from a list of Key-Value pairs. Same as
|
||||||
|
% pairs_keys_values(Pairs, Keys, _)
|
||||||
|
|
||||||
|
pairs_keys([], []).
|
||||||
|
pairs_keys([K-_|T0], [K|T]) :-
|
||||||
|
pairs_keys(T0, T).
|
||||||
|
|
||||||
|
|
||||||
|
%% group_pairs_by_key(+Pairs, -Joined:list(Key-Values)) is det.
|
||||||
|
%
|
||||||
|
% Group values with the same key. For example:
|
||||||
|
%
|
||||||
|
% ==
|
||||||
|
% ?- group_pairs_by_key([a-2, a-1, b-4], X).
|
||||||
|
%
|
||||||
|
% X = [a-[2,1], b-[4]]
|
||||||
|
% ==
|
||||||
|
%
|
||||||
|
% @param Pairs Key-Value list, sorted to the standard order
|
||||||
|
% of terms (as keysort/2 does)
|
||||||
|
% @param Joined List of Key-Group, where Group is the
|
||||||
|
% list of Values associated with Key.
|
||||||
|
|
||||||
|
group_pairs_by_key([], []).
|
||||||
|
group_pairs_by_key([M-N|T0], [M-[N|TN]|T]) :-
|
||||||
|
same_key(M, T0, TN, T1),
|
||||||
|
group_pairs_by_key(T1, T).
|
||||||
|
|
||||||
|
same_key(M, [M-N|T0], [N|TN], T) :- !,
|
||||||
|
same_key(M, T0, TN, T).
|
||||||
|
same_key(_, L, [], L).
|
||||||
|
|
||||||
|
|
||||||
|
%% transpose_pairs(+Pairs, -Transposed) is det.
|
||||||
|
%
|
||||||
|
% Swap Key-Value to Value-Key and sort the result on Value
|
||||||
|
% (the new key) using keysort/2.
|
||||||
|
|
||||||
|
transpose_pairs(Pairs, Transposed) :-
|
||||||
|
flip_pairs(Pairs, Flipped),
|
||||||
|
keysort(Flipped, Transposed).
|
||||||
|
|
||||||
|
flip_pairs([], []).
|
||||||
|
flip_pairs([Key-Val|Pairs], [Val-Key|Flipped]) :-
|
||||||
|
flip_pairs(Pairs, Flipped).
|
||||||
|
|
||||||
|
|
||||||
|
%% map_list_to_pairs(:Function, +List, -Keyed)
|
||||||
|
%
|
||||||
|
% Create a key-value list by mapping each element of List.
|
||||||
|
% For example, if we have a list of lists we can create a
|
||||||
|
% list of Length-List using
|
||||||
|
%
|
||||||
|
% ==
|
||||||
|
% map_list_to_pairs(length, ListOfLists, Pairs),
|
||||||
|
% ==
|
||||||
|
|
||||||
|
:- module_transparent
|
||||||
|
map_list_to_pairs/3,
|
||||||
|
map_list_to_pairs2/3.
|
||||||
|
|
||||||
|
map_list_to_pairs(Function, List, Pairs) :-
|
||||||
|
map_list_to_pairs2(List, Function, Pairs).
|
||||||
|
|
||||||
|
map_list_to_pairs2([], _, []).
|
||||||
|
map_list_to_pairs2([H|T0], Pred, [K-H|T]) :-
|
||||||
|
call(Pred, H, K),
|
||||||
|
map_list_to_pairs2(T0, Pred, T).
|
||||||
|
|
||||||
68
misc/buildops
Normal file
68
misc/buildops
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
|
||||||
|
:- use_module(library(lineutils),
|
||||||
|
[process/2,
|
||||||
|
split/3]).
|
||||||
|
|
||||||
|
:- initialization(main).
|
||||||
|
|
||||||
|
main :-
|
||||||
|
open('H/YapOpcodes.h',write,W),
|
||||||
|
header(W),
|
||||||
|
file('C/absmi.c',W),
|
||||||
|
format(W, '#ifdef YAPOR~n',[]),
|
||||||
|
file('OPTYap/or.insts.i',W),
|
||||||
|
format(W, '#endif~n',[]),
|
||||||
|
format(W, '#ifdef TABLING~n',[]),
|
||||||
|
file('OPTYap/tab.insts.i',W),
|
||||||
|
file('OPTYap/tab.tries.insts.i',W),
|
||||||
|
format(W, '#endif~n',[]),
|
||||||
|
footer(W),
|
||||||
|
close(W).
|
||||||
|
|
||||||
|
header(W) :-
|
||||||
|
format(W,'~n /* This file was generated automatically by \"yap -L misc/buildops\"~n please do not update */~n~n',[]).
|
||||||
|
|
||||||
|
|
||||||
|
file(I,W) :-
|
||||||
|
open(I,read,R),
|
||||||
|
process(R,grep_opcode(W)),
|
||||||
|
close(R).
|
||||||
|
|
||||||
|
grep_opcode(W, Line) :-
|
||||||
|
split(Line," ,();",[OP,Name,Type]),
|
||||||
|
Name \= "or_last",
|
||||||
|
check_op(OP),
|
||||||
|
special(Name,W),
|
||||||
|
format(W,' OPCODE(~s~36+,~s),~n',[Name,Type]),
|
||||||
|
end_special(Name,W).
|
||||||
|
|
||||||
|
check_op("Op").
|
||||||
|
check_op("BOp").
|
||||||
|
check_op("PBOp").
|
||||||
|
check_op("OpRW").
|
||||||
|
check_op("OpW").
|
||||||
|
|
||||||
|
special(Name, W) :-
|
||||||
|
special_op(Name, Decl), !,
|
||||||
|
format(W,"#ifdef ~s~n",[Decl]).
|
||||||
|
special(_, _).
|
||||||
|
|
||||||
|
end_special(Name, W) :-
|
||||||
|
special_op(Name, _), !,
|
||||||
|
format(W,"#endif~n",[]).
|
||||||
|
end_special(_, _).
|
||||||
|
|
||||||
|
special_op("cut_c","CUT_C").
|
||||||
|
special_op("cut_userc","CUT_C").
|
||||||
|
special_op("run_eam","BEAM").
|
||||||
|
special_op("retry_eam","BEAM").
|
||||||
|
special_op("thread_local","THREADS").
|
||||||
|
|
||||||
|
/* or_last requires special handling */
|
||||||
|
footer(W) :-
|
||||||
|
format(W,' /* this instruction is hardwired */~n',[]),
|
||||||
|
format(W,'#ifdef YAPOR~n',[]),
|
||||||
|
format(W,' OPCODE(~s~36+,~s)~n',["or_last","sblp"]),
|
||||||
|
format(W,'#else~n',[]),
|
||||||
|
format(W,' OPCODE(~s~36+,~s)~n',["or_last","p"]),
|
||||||
|
format(W,'#endif~n',[]).
|
||||||
Reference in New Issue
Block a user