insquery.c

NASA 开发使用的一个专家系统

         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
      cls = LookupDefclassByMdlOrScope(DOPToString(val));
      if (cls == NULL)
        {
         ClassExistError(func,DOPToString(val));
         return(NULL);
        }
      IncrementDefclassBusyCount((VOID *) cls);
      head = get_struct(query_class);
      head->cls = cls;
      if (DefclassInScope(head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            className = ValueToString(GetMFValue(val->value,i));
            cls = LookupDefclassByMdlOrScope(className);
            if (cls == NULL)
              {
               ClassExistError(func,className);
               DeleteQueryClasses(head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryClasses(head);
            return(NULL);
           }
         IncrementDefclassBusyCount((VOID *) cls);
         tmp = get_struct(query_class);
         tmp->cls = cls;
         if (DefclassInScope(tmp->cls,currentModule))
           tmp->theModule = currentModule;
         else
           tmp->theModule = tmp->cls->header.whichModule->theModule;
         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }

/******************************************************
  NAME         : DeleteQueryClasses
  DESCRIPTION  : Deletes a query class-list
  INPUTS       : The query list address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Nodes deallocated
                 Busy count decremented for all classes
  NOTES        : None
 ******************************************************/
static VOID DeleteQueryClasses(qlist)
  QUERY_CLASS *qlist;
  {
   QUERY_CLASS *tmp;
   
   while (qlist != NULL)
     {
      while (qlist->chain != NULL)
        {
         tmp = qlist->chain;
         qlist->chain = qlist->chain->chain;
         DecrementDefclassBusyCount((VOID *) tmp->cls);
         rtn_struct(query_class,tmp);
        }
      tmp = qlist;
      qlist = qlist->nxt;
      DecrementDefclassBusyCount((VOID *) tmp->cls);
      rtn_struct(query_class,tmp);
     }
  }
  
/************************************************************
  NAME         : TestForFirstInChain
  DESCRIPTION  : Processes all classes in a restriction chain
                   until success or done
  INPUTS       : 1) The current chain
                 2) The index of the chain restriction
                     (e.g. the 4th query-variable)
  RETURNS      : CLIPS_TRUE if query succeeds, CLIPS_FALSE otherwise
  SIDE EFFECTS : Sets current restriction class
                 Instance variable values set
  NOTES        : None
 ************************************************************/
static int TestForFirstInChain(qchain,indx)
  QUERY_CLASS *qchain;
  int indx;
  {
   QUERY_CLASS *qptr;
   int id;
   
   AbortQuery = CLIPS_TRUE;
   for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
     {
      AbortQuery = CLIPS_FALSE;
      if ((id = GetTraversalID()) == -1)
        return(CLIPS_FALSE);
      if (TestForFirstInstanceInClass(qptr->theModule,id,qptr->cls,qchain,indx))
        {
         ReleaseTraversalID();
         return(CLIPS_TRUE);
        }
      ReleaseTraversalID();
      if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
        return(CLIPS_FALSE);
     }
   return(CLIPS_FALSE);
  }

/*****************************************************************
  NAME         : TestForFirstInstanceInClass
  DESCRIPTION  : Processes all instances in a class and then
                   all subclasses of a class until success or done
  INPUTS       : 1) The module for which classes tested must be
                    in scope
                 2) Visitation traversal id
                 3) The class
                 4) The current class restriction chain
                 5) The index of the current restriction
  RETURNS      : CLIPS_TRUE if query succeeds, CLIPS_FALSE otherwise
  SIDE EFFECTS : Instance variable values set
  NOTES        : None
 *****************************************************************/
static int TestForFirstInstanceInClass(theModule,id,cls,qchain,indx)
  struct defmodule *theModule;
  int id;
  DEFCLASS *cls;
  QUERY_CLASS *qchain;
  int indx;
  {
   register unsigned i;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   if (TestTraversalID(cls->traversalRecord,id))
     return(CLIPS_FALSE);
   SetTraversalID(cls->traversalRecord,id);
   if (DefclassInScope(cls,theModule) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   ins = cls->instanceList;
   while (ins != NULL)
     {
      QueryCore->solns[indx] = ins;
      if (qchain->nxt != NULL)
        {
         ins->busy++;
         if (TestForFirstInChain(qchain->nxt,indx+1) == CLIPS_TRUE)
           {
            ins->busy--;
            break;
           }
         ins->busy--;
         if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
           break;
        }
      else
        {
         ins->busy++;
         CurrentEvaluationDepth++;
         EvaluateExpression(QueryCore->query,&temp);
         CurrentEvaluationDepth--;
         PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
         ins->busy--;
         if (HaltExecution == CLIPS_TRUE)
           break;
         if ((temp.type != SYMBOL) ? CLIPS_TRUE : 
             (temp.value != CLIPSFalseSymbol))
           break;
        }
      ins = ins->nxtClass;
      while ((ins != NULL) ? (ins->garbage == 1) : CLIPS_FALSE)
        ins = ins->nxtClass;
     }
   if (ins != NULL)
     return(((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE)) 
             ? CLIPS_FALSE : CLIPS_TRUE);
   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
     {
      if (TestForFirstInstanceInClass(theModule,id,cls->directSubclasses.classArray[i],
                                      qchain,indx))
        return(CLIPS_TRUE);
      if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
        return(CLIPS_FALSE);
     }
   return(CLIPS_FALSE);
  }
  
/************************************************************
  NAME         : TestEntireChain
  DESCRIPTION  : Processes all classes in a restriction chain
                   until done
  INPUTS       : 1) The current chain
                 2) The index of the chain restriction
                     (i.e. the 4th query-variable)
  RETURNS      : Nothing useful
  SIDE EFFECTS : Sets current restriction class
                 Query instance variables set
                 Solution sets stored in global list
  NOTES        : None
 ************************************************************/
static VOID TestEntireChain(qchain,indx)
  QUERY_CLASS *qchain;
  int indx;
  {
   QUERY_CLASS *qptr;
   int id;
   
   AbortQuery = CLIPS_TRUE;
   for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
     {
      AbortQuery = CLIPS_FALSE;
      if ((id = GetTraversalID()) == -1)
        return;
      TestEntireClass(qptr->theModule,id,qptr->cls,qchain,indx);
      ReleaseTraversalID();
      if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
        return;
     }
  }

/*****************************************************************
  NAME         : TestEntireClass
  DESCRIPTION  : Processes all instances in a class and then
                   all subclasses of a class until done
  INPUTS       : 1) The module for which classes tested must be
                    in scope
                 2) Visitation traversal id
                 3) The class
                 4) The current class restriction chain
                 5) The index of the current restriction
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance variable values set
                 Solution sets stored in global list
  NOTES        : None
 *****************************************************************/
static VOID TestEntireClass(theModule,id,cls,qchain,indx)
  struct defmodule *theModule;
  int id;
  DEFCLASS *cls;
  QUERY_CLASS *qchain;
  int indx;  
  {
   register unsigned i;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   if (TestTraversalID(cls->traversalRecord,id))
     return;
   SetTraversalID(cls->traversalRecord,id);
   if (DefclassInScope(cls,theModule) == CLIPS_FALSE)
     return;
   ins = cls->instanceList;
   while (ins != NULL)
     {
      QueryCore->solns[indx] = ins;
      if (qchain->nxt != NULL)
        {
         ins->busy++;
         TestEntireChain(qchain->nxt,indx+1);
         ins->busy--;
         if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
           break;
        }
      else
        {
         ins->busy++;
         CurrentEvaluationDepth++;
         EvaluateExpression(QueryCore->query,&temp);
         CurrentEvaluationDepth--;
         PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
         ins->busy--;
         if (HaltExecution == CLIPS_TRUE) 
           break;
         if ((temp.type != SYMBOL) ? CLIPS_TRUE : 
             (temp.value != CLIPSFalseSymbol))
           {
            if (QueryCore->action != NULL)
              {
               ins->busy++;
               CurrentEvaluationDepth++;
               ValueDeinstall(QueryCore->result);
               EvaluateExpression(QueryCore->action,QueryCore->result);
               ValueInstall(QueryCore->result);
               CurrentEvaluationDepth--;
               PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
               ins->busy--;
               if (BreakFlag || ReturnFlag)
                 {
                  AbortQuery = CLIPS_TRUE;
                  break;
                 }
               if (HaltExecution == CLIPS_TRUE)
                 break;
              }
            else
              AddSolution();
           }
        }
      ins = ins->nxtClass;
      while ((ins != NULL) ? (ins->garbage == 1) : CLIPS_FALSE)
        ins = ins->nxtClass;
     }
   if (ins != NULL)
     return;
   for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
     {
      TestEntireClass(theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
      if ((HaltExecution == CLIPS_TRUE) || (AbortQuery == CLIPS_TRUE))
        return;
     }
  }
  
/***************************************************************************
  NAME         : AddSolution
  DESCRIPTION  : Adds the current instance set to a global list of
                   solutions
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Global list and count updated
  NOTES        : Solutions are stored as sequential arrays of INSTANCE_TYPE *
 ***************************************************************************/
static VOID AddSolution()
  {
   QUERY_SOLN *new_soln;
   register int i;
   
   new_soln = (QUERY_SOLN *) gm2((int) sizeof(QUERY_SOLN));
   new_soln->soln = (INSTANCE_TYPE **) 
                    gm2((int) (sizeof(INSTANCE_TYPE *) * (QueryCore->soln_size)));
   for (i = 0 ; i < QueryCore->soln_size ; i++)
     new_soln->soln[i] = QueryCore->solns[i];
   new_soln->nxt = NULL;
   if (QueryCore->soln_set == NULL)
     QueryCore->soln_set = new_soln;
   else
     QueryCore->soln_bottom->nxt = new_soln;
   QueryCore->soln_bottom = new_soln;
   QueryCore->soln_cnt++;
  }
  
/***************************************************
  NAME         : PopQuerySoln
  DESCRIPTION  : Deallocates the topmost solution
                   set for an instance-set query
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Solution set deallocated
  NOTES        : Assumes QueryCore->soln_set != 0
 ***************************************************/
static VOID PopQuerySoln()
  {
   QueryCore->soln_bottom = QueryCore->soln_set;
   QueryCore->soln_set = QueryCore->soln_set->nxt;
   rm((VOID *) QueryCore->soln_bottom->soln,
      (int) (sizeof(INSTANCE_TYPE *) * QueryCore->soln_size));
   rm((VOID *) QueryCore->soln_bottom,(int) sizeof(QUERY_SOLN));
  }
  
#endif

/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/