/*-------------------------------------------------------------------------* * 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; }