/*-------------------------------------------------------------------------*
* PL_FD_CHECK_FOR_BOOL_VAR *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Check_For_Bool_Var(WamWord x_word)
{
WamWord word, tag_mask;
WamWord *adr, *fdv_adr;
Range range;
DEREF(x_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
{
adr = UnTag_REF(word);
fdv_adr = Pl_Fd_New_Bool_Variable();
Bind_UV(adr, Tag_REF(fdv_adr));
return TRUE;
}
if (tag_mask == TAG_INT_MASK)
return (unsigned long) (UnTag_INT(word)) <= 1;
if (tag_mask != TAG_FDV_MASK)
Pl_Err_Type(pl_type_fd_variable, word);
fdv_adr = UnTag_FDV(word);
if (Min(fdv_adr) > 1)
return FALSE;
if (Max(fdv_adr) <= 1)
return TRUE;
/* here max > 1 */
if (Min(fdv_adr) == 1)
return Pl_Fd_Unify_With_Integer0(fdv_adr, 1);
/* here min == 0 */
if (!Pl_Range_Test_Value(Range(fdv_adr), 1))
return Pl_Fd_Unify_With_Integer0(fdv_adr, 0);
/* Check Bool == X in 0..1 */
Pl_Fd_Before_Add_Cstr();
if (Is_Sparse(Range(fdv_adr)))
{
Range_Init_Interval(&range, 0, 1);
if (!Pl_Fd_Tell_Range_Range(fdv_adr, &range))
return FALSE;
}
else if (!Pl_Fd_Tell_Interv_Interv(fdv_adr, 0, 1))
return FALSE;
return Pl_Fd_After_Add_Cstr();
}
/*-------------------------------------------------------------------------*
* SET_NOT *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Not(WamWord *exp, int result, WamWord *load_word)
{
if (result == 0) /* ~X is false */
return Pl_Get_Integer(1, exp[1]);
if (result == 1) /* ~X is true */
return Pl_Get_Integer(0, exp[1]);
/* ~X=B */
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
BOOL_CSTR_2(pl_not_x_eq_b, exp[1], *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* SET_NOR *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Nor(WamWord *exp, int result, WamWord *load_word)
{
WamWord load_l, load_r;
if (result <= 1) /* L ~\/ R is true or false */
return Set_Or(exp, 1 - result, load_word);
if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) ||
!Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r))
return FALSE;
/* L ~\/ R = B */
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
BOOL_CSTR_3(pl_x_nor_y_eq_b, load_l, load_r, *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* SET_EQUIV *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Equiv(WamWord *exp, int result, WamWord *load_word)
{
WamWord load_l, load_r;
if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) ||
!Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r))
return FALSE;
if (result == 0) /* L <=> R is false */
{
BOOL_CSTR_2(pl_not_x_eq_b, load_l, load_r);
return TRUE;
}
if (result == 1) /* L <=> R is true */
return Pl_Fd_Math_Unify_X_Y(load_l, load_r);
/* L <=> R = B */
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
BOOL_CSTR_3(pl_x_equiv_y_eq_b, load_l, load_r, *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* SET_OR *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Or(WamWord *exp, int result, WamWord *load_word)
{
WamWord load_l, load_r;
if (result == 0) /* L \/ R is false */
return Load_Bool_Into_Word((WamWord *) (exp[1]), 0, NULL) &&
Load_Bool_Into_Word((WamWord *) (exp[2]), 0, NULL);
if (!Load_Bool_Into_Word((WamWord *) (exp[1]), 2, &load_l) ||
!Load_Bool_Into_Word((WamWord *) (exp[2]), 2, &load_r))
return FALSE;
if (result == 1) /* L \/ R is true */
{
BOOL_CSTR_2(pl_x_or_y_eq_1, load_l, load_r);
return TRUE;
}
/* L \/ R = B */
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
BOOL_CSTR_3(pl_x_or_y_eq_b, load_l, load_r, *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* SET_LTE *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Lte(WamWord *exp, int result, WamWord *load_word)
{
WamWord le_word, re_word;
int mask;
WamWord l_word, r_word;
PlLong c;
le_word = exp[1];
re_word = exp[2];
if (result == 0) /* L <= R is false */
return Pl_Fd_Lt_2(re_word, le_word);
if (result == 1) /* L <= R is true */
return Pl_Fd_Lte_2(le_word, re_word);
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
#ifdef DEBUG
cur_op = (pl_full_ac) ? "truth#=<#" : "truth#=<";
#endif
if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)
|| !Pl_Term_Math_Loading(l_word, r_word))
return FALSE;
switch (mask)
{
case MASK_EMPTY:
return Pl_Get_Integer(c <= 0, *load_word);
case MASK_LEFT:
if (c > 0)
return Pl_Get_Integer(0, *load_word);
PRIM_CSTR_3(pl_truth_x_lte_c, l_word, Tag_INT(-c), *load_word);
return TRUE;
case MASK_RIGHT:
if (c <= 0)
return Pl_Get_Integer(1, *load_word);
PRIM_CSTR_3(pl_truth_x_gte_c, r_word, Tag_INT(c), *load_word);
return TRUE;
}
if (c > 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_lte_y, l_word, Tag_INT(c), r_word,
*load_word);
return TRUE;
}
if (c < 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_gte_y, r_word, Tag_INT(-c), l_word,
*load_word);
return TRUE;
}
PRIM_CSTR_3(pl_truth_x_lte_y, l_word, r_word, *load_word);
return TRUE;
}
