Attributed variables provide a technique for extending the
Prolog unification algorithm Holzbaur,
1992 by hooking the binding of attributed variables. There is
no consensus in the Prolog community on the exact definition and
interface to attributed variables. The SWI-Prolog interface is very
similar to the one implemented in SICStus Prolog, and also supports the
interface that is realised by Bart Demoen for hProlog Demoen,
2002. The interface used for hProlog is available on all
Prolog systems that can run the Leuven CHR system (see chapter
8 and the Leuven CHR
page).
Binding an attributed variable schedules a goal to be executed at the
first possible opportunity. Each attribute is associated to a module,
and the hooks (verify_attributes/3, attr_unify_hook/2)
are executed in this module. The example below realises a very simple
and incomplete finite domain reasoner:
:- module(domain,
[ domain/2 % Var, ?Domain
]).
:- use_module(library(ordsets)).
domain(X, Dom) :-
var(Dom), !,
get_attr(X, domain, Dom).
domain(X, List) :-
list_to_ord_set(List, Domain),
put_attr(Y, domain, Domain),
X = Y.
% An attributed variable X is about to be unified with Y
verify_attributes(X, Y, Gs) :-
( get_attr(X, domain, Domain) ->
( get_attr(Y, domain, Dom2)
-> ord_intersection(Domain, Dom2, NewDomain),
NewDomain \== [],
( NewDomain = [Value]
-> Gs = [Y=Value]
; Gs = [],
put_attr(Y, domain, NewDomain)
)
; var(Y)
-> put_attr(Y, domain, Domain ),
Gs = []
; ord_memberchk(Y, Domain),
Gs = []
)
; Gs = []
).
% Translate attributes from this module to residual goals
attribute_goals(X) -->
{ get_attr(X, domain, List) },
[domain(X, List)].
Before explaining the code we give some example queries:
?- domain(X, [a,b]), X = c. | fail |
?- domain(X, [a,b]), domain(X, [a,c]). | X =
a |
?- domain(X, [a,b,c]), domain(X, [a,c]). | domain(X,
[a, c]) |
The predicate domain/2 fetches (first clause) or assigns (second
clause) the variable a domain, a set of values the variable can
be unified with. In the second clause, domain/2
first associates the domain with a fresh variable (Y) and then unifies X
to this variable to deal with the possibility that X already has a
domain. The predicate attr_unify_hook/2
(see below) is a hook called after a variable with a domain is assigned
a value. In the simple case where the variable is bound to a concrete
value, we simply check whether this value is in the domain. Otherwise we
take the intersection of the domains and either fail if the intersection
is empty (first example), assign the value if there is only one value in
the intersection (second example), or assign the intersection as the new
domain of the variable (third example). The nonterminal
attribute_goals/3
is used to translate remaining attributes to user-readable goals that,
when executed, reinstate these attributes.
- attvar(@Term)
-
Succeeds if Term is an attributed variable. Note that var/1
also succeeds on attributed variables. Attributed variables are created
with
put_attr/3.
- put_attr(+Var,
+Module, +Value)
-
If Var is a variable or attributed variable, set the value
for the attribute named Module to Value. If an
attribute with this name is already associated with Var, the
old value is replaced. Backtracking will restore the old value (i.e., an
attribute is a mutable term; see also setarg/3).
This predicate raises a representation error if
Var is not a variable and a type error if Module
is not an atom.
- get_attr(+Var,
+Module, -Value)
-
Request the current value for the attribute named Module.
If
Var is not an attributed variable or the named attribute is
not associated to Var this predicate fails silently. If Module
is not an atom, a type error is raised.
- del_attr(+Var,
+Module)
-
Delete the named attribute. If Var loses its last attribute
it is transformed back into a traditional Prolog variable. If Module
is not an atom, a type error is raised. In all other cases this
predicate succeeds regardless of whether or not the named attribute is
present.
Attribute names are linked to modules. This means that certain
operations on attributed variables cause hooks to be called in
the module whose name matches the attribute name.
- verify_attributes(+Var,
+Value, -Goals)
-
This hook is the recommended way to reason about unifications of
attributed variables. It is a predicate that users can define in each
module where the variable may have attributes. When an attributed
variable Var is being unified with Value,
this hook is invoked before the unification takes place. Var
may or
may not have attributes attached in all modules where the hook
is called. This hook can veto the unification. If it succeeds, it must
bind Goals with a list of Prolog goals that are called
after the unification has taken place. The hook itself
must not unify Var.
- attr_unify_hook(+AttValue,
+VarValue)
-
This hook is available for compatability with hProlog. If it is defined
in the module to which an attributed variable refers, it is called after
the attributed variable has been unified with a non-var term, possibly
another attributed variable.
AttValue is the attribute that was associated to the variable
in this module and VarValue is the new value of the variable.
Normally this predicate fails to veto binding the variable to
VarValue, forcing backtracking to undo the binding. If
VarValue is another attributed variable the hook often
combines the two attributes and associates the combined attribute with
VarValue using put_attr/3.
- [deprecated]attr_portray_hook(+AttValue,
+Var)
-
Called by write_term/2
and friends for each attribute if the option
attributes(portray)
is in effect. If the hook succeeds the
attribute is considered printed. Otherwise Module = ...
is
printed to indicate the existence of a variable. New infrastructure
dealing with communicating attribute values must be based on
copy_term/3
and its hook attribute_goals/3.
- attribute_goals(+Var)
//
-
This nonterminal, if it is defined in a module, is used by copy_term/3
to project attributes of that module to residual goals. It is also used
by the top level to obtain residual goals after executing a query.
- project_attributes(+QueryVars,
+ResidualVars)
-
hook that can be defined in each module to project constraints on newly
introduced variables back to the query variables.
QueryVars is the list of variables occurring in the query and
ResidualVars is a list of variables that have attributes
attached. There may be variables that occur in both lists. If possible, project_attributes/2
should change the attributes so that all constraints are expressed as
residual goals that refer only to
QueryVars, while other variables are existentially
quantified.
- copy_term(+Term,
-Copy, -Gs)
-
Create a regular term Copy as a copy of Term
(without any attributes), and a list Gs of goals that
represents the attributes. The goal maplist(call,Gs)
recreates the attributes for Copy. The nonterminal attribute_goals/3,
as defined in the modules the attributes stem from, is used to convert
attributes to lists of goals.
This building block is used by the top level to report pending
attributes in a portable and understandable fashion. This predicate is
the preferred way to reason about and communicate terms with
constraints.
- copy_term_nat(+Term,
-Copy)
-
As copy_term/2.
Attributes, however, are not copied but replaced by fresh
variables.
- term_attvars(+Term,
-AttVars)
-
AttVars is a list of all attributed variables in Term
and its attributes. That is, term_attvars/2
works recursively through attributes. This predicate is cycle-safe. The
goal
term_attvars(Term,[])
in an efficient test that Term
has
no attributes; scanning the term is aborted after the first
attributed variable is found.
Normal user code should deal with put_attr/3, get_attr/3
and del_attr/2.
The routines in this section fetch or set the entire attribute list of a
variable. Use of these predicates is anticipated to be restricted to
printing and other special purpose operations.
- get_attrs(+Var,
-Attributes)
-
Get all attributes of Var. Attributes is a term of
the form
att(Module, Value, MoreAttributes)
, where MoreAttributes
is
[]
for the last attribute.
- put_attrs(+Var,
-Attributes)
-
Set all attributes of Var. See get_attrs/2
for a description of
Attributes.
- del_attrs(+Var)
-
If Var is an attributed variable, delete all its
attributes. In all other cases, this predicate succeeds without
side-effects.