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