This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/mavar.c
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

277 lines
6.9 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 *
* *
*************************************************************************/
#include "Yap.h"
#ifdef MULTI_ASSIGNMENT_VARIABLES
#include "Yatom.h"
#include "Heap.h"
#include "eval.h"
STD_PROTO(static Int p_setarg, (void));
STD_PROTO(static void CreateTimedVar, (Term));
STD_PROTO(static void CreateEmptyTimedVar, (void));
STD_PROTO(static Int p_create_mutable, (void));
STD_PROTO(static Int p_get_mutable, (void));
STD_PROTO(static Int p_update_mutable, (void));
STD_PROTO(static Int p_is_mutable, (void));
static Int
p_setarg(void)
{
CELL ti = Deref(ARG1), ts = Deref(ARG2);
Int i;
if (IsVarTerm(ti)) {
Error(INSTANTIATION_ERROR,ti,"setarg/3");
return(FALSE);
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
union arith_ret v;
if (Eval(ti, &v) == long_int_e) {
i = v.Int;
} else {
Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return(FALSE);
}
}
}
if (IsVarTerm(ts)) {
Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return(FALSE);
}
if (i < 0 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return(FALSE);
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, Deref(ARG3));
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i != 1 || i != 2) {
if (i<0)
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, Deref(ARG3));
} else {
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 during backtracking. 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 void
CreateTimedVar(Term val)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
tv->value = val;
H += sizeof(timed_var)/sizeof(CELL);
}
static void
CreateEmptyTimedVar(void)
{
timed_var *tv = (timed_var *)H;
tv->clock = MkIntegerTerm((Int)((CELL *)(B->cp_tr)-(CELL *)TrailBase));
if (B->cp_tr == TR) {
/* we run the risk of not making non-determinate bindings before
the end of the night */
/* so we just init a TR cell that will not harm anyone */
Bind((CELL *)(TR+1),AbsAppl(H-1));
}
RESET_VARIABLE(&(tv->value));
H += sizeof(timed_var)/sizeof(CELL);
}
Term NewTimedVar(CELL val)
{
Term t = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
CreateTimedVar(val);
return(t);
}
Term NewEmptyTimedVar(void)
{
Term t = AbsAppl(H);
*H++ = (CELL)FunctorMutable;
CreateEmptyTimedVar();
return(t);
}
Term ReadTimedVar(Term inv)
{
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
return(tv->value);
}
/* update a timed var with a new value */
Term UpdateTimedVar(Term inv, Term new)
{
timed_var *tv = (timed_var *)(RepAppl(inv)+1);
CELL t = tv->value;
tr_fr_ptr timestmp = (tr_fr_ptr)((CELL *)TrailBase + IntegerOfTerm(tv->clock));
if (B->cp_tr <= timestmp
#if defined(SBA) || defined(TABLING)
&& timestmp <= TR
#endif
) {
/* last assignment more recent than last B */
#if 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;
#if defined(SBA) || defined(TABLING)
if (Unsigned((Int)(tv)-(Int)(HBREG)) >
Unsigned(BBREG)-(Int)(HBREG))
TrailVal(timestmp-1) = new;
#endif
} else {
Term nclock;
MaBind(&(tv->value), new);
nclock = MkIntegerTerm((Int)((CELL *)TR-(CELL *)TrailBase));
MaBind(&(tv->clock), nclock);
}
return(t);
}
static Int
p_create_mutable(void)
{
Term t = NewTimedVar(Deref(ARG1));
return(unify(ARG2,t));
}
static Int
p_get_mutable(void)
{
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "get_mutable/3");
return(FALSE);
}
if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"get_mutable/3");
return(FALSE);
}
if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"get_mutable/3");
return(FALSE);
}
t = ReadTimedVar(t);
return(unify(ARG1, t));
}
static Int
p_update_mutable(void)
{
Term t = Deref(ARG2);
if (IsVarTerm(t)) {
Error(INSTANTIATION_ERROR, t, "update_mutable/3");
return(FALSE);
}
if (!IsApplTerm(t)) {
Error(TYPE_ERROR_COMPOUND,t,"update_mutable/3");
return(FALSE);
}
if (FunctorOfTerm(t) != FunctorMutable) {
Error(DOMAIN_ERROR_MUTABLE,t,"update_mutable/3");
return(FALSE);
}
UpdateTimedVar(t, Deref(ARG1));
return(TRUE);
}
static Int
p_is_mutable(void)
{
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
return(FALSE);
}
if (!IsApplTerm(t)) {
return(FALSE);
}
if (FunctorOfTerm(t) != FunctorMutable) {
return(FALSE);
}
return(TRUE);
}
#endif
void
InitMaVarCPreds(void)
{
#ifdef MULTI_ASSIGNMENT_VARIABLES
/* The most famous contributions of SICStus to the Prolog language */
InitCPred("setarg", 3, p_setarg, SafePredFlag);
InitCPred("create_mutable", 2, p_create_mutable, SafePredFlag);
InitCPred("get_mutable", 2, p_get_mutable, SafePredFlag);
InitCPred("update_mutable", 2, p_update_mutable, SafePredFlag);
InitCPred("is_mutable", 1, p_is_mutable, SafePredFlag);
#endif
}