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;
}
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 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;
}
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();
}
}
TERM cont_Deref(CONTEXT GlobalContext, CONTEXT* TermContext, TERM Term)
/******************************************************************
INPUT: A global context where the Index variables are bound,
a term <Term> and a call-by-ref context for <Term>.
RETURNS: The dereferenced term and the corresponding context.
SUMMARY: Dereferences bindings of variables.
CAUTION: In general, the context of the returned term <TermContext>
is different to the input context.
ASSUMPTION: All Index variables occuring in <Term> have to be
bound in <GlobalContext>,
no Index variable is mapped to another index variable
*******************************************************************/
{
if(term_IsIndexVariable(Term)) {
SYMBOL TermTop;
TermTop = term_TopSymbol(Term);
#ifdef CHECK
if(!cont_VarIsBound(GlobalContext, TermTop) ||
term_IsIndexVariable(cont_ContextBindingTerm(GlobalContext, TermTop))) {
misc_StartErrorReport();
misc_ErrorReport("\ncont_Deref: Illegal Context!");
misc_FinishErrorReport();
}
#endif
Term = cont_ContextBindingTerm(GlobalContext, TermTop);
*TermContext = cont_ContextBindingContext(GlobalContext, TermTop);
}
while (term_IsVariable(Term) && *TermContext != cont_InstanceContext()) {
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
return Term;
}
return Term;
}
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();
}
}
}
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());
}
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 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(')');
}
}
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 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 */
}
}
}
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(')');
}
}
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 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;
}
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();
}
}
}
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;
}
BOOL cont_BindingsAreRenamingModuloMatching(const CONTEXT RenamingContext)
{
CONTEXT Context;
#ifdef CHECK
if (!cont_IsContextEmpty(RenamingContext)) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_BindingsAreRenamingModuloMatching:");
misc_ErrorReport(" Renaming context contains bindings.\n");
misc_FinishErrorReport();
}
#endif
cont_StartBinding();
Context = cont_LastBinding();
while (Context) {
if (!symbol_IsIndexVariable(cont_BindingSymbol(Context))) {
SYMBOL CodomainSymbol;
CodomainSymbol = term_TopSymbol(cont_BindingTerm(Context));
if (symbol_IsVariable(CodomainSymbol)) {
if (cont_VarIsRenamed(RenamingContext, CodomainSymbol)) {
cont_BackTrack();
return FALSE;
} else {
cont_CreateBinding(RenamingContext, CodomainSymbol, NULL, NULL);
cont_SetContextBindingRenaming(RenamingContext, CodomainSymbol, CodomainSymbol);
}
} else {
cont_BackTrack();
return FALSE;
}
}
Context = cont_BindingLink(Context);
}
cont_BackTrack();
return TRUE;
}
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;
}
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;
}
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;
}
static LIST ana_CalculateFunctionPrecedence(LIST Functions, LIST Clauses,
FLAGSTORE Flags)
/**************************************************************
INPUT: A list of functions, a list of clauses and
a flag store.
RETURNS: A list of function symbols, which should be used
for setting the symbol precedence. The list is sorted
in descending order, that means function with highest
precedence come first.
EFFECT: Analyzes the clauses to build a directed graph G with
function symbol as nodes. An edge (f,g) or in G means
f should have lower precedence than g.
An edge (f,g) or (g,f) is created if there's an equation
equal(f(...), g(...)) in the clause list.
The direction of the edge depends on the degree of the
nodes and the symbol arity.
Then find the strongly connected components of this
graph.
The "Ordering" flag will be set in the flag store.
CAUTION: The value of "ana_PEQUATIONS" must be up to date.
***************************************************************/
{
GRAPH graph;
GRAPHNODE n1, n2;
LIST result, scan, scan2, distrPairs;
int i, j;
SYMBOL s, Add, Mult;
if (list_Empty(Functions))
return Functions; /* Problem contains no functions */
else if (!ana_PEQUATIONS) {
Functions = list_NumberSort(Functions, (NAT (*)(POINTER)) symbol_PositiveArity);
return Functions;
}
graph = graph_Create();
/* First create the nodes: one node for every function symbol. */
for (; !list_Empty(Functions); Functions = list_Pop(Functions))
graph_AddNode(graph, symbol_Index((SYMBOL)list_Car(Functions)));
/* Now sort the node list wrt descending symbol arity. */
graph_SortNodes(graph, ana_NodeGreater);
/* A list of pairs (add, multiply) of distributive symbols */
distrPairs = list_Nil();
/* Now add undirected edges: there's an undirected edge between */
/* two nodes if the symbols occur as top symbols in a positive */
/* equation. */
for (scan = Clauses; !list_Empty(scan); scan = list_Cdr(scan)) {
CLAUSE c = list_Car(scan);
for (i = clause_FirstSuccedentLitIndex(c);
i <= clause_LastSuccedentLitIndex(c); i++) {
if (clause_LiteralIsEquality(clause_GetLiteral(c, i))) {
/* Consider only positive equations */
TERM t1, t2;
if (fol_DistributiveEquation(clause_GetLiteralAtom(c,i), &Add, &Mult)) {
/* Add a pair (Add, Mult) to <distrTerms> */
distrPairs = list_Cons(list_PairCreate((POINTER)Add, (POINTER)Mult),
distrPairs);
/*fputs("\nDISTRIBUTIVITY: ", stdout);
term_PrintPrefix(clause_GetLiteralAtom(c,i));
fputs(" Add=", stdout); symbol_Print(Add);
fputs(" Mult=", stdout); symbol_Print(Mult); fflush(stdout); DBG */
}
t1 = term_FirstArgument(clause_GetLiteralAtom(c, i));
t2 = term_SecondArgument(clause_GetLiteralAtom(c, i));
if (!term_IsVariable(t1) && !term_IsVariable(t2) &&
!term_EqualTopSymbols(t1, t2) && /* No self loops! */
!term_HasSubterm(t1, t2) && /* No subterm property */
!term_HasSubterm(t2, t1)) {
n1 = graph_GetNode(graph, symbol_Index(term_TopSymbol(t1)));
n2 = graph_GetNode(graph, symbol_Index(term_TopSymbol(t2)));
/* Create an undirected edge by adding two directed edges */
graph_AddEdge(n1, n2);
graph_AddEdge(n2, n1);
/* Use the node info for the degree of the node */
ana_IncNodeDegree(n1);
ana_IncNodeDegree(n2);
}
}
}
}
/* putchar('\n');
for (scan = graph_Nodes(graph); !list_Empty(scan); scan = list_Cdr(scan)) {
n1 = list_Car(scan);
printf("(%s,%d,%u), ",
symbol_Name(symbol_GetSigSymbol(graph_NodeNumber(n1))),
graph_NodeNumber(n1), ana_NodeDegree(n1));
}
graph_Print(graph); fflush(stdout); DBG */
graph_DeleteDuplicateEdges(graph);
/* Transform the undirected graph into a directed graph. */
for (scan = graph_Nodes(graph); !list_Empty(scan); scan = list_Cdr(scan)) {
n1 = list_Car(scan);
result = list_Nil(); /* Collect edges from n1 that shall be deleted */
for (scan2 = graph_NodeNeighbors(n1); !list_Empty(scan2);
scan2 = list_Cdr(scan2)) {
int a1, a2;
n2 = list_Car(scan2);
/* Get the node degrees in the undirected graph with multiple edges */
i = ana_NodeDegree(n1);
j = ana_NodeDegree(n2);
a1 = symbol_Arity(symbol_GetSigSymbol(graph_NodeNumber(n1)));
a2 = symbol_Arity(symbol_GetSigSymbol(graph_NodeNumber(n2)));
if (i > j || (i==j && a1 >= a2)) {
/* symbol2 <= symbol1, so remove edge n1 -> n2 */
result = list_Cons(n2, result);
}
if (i < j || (i==j && a1 <= a2)) {
/* symbol1 <= symbol2, so remove edge n2 -> n1 */
graph_DeleteEdge(n2, n1);
}
/* NOTE: If (i==j && a1==a2) both edges are deleted! */
}
/* Now delete edges from n1 */
for ( ; !list_Empty(result); result = list_Pop(result))
graph_DeleteEdge(n1, list_Car(result));
}
if (!list_Empty(distrPairs) && !ana_BidirectionalDistributivity(distrPairs)) {
/* Enable RPO ordering, otherwise the default KBO will be used. */
flag_SetFlagIntValue(Flags, flag_ORD, flag_ORDRPOS);
}
/* Now examine the list of distribute symbols */
/* since they've highest priority. */
for ( ; !list_Empty(distrPairs); distrPairs = list_Pop(distrPairs)) {
scan = list_Car(distrPairs); /* A pair (Add, Mult) */
/* Addition */
n1 = graph_GetNode(graph,
symbol_Index((SYMBOL)list_PairFirst(scan)));
/* Multiplication */
n2 = graph_GetNode(graph,
symbol_Index((SYMBOL)list_PairSecond(scan)));
/* Remove any edges between n1 and n2 */
graph_DeleteEdge(n1, n2);
graph_DeleteEdge(n2, n1);
/* Add one edge Addition -> Multiplication */
graph_AddEdge(n1, n2);
list_PairFree(scan);
}
/* fputs("\n------------------------",stdout);
graph_Print(graph); fflush(stdout); DBG */
/* Calculate the strongly connected components of the graph. */
/* <i> is the number of SCCs. */
i = graph_StronglyConnectedComponents(graph);
/* Now create the precedence list by scanning the nodes. */
/* If there's a link between two strongly connected components */
/* c1 and c2 then component_num(c1) > component_num(c2), so the */
/* following code creates a valid precedence list in descending */
/* order. */
result = list_Nil();
while (i-- > 0) { /* for i = numberOfSCCs -1 dowto 0 */
for (scan = graph_Nodes(graph); !list_Empty(scan); scan = list_Cdr(scan)) {
n1 = list_Car(scan);
if (graph_NodeCompNum(n1) == i) {
/* The symbol represented by the node <n> belongs to component <i> */
s = symbol_GetSigSymbol(graph_NodeNumber(n1));
result = list_Cons((POINTER)s, result);
}
}
}
/* putchar('\n');
for (scan = result; !list_Empty(scan); scan = list_Cdr(scan)) {
s = (SYMBOL) list_Car(scan);
symbol_Print(s);
fputs(" > ", stdout);
}
putchar('\n'); fflush(stdout); DBG */
graph_Delete(graph);
return result;
}
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 LIST ana_CalculatePredicatePrecedence(LIST Predicates, LIST Clauses)
/**************************************************************
INPUT: A list of predicates and a list of clauses.
RETURNS: A list of predicate symbols, which should be used
for setting the symbol precedence. The list is sorted
in descending order, that means predicates with highest
precedence come first.
EFFECT: Analyze the clause list to build a directed graph G where
the predicates are vertices. There's an edge (P,Q) in
G iff a clause exists where P is a negative literal
and Q is a positive literal and P != Q. Apply DFS to
find the strongly connected components of this graph.
The <Predicates> list is deleted.
CAUTION: The predicate list must contain ALL predicates
occurring in the clause list!
***************************************************************/
{
GRAPH graph;
LIST result, scan;
int i, j;
NAT count;
SYMBOL s;
/* clause_ListPrint(Clauses); DBG */
if (list_Empty(Predicates)) {
return Predicates;
}
graph = graph_Create();
/* First create the nodes: one node for every predicate symbol. */
for ( ; !list_Empty(Predicates); Predicates = list_Pop(Predicates))
graph_AddNode(graph, symbol_Index((SYMBOL)list_Car(Predicates)));
/* Now scan the clause clause list to create the edges */
/* An edge (P,Q) means P is smaller than Q */
for (scan = Clauses; !list_Empty(scan); scan = list_Cdr(scan)) {
CLAUSE c = list_Car(scan);
for (i = clause_FirstLitIndex(); i < clause_FirstSuccedentLitIndex(c); i++) {
SYMBOL negPred = term_TopSymbol(clause_GetLiteralAtom(c, i));
if (!symbol_Equal(negPred, fol_Equality())) { /* negative predicate */
for (j = clause_FirstSuccedentLitIndex(c); j < clause_Length(c); j++) {
SYMBOL posPred = term_TopSymbol(clause_GetLiteralAtom(c, j));
if (!symbol_Equal(posPred, fol_Equality()) && /* positive predicate */
negPred != posPred) { /* No self loops! */
graph_AddEdge(graph_GetNode(graph, symbol_Index(negPred)),
graph_GetNode(graph, symbol_Index(posPred)));
}
}
}
}
}
/* graph_Print(graph); fflush(stdout); DBG */
/* Calculate the strongly connected components of the graph */
count = graph_StronglyConnectedComponents(graph);
/* Now create the precedence list by scanning the nodes. */
/* If there's a link between two strongly connected components */
/* c1 and c2 then component_num(c1) > component_num(c2), so the */
/* following code creates a valid precedence list in descending */
/* order. */
result = list_Nil();
for (i = count - 1; i >= 0; i--) {
for (scan = graph_Nodes(graph); !list_Empty(scan); scan = list_Cdr(scan)) {
GRAPHNODE n = list_Car(scan);
if (graph_NodeCompNum(n) == i) {
/* The symbol represented by the node <<n> belongs to component <i> */
s = symbol_GetSigSymbol(graph_NodeNumber(n));
result = list_Cons((POINTER)s, result);
}
}
}
/* putchar('\n');
for (scan = result; !list_Empty(scan); scan = list_Cdr(scan)) {
s = (SYMBOL) list_Car(scan);
symbol_Print(s);
putchar(' ');
}
putchar('\n'); fflush(stdout); DBG */
graph_Delete(graph);
return result;
}
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;
}