static int list_CompareDistributions(LIST Left, LIST Right) /************************************************************** INPUT: Two lists, representing element distributions. RETURNS: 1 if left > right, -1 if left < right, 0 otherwise. EFFECT: Compares the two distributions by comparing the element frequencies from left to right. CAUTION: Expects the distributions to be sorted. ***************************************************************/ { LIST scan, scan2; int result; result = 0; scan = Left; scan2 = Right; /* Compare distributions. */ while ( !(list_Empty(scan) || list_Empty(scan2))) { result = list_CompareElementDistribution(list_Car(scan), list_Car(scan2)); if (result != 0) { break; } scan = list_Cdr(scan); scan2 = list_Cdr(scan2); } /* If the result is 0, and a distribution still has elements left, it is declared to be greater. */ if (result == 0) { if (list_Empty(scan) && !list_Empty(scan2)) result = -1; else if (!list_Empty(scan) && list_Empty(scan2)) result = 1; } return result; }
void hsh_Print(HASH H, void (*KeyPrint)(POINTER), void (*ValuePrint)(POINTER)) /************************************************************** INPUT: A hasharray and a print function for the values EFFECT: Prints all values in the hash array ***************************************************************/ { int i; LIST Scan; for (i = 0; i < hsh__SIZE; i++) { Scan = H[i]; printf("\n %d:",i); while (!list_Empty(Scan)) { KeyPrint(list_PairFirst(list_Car(Scan))); printf("-"); ValuePrint(list_PairSecond(list_Car(Scan))); printf("\n "); Scan = list_Cdr(Scan); } } }
LIST list_DeleteElement(LIST List, POINTER Element, BOOL (*Test)(POINTER, POINTER)) /************************************************************** INPUT: A list, an element pointer, an equality test for elements RETURNS: The list where Element is deleted from List with respect to Test. EFFECTS: If List contains Element with respect to EqualityTest, Element is deleted from List CAUTION: Destructive. Be careful, the first element of a list cannot be changed destructively by call by reference. ***************************************************************/ { LIST Scan1,Scan2; while (!list_Empty(List) && Test(Element, list_Car(List))) { Scan1 = list_Cdr(List); list_Free(List); List = Scan1; } if (list_Empty(List)) return list_Nil(); Scan2 = List; Scan1 = list_Cdr(List); while (!list_Empty(Scan1)) { if (Test(Element, list_Car(Scan1))) { list_Rplacd(Scan2, list_Cdr(Scan1)); list_Free(Scan1); Scan1 = list_Cdr(Scan2); } else { Scan2 = Scan1; Scan1 = list_Cdr(Scan1); } } return List; }
void tab_CheckEmpties(TABLEAU T) /************************************************************** INPUT: A tableau RETURNS: Nothing. EFFECTS: Prints warnings if non-leaf nodes contain empty clauses (which should not be the case after pruning any more), of if leaf nodes contain more than one empty clause ***************************************************************/ { LIST Scan, Empties; BOOL Printem; if (tab_IsEmpty(T)) return; /* get all empty clauses in this node */ Empties = list_Nil(); for (Scan = tab_Clauses(T); !list_Empty(Scan); Scan = list_Cdr(Scan)) { if (clause_IsEmptyClause(list_Car(Scan))) Empties = list_Cons(list_Car(Scan), Empties); } Printem = FALSE; if (!list_Empty(Empties) && !tab_IsLeaf(T)) { puts("\nNOTE: non-leaf node contains empty clauses."); Printem = TRUE; } if (tab_IsLeaf(T) && list_Length(Empties) > 1) { puts("\nNOTE: Leaf contains more than one empty clauses."); Printem = TRUE; } if (Printem) { puts("Clauses:"); clause_PParentsListPrint(tab_Clauses(T)); } list_Delete(Empties); tab_CheckEmpties(tab_LeftBranch(T)); tab_CheckEmpties(tab_RightBranch(T)); }
CLAUSE res_SelectLightestClause(LIST clauselist) /********************************************************** INPUT: A list of clauses. RETURNS: The lightest clause of the clauselist. CAUTION: None. ***********************************************************/ { CLAUSE clause; LIST scan; int min; clause = list_Car(clauselist); min = clause_Weight(clause); for (scan=list_Cdr(clauselist); !list_Empty(scan); scan=list_Cdr(scan)) { if (clause_Weight(list_Car(scan)) < min) { clause = list_Car(scan); min = clause_Weight(clause); } } return clause; }
static LIST red_GetTerminatorPartnerLits(TERM Atom, LITERAL Lit, BOOL UnitsOnly, LIST IndexList) /************************************************************** INPUT: An atom, a literal, a boolean flag and a list of SHARED_INDEXes. RETURNS: A list of literals with sign complementary to <Lit> that are unifiable with <Atom>. The literals are searched in all SHARED_INDEXes from <IndexList>. Additionally, if <Unitsonly> is true, only literals from unit clauses are returned. EFFECT: <Atom> is a copy of <Lit> where some substitution was applied and equality literals might have been swapped. <Lit> is just needed to check whether the unifiable literals are complementary. ***************************************************************/ { LIST Result, Unifiers, LitScan; LITERAL NextLit; Result = list_Nil(); for ( ; !list_Empty(IndexList); IndexList = list_Cdr(IndexList)) { Unifiers = st_GetUnifier(cont_LeftContext(), sharing_Index(list_Car(IndexList)), cont_RightContext(), Atom); for ( ; !list_Empty(Unifiers); Unifiers = list_Pop(Unifiers)) { if (!term_IsVariable(list_Car(Unifiers))) { for (LitScan = sharing_NAtomDataList(list_Car(Unifiers)); !list_Empty(LitScan); LitScan = list_Cdr(LitScan)) { NextLit = list_Car(LitScan); if (clause_LiteralsAreComplementary(Lit, NextLit) && (!UnitsOnly || clause_Length(clause_LiteralOwningClause(NextLit))==1)) /* The partner literals must have complementary sign and if <UnitsOnly> == TRUE they must be from unit clauses. */ Result = list_Cons(NextLit, Result); } } } } return Result; }
BOOL rpos_ContEqual(CONTEXT GlobalC1, CONTEXT TermC1, TERM T1, CONTEXT GlobalC2, CONTEXT TermC2, TERM T2) /************************************************************** INPUT: Two contexts and two terms. RETURNS: TRUE, if <T1> is equal to <T2> and FALSE otherwise. EFFECT: Variable bindings are considered. ASSUMPTION: All index variables of <T1> and <T2> are bound in <GlobalC1> and <GlobalCt2>, respectively ***************************************************************/ { LIST l1, l2; T1 = cont_Deref(GlobalC1, &TermC1, T1); T2 = cont_Deref(GlobalC2, &TermC2, 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(GlobalC1, TermC1, T1, GlobalC2, TermC2, 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(GlobalC1, TermC1,list_Car(l1), GlobalC2, TermC2,list_Car(l2)); l1 = list_Cdr(l1), l2 = list_Cdr(l2)); /* empty body */ return list_Empty(l1); /* All arguments were equal */ } } }
void hsh_Check(HASH H) /************************************************************** INPUT: A hasharray EFFECT: Traverses the whole array and the lists to find dangling pointers. ***************************************************************/ { LIST Scan, Scan2, Pair; NAT i; unsigned long Key; for (i = 0; i < hsh__SIZE; i++) { for (Scan = H[i]; !list_Empty(Scan); Scan = list_Cdr(Scan)) { Pair = list_Car(Scan); Key = (unsigned long)list_PairFirst(Pair); for (Scan2 = list_PairSecond(Pair); !list_Empty(Scan2); Scan2 = list_Cdr(Scan2)) { POINTER Value; char Z; Value = list_Car(Scan2); Z = * ((char*) Value); } } } }
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; }
LIST list_PointerDeleteElement(LIST List, POINTER Element) /************************************************************** INPUT: A list and an element pointer RETURNS: The list where Element is deleted from List with respect to pointer equality. EFFECTS: If <List> contains <Element> with respect to pointer equality, <Element> is deleted from <List>. This function needs time O(n), where <n> is the length of the list. CAUTION: Destructive. Be careful, the first element of a list cannot be changed destructively by call by reference. ***************************************************************/ { LIST Scan1,Scan2; while (!list_Empty(List) && Element == list_Car(List)) { Scan1 = list_Cdr(List); list_Free(List); List = Scan1; } if (list_Empty(List)) return list_Nil(); Scan2 = List; Scan1 = list_Cdr(List); while (!list_Empty(Scan1)) { if (Element == list_Car(Scan1)) { list_Rplacd(Scan2, list_Cdr(Scan1)); list_Free(Scan1); Scan1 = list_Cdr(Scan2); } else { Scan2 = Scan1; Scan1 = list_Cdr(Scan1); } } return List; }
static LIST inf_GetURPartnerLits(TERM Atom, LITERAL Lit, BOOL Unit, SHARED_INDEX Index) /************************************************************** INPUT: An atom, a literal, a boolean flag and a SHARED_INDEX. RETURNS: A list of literals with sign complementary to <Lit> that are unifiable with <Atom>. If <Unit> is true, only literals from unit clauses are returned, if <Unit> is false, only literals from non-unit clauses are returned. EFFECT: <Atom> is a copy of <Lit>'s atom where some substitution was applied and equality literals might have been swapped. <Lit> is just needed to check whether the unifiable literals are complementary. ***************************************************************/ { LIST Result, Unifiers, LitScan; LITERAL PLit; int length; Result = list_Nil(); Unifiers = st_GetUnifier(cont_LeftContext(), sharing_Index(Index), cont_RightContext(), Atom); for ( ; !list_Empty(Unifiers); Unifiers = list_Pop(Unifiers)) { if (!term_IsVariable(list_Car(Unifiers))) { for (LitScan = sharing_NAtomDataList(list_Car(Unifiers)); !list_Empty(LitScan); LitScan = list_Cdr(LitScan)) { PLit = list_Car(LitScan); length = clause_Length(clause_LiteralOwningClause(PLit)); if (clause_LiteralsAreComplementary(Lit, PLit) && ((Unit && length==1) || (!Unit && length!=1))) /* The partner literals must have complementary sign and if <Unit> == TRUE they must be from unit clauses, if <Unit> == FALSE they must be from non-unit clauses. */ Result = list_Cons(PLit, Result); } } } return Result; }
static ord_RESULT rpos_ContMulGreaterEqual(CONTEXT C1, TERM T1, CONTEXT C2, TERM T2) /************************************************************** INPUT: Two contexts and two terms with equal top symbols and multiset 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. ***************************************************************/ { LIST l1, l2; /* Don't apply bindings at top level, since that happened */ /* in rpos_ContGreaterEqual. */ l1 = rpos_ContMultisetDifference(C1, T1, C2, T2); if (list_Empty(l1)) /* If |M| = |N| and M-N = {} then N-M = {} */ return ord_Equal(); /* Terms are equal */ else { LIST scan; BOOL greater; l2 = rpos_ContMultisetDifference(C2, T2, C1, T1); for (greater = TRUE; !list_Empty(l2) && greater; l2 = list_Pop(l2)) { for (scan = l1, greater = FALSE; !list_Empty(scan) && !greater; scan = list_Cdr(scan)) greater = rpos_ContGreater(C1, list_Car(scan), C2, list_Car(l2)); } list_Delete(l1); /* l2 was freed in the outer for loop */ if (greater) return ord_GreaterThan(); else return ord_Uncomparable(); } }
static LIST rpos_ContMultisetDifference(CONTEXT GlobalC1, CONTEXT TermC1, TERM T1, CONTEXT GlobalC2, CONTEXT TermC2, TERM T2) /************************************************************** INPUT: Four contexts and two terms. RETURNS: The multiset difference between the arguments of both terms with respect to rpos_ContEqual. EFFECT: Variable bindings are considered. ASSUMPTION: All index variables of <T1> and <T2> are bound in <GlobalC1> and <GlobalCt2>, respectively ***************************************************************/ { 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(GlobalC1, TermC1, list_Car(scan1), GlobalC2, TermC2, 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 */ }
void graph_DeleteDuplicateEdges(GRAPH Graph) /************************************************************** INPUT: A graph. RETURNS: Nothing. EFFECT: Removes duplicate edges between all nodes. ***************************************************************/ { LIST scan; for (scan = graph_Nodes(Graph); !list_Empty(scan); scan = list_Cdr(scan)) { GRAPHNODE n = list_Car(scan); n->neighbors = list_PointerDeleteDuplicates(n->neighbors); } }
LIST list_NListTimes(LIST List1, LIST List2) /************************************************************** INPUT: Two lists of lists. RETURNS: The list of combinations of element lists. CAUTION: Destroys List1 and List2. ***************************************************************/ { LIST Result, Scan1, Scan2; Result = list_Nil(); if (!list_Empty(List2)) { for (Scan1=List1; !list_Empty(Scan1); Scan1=list_Cdr(Scan1)) for (Scan2=List2; !list_Empty(Scan2); Scan2=list_Cdr(Scan2)) Result = list_Cons(list_Append(((LIST)list_Car(Scan1)), list_Copy((LIST)list_Car(Scan2))), Result); } list_DeleteWithElement(List1, (void (*)(POINTER))list_Delete); list_DeleteWithElement(List2, (void (*)(POINTER))list_Delete); return Result; }
static BOOL ana_BidirectionalDistributivity(LIST SymbolPairs) /************************************************************** INPUT: A list of symbol pairs defining distributivity. RETURNS: TRUE, if the list contains two pairs (s1, s2) and (s2, s1) FALSE otherwise. EFFECT: This function is used to detect symbols that are distributive in both directions, logical OR and AND for example. ***************************************************************/ { LIST scan, actPair, nextPair; for ( ; !list_Empty(SymbolPairs); SymbolPairs = list_Cdr(SymbolPairs)) { actPair = list_Car(SymbolPairs); /* If actPair = (s1, s2), check whether there's a pair (s2, s1) in list */ for (scan = list_Cdr(SymbolPairs); !list_Empty(scan); scan = list_Cdr(scan)) { nextPair = list_Car(scan); if (symbol_Equal((SYMBOL)list_PairFirst(actPair),(SYMBOL)list_PairSecond(nextPair)) && symbol_Equal((SYMBOL)list_PairSecond(actPair),(SYMBOL)list_PairFirst(nextPair))) return TRUE; } } return FALSE; }
void list_Apply(void (*Function)(POINTER), LIST List) /************************************************************** INPUT: A non-resulting function and a list. SUMMARY: Apply the function to all members of the list. The function needs time O(n*f), where <n> is the length of the list and <f> is the time for a call of the element function. ***************************************************************/ { while (!list_Empty(List)) { Function(list_Car(List)); List = list_Cdr(List); } }
LIST list_DeleteElementIf(LIST List, BOOL (*Test)(POINTER)) /************************************************************** INPUT: A list and a test for elements. RETURNS: The list where an element is deleted if <Test> on it succeeds. CAUTION: Destructive. Be careful, the first element of a list cannot be changed destructively by call by reference. ***************************************************************/ { LIST Scan1,Scan2; while (!list_Empty(List) && Test(list_Car(List))) { Scan1 = list_Cdr(List); list_Free(List); List = Scan1; } if (list_Empty(List)) return list_Nil(); Scan2 = List; Scan1 = list_Cdr(List); while (!list_Empty(Scan1)) { if (Test(list_Car(Scan1))) { list_Rplacd(Scan2, list_Cdr(Scan1)); list_Free(Scan1); Scan1 = list_Cdr(Scan2); } else { Scan2 = Scan1; Scan1 = list_Cdr(Scan1); } } return List; }
LIST list_PointerDeleteOneElement(LIST List, POINTER Element) /************************************************************** INPUT: A list and an element pointer. RETURNS: The list where one occurrence of Element is deleted from List with respect to pointer equality. EFFECTS: If List contains Element with respect to pointer equality, Element is deleted from List. CAUTION: Destructive. Be careful, the first element of a list cannot be changed destructively by call by reference. ***************************************************************/ { LIST Scan1,Scan2; if (list_Empty(List)) return List; else { if (Element == list_Car(List)) return list_Pop(List); } Scan2 = List; Scan1 = list_Cdr(List); while (!list_Empty(Scan1)) { if (Element == list_Car(Scan1)) { list_Rplacd(Scan2, list_Cdr(Scan1)); list_Free(Scan1); Scan1 = list_Cdr(Scan2); return List; } else { Scan2 = Scan1; Scan1 = list_Cdr(Scan1); } } return List; }
LITPTR litptr_Create(LIST Indexlist, LIST Termsymblist) /********************************************************** INPUT: A list of indexes and a list of terms, i.e. a list of integers. RETURNS: A LITPTR structure is created. MEMORY: The integers in the created structure are the integers in indexList, no copies. ***********************************************************/ { LITPTR lit_ptr; LIST Scan,varlist; CLITERAL literal; int literal_index,n,k; n = list_Length(Indexlist); lit_ptr = (LITPTR)memory_Malloc(sizeof(LITPTR_NODE)); litptr_SetLength(lit_ptr, n); if (n > 0) { lit_ptr->litptr = (CLITERAL *)memory_Malloc(n * sizeof(CLITERAL)); k = 0; for (Scan = Indexlist; !list_Empty(Scan); Scan = list_Cdr(Scan)) { literal_index = (int)list_Car(Scan); varlist = (LIST)list_Car(Termsymblist); Termsymblist = list_Cdr(Termsymblist); literal = literal_Create(FALSE,literal_index,varlist); litptr_SetLiteral(lit_ptr, k, literal); k++; } } else lit_ptr->litptr = NULL; return lit_ptr; }
LIST list_NPointerDifference(LIST List1, LIST List2) /************************************************************** INPUT: Two lists. RETURNS: The list List1-List2. CAUTION: Destructive on List1. ***************************************************************/ { LIST Scan; if (!list_Empty(List1)) { for (Scan=List2; !list_Empty(Scan); Scan=list_Cdr(Scan)) List1 = list_PointerDeleteElement(List1, list_Car(Scan)); } return List1; }
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; }
void tab_GetEarliestEmptyClauses(TABLEAU T, LIST* L) /************************************************************** INPUT : A tableau, a list of clauses by reference RETURNS: Nothing. EFFECTS: For each leaf node, adds empty clauses in leaf nodes to <L>. If the leaf node contains only one empty clause, it is added to <L> anyway. If the leaf node contains more than one empty clause, the earliest derived empty clause is added to <L>. ***************************************************************/ { CLAUSE FirstEmpty; LIST Scan; if (tab_IsEmpty(T)) return; if (tab_IsLeaf(T)) { FirstEmpty = clause_Null(); for (Scan = tab_Clauses(T); !list_Empty(Scan); Scan = list_Cdr(Scan)) { if (clause_IsEmptyClause(list_Car(Scan))) { if (FirstEmpty == clause_Null()) FirstEmpty = list_Car(Scan); else if (clause_Number(FirstEmpty) > clause_Number(list_Car(Scan))) FirstEmpty = list_Car(Scan); } } if (FirstEmpty != clause_Null()) (*L) = list_Cons(FirstEmpty, *L); } tab_GetEarliestEmptyClauses(tab_LeftBranch(T), L); tab_GetEarliestEmptyClauses(tab_RightBranch(T), L); }
POINTER list_NthElement(LIST List, NAT Number) /************************************************************** INPUT: A List and a natural number. RETURNS: The <Number>th element of the list, NULL otherwise. EFFECT: The function needs time O(Number). ***************************************************************/ { while (!list_Empty(List) && --Number > 0) List = list_Cdr(List); if (list_Empty(List)) return NULL; else return list_Car(List); }
static BOOL tab_HasEmptyClause(TABLEAU T) /************************************************************** INPUT: A tableau RETURNS: TRUE iff an empty clause is among the clauses on this level ***************************************************************/ { LIST Scan; for (Scan = tab_Clauses(T); !list_Empty(Scan); Scan = list_Cdr(Scan)) if (clause_IsEmptyClause(list_Car(Scan))) return TRUE; return FALSE; }
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; }
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()); }
LIST list_DeleteOneElement(LIST List, POINTER Element, BOOL (*Test)(POINTER, POINTER)) /************************************************************** INPUT: A list, an element pointer and an equality test for elements. RETURNS: The list where at most one element was deleted from <List> if the Test between <Element> and the element succeeds. EFFECT: The function needs time O(n*t) in the worst case, and time O(t) in the best case, where <n> is the length of the list and t is the time for a call of the test function. CAUTION: Destructive. Be careful, the first element of a list cannot be changed destructively by call by reference. The memory of the deleted element is not freed. ***************************************************************/ { LIST scan1, scan2; if (list_Empty(List)) return List; else { if (Test(Element, list_Car(List))) return list_Pop(List); } for (scan2 = List, scan1 = list_Cdr(List); !list_Empty(scan1); scan2 = scan1, scan1 = list_Cdr(scan1)) { if (Test(Element, list_Car(scan1))) { list_Rplacd(scan2, list_Cdr(scan1)); list_Free(scan1); scan1 = list_Cdr(scan2); return List; } } return List; }
LIST hsh_GetAllEntries(HASH H) /************************************************************** INPUT: A hasharray RETURNS: A new list of all data items stored in the hasharray ***************************************************************/ { LIST Scan, Result; NAT i; Result = list_Nil(); for (i = 0; i < hsh__SIZE; i++) { for (Scan = H[i]; !list_Empty(Scan); Scan = list_Cdr(Scan)) Result = list_Nconc(Result, list_Copy(list_PairSecond(list_Car(Scan)))); } return Result; }
LIST list_NDifference(LIST List1, LIST List2, BOOL (*Test)(POINTER, POINTER)) /************************************************************** INPUT: Two lists and an equality test for elements. RETURNS: The list List1-List2 wrt. <Test>. CAUTION: Destructive on List1. ***************************************************************/ { LIST Scan; if (!list_Empty(List1)) { for (Scan=List2; !list_Empty(Scan); Scan=list_Cdr(Scan)) List1 = list_DeleteElement(List1, list_Car(Scan), Test); } return List1; }