BOOL rpos_Equal(TERM T1, TERM T2)
/**************************************************************
INPUT: Two terms.
RETURNS: TRUE, if <T1> is equal to <T2> and
FALSE otherwise.
***************************************************************/
{
LIST l1, l2;
if (!term_EqualTopSymbols(T1, T2))
return FALSE;
else if (!term_IsComplex(T1)) /* Equal variable or constant */
return TRUE;
else {
if (symbol_HasProperty(term_TopSymbol(T1), ORDMUL)) { /* MUL case */
l1 = rpos_MultisetDifference(T1, T2);
if (list_Empty(l1))
return TRUE;
else {
list_Delete(l1);
return FALSE;
}
} else { /* LEX case */
for (l1 = term_ArgumentList(T1), l2 = term_ArgumentList(T2);
!list_Empty(l1) && rpos_Equal(list_Car(l1), list_Car(l2));
l1 = list_Cdr(l1), l2 = list_Cdr(l2))
/* empty */;
return list_Empty(l1); /* All arguments were equal */
}
}
}
BOOL cont_TermEqual(CONTEXT Context1, TERM Term1, CONTEXT Context2, TERM Term2)
/*********************************************************
INPUT: Two terms and two contexts.
RETURNS: TRUE iff the two terms are equal, where
variables are interpreted with respect to
the bindings in the contexts.
********************************************************/
{
#ifdef CHECK
if (!(term_IsTerm(Term1) && term_IsTerm(Term2))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_TermEqual: Input terms are corrupted.\n");
misc_FinishErrorReport();
}
#endif
Term1 = cont_Deref(&Context1,Term1);
Term2 = cont_Deref(&Context2,Term2);
if (!term_EqualTopSymbols(Term1, Term2))
return FALSE;
else if (term_ArgumentList(Term1)) {
LIST Scan1, Scan2;
for (Scan1=term_ArgumentList(Term1), Scan2=term_ArgumentList(Term2);
list_Exist(Scan1) && list_Exist(Scan2);
Scan1=list_Cdr(Scan1), Scan2=list_Cdr(Scan2))
if (!cont_TermEqual(Context1,list_Car(Scan1), Context2,list_Car(Scan2)))
return FALSE;
return (list_Empty(Scan1) ? list_Empty(Scan2) : FALSE);
} else
return TRUE;
}
static LIST rpos_ContMultisetDifference(CONTEXT C1, TERM T1, CONTEXT C2, TERM T2)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: The multiset difference between the arguments
of both terms with respect to rpos_ContEqual.
EFFECT: Variable bindings are considered.
***************************************************************/
{
LIST result, scan1, scan2;
/* Don't apply bindings at top level, since that happened */
/* in rpos_ContGreaterEqual */
/* We can't use list_NMultisetDifference, since that function */
/* expects an equality functions for terms that takes two terms */
/* as arguments. We also need the two contexts resolve variable */
/* bindings. */
result = list_Copy(term_ArgumentList(T1));
for (scan2 = term_ArgumentList(T2); !list_Empty(scan2);
scan2 = list_Cdr(scan2)) {
/* Delete at most one occurrence of the */
/* current element of list2 from list1 */
for (scan1 = result; !list_Empty(scan1); scan1 = list_Cdr(scan1)) {
if (list_Car(scan1) != NULL &&
rpos_ContEqual(C1, list_Car(scan1), C2, list_Car(scan2))) {
/* arg of list1 wasn't deleted earlier and terms are equal */
list_Rplaca(scan1, NULL); /* Mark argument of T1 as deleted */
break;
}
}
}
return list_PointerDeleteElement(result, NULL); /* Delete all marked terms */
}
BOOL rpos_ContEqual(CONTEXT C1, TERM T1, CONTEXT C2, TERM T2)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: TRUE, if <T1> is equal to <T2> and
FALSE otherwise.
EFFECT: Variable bindings are considered.
***************************************************************/
{
LIST l1, l2;
T1 = cont_Deref(&C1, T1);
T2 = cont_Deref(&C2, T2);
if (!term_EqualTopSymbols(T1, T2))
return FALSE;
else if (!term_IsComplex(T1))
return TRUE;
else {
if (symbol_HasProperty(term_TopSymbol(T1), ORDMUL)) {
l1 = rpos_ContMultisetDifference(C1, T1, C2, T2);
if (list_Empty(l1))
return TRUE;
else {
list_Delete(l1);
return FALSE;
}
} else { /* LEX case */
for (l1 = term_ArgumentList(T1), l2 = term_ArgumentList(T2);
!list_Empty(l1) && rpos_ContEqual(C1,list_Car(l1),C2,list_Car(l2));
l1 = list_Cdr(l1), l2 = list_Cdr(l2)); /* empty body */
return list_Empty(l1); /* All arguments were equal */
}
}
}
static ord_RESULT rpos_LexGreaterEqual(TERM T1, TERM T2, BOOL VarIsConst)
/**************************************************************
INPUT: Two terms with equal top symbols and lexicographic status.
RETURNS: ord_GREATER_THAN if <T1> is greater than <T2>,
ord_EQUAL if both terms are equal and
ord_UNCOMPARABLE otherwise.
CAUTION: If <VarIsConst> is set then variables are interpreted as constants
with lowest precedence. They are ranked to each other using
their variable index.
***************************************************************/
{
ord_RESULT result;
LIST l1, l2, scan1, scan2;
if (symbol_HasProperty(term_TopSymbol(T1), ORDRIGHT)) {
l1 = list_Reverse(term_ArgumentList(T1)); /* Create new lists */
l2 = list_Reverse(term_ArgumentList(T2));
} else {
l1 = term_ArgumentList(T1);
l2 = term_ArgumentList(T2);
}
/* First ignore equal arguments */
result = ord_Equal();
for (scan1 = l1, scan2 = l2; !list_Empty(scan1);
scan1 = list_Cdr(scan1), scan2 = list_Cdr(scan2)) {
result = rpos_GreaterEqual(list_Car(scan1), list_Car(scan2), VarIsConst);
if (!ord_IsEqual(result))
break;
}
if (ord_IsEqual(result)) /* All arguments are equal, so the terms */
/* empty */; /* are equal with respect to RPOS */
else if (ord_IsGreaterThan(result)) {
/* Check if T1 > each remaining argument of T2 */
for (scan2 = list_Cdr(scan2); !list_Empty(scan2) &&
rpos_Greater(T1, list_Car(scan2), VarIsConst);
scan2 = list_Cdr(scan2)); /* Empty body */
if (list_Empty(scan2))
result = ord_GreaterThan();
else
result = ord_Uncomparable();
}
else {
/* Argument of T1 was not >= argument of T2. */
/* Try to find an argument of T1 that is >= T2 */
for (scan1 = list_Cdr(scan1), result = ord_Uncomparable();
!list_Empty(scan1) && !ord_IsGreaterThan(result);
scan1 = list_Cdr(scan1)) {
if (!ord_IsUncomparable(rpos_GreaterEqual(list_Car(scan1), T2, VarIsConst)))
result = ord_GreaterThan();
}
}
if (symbol_HasProperty(term_TopSymbol(T1), ORDRIGHT)) {
list_Delete(l1); /* Delete the lists create above */
list_Delete(l2);
}
return result;
}
ord_RESULT rpos_GreaterEqual(TERM T1, TERM T2, BOOL VarIsConst)
/**************************************************************
INPUT: Two terms.
RETURNS: ord_GREATER_THAN if <T1> is greater than <T2>
ord_EQUAL if both terms are equal
ord_UNCOMPARABLE otherwise.
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
If <VarIsConst> is set then variables are interpreted as constants
with lowest precedence. They are ranked to each other using
their variable index.
***************************************************************/
{
LIST scan;
if (term_IsVariable(T1)) {
if (term_EqualTopSymbols(T1, T2))
return ord_Equal(); /* T2 is the same variable */
else if(VarIsConst && term_IsVariable(T2)) {
if(term_TopSymbol(T1) > term_TopSymbol(T2))
return ord_GreaterThan();
else
return ord_Uncomparable();
}
else
/* A variable can't be greater than another term */
return ord_Uncomparable();
} else if (!VarIsConst && term_IsVariable(T2)) { /* T1 isn't a variable */
if (term_ContainsSymbol(T1, term_TopSymbol(T2)))
return ord_GreaterThan();
else
return ord_Uncomparable();
} else if(VarIsConst && term_IsVariable(T2)){
return ord_GreaterThan();
} else if (term_EqualTopSymbols(T1, T2)) {
if (symbol_HasProperty(term_TopSymbol(T1), ORDMUL))
return rpos_MulGreaterEqual(T1, T2, VarIsConst);
else
return rpos_LexGreaterEqual(T1, T2, VarIsConst);
} else {
if (symbol_PrecedenceGreater(ord_PRECEDENCE, term_TopSymbol(T1),
term_TopSymbol(T2))) {
/* Different top symbols, symbol of T1 > symbol of T2. */
/* Try if T1 > each argument of T2. */
for (scan = term_ArgumentList(T2); !list_Empty(scan); scan = list_Cdr(scan))
if (!rpos_Greater(T1, list_Car(scan), VarIsConst))
return ord_Uncomparable();
return ord_GreaterThan();
} else {
/* Try to find an argument of T1 that is >= T2 */
for (scan = term_ArgumentList(T1); !list_Empty(scan); scan = list_Cdr(scan))
if (!ord_IsUncomparable(rpos_GreaterEqual(list_Car(scan), T2, VarIsConst)))
return ord_GreaterThan(); /* Argument of T1 >= T2 */
return ord_Uncomparable();
}
}
}
ord_RESULT rpos_ContGreaterEqual(CONTEXT C1, TERM T1, CONTEXT C2, TERM T2)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: ord_GREATER_THAN if <T1> is greater than <T2>
ord_EQUAL if both terms are equal
ord_UNCOMPARABLE otherwise.
EFFECT: Variable bindings are considered.
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
***************************************************************/
{
LIST scan;
T1 = cont_Deref(&C1, T1);
T2 = cont_Deref(&C2, T2);
if (term_IsVariable(T1)) {
if (term_EqualTopSymbols(T1, T2))
return ord_Equal(); /* T2 is the same variable */
else
/* A variable can't be greater than another term */
return ord_Uncomparable();
} else if (term_IsVariable(T2)) { /* T1 isn't a variable */
if (cont_TermContainsSymbol(C1, T1, term_TopSymbol(T2)))
return ord_GreaterThan();
else
return ord_Uncomparable();
} else if (term_EqualTopSymbols(T1, T2)) {
if (symbol_HasProperty(term_TopSymbol(T1), ORDMUL))
return rpos_ContMulGreaterEqual(C1, T1, C2, T2);
else
return rpos_ContLexGreaterEqual(C1, T1, C2, T2);
} else {
if (symbol_PrecedenceGreater(ord_PRECEDENCE, term_TopSymbol(T1),
term_TopSymbol(T2))) {
/* Different top symbols, symbol of T1 > symbol of T2. */
/* Try if T1 > each argument of T2. */
for (scan = term_ArgumentList(T2); !list_Empty(scan); scan = list_Cdr(scan))
if (!rpos_ContGreater(C1, T1, C2, list_Car(scan)))
return ord_Uncomparable();
return ord_GreaterThan();
} else {
/* Try to find an argument of T1 that is >= T2 */
for (scan = term_ArgumentList(T1); !list_Empty(scan); scan = list_Cdr(scan))
if (!ord_IsUncomparable(rpos_ContGreaterEqual(C1,list_Car(scan),C2,T2)))
return ord_GreaterThan(); /* Argument of T1 >= T2 */
return ord_Uncomparable();
}
}
}
static LIST rpos_MultisetDifference(TERM T1, TERM T2)
/**************************************************************
INPUT: Two terms.
RETURNS: The multiset difference between the arguments
of both terms with respect to rpos_Equal.
***************************************************************/
{
LIST result;
result = list_Copy(term_ArgumentList(T1));
result = list_NMultisetDifference(result, term_ArgumentList(T2),
(BOOL (*)(POINTER,POINTER)) rpos_Equal);
return result;
}
TERM cont_ApplyBindingsModuloMatching(const CONTEXT Context, TERM Term,
BOOL VarCheck)
/**********************************************************
INPUT: A context, a term, and a boolean flag.
RETURNS: <Term> is destructively changed with respect to
established bindings in the context.
If <VarCheck> is true, all variables in <Term>
must be bound in the context. When compiled with
"CHECK" on, this condition is in fact checked.
This function only makes sense after a matching operation.
***********************************************************/
{
TERM RplacTerm;
LIST Arglist;
SYMBOL Top;
#ifdef CHECK
if (VarCheck && symbol_IsVariable(term_TopSymbol(Term)) &&
!cont_VarIsBound(Context, term_TopSymbol(Term))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_ApplyBindingsModuloMatching:");
misc_ErrorReport(" Used in forbidden context.\n");
misc_FinishErrorReport();
}
#endif
Top = term_TopSymbol(Term);
if (symbol_IsVariable(Top)) {
if (cont_VarIsBound(Context, Top)) {
RplacTerm = cont_ContextBindingTerm(Context, Top);
Arglist = term_CopyTermList(term_ArgumentList(RplacTerm));
term_RplacTop(Term, term_TopSymbol(RplacTerm));
term_DeleteTermList(term_ArgumentList(Term));
term_RplacArgumentList(Term, Arglist);
}
}
else {
for (Arglist = term_ArgumentList(Term);
!list_Empty(Arglist);
Arglist = list_Cdr(Arglist))
cont_ApplyBindingsModuloMatching(Context, list_Car(Arglist), VarCheck);
}
return Term;
}
void cont_TermPrintPrefix(CONTEXT GlobalContext, CONTEXT TermContext, TERM Term)
/**************************************************************
INPUT: A global context where index variables are bound,
a context and a term.
RETURNS: none.
SUMMARY: Prints the term modulo the context to stdout.
CAUTION: Variables of <Term1> are bound in
<TermContext1> and
the index variables are bound in <GlobalContext1>
***************************************************************/
{
Term = cont_Deref(GlobalContext,&TermContext, Term);
symbol_Print(term_TopSymbol(Term));
if (term_IsComplex(Term)) {
LIST List;
putchar('(');
for (List = term_ArgumentList(Term); !list_Empty(List);
List = list_Cdr(List)) {
cont_TermPrintPrefix(GlobalContext, TermContext, list_Car(List));
if (!list_Empty(list_Cdr(List)))
putchar(',');
}
putchar(')');
}
}
static int cc_Number(int actno, TERM term, TERM pred)
/***************************************************************
INPUT: the actual number of terms, the term to be numbered
and its predecessor (may be the empty term
term_Null())
RETURNS: the new number of terms after recursively numbering
the term and its subterms
EFFECT: stores a term's number as its size, partially
initializes its predecessor list and pushes all
subterms to the pending stack
***************************************************************/
{
LIST terms;
#ifdef CHECK
if (actno < 0) {
misc_StartErrorReport();
misc_ErrorReport("\n In cc_Number: negative actual number of terms.");
misc_FinishErrorReport();
}
#endif
term_SetSize(term, actno++);
cc_SetCars(ras_Push(cc_GetCars(), pred));
cc_SetPending(ras_Push(cc_GetPending(), term));
for (terms = term_ArgumentList(term); !list_Empty(terms); terms =
list_Cdr(terms))
actno = cc_Number(actno, list_Car(terms), term);
return actno;
}
TERM cont_CopyAndApplyBindings(CONTEXT TermContext, TERM Term)
{
while (term_IsVariable(Term)) {
SYMBOL TermTop;
TermTop = term_TopSymbol(Term);
if (cont_VarIsBound(TermContext, TermTop)) {
CONTEXT HelpContext;
HelpContext = cont_ContextBindingContext(TermContext, TermTop);
Term = cont_ContextBindingTerm(TermContext, TermTop);
TermContext = HelpContext;
} else
break;
}
if (term_IsComplex(Term)) {
LIST Scan, ArgumentList;
for (Scan = ArgumentList = list_Copy(term_ArgumentList(Term));
!list_Empty(Scan);
Scan = list_Cdr(Scan))
list_Rplaca(Scan, cont_CopyAndApplyBindings(TermContext, list_Car(Scan)));
return term_Create(term_TopSymbol(Term), ArgumentList);
} else
return term_Create(term_TopSymbol(Term), list_Nil());
}
static TERM cont_CopyAndApplyIndexVariableBindings(const CONTEXT Context, TERM Term)
{
SYMBOL TermTop;
#ifdef CHECK
if (symbol_IsIndexVariable(term_TopSymbol(Term)) &&
!cont_VarIsBound(Context, term_TopSymbol(Term))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_CopyAndApplyIndexVariableBindings:");
misc_ErrorReport(" Expected bound index variable.");
misc_FinishErrorReport();
}
#endif
TermTop = term_TopSymbol(Term);
while (symbol_IsIndexVariable(TermTop)) {
if (cont_VarIsBound(Context, TermTop)) {
Term = cont_ContextBindingTerm(Context, TermTop);
TermTop = term_TopSymbol(Term);
}
}
if (term_IsComplex(Term)) {
LIST Scan, ArgumentList;
for (Scan = ArgumentList = list_Copy(term_ArgumentList(Term));
!list_Empty(Scan);
Scan = list_Cdr(Scan))
list_Rplaca(Scan, cont_CopyAndApplyIndexVariableBindings(Context, list_Car(Scan)));
return term_Create(TermTop, ArgumentList);
} else
return term_Create(TermTop, list_Nil());
}
SYMBOL cont_TermMaxVar(CONTEXT Context, TERM Term)
/*********************************************************
INPUT: A context and a term.
RETURNS: The maximal variable in <Term> with respect to
the bindings in <Context>
********************************************************/
{
LIST scan;
SYMBOL result;
#ifdef CHECK
if (!term_IsTerm(Term)) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_TermMaxVar: Input term is corrupted.\n");
misc_FinishErrorReport();
}
#endif
Term = cont_Deref(&Context,Term);
result = symbol_Null();
if (term_IsStandardVariable(Term)) {
if (term_TopSymbol(Term) > result)
result = term_TopSymbol(Term);
} else {
for (scan = term_ArgumentList(Term); !list_Empty(scan); scan = list_Cdr(scan)) {
SYMBOL max = cont_TermMaxVar(Context, list_Car(scan));
if (max > result)
result = max;
}
}
return result;
}
void cont_TermPrintPrefix(CONTEXT Context, TERM Term)
/**************************************************************
INPUT: A context and a term.
RETURNS: none.
SUMMARY: Prints the term modulo the context to stdout.
CAUTION: none.
***************************************************************/
{
Term = cont_Deref(&Context, Term);
symbol_Print(term_TopSymbol(Term));
if (term_IsComplex(Term)) {
LIST List;
putchar('(');
for (List = term_ArgumentList(Term); !list_Empty(List);
List = list_Cdr(List)) {
cont_TermPrintPrefix(Context, list_Car(List));
if (!list_Empty(list_Cdr(List)))
putchar(',');
}
putchar(')');
}
}
TERM cont_ApplyBindingsModuloMatchingReverse(const CONTEXT Context, TERM Term)
/**********************************************************
INPUT: A term.
RETURNS: <Term> is destructively changed with respect to
established bindings in the leftmost context. This
function only make sense after a matching operation (reverse).
***********************************************************/
{
TERM RplacTerm;
LIST Arglist;
SYMBOL Top;
#ifdef CHECK
if (symbol_IsVariable(term_TopSymbol(Term)) &&
!cont_VarIsBound(Context, term_TopSymbol(Term))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_ApplyBindingsModuloMatchingReverse:");
misc_ErrorReport(" Used in forbidden context.\n");
misc_FinishErrorReport();
}
#endif
Top = term_TopSymbol(Term);
if (symbol_IsVariable(Top)) {
if (cont_VarIsBound(Context, Top)) {
RplacTerm =
cont_CopyAndApplyIndexVariableBindings(Context,
cont_ContextBindingTerm(Context, Top));
term_RplacTop(Term, term_TopSymbol(RplacTerm));
term_DeleteTermList(term_ArgumentList(Term));
term_RplacArgumentList(Term, term_ArgumentList(RplacTerm));
term_Free(RplacTerm);
}
}
else {
for (Arglist = term_ArgumentList(Term); !list_Empty(Arglist);
Arglist = list_Cdr(Arglist))
cont_ApplyBindingsModuloMatchingReverse(Context, list_Car(Arglist));
}
return Term;
}
TERM table_QueryAndEnter(TABLE table, PARTITION p, TERM term)
/***************************************************************
RETURNS: a term with the same p-signature (sigtab_Index(top
symbol), [arg 1] , ..., [arg n] ) as term - or the
p p
empty term if no such term exists
EFFECT: term enters table in the latter case
***************************************************************/
{
TERMARRAY ta;
LIST terms;
#ifdef CHECK
if (part_Size(p) - 1 > table_GetTermbound(table)) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_QueryAndEnter: partition not suitable.");
misc_FinishErrorReport();
}
if (table_Index(term_TopSymbol(term)) > table_GetOpbound(table)) {
misc_StartErrorReport();
misc_ErrorReport
("\n In table_QueryAndEnter: term's operation symbol out of bounds.");
misc_FinishErrorReport();
}
if (table_Index(term_TopSymbol(term)) < -table_GetVarbound(table)) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_QueryAndEnter: variable out of bounds.");
misc_FinishErrorReport();
}
if (!table_LegalPosIndex(table, term_Size(term))) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_QueryAndEnter: term out of bounds.");
misc_FinishErrorReport();
}
#endif
ta = table_GetTermarray(table) + table_Index(term_TopSymbol(term));
for (terms = term_ArgumentList(term); !list_Empty(terms); terms =
list_Cdr(terms)) {
if (!table_GetChild(ta))
table_SetChild(ta, (TERMARRAY) memory_Calloc (
table_GetTermbound(table) + 1,
sizeof(struct termarray)
));
ta = table_GetChild(ta) + part_Find(p, term_Size(list_Car(terms)));
}
table_DelayedInit(table, ta);
if (table_GetTerm(ta))
return table_GetTerm(ta);
else {
table_SetTerm(ta, term);
table_SetPos(table, table_DelayedPosInit(table, term_Size(term)), ta);
return term_Null();
}
}
BOOL cont_TermEqual(CONTEXT GlobalContext1, CONTEXT TermContext1, TERM Term1,
CONTEXT GlobalContext2, CONTEXT TermContext2, TERM Term2)
/*********************************************************
INPUT: Two terms and two local contexts for the terms and
two global contexts
RETURNS: TRUE iff the two terms are equal, where
variables are interpreted with respect to
the bindings in the contexts.
CAUTION: Variables of <Term1> and <Term2> are bound in
<TermContext1> and <TermContext2> respectively and
the index variables are bound in <GlobalContext1>
and <GlobalContext2> respectively.
********************************************************/
{
#ifdef CHECK
if (!(term_IsTerm(Term1) && term_IsTerm(Term2))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_TermEqual: Input terms are corrupted.\n");
misc_FinishErrorReport();
}
#endif
Term1 = cont_Deref(GlobalContext1,&TermContext1,Term1);
Term2 = cont_Deref(GlobalContext2,&TermContext2,Term2);
if (!term_EqualTopSymbols(Term1, Term2))
return FALSE;
else if (term_ArgumentList(Term1)) {
LIST Scan1, Scan2;
for (Scan1=term_ArgumentList(Term1), Scan2=term_ArgumentList(Term2);
list_Exist(Scan1) && list_Exist(Scan2);
Scan1=list_Cdr(Scan1), Scan2=list_Cdr(Scan2))
if (!cont_TermEqual(GlobalContext1, TermContext1,list_Car(Scan1),
GlobalContext2, TermContext2,list_Car(Scan2)))
return FALSE;
return (list_Empty(Scan1) ? list_Empty(Scan2) : FALSE);
} else
return TRUE;
}
TERM cont_CopyAndApplyBindingsCom(const CONTEXT Context, TERM Term)
{
while (term_IsVariable(Term) && cont_VarIsBound(Context, term_TopSymbol(Term)))
Term = cont_ContextBindingTerm(Context, term_TopSymbol(Term));
if (term_IsComplex(Term)) {
LIST Scan, ArgumentList;
for (Scan = ArgumentList = list_Copy(term_ArgumentList(Term));
!list_Empty(Scan);
Scan = list_Cdr(Scan))
list_Rplaca(Scan, cont_CopyAndApplyBindingsCom(Context, list_Car(Scan)));
return term_Create(term_TopSymbol(Term), ArgumentList);
} else
return term_Create(term_TopSymbol(Term), list_Nil());
}
NAT cont_TermSize(CONTEXT Context, TERM Term)
/*********************************************************
INPUT: A context and a term.
RETURNS: The number of symbols in <Term> with respect to
the bindings in <Context>
********************************************************/
{
NAT result;
LIST scan;
Term = cont_Deref(&Context, Term);
result = 1;
for (scan = term_ArgumentList(Term); !list_Empty(scan); scan = list_Cdr(scan))
result += cont_TermSize(Context, list_Car(scan));
return result;
}
NAT cont_TermSize(CONTEXT GlobalContext, CONTEXT TermContext, TERM Term)
/*********************************************************
INPUT: A global context where index variables are bound
a context and a term.
RETURNS: The number of symbols in <Term> with respect to
the bindings in <Context>
CAUTION: Variables of <Term1> are bound in
<TermContext1> and
the index variables are bound in <GlobalContext1>
********************************************************/
{
NAT result;
LIST scan;
Term = cont_Deref(GlobalContext, &TermContext, Term);
result = 1;
for (scan = term_ArgumentList(Term); !list_Empty(scan); scan = list_Cdr(scan))
result += cont_TermSize(GlobalContext, TermContext, list_Car(scan));
return result;
}
BOOL cont_TermContainsSymbol(CONTEXT Context, TERM Term, SYMBOL Symbol)
/*********************************************************
INPUT: A context, a term and a symbol.
RETURNS: TRUE, if <Symbol> occurs in <Term> with respect to
the bindings in <Context>, FALSE otherwise.
********************************************************/
{
LIST scan;
Term = cont_Deref(&Context, Term);
if (symbol_Equal(term_TopSymbol(Term), Symbol))
return TRUE;
else
for (scan = term_ArgumentList(Term); !list_Empty(scan); scan = list_Cdr(scan)) {
if (cont_TermContainsSymbol(Context, list_Car(scan), Symbol))
return TRUE;
}
return FALSE;
}
TERM cont_SymbolApplyBindings(CONTEXT TermContext, SYMBOL Symbol)
/**************************************************************
INPUT: A call-by-ref context and a variable symbol.
RETURNS: The recursively dereferenced term and the corresponding context,
NULL if the symbol is not bound
SUMMARY: Dereferences bindings of variables.
CAUTION: In general, the context of the returned term
is different to the input context.
***************************************************************/
{
TERM Term;
Term = (TERM)NULL;
while (symbol_IsVariable(Symbol)) {
if (cont_VarIsBound(TermContext, Symbol)) {
CONTEXT HelpContext;
HelpContext = cont_ContextBindingContext(TermContext, Symbol);
Term = cont_ContextBindingTerm(TermContext, Symbol);
TermContext = HelpContext;
Symbol = term_TopSymbol(Term);
} else
break;
}
if (Term != (TERM)NULL && term_IsComplex(Term)) {
LIST Scan, ArgumentList;
for (Scan = ArgumentList = list_Copy(term_ArgumentList(Term));
!list_Empty(Scan);
Scan = list_Cdr(Scan))
list_Rplaca(Scan, cont_CopyAndApplyBindings(TermContext, list_Car(Scan)));
return term_Create(term_TopSymbol(Term), ArgumentList);
}
return Term;
}
static int kbo_ContCompVarCondAndWeightIntern(CONTEXT Context, TERM Term, int Index)
/**************************************************************
INPUT:
EFFECT:
***************************************************************/
{
int Weight;
Weight = 0;
Term = cont_Deref(&Context,Term);
if (term_IsStandardVariable(Term)) {
ord_VARCOUNT[term_TopSymbol(Term)][Index]++;
Weight += kbo_MINWEIGHT;
}
else {
LIST Scan;
Weight += symbol_Weight(term_TopSymbol(Term));
for (Scan=term_ArgumentList(Term); !list_Empty(Scan); Scan=list_Cdr(Scan))
Weight += kbo_ContCompVarCondAndWeightIntern(Context, list_Car(Scan), Index);
}
return Weight;
}
static ord_RESULT rpos_ContLexGreaterEqual(CONTEXT C1, TERM T1,
CONTEXT C2, TERM T2)
/**************************************************************
INPUT: Two contexts and two terms with equal top symbols
and lexicographic status.
RETURNS: ord_GREATER_THAN if <T1> is greater than <T2>,
ord_EQUAL if both terms are equal and
ord_UNCOMPARABLE otherwise.
EFFECT: Variable bindings are considered.
***************************************************************/
{
ord_RESULT result;
LIST l1, l2, scan1, scan2;
/* Don't apply bindings at top level, since that happened */
/* in rpos_ContGreaterEqual */
if (symbol_HasProperty(term_TopSymbol(T1), ORDRIGHT)) {
l1 = list_Reverse(term_ArgumentList(T1)); /* Create new lists */
l2 = list_Reverse(term_ArgumentList(T2));
} else {
l1 = term_ArgumentList(T1);
l2 = term_ArgumentList(T2);
}
/* First ignore equal arguments */
result = ord_Equal();
for (scan1 = l1, scan2 = l2; !list_Empty(scan1);
scan1 = list_Cdr(scan1), scan2 = list_Cdr(scan2)) {
result = rpos_ContGreaterEqual(C1, list_Car(scan1), C2, list_Car(scan2));
if (!ord_IsEqual(result))
break;
}
if (ord_IsEqual(result)) /* All arguments are equal, so the terms */
/* empty */; /* are equal with respect to RPOS */
else if (ord_IsGreaterThan(result)) {
/* Check if T1 > each remaining argument of T2 */
for (scan2 = list_Cdr(scan2);
!list_Empty(scan2) && rpos_ContGreater(C1, T1, C2, list_Car(scan2));
scan2 = list_Cdr(scan2)); /* Empty body */
if (list_Empty(scan2))
result = ord_GreaterThan();
else
result = ord_Uncomparable();
}
else {
/* Argument of T1 was not >= argument of T2. */
/* Try to find an argument of T1 that is >= T2 */
for (scan1 = list_Cdr(scan1), result = ord_Uncomparable();
!list_Empty(scan1) && !ord_IsGreaterThan(result);
scan1 = list_Cdr(scan1)) {
if (!ord_IsUncomparable(rpos_ContGreaterEqual(C1,list_Car(scan1),C2,T2)))
result = ord_GreaterThan();
}
}
if (symbol_HasProperty(term_TopSymbol(T1), ORDRIGHT)) {
list_Delete(l1); /* Delete the lists create above */
list_Delete(l2);
}
return result;
}
static BOOL kbo_ContGreaterCompareStruc(CONTEXT Context1, TERM Term1,
CONTEXT Context2, TERM Term2)
/**************************************************************
INPUT: Two contexts and two terms where the kbo-variable condition
for <Term1> and <Term2> is satisfied as well as the
weight difference between the terms is zero.
RETURNS: TRUE if Term1 is greater than Term2.
The Terms are interpreted with respect to the contexts.
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
***************************************************************/
{
LIST Scan1,Scan2;
SYMBOL Top1,Top2;
Term1 = cont_Deref(&Context1,Term1);
Term2 = cont_Deref(&Context2,Term2);
Top1 = term_TopSymbol(Term1);
Top2 = term_TopSymbol(Term2);
if (symbol_IsStandardVariable(Top1)) {
if (symbol_IsStandardVariable(Top2))
return FALSE;
else
return FALSE;
}
else if (symbol_IsStandardVariable(Top2) ||
symbol_PrecedenceGreater(ord_PRECEDENCE, Top1, Top2))
return TRUE;
else if (Top1 == Top2) {
int RecWeightDiff;
BOOL T1VarCond, T2VarCond;
TERM RecTerm1,RecTerm2;
Scan1 = term_ArgumentList(Term1);
Scan2 = term_ArgumentList(Term2);
if (symbol_HasProperty(Top1,ORDRIGHT)) {
int i;
for (i = symbol_Arity(Top1);
i > 0 && cont_TermEqual(Context1,list_NthElement(Scan1,i),
Context2,list_NthElement(Scan2,i));
i--);
if (i > 0) {
RecTerm1 = cont_Deref(&Context1,list_NthElement(Scan1,i));
RecTerm2 = cont_Deref(&Context2,list_NthElement(Scan2,i));
}
else
return FALSE;
}
else {
while (!list_Empty(Scan1) && cont_TermEqual(Context1,list_Car(Scan1),Context2,list_Car(Scan2))) {
Scan1 = list_Cdr(Scan1);
Scan2 = list_Cdr(Scan2);
}
if (list_Empty(Scan1)) /* Implies that list_Empty(Scan2) */
return FALSE;
else {
RecTerm1 = cont_Deref(&Context1,list_Car(Scan1));
RecTerm2 = cont_Deref(&Context2,list_Car(Scan2));
}
}
RecWeightDiff = kbo_ContCompVarCondAndWeight(Context1,RecTerm1,&T1VarCond,
Context2,RecTerm2,&T2VarCond);
if (T1VarCond) {
if (RecWeightDiff > 0)
return TRUE;
else if (RecWeightDiff == 0)
return kbo_ContGreaterCompareStruc(Context1, RecTerm1, Context2, RecTerm2);
}
}
return FALSE;
}
static ord_RESULT kbo_CompareStruc(TERM Term1, TERM Term2, int WeightDiff)
/**************************************************************
INPUT: Two terms where the kbo-variable condition for <Term1> and
<Term2> is satisfied and <WeightDiff> is the kbo weight difference
between <Term1> and <Term2>
RETURNS: ord_UNCOMPARABLE, if Term1 and Term2 are uncomparable
ord_EQUAL, if Term1 and Term2 are equal
ord_GREATER_THAN, if Term1 is greater than Term2
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
***************************************************************/
{
LIST Scan1,Scan2;
SYMBOL Top1,Top2;
Top1 = term_TopSymbol(Term1);
Top2 = term_TopSymbol(Term2);
if (WeightDiff > 0)
return ord_GREATER_THAN;
else if (WeightDiff == 0) {
if (symbol_IsStandardVariable(Top1)) {
if (symbol_IsStandardVariable(Top2))
return ord_EQUAL;
else
return ord_UNCOMPARABLE;
}
else if (symbol_IsStandardVariable(Top2) ||
symbol_PrecedenceGreater(ord_PRECEDENCE, Top1, Top2))
return ord_GREATER_THAN;
else if (Top1 == Top2) {
int RecWeightDiff;
BOOL T1VarCond, T2VarCond;
TERM RecTerm1,RecTerm2;
Scan1 = term_ArgumentList(Term1);
Scan2 = term_ArgumentList(Term2);
if (symbol_HasProperty(Top1,ORDRIGHT)) {
int i;
for (i = symbol_Arity(Top1);
i > 0 && term_Equal(list_NthElement(Scan1,i),list_NthElement(Scan2,i));
i--);
if (i > 0) {
RecTerm1 = (TERM)list_NthElement(Scan1,i);
RecTerm2 = (TERM)list_NthElement(Scan2,i);
}
else
return ord_EQUAL;
}
else {
while (!list_Empty(Scan1) && term_Equal(list_Car(Scan1),list_Car(Scan2))) {
Scan1 = list_Cdr(Scan1);
Scan2 = list_Cdr(Scan2);
}
if (list_Empty(Scan1)) /* Implies that list_Empty(Scan2) */
return ord_EQUAL;
else {
RecTerm1 = (TERM)list_Car(Scan1);
RecTerm2 = (TERM)list_Car(Scan2);
}
}
RecWeightDiff = kbo_CompVarCondAndWeight(RecTerm1,&T1VarCond,RecTerm2,&T2VarCond);
if (RecWeightDiff >= 0 && T1VarCond)
return kbo_CompareStruc(RecTerm1, RecTerm2, RecWeightDiff);
else
return ord_UNCOMPARABLE;
}
else
return ord_UNCOMPARABLE;
}
else
return ord_UNCOMPARABLE;
return ord_UNCOMPARABLE;
}
ord_RESULT rpos_ContGreaterEqual(CONTEXT GlobalC1, CONTEXT TermC1, TERM T1,
CONTEXT GlobalC2, CONTEXT TermC2, TERM T2,
BOOL VarIsConst)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: ord_GREATER_THAN if <T1> is greater than <T2>
ord_EQUAL if both terms are equal
ord_UNCOMPARABLE otherwise.
EFFECT: Variable bindings are considered.
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
If <VarIsConst> is set then variables are interpreted as constants
with lowest precedence. They are ranked to each other using
their variable index.
ASSUMPTION: All index variables of <T1> and <T2> are bound in
<GlobalC1> and <GlobalCt2>, respectively
***************************************************************/
{
LIST scan;
T1 = cont_Deref(GlobalC1, &TermC1, T1);
T2 = cont_Deref(GlobalC2, &TermC2, T2);
if (term_IsVariable(T1)) {
if (term_EqualTopSymbols(T1, T2))
return ord_Equal(); /* T2 is the same variable */
else
/* A variable can't be greater than another term */
return ord_Uncomparable();
} else if (term_IsVariable(T2)) { /* T1 isn't a variable */
if (cont_TermContainsSymbol(GlobalC1, TermC1, T1, term_TopSymbol(T2)))
return ord_GreaterThan();
else
return ord_Uncomparable();
} else if (term_EqualTopSymbols(T1, T2)) {
if (symbol_HasProperty(term_TopSymbol(T1), ORDMUL))
return rpos_ContMulGreaterEqual(GlobalC1, TermC1, T1,
GlobalC2, TermC2, T2, VarIsConst);
else
return rpos_ContLexGreaterEqual(GlobalC1, TermC1, T1,
GlobalC2, TermC2, T2, VarIsConst);
} else {
if (symbol_PrecedenceGreater(ord_PRECEDENCE, term_TopSymbol(T1),
term_TopSymbol(T2))) {
/* Different top symbols, symbol of T1 > symbol of T2. */
/* Try if T1 > each argument of T2. */
for (scan = term_ArgumentList(T2); !list_Empty(scan); scan = list_Cdr(scan))
if (!rpos_ContGreaterAux(GlobalC1, TermC1, T1,
GlobalC2, TermC2, list_Car(scan), VarIsConst))
return ord_Uncomparable();
return ord_GreaterThan();
} else {
/* Try to find an argument of T1 that is >= T2 */
for (scan = term_ArgumentList(T1); !list_Empty(scan); scan = list_Cdr(scan))
if (!ord_IsUncomparable(rpos_ContGreaterEqual(GlobalC1, TermC1,list_Car(scan),
GlobalC2, TermC2,T2,
VarIsConst)))
return ord_GreaterThan(); /* Argument of T1 >= T2 */
return ord_Uncomparable();
}
}
}
static int kbo_CompVarCondAndWeight(TERM Term1, BOOL *VarCond1, TERM Term2, BOOL *VarCond2)
/**************************************************************
INPUT: Two terms and two pointers to booleans.
EFFECT: Sets the booleans with respect to the kbo variable condition.
Computes the kbo weight difference.
***************************************************************/
{
SYMBOL MaxVar1,MaxVar2;
TERM Term;
LIST Scan;
int i,Stack,Weight;
*VarCond1 = *VarCond2 = TRUE;
MaxVar1 = term_MaxVar(Term1);
MaxVar2 = term_MaxVar(Term2);
Stack = stack_Bottom();
Weight = 0;
if (MaxVar1 < MaxVar2)
MaxVar1 = MaxVar2;
for (i = 0; i <= MaxVar1; i++) {
ord_VARCOUNT[i][0] = 0;
ord_VARCOUNT[i][1] = 0;
}
Term = Term1;
if (term_IsStandardVariable(Term)) {
ord_VARCOUNT[term_TopSymbol(Term)][0]++;
Weight += kbo_MINWEIGHT;
}
else {
Weight += symbol_Weight(term_TopSymbol(Term));
if (term_IsComplex(Term))
stack_Push(term_ArgumentList(Term));
}
while (!stack_Empty(Stack)) {
Scan = stack_Top();
Term = (TERM)list_Car(Scan);
stack_RplacTop(list_Cdr(Scan));
if (term_IsStandardVariable(Term)) {
Weight += kbo_MINWEIGHT;
ord_VARCOUNT[term_TopSymbol(Term)][0]++;
}
else {
Weight += symbol_Weight(term_TopSymbol(Term));
if (term_IsComplex(Term))
stack_Push(term_ArgumentList(Term));
}
while (!stack_Empty(Stack) && list_Empty(stack_Top()))
stack_Pop();
}
Term = Term2;
if (term_IsStandardVariable(Term)) {
Weight -= kbo_MINWEIGHT;
ord_VARCOUNT[term_TopSymbol(Term)][1]++;
}
else {
Weight -= symbol_Weight(term_TopSymbol(Term));
if (term_IsComplex(Term))
stack_Push(term_ArgumentList(Term));
}
while (!stack_Empty(Stack)) {
Scan = stack_Top();
Term = (TERM)list_Car(Scan);
stack_RplacTop(list_Cdr(Scan));
if (term_IsStandardVariable(Term)) {
Weight -= kbo_MINWEIGHT;
ord_VARCOUNT[term_TopSymbol(Term)][1]++;
}
else {
Weight -= symbol_Weight(term_TopSymbol(Term));
if (term_IsComplex(Term))
stack_Push(term_ArgumentList(Term));
}
while (!stack_Empty(Stack) && list_Empty(stack_Top()))
stack_Pop();
}
for (i = 0; i <= MaxVar1; i++) {
if (ord_VARCOUNT[i][0] < ord_VARCOUNT[i][1]) {
*VarCond1 = FALSE;
if (!*VarCond2)
return Weight;
}
if (ord_VARCOUNT[i][0] > ord_VARCOUNT[i][1]) {
*VarCond2 = FALSE;
if (!*VarCond1)
return Weight;
}
}
return Weight;
}
BOOL cont_TermEqualModuloBindings(CONTEXT IndexContext, CONTEXT CtL, TERM TermL,
CONTEXT CtR, TERM TermR)
/*********************************************************
INPUT: Two contexts, two terms.
RETURNS: The boolean value TRUE if the terms are equal.
CAUTION: EQUAL FUNCTION- OR PREDICATE SYMBOLS SHARE THE
SAME ARITY. THIS IS NOT VALID FOR JUNCTORS!
*******************************************************/
{
#ifdef CHECK
if (!(term_IsTerm(TermL) && term_IsTerm(TermR))) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_TermEqualModuloBindings: Input terms are corrupted.\n");
misc_FinishErrorReport();
}
#endif
while (term_IsVariable(TermL)) {
SYMBOL TermTop;
TermTop = term_TopSymbol(TermL);
if (symbol_IsIndexVariable(TermTop))
CtL = IndexContext;
else if (CtL == cont_InstanceContext())
break;
if (cont_VarIsBound(CtL, TermTop)) {
CONTEXT CHelp;
CHelp = cont_ContextBindingContext(CtL, TermTop);
TermL = cont_ContextBindingTerm(CtL, TermTop);
CtL = CHelp;
} else
break;
}
while (term_IsVariable(TermR)) {
SYMBOL TermTop;
TermTop = term_TopSymbol(TermR);
if (symbol_IsIndexVariable(TermTop))
CtR = IndexContext;
else if (CtR == cont_InstanceContext())
break;
if (cont_VarIsBound(CtR, TermTop)) {
CONTEXT CHelp;
CHelp = cont_ContextBindingContext(CtR, TermTop);
TermR = cont_ContextBindingTerm(CtR, TermTop);
CtR = CHelp;
} else
break;
}
if (!term_EqualTopSymbols(TermL, TermR))
return FALSE;
else
if (term_IsVariable(TermL)) {
if (CtL == CtR)
return TRUE;
else
return FALSE;
}
else
if (term_IsComplex(TermL)) {
LIST ScanL, ScanR;
for (ScanL=term_ArgumentList(TermL), ScanR=term_ArgumentList(TermR);
list_Exist(ScanL) && list_Exist(ScanR);
ScanL=list_Cdr(ScanL), ScanR=list_Cdr(ScanR))
if (!cont_TermEqualModuloBindings(IndexContext, CtL, list_Car(ScanL),
CtR, list_Car(ScanR)))
return FALSE;
return (list_Empty(ScanL) ? list_Empty(ScanR) : FALSE);
}
else
return TRUE;
}
