/*-------------------------------------------------------------------------*
* PL_TYPE_OF_TERM *
* *
*-------------------------------------------------------------------------*/
int
Pl_Type_Of_Term(WamWord start_word)
{
WamWord word, tag_mask;
DEREF(start_word, word, tag_mask);
return Tag_From_Tag_Mask(tag_mask);
}
/*-------------------------------------------------------------------------*
* PL_TERM_SIZE *
* *
*-------------------------------------------------------------------------*/
int
Pl_Term_Size(WamWord start_word)
{
WamWord word, tag_mask;
WamWord *adr;
int i;
int n = 0; /* init to zero for terminal_rec */
terminal_rec:
DEREF(start_word, word, tag_mask);
switch (Tag_From_Tag_Mask(tag_mask))
{
#ifndef NO_USE_FD_SOLVER
case FDV: /* 1+ for <REF,->fdv_adr> since Dont_Separate_Tag */
return n + 1 + Fd_Variable_Size(UnTag_FDV(word));
#endif
case FLT:
#if WORD_SIZE == 32
return n + 1 + 2;
#else
return n + 1 + 1;
#endif
case LST:
adr = UnTag_LST(word);
adr = &Car(adr);
n += 1 + Pl_Term_Size(*adr++);
start_word = *adr;
goto terminal_rec;
case STC:
adr = UnTag_STC(word);
n += 2; /* tagged word + f_n */
i = Arity(adr);
adr = &Arg(adr, 0);
while (--i)
n += Pl_Term_Size(*adr++);
start_word = *adr;
goto terminal_rec;
default:
return n + 1;
}
}
static void
Show_List_Arg(int depth, WamWord *lst_adr)
{
WamWord word, tag_mask;
terminal_rec:
depth--;
Show_Term(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM, Car(lst_adr));
if (depth == 0) /* dots already written by Show_Term */
return;
DEREF(Cdr(lst_adr), word, tag_mask);
switch (Tag_From_Tag_Mask(tag_mask))
{
case REF:
SHOW_LIST_PIPE;
Show_Global_Var(UnTag_REF(word));
break;
case ATM:
if (word != NIL_WORD)
{
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Atom(GENERAL_TERM, UnTag_ATM(word));
}
break;
#ifndef NO_USE_FD_SOLVER
case FDV:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Fd_Variable(UnTag_FDV(word));
break;
#endif
case INT:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Integer(UnTag_INT(word));
break;
case FLT:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Float(Pl_Obtain_Float(UnTag_FLT(word)));
break;
case LST:
Out_Char(',');
if (space_args)
Out_Space();
lst_adr = UnTag_LST(word);
goto terminal_rec;
break;
case STC:
SHOW_LIST_PIPE;
if (Try_Portray(word))
return;
Show_Structure(depth, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
UnTag_STC(word));
break;
}
}
/*-------------------------------------------------------------------------*
* SHOW_TERM *
* *
*-------------------------------------------------------------------------*/
static void
Show_Term(int depth, int prec, int context, WamWord term_word)
{
WamWord word, tag_mask;
WamWord *adr;
if (depth == 0)
{
Show_Atom(GENERAL_TERM, atom_dots);
return;
}
DEREF(term_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK && Try_Portray(word))
return;
switch (Tag_From_Tag_Mask(tag_mask))
{
case REF:
adr = UnTag_REF(word);
if (Is_A_Local_Adr(adr))
{
Globalize_Local_Unbound_Var(adr, word);
adr = UnTag_REF(word);
}
Show_Global_Var(adr);
break;
case ATM:
Show_Atom(context, UnTag_ATM(word));
break;
#ifndef NO_USE_FD_SOLVER
case FDV:
Show_Fd_Variable(UnTag_FDV(word));
break;
#endif
case INT:
Show_Integer(UnTag_INT(word));
break;
case FLT:
Show_Float(Pl_Obtain_Float(UnTag_FLT(word)));
break;
case LST:
adr = UnTag_LST(word);
if (ignore_op)
{
Out_String("'.'(");
Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
Car(adr));
Out_Char(',');
Show_Term(depth - 1, MAX_ARG_OF_FUNCTOR_PREC, GENERAL_TERM,
Cdr(adr));
Out_Char(')');
}
else
{
Out_Char('[');
Show_List_Arg(depth, adr);
Out_Char(']');
}
break;
case STC:
adr = UnTag_STC(word);
Show_Structure(depth, prec, context, adr);
break;
}
}
/*-------------------------------------------------------------------------*
* 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;
}
/*-------------------------------------------------------------------------*
* COPY_TERM_REC *
* *
* p is the next address to use to store the rest of a term. *
*-------------------------------------------------------------------------*/
static void
Copy_Term_Rec(WamWord *dst_adr, WamWord *src_adr, WamWord **p)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord *q;
int i;
terminal_rec:
DEREF(*src_adr, word, tag_mask);
switch (Tag_From_Tag_Mask(tag_mask))
{
case REF:
adr = UnTag_REF(word);
q = *p;
if (adr < q && adr >= base_copy) /* already a copy */
{
*dst_adr = word;
return;
}
if (top_vars >= end_vars)
Pl_Err_Representation(pl_representation_too_many_variables);
*top_vars++ = word; /* word to restore */
*top_vars++ = (WamWord) adr; /* address to restore */
*adr = *dst_adr = Tag_REF(dst_adr); /* bind to a new copy */
return;
#ifndef NO_USE_FD_SOLVER
case FDV:
adr = UnTag_FDV(word);
q = *p;
if (adr < q && adr >= base_copy) /* already a copy */
{
*dst_adr = Tag_REF(adr); /* since Dont_Separate_Tag */
return;
}
if (top_vars >= end_vars)
Pl_Err_Representation(pl_representation_too_many_variables);
*top_vars++ = word; /* word to restore */
*top_vars++ = (WamWord) adr; /* address to restore */
q = *p;
*p = q + Fd_Copy_Variable(q, adr);
*adr = *dst_adr = Tag_REF(q); /* bind to a new copy */
return;
#endif
case FLT:
adr = UnTag_FLT(word);
q = *p;
q[0] = adr[0];
#if WORD_SIZE == 32
q[1] = adr[1];
*p = q + 2;
#else
*p = q + 1;
#endif
*dst_adr = Tag_FLT(q);
return;
case LST:
adr = UnTag_LST(word);
q = *p;
*dst_adr = Tag_LST(q);
*p = &Cdr(q) + 1;
q = &Car(q);
adr = &Car(adr);
Copy_Term_Rec(q++, adr++, p);
dst_adr = q;
src_adr = adr;
goto terminal_rec;
case STC:
adr = UnTag_STC(word);
q = *p;
*dst_adr = Tag_STC(q);
Functor_And_Arity(q) = Functor_And_Arity(adr);
i = Arity(adr);
*p = &Arg(q, i - 1) + 1;
q = &Arg(q, 0);
adr = &Arg(adr, 0);
while (--i)
Copy_Term_Rec(q++, adr++, p);
dst_adr = q;
src_adr = adr;
goto terminal_rec;
default:
*dst_adr = word;
return;
}
}
