void symbol_Delete(SYMBOL Symbol)
/**************************************************************
INPUT: A symbol.
RETURNS: Nothing.
SUMMARY: Deletes the symbol from the symbol table and frees its memory.
***************************************************************/
{
#ifdef CHECK
if (!symbol_SignatureExists()) {
misc_StartErrorReport();
misc_ErrorReport("\n In symbol_Delete: Module was initialized without signature.\n");
misc_FinishErrorReport();
}
if (!symbol_IsSymbol(Symbol)) {
misc_StartErrorReport();
misc_ErrorReport("\n In symbol_Delete: Illegal input.\n");
misc_FinishErrorReport();
}
#endif
if (!symbol_IsVariable(Symbol)) {
int Index;
SIGNATURE Entry;
Index = symbol_Index(Symbol);
symbol_FREEDSYMBOLS = list_Cons((POINTER)Index,symbol_FREEDSYMBOLS);
Entry = symbol_Signature(Index);
symbol_SetSignature(Index, NULL);
symbol_FreeSignature(Entry);
}
}
TABLE table_Delete(TABLE table, TERM term)
/***************************************************************
EFFECT: if term has entered table before, it is deleted
***************************************************************/
{
int no;
#ifdef CHECK
if (!table_LegalPosIndex(table, term_Size(term))) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_Delete: illegal table access.");
misc_FinishErrorReport();
}
#endif
no = term_Size(term);
table_DelayedPosInit(table, no);
if (table_GetPos(table, no)) {
#ifdef CHECK
if (!table_Stamped(table, table_GetPos(table, no))) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_Delete: table corrupted.");
misc_FinishErrorReport();
}
#endif
table_SetTerm(table_GetPos(table, no), term_Null());
table_SetPos(table, no, (TERMARRAY) NULL);
}
return table;
}
static void cc_Union(ECLASS c1, ECLASS c2)
/***************************************************************
EFFECT: unions c1 and c2, therefore the signatures of the
predecessors of one class change, so these
predecessors have to be deleted from the signature
table and become pending again; sets new class's
predecessor list and its size to the concatenation of
the old lists resp. the sum of the old sizes
***************************************************************/
{
int aux, size;
TERM term;
#ifdef CHECK
if (part_Find(cc_GetPartition(), c1) != c1) {
misc_StartErrorReport();
misc_ErrorReport("\n In cc_Union: first class corrupted, i. e. is not ");
misc_ErrorReport("the representative.");
misc_FinishErrorReport();
}
if (part_Find(cc_GetPartition(), c2) != c2) {
misc_StartErrorReport();
misc_ErrorReport("\n In cc_Union: second class corrupted, i. e. is not ");
misc_ErrorReport("the representative.");
misc_FinishErrorReport();
}
#endif
if (c1 != c2) {
/* make c1 the class with the bigger (or at least not smaller) list: */
if (cc_GetSize(c1) < cc_GetSize(c2)) {
aux = c1;
c1 = c2;
c2 = aux;
}
/* delete c2's predecessors from signature table and add them to pending: */
for (size = cc_GetSize(c2), aux = c2; size > 0; size--) {
term = cc_GetCar(aux);
aux = cc_GetCdr(aux);
table_Delete(cc_GetTable(), term);
cc_SetPending(ras_Push(cc_GetPending(), term));
}
if (cc_GetSize(c2) > 0) { /* then GetSize(c1) ( >= GetSize(c2) ) > 0 too */
/* union circularly linked lists by exchanging cdrs: */
aux = cc_GetCdr(c1);
cc_SetCdr(c1, cc_GetCdr(c2));
cc_SetCdr(c2, aux);
cc_SetSize(c1, cc_GetSize(c1) + cc_GetSize(c2));
}
part_Union(cc_GetPartition(), c1, c2);
}
}
POINTER st_ExistGenPreTest(CONTEXT IndexContext, st_INDEX StIndex, TERM Term)
/**************************************************************
INPUT:
RETURNS:
EFFECTS:
***************************************************************/
{
SYMBOL FirstDomain;
POINTER Result;
#ifdef CHECK
if (!st_StackEmpty(st_STACKSAVE)) {
misc_StartErrorReport();
misc_ErrorReport("\n In st_ExistGenPreTest: ST-Stack not empty.\n");
misc_FinishErrorReport();
}
else
if (st_CURRENT_RETRIEVAL != st_NOP) {
misc_StartErrorReport();
misc_ErrorReport("\n In st_ExistGenPreTest: %d Retrieval already in progress.\n",
st_CURRENT_RETRIEVAL);
misc_FinishErrorReport();
}
#endif
cont_Check();
if (st_Exist(StIndex)) {
st_CURRENT_RETRIEVAL = st_GENPRETEST;
st_WHICH_CONTEXTS = st_STANDARD;
st_INDEX_CONTEXT = IndexContext;
st_STACKSAVE = st_StackBottom();
FirstDomain = symbol_FirstIndexVariable();
st_EXIST_MINMAX = term_ComputeSize(Term);
cont_CreateBinding(IndexContext, FirstDomain, IndexContext, Term);
cont_StartBinding();
st_StackPush(StIndex->subnodes);
cont_StartBinding();
Result = st_TraverseForExistGenPreTest(IndexContext);
#ifdef CHECK
cont_SaveState();
#endif
if (Result == NULL)
st_CancelExistRetrieval();
return Result;
} else
return NULL;
}
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();
}
}
TABLE table_Create(int opbound, int varbound, int termbound)
/***************************************************************
INPUT: bounds for the operator symbol, variable and term
indices of the terms to be stored in the signature
table (i. e. for every such term its top symbol index
has to be in [1, opbound] and the term numbers of its
arguments in [0, termbound] - or its variable index
in [1, varbound] if it is a variable)
RETURNS: a new (and empty) signature table
***************************************************************/
{
TABLE result;
#ifdef CHECK
if (opbound < 0) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_Create: negative opbound.");
misc_FinishErrorReport();
}
if (varbound < 0) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_Create: negative varbound.");
misc_FinishErrorReport();
}
if (termbound < 0) {
misc_StartErrorReport();
misc_ErrorReport("\n In table_Create: negative termbound.");
misc_FinishErrorReport();
}
#endif
result = (TABLE) memory_Malloc(sizeof(struct table));
table_SetTermarray(result, (TERMARRAY) memory_Calloc (
opbound + varbound + 1,
sizeof(struct termarray)
) + varbound);
/* move pointer to the middle of the array to allow negative indices */
table_SetPoss(
result,
(TERMARRAY*) memory_Malloc((termbound + 1) * sizeof(TERMARRAY))
);
table_SetPosstamps(result, (int*) memory_Calloc(termbound + 1, sizeof(int)));
table_SetOpbound(result, opbound);
table_SetVarbound(result, varbound);
table_SetTermbound(result, termbound);
table_SetStampcounter(result, 1);
return result;
}
static ELEMENT part_NF(PARTITION p, ELEMENT e)
/***************************************************************
RETURNS: the normal form element of the class [e]; this is an
element of [e] that sometimes differ from the
representative
EFFECT: makes the normal form to the direct parent of all
elements visited on the search path from e to this
normal form ("path compression")
***************************************************************/
{
ELEMENT nf, aux;
#ifdef CHECK
if (!part_Element(p, e)) {
misc_StartErrorReport();
misc_ErrorReport("\n In part_NF: %d not in partitioned set.", e);
misc_FinishErrorReport();
}
#endif
nf = e;
while (part_GetClass(p, part_DelayedInit(p, nf)) >= 0)
nf = part_GetClass(p, nf);
/* path compression: */
while (e != nf) {
aux = part_GetClass(p, e);
part_SetClass(p, e, nf);
e = aux;
}
return nf;
}
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;
}
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;
}
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());
}
static BOOL cc_Outit(CLAUSE clause)
/***************************************************************
RETURNS: the decision, if the clause is a tautology
***************************************************************/
{
int last, i;
BOOL result;
TERM atom;
#ifdef CHECK
if (!ras_Empty(cc_GetPending())) {
misc_StartErrorReport();
misc_ErrorReport("\n In cc_Outit: there are terms left to work off.");
misc_FinishErrorReport();
}
#endif
last = clause_LastLitIndex(clause);
for (i = clause_FirstSuccedentLitIndex(clause), result = FALSE;
i <= last && !result; i++) {
atom = clause_GetLiteralAtom(clause, i);
if (fol_IsEquality(atom))
result = part_Equivalent(cc_GetPartition(),
term_Size(term_FirstArgument(atom)),
term_Size(term_SecondArgument(atom)));
else
result = part_Equivalent(cc_GetPartition(), term_Size(atom), cc_NOOFTRUE);
}
return result;
}
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;
}
void list_NInsert(LIST List1, LIST List2)
/**************************************************************
INPUT: Two lists where <List1> must not be empty.
EFFECT: <List2> is destructively concatenated after
the first element of <List1>.
RETURNS: void.
CAUTION: Destructive on List1 and List2.
***************************************************************/
{
LIST Help;
#ifdef CHECK
if (list_Empty(List1)) {
misc_StartErrorReport();
misc_ErrorReport("\n In list_NInsert: Empty list argument.");
misc_FinishErrorReport();
}
#endif
Help = list_Cdr(List1);
list_Rplacd(List1,List2);
List2 = List1;
while (!list_Empty(list_Cdr(List2)))
List2 = list_Cdr(List2);
list_Rplacd(List2,Help);
}
BOOL kbo_ContGreater(CONTEXT Context1, TERM Term1, CONTEXT Context2, TERM Term2)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: TRUE, if Term1 is greater than Term2 wrt the kbo with
the actual precedence kbo_Prec and the given symbol_Weights
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
***************************************************************/
{
int WeightDiff;
BOOL T1VarCond, T2VarCond;
#ifdef CHECK
if ((!term_IsTerm(Term1)) || (!term_IsTerm(Term2)) ) {
misc_StartErrorReport();
misc_ErrorReport("\n In kbo_ContGreater:");
misc_ErrorReport("\n Illegal input.");
misc_FinishErrorReport();
}
#endif
WeightDiff = kbo_ContCompVarCondAndWeight(Context1, Term1, &T1VarCond, Context2, Term2, &T2VarCond);
if (T1VarCond) {
if (WeightDiff > 0)
return TRUE;
else if (WeightDiff == 0)
return kbo_ContGreaterCompareStruc(Context1,Term1,Context2,Term2);
}
return FALSE;
}
PARTITION part_Union(PARTITION p, ECLASS c1, ECLASS c2)
/***************************************************************
RETURNS: the union of the classes
EFFECT: the representative of c1 is the representative of the
union
***************************************************************/
{
ELEMENT nf1, nf2, aux;
#ifdef CHECK
if (!part_Element(p, c1)) {
misc_StartErrorReport();
misc_ErrorReport("\n In part_Union: first class %d not in partitioned set.",
c1);
misc_FinishErrorReport();
}
if (!part_Element(p, c2)) {
misc_StartErrorReport();
misc_ErrorReport
("\n In part_Union: second class %d not in partitioned set.", c2);
misc_FinishErrorReport();
}
#endif
nf1 = part_NF(p, c1);
nf2 = part_NF(p, c2);
if (nf1 != nf2) {
/* make [nf1] the bigger (or at least not smaller) class: */
if (part_GetClassSize(p, nf1) < part_GetClassSize(p, nf2)) {
aux = nf1;
nf1 = nf2;
nf2 = aux;
part_SetClass(p, nf1, part_GetClass(p, nf2));
part_SetClass(p, -part_GetClass(p, nf2) - 1, nf1);
}
part_SetClass(p, nf2, nf1);
part_SetClassSize(p, nf1,
part_GetClassSize(p, nf1) + part_GetClassSize(p, nf2));
}
return p;
}
void tab_AddSplitAtCursor(TABPATH Path, BOOL LeftSide)
/**************************************************************
INPUT: A tableau path, a flag
RETURNS: Nothing.
EFFECTS: Extends the tableau containing the path <Path> to
the left if <LeftSide> is TRUE, to the right
otherwise
***************************************************************/
{
TABLEAU Tab, NewBranch;
Tab = tab_PathTop(Path);
NewBranch = tab_CreateNode();
if (LeftSide) {
#ifdef CHECK
if (!tab_LeftBranchIsEmpty(Tab)) {
misc_StartErrorReport();
misc_ErrorReport("\n In tab_AddSplitAtCursor: Recreating existing");
misc_ErrorReport(" left branch in tableau.\n");
misc_FinishErrorReport();
}
#endif
tab_SetLeftBranch(Tab,NewBranch);
} else {
#ifdef CHECK
if (!tab_RightBranchIsEmpty(Tab)) {
misc_StartErrorReport();
misc_ErrorReport("\n In tab_AddSplitAtCursor: Recreating existing");
misc_ErrorReport(" right branch in tableau.\n");
misc_FinishErrorReport();
}
#endif
tab_SetRightBranch(Tab, NewBranch);
}
tab_PathPush(NewBranch, Path);
}
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;
}
void symbol_FPrintOtter(FILE* File, SYMBOL Symbol)
/**************************************************************
INPUT: A file and a symbol.
RETURNS: None.
SUMMARY: Prints a symbol in Otter format to stdout.
***************************************************************/
{
#ifdef CHECK
if (!symbol_IsSymbol(Symbol)) {
misc_StartErrorReport();
misc_ErrorReport("\n In symbol_FPrintOtter: Illegal input.\n");
misc_FinishErrorReport();
}
#endif
if (symbol_IsVariable(Symbol)) {
SYMBOL NormSymbol;
NormSymbol = symbol_NormVar(Symbol);
if (symbol_IsStandardVariable(Symbol)) {
if (Symbol <= 6)
/* u, v, w, x, y, z */
sprintf(symbol_VARSTRING,"%c", 116 + NormSymbol);
else
/* x1, x2, x3, ... */
sprintf(symbol_VARSTRING,"x%d", NormSymbol - 6);
}
else if (symbol_IsIndexVariable(Symbol))
/* I1, I2, I3, ... */
sprintf(symbol_VARSTRING,"I%d", NormSymbol);
fputs(symbol_VARSTRING, File);
}
else
if (symbol_SignatureExists()) {
if (symbol_IsConstant(Symbol))
fprintf(File, "c%s", symbol_Name(Symbol));
else
if (symbol_IsFunction(Symbol))
fprintf(File, "f%s", symbol_Name(Symbol));
else
if (symbol_IsPredicate(Symbol))
fprintf(File, "P%s", symbol_Name(Symbol));
else
fputs(symbol_Name(Symbol), File);
}
else
fprintf(File, "%d", Symbol);
}
LIST list_Sort(LIST List, BOOL (*Test)(POINTER, POINTER))
/**************************************************************
INPUT: A list and a 'less' function on the elements.
RETURNS: The same list where the elements are sorted with
respect to Test.
EFFECT: The function needs time O((n log n) *t), where <n>
is the length of the list and <t> is the time for
the test function.
CAUTION: Destructive.
***************************************************************/
{
LIST Result;
#ifdef CHECK
NAT originallength;
originallength = list_Length(List);
#endif
Result = list_MergeSort(List, Test);
#ifdef CHECK
if (!list_SortedInOrder(Result, Test)) {
misc_StartErrorReport();
misc_ErrorReport("\n In list_Sort: list_MergeSort did not sort properly.");
misc_FinishErrorReport();
}
if (list_Length(Result) != originallength) {
misc_StartErrorReport();
misc_ErrorReport("\n In list_Sort: list_MergeSort lost elements. ");
misc_FinishErrorReport();
}
#endif
return Result;
}
ord_RESULT kbo_ContCompare(CONTEXT Context1, TERM Term1, CONTEXT Context2, TERM Term2)
/**************************************************************
INPUT: Two contexts and two terms.
RETURNS: ord_UNCOMPARABLE, if Term1 and Term2 are uncomparable because of
different variables,
ord_EQUAL, if Term1 and Term2 are comparable and have the
same weight,
ord_GREATER_THAN, if Term1 is greater than Term2 wrt the kbo with
the actual precedence kbo_Prec and the given
symbol_Weights,
ord_SMALLER_THAN, else.
The Terms are interpreted with respect to the contexts.
CAUTION: The precedence from the order module is used to determine
the precedence of symbols!
***************************************************************/
{
int WeightDiff;
BOOL T1VarCond, T2VarCond;
ord_RESULT Result;
#ifdef CHECK
if (!term_IsTerm(Term1) || !term_IsTerm(Term2)) {
misc_StartErrorReport();
misc_ErrorReport("\n In kbo_Compare:");
misc_ErrorReport("\n Illegal input.");
misc_FinishErrorReport();
}
#endif
WeightDiff = kbo_ContCompVarCondAndWeight(Context1, Term1, &T1VarCond, Context2, Term2, &T2VarCond);
if (T1VarCond && !T2VarCond)
return kbo_ContCompareStruc(Context1,Term1,Context2,Term2,WeightDiff);
if (!T1VarCond && T2VarCond)
return ord_Not(kbo_ContCompareStruc(Context2,Term2,Context1,Term1,-WeightDiff));
if (T1VarCond && T2VarCond) {
Result = kbo_ContCompareStruc(Context1,Term1,Context2,Term2,WeightDiff);
if (Result == ord_UNCOMPARABLE)
return ord_Not(kbo_ContCompareStruc(Context2,Term2,Context1,Term1,-WeightDiff));
else
return Result;
}
return ord_UNCOMPARABLE;
}
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_CreateBindingHelp(CONTEXT C, SYMBOL Var, CONTEXT CTerm, TERM Term)
{
#ifdef CHECK
if (cont_VarIsBound(C, Var)) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_CreateBindingHelp: Variable already bound.\n");
misc_FinishErrorReport();
}
#endif
cont_CURRENTBINDING = cont_Binding(C,Var);
cont_SetBindingTerm(cont_CURRENTBINDING, Term);
cont_SetBindingContext(cont_CURRENTBINDING, CTerm);
cont_SetBindingLink(cont_CURRENTBINDING, cont_LastBinding());
cont_SetLastBinding(cont_CURRENTBINDING);
}
void cont_Check(void)
/**********************************************************
INPUT: None.
RETURNS: None.
EFFECT: Frees internal structures of the unify module.
********************************************************/
{
#ifdef CHECK
if (cont_LASTBINDING || (cont_BINDINGS != 0) ||
!symbol_Equal(cont_INDEXVARSCANNER,
symbol_GetInitialIndexVarCounter())) {
misc_StartErrorReport();
misc_ErrorReport("\n In cont_Check: There are variable bindings not reset.\n");
misc_FinishErrorReport();
}
#endif
}
ECLASS part_Find(PARTITION p, ELEMENT e)
/***************************************************************
RETURNS: (the representative of) class [e]
***************************************************************/
{
#ifdef CHECK
if (!part_Element(p, e)) {
misc_StartErrorReport();
misc_ErrorReport("\n In part_Find: %d not in partitioned set.", e);
misc_FinishErrorReport();
}
#endif
return -part_GetClass(p, part_NF(p, e)) - 1;
/* representative e is coded as -e - 1 (cf. part_DelayedInit) */
}
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;
}
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;
}
void list_InsertNext(LIST List, POINTER Pointer)
/**************************************************************
INPUT: A list and a pointer to anything.
RETURNS: A list with Pointer being added at the position that
follows List.
SUMMARY: We enqueue the element at position list_Cdr(List);
The function needs time O(1).
***************************************************************/
{
#ifdef CHECK
if (Pointer == NULL) {
misc_StartErrorReport();
misc_ErrorReport("\n In list_InsertNext: NULL Pointer. ");
misc_FinishErrorReport();
}
#endif
list_Rplacd(List, list_Cons(Pointer, list_Cdr(List)));
}
void symbol_FPrint(FILE* File, SYMBOL Symbol)
/**************************************************************
INPUT: A file and a symbol.
RETURNS: None.
SUMMARY: Prints a symbol to the file.
***************************************************************/
{
#ifdef CHECK
if (!symbol_IsSymbol(Symbol)) {
misc_StartErrorReport();
misc_ErrorReport("\n In symbol_FPrint: Illegal input.\n");
misc_FinishErrorReport();
}
#endif
if (symbol_Equal(symbol_Null(),Symbol))
fputs("NULL", File);
else if (symbol_IsVariable(Symbol)) {
SYMBOL NormSymbol;
NormSymbol = symbol_NormVar(Symbol);
if (symbol_IsStandardVariable(Symbol)) {
if (Symbol <= 6)
/* U, V, W, X, Y, Z */
sprintf(symbol_VARSTRING,"%c", 'U' + NormSymbol - 1);
else
/* X1, X2, X3, ... */
sprintf(symbol_VARSTRING,"X%d", NormSymbol - 6);
}
else if (symbol_IsIndexVariable(Symbol))
/* I1, I2, I3, ... */
sprintf(symbol_VARSTRING,"I%d", NormSymbol);
fputs(symbol_VARSTRING, File);
}
else if (symbol_SignatureExists())
fputs(symbol_Name(Symbol), File);
else
fprintf(File, "%d", Symbol);
}
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;
}
PARTITION part_Init(PARTITION p, int size)
/****************************************************************
RETURNS: the initial partition {{0}, {1}, {2}, ..., {size - 1}}
of the set {0, 1, 2, ..., size - 1}
EFFECT: stores the initial partition to p if it's big enough,
otherwise creates a new partition, therefore
CAUTION: must be called inside an assignment like:
p = part_Init(p, ...)
****************************************************************/
{
int alloc, i;
#ifdef CHECK
if (size < 0) {
misc_StartErrorReport();
misc_ErrorReport("\n In part_Init: negative size %d.", size);
misc_FinishErrorReport();
}
#endif
alloc = (p[part_ALLOC] - part_HEAD) / 3;
if (size > alloc) {
part_Free(p);
p = part_Create(size);
}
else {
p[part_CARD] = size;
p[part_STAMPCOUNTER]++;
/* if a stamp overflow occurs, reinit stamps: */
if (p[part_STAMPCOUNTER] <= 0) {
for (i = 0; i < alloc; i++)
part_SetStamp(p, i, 0);
p[part_STAMPCOUNTER] = 1;
}
}
return p;
}
