src/clipsrules/core/immthpsr.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*               CLIPS Version 6.24  07/01/05          */
00005    /*                                                     */
00006    /*         IMPLICIT SYSTEM METHODS PARSING MODULE      */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose: Parsing routines for Implicit System Methods     */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*                                                           */
00017 /* Revision History:                                         */
00018 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
00019 /*                                                           */
00020 /*      6.24: Added pragmas to remove unused parameter       */
00021 /*            warnings.                                      */
00022 /*                                                           */
00023 /*************************************************************/
00024 
00025 /* =========================================
00026    *****************************************
00027                EXTERNAL DEFINITIONS
00028    =========================================
00029    ***************************************** */
00030 #include "setup.h"
00031 
00032 #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME)
00033 
00034 #include <stdlib.h>
00035 
00036 #if OBJECT_SYSTEM
00037 #include "classcom.h"
00038 #include "classfun.h"
00039 #endif
00040 
00041 #include "envrnmnt.h"
00042 #include "memalloc.h"
00043 #include "cstrnutl.h"
00044 #include "extnfunc.h"
00045 #include "genrcpsr.h"
00046 #include "prccode.h"
00047 
00048 #define _IMMTHPSR_SOURCE_
00049 #include "immthpsr.h"
00050 
00051 /* =========================================
00052    *****************************************
00053       INTERNALLY VISIBLE FUNCTION HEADERS
00054    =========================================
00055    ***************************************** */
00056 
00057 static void FormMethodsFromRestrictions(void *,DEFGENERIC *,char *,EXPRESSION *);
00058 static RESTRICTION *ParseRestrictionType(void *,int);
00059 static EXPRESSION *GenTypeExpression(void *,EXPRESSION *,int,int,char *);
00060 
00061 /* =========================================
00062    *****************************************
00063           EXTERNALLY VISIBLE FUNCTIONS
00064    =========================================
00065    ***************************************** */
00066 
00067 /********************************************************
00068   NAME         : AddImplicitMethods
00069   DESCRIPTION  : Adds a method(s) for a generic function
00070                    for an overloaded system function
00071   INPUTS       : A pointer to a gneeric function
00072   RETURNS      : Nothing useful
00073   SIDE EFFECTS : Method added
00074   NOTES        : Method marked as system
00075                  Assumes no other methods already present
00076  ********************************************************/
00077 globle void AddImplicitMethods(
00078   void *theEnv,
00079   DEFGENERIC *gfunc)
00080   {
00081    struct FunctionDefinition *sysfunc;
00082    EXPRESSION action;
00083 
00084    sysfunc = FindFunction(theEnv,ValueToString(gfunc->header.name));
00085    if (sysfunc == NULL)
00086      return;
00087    action.type = FCALL;
00088    action.value = (void *) sysfunc;
00089    action.nextArg = NULL;
00090    action.argList = NULL;
00091    FormMethodsFromRestrictions(theEnv,gfunc,sysfunc->restrictions,&action);
00092   }
00093 
00094 /* =========================================
00095    *****************************************
00096           INTERNALLY VISIBLE FUNCTIONS
00097    =========================================
00098    ***************************************** */
00099 
00100 /**********************************************************************
00101   NAME         : FormMethodsFromRestrictions
00102   DESCRIPTION  : Uses restriction string given in DefineFunction2()
00103                    for system function to create an equivalent method
00104   INPUTS       : 1) The generic function for the new methods
00105                  2) System function restriction string
00106                     (see DefineFunction2() last argument)
00107                  3) The actions to attach to a new method(s)
00108   RETURNS      : Nothing useful
00109   SIDE EFFECTS : Implicit method(s) created
00110   NOTES        : None
00111  **********************************************************************/
00112 static void FormMethodsFromRestrictions(
00113   void *theEnv,
00114   DEFGENERIC *gfunc,
00115   char *rstring,
00116   EXPRESSION *actions)
00117   {
00118    DEFMETHOD *meth;
00119    EXPRESSION *plist,*tmp,*bot,*svBot;
00120    RESTRICTION *rptr;
00121    char theChar[2],defaultc;
00122    int min,max,mposn,needMinimumMethod;
00123    register int i,j;
00124 
00125    /* ===================================
00126       The system function will accept any
00127       number of any type of arguments
00128       =================================== */
00129    if (rstring == NULL)
00130      {
00131       tmp = get_struct(theEnv,expr);
00132       rptr = get_struct(theEnv,restriction);
00133       PackRestrictionTypes(theEnv,rptr,NULL);
00134       rptr->query = NULL;
00135       tmp->argList = (EXPRESSION *) rptr;
00136       tmp->nextArg = NULL;
00137       meth = AddMethod(theEnv,gfunc,NULL,0,0,tmp,1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv),
00138                        PackExpression(theEnv,actions),NULL,FALSE);
00139       meth->system = 1;
00140       DeleteTempRestricts(theEnv,tmp);
00141       return;
00142      }
00143 
00144    /* ==============================
00145       Extract the range of arguments
00146       from the restriction string
00147       ============================== */
00148    theChar[1] = '\0';
00149    if (rstring[0] == '*')
00150      min = 0;
00151    else
00152      {
00153       theChar[0] = rstring[0];
00154       min = atoi(theChar);
00155      }
00156    if (rstring[1] == '*')
00157      max = -1;
00158    else
00159      {
00160       theChar[0] = rstring[1];
00161       max = atoi(theChar);
00162      }
00163    if (rstring[2] != '\0')
00164      {
00165       defaultc = rstring[2];
00166       j = 3;
00167      }
00168    else
00169      {
00170       defaultc = 'u';
00171       j= 2;
00172      }
00173 
00174    /* ================================================
00175       Form a list of method restrictions corresponding
00176       to the minimum number of arguments
00177       ================================================ */
00178    plist = bot = NULL;
00179    for (i = 0 ; i < min ; i++)
00180      {
00181       theChar[0] = (rstring[j] != '\0') ? rstring[j++] : defaultc;
00182       rptr = ParseRestrictionType(theEnv,(int) theChar[0]);
00183       tmp = get_struct(theEnv,expr);
00184       tmp->argList = (EXPRESSION *) rptr;
00185       tmp->nextArg = NULL;
00186       if (plist == NULL)
00187         plist = tmp;
00188       else
00189         bot->nextArg = tmp;
00190       bot = tmp;
00191      }
00192 
00193    /* ===============================
00194       Remember where restrictions end
00195       for minimum number of arguments
00196       =============================== */
00197    svBot = bot;
00198    needMinimumMethod = TRUE;
00199 
00200    /* =======================================================
00201       Attach one or more new methods to correspond
00202       to the possible variations of the extra arguments
00203 
00204       Add a separate method for each specified extra argument
00205       ======================================================= */
00206    i = 0;
00207    while (rstring[j] != '\0')
00208      {
00209       if ((rstring[j+1] == '\0') && ((min + i + 1) == max))
00210         {
00211          defaultc = rstring[j];
00212          break;
00213         }
00214       rptr = ParseRestrictionType(theEnv,(int) rstring[j]);
00215       tmp = get_struct(theEnv,expr);
00216       tmp->argList = (EXPRESSION *) rptr;
00217       tmp->nextArg = NULL;
00218       if (plist == NULL)
00219         plist = tmp;
00220       else
00221         bot->nextArg = tmp;
00222       bot = tmp;
00223       i++;
00224       j++;
00225       if ((rstring[j] != '\0') || ((min + i) == max))
00226         {
00227          FindMethodByRestrictions(gfunc,plist,min + i,NULL,&mposn);
00228          meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i,0,NULL,
00229                           PackExpression(theEnv,actions),NULL,TRUE);
00230          meth->system = 1;
00231         }
00232      }
00233 
00234    /* ==============================================
00235       Add a method to account for wildcard arguments
00236       and attach a query in case there is a limit
00237       ============================================== */
00238    if ((min + i) != max)
00239      {
00240       /* ================================================
00241          If a wildcard is present immediately after the
00242          minimum number of args - then the minimum case
00243          will already be handled by this method. We don't
00244          need to add an extra method for that case
00245          ================================================ */
00246       if (i == 0)
00247         needMinimumMethod = FALSE;
00248 
00249       rptr = ParseRestrictionType(theEnv,(int) defaultc);
00250       if (max != -1)
00251         {
00252          rptr->query = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"<="));
00253          rptr->query->argList = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"length$"));
00254          rptr->query->argList->argList = GenProcWildcardReference(theEnv,min + i + 1);
00255          rptr->query->argList->nextArg =
00256                GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long long) (max - min - i)));
00257         }
00258       tmp = get_struct(theEnv,expr);
00259       tmp->argList = (EXPRESSION *) rptr;
00260       tmp->nextArg = NULL;
00261       if (plist == NULL)
00262         plist = tmp;
00263       else
00264         bot->nextArg = tmp;
00265       FindMethodByRestrictions(gfunc,plist,min + i + 1,(SYMBOL_HN *) EnvTrueSymbol(theEnv),&mposn);
00266       meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i + 1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv),
00267                        PackExpression(theEnv,actions),NULL,FALSE);
00268       meth->system = 1;
00269      }
00270 
00271    /* ===================================================
00272       When extra methods had to be added because of
00273       different restrictions on the optional arguments OR
00274       the system function accepts a fixed number of args,
00275       we must add a specific method for the minimum case.
00276       Otherwise, the method with the wildcard covers it.
00277       =================================================== */
00278    if (needMinimumMethod)
00279      {
00280       if (svBot != NULL)
00281         {
00282          bot = svBot->nextArg;
00283          svBot->nextArg = NULL;
00284          DeleteTempRestricts(theEnv,bot);
00285         }
00286       FindMethodByRestrictions(gfunc,plist,min,NULL,&mposn);
00287       meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min,0,NULL,
00288                        PackExpression(theEnv,actions),NULL,TRUE);
00289       meth->system = 1;
00290      }
00291    DeleteTempRestricts(theEnv,plist);
00292   }
00293 
00294 /*******************************************************************
00295   NAME         : ParseRestrictionType
00296   DESCRIPTION  : Takes a string of type character codes (as given in
00297                  DefineFunction2()) and converts it into a method
00298                  restriction structure
00299   INPUTS       : The type character code
00300   RETURNS      : The restriction
00301   SIDE EFFECTS : Restriction allocated
00302   NOTES        : None
00303  *******************************************************************/
00304 static RESTRICTION *ParseRestrictionType(
00305   void *theEnv,
00306   int code)
00307   {
00308    RESTRICTION *rptr;
00309    CONSTRAINT_RECORD *rv;
00310    EXPRESSION *types = NULL;
00311 
00312    rptr = get_struct(theEnv,restriction);
00313    rptr->query = NULL;
00314    rv = ArgumentTypeToConstraintRecord(theEnv,code);
00315    if (rv->anyAllowed == FALSE)
00316      {
00317       if (rv->symbolsAllowed && rv->stringsAllowed)
00318         types = GenTypeExpression(theEnv,types,LEXEME_TYPE_CODE,-1,LEXEME_TYPE_NAME);
00319       else if (rv->symbolsAllowed)
00320         types = GenTypeExpression(theEnv,types,SYMBOL,SYMBOL,NULL);
00321       else if (rv->stringsAllowed)
00322         types = GenTypeExpression(theEnv,types,STRING,STRING,NULL);
00323 
00324       if (rv->floatsAllowed && rv->integersAllowed)
00325         types = GenTypeExpression(theEnv,types,NUMBER_TYPE_CODE,-1,NUMBER_TYPE_NAME);
00326       else if (rv->integersAllowed)
00327         types = GenTypeExpression(theEnv,types,INTEGER,INTEGER,NULL);
00328       else if (rv->floatsAllowed)
00329         types = GenTypeExpression(theEnv,types,FLOAT,FLOAT,NULL);
00330 
00331       if (rv->instanceNamesAllowed && rv->instanceAddressesAllowed)
00332         types = GenTypeExpression(theEnv,types,INSTANCE_TYPE_CODE,-1,INSTANCE_TYPE_NAME);
00333       else if (rv->instanceNamesAllowed)
00334         types = GenTypeExpression(theEnv,types,INSTANCE_NAME,INSTANCE_NAME,NULL);
00335       else if (rv->instanceAddressesAllowed)
00336         types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL);
00337 
00338       if (rv->externalAddressesAllowed && rv->instanceAddressesAllowed &&
00339           rv->factAddressesAllowed)
00340         types = GenTypeExpression(theEnv,types,ADDRESS_TYPE_CODE,-1,ADDRESS_TYPE_NAME);
00341       else
00342         {
00343          if (rv->externalAddressesAllowed)
00344            types = GenTypeExpression(theEnv,types,EXTERNAL_ADDRESS,EXTERNAL_ADDRESS,NULL);
00345          if (rv->instanceAddressesAllowed && (rv->instanceNamesAllowed == 0))
00346            types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL);
00347          if (rv->factAddressesAllowed)
00348            types = GenTypeExpression(theEnv,types,FACT_ADDRESS,FACT_ADDRESS,NULL);
00349         }
00350 
00351       if (rv->multifieldsAllowed)
00352         types = GenTypeExpression(theEnv,types,MULTIFIELD,MULTIFIELD,NULL);
00353      }
00354    RemoveConstraint(theEnv,rv);
00355    PackRestrictionTypes(theEnv,rptr,types);
00356    return(rptr);
00357   }
00358 
00359 /***************************************************
00360   NAME         : GenTypeExpression
00361   DESCRIPTION  : Creates an expression corresponding
00362                  to the type specified and adds it
00363                  to the front of a temporary type
00364                  list for a method restriction
00365   INPUTS       : 1) The top of the current type list
00366                  2) The type code when COOL is
00367                     not installed
00368                  3) The primitive type (-1 if not
00369                     a primitive type)
00370                  4) The name of the COOL class if
00371                     it is not a primitive type
00372   RETURNS      : The new top of the types list
00373   SIDE EFFECTS : Type node allocated and attached
00374   NOTES        : Restriction types in a non-COOL
00375                  environment are the type codes
00376                  given in CONSTANT.H.  In a COOL
00377                  environment, they are pointers
00378                  to classes
00379  ***************************************************/
00380 #if WIN_BTC
00381 #pragma argsused
00382 #endif
00383 static EXPRESSION *GenTypeExpression(
00384   void *theEnv,
00385   EXPRESSION *top,
00386   int nonCOOLCode,
00387   int primitiveCode,
00388   char *COOLName)
00389   {
00390 #if OBJECT_SYSTEM
00391 #if MAC_MCW || WIN_MCW || MAC_XCD
00392 #pragma unused(nonCOOLCode)
00393 #endif
00394 #else
00395 #if MAC_MCW || WIN_MCW || MAC_XCD
00396 #pragma unused(primitiveCode)
00397 #pragma unused(COOLName)
00398 #endif
00399 #endif
00400    EXPRESSION *tmp;
00401 
00402 #if OBJECT_SYSTEM
00403    if (primitiveCode != -1)
00404      tmp = GenConstant(theEnv,0,(void *) DefclassData(theEnv)->PrimitiveClassMap[primitiveCode]);
00405    else
00406      tmp = GenConstant(theEnv,0,(void *) LookupDefclassByMdlOrScope(theEnv,COOLName));
00407 #else
00408    tmp = GenConstant(theEnv,0,EnvAddLong(theEnv,(long long) nonCOOLCode));
00409 #endif
00410    tmp->nextArg = top;
00411    return(tmp);
00412   }
00413 
00414 #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */
00415