593 lines
16 KiB
Prolog
593 lines
16 KiB
Prolog
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: atts.yap *
|
|
* Last rev: 8/2/88 *
|
|
* mods: *
|
|
* comments: attribute support for Prolog *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
|
|
/** @defgroup Attributed_Variables Attributed Variables
|
|
@ingroup YAPExtensions
|
|
|
|
YAP supports attributed variables, originally developed at OFAI by
|
|
Christian Holzbaur. Attributes are a means of declaring that an
|
|
arbitrary term is a property for a variable. These properties can be
|
|
updated during forward execution. Moreover, the unification algorithm is
|
|
aware of attributed variables and will call user defined handlers when
|
|
trying to unify these variables.
|
|
|
|
Attributed variables provide an elegant abstraction over which one can
|
|
extend Prolog systems. Their main application so far has been in
|
|
implementing constraint handlers, such as Holzbaur's CLPQR, Fruewirth
|
|
and Holzbaur's CHR, and CLP(BN).
|
|
|
|
Different Prolog systems implement attributed variables in different
|
|
ways. Originally, YAP used the interface designed by SICStus
|
|
Prolog. This interface is still
|
|
available through the <tt>atts</tt> library, and is still used by CLPBN.
|
|
|
|
From YAP-6.0.3 onwards we recommend using the hProlog, SWI style
|
|
interface. We believe that this design is easier to understand and
|
|
work with. Most packages included in YAP that use attributed
|
|
variables, such as CHR, CLP(FD), and CLP(QR), rely on the SWI-Prolog
|
|
interface.
|
|
|
|
@{
|
|
*/
|
|
|
|
|
|
|
|
/** @defgroup New_Style_Attribute_Declarations hProlog and SWI-Prolog style Attribute Declarations
|
|
@ingroup Attributed_Variables
|
|
@{
|
|
|
|
The following documentation is taken from the SWI-Prolog manual.
|
|
|
|
Binding an attributed variable schedules a goal to be executed at the
|
|
first possible opportunity. In the current implementation the hooks are
|
|
executed immediately after a successful unification of the clause-head
|
|
or successful completion of a foreign language (built-in) predicate. Each
|
|
attribute is associated to a module and the hook attr_unify_hook/2 is
|
|
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 with attribute value Domain has been
|
|
% assigned the value Y
|
|
|
|
attr_unify_hook(Domain, Y) :-
|
|
( get_attr(Y, domain, Dom2)
|
|
-> ord_intersection(Domain, Dom2, NewDomain),
|
|
( NewDomain == []
|
|
-> fail
|
|
; NewDomain = [Value]
|
|
-> Y = Value
|
|
; put_attr(Y, domain, NewDomain)
|
|
)
|
|
; var(Y)
|
|
-> put_attr( Y, domain, Domain )
|
|
; ord_memberchk(Y, Domain)
|
|
).
|
|
|
|
% 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:
|
|
|
|
The predicate `domain/2` fetches (first clause) or assigns
|
|
(second clause) the variable a <em>domain</em>, a set of values it can
|
|
be unified with. In the second clause first associates the domain
|
|
with a fresh variable and then unifies X to this variable to deal
|
|
with the possibility that X already has a domain. The
|
|
predicate attr_unify_hook/2 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), simply 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.
|
|
|
|
*/
|
|
|
|
|
|
|
|
:- module('$attributes', [
|
|
delayed_goals/4
|
|
]).
|
|
|
|
:- use_system_module( '$_boot', ['$undefp'/1]).
|
|
|
|
:- use_system_module( '$_errors', ['$do_error'/2]).
|
|
|
|
:- use_system_module( '$coroutining', [attr_unify_hook/2]).
|
|
|
|
:- use_system_module( attributes, [all_attvars/1,
|
|
attributed_module/3,
|
|
bind_attvar/1,
|
|
del_all_atts/1,
|
|
del_all_module_atts/2,
|
|
get_all_swi_atts/2,
|
|
get_module_atts/2,
|
|
modules_with_attributes/1,
|
|
put_att_term/2,
|
|
put_module_atts/2,
|
|
unbind_attvar/1,
|
|
woken_att_do/4]).
|
|
|
|
|
|
:- dynamic attributes:attributed_module/3, attributes:modules_with_attributes/1.
|
|
|
|
/** @pred 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.
|
|
|
|
|
|
*/
|
|
prolog:get_attr(Var, Mod, Att) :-
|
|
functor(AttTerm, Mod, 2),
|
|
arg(2, AttTerm, Att),
|
|
attributes:get_module_atts(Var, AttTerm).
|
|
|
|
/**
|
|
@pred 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.
|
|
|
|
|
|
*/
|
|
prolog:put_attr(Var, Mod, Att) :-
|
|
functor(AttTerm, Mod, 2),
|
|
arg(2, AttTerm, Att),
|
|
attributes:put_module_atts(Var, AttTerm).
|
|
|
|
/** @pred 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 whether or not the named attribute is
|
|
present.
|
|
|
|
|
|
*/
|
|
prolog:del_attr(Var, Mod) :-
|
|
functor(AttTerm, Mod, 2),
|
|
attributes:del_all_module_atts(Var, AttTerm).
|
|
|
|
/** @pred del_attrs(+ _Var_)
|
|
|
|
|
|
If _Var_ is an attributed variable, delete <em>all</em> its
|
|
attributes. In all other cases, this predicate succeeds without
|
|
side-effects.
|
|
|
|
|
|
*/
|
|
prolog:del_attrs(Var) :-
|
|
attributes:del_all_atts(Var).
|
|
|
|
prolog:get_attrs(AttVar, SWIAtts) :-
|
|
attributes:get_all_swi_atts(AttVar,SWIAtts).
|
|
|
|
/** @pred put_attrs(+ _Var_,+ _Attributes_)
|
|
|
|
|
|
Set all attributes of _Var_. See get_attrs/2 for a description of
|
|
_Attributes_.
|
|
|
|
|
|
*/
|
|
prolog:put_attrs(_, []).
|
|
prolog:put_attrs(V, Atts) :-
|
|
cvt_to_swi_atts(Atts, YapAtts),
|
|
attributes:put_att_term(V, YapAtts).
|
|
|
|
cvt_to_swi_atts([], _).
|
|
cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
|
|
ModAttribute =.. [Mod, YapAtts, Attribute],
|
|
cvt_to_swi_atts(Atts, YapAtts).
|
|
|
|
/** @pred copy_term(? _TI_,- _TF_,- _Goals_)
|
|
|
|
Term _TF_ is a variant of the original term _TI_, such that for
|
|
each variable _V_ in the term _TI_ there is a new variable _V'_
|
|
in term _TF_ without any attributes attached. Attributed
|
|
variables are thus converted to standard variables. _Goals_ is
|
|
unified with a list that represents the attributes. The goal
|
|
`maplist(call, _Goals_)` can be called to recreate the
|
|
attributes.
|
|
|
|
Before the actual copying, `copy_term/3` calls
|
|
`attribute_goals/1` in the module where the attribute is
|
|
defined.
|
|
|
|
|
|
*/
|
|
prolog:copy_term(Term, Copy, Gs) :-
|
|
term_attvars(Term, Vs),
|
|
( Vs == []
|
|
-> Gs = [],
|
|
copy_term(Term, Copy)
|
|
; findall(Term-Gs,
|
|
'$attributes':residuals_and_delete_attributes(Vs, Gs, Term),
|
|
[Copy-Gs])
|
|
).
|
|
|
|
residuals_and_delete_attributes(Vs, Gs, Term) :-
|
|
attvars_residuals(Vs, Gs, []),
|
|
delete_attributes(Term).
|
|
|
|
attvars_residuals([]) --> [].
|
|
attvars_residuals([V|Vs]) -->
|
|
( { get_attrs(V, As) }
|
|
-> attvar_residuals(As, V)
|
|
; []
|
|
),
|
|
attvars_residuals(Vs).
|
|
|
|
%% @}
|
|
|
|
%
|
|
% wake_up_goal is called by the system whenever a suspended goal
|
|
% resumes.
|
|
%
|
|
|
|
/* The first case may happen if this variable was used for dif.
|
|
In this case, we need a way to keep the original
|
|
suspended goal around
|
|
*/
|
|
%'$wake_up_goal'([Module1|Continuation],G) :-
|
|
% '$write'(4,vsc_woke:G+[Module1|Continuation]:'
|
|
%'), fail.
|
|
prolog:'$wake_up_goal'([Module1|Continuation], LG) :-
|
|
% writeln( [Module1|Continuation]:LG),
|
|
execute_woken_system_goals(LG),
|
|
do_continuation(Continuation, Module1).
|
|
|
|
|
|
%
|
|
% in the first two cases restore register immediately and proceed
|
|
% to continuation. In the last case take care with modules, but do
|
|
% not act as if a meta-call.
|
|
%
|
|
%
|
|
do_continuation('$cut_by'(X), _) :- !,
|
|
'$$cut_by'(X).
|
|
do_continuation('$restore_regs'(X), _) :- !,
|
|
% yap_flag(gc_trace,verbose),
|
|
% garbage_collect,
|
|
'$restore_regs'(X).
|
|
do_continuation('$restore_regs'(X,Y), _) :- !,
|
|
% yap_flag(gc_trace,verbose),
|
|
% garbage_collect,
|
|
'$restore_regs'(X,Y).
|
|
do_continuation(Continuation, Module1) :-
|
|
execute_continuation(Continuation,Module1).
|
|
|
|
execute_continuation(Continuation, Module1) :-
|
|
'$undefined'(Continuation, Module1), !,
|
|
'$current_module'( M ),
|
|
'$swi_current_prolog_flag'( M:unknown, Default ),
|
|
'$undefp'([Module1|Continuation] , Default ).
|
|
execute_continuation(Continuation, Mod) :-
|
|
% do not do meta-expansion nor any fancy stuff.
|
|
'$execute0'(Continuation, Mod).
|
|
|
|
|
|
execute_woken_system_goals([]).
|
|
execute_woken_system_goals(['$att_do'(V,New)|LG]) :-
|
|
execute_woken_system_goals(LG),
|
|
call_atts(V,New).
|
|
|
|
%
|
|
% what to do when an attribute gets bound
|
|
%
|
|
call_atts(V,_) :-
|
|
nonvar(V), !.
|
|
call_atts(V,_) :-
|
|
'$att_bound'(V), !.
|
|
call_atts(V,New) :-
|
|
attributes:get_all_swi_atts(V,SWIAtts),
|
|
(
|
|
'$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes)
|
|
->
|
|
LGoals = [],
|
|
DoNotBind = false
|
|
;
|
|
attributes:woken_att_do(V, New, LGoals, DoNotBind)
|
|
),
|
|
( DoNotBind == true
|
|
->
|
|
attributes:unbind_attvar(V)
|
|
;
|
|
attributes:bind_attvar(V)
|
|
),
|
|
do_hook_attributes(SWIAtts, New),
|
|
lcall(LGoals).
|
|
|
|
do_hook_attributes([], _).
|
|
do_hook_attributes(att(Mod,Att,Atts), Binding) :-
|
|
('$undefined'(attr_unify_hook(Att,Binding), Mod)
|
|
->
|
|
true
|
|
;
|
|
Mod:attr_unify_hook(Att, Binding)
|
|
),
|
|
do_hook_attributes(Atts, Binding).
|
|
|
|
|
|
lcall([]).
|
|
lcall([Mod:Gls|Goals]) :-
|
|
lcall2(Gls,Mod),
|
|
lcall(Goals).
|
|
|
|
lcall2([], _).
|
|
lcall2([Goal|Goals], Mod) :-
|
|
call(Mod:Goal),
|
|
lcall2(Goals, Mod).
|
|
|
|
|
|
|
|
/** @pred call_residue_vars(: _G_, _L_)
|
|
|
|
|
|
|
|
Call goal _G_ and unify _L_ with a list of all constrained variables created <em>during</em> execution of _G_:
|
|
|
|
~~~~~
|
|
?- dif(X,Z), call_residue_vars(dif(X,Y),L).
|
|
dif(X,Z), call_residue_vars(dif(X,Y),L).
|
|
L = [Y],
|
|
dif(X,Z),
|
|
dif(X,Y) ? ;
|
|
|
|
no
|
|
~~~~~
|
|
*/
|
|
prolog:call_residue_vars(Goal,Residue) :-
|
|
attributes:all_attvars(Vs0),
|
|
call(Goal),
|
|
attributes:all_attvars(Vs),
|
|
% this should not be actually strictly necessary right now.
|
|
% but it makes it a safe bet.
|
|
sort(Vs, Vss),
|
|
sort(Vs0, Vs0s),
|
|
'$ord_remove'(Vss, Vs0s, Residue).
|
|
|
|
'$ord_remove'([], _, []).
|
|
'$ord_remove'([V|Vs], [], [V|Vs]).
|
|
'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :-
|
|
( V1 == V2 ->
|
|
'$ord_remove'(Vss, Vs0s, Residue)
|
|
;
|
|
V1 @< V2 ->
|
|
Residue = [V1|ResidueF],
|
|
'$ord_remove'(Vss, [V2|Vs0s], ResidueF)
|
|
;
|
|
'$ord_remove'([V1|Vss], Vs0s, Residue)
|
|
).
|
|
|
|
/** @pred _Module_:attribute_goal( _-Var_, _-Goal_)
|
|
|
|
User-defined procedure, called to convert the attributes in _Var_ to
|
|
a _Goal_. Should fail when no interpretation is available.
|
|
*/
|
|
attvar_residuals([], _) --> [].
|
|
attvar_residuals(att(Module,Value,As), V) -->
|
|
( { nonvar(V) }
|
|
-> % a previous projection predicate could have instantiated
|
|
% this variable, for example, to avoid redundant goals
|
|
[]
|
|
; { attributes:attributed_module(Module, _, _) } ->
|
|
% SICStus like run, put attributes back first
|
|
{ Value =.. [Name,_|Vs],
|
|
NValue =.. [Name,_|Vs],
|
|
attributes:put_module_atts(V,NValue)
|
|
},
|
|
attvar_residuals(As, V),
|
|
( { '$undefined'(attribute_goal(V, Goal), Module) }
|
|
->
|
|
[]
|
|
;
|
|
{ call(Module:attribute_goal(V, Goal)) },
|
|
dot_list(Goal)
|
|
)
|
|
; ( { current_predicate(Module:attribute_goals/3) }
|
|
-> { call(Module:attribute_goals(V, Goals, [])) },
|
|
list(Goals)
|
|
; { current_predicate(Module:attribute_goal/2) }
|
|
-> { call(Module:attribute_goal(V, Goal)) },
|
|
dot_list(Goal)
|
|
; [put_attr(V, Module, Value)]
|
|
),
|
|
attvar_residuals(As, V)
|
|
).
|
|
|
|
list([]) --> [].
|
|
list([L|Ls]) --> [L], list(Ls).
|
|
|
|
dot_list((A,B)) --> !, dot_list(A), dot_list(B).
|
|
dot_list(A) --> [A].
|
|
|
|
delete_attributes(Term) :-
|
|
term_attvars(Term, Vs),
|
|
delete_attributes_(Vs).
|
|
|
|
delete_attributes_([]).
|
|
delete_attributes_([V|Vs]) :-
|
|
del_attrs(V),
|
|
delete_attributes_(Vs).
|
|
|
|
|
|
|
|
/** @pred call_residue(: _G_, _L_)
|
|
|
|
|
|
|
|
Call goal _G_. If subgoals of _G_ are still blocked, return
|
|
a list containing these goals and the variables they are blocked in. The
|
|
goals are then considered as unblocked. The next example shows a case
|
|
where dif/2 suspends twice, once outside call_residue/2,
|
|
and the other inside:
|
|
|
|
~~~~~
|
|
?- dif(X,Y),
|
|
call_residue((dif(X,Y),(X = f(Z) ; Y = f(Z))), L).
|
|
|
|
X = f(Z),
|
|
L = [[Y]-dif(f(Z),Y)],
|
|
dif(f(Z),Y) ? ;
|
|
|
|
Y = f(Z),
|
|
L = [[X]-dif(X,f(Z))],
|
|
dif(X,f(Z)) ? ;
|
|
|
|
no
|
|
~~~~~
|
|
The system only reports one invocation of dif/2 as having
|
|
suspended.
|
|
|
|
|
|
*/
|
|
prolog:call_residue(Goal,Residue) :-
|
|
var(Goal), !,
|
|
'$do_error'(instantiation_error,call_residue(Goal,Residue)).
|
|
prolog:call_residue(Module:Goal,Residue) :-
|
|
atom(Module), !,
|
|
call_residue(Goal,Module,Residue).
|
|
prolog:call_residue(Goal,Residue) :-
|
|
'$current_module'(Module),
|
|
call_residue(Goal,Module,Residue).
|
|
|
|
call_residue(Goal,Module,Residue) :-
|
|
prolog:call_residue_vars(Module:Goal,NewAttVars),
|
|
(
|
|
attributes:modules_with_attributes([_|_])
|
|
->
|
|
project_attributes(NewAttVars, Module:Goal)
|
|
;
|
|
true
|
|
),
|
|
copy_term(Goal, Goal, Residue).
|
|
|
|
delayed_goals(G, Vs, NVs, Gs) :-
|
|
project_delayed_goals(G),
|
|
% term_factorized([G|Vs], [_|NVs], Gs).
|
|
copy_term([G|Vs], [_|NVs], Gs).
|
|
|
|
project_delayed_goals(G) :-
|
|
% SICStus compatible step,
|
|
% just try to simplify store by projecting constraints
|
|
% over query variables.
|
|
% called by top_level to find out about delayed goals
|
|
attributes:modules_with_attributes([_|_]), !,
|
|
attributes:all_attvars(LAV),
|
|
LAV = [_|_],
|
|
project_attributes(LAV, G), !.
|
|
project_delayed_goals(_).
|
|
|
|
|
|
attributed(G, Vs) :-
|
|
term_variables(G, LAV),
|
|
att_vars(LAV, Vs).
|
|
|
|
att_vars([], []).
|
|
att_vars([V|LGs], [V|AttVars]) :- attvar(V), !,
|
|
att_vars(LGs, AttVars).
|
|
att_vars([_|LGs], AttVars) :-
|
|
att_vars(LGs, AttVars).
|
|
|
|
% make sure we set the suspended goal list to its previous state!
|
|
% make sure we have installed a SICStus like constraint solver.
|
|
/** @pred _Module_:project_attributes( _+QueryVars_, _+AttrVars_)
|
|
|
|
|
|
Given a list of variables _QueryVars_ and list of attributed
|
|
variables _AttrVars_, project all attributes in _AttrVars_ to
|
|
_QueryVars_. Although projection is constraint system dependent,
|
|
typically this will involve expressing all constraints in terms of
|
|
_QueryVars_ and considering all remaining variables as existentially
|
|
quantified.
|
|
|
|
|
|
Projection interacts with attribute_goal/2 at the Prolog top
|
|
level. When the query succeeds, the system first calls
|
|
project_attributes/2. The system then calls
|
|
attribute_goal/2 to get a user-level representation of the
|
|
constraints. Typically, attribute_goal/2 will convert from the
|
|
original constraints into a set of new constraints on the projection,
|
|
and these constraints are the ones that will have an
|
|
attribute_goal/2 handler.
|
|
|
|
|
|
*/
|
|
project_attributes(AllVs, G) :-
|
|
attributes:modules_with_attributes(LMods),
|
|
LMods = [_|_],
|
|
term_variables(G, InputVs),
|
|
pick_att_vars(InputVs, AttIVs),
|
|
project_module(LMods, AttIVs, AllVs).
|
|
|
|
pick_att_vars([],[]).
|
|
pick_att_vars([V|L],[V|NL]) :- attvar(V), !,
|
|
pick_att_vars(L,NL).
|
|
pick_att_vars([_|L],NL) :-
|
|
pick_att_vars(L,NL).
|
|
|
|
project_module([], _, _).
|
|
project_module([Mod|LMods], LIV, LAV) :-
|
|
'$pred_exists'(project_attributes(LIV, LAV),Mod),
|
|
call(Mod:project_attributes(LIV, LAV)), !,
|
|
attributes:all_attvars(NLAV),
|
|
project_module(LMods,LIV,NLAV).
|
|
project_module([_|LMods], LIV, LAV) :-
|
|
project_module(LMods,LIV,LAV).
|
|
|
|
/**
|
|
@}
|
|
*/
|