insquery.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*                                                     */
   /*******************************************************/

/*************************************************************/
/* Purpose: Query Functions for Objects                      */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if INSTANCE_SET_QUERIES

#include "argacces.h"
#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "exprnpsr.h"
#include "insfun.h"
#include "insmngr.h"
#include "insqypsr.h"
#include "prcdrfun.h"
#include "router.h"
#include "utility.h"

#define _INSQUERY_SOURCE_
#include "insquery.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */
typedef struct query_class
  {
   DEFCLASS *cls;
   struct defmodule *theModule;
   struct query_class *chain,*nxt;
  } QUERY_CLASS;

typedef struct query_soln
  {
   INSTANCE_TYPE **soln;
   struct query_soln *nxt;
  } QUERY_SOLN;
  
typedef struct query_core
  {
   INSTANCE_TYPE **solns;
   EXPRESSION *query,*action;
   QUERY_SOLN *soln_set,*soln_bottom;
   int soln_size,soln_cnt;
   DATA_OBJECT *result;
  } QUERY_CORE;
  
typedef struct query_stack
  {
   QUERY_CORE *core;
   struct query_stack *nxt;
  } QUERY_STACK;
  
/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static VOID PushQueryCore(void);
static VOID PopQueryCore(void);
static QUERY_CORE *FindQueryCore(int);
static QUERY_CLASS *DetermineQueryClasses(EXPRESSION *,char *,int *);
static QUERY_CLASS *FormChain(char *,DATA_OBJECT *);
static VOID DeleteQueryClasses(QUERY_CLASS *);
static int TestForFirstInChain(QUERY_CLASS *,int);
static int TestForFirstInstanceInClass(struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int);
static VOID TestEntireChain(QUERY_CLASS *,int);
static VOID TestEntireClass(struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int);
static VOID AddSolution(void);
static VOID PopQuerySoln(void);

#else

static VOID PushQueryCore();
static VOID PopQueryCore();
static QUERY_CORE *FindQueryCore();
static QUERY_CLASS *DetermineQueryClasses();
static QUERY_CLASS *FormChain();
static VOID DeleteQueryClasses();
static int TestForFirstInChain();
static int TestForFirstInstanceInClass();
static VOID TestEntireChain();
static VOID TestEntireClass();
static VOID AddSolution();
static VOID PopQuerySoln();

#endif
      
/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle SYMBOL_HN *QUERY_DELIMETER_SYMBOL = NULL;
   
/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
static QUERY_CORE *QueryCore = NULL;
static QUERY_STACK *QueryCoreStack = NULL;
static int AbortQuery = CLIPS_FALSE;

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
/****************************************************
  NAME         : SetupQuery
  DESCRIPTION  : Initializes instance query CLIPS
                   functions and parsers
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Sets up kernel functions and parsers
  NOTES        : None
 ****************************************************/
globle VOID SetupQuery()
  {
#if ! RUN_TIME
   QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) AddSymbol(QUERY_DELIMETER_STRING);
   IncrementSymbolCount(QUERY_DELIMETER_SYMBOL);

   DefineFunction2("(query-instance)",'o',
                  PTIF GetQueryInstance,"GetQueryInstance",NULL);

   DefineFunction2("(query-instance-slot)",'u',
                  PTIF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);

   DefineFunction2("any-instancep",'b',PTIF AnyInstances,"AnyInstances",NULL);
   AddFunctionParser("any-instancep",ParseQueryNoAction);

   DefineFunction2("find-instance",'m',
                  PTIF QueryFindInstance,"QueryFindInstance",NULL);
   AddFunctionParser("find-instance",ParseQueryNoAction);

   DefineFunction2("find-all-instances",'m',
                  PTIF QueryFindAllInstances,"QueryFindAllInstances",NULL);
   AddFunctionParser("find-all-instances",ParseQueryNoAction);

   DefineFunction2("do-for-instance",'u',
                  PTIF QueryDoForInstance,"QueryDoForInstance",NULL);
   AddFunctionParser("do-for-instance",ParseQueryAction);

   DefineFunction2("do-for-all-instances",'u',
                  PTIF QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
   AddFunctionParser("do-for-all-instances",ParseQueryAction);

   DefineFunction2("delayed-do-for-all-instances",'u',
                  PTIF DelayedQueryDoForAllInstances,
                  "DelayedQueryDoForAllInstances",NULL);
   AddFunctionParser("delayed-do-for-all-instances",ParseQueryAction);
#endif
  }
  
/*************************************************************
  NAME         : GetQueryInstance
  DESCRIPTION  : Internal function for referring to instance
                    array on instance-queries
  INPUTS       : None
  RETURNS      : The name of the specified instance-set member
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : ((query-instance) <index>)
 *************************************************************/
globle SYMBOL_HN *GetQueryInstance()
  {
   register QUERY_CORE *core;
   
   core = FindQueryCore(DOPToInteger(GetFirstArgument()));
   return(GetFullInstanceName(core->solns[DOPToInteger(GetFirstArgument()->nextArg)]));
  }
  
/***************************************************************************
  NAME         : GetQueryInstanceSlot
  DESCRIPTION  : Internal function for referring to slots of instances in
                    instance array on instance-queries
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set appropriately
  NOTES        : CLIPS Syntax : ((query-instance-slot) <index> <slot-name>)
 **************************************************************************/
globle VOID GetQueryInstanceSlot(result)
  DATA_OBJECT *result;
  {
   INSTANCE_TYPE *ins;
   INSTANCE_SLOT *sp;
   DATA_OBJECT temp;
   QUERY_CORE *core;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   
   core = FindQueryCore(DOPToInteger(GetFirstArgument()));
   ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)];
   EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1("get",1,"symbol");
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),"instance-set query");
      return;
     }
   result->type = sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      result->end = GetInstanceSlotLength(sp) - 1;
     }
  }
  
/* =============================================================================
   =============================================================================
   Following are the instance query functions :
   
     any-instancep         : Determines if any instances satisfy the query
     find-instance         : Finds first (set of) instance(s) which satisfies
                               the query and stores it in a multi-field
     find-all-instances    : Finds all (sets of) instances which satisfy the
                               the query and stores them in a multi-field
     do-for-instance       : Executes a given action for the first (set of)
                               instance(s) which satisfy the query
     do-for-all-instances  : Executes an action for all instances which satisfy
                               the query as they are found
     delayed-do-for-all-instances : Same as above - except that the list of instances
                               which satisfy the query is formed before any
                               actions are executed
                               
     Instance candidate search algorithm :
     
     All permutations of first restriction class instances with other
       restriction class instances (Rightmost are varied first)
     All permutations of first restriction class's subclasses' instances with
       other restriction class instances.
     And  so on...
     
     For any one class, instances are examined in the order they were defined
     
     Example :
     (defclass a (is-a standard-user))
     (defclass b (is-a standard-user))
     (defclass c (is-a standard-user))
     (defclass d (is-a a b))
     (make-instance a1 of a)
     (make-instance a2 of a)
     (make-instance b1 of b)
     (make-instance b2 of b)
     (make-instance c1 of c)
     (make-instance c2 of c)
     (make-instance d1 of d)
     (make-instance d2 of d)
     
     (any-instancep ((?a a b) (?b c)) <query>)
     
     The permutations (?a ?b) would be examined in the following order :
     
     (a1 c1),(a1 c2),(a2 c1),(a2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2),
     (b1 c1),(b1 c2),(b2 c1),(b2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2)
     
     Notice the duplication because d is a subclass of both and a and b.
   =============================================================================
   ============================================================================= */
   
/******************************************************************************
  NAME         : AnyInstances
  DESCRIPTION  : Determines if there any existing instances which satisfy
                   the query
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the query is satisfied, CLIPS_FALSE otherwise
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   zero or more times (depending on instance restrictions
                   and how early the expression evaulates to CLIPS_TRUE - if at all).
  NOTES        : CLIPS Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle BOOLEAN AnyInstances()
  {
   QUERY_CLASS *qclasses;
   int rcnt;
   int TestResult;
   
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
                                      "any-instancep",&rcnt);
   if (qclasses == NULL)
     return(CLIPS_FALSE);
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   TestResult = TestForFirstInChain(qclasses,0);
   AbortQuery = CLIPS_FALSE;
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
   return(TestResult);
  }
  
/******************************************************************************
  NAME         : QueryFindInstance
  DESCRIPTION  : Finds the first set of instances which satisfy the query and
                   stores their names in the user's multi-field variable
  INPUTS       : Caller's result buffer
  RETURNS      : CLIPS_TRUE if the query is satisfied, CLIPS_FALSE otherwise
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   zero or more times (depending on instance restrictions
                   and how early the expression evaulates to CLIPS_TRUE - if at all).
  NOTES        : CLIPS Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle VOID QueryFindInstance(result)
  DATA_OBJECT *result;
  {
   QUERY_CLASS *qclasses;
   int rcnt,i;
   
   result->type = MULTIFIELD;
   result->begin = 0;
   result->end = -1;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
                                      "find-instance",&rcnt);
   if (qclasses == NULL)
     {
      result->value = (VOID *) CreateMultifield(0L);
      return;
     }
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) 
                      gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   if (TestForFirstInChain(qclasses,0) == CLIPS_TRUE)
     {
      result->value = (VOID *) CreateMultifield(rcnt);
      result->end = rcnt-1;
      for (i = 1 ; i <= rcnt ; i++)
        {
         SetMFType(result->value,i,INSTANCE_NAME);
         SetMFValue(result->value,i,GetFullInstanceName(QueryCore->solns[i - 1]));
        }
     }
   else
      result->value = (VOID *) CreateMultifield(0L);
   AbortQuery = CLIPS_FALSE;
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
  
/******************************************************************************
  NAME         : QueryFindAllInstances
  DESCRIPTION  : Finds all sets of instances which satisfy the query and