359 lines
8.1 KiB
C
359 lines
8.1 KiB
C
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: mavar.c *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: support from multiple assignment variables in YAP *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
|
|
/** @defgroup Term_Modification Term Modification
|
|
@ingroup YAPBuiltins
|
|
@{
|
|
|
|
It is sometimes useful to change the value of instantiated
|
|
variables. Although, this is against the spirit of logic programming, it
|
|
is sometimes useful. As in other Prolog systems, YAP has
|
|
several primitives that allow updating Prolog terms. Note that these
|
|
primitives are also backtrackable.
|
|
|
|
The `setarg/3` primitive allows updating any argument of a Prolog
|
|
compound terms. The `mutable` family of predicates provides
|
|
<em>mutable variables</em>. They should be used instead of `setarg/3`,
|
|
as they allow the encapsulation of accesses to updatable
|
|
variables. Their implementation can also be more efficient for long
|
|
deterministic computations.
|
|
|
|
|
|
|
|
*/
|
|
|
|
|
|
#include "Yap.h"
|
|
|
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
|
|
|
#include "Yatom.h"
|
|
#include "YapHeap.h"
|
|
#include "eval.h"
|
|
|
|
static Int p_setarg( USES_REGS1 );
|
|
static Int p_create_mutable( USES_REGS1 );
|
|
static Int p_get_mutable( USES_REGS1 );
|
|
static Int p_update_mutable( USES_REGS1 );
|
|
static Int p_is_mutable( USES_REGS1 );
|
|
|
|
static Int
|
|
p_setarg( USES_REGS1 )
|
|
{
|
|
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
|
|
Int i;
|
|
|
|
if (IsVarTerm(t3) &&
|
|
VarOfTerm(t3) > HR &&VarOfTerm(t3) < ASP) {
|
|
/* local variable */
|
|
Term tn = MkVarTerm();
|
|
Bind_Local(VarOfTerm(t3), tn);
|
|
t3 = tn;
|
|
}
|
|
if (IsVarTerm(ti)) {
|
|
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
|
|
return FALSE;
|
|
} else {
|
|
if (IsIntTerm(ti))
|
|
i = IntOfTerm(ti);
|
|
else {
|
|
Term te = Yap_Eval(ti);
|
|
if (IsIntegerTerm(te)) {
|
|
i = IntegerOfTerm(te);
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
|
|
return FALSE;
|
|
}
|
|
}
|
|
}
|
|
if (IsVarTerm(ts)) {
|
|
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
|
|
} else if(IsApplTerm(ts)) {
|
|
CELL *pt;
|
|
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
|
|
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
|
|
return FALSE;
|
|
}
|
|
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
|
|
if (i<0)
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
|
|
return FALSE;
|
|
if (i==0)
|
|
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
|
|
return FALSE;
|
|
}
|
|
pt = RepAppl(ts)+i;
|
|
/* the evil deed is to be done now */
|
|
MaBind(pt, t3);
|
|
} else if(IsPairTerm(ts)) {
|
|
CELL *pt;
|
|
if (i < 1 || i > 2) {
|
|
if (i<0)
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
|
|
return FALSE;
|
|
}
|
|
pt = RepPair(ts)+i-1;
|
|
/* the evil deed is to be done now */
|
|
MaBind(pt, t3);
|
|
} else {
|
|
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
|
|
return FALSE;
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
|
|
/* One problem with MAVars is that they you always trail on
|
|
non-determinate bindings. This is not cool if you have a long
|
|
determinate computation. One alternative could be to use
|
|
timestamps.
|
|
|
|
Because of !, the only timestamp one can trust is the trailpointer
|
|
(ouch..). The trail is not reclaimed after cuts. Also, if there was
|
|
a conditional binding, the trail is sure to have been increased
|
|
since the last choicepoint. For maximum effect, we can actually
|
|
store the current value of TR in the timestamp field, giving a way
|
|
to actually follow a link of all trailings for these variables.
|
|
|
|
*/
|
|
|
|
/* create and initialise a new timed var. The problem is: how to set
|
|
the clock?
|
|
|
|
If I give it the current value of B->TR, we may have trouble if no
|
|
non-determinate bindings are made before the next
|
|
choice-point. Just to make sure this doesn't cause trouble, if (TR
|
|
== B->TR) we will add a little something ;-).
|
|
*/
|
|
|
|
static Term
|
|
NewTimedVar(CELL val USES_REGS)
|
|
{
|
|
Term out;
|
|
timed_var *tv;
|
|
if (IsVarTerm(val) &&
|
|
VarOfTerm(val) > HR) {
|
|
Term nval = MkVarTerm();
|
|
Bind_Local(VarOfTerm(val), nval);
|
|
val = nval;
|
|
}
|
|
out = AbsAppl(HR);
|
|
*HR++ = (CELL)FunctorMutable;
|
|
tv = (timed_var *)HR;
|
|
RESET_VARIABLE(&(tv->clock));
|
|
tv->value = val;
|
|
HR += sizeof(timed_var)/sizeof(CELL);
|
|
return(out);
|
|
}
|
|
|
|
Term
|
|
Yap_NewTimedVar(CELL val)
|
|
{
|
|
CACHE_REGS
|
|
return NewTimedVar(val PASS_REGS);
|
|
}
|
|
|
|
Term
|
|
Yap_NewEmptyTimedVar( void )
|
|
{
|
|
CACHE_REGS
|
|
Term out = AbsAppl(HR);
|
|
timed_var *tv;
|
|
*HR++ = (CELL)FunctorMutable;
|
|
tv = (timed_var *)HR;
|
|
RESET_VARIABLE(&(tv->clock));
|
|
RESET_VARIABLE(&(tv->value));
|
|
HR += sizeof(timed_var)/sizeof(CELL);
|
|
return(out);
|
|
}
|
|
|
|
static Term
|
|
ReadTimedVar(Term inv)
|
|
{
|
|
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
|
|
return(tv->value);
|
|
}
|
|
|
|
Term
|
|
Yap_ReadTimedVar(Term inv)
|
|
{
|
|
return ReadTimedVar(inv);
|
|
}
|
|
|
|
|
|
/* update a timed var with a new value */
|
|
static Term
|
|
UpdateTimedVar(Term inv, Term new USES_REGS)
|
|
{
|
|
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
|
|
CELL t = tv->value;
|
|
CELL* timestmp = (CELL *)(tv->clock);
|
|
if (IsVarTerm(new) &&
|
|
VarOfTerm(new) > HR) {
|
|
Term nnew = MkVarTerm();
|
|
Bind_Local(VarOfTerm(new), nnew);
|
|
new = nnew;
|
|
}
|
|
if (timestmp > B->cp_h
|
|
#if FROZEN_STACKS
|
|
&& timestmp > H_FZ
|
|
#endif
|
|
) {
|
|
/* last assignment more recent than last B */
|
|
#if YAPOR_SBA
|
|
if (Unsigned((Int)(tv)-(Int)(H_FZ)) >
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ)))
|
|
*STACK_TO_SBA(&(tv->value)) = new;
|
|
else
|
|
#endif
|
|
tv->value = new;
|
|
} else {
|
|
Term nclock = (Term)HR;
|
|
MaBind(&(tv->value), new);
|
|
*HR++ = TermFoundVar;
|
|
MaBind(&(tv->clock), nclock);
|
|
}
|
|
return(t);
|
|
}
|
|
|
|
/* update a timed var with a new value */
|
|
Term
|
|
Yap_UpdateTimedVar(Term inv, Term new)
|
|
{
|
|
CACHE_REGS
|
|
return UpdateTimedVar(inv, new PASS_REGS);
|
|
}
|
|
|
|
static Int
|
|
p_create_mutable( USES_REGS1 )
|
|
{
|
|
Term t = NewTimedVar(Deref(ARG1) PASS_REGS);
|
|
return(Yap_unify(ARG2,t));
|
|
}
|
|
|
|
static Int
|
|
p_get_mutable( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG2);
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR, t, "get_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
if (!IsApplTerm(t)) {
|
|
Yap_Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
if (FunctorOfTerm(t) != FunctorMutable) {
|
|
Yap_Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
t = ReadTimedVar(t);
|
|
return(Yap_unify(ARG1, t));
|
|
}
|
|
|
|
static Int
|
|
p_update_mutable( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG2);
|
|
if (IsVarTerm(t)) {
|
|
Yap_Error(INSTANTIATION_ERROR, t, "update_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
if (!IsApplTerm(t)) {
|
|
Yap_Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
if (FunctorOfTerm(t) != FunctorMutable) {
|
|
Yap_Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
|
|
return(FALSE);
|
|
}
|
|
UpdateTimedVar(t, Deref(ARG1) PASS_REGS);
|
|
return(TRUE);
|
|
}
|
|
|
|
static Int
|
|
p_is_mutable( USES_REGS1 )
|
|
{
|
|
Term t = Deref(ARG1);
|
|
if (IsVarTerm(t)) {
|
|
return(FALSE);
|
|
}
|
|
if (!IsApplTerm(t)) {
|
|
return(FALSE);
|
|
}
|
|
if (FunctorOfTerm(t) != FunctorMutable) {
|
|
return(FALSE);
|
|
}
|
|
return(TRUE);
|
|
}
|
|
|
|
#endif
|
|
|
|
void
|
|
Yap_InitMaVarCPreds(void)
|
|
{
|
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
|
/* The most famous contributions of SICStus to the Prolog language */
|
|
Yap_InitCPred("setarg", 3, p_setarg, SafePredFlag);
|
|
/** @pred setarg(+ _I_,+ _S_,? _T_)
|
|
|
|
|
|
Set the value of the _I_th argument of term _S_ to term _T_.
|
|
|
|
|
|
*/
|
|
Yap_InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
|
|
/** @pred create_mutable(+ _D_,- _M_)
|
|
|
|
|
|
Create new mutable variable _M_ with initial value _D_.
|
|
|
|
|
|
*/
|
|
Yap_InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
|
|
/** @pred get_mutable(? _D_,+ _M_)
|
|
|
|
|
|
Unify the current value of mutable term _M_ with term _D_.
|
|
|
|
|
|
*/
|
|
Yap_InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
|
|
/** @pred update_mutable(+ _D_,+ _M_)
|
|
|
|
|
|
Set the current value of mutable term _M_ to term _D_.
|
|
|
|
|
|
|
|
*/
|
|
Yap_InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
|
|
/** @pred is_mutable(? _D_)
|
|
|
|
|
|
Holds if _D_ is a mutable term.
|
|
|
|
|
|
*/
|
|
#endif
|
|
}
|
|
|
|
/**
|
|
@}
|
|
*/
|