/*******************************************************/   /*      "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_FUNCTIONSstatic void CreateDefaultGenericPPForm(void *,DEFGENERIC *);#endifstatic 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...().