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 st_INDEX st_FirstVariant(const CONTEXT Context, LIST Subnodes, st_INDEX* BestNonVariant)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
st_INDEX EmptyVariant;
for (EmptyVariant = NULL, *BestNonVariant = NULL;
list_Exist(Subnodes);
Subnodes = list_Cdr(Subnodes)) {
st_INDEX CurrentNode;
CurrentNode = (st_INDEX)list_Car(Subnodes);
cont_StartBinding();
if (subst_Variation(Context, CurrentNode->subst)) {
if (subst_Exist(CurrentNode->subst)) {
subst_CloseVariables(Context, CurrentNode->subst);
return CurrentNode;
} else
EmptyVariant = CurrentNode;
} else if (*BestNonVariant == NULL)
if (subst_MatchTops(Context, CurrentNode->subst))
*BestNonVariant = CurrentNode;
cont_BackTrack();
}
return EmptyVariant;
}
BOOL list_DeleteFromList(LIST* List, POINTER Element)
/**************************************************************
INPUT: A list and an element pointer
RETURNS: TRUE, if Element was deleted; FALSE, otherwise.
EFFECTS: If List contains Element with respect to pointer equality,
all occurrences of Element are deleted from List.
CAUTION: Destructive. Be careful, the first element of a list cannot
be changed destructively by call by reference.
***************************************************************/
{
BOOL Found;
LIST Scan1;
Found = FALSE;
while (list_Exist(*List) && Element == list_Car(*List)) {
Scan1 = list_Cdr(*List);
list_Free(*List);
*List = Scan1;
Found = TRUE;
}
if (list_Exist(*List)) {
LIST Scan2;
Scan2 = *List;
Scan1 = list_Cdr(*List);
while (list_Exist(Scan1)) {
if (Element == list_Car(Scan1)) {
list_Rplacd(Scan2, list_Cdr(Scan1));
list_Free(Scan1);
Scan1 = list_Cdr(Scan2);
Found = TRUE;
} else {
Scan2 = Scan1;
Scan1 = list_Cdr(Scan1);
}
}
}
return Found;
}
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;
}
static POINTER st_TraverseForExistInstancePreTest(CONTEXT IndexContext)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
LIST CurrentList;
st_INDEX CurrentNode;
/* Caution: In case an entry is found
the procedure returns immediately
without backtracking the current bindings. */
CurrentList = list_Nil();
for (;;) {
/* BACKTRACK A BIG STEP */
if (list_Empty(CurrentList)) {
cont_StopAndBackTrack();
if (st_StackEmpty(st_STACKSAVE))
return NULL;
CurrentList = st_StackPopResult();
}
/* DESCENDING */
for (CurrentNode = (st_INDEX)list_Car(CurrentList);
(st_EXIST_MINMAX <= st_Max(CurrentNode)) &&
subst_MatchReverse(IndexContext, CurrentNode->subst);
CurrentList = CurrentNode->subnodes,
CurrentNode = (st_INDEX)list_Car(CurrentList)) {
if (list_Exist(list_Cdr(CurrentList))) {
st_StackPush(list_Cdr(CurrentList));
cont_StartBinding();
} else
cont_StopAndStartBinding();
if (st_IsLeaf(CurrentNode)) {
st_StackPush(list_Cdr(CurrentNode->entries));
return list_Car(CurrentNode->entries);
}
}
/* BACKTRACK LEAF OR INNER NODE */
CurrentList = list_Cdr(CurrentList);
cont_BackTrackAndStart();
}
}
static LIST st_TraverseTreeUnifier(CONTEXT IndexContext, st_INDEX StIndex)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
int Save;
LIST Result, CurrentList;
st_INDEX CurrentNode;
/* PREPARE TRAVERSAL */
Save = stack_Bottom();
Result = list_Nil();
CurrentList = StIndex->subnodes;
cont_StartBinding();
for (;;) {
/* BACKTRACK A BIG STEP */
if (list_Empty(CurrentList)) {
cont_StopAndBackTrack();
if (stack_Empty(Save))
return Result;
CurrentList = stack_PopResult();
}
/* DESCENDING */
for (CurrentNode = (st_INDEX)list_Car(CurrentList);
subst_Unify(IndexContext, CurrentNode->subst);
CurrentList = CurrentNode->subnodes,
CurrentNode = (st_INDEX)list_Car(CurrentList))
if (st_IsLeaf(CurrentNode)) {
Result = list_Append(CurrentNode->entries, Result);
break;
} else if (list_Exist(list_Cdr(CurrentList))) {
stack_Push(list_Cdr(CurrentList));
cont_StartBinding();
} else
cont_StopAndStartBinding();
/* BACKTRACK LEAF OR INNER NODE */
CurrentList = list_Cdr(CurrentList);
cont_BackTrackAndStart();
}
}
BOOL list_DeleteOneFromList(LIST* List, POINTER Element)
/**************************************************************
INPUT: A list and an element pointer
RETURNS: TRUE, if <Element> was deleted; FALSE, otherwise.
EFFECTS: If <List> contains <Element> with respect to pointer equality,
the first occurrence of <Element> is deleted from <List>.
CAUTION: Destructive.
***************************************************************/
{
if (list_Exist(*List)) {
LIST Scan1;
/* special treatment for the first element */
if (Element == list_Car(*List)) {
Scan1 = list_Cdr(*List);
list_Free(*List);
*List = Scan1;
return TRUE;
} else {
LIST Scan2;
for (Scan2 = *List, Scan1 = list_Cdr(*List); list_Exist(Scan1); ) {
if (Element == list_Car(Scan1)) {
list_Rplacd(Scan2, list_Cdr(Scan1));
list_Free(Scan1);
Scan1 = list_Cdr(Scan2);
return TRUE;
} else {
Scan2 = Scan1;
Scan1 = list_Cdr(Scan1);
}
}
}
}
return FALSE;
}
static void st_CloseUsedVariables(const CONTEXT Context, LIST NodeList)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
for (; list_Exist(NodeList); NodeList = list_Cdr(NodeList)) {
SUBST Subst;
for (Subst = ((st_INDEX)list_Car(NodeList))->subst;
subst_Exist(Subst);
Subst = subst_Next(Subst))
if (!cont_VarIsUsed(Context, subst_Dom(Subst)))
cont_CreateClosedBinding(Context, subst_Dom(Subst));
if (!st_IsLeaf((st_INDEX)list_Car(NodeList)))
st_CloseUsedVariables(Context, ((st_INDEX)list_Car(NodeList))->subnodes);
}
}
CONTEXT cont_ContextOfBinding(CONTEXT B)
{
CONTEXT Result;
LIST Scan;
for (Result = NULL, Scan = cont_LISTOFCONTEXTS;
list_Exist(Scan);
Scan = list_Cdr(Scan)) {
if (cont_IsInContext(list_Car(Scan), cont_BindingSymbol(B), B)) {
Result = list_Car(Scan);
break;
}
}
#ifdef CHECK
if (Result == NULL) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_ContextOfBinding: Unknown context.\n");
misc_FinishErrorReport();
}
#endif
return Result;
}
BOOL st_EntryDelete(st_INDEX StIndex, POINTER Pointer, TERM Term, const CONTEXT Context)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
BOOL Found;
LIST Subnodes;
SYMBOL FirstDomain;
cont_Check();
FirstDomain = symbol_FirstIndexVariable();
cont_CreateBinding(Context, FirstDomain, Context, Term);
for (Found = FALSE, Subnodes = StIndex->subnodes;
list_Exist(Subnodes);
Subnodes = list_Cdr(Subnodes)) {
st_INDEX CurrentNode;
CurrentNode = (st_INDEX)list_Car(Subnodes);
cont_StartBinding();
if (subst_Variation(Context, CurrentNode->subst)) {
list_Rplaca(Subnodes, st_EntryDeleteHelp(Context, CurrentNode, Pointer, &Found));
if (Found) {
StIndex->subnodes = list_PointerDeleteElement(StIndex->subnodes, NULL);
if (list_Exist(StIndex->subnodes)) {
CurrentNode = (st_INDEX)list_Car(StIndex->subnodes);
st_SetMax(StIndex, st_Max(CurrentNode));
st_SetMin(StIndex, st_Min(CurrentNode));
for (Subnodes = list_Cdr(StIndex->subnodes);
list_Exist(Subnodes);
Subnodes = list_Cdr(Subnodes)) {
CurrentNode = (st_INDEX)list_Car(Subnodes);
if (st_Max(CurrentNode) > st_Max(StIndex))
st_SetMax(StIndex, st_Max(CurrentNode));
if (st_Min(CurrentNode) < st_Min(StIndex))
st_SetMin(StIndex, st_Min(CurrentNode));
}
} else {
st_SetMax(StIndex, 0);
st_SetMin(StIndex, 0);
}
break;
}
}
cont_BackTrack();
}
cont_Reset();
return Found;
}
static st_INDEX st_EntryDeleteHelp(const CONTEXT Context, st_INDEX StIndex, POINTER Pointer,
BOOL* Found)
/**************************************************************
INPUT: The root of an abstraction tree (StIndex), a
pointer to a specific entry of the tree and
a query term.
RETURNS: Nothing.
SUMMARY: Uses Term in order to find Pointer in the tree.
EFFECTS: Will delete nodes of StIndex.
***************************************************************/
{
if (st_IsLeaf(StIndex)) {
*Found = list_DeleteFromList(&(StIndex->entries), Pointer);
if (list_Exist(StIndex->entries))
return StIndex;
else {
subst_Delete(StIndex->subst);
st_Free(StIndex);
return NULL;
}
} else {
LIST Subnodes;
for (Subnodes = StIndex->subnodes;
list_Exist(Subnodes);
Subnodes = list_Cdr(Subnodes)) {
st_INDEX CurrentNode;
CurrentNode = (st_INDEX)list_Car(Subnodes);
cont_StartBinding();
if (subst_Variation(Context, CurrentNode->subst)) {
list_Rplaca(Subnodes, st_EntryDeleteHelp(Context,
CurrentNode,
Pointer,
Found));
if (*Found) {
if (list_DeleteFromList(&(StIndex->subnodes), NULL))
if (list_Empty(list_Cdr(StIndex->subnodes))) {
/* 'StIndex' has one subnode only. */
st_NodeMergeWithSon(StIndex);
return StIndex;
}
/* Assertion: 'StIndex' is an inner node. */
CurrentNode = (st_INDEX)list_Car(StIndex->subnodes);
st_SetMax(StIndex, st_Max(CurrentNode));
st_SetMin(StIndex, st_Min(CurrentNode));
for (Subnodes = list_Cdr(StIndex->subnodes);
list_Exist(Subnodes);
Subnodes = list_Cdr(Subnodes)) {
CurrentNode = (st_INDEX)list_Car(Subnodes);
if (st_Max(CurrentNode) > st_Max(StIndex))
st_SetMax(StIndex, st_Max(CurrentNode));
if (st_Min(CurrentNode) < st_Min(StIndex))
st_SetMin(StIndex, st_Min(CurrentNode));
}
return StIndex;
}
}
cont_BackTrack();
}
return StIndex;
}
}
POINTER st_NextCandidate(void)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
LIST Result;
#ifdef CHECK
if (st_StackEmpty(st_STACKSAVE)) {
misc_StartErrorReport();
misc_ErrorReport("\n In st_NextCandidate: ST-Stack empty.\n");
misc_FinishErrorReport();
}
else
if (st_CURRENT_RETRIEVAL == st_NOP) {
misc_StartErrorReport();
misc_ErrorReport("\n In st_NextCandidate: No retrieval in progress.\n");
misc_FinishErrorReport();
}
cont_CheckState();
#endif
Result = st_StackPopResult();
if (list_Exist(Result)) {
st_StackPush(list_Cdr(Result));
#ifdef CHECK
cont_SaveState();
#endif
return list_Car(Result);
} else {
POINTER NewResult;
NewResult = NULL;
if (st_WHICH_CONTEXTS == st_STANDARD)
switch (st_CURRENT_RETRIEVAL) {
case st_UNIFIER:
NewResult = st_TraverseForExistUnifier(st_INDEX_CONTEXT);
break;
case st_GEN:
NewResult = st_TraverseForExistGen(st_INDEX_CONTEXT);
break;
case st_GENPRETEST:
NewResult = st_TraverseForExistGenPreTest(st_INDEX_CONTEXT);
break;
case st_INSTANCE:
NewResult = st_TraverseForExistInstance(st_INDEX_CONTEXT);
break;
case st_INSTANCEPRETEST:
NewResult = st_TraverseForExistInstancePreTest(st_INDEX_CONTEXT);
default:
misc_StartErrorReport();
misc_ErrorReport("\n In st_NextCandidate: Unknown retrieval type.\n");
misc_FinishErrorReport();
}
else {
misc_StartErrorReport();
misc_ErrorReport("\n In st_NextCandidate: Unknown context type.\n");
misc_FinishErrorReport();
}
#ifdef CHECK
cont_SaveState();
#endif
if (NewResult == NULL)
st_CancelExistRetrieval();
return NewResult;
}
}
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;
}
