/*-------------------------------------------------------------------------*
* PL_BLT_COMPARE *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y)
{
int cmp;
char c;
Bool res;
Pl_Set_C_Bip_Name("compare", 3);
cmp = Pl_Term_Compare(x, y);
c = (cmp < 0) ? '<' : (cmp == 0) ? '=' : '>';
res = Pl_Un_Atom_Check(ATOM_CHAR(c), cmp_word);
if (!res) /* check if it is one of < = > */
{
WamWord word, tag_mask;
char *s;
DEREF(cmp_word, word, tag_mask); /* we know it is an atom */
s = pl_atom_tbl[UnTag_ATM(word)].name;
if ((s[0] != '<' && s[0] != '=' && s[0] != '>') || s[1] != '\0')
Pl_Err_Domain(pl_domain_order, cmp_word);
}
Pl_Unset_C_Bip_Name();
return res;
}
/*-------------------------------------------------------------------------*
* PL_BLT_COMPARE *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Compare(WamWord cmp_word, WamWord x, WamWord y)
{
int cmp;
char c;
Bool res;
Pl_Set_C_Bip_Name("compare", 3);
cmp = Pl_Term_Compare(x, y);
c = (cmp < 0) ? '<' : (cmp == 0) ? '=' : '>';
res = Pl_Un_Atom_Check(ATOM_CHAR(c), cmp_word);
Pl_Unset_C_Bip_Name();
return res;
}
/*-------------------------------------------------------------------------*
* GROUP *
* *
*-------------------------------------------------------------------------*/
static WamWord
Group(WamWord all_sol_word, WamWord gl_key_word, WamWord *key_adr)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord *lst_adr, *prev_lst_adr;
WamWord key_word, key_word1;
DEREF(all_sol_word, word, tag_mask);
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask); /* term of the form Key-Value */
adr = UnTag_STC(word);
*key_adr = key_word = Arg(adr, 0);
for (;;)
{ /* Arg(adr,1) cannot be a Dont_Separate_Tag */
Car(lst_adr) = Arg(adr, 1);
prev_lst_adr = lst_adr;
DEREF(Cdr(lst_adr), word, tag_mask);
if (word == NIL_WORD)
return NOT_A_WAM_WORD;
prev_lst_adr = lst_adr;
lst_adr = UnTag_LST(word);
DEREF(Car(lst_adr), word, tag_mask); /* term of the form Key-Value */
adr = UnTag_STC(word);
key_word1 = Arg(adr, 0);
if (Pl_Term_Compare(key_word, key_word1) != 0)
break;
}
all_sol_word = Cdr(prev_lst_adr);
Cdr(prev_lst_adr) = NIL_WORD;
return all_sol_word;
}
/*-------------------------------------------------------------------------*
* PL_BLT_TERM_LTE *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Lte(WamWord x, WamWord y)
{
return Pl_Term_Compare(x, y) <= 0;
}
/*-------------------------------------------------------------------------*
* PL_BLT_TERM_NEQ *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Neq(WamWord x, WamWord y)
{
return Pl_Term_Compare(x, y) != 0;
}
/*-------------------------------------------------------------------------*
* PL_BLT_TERM_GT *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Term_Gt(WamWord x, WamWord y)
{
return Pl_Term_Compare(x, y) > 0;
}
/*-------------------------------------------------------------------------*
* PL_TERM_COMPARE *
* *
*-------------------------------------------------------------------------*/
long
Pl_Term_Compare(WamWord start_u_word, WamWord start_v_word)
{
WamWord u_word, u_tag_mask;
WamWord v_word, v_tag_mask;
WamWord u_tag, v_tag;
int u_func, u_arity;
WamWord *u_arg_adr;
int v_func, v_arity;
WamWord *v_arg_adr;
int i, x;
double d1, d2;
DEREF(start_u_word, u_word, u_tag_mask);
DEREF(start_v_word, v_word, v_tag_mask);
u_tag = Tag_From_Tag_Mask(u_tag_mask);
v_tag = Tag_From_Tag_Mask(v_tag_mask);
switch (u_tag)
{
case REF:
return (v_tag != REF) ? -1 : UnTag_REF(u_word) - UnTag_REF(v_word);
#ifndef NO_USE_FD_SOLVER
case FDV:
if (v_tag == REF)
return 1;
return (v_tag != FDV) ? -1 : UnTag_FDV(u_word) - UnTag_FDV(v_word);
#endif
case FLT:
if (v_tag == REF
#ifndef NO_USE_FD_SOLVER
|| v_tag == FDV
#endif
)
return 1;
if (v_tag != FLT)
return -1;
d1 = Pl_Obtain_Float(UnTag_FLT(u_word));
d2 = Pl_Obtain_Float(UnTag_FLT(v_word));
return (d1 < d2) ? -1 : (d1 == d2) ? 0 : 1;
case INT:
if (v_tag == REF ||
#ifndef NO_USE_FD_SOLVER
v_tag == FDV ||
#endif
v_tag == FLT)
return 1;
return (v_tag != INT) ? -1 : UnTag_INT(u_word) - UnTag_INT(v_word);
case ATM:
if (v_tag == REF ||
#ifndef NO_USE_FD_SOLVER
v_tag == FDV ||
#endif
v_tag == FLT || v_tag == INT)
return 1;
return (v_tag != ATM) ? -1 : strcmp(pl_atom_tbl[UnTag_ATM(u_word)].name,
pl_atom_tbl[UnTag_ATM(v_word)].name);
}
/* u_tag == LST / STC */
v_arg_adr = Pl_Rd_Compound(v_word, &v_func, &v_arity);
if (v_arg_adr == NULL) /* v_tag != LST / STC */
return 1;
u_arg_adr = Pl_Rd_Compound(u_word, &u_func, &u_arity);
if (u_arity != v_arity)
return u_arity - v_arity;
if (u_func != v_func)
return strcmp(pl_atom_tbl[u_func].name, pl_atom_tbl[v_func].name);
for (i = 0; i < u_arity; i++)
if ((x = Pl_Term_Compare(*u_arg_adr++, *v_arg_adr++)) != 0)
return x;
return 0;
}