multifun.c

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

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

/*************************************************************/
/* Purpose: Contains the code for several multifield         */
/*   functions including first$, rest$, subseq$, delete$,    */
/*   delete-member$, replace-member$                         */
/*   replace$, insert$, explode$, implode$, nth$, member$,   */
/*   subsetp, progn$, str-implode, str-explode, subset, nth, */
/*   mv-replace, member, mv-subseq, and mv-delete.           */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*      Brian Donnell                                        */
/*      Barry Cameron                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _MULTIFUN_SOURCE_

#include "setup.h"

#if MULTIFIELD_FUNCTIONS || OBJECT_SYSTEM

#include <stdio.h>
#define _CLIPS_STDIO_
#include <string.h>

#include "clipsmem.h"
#include "argacces.h"
#include "multifld.h"
#include "router.h"
#include "multifun.h"
#include "exprnpsr.h"
#include "prcdrpsr.h"
#include "prcdrfun.h"
#if (! BLOAD_ONLY) && (! RUN_TIME)
#include "scanner.h"
#endif
#include "utility.h"

#if OBJECT_SYSTEM
#include "object.h"
#endif

/**************/
/* STRUCTURES */
/**************/

typedef struct fieldVarStack
  {
   int type;
   VOID *value;
   long index;
   struct fieldVarStack *nxt;
  } FIELD_VAR_STACK;
  
/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

#if ANSI_COMPILER
#if MULTIFIELD_FUNCTIONS
   static BOOLEAN                 FindDOsInSegment(DATA_OBJECT_PTR,int,DATA_OBJECT_PTR,
                                                   long *,long *,long *,int);
   static BOOLEAN                 MVRangeCheck(long,long,long *,int);
#if (! BLOAD_ONLY) && (! RUN_TIME)
   static struct expr            *MultifieldPrognParser(struct expr *,char *);
   static VOID                    ReplaceMvPrognFieldVars(SYMBOL_HN *,struct expr *,int);
#endif
#endif
   static VOID                    MVRangeError(long,long,long,char *);
#else
#if MULTIFIELD_FUNCTIONS
   static BOOLEAN                 FindDOsInSegment();
   static BOOLEAN                 MVRangeCheck();
#if (! BLOAD_ONLY) && (! RUN_TIME)
   static struct expr            *MultifieldPrognParser();
   static VOID                    ReplaceMvPrognFieldVars();
#endif
#endif
   static VOID                    MVRangeError();
#endif
#endif

/***************************************/
/* LOCAL INTERNAL VARIABLE DEFINITIONS */
/***************************************/

#if MULTIFIELD_FUNCTIONS

   static FIELD_VAR_STACK    *FieldVarStack = NULL;

#if ! RUN_TIME
/**********************************************/
/* MultifieldFunctionDefinitions: Initializes */
/*   the multifield functions.                */
/**********************************************/
globle VOID MultifieldFunctionDefinitions()
  {   
   DefineFunction2("first$", 'm', PTIF FirstFunction, "FirstFunction", "11m");
   DefineFunction2("rest$", 'm', PTIF RestFunction, "RestFunction", "11m");
   DefineFunction2("subseq$", 'm', PTIF SubseqFunction, "SubseqFunction", "33im");
   DefineFunction2("delete-member$", 'm', PTIF DeleteMemberFunction, "DeleteMemberFunction", "2*um");
   DefineFunction2("replace-member$", 'm', PTIF ReplaceMemberFunction, "ReplaceMemberFunction","3*um");
   DefineFunction2("delete$", 'm', PTIF DeleteFunction, "DeleteFunction", "33im");
   DefineFunction2("replace$", 'm', PTIF ReplaceFunction, "ReplaceFunction","4**mii");
   DefineFunction2("insert$", 'm', PTIF InsertFunction, "InsertFunction", "3**mi");
   DefineFunction2("explode$", 'm', PTIF ExplodeFunction, "ExplodeFunction", "11s");
   DefineFunction2("implode$", 's', PTIF ImplodeFunction, "ImplodeFunction", "11m");
   DefineFunction2("nth$", 'u', PTIF NthFunction, "NthFunction", "22*im");
   DefineFunction2("member$", 'u', PTIF MemberFunction, "MemberFunction", "22*um");
   DefineFunction2("subsetp", 'b', PTIF SubsetpFunction, "SubsetpFunction", "22*mm");
   DefineFunction2("progn$", 'u', PTIF MultifieldPrognFunction, "MultifieldPrognFunction", NULL);
   DefineFunction2("str-implode", 's', PTIF ImplodeFunction, "ImplodeFunction", "11m");
   DefineFunction2("str-explode", 'm', PTIF ExplodeFunction, "ExplodeFunction", "11s");
   DefineFunction2("subset", 'b', PTIF SubsetpFunction, "SubsetpFunction", "22*mm");
   DefineFunction2("nth", 'u', PTIF NthFunction, "NthFunction", "22*im");
   DefineFunction2("mv-replace", 'm', PTIF MVReplaceFunction, "MVReplaceFunction","33*im");
   DefineFunction2("member", 'u', PTIF MemberFunction, "MemberFunction", "22*um");
   DefineFunction2("mv-subseq", 'm', PTIF MVSubseqFunction, "MVSubseqFunction", "33*iim");
   DefineFunction2("mv-delete", 'm', PTIF MVDeleteFunction,"MVDeleteFunction", "22*im");
#if ! BLOAD_ONLY
   AddFunctionParser("progn$",MultifieldPrognParser);
#endif
   FuncSeqOvlFlags("progn$",CLIPS_FALSE,CLIPS_FALSE);
   DefineFunction2("(get-progn$-field)", 'u', PTIF GetMvPrognField, "GetMvPrognField", "00");
   DefineFunction2("(get-progn$-index)", 'l', PTIF GetMvPrognIndex, "GetMvPrognIndex", "00");
  }
#endif

/****************************************/
/* DeleteFunction: CLIPS access routine */
/*   for the delete$ function.          */
/****************************************/
globle VOID DeleteFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT value1, value2, value3;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   
   if ((ArgTypeCheck("delete$",1,MULTIFIELD,&value1) == CLIPS_FALSE) ||
       (ArgTypeCheck("delete$",2,INTEGER,&value2) == CLIPS_FALSE) ||
       (ArgTypeCheck("delete$",3,INTEGER,&value3) == CLIPS_FALSE))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }

   /*=================================================*/
   /* Delete the section out of the multifield value. */
   /*=================================================*/
   
   if (DeleteMultiValueField(returnValue,&value1,
            DOToLong(value2),DOToLong(value3),"delete$") == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
     }
  }
  
/******************************************/
/* MVDeleteFunction: CLIPS access routine */
/*   for the mv-delete function.          */
/******************************************/
globle VOID MVDeleteFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT value1, value2;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   
   if ((ArgTypeCheck("mv-delete",1,INTEGER,&value1) == CLIPS_FALSE) ||
       (ArgTypeCheck("mv-delete",2,MULTIFIELD,&value2) == CLIPS_FALSE))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }

   /*=================================================*/
   /* Delete the section out of the multifield value. */
   /*=================================================*/
   
   if (DeleteMultiValueField(returnValue,&value2,
            DOToLong(value1),DOToLong(value1),"mv-delete") == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
     }
  }

/*****************************************/
/* ReplaceFunction: CLIPS access routine */
/*   for the replace$ function.          */
/*****************************************/
globle VOID ReplaceFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT value1, value2, value3, value4;
   EXPRESSION *fieldarg;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   
   if ((ArgTypeCheck("replace$",1,MULTIFIELD,&value1) == CLIPS_FALSE) ||
       (ArgTypeCheck("replace$",2,INTEGER,&value2) == CLIPS_FALSE) ||
       (ArgTypeCheck("replace$",3,INTEGER,&value3) == CLIPS_FALSE))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }
     
   /*===============================*/
   /* Create the replacement value. */
   /*===============================*/
   
   fieldarg = GetFirstArgument()->nextArg->nextArg->nextArg;
   if (fieldarg->nextArg != NULL)
     { StoreInMultifield(&value4,fieldarg,CLIPS_TRUE); }
   else
     { EvaluateExpression(fieldarg,&value4); }
     
   /*==============================================*/
   /* Replace the section in the multifield value. */
   /*==============================================*/

   if (ReplaceMultiValueField(returnValue,&value1,DOToInteger(value2),
                   DOToInteger(value3),&value4,"replace$") == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
     }
  }
  
/*******************************************/
/* MVReplaceFunction: CLIPS access routine */
/*   for the mv-replace function.          */
/*******************************************/
globle VOID MVReplaceFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT value1, value2, value3;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   
   if ((ArgTypeCheck("mv-replace",1,INTEGER,&value1) == CLIPS_FALSE) ||
       (ArgTypeCheck("mv-replace",2,MULTIFIELD,&value2) == CLIPS_FALSE))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }
   
   /*===============================*/
   /* Create the replacement value. */
   /*===============================*/
   
   EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&value3);

   /*==============================================*/
   /* Replace the section in the multifield value. */
   /*==============================================*/
   
   if (ReplaceMultiValueField(returnValue,&value2,DOToInteger(value1),
                   DOToInteger(value1),&value3,"mv-replace") == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
     }
  }
  
/**********************************************/
/* DeleteMemberFunction: CLIPS access routine */
/*   for the delete-member$ function.         */
/**********************************************/
globle VOID DeleteMemberFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT resultValue,*delVals,tmpVal;
   int i,argCnt,delSize;
   long j,k;

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/
   argCnt = ArgCountCheck("delete-member$",AT_LEAST,2);
   if (argCnt == -1)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/   
   if (ArgTypeCheck("delete-member$",1,MULTIFIELD,&resultValue) == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }

   /*=================================================
     For every value specified, delete all occurrences
     of those values from the multifield
     ================================================= */
   delSize = (int) (sizeof(DATA_OBJECT) * (argCnt-1));
   delVals = (DATA_OBJECT_PTR) gm2(delSize);
   for (i = 2 ; i <= argCnt ; i++)
     {
      if (!RtnUnknown(i,&delVals[i-2]))
        {
         rm((VOID *) delVals,delSize);
         SetEvaluationError(CLIPS_TRUE);
         SetMultifieldErrorValue(returnValue);
         return;
        }
     }

   while (FindDOsInSegment(delVals,argCnt-1,&resultValue,&j,&k,NULL,0))
     {
      if (DeleteMultiValueField(&tmpVal,&resultValue,
                                j,k,"delete-member$") == CLIPS_FALSE)
        {
         rm((VOID *) delVals,delSize);
         SetEvaluationError(CLIPS_TRUE);
         SetMultifieldErrorValue(returnValue);
         return;
        }
      CopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal);
     }
   rm((VOID *) delVals,delSize);
   CopyMemory(DATA_OBJECT,1,returnValue,&resultValue);
  }
  
/***********************************************/
/* ReplaceMemberFunction: CLIPS access routine */
/*   for the replace-member$ function.         */
/***********************************************/
globle VOID ReplaceMemberFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT resultValue,replVal,*delVals,tmpVal;
   int i,argCnt,delSize;
   long j,k,mink[2],*minkp;
   long replLen = 1L;

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/
   argCnt = ArgCountCheck("replace-member$",AT_LEAST,3);
   if (argCnt == -1)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/   
   if (ArgTypeCheck("replace-member$",1,MULTIFIELD,&resultValue) == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }
     
   if (!RtnUnknown(2,&replVal))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }
   if (GetType(replVal) == MULTIFIELD)
     replLen = GetDOLength(replVal);

   /*=====================================================
     For the value (or values from multifield ) specified,
     replace all occurrences of those values with all
     values specified
     ===================================================== */
   delSize = (int) (sizeof(DATA_OBJECT) * (argCnt-2));
   delVals = (DATA_OBJECT_PTR) gm2(delSize);
   for (i = 3 ; i <= argCnt ; i++)
     {
      if (!RtnUnknown(i,&delVals[i-3]))
        {
         rm((VOID *) delVals,delSize);
         SetEvaluationError(CLIPS_TRUE);
         SetMultifieldErrorValue(returnValue);
         return;
        }
     }
   minkp = NULL;
   while (FindDOsInSegment(delVals,argCnt-2,&resultValue,&j,&k,minkp,minkp ? 1 : 0))
     {
      if (ReplaceMultiValueField(&tmpVal,&resultValue,j,k,
                                 &replVal,"replace-member$") == CLIPS_FALSE)
        {
         rm((VOID *) delVals,delSize);
         SetEvaluationError(CLIPS_TRUE);
         SetMultifieldErrorValue(returnValue);
         return;