/*-------------------------------------------------------------------------*
* PL_TERM_MATH_LOADING *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Term_Math_Loading(WamWord l_word, WamWord r_word)
{
WamWord word, tag_mask;
WamWord *adr, *fdv_adr;
if (delay_sp != delay_cstr_stack)
{
#ifdef DEBUG
DBGPRINTF("\nnon Linear part\n");
#endif
if (!Load_Delay_Cstr_Part())
return FALSE;
}
while (--vars_sp >= vars_tbl)
{
DEREF(*vars_sp, word, tag_mask);
if (tag_mask == TAG_REF_MASK && word != l_word && word != r_word)
{
adr = UnTag_REF(word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
}
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_FD_PROLOG_TO_FD_VAR *
* *
*-------------------------------------------------------------------------*/
WamWord *
Pl_Fd_Prolog_To_Fd_Var(WamWord arg_word, Bool pl_var_ok)
{
WamWord word, tag_mask;
WamWord *adr, *fdv_adr;
DEREF(arg_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
{
if (!pl_var_ok)
Pl_Err_Instantiation();
adr = UnTag_REF(word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
return fdv_adr;
}
if (tag_mask == TAG_INT_MASK)
return Pl_Fd_New_Int_Variable(UnTag_INT(word));
if (tag_mask == TAG_FDV_MASK)
return UnTag_FDV(word);
Pl_Err_Type(pl_type_fd_variable, word);
return NULL;
}
/*-------------------------------------------------------------------------*
* PL_FD_NEW_BOOL_VARIABLE *
* *
*-------------------------------------------------------------------------*/
WamWord *
Pl_Fd_New_Bool_Variable(void)
{
WamWord *fdv_adr = Pl_Fd_New_Variable();
Nb_Elem(fdv_adr) = 2;
Min(fdv_adr) = 0;
Max(fdv_adr) = 1;
return fdv_adr;
}
/*-------------------------------------------------------------------------*
* PL_FD_BOOL_META_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Bool_Meta_3(WamWord le_word, WamWord re_word, WamWord op_word)
{
WamWord word, tag_mask;
WamWord *adr, *fdv_adr;
WamWord *exp;
int op;
static WamWord h[3]; /* static to avoid high address */
DEREF(op_word, word, tag_mask);
op = UnTag_INT(op_word);
h[0] = bool_tbl[op]; /* also works for NOT/1 */
h[1] = le_word;
h[2] = re_word;
sp = stack;
vars_sp = vars_tbl;
exp = Simplify(1, Tag_STC(h));
#ifdef DEBUG
Display_Stack(exp);
DBGPRINTF("\n");
#endif
if (!Load_Bool_Into_Word(exp, 1, NULL))
return FALSE;
while (--vars_sp >= vars_tbl)
if (*vars_sp-- == 0) /* bool var */
{
if (!Pl_Fd_Check_For_Bool_Var(*vars_sp))
return FALSE;
}
else /* FD var */
{
DEREF(*vars_sp, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
{
adr = UnTag_REF(word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
}
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_FD_COPY_VARIABLE0 *
* *
* returns the size of the created fd var. *
*-------------------------------------------------------------------------*/
int
Pl_Fd_Copy_Variable0(WamWord *dst_adr, WamWord *fdv_adr)
{
WamWord *save_CS;
int size;
save_CS = CS;
CS = dst_adr;
Pl_Fd_New_Variable(); /* we know that it is pushed at CS (=dst_adr) */
Nb_Elem(dst_adr) = Nb_Elem(fdv_adr);
Pl_Range_Copy(Range(dst_adr), Range(fdv_adr));
size = CS - dst_adr;
CS = save_CS;
return size;
}
/*-------------------------------------------------------------------------*
* PL_FD_REIFIED_IN *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word)
{
WamWord word, tag_mask;
WamWord b_tag_mask, x_tag_mask;
WamWord *adr, *fdv_adr;
PlLong x;
PlLong b = -1; /* a var */
int min, max;
int x_min, x_max;
Range *r;
// Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word);
/* from fd_values_c.c (optimized version) */
Bool Pl_Fd_Domain_Interval(WamWord x_word, int min, int max);
/* from fd_values_fd.fd */
Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word);
min = Pl_Fd_Prolog_To_Value(l_word);
if (min < 0)
min = 0;
max = Pl_Fd_Prolog_To_Value(u_word);
DEREF(x_word, word, tag_mask);
x_word = word;
x_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
{
err_type_fd:
Pl_Err_Type(pl_type_fd_variable, word);
return FALSE;
}
DEREF(b_word, word, tag_mask);
b_word = word;
b_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
goto err_type_fd;
if (x_tag_mask == TAG_INT_MASK)
{
x = UnTag_INT(x_word);
b = (x >= min) && (x <= max);
unif_b:
return Pl_Get_Integer(b, b_word);
}
if (b_tag_mask == TAG_INT_MASK)
{
b = UnTag_INT(b_word);
if (b == 0)
return pl_fd_not_domain(x_word, l_word, u_word);
return (b == 1) && Pl_Fd_Domain_Interval(x_word, min, max);
}
if (x_tag_mask == TAG_REF_MASK) /* make an FD var */
{
adr = UnTag_REF(x_word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
else
fdv_adr = UnTag_FDV(x_word);
r = Range(fdv_adr);
x_min = r->min;
x_max = r->max;
if (x_min >= min && x_max <= max)
{
b = 1;
goto unif_b;
}
if (min > max || x_max < min || x_min > max) /* NB: if L..U is empty then B = 0 */
{
b = 0;
goto unif_b;
}
if (!Pl_Fd_Check_For_Bool_Var(b_word))
return FALSE;
PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_FD_REIFIED_IN *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Reified_In(WamWord x_word, WamWord l_word, WamWord u_word, WamWord b_word)
{
WamWord word, tag_mask;
WamWord b_tag_mask, x_tag_mask;
WamWord *adr, *fdv_adr;
int x;
int l = Pl_Rd_Integer_Check(l_word);
int u = Pl_Rd_Integer_Check(u_word);
int b = -1; /* a var */
Range *r;
int x_min, x_max;
Bool pl_fd_domain(WamWord x_word, WamWord l_word, WamWord u_word);
Bool pl_fd_not_domain(WamWord x_word, WamWord l_word, WamWord u_word);
DEREF(x_word, word, tag_mask);
x_word = word;
x_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
{
err_type_fd:
Pl_Err_Type(pl_type_fd_variable, word);
return FALSE;
}
DEREF(b_word, word, tag_mask);
b_word = word;
b_tag_mask = tag_mask;
if (tag_mask != TAG_REF_MASK && tag_mask != TAG_FDV_MASK && tag_mask != TAG_INT_MASK)
goto err_type_fd;
if (x_tag_mask == TAG_INT_MASK)
{
x = UnTag_INT(x_word);
b = (x >= l) && (x <= u);
unif_b:
return Pl_Get_Integer(b, b_word);
}
if (b_tag_mask == TAG_INT_MASK)
{
b = UnTag_INT(b_word);
if (b == 0)
return pl_fd_not_domain(x_word, l_word, u_word);
return (b == 1) && pl_fd_domain(x_word, l_word, u_word);
}
if (x_tag_mask == TAG_REF_MASK) /* make an FD var */
{
adr = UnTag_REF(x_word);
fdv_adr = Pl_Fd_New_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
}
else
fdv_adr = UnTag_FDV(x_word);
r = Range(fdv_adr);
x_min = r->min;
x_max = r->max;
if (x_min >= l && x_max <= u)
{
b = 1;
goto unif_b;
}
if (l > u || x_max < l || x_min > u) /* NB: if L..U is empty then B = 0 */
{
b = 0;
goto unif_b;
}
if (!Pl_Fd_Check_For_Bool_Var(b_word))
return FALSE;
PRIM_CSTR_4(pl_truth_x_in_l_u, x_word, l_word, u_word, b_word);
return TRUE;
}
