src/clipsrules/core/dffnxpsr.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.24  06/05/06          */
00005    /*                                                     */
00006    /*                                                     */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose: Deffunction Parsing Routines                     */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /* Revision History:                                         */
00018 /*                                                           */
00019 /*      6.24: Renamed BOOLEAN macro type to intBool.         */
00020 /*                                                           */
00021 /*            If the last construct in a loaded file is a    */
00022 /*            deffunction or defmethod with no closing right */
00023 /*            parenthesis, an error should be issued, but is */
00024 /*            not. DR0872                                    */
00025 /*                                                           */
00026 /*            Added pragmas to prevent unused variable       */
00027 /*            warnings.                                      */
00028 /*                                                           */
00029 /*************************************************************/
00030 
00031 /* =========================================
00032    *****************************************
00033                EXTERNAL DEFINITIONS
00034    =========================================
00035    ***************************************** */
00036 #include "setup.h"
00037 
00038 #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME)
00039 
00040 #if BLOAD || BLOAD_AND_BSAVE
00041 #include "bload.h"
00042 #endif
00043 
00044 #if DEFRULE_CONSTRUCT
00045 #include "network.h"
00046 #endif
00047 
00048 #if DEFGENERIC_CONSTRUCT
00049 #include "genrccom.h"
00050 #endif
00051 
00052 #include "constant.h"
00053 #include "cstrcpsr.h"
00054 #include "constrct.h"
00055 #include "dffnxfun.h"
00056 #include "envrnmnt.h"
00057 #include "expressn.h"
00058 #include "exprnpsr.h"
00059 #include "extnfunc.h"
00060 #include "memalloc.h"
00061 #include "prccode.h"
00062 #include "router.h"
00063 #include "scanner.h"
00064 #include "symbol.h"
00065 
00066 #define _DFFNXPSR_SOURCE_
00067 #include "dffnxpsr.h"
00068 
00069 /* =========================================
00070    *****************************************
00071       INTERNALLY VISIBLE FUNCTION HEADERS
00072    =========================================
00073    ***************************************** */
00074 
00075 static intBool ValidDeffunctionName(void *,char *);
00076 static DEFFUNCTION *AddDeffunction(void *,SYMBOL_HN *,EXPRESSION *,int,int,int,int);
00077 
00078 /* =========================================
00079    *****************************************
00080           EXTERNALLY VISIBLE FUNCTIONS
00081    =========================================
00082    ***************************************** */
00083 
00084 /***************************************************************************
00085   NAME         : ParseDeffunction
00086   DESCRIPTION  : Parses the deffunction construct
00087   INPUTS       : The input logical name
00088   RETURNS      : FALSE if successful parse, TRUE otherwise
00089   SIDE EFFECTS : Creates valid deffunction definition
00090   NOTES        : H/L Syntax :
00091                  (deffunction <name> [<comment>]
00092                     (<single-field-varible>* [<multifield-variable>])
00093                     <action>*)
00094  ***************************************************************************/
00095 globle intBool ParseDeffunction(
00096   void *theEnv,
00097   char *readSource)
00098   {
00099    SYMBOL_HN *deffunctionName;
00100    EXPRESSION *actions;
00101    EXPRESSION *parameterList;
00102    SYMBOL_HN *wildcard;
00103    int min,max,lvars,DeffunctionError = FALSE;
00104    short overwrite = FALSE, owMin = 0, owMax = 0;
00105    DEFFUNCTION *dptr;
00106 
00107    SetPPBufferStatus(theEnv,ON);
00108 
00109    FlushPPBuffer(theEnv);
00110    SetIndentDepth(theEnv,3);
00111    SavePPBuffer(theEnv,"(deffunction ");
00112 
00113 #if BLOAD || BLOAD_AND_BSAVE
00114    if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
00115      {
00116       CannotLoadWithBloadMessage(theEnv,"deffunctions");
00117       return(TRUE);
00118      }
00119 #endif
00120 
00121    /* =====================================================
00122       Parse the name and comment fields of the deffunction.
00123       ===================================================== */
00124    deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction",
00125                                                 EnvFindDeffunction,NULL,
00126                                                 "!",TRUE,TRUE,TRUE);
00127    if (deffunctionName == NULL)
00128      return(TRUE);
00129 
00130    if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE)
00131      return(TRUE);
00132 
00133    /*==========================*/
00134    /* Parse the argument list. */
00135    /*==========================*/
00136    parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard,
00137                                        &min,&max,&DeffunctionError,NULL);
00138    if (DeffunctionError)
00139      return(TRUE);
00140 
00141    /*===================================================================*/
00142    /* Go ahead and add the deffunction so it can be recursively called. */
00143    /*===================================================================*/
00144 
00145    if (ConstructData(theEnv)->CheckSyntaxMode)
00146      {
00147       dptr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(deffunctionName));
00148       if (dptr == NULL)
00149         { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
00150       else
00151         {
00152          overwrite = TRUE;
00153          owMin = (short) dptr->minNumberOfParameters;
00154          owMax = (short) dptr->maxNumberOfParameters;
00155          dptr->minNumberOfParameters = min;
00156          dptr->maxNumberOfParameters = max;
00157         }
00158      }
00159    else
00160      { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
00161 
00162    if (dptr == NULL)
00163      {
00164       ReturnExpression(theEnv,parameterList);
00165       return(TRUE);
00166      }
00167 
00168    /*==================================================*/
00169    /* Parse the actions contained within the function. */
00170    /*==================================================*/
00171 
00172    PPCRAndIndent(theEnv);
00173 
00174    ExpressionData(theEnv)->ReturnContext = TRUE;
00175    actions = ParseProcActions(theEnv,"deffunction",readSource,
00176                               &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard,
00177                               NULL,NULL,&lvars,NULL);
00178 
00179    /*=============================================================*/
00180    /* Check for the closing right parenthesis of the deffunction. */
00181    /*=============================================================*/
00182 
00183    if ((DeffunctionData(theEnv)->DFInputToken.type != RPAREN) && /* DR0872 */
00184        (actions != NULL))
00185      {
00186       SyntaxErrorMessage(theEnv,"deffunction");
00187       
00188       ReturnExpression(theEnv,parameterList);
00189       ReturnPackedExpression(theEnv,actions);
00190 
00191       if (overwrite)
00192         {
00193          dptr->minNumberOfParameters = owMin;
00194          dptr->maxNumberOfParameters = owMax;
00195         }
00196 
00197       if ((dptr->busy == 0) && (! overwrite))
00198         {
00199          RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
00200          RemoveDeffunction(theEnv,dptr);
00201         }
00202 
00203       return(TRUE);
00204      }
00205 
00206    if (actions == NULL)
00207      {
00208       ReturnExpression(theEnv,parameterList);
00209       if (overwrite)
00210         {
00211          dptr->minNumberOfParameters = owMin;
00212          dptr->maxNumberOfParameters = owMax;
00213         }
00214 
00215       if ((dptr->busy == 0) && (! overwrite))
00216         {
00217          RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
00218          RemoveDeffunction(theEnv,dptr);
00219         }
00220       return(TRUE);
00221      }
00222 
00223    /*==============================================*/
00224    /* If we're only checking syntax, don't add the */
00225    /* successfully parsed deffunction to the KB.   */
00226    /*==============================================*/
00227 
00228    if (ConstructData(theEnv)->CheckSyntaxMode)
00229      {
00230       ReturnExpression(theEnv,parameterList);
00231       ReturnPackedExpression(theEnv,actions);
00232       if (overwrite)
00233         {
00234          dptr->minNumberOfParameters = owMin;
00235          dptr->maxNumberOfParameters = owMax;
00236         }
00237       else
00238         {
00239          RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
00240          RemoveDeffunction(theEnv,dptr);
00241         }
00242       return(FALSE);
00243      }
00244 
00245    /*=============================*/
00246    /* Reformat the closing token. */
00247    /*=============================*/
00248 
00249    PPBackup(theEnv);
00250    PPBackup(theEnv);
00251    SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm);
00252    SavePPBuffer(theEnv,"\n");
00253 
00254    /*======================*/
00255    /* Add the deffunction. */
00256    /*======================*/
00257 
00258    AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE);
00259 
00260    ReturnExpression(theEnv,parameterList);
00261 
00262    return(DeffunctionError);
00263   }
00264 
00265 /* =========================================
00266    *****************************************
00267           INTERNALLY VISIBLE FUNCTIONS
00268    =========================================
00269    ***************************************** */
00270 
00271 /************************************************************
00272   NAME         : ValidDeffunctionName
00273   DESCRIPTION  : Determines if a new deffunction of the given
00274                  name can be defined in the current module
00275   INPUTS       : The new deffunction name
00276   RETURNS      : TRUE if OK, FALSE otherwise
00277   SIDE EFFECTS : Error message printed if not OK
00278   NOTES        : GetConstructNameAndComment() (called before
00279                  this function) ensures that the deffunction
00280                  name does not conflict with one from
00281                  another module
00282  ************************************************************/
00283 static intBool ValidDeffunctionName(
00284   void *theEnv,
00285   char *theDeffunctionName)
00286   {
00287    struct constructHeader *theDeffunction;
00288 #if DEFGENERIC_CONSTRUCT
00289    struct defmodule *theModule;
00290    struct constructHeader *theDefgeneric;
00291 #endif
00292 
00293    /* ============================================
00294       A deffunction cannot be named the same as a
00295       construct type, e.g, defclass, defrule, etc.
00296       ============================================ */
00297    if (FindConstruct(theEnv,theDeffunctionName) != NULL)
00298      {
00299       PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
00300       EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
00301       return(FALSE);
00302      }
00303 
00304    /* ============================================
00305       A deffunction cannot be named the same as a
00306       pre-defined system function, e.g, watch,
00307       list-defrules, etc.
00308       ============================================ */
00309    if (FindFunction(theEnv,theDeffunctionName) != NULL)
00310      {
00311       PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
00312       EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
00313       return(FALSE);
00314      }
00315 
00316 #if DEFGENERIC_CONSTRUCT
00317    /* ============================================
00318       A deffunction cannot be named the same as a
00319       generic function (either in this module or
00320       imported from another)
00321       ============================================ */
00322    theDefgeneric =
00323      (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
00324    if (theDefgeneric != NULL)
00325      {
00326       theModule = GetConstructModuleItem(theDefgeneric)->theModule;
00327       if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
00328         {
00329          PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
00330          EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
00331          EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
00332          EnvPrintRouter(theEnv,WERROR," imported from module ");
00333          EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
00334          EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
00335          return(FALSE);
00336         }
00337       else
00338         {
00339          PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
00340          EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
00341         }
00342       return(FALSE);
00343      }
00344 #endif
00345 
00346    theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName);
00347    if (theDeffunction != NULL)
00348      {
00349       /* ===========================================
00350          And a deffunction in the current module can
00351          only be redefined if it is not executing.
00352          =========================================== */
00353       if (((DEFFUNCTION *) theDeffunction)->executing)
00354         {
00355          PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
00356          EnvPrintRouter(theEnv,WERROR,"Deffunction ");
00357          EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
00358          EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
00359          return(FALSE);
00360         }
00361      }
00362    return(TRUE);
00363   }
00364 
00365 
00366 /****************************************************
00367   NAME         : AddDeffunction
00368   DESCRIPTION  : Adds a deffunction to the list of
00369                  deffunctions
00370   INPUTS       : 1) The symbolic name
00371                  2) The action expressions
00372                  3) The minimum number of arguments
00373                  4) The maximum number of arguments
00374                     (can be -1)
00375                  5) The number of local variables
00376                  6) A flag indicating if this is
00377                     a header call so that the
00378                     deffunction can be recursively
00379                     called
00380   RETURNS      : The new deffunction (NULL on errors)
00381   SIDE EFFECTS : Deffunction structures allocated
00382   NOTES        : Assumes deffunction is not executing
00383  ****************************************************/
00384 #if WIN_BTC
00385 #pragma argsused
00386 #endif
00387 static DEFFUNCTION *AddDeffunction(
00388   void *theEnv,
00389   SYMBOL_HN *name,
00390   EXPRESSION *actions,
00391   int min,
00392   int max,
00393   int lvars,
00394   int headerp)
00395   {
00396    DEFFUNCTION *dfuncPtr;
00397    unsigned oldbusy;
00398 #if DEBUGGING_FUNCTIONS
00399    unsigned DFHadWatch = FALSE;
00400 #else
00401 #if MAC_MCW || WIN_MCW || MAC_XCD
00402 #pragma unused(headerp)
00403 #endif
00404 #endif
00405 
00406    /*===============================================================*/
00407    /* If the deffunction doesn't exist, create a new structure to   */
00408    /* contain it and add it to the List of deffunctions. Otherwise, */
00409    /* use the existing structure and remove the pretty print form   */
00410    /* and interpretive code.                                        */
00411    /*===============================================================*/
00412    dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name));
00413    if (dfuncPtr == NULL)
00414      {
00415       dfuncPtr = get_struct(theEnv,deffunctionStruct);
00416       InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
00417       IncrementSymbolCount(name);
00418       dfuncPtr->code = NULL;
00419       dfuncPtr->minNumberOfParameters = min;
00420       dfuncPtr->maxNumberOfParameters = max;
00421       dfuncPtr->numberOfLocalVars = lvars;
00422       dfuncPtr->busy = 0;
00423       dfuncPtr->executing = 0;
00424      }
00425    else
00426      {
00427 #if DEBUGGING_FUNCTIONS
00428       DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
00429 #endif
00430       dfuncPtr->minNumberOfParameters = min;
00431       dfuncPtr->maxNumberOfParameters = max;
00432       dfuncPtr->numberOfLocalVars = lvars;
00433       oldbusy = dfuncPtr->busy;
00434       ExpressionDeinstall(theEnv,dfuncPtr->code);
00435       dfuncPtr->busy = oldbusy;
00436       ReturnPackedExpression(theEnv,dfuncPtr->code);
00437       dfuncPtr->code = NULL;
00438       SetDeffunctionPPForm((void *) dfuncPtr,NULL);
00439 
00440       /* =======================================
00441          Remove the deffunction from the list so
00442          that it can be added at the end
00443          ======================================= */
00444       RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
00445      }
00446 
00447    AddConstructToModule((struct constructHeader *) dfuncPtr);
00448 
00449    /* ==================================
00450       Install the new interpretive code.
00451       ================================== */
00452 
00453    if (actions != NULL)
00454      {
00455       /* ===============================
00456          If a deffunction is recursive,
00457          do not increment its busy count
00458          based on self-references
00459          =============================== */
00460       oldbusy = dfuncPtr->busy;
00461       ExpressionInstall(theEnv,actions);
00462       dfuncPtr->busy = oldbusy;
00463       dfuncPtr->code = actions;
00464      }
00465 
00466    /* ===============================================================
00467       Install the pretty print form if memory is not being conserved.
00468       =============================================================== */
00469 
00470 #if DEBUGGING_FUNCTIONS
00471    EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
00472    if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
00473      SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv));
00474 #endif
00475    return(dfuncPtr);
00476   }
00477 
00478 #endif /* DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */
00479