genrcpsr.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.24  06/05/06          */
   /*                                                     */
   /*                                                     */
   /*******************************************************/

/*************************************************************/
/* Purpose: Generic Functions Parsing Routines               */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*      6.24: Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*            If the last construct in a loaded file is a    */
/*            deffunction or defmethod with no closing right */
/*            parenthesis, an error should be issued, but is */
/*            not. DR0872                                    */
/*                                                           */
/*************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME)

#if BLOAD || BLOAD_AND_BSAVE
#include "bload.h"
#endif

#if DEFFUNCTION_CONSTRUCT
#include "dffnxfun.h"
#endif

#if OBJECT_SYSTEM
#include "classfun.h"
#include "classcom.h"
#endif

#include "memalloc.h"
#include "cstrcpsr.h"
#include "envrnmnt.h"
#include "exprnpsr.h"
#include "genrccom.h"
#include "immthpsr.h"
#include "modulutl.h"
#include "prcdrpsr.h"
#include "prccode.h"
#include "router.h"
#include "scanner.h"

#define _GENRCPSR_SOURCE_
#include "genrcpsr.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define HIGHER_PRECEDENCE -1
#define IDENTICAL          0
#define LOWER_PRECEDENCE   1

#define CURR_ARG_VAR "current-argument"

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */

static intBool ValidGenericName(void *,char *);
static SYMBOL_HN *ParseMethodNameAndIndex(void *,char *,int *);

#if DEBUGGING_FUNCTIONS
static void CreateDefaultGenericPPForm(void *,DEFGENERIC *);
#endif

static int ParseMethodParameters(void *,char *,EXPRESSION **,SYMBOL_HN **);
static RESTRICTION *ParseRestriction(void *,char *);
static void ReplaceCurrentArgRefs(void *,EXPRESSION *);
static int DuplicateParameters(void *,EXPRESSION *,EXPRESSION **,SYMBOL_HN *);
static EXPRESSION *AddParameter(void *,EXPRESSION *,EXPRESSION *,SYMBOL_HN *,RESTRICTION *);
static EXPRESSION *ValidType(void *,SYMBOL_HN *);
static intBool RedundantClasses(void *,void *,void *);
static DEFGENERIC *AddGeneric(void *,SYMBOL_HN *,int *);
static DEFMETHOD *AddGenericMethod(void *,DEFGENERIC *,int,short);
static int RestrictionsCompare(EXPRESSION *,int,int,int,DEFMETHOD *);
static int TypeListCompare(RESTRICTION *,RESTRICTION *);
static DEFGENERIC *NewGeneric(void *,SYMBOL_HN *);

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***************************************************************************
  NAME         : ParseDefgeneric
  DESCRIPTION  : Parses the defgeneric construct
  INPUTS       : The input logical name
  RETURNS      : FALSE if successful parse, TRUE otherwise
  SIDE EFFECTS : Inserts valid generic function defn into generic entry
  NOTES        : H/L Syntax :
                 (defgeneric <name> [<comment>])
 ***************************************************************************/
globle intBool ParseDefgeneric(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *gname;
   DEFGENERIC *gfunc;
   int newGeneric;

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SavePPBuffer(theEnv,"(defgeneric ");
   SetIndentDepth(theEnv,3);

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defgeneric");
      return(TRUE);
     }
#endif

   gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric",
                                      EnvFindDefgeneric,NULL,"^",TRUE,
                                      TRUE,TRUE);
   if (gname == NULL)
     return(TRUE);

   if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE)
     return(TRUE);

   if (DefgenericData(theEnv)->GenericInputToken.type != RPAREN)
     {
      PrintErrorID(theEnv,"GENRCPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Expected ')' to complete defgeneric.\n");
      return(TRUE);
     }
   SavePPBuffer(theEnv,"\n");

   /* ========================================================
      If we're only checking syntax, don't add the
      successfully parsed deffacts to the KB.
      ======================================================== */

   if (ConstructData(theEnv)->CheckSyntaxMode)
     { return(FALSE); }

   gfunc = AddGeneric(theEnv,gname,&newGeneric);

#if DEBUGGING_FUNCTIONS
   SetDefgenericPPForm((void *) gfunc,EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv));
#endif
   return(FALSE);
  }

/***************************************************************************
  NAME         : ParseDefmethod
  DESCRIPTION  : Parses the defmethod construct
  INPUTS       : The input logical name
  RETURNS      : FALSE if successful parse, TRUE otherwise
  SIDE EFFECTS : Inserts valid method definition into generic entry
  NOTES        : H/L Syntax :
                 (defmethod <name> [<index>] [<comment>]
                    (<restriction>* [<wildcard>])
                    <action>*)
                 <restriction> :== ?<name> |
                                   (?<name> <type>* [<restriction-query>])
                 <wildcard>    :== $?<name> |
                                   ($?<name> <type>* [<restriction-query>])
 ***************************************************************************/
globle intBool ParseDefmethod(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *gname;
   int rcnt,mposn,mi,newMethod,mnew = FALSE,lvars,error;
   EXPRESSION *params,*actions,*tmp;
   SYMBOL_HN *wildcard;
   DEFMETHOD *meth;
   DEFGENERIC *gfunc;
   int theIndex;

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmethod ");

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmethod");
      return(TRUE);
     }
#endif

   gname = ParseMethodNameAndIndex(theEnv,readSource,&theIndex);
   if (gname == NULL)
     return(TRUE);

   if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE)
     return(TRUE);

   /* ========================================================
      Go ahead and add the header so that the generic function
      can be called recursively
      ======================================================== */
   gfunc = AddGeneric(theEnv,gname,&newMethod);

#if DEBUGGING_FUNCTIONS
   if (newMethod && (! ConstructData(theEnv)->CheckSyntaxMode))
      CreateDefaultGenericPPForm(theEnv,gfunc);
#endif

   IncrementIndentDepth(theEnv,1);
   rcnt = ParseMethodParameters(theEnv,readSource,&params,&wildcard);
   DecrementIndentDepth(theEnv,1);
   if (rcnt == -1)
     goto DefmethodParseError;
   PPCRAndIndent(theEnv);
   for (tmp = params ; tmp != NULL ; tmp = tmp->nextArg)
     {
      ReplaceCurrentArgRefs(theEnv,((RESTRICTION *) tmp->argList)->query);
      if (ReplaceProcVars(theEnv,"method",((RESTRICTION *) tmp->argList)->query,
                                  params,wildcard,NULL,NULL))
        {
         DeleteTempRestricts(theEnv,params);
         goto DefmethodParseError;
        }
     }
   meth = FindMethodByRestrictions(gfunc,params,rcnt,wildcard,&mposn);
   error = FALSE;
   if (meth != NULL)
     {
      if (meth->system)
        {
         PrintErrorID(theEnv,"GENRCPSR",17,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #");
         PrintLongInteger(theEnv,WERROR,(long long) meth->index);
         EnvPrintRouter(theEnv,WERROR,".\n");
         error = TRUE;
        }
      else if ((theIndex != 0) && (theIndex != meth->index))
        {
         PrintErrorID(theEnv,"GENRCPSR",2,FALSE);
         EnvPrintRouter(theEnv,WERROR,"New method #");
         PrintLongInteger(theEnv,WERROR,(long long) theIndex);
         EnvPrintRouter(theEnv,WERROR," would be indistinguishable from method #");
         PrintLongInteger(theEnv,WERROR,(long long) meth->index);
         EnvPrintRouter(theEnv,WERROR,".\n");
         error = TRUE;
        }
     }
   else if (theIndex != 0)
     {
      mi = FindMethodByIndex(gfunc,theIndex);
      if (mi == -1)
        mnew = TRUE;
      else if (gfunc->methods[mi].system)
        {
         PrintErrorID(theEnv,"GENRCPSR",17,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #");
         PrintLongInteger(theEnv,WERROR,(long long) theIndex);
         EnvPrintRouter(theEnv,WERROR,".\n");
         error = TRUE;
        }
     }
   else
     mnew = TRUE;
   if (error)
     {
      DeleteTempRestricts(theEnv,params);
      goto DefmethodParseError;
     }
   ExpressionData(theEnv)->ReturnContext = TRUE;
   actions = ParseProcActions(theEnv,"method",readSource,
                              &DefgenericData(theEnv)->GenericInputToken,params,wildcard,
                              NULL,NULL,&lvars,NULL);
                              
   /*===========================================================*/
   /* Check for the closing right parenthesis of the defmethod. */
   /*===========================================================*/

   if ((DefgenericData(theEnv)->GenericInputToken.type != RPAREN) &&  /* DR0872 */
       (actions != NULL))
     {
      SyntaxErrorMessage(theEnv,"defmethod");
      DeleteTempRestricts(theEnv,params);
      ReturnPackedExpression(theEnv,actions);
      goto DefmethodParseError;
     }

   if (actions == NULL)
     {
      DeleteTempRestricts(theEnv,params);
      goto DefmethodParseError;
     }

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed deffunction to the KB.   */
   /*==============================================*/

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      DeleteTempRestricts(theEnv,params);
      ReturnPackedExpression(theEnv,actions);
      if (newMethod)
        {
         RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc);
         RemoveDefgeneric(theEnv,(struct constructHeader *) gfunc);
        }
      return(FALSE);
     }

   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm);
   SavePPBuffer(theEnv,"\n");

#if DEBUGGING_FUNCTIONS
   meth = AddMethod(theEnv,gfunc,meth,mposn,theIndex,params,rcnt,lvars,wildcard,actions,
             EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv),FALSE);
#else
   meth = AddMethod(theEnv,gfunc,meth,mposn,theIndex,params,rcnt,lvars,wildcard,actions,NULL,FALSE);
#endif
   DeleteTempRestricts(theEnv,params);
   if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
     {
      EnvPrintRouter(theEnv,WDIALOG,"   Method #");
      PrintLongInteger(theEnv,WDIALOG,(long long) meth->index);
      EnvPrintRouter(theEnv,WDIALOG,(char *) (mnew ? " defined.\n" : " redefined.\n"));
     }
   return(FALSE);

DefmethodParseError:
   if (newMethod)
     {
      RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc);
      RemoveDefgeneric(theEnv,(void *) gfunc);
     }
   return(TRUE);
  }

/************************************************************************
  NAME         : AddMethod
  DESCRIPTION  : (Re)defines a new method for a generic
                 If method already exists, deletes old information
                    before proceeding.
  INPUTS       : 1) The generic address
                 2) The old method address (can be NULL)
                 3) The old method array position (can be -1)
                 4) The method index to assign (0 if don't care)
                 5) The parameter expression-list
                    (restrictions attached to argList pointers)
                 6) The number of restrictions
                 7) The number of locals vars reqd
                 8) The wildcard symbol (NULL if none)
                 9) Method actions
                 10) Method pretty-print form
                 11) A flag indicating whether to copy the
                     restriction types or just use the pointers
  RETURNS      : The new (old) method address
  SIDE EFFECTS : Method added to (or changed in) method array for generic
                 Restrictions repacked into new method
                 Actions and pretty-print form attached
  NOTES        : Assumes if a method is being redefined, its busy
                   count is 0!!
                 IMPORTANT: Expects that FindMethodByRestrictions() has
                   previously been called to determine if this method
                   is already present or not.  Arguments #1 and #2
                   should be the values obtained from FindMethod...().