Esempio n. 1
0
static void dp_FPrintDFGProof(LIST Clauses, const char *FilePrefix,
			      FLAGSTORE Flags, PRECEDENCE Precedence)
/*********************************************************
  INPUT:   A list of clauses representing a proof, a
           string indicating a file name prefix, a flag
	   store and a precedence.
  RETURNS: void.
  EFFECT:  Outputs the proof in DFG proof format to
           <FilePrefix>.prf
**********************************************************/
{
  FILE   *Output;
  CLAUSE Clause;
  LIST   AxClauses,ConClauses,ProofClauses,Scan;
  char   *name;

  AxClauses = ConClauses = ProofClauses = list_Nil();
  
  name = memory_Malloc(sizeof(char)*(strlen(FilePrefix)+5));
  sprintf(name,"%s.prf", FilePrefix);

  Output = misc_OpenFile(name,"w");

  fputs("begin_problem(Unknown).\n\n", Output);

  fputs("list_of_descriptions.\n", Output);
  fputs("name({*", Output);
  fputs(FilePrefix, Output);
  fputs("*}).\n", Output);
  fputs("author({*SPASS ", Output);
  fputs(vrs_VERSION, Output);
  fputs("*}).\n", Output);
  fputs("status(unsatisfiable).\n", Output);
  fputs("description({*File generated by SPASS containing a proof.*}).\n", Output);
  fputs("end_of_list.\n\n", Output);

  fputs("list_of_symbols.\n", Output);
  symbol_FPrintDFGSignature(Output);
  fputs("end_of_list.\n\n", Output);

  for (Scan=Clauses;!list_Empty(Scan);Scan=list_Cdr(Scan)) {
    Clause = (CLAUSE)list_Car(Scan);
    if (clause_IsFromInput(Clause)) {
      if (clause_GetFlag(Clause, CONCLAUSE))
	ConClauses = list_Cons(Clause, ConClauses);
      else
	AxClauses  = list_Cons(Clause, AxClauses);
    }
    else
      ProofClauses  = list_Cons(Clause, ProofClauses);
  }

  ConClauses   = list_NReverse(ConClauses);
  AxClauses    = list_NReverse(AxClauses);
  ProofClauses = list_NReverse(ProofClauses);
  
  clause_FPrintCnfDFG(Output, FALSE, AxClauses, ConClauses, Flags, Precedence);
  fputs("\nlist_of_proof(SPASS).\n", Output);
  for (Scan=ProofClauses; !list_Empty(Scan); Scan=list_Cdr(Scan)) {
    clause_FPrintDFGStep(Output,list_Car(Scan),TRUE);
  }
  fputs("end_of_list.\n\n", Output);

  fputs("end_problem.\n\n", Output);

  misc_CloseFile(Output, name);
  fputs("\nDFG Proof printed to: ", stdout);
  puts(name);

  list_Delete(ConClauses);
  list_Delete(AxClauses);
  list_Delete(ProofClauses);
  memory_Free(name, sizeof(char)*(strlen(FilePrefix)+5));
}
Esempio n. 2
0
LIST split_Backtrack(PROOFSEARCH PS, CLAUSE EmptyClause, CLAUSE* SplitClause) 
/**************************************************************
  INPUT:   A proofsearch object, an empty clause and a pointer to a clause
           used as return value.
  RETURNS: A list of clauses deleted in the backtracked split levels.
           <*SplitClause> is set to the split clause for the right branch
	   of the splitting step, or NULL, if the tableau is finished.
  EFFECT:  Backtracks the top of the split stack wrt the empty clause's level
***************************************************************/
{
  SPLIT ActBacktrackSplit;
  LIST  RecoverList, Scan;
  int   Backtracklevel;

  ActBacktrackSplit = (SPLIT)NULL;
  RecoverList       = split_RemoveUnnecessarySplits(PS, EmptyClause);
  Backtracklevel    = clause_SplitLevel(EmptyClause);
  *SplitClause      = NULL;

  /* Backtrack all split levels bigger than the level of the empty clause */
  while (!prfs_SplitStackEmpty(PS) && (prfs_ValidLevel(PS) > Backtracklevel)) {
    ActBacktrackSplit = prfs_SplitStackTop(PS);
    prfs_SplitStackPop(PS);
    if (prfs_SplitFatherClause(ActBacktrackSplit) != (CLAUSE)NULL) {
      RecoverList = list_Cons(prfs_SplitFatherClause(ActBacktrackSplit),
			      RecoverList);
      prfs_SplitSetFatherClause(ActBacktrackSplit, NULL);
    }
    RecoverList = list_Nconc(prfs_SplitDeletedClauses(ActBacktrackSplit),
			     RecoverList);
    clause_DeleteClauseList(prfs_SplitBlockedClauses(ActBacktrackSplit));
    prfs_SplitFree(ActBacktrackSplit);
    prfs_DecValidLevel(PS);
  }
  
  /* Backtrack further for all right branches on top of the stack */
  while (!prfs_SplitStackEmpty(PS) &&
	 list_Empty(prfs_SplitBlockedClauses(prfs_SplitStackTop(PS)))) {
    ActBacktrackSplit = prfs_SplitStackTop(PS);
    prfs_SplitStackPop(PS);
    if (prfs_SplitFatherClause(ActBacktrackSplit) != (CLAUSE)NULL)
      RecoverList = list_Cons(prfs_SplitFatherClause(ActBacktrackSplit),
			      RecoverList);
    RecoverList = list_Nconc(prfs_SplitDeletedClauses(ActBacktrackSplit),
			     RecoverList);
    prfs_SplitFree(ActBacktrackSplit);
    prfs_DecValidLevel(PS);
  }
  
  if (!prfs_SplitStackEmpty(PS)) {
    /* Enter the right branch of the splitting step */
    int SplitMinus1;
    LIST RightClauses;

    SplitMinus1       = prfs_ValidLevel(PS) - 1;
    ActBacktrackSplit = prfs_SplitStackTop(PS);

    RecoverList       = list_Nconc(prfs_SplitDeletedClauses(ActBacktrackSplit),
				   RecoverList);
    prfs_SplitSetDeletedClauses(ActBacktrackSplit, list_Nil());    
    RecoverList       = split_DeleteInvalidClausesFromList(PS, SplitMinus1,
							   RecoverList);

    RightClauses = prfs_SplitBlockedClauses(ActBacktrackSplit);
    prfs_SplitSetBlockedClauses(ActBacktrackSplit, list_Nil());    
    for (Scan = RightClauses; !list_Empty(Scan); Scan = list_Cdr(Scan)) {
      if (clause_Number(list_Car(Scan)) == 0) {
	/* Found the right clause, the negation clauses have number -1. */
#ifdef CHECK
	if (*SplitClause != NULL) {
	  misc_StartErrorReport();
	  misc_ErrorReport("\n In split_Backtrack:");
	  misc_ErrorReport(" Found two blocked clauses ");
	  misc_ErrorReport("\n with clause number 0 (this marks the clause ");
	  misc_ErrorReport("\n for the right branch of the tableau).");
	  misc_FinishErrorReport();
	}
#endif
	*SplitClause = list_Car(Scan);
      }
      
      clause_NewNumber((CLAUSE) list_Car(Scan));
      clause_AddParentClause((CLAUSE) list_Car(Scan), clause_Number(EmptyClause));
      clause_AddParentLiteral((CLAUSE) list_Car(Scan), 0);  /* dummy literal */
    }

#ifdef CHECK
    if (*SplitClause == NULL) {
      misc_StartErrorReport();
      misc_ErrorReport("\n In split_Backtrack: Didn´t find a blocked clause");
      misc_ErrorReport("\n with clause number 0. (this marks the clause ");
      misc_ErrorReport("\n for the right branch of the tableau).");
      misc_FinishErrorReport();
    }
#endif
    
    RecoverList = list_Nconc(RightClauses, RecoverList);

    /* Then, delete clauses from current level (Hack) */
    prfs_DecValidLevel(PS);
    prfs_MoveInvalidClausesDocProof(PS);
    split_DeleteInvalidClausesFromStack(PS);
    prfs_IncValidLevel(PS);
  } else {
    /* Don't delete clauses from current level (split is top level) */
    prfs_MoveInvalidClausesDocProof(PS);
    for (Scan = RecoverList; !list_Empty(Scan); Scan = list_Cdr(Scan))
      prfs_InsertDocProofClause(PS, list_Car(Scan));
    list_Delete(RecoverList);
    RecoverList = list_Nil();
  }
  prfs_SetLastBacktrackLevel(PS, prfs_ValidLevel(PS));

  return RecoverList;
}
Esempio n. 3
0
LIST dp_PrintProof(PROOFSEARCH Search, LIST Clauses, const char *FilePrefix)
/*********************************************************
  INPUT:   A proofsearch object, a list of empty clauses and
           the prefix of the output file name.
  RETURNS: The list of clauses required for the proof.
  MEMORY:  The returned list must be freed.
  EFFECT:  The proof is printed both to standard output and
           to the file <FilePrefix>.prf.
**********************************************************/
{
  LIST ProofClauses,Scan,EmptyClauses,AllClauses, ReducedProof;
  LIST Missing, Incomplete, SplitClauses;

  FLAGSTORE Flags;

  Flags = prfs_Store(Search);

  Missing = pcheck_ConvertParentsInSPASSProof(Search, Clauses);
  
  if (!list_Empty(Missing)) {
    puts("\nNOTE: clauses with following numbers have not been found:");
    for (; !list_Empty(Missing); Missing = list_Pop(Missing))
      printf("%d ", (int)list_Car(Missing)); 
    putchar('\n');
  }

  EmptyClauses = list_Copy(Clauses); 
  ProofClauses = list_Nil();
  AllClauses   = list_Nconc(list_Copy(prfs_DocProofClauses(Search)),
			    list_Nconc(list_Copy(prfs_UsableClauses(Search)),
				       list_Copy(prfs_WorkedOffClauses(Search))));

  /*
   *  collect proof clauses by noodling upward in the 
   *  proof tree, starting from <EmptyClauses>.
   *  Before, add all splitting clauses to avoid gaps in split tree 
   */

  SplitClauses = list_Nil();
  for (Scan = AllClauses; !list_Empty(Scan); Scan = list_Cdr(Scan)) 
    if (clause_IsFromSplitting(list_Car(Scan))) 
      SplitClauses = list_Cons(list_Car(Scan), SplitClauses);

  /* mark all needed clauses */
  pcheck_ClauseListRemoveFlag(EmptyClauses, MARKED);
  pcheck_ClauseListRemoveFlag(AllClauses, MARKED);
  pcheck_MarkRecursive(EmptyClauses);
  pcheck_MarkRecursive(SplitClauses);
  
  /* collect all marked clauses */
  ProofClauses = list_Nil();
  for (Scan = AllClauses; !list_Empty(Scan); Scan = list_Cdr(Scan)) {
    if (clause_GetFlag(list_Car(Scan), MARKED))
      ProofClauses = list_Cons(list_Car(Scan), ProofClauses); 
  }

  /* build reduced proof  */
  ProofClauses = list_Nconc(ProofClauses, list_Copy(EmptyClauses));
  ProofClauses = pcheck_ClauseNumberMergeSort(ProofClauses);
  ReducedProof = pcheck_ReduceSPASSProof(ProofClauses); 

  dp_SetProofDepth(pcheck_SeqProofDepth(ReducedProof));
  
  pcheck_ParentPointersToParentNumbers(AllClauses);
  pcheck_ParentPointersToParentNumbers(Clauses);

  /* check reduced proof for clauses whose parents have been marked as
     incomplete (HIDDEN flag) by ConvertParentsInSPASSProof    */

  Incomplete = list_Nil();
  for (Scan = ReducedProof; !list_Empty(Scan); Scan = list_Cdr(Scan)) {
    if (clause_GetFlag(list_Car(Scan), HIDDEN))
      Incomplete = list_Cons(list_Car(Scan), Incomplete);
  }
  if (!list_Empty(Incomplete)) {
    puts("NOTE: Following clauses in reduced proof have incomplete parent sets:");
    for (Scan = Incomplete; !list_Empty(Scan); Scan = list_Cdr(Scan))
      printf("%d ", clause_Number(list_Car(Scan)));
    putchar('\n');
  }

  printf("\n\nHere is a proof with depth %d, length %d :\n",
	 dp_ProofDepth(), list_Length(ReducedProof));
  clause_ListPrint(ReducedProof);

  if (flag_GetFlagValue(Flags, flag_FPDFGPROOF))
    dp_FPrintDFGProof(ReducedProof, FilePrefix, Flags, prfs_Precedence(Search));

  fflush(stdout);

  list_Delete(EmptyClauses);
  list_Delete(AllClauses);
  list_Delete(ProofClauses);
  list_Delete(SplitClauses);
  list_Delete(Incomplete); 

  return ReducedProof;
}
Esempio n. 4
0
static LIST split_RemoveUnnecessarySplits(PROOFSEARCH PS, CLAUSE EmptyClause)
/**************************************************************
  INPUT:   An empty clause and a proof search object
  EFFECT:  Removes all splits up to the last backtrack level
           that were not necessary to derive the empty clause.
  RETURNS: A list of recovered clauses.
***************************************************************/
{
  LIST Scan;
  LIST Recover, New;
  LIST Deleted;
  LIST ScanStack;

  int SplitLevel;
  int LastBacktrackLevel;
  SPLIT Split,ScanSplit;

  Scan               = prfs_SplitStack(PS);
  SplitLevel         = prfs_ValidLevel(PS);
  LastBacktrackLevel = prfs_LastBacktrackLevel(PS);
  Recover            = list_Nil();

  while (SplitLevel > LastBacktrackLevel) {
    if (prfs_SplitIsUnused(list_Car(Scan)) &&
	!clause_DependsOnSplitLevel(EmptyClause, SplitLevel)) {
      New   = list_Nil();
      Split = list_Car(Scan);

      /*printf("\n\t Removed: %d",prfs_SplitSplitLevel(Split));*/
      
      clause_DeleteClauseList(prfs_SplitBlockedClauses(Split));
      prfs_SplitSetBlockedClauses(Split, list_Nil());
      
      Recover = list_Nconc(prfs_SplitDeletedClauses(Split), Recover);
      prfs_SplitSetDeletedClauses(Split, list_Nil());
      
      if (prfs_SplitFatherClause(Split) != (CLAUSE)NULL) {
	Recover = list_Cons(prfs_SplitFatherClause(Split),Recover);
	prfs_SplitSetFatherClause(Split,NULL);
      }
      Recover = split_DeleteClausesDependingOnLevelFromList(PS, Recover, SplitLevel, &New);
      
      ScanStack = prfs_SplitStack(PS);
      while (!list_StackEmpty(ScanStack) &&  
	     prfs_SplitSplitLevel((ScanSplit = (SPLIT)list_Car(ScanStack))) > LastBacktrackLevel) {
	Deleted = prfs_SplitDeletedClauses(ScanSplit);
	prfs_SplitSetDeletedClauses(ScanSplit, list_Nil()); /* IMPORTANT!, see next line */
	Deleted = split_DeleteClausesDependingOnLevelFromList(PS, Deleted, SplitLevel, &New);
	prfs_SplitSetDeletedClauses(ScanSplit, Deleted);
	ScanStack = list_Cdr(ScanStack);
      }
      
      while (!list_Empty(New)) {
	Deleted = list_Nil();
	Recover = list_Nconc(split_DeleteClausesDependingOnLevelFromList(PS, New, SplitLevel, &Deleted),
			     Recover);
	New     = Deleted;
      }
      Recover = list_Nconc(Recover, 
		    split_DeleteClausesDependingOnLevelFromSet(PS, prfs_UsableClauses(PS), SplitLevel));
      Recover = list_Nconc(Recover,
			   split_DeleteClausesDependingOnLevelFromSet(PS, prfs_WorkedOffClauses(PS), SplitLevel));
      
      prfs_SplitSetUsed(Split);
    }
    
    SplitLevel--;
    Scan = list_Cdr(Scan);
  }
  return Recover;
}
Esempio n. 5
0
int main(int argc, const char* argv[])
{
  LIST       Clauses,Axioms,Conjectures,Sorts,Scan, 
             UserPrecedence,UserSelection,ClAxRelation;
  FILE       *Input;
  CLAUSE     Clause;
  const char *Filename;
  FLAGSTORE  Flags;
  PRECEDENCE Precedence;
  BOOL       HasPlainClauses;
  DFGDESCRIPTION Description;

  memory_Init(memory__UNLIMITED);
  atexit(memory_FreeAllMem);
  symbol_Init(TRUE);
  stack_Init();
  term_Init();
  flag_Init(flag_SPASS);
  cmdlne_Init();

  Flags = flag_CreateStore();
  flag_InitStoreByDefaults(Flags);
  Precedence = symbol_CreatePrecedence();
  Description = desc_Create();

  fol_Init(TRUE, Precedence);
  eml_Init(Precedence);
  clause_Init();

  if (argc < 2 || !cmdlne_Read(argc, argv)) {
    fputs("\n\t          dfg2ascii Version ", stdout);
    fputs(DFG2ASCII__VERSION, stdout);
    puts("\n\t       Usage: dfg2ascii <input-file>\n");
    return EXIT_FAILURE;
  }
  
  if (!cmdlne_SetFlags(Flags))
    return EXIT_FAILURE;

  Axioms         = list_Nil();
  Conjectures    = list_Nil();
  Sorts          = list_Nil();
  UserPrecedence = list_Nil();
  UserSelection  = list_Nil();
  ClAxRelation   = list_Nil();

  Filename = cmdlne_GetInputFile();
  Input    = misc_OpenFile(Filename,"r");
  Clauses  = dfg_DFGParser(Input, Flags, Precedence, Description, &Axioms, &Conjectures,
			   &Sorts, &UserPrecedence, &UserSelection, &ClAxRelation,
                           &HasPlainClauses);
  misc_CloseFile(Input,Filename);

  Axioms = list_Nconc(Axioms, Sorts);

  if (!list_Empty(Axioms) || !list_Empty(Conjectures)) {
    puts("\n\n\t\t Axioms:\n");
    if (list_Empty(Axioms))
      puts("None.\n");
    else
      for (Scan=Axioms; !list_Empty(Scan);Scan=list_Cdr(Scan)) {
	if (list_PairFirst(list_Car(Scan)) != NULL)
	  printf("%s:\n",(char *)list_PairFirst(list_Car(Scan)));
	fol_PrettyPrintDFG(list_PairSecond(list_Car(Scan)));
	puts("\n");
      }
    puts("\n\n\t\t Conjectures:\n");
    if (list_Empty(Conjectures))
      puts("None.\n");
    else
      for (Scan=Conjectures; !list_Empty(Scan);Scan=list_Cdr(Scan)) {
	if (list_PairFirst(list_Car(Scan)) != NULL)
	  printf("%s:\n",(char *)list_PairFirst(list_Car(Scan)));
	fol_PrettyPrintDFG(list_PairSecond(list_Car(Scan)));
	puts("\n");
      }
  }
  else {
    BOOL SetExist;
    LIST ClauseScan;

    /* Before we sort the clauses, we need to make sure that they have been
       assigned a weight.
    */
    for (ClauseScan = Clauses; !list_Empty(ClauseScan); ClauseScan = list_Cdr(ClauseScan)) {
      clause_UpdateWeight((CLAUSE) list_Car(ClauseScan), Flags);
    }
    
    Clauses   = clause_ListSortWeighed(Clauses);
    clause_SetCounter(1);
    for (Scan = Clauses;!list_Empty(Scan);Scan=list_Cdr(Scan)) {
      Clause = (CLAUSE)list_Car(Scan);
      clause_SetSortConstraint(Clause, FALSE, Flags, Precedence);
      clause_NewNumber(Clause);
      clause_OrientAndReInit(Clause, Flags, Precedence);
    }
    puts("\n\n\t\t Axiom Clauses:\n");
    SetExist = FALSE;
    for (Scan = Clauses;!list_Empty(Scan);Scan=list_Cdr(Scan)) {
      Clause = (CLAUSE)list_Car(Scan);
      if (!clause_GetFlag(Clause,CONCLAUSE)) {
	SetExist = TRUE;
	clause_Print(Clause);
	putchar('\n');
      }
    }
    if (SetExist)
      SetExist = FALSE;
    else
      puts("None.\n");
    puts("\n\n\t\t Conjecture Clauses:\n");
    for (Scan = Clauses;!list_Empty(Scan);Scan=list_Cdr(Scan)) {
      Clause = (CLAUSE)list_Car(Scan);
      if (clause_GetFlag(Clause,CONCLAUSE)) {
	SetExist = TRUE;
	clause_Print(Clause);
	putchar('\n');
      }
    }
    if (SetExist)
      SetExist = FALSE;
    else
      puts("None.\n");
  }

  clause_DeleteClauseList(Clauses);
  dfg_StripLabelsFromList(Axioms);
  dfg_StripLabelsFromList(Conjectures);
  term_DeleteTermList(Axioms);
  term_DeleteTermList(Conjectures);

  eml_Free();
  flag_DeleteStore(Flags);
  symbol_DeletePrecedence(Precedence);
  list_Delete(UserPrecedence);
  list_Delete(UserSelection);
  dfg_DeleteClAxRelation(ClAxRelation);
  desc_Delete(Description);
  
  /*symbol_Dump();*/
  cmdlne_Free();
  fol_Free();
  symbol_FreeAllSymbols();
#ifdef CHECK
  memory_Print();
#endif
  return 0;
}
Esempio n. 6
0
LIST list_MergeSort (LIST L, BOOL (*Test) (POINTER, POINTER)) 
/**************************************************************
  INPUT:   A list, and an ordering function.
  RETURNS: The list sorted with respect to the ordering function.
  EFFECT:  The function needs time O((n log n) * t), where 
	   <n> is the length of the input list and <t> is the
	   execution time of the ordering function.
***************************************************************/
{
  LIST Result; 
#ifdef CHECK
  NAT  originallength;

  originallength = list_Length(L);
#endif

  /* Only sort if list has more than one element */
  if (!list_Empty(L) && !list_Empty(list_Cdr(L))) {
    LIST  lowerhalf;
    LIST  greaterhalf;

    LIST *lowerhalfptr;
    LIST *greaterhalfptr;

    lowerhalfptr = &lowerhalf;
    greaterhalfptr = &greaterhalf;

    list_Split(L, lowerhalfptr, greaterhalfptr);

#ifdef CHECK
    if((list_Length(lowerhalf) + list_Length(greaterhalf)) 
       != originallength) {
      /* output an error message and exit */
      misc_StartErrorReport();
      misc_ErrorReport("\n In list_MergeSort: Split lists' total sizes");
      misc_ErrorReport("\n don't match original list's size.");
      misc_FinishErrorReport();
    }
#endif

    lowerhalf   = list_MergeSort(lowerhalf, Test);

    greaterhalf = list_MergeSort(greaterhalf, Test);

#ifdef CHECK
    if((list_Length(lowerhalf) + list_Length(greaterhalf)) 
       != originallength) {
      /* output an error message and exit */
      misc_StartErrorReport();
      misc_ErrorReport("\n In list_MergeSort: Mergesorted lists' total sizes");
      misc_ErrorReport("\n don't match original list's size.");
      misc_FinishErrorReport();
    }
#endif

    Result = list_Merge(lowerhalf, greaterhalf, Test);
    
#ifdef CHECK
    if(list_Length(Result) != originallength) {
      /* output an error message and exit */
      misc_StartErrorReport();
      misc_ErrorReport("\n In list_MergeSort: Merged list's size doesn't match ");
      misc_ErrorReport("\n original list's size.");
      misc_FinishErrorReport();
    }
#endif

  }
  else {
    Result = L;
  }

  return Result;
}
Esempio n. 7
0
LIST list_Merge(LIST List1, LIST List2, BOOL (*Test)(POINTER, POINTER)) 
/**************************************************************
  INPUT:   Two sorted lists List1 and List2, and an ordering function.
  RETURNS: The merged list ordered with respect to the ordering function.
  EFFECT:  The function needs time O(n), where <n> is the length of the list.
***************************************************************/
{

  LIST Scan1, Scan2, Result, ResultStart;

#ifdef CHECK
  if (!list_SortedInOrder(List1, Test)) {
    /* print an error message and exit */
    misc_StartErrorReport();
    misc_ErrorReport("\n In list_Merge: First argument is not sorted.");
    misc_FinishErrorReport();
  }
  else if (!list_SortedInOrder (List2, Test)) {
    /* print an error message and exit */
    misc_StartErrorReport();
    misc_ErrorReport("\n In list_Merge: Second argument is not sorted.");
    misc_FinishErrorReport();
  }
#endif

  if (list_Empty(List1))
    return List2;

  if (list_Empty(List2))
    return List1;

  /* This version is derived from list_NNumberMerge, but it doesn't need */
  /* to allocate and deallocate memory, so it should be more efficient.  */

  /* Use the list with the least element as result list. */
  if (Test(list_Car(List1), list_Car(List2))) {
    ResultStart = List1;
    Scan1       = list_Cdr(List1);
    Scan2       = List2;
  }
  else {
    ResultStart = List2;
    Scan1       = List1;
    Scan2       = list_Cdr(List2);
  }

  /* Result is the last element of the merged list. */

  Result = ResultStart;

  while (!list_Empty(Scan1) && !list_Empty(Scan2)) {
    /* This function doesn't implement stable merging. */
    /* Add another test if you need it.                */

    if (Test(list_Car(Scan1), list_Car(Scan2))) {
      list_Rplacd(Result,Scan1);
      Scan1  = list_Cdr(Scan1);
    }
    else {
      list_Rplacd(Result,Scan2);
      Scan2  = list_Cdr(Scan2);
    }
    Result = list_Cdr(Result);
  }

  if (list_Empty(Scan1))
    list_Rplacd(Result, Scan2);
  else
    list_Rplacd(Result, Scan1);

  return ResultStart;
}
Esempio n. 8
0
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;
}