/*-------------------------------------------------------------------------*
* PL_FD_MATH_UNIFY_X_Y *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Math_Unify_X_Y(WamWord x, WamWord y)
{
WamWord x_word, x_tag;
WamWord y_word, y_tag;
DEREF(x, x_word, x_tag);
DEREF(y, y_word, y_tag);
if (x_tag == TAG_FDV_MASK && y_tag == TAG_FDV_MASK)
{
MATH_CSTR_2(pl_x_eq_y, x, y);
return TRUE;
}
#ifdef DEBUG
DBGPRINTF("Prolog Unif: ");
Pl_Write_1(x_word);
DBGPRINTF(" = ");
Pl_Write_1(y_word);
DBGPRINTF("\n");
#endif
return Pl_Unify(x_word, y_word);
}
/*-------------------------------------------------------------------------*
* PL_LOAD_LEFT_RIGHT *
* *
* This function loads the left and right term of a constraint into (new) *
* variables. *
* Input: *
* optim_eq: is used to optimize loadings of a term1 #= term2 constraint*
* when the constant is zero. *
* le_word : left term of the constraint *
* re_word : right term of the constraint *
* *
* Output: *
* mask : indicates if l_word and r_word are used (see MASK_... cst) *
* c : the general (signed) constant *
* l_word : the variable containing the left part (tagged <REF,adr>) *
* r_word : the variable containing the right part (tagged <REF,adr>) *
*-------------------------------------------------------------------------*/
Bool
Pl_Load_Left_Right(Bool optim_eq, WamWord le_word, WamWord re_word,
int *mask, PlLong *c, WamWord *l_word, WamWord *r_word)
{
#ifdef DEBUG
DBGPRINTF("\n*** Math constraint : ");
Pl_Write_1(le_word);
DBGPRINTF(" %s ", cur_op);
Pl_Write_1(re_word);
DBGPRINTF("\n");
#endif
delay_sp = delay_cstr_stack;
vars_sp = vars_tbl;
return Load_Left_Right_Rec(optim_eq, le_word, re_word, mask, c,
l_word, r_word);
}
/*-------------------------------------------------------------------------*
* DEBUG_DISPLAY *
* *
*-------------------------------------------------------------------------*/
void
Debug_Display(char *fct, int n, ...)
{
va_list arg_ptr;
WamWord word;
int i;
char *s1[] = { "plus", "eq", "neq", "lte", "lt", "gte", "gt", NULL };
char *s2[] = { "+", "=", "\\=", "<=", "<", ">=", ">" };
char **s;
char *p;
va_start(arg_ptr, n);
DBGPRINTF("'");
for (p = fct; *p; p++)
{
if (*p == '_')
{
for (s = s1; *s; s++)
{
i = strlen(*s);
if (strncmp(*s, p + 1, i) == 0)
break;
}
if (*s && p[1 + i] == '_')
{
p += 1 + i;
DBGPRINTF(s2[s - s1]);
continue;
}
}
DBGPRINTF("%c", *p);
}
DBGPRINTF("'(");
for (i = 0; i < n; i++)
{
word = va_arg(arg_ptr, WamWord);
Pl_Write_1(word);
DBGPRINTF("%c", (i < n - 1) ? ',' : ')');
}
va_end(arg_ptr);
DBGPRINTF("\n");
}
/*-------------------------------------------------------------------------*
* DISPLAY_STACK *
* *
*-------------------------------------------------------------------------*/
static void
Display_Stack(WamWord *exp)
{
int op = exp[0];
WamWord *le = (WamWord *) (exp[1]);
WamWord *re = (WamWord *) (exp[2]);
switch (op)
{
case NOT:
DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name);
DBGPRINTF(" ");
Pl_Write_1(exp[1]);
break;
case EQUIV:
case NEQUIV:
case IMPLY:
case NIMPLY:
case AND:
case NAND:
case OR:
case NOR:
DBGPRINTF("(");
Display_Stack(le);
DBGPRINTF(" ");
DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name);
DBGPRINTF(" ");
Display_Stack(re);
DBGPRINTF(")");
break;
case EQ:
case NEQ:
case LT:
case LTE:
case GT:
case GTE:
case EQ_F:
case NEQ_F:
case LT_F:
case LTE_F:
case GT_F:
case GTE_F:
Pl_Write_1(exp[1]);
DBGPRINTF(" ");
DBGPRINTF("%s", pl_atom_tbl[Functor_Of(bool_tbl[op])].name);
DBGPRINTF(" ");
Pl_Write_1(exp[2]);
break;
case ZERO:
DBGPRINTF("0");
break;
case ONE:
DBGPRINTF("1");
break;
default:
Pl_Write_1(*exp);
}
}
/*-------------------------------------------------------------------------*
* LOAD_LEFT_RIGHT_REC *
* *
* This function can be called with re_word == NOT_A_WAM_WORD by the fct *
* Load_Term_Into_Word(). In that case, re_word is simply ignored. *
*-------------------------------------------------------------------------*/
static Bool
Load_Left_Right_Rec(Bool optim_eq, WamWord le_word, WamWord re_word,
int *mask, PlLong *c, WamWord *l_word, WamWord *r_word)
{
Poly p;
Monom *l_m, *r_m;
Monom *cur, *pos, *neg, *end;
int l_nb_monom, r_nb_monom;
WamWord pref_load_word; /* to optimize equalities (#=) */
int i;
sort = FALSE;
New_Poly(p);
if (!Normalize(le_word, +1, &p))
return FALSE;
if (re_word != NOT_A_WAM_WORD && !Normalize(re_word, -1, &p))
return FALSE;
if (sort || p.nb_monom > MAX_MONOMS / 2)
{
qsort(p.m, p.nb_monom, sizeof(Monom),
(int (*)(const void *, const void *)) Compar_Monom);
for (i = 0; i < p.nb_monom; i++) /* find left monomial terms */
if (p.m[i].a <= 0)
break;
l_m = p.m;
l_nb_monom = i;
for (; i < p.nb_monom; i++) /* find right monomial terms */
if (p.m[i].a >= 0)
break;
else
p.m[i].a = -p.m[i].a; /* only positive coefs now */
r_m = l_m + l_nb_monom;
r_nb_monom = i - l_nb_monom;
}
else
{
pos = p.m;
end = pos + p.nb_monom;
neg = end;
for (cur = pos; cur < end; cur++)
{
if (cur->a < 0)
{
neg->a = -cur->a;
neg->x_word = cur->x_word;
neg++;
continue;
}
if (cur->a > 0)
{
if (cur != pos)
*pos = *cur;
pos++;
}
}
l_m = p.m;
l_nb_monom = pos - l_m;
r_m = end;
r_nb_monom = neg - r_m;
#ifdef DEBUG
DBGPRINTF("l_nb_monom:%d r_nb_monom:%d\n", l_nb_monom, r_nb_monom);
#endif
}
#ifdef DEBUG
DBGPRINTF("normalization: ");
for (i = 0; i < l_nb_monom; i++)
{
DBGPRINTF("%" PL_FMT_d "*", l_m[i].a);
Pl_Write_1(l_m[i].x_word);
DBGPRINTF(" + ");
}
if (p.c > 0)
DBGPRINTF("%" PL_FMT_d " + ", p.c);
else if (l_nb_monom == 0)
DBGPRINTF("0 + ");
DBGPRINTF("\b\b%s ", (re_word != NOT_A_WAM_WORD) ? cur_op : "=");
for (i = 0; i < r_nb_monom; i++)
{
DBGPRINTF("%" PL_FMT_d "*", r_m[i].a);
Pl_Write_1(r_m[i].x_word);
DBGPRINTF(" + ");
}
if (p.c < 0)
DBGPRINTF("%" PL_FMT_d " + ", -p.c);
else if (r_nb_monom == 0 && re_word != NOT_A_WAM_WORD)
DBGPRINTF("0 + ");
if (re_word == NOT_A_WAM_WORD)
DBGPRINTF("loaded + ");
DBGPRINTF("\b\b \n\n");
#endif
pref_load_word = NOT_A_WAM_WORD;
*mask = MASK_EMPTY;
if (l_nb_monom)
{
*mask |= MASK_LEFT;
if (optim_eq && p.c == 0 && r_nb_monom == 1 && r_m[0].a == 1)
pref_load_word = r_m[0].x_word;
if (!Load_Poly(l_nb_monom, l_m, pref_load_word, l_word))
return FALSE;
}
if (r_nb_monom)
{
*mask |= MASK_RIGHT;
if (pref_load_word == NOT_A_WAM_WORD)
{
if (optim_eq && p.c == 0 && l_nb_monom)
pref_load_word = *l_word;
if (!Load_Poly(r_nb_monom, r_m, pref_load_word, r_word))
return FALSE;
}
}
*c = p.c;
return TRUE;
}
