src/clipsrules/core/insmult.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*              CLIPS Version 6.24  06/05/06           */
00005    /*                                                     */
00006    /*           INSTANCE MULTIFIELD SLOT MODULE           */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:  Access routines for Instance Multifield Slots   */
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: Renamed BOOLEAN macro type to intBool.         */
00021 /*                                                           */
00022 /*************************************************************/
00023 
00024 /* =========================================
00025    *****************************************
00026                EXTERNAL DEFINITIONS
00027    =========================================
00028    ***************************************** */
00029 #include "setup.h"
00030 
00031 #if OBJECT_SYSTEM
00032 
00033 #include "argacces.h"
00034 #include "envrnmnt.h"
00035 #include "extnfunc.h"
00036 #include "insfun.h"
00037 #include "msgfun.h"
00038 #include "msgpass.h"
00039 #include "multifun.h"
00040 #include "router.h"
00041 
00042 #define _INSMULT_SOURCE_
00043 #include "insmult.h"
00044 
00045 /* =========================================
00046    *****************************************
00047                    CONSTANTS
00048    =========================================
00049    ***************************************** */
00050 #define INSERT         0
00051 #define REPLACE        1
00052 #define DELETE_OP      2
00053 
00054 /* =========================================
00055    *****************************************
00056       INTERNALLY VISIBLE FUNCTION HEADERS
00057    =========================================
00058    ***************************************** */
00059 
00060 static INSTANCE_TYPE *CheckMultifieldSlotInstance(void *,char *);
00061 static INSTANCE_SLOT *CheckMultifieldSlotModify(void *,int,char *,INSTANCE_TYPE *,
00062                                        EXPRESSION *,long *,long *,DATA_OBJECT *);
00063 static void AssignSlotToDataObject(DATA_OBJECT *,INSTANCE_SLOT *);
00064 
00065 /* =========================================
00066    *****************************************
00067           EXTERNALLY VISIBLE FUNCTIONS
00068    =========================================
00069    ***************************************** */
00070 
00071 #if (! RUN_TIME)
00072 
00073 /***************************************************
00074   NAME         : SetupInstanceMultifieldCommands
00075   DESCRIPTION  : Defines function interfaces for
00076                  manipulating instance multislots
00077   INPUTS       : None
00078   RETURNS      : Nothing useful
00079   SIDE EFFECTS : Functions defined to KB
00080   NOTES        : None
00081  ***************************************************/
00082 globle void SetupInstanceMultifieldCommands(
00083   void *theEnv)
00084   {
00085    /* ===================================
00086       Old version 5.1 compatibility names
00087       =================================== */
00088    EnvDefineFunction2(theEnv,"direct-mv-replace",'b',PTIEF DirectMVReplaceCommand,
00089                    "DirectMVReplaceCommand","4**wii");
00090    EnvDefineFunction2(theEnv,"direct-mv-insert",'b',PTIEF DirectMVInsertCommand,
00091                    "DirectMVInsertCommand","3**wi");
00092    EnvDefineFunction2(theEnv,"direct-mv-delete",'b',PTIEF DirectMVDeleteCommand,
00093                    "DirectMVDeleteCommand","33iw");
00094    EnvDefineFunction2(theEnv,"mv-slot-replace",'u',PTIEF MVSlotReplaceCommand,
00095                    "MVSlotReplaceCommand","5*uewii");
00096    EnvDefineFunction2(theEnv,"mv-slot-insert",'u',PTIEF MVSlotInsertCommand,
00097                    "MVSlotInsertCommand","4*uewi");
00098    EnvDefineFunction2(theEnv,"mv-slot-delete",'u',PTIEF MVSlotDeleteCommand,
00099                    "MVSlotDeleteCommand","44iew");
00100 
00101    /* =====================
00102       New version 6.0 names
00103       ===================== */
00104    EnvDefineFunction2(theEnv,"slot-direct-replace$",'b',PTIEF DirectMVReplaceCommand,
00105                    "DirectMVReplaceCommand","4**wii");
00106    EnvDefineFunction2(theEnv,"slot-direct-insert$",'b',PTIEF DirectMVInsertCommand,
00107                    "DirectMVInsertCommand","3**wi");
00108    EnvDefineFunction2(theEnv,"slot-direct-delete$",'b',PTIEF DirectMVDeleteCommand,
00109                    "DirectMVDeleteCommand","33iw");
00110    EnvDefineFunction2(theEnv,"slot-replace$",'u',PTIEF MVSlotReplaceCommand,
00111                    "MVSlotReplaceCommand","5*uewii");
00112    EnvDefineFunction2(theEnv,"slot-insert$",'u',PTIEF MVSlotInsertCommand,
00113                    "MVSlotInsertCommand","4*uewi");
00114    EnvDefineFunction2(theEnv,"slot-delete$",'u',PTIEF MVSlotDeleteCommand,
00115                    "MVSlotDeleteCommand","44iew");
00116   }
00117 
00118 #endif
00119 
00120 /***********************************************************************************
00121   NAME         : MVSlotReplaceCommand
00122   DESCRIPTION  : Allows user to replace a specified field of a multi-value slot
00123                  The slot is directly read (w/o a get- message) and the new
00124                    slot-value is placed via a put- message.
00125                  This function is not valid for single-value slots.
00126   INPUTS       : Caller's result buffer
00127   RETURNS      : TRUE if multi-value slot successfully modified,
00128                  FALSE otherwise
00129   SIDE EFFECTS : Put messsage sent for slot
00130   NOTES        : H/L Syntax : (slot-replace$ <instance> <slot>
00131                                  <range-begin> <range-end> <value>)
00132  ***********************************************************************************/
00133 globle void MVSlotReplaceCommand(
00134   void *theEnv,
00135   DATA_OBJECT *result)
00136   {
00137    DATA_OBJECT newval,newseg,oldseg;
00138    INSTANCE_TYPE *ins;
00139    INSTANCE_SLOT *sp;
00140    long rb,re;
00141    EXPRESSION arg;
00142 
00143    result->type = SYMBOL;
00144    result->value = EnvFalseSymbol(theEnv);
00145    ins = CheckMultifieldSlotInstance(theEnv,"slot-replace$");
00146    if (ins == NULL)
00147      return;
00148    sp = CheckMultifieldSlotModify(theEnv,REPLACE,"slot-replace$",ins,
00149                             GetFirstArgument()->nextArg,&rb,&re,&newval);
00150    if (sp == NULL)
00151      return;
00152    AssignSlotToDataObject(&oldseg,sp);
00153    if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"slot-replace$") == FALSE)
00154      return;
00155    arg.type = MULTIFIELD;
00156    arg.value = (void *) &newseg;
00157    arg.nextArg = NULL;
00158    arg.argList = NULL;
00159    DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
00160   }
00161 
00162 /***********************************************************************************
00163   NAME         : MVSlotInsertCommand
00164   DESCRIPTION  : Allows user to insert a specified field of a multi-value slot
00165                  The slot is directly read (w/o a get- message) and the new
00166                    slot-value is placed via a put- message.
00167                  This function is not valid for single-value slots.
00168   INPUTS       : Caller's result buffer
00169   RETURNS      : TRUE if multi-value slot successfully modified, FALSE otherwise
00170   SIDE EFFECTS : Put messsage sent for slot
00171   NOTES        : H/L Syntax : (slot-insert$ <instance> <slot> <index> <value>)
00172  ***********************************************************************************/
00173 globle void MVSlotInsertCommand(
00174   void *theEnv,
00175   DATA_OBJECT *result)
00176   {
00177    DATA_OBJECT newval,newseg,oldseg;
00178    INSTANCE_TYPE *ins;
00179    INSTANCE_SLOT *sp;
00180    long theIndex;
00181    EXPRESSION arg;
00182 
00183    result->type = SYMBOL;
00184    result->value = EnvFalseSymbol(theEnv);
00185    ins = CheckMultifieldSlotInstance(theEnv,"slot-insert$");
00186    if (ins == NULL)
00187      return;
00188    sp = CheckMultifieldSlotModify(theEnv,INSERT,"slot-insert$",ins,
00189                             GetFirstArgument()->nextArg,&theIndex,NULL,&newval);
00190    if (sp == NULL)
00191      return;
00192    AssignSlotToDataObject(&oldseg,sp);
00193    if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"slot-insert$") == FALSE)
00194      return;
00195    arg.type = MULTIFIELD;
00196    arg.value = (void *) &newseg;
00197    arg.nextArg = NULL;
00198    arg.argList = NULL;
00199    DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
00200   }
00201 
00202 /***********************************************************************************
00203   NAME         : MVSlotDeleteCommand
00204   DESCRIPTION  : Allows user to delete a specified field of a multi-value slot
00205                  The slot is directly read (w/o a get- message) and the new
00206                    slot-value is placed via a put- message.
00207                  This function is not valid for single-value slots.
00208   INPUTS       : Caller's result buffer
00209   RETURNS      : TRUE if multi-value slot successfully modified, FALSE otherwise
00210   SIDE EFFECTS : Put message sent for slot
00211   NOTES        : H/L Syntax : (slot-delete$ <instance> <slot>
00212                                  <range-begin> <range-end>)
00213  ***********************************************************************************/
00214 globle void MVSlotDeleteCommand(
00215   void *theEnv,
00216   DATA_OBJECT *result)
00217   {
00218    DATA_OBJECT newseg,oldseg;
00219    INSTANCE_TYPE *ins;
00220    INSTANCE_SLOT *sp;
00221    long rb,re;
00222    EXPRESSION arg;
00223 
00224    result->type = SYMBOL;
00225    result->value = EnvFalseSymbol(theEnv);
00226    ins = CheckMultifieldSlotInstance(theEnv,"slot-delete$");
00227    if (ins == NULL)
00228      return;
00229    sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"slot-delete$",ins,
00230                             GetFirstArgument()->nextArg,&rb,&re,NULL);
00231    if (sp == NULL)
00232      return;
00233    AssignSlotToDataObject(&oldseg,sp);
00234    if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"slot-delete$") == FALSE)
00235      return;
00236    arg.type = MULTIFIELD;
00237    arg.value = (void *) &newseg;
00238    arg.nextArg = NULL;
00239    arg.argList = NULL;
00240    DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
00241   }
00242 
00243 /*****************************************************************
00244   NAME         : DirectMVReplaceCommand
00245   DESCRIPTION  : Directly replaces a slot's value
00246   INPUTS       : None
00247   RETURNS      : TRUE if put OK, FALSE otherwise
00248   SIDE EFFECTS : Slot modified
00249   NOTES        : H/L Syntax: (direct-slot-replace$ <slot>
00250                                 <range-begin> <range-end> <value>)
00251  *****************************************************************/
00252 globle intBool DirectMVReplaceCommand(
00253   void *theEnv)
00254   {
00255    INSTANCE_SLOT *sp;
00256    INSTANCE_TYPE *ins;
00257    long rb,re;
00258    DATA_OBJECT newval,newseg,oldseg;
00259 
00260    if (CheckCurrentMessage(theEnv,"direct-slot-replace$",TRUE) == FALSE)
00261      return(FALSE);
00262    ins = GetActiveInstance(theEnv);
00263    sp = CheckMultifieldSlotModify(theEnv,REPLACE,"direct-slot-replace$",ins,
00264                             GetFirstArgument(),&rb,&re,&newval);
00265    if (sp == NULL)
00266      return(FALSE);
00267    AssignSlotToDataObject(&oldseg,sp);
00268    if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"direct-slot-replace$")
00269            == FALSE)
00270      return(FALSE);
00271    if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-replace$"))
00272      return(TRUE);
00273    return(FALSE);
00274   }
00275 
00276 /************************************************************************
00277   NAME         : DirectMVInsertCommand
00278   DESCRIPTION  : Directly inserts a slot's value
00279   INPUTS       : None
00280   RETURNS      : TRUE if put OK, FALSE otherwise
00281   SIDE EFFECTS : Slot modified
00282   NOTES        : H/L Syntax: (direct-slot-insert$ <slot> <index> <value>)
00283  ************************************************************************/
00284 globle intBool DirectMVInsertCommand(
00285   void *theEnv)
00286   {
00287    INSTANCE_SLOT *sp;
00288    INSTANCE_TYPE *ins;
00289    long theIndex;
00290    DATA_OBJECT newval,newseg,oldseg;
00291 
00292    if (CheckCurrentMessage(theEnv,"direct-slot-insert$",TRUE) == FALSE)
00293      return(FALSE);
00294    ins = GetActiveInstance(theEnv);
00295    sp = CheckMultifieldSlotModify(theEnv,INSERT,"direct-slot-insert$",ins,
00296                             GetFirstArgument(),&theIndex,NULL,&newval);
00297    if (sp == NULL)
00298      return(FALSE);
00299    AssignSlotToDataObject(&oldseg,sp);
00300    if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"direct-slot-insert$")
00301           == FALSE)
00302      return(FALSE);
00303    if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-insert$"))
00304      return(TRUE);
00305    return(FALSE);
00306   }
00307 
00308 /*****************************************************************
00309   NAME         : DirectMVDeleteCommand
00310   DESCRIPTION  : Directly deletes a slot's value
00311   INPUTS       : None
00312   RETURNS      : TRUE if put OK, FALSE otherwise
00313   SIDE EFFECTS : Slot modified
00314   NOTES        : H/L Syntax: (direct-slot-delete$ <slot>
00315                                 <range-begin> <range-end>)
00316  *****************************************************************/
00317 globle intBool DirectMVDeleteCommand(
00318   void *theEnv)
00319   {
00320    INSTANCE_SLOT *sp;
00321    INSTANCE_TYPE *ins;
00322    long rb,re;
00323    DATA_OBJECT newseg,oldseg;
00324 
00325    if (CheckCurrentMessage(theEnv,"direct-slot-delete$",TRUE) == FALSE)
00326      return(FALSE);
00327    ins = GetActiveInstance(theEnv);
00328    sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"direct-slot-delete$",ins,
00329                                   GetFirstArgument(),&rb,&re,NULL);
00330    if (sp == NULL)
00331      return(FALSE);
00332    AssignSlotToDataObject(&oldseg,sp);
00333    if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"direct-slot-delete$")
00334          == FALSE)
00335      return(FALSE);
00336    if (PutSlotValue(theEnv,ins,sp,&newseg,&oldseg,"function direct-slot-delete$"))
00337      return(TRUE);
00338    return(FALSE);
00339   }
00340 
00341 /* =========================================
00342    *****************************************
00343           INTERNALLY VISIBLE FUNCTIONS
00344    =========================================
00345    ***************************************** */
00346 
00347 /**********************************************************************
00348   NAME         : CheckMultifieldSlotInstance
00349   DESCRIPTION  : Gets the instance for the functions slot-replace$,
00350                     insert and delete
00351   INPUTS       : The function name
00352   RETURNS      : The instance address, NULL on errors
00353   SIDE EFFECTS : None
00354   NOTES        : None
00355  **********************************************************************/
00356 static INSTANCE_TYPE *CheckMultifieldSlotInstance(
00357   void *theEnv,
00358   char *func)
00359   {
00360    INSTANCE_TYPE *ins;
00361    DATA_OBJECT temp;
00362 
00363    if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)
00364      {
00365       SetEvaluationError(theEnv,TRUE);
00366       return(NULL);
00367      }
00368    if (temp.type == INSTANCE_ADDRESS)
00369      {
00370       ins = (INSTANCE_TYPE *) temp.value;
00371       if (ins->garbage == 1)
00372         {
00373          StaleInstanceAddress(theEnv,func,0);
00374          SetEvaluationError(theEnv,TRUE);
00375          return(NULL);
00376         }
00377      }
00378    else
00379      {
00380       ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
00381       if (ins == NULL)
00382         NoInstanceError(theEnv,ValueToString(temp.value),func);
00383      }
00384    return(ins);
00385   }
00386 
00387 /*********************************************************************
00388   NAME         : CheckMultifieldSlotModify
00389   DESCRIPTION  : For the functions slot-replace$, insert, & delete
00390                     as well as direct-slot-replace$, insert, & delete
00391                     this function gets the slot, index, and optional
00392                     field-value for these functions
00393   INPUTS       : 1) A code indicating the type of operation
00394                       INSERT    (0) : Requires one index
00395                       REPLACE   (1) : Requires two indices
00396                       DELETE_OP (2) : Requires two indices
00397                  2) Function name-string
00398                  3) Instance address
00399                  4) Argument expression chain
00400                  5) Caller's buffer for index (or beginning of range)
00401                  6) Caller's buffer for end of range
00402                      (can be NULL for INSERT)
00403                  7) Caller's new-field value buffer
00404                      (can be NULL for DELETE_OP)
00405   RETURNS      : The address of the instance-slot,
00406                     NULL on errors
00407   SIDE EFFECTS : Caller's index buffer set
00408                  Caller's new-field value buffer set (if not NULL)
00409                    Will allocate an ephemeral segment to store more
00410                      than 1 new field value
00411                  EvaluationError set on errors
00412   NOTES        : Assume the argument chain is at least 2
00413                    expressions deep - slot, index, and optional values
00414  *********************************************************************/
00415 static INSTANCE_SLOT *CheckMultifieldSlotModify(
00416   void *theEnv,
00417   int code,
00418   char *func,
00419   INSTANCE_TYPE *ins,
00420   EXPRESSION *args,
00421   long *rb,
00422   long *re,
00423   DATA_OBJECT *newval)
00424   {
00425    DATA_OBJECT temp;
00426    INSTANCE_SLOT *sp;
00427    int start;
00428 
00429    start = (args == GetFirstArgument()) ? 1 : 2;
00430    EvaluationData(theEnv)->EvaluationError = FALSE;
00431    EvaluateExpression(theEnv,args,&temp);
00432    if (temp.type != SYMBOL)
00433      {
00434       ExpectedTypeError1(theEnv,func,start,"symbol");
00435       SetEvaluationError(theEnv,TRUE);
00436       return(NULL);
00437      }
00438    sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
00439    if (sp == NULL)
00440      {
00441       SlotExistError(theEnv,ValueToString(temp.value),func);
00442       return(NULL);
00443      }
00444    if (sp->desc->multiple == 0)
00445      {
00446       PrintErrorID(theEnv,"INSMULT",1,FALSE);
00447       EnvPrintRouter(theEnv,WERROR,"Function ");
00448       EnvPrintRouter(theEnv,WERROR,func);
00449       EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot ");
00450       EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
00451       EnvPrintRouter(theEnv,WERROR," in instance ");
00452       EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
00453       EnvPrintRouter(theEnv,WERROR,".\n");
00454       SetEvaluationError(theEnv,TRUE);
00455       return(NULL);
00456      }
00457    EvaluateExpression(theEnv,args->nextArg,&temp);
00458    if (temp.type != INTEGER)
00459      {
00460       ExpectedTypeError1(theEnv,func,start+1,"integer");
00461       SetEvaluationError(theEnv,TRUE);
00462       return(NULL);
00463      }
00464    args = args->nextArg->nextArg;
00465    *rb = (long) ValueToLong(temp.value);
00466    if ((code == REPLACE) || (code == DELETE_OP))
00467      {
00468       EvaluateExpression(theEnv,args,&temp);
00469       if (temp.type != INTEGER)
00470         {
00471          ExpectedTypeError1(theEnv,func,start+2,"integer");
00472          SetEvaluationError(theEnv,TRUE);
00473          return(NULL);
00474         }
00475       *re = (long) ValueToLong(temp.value);
00476       args = args->nextArg;
00477      }
00478    if ((code == INSERT) || (code == REPLACE))
00479      {
00480       if (EvaluateAndStoreInDataObject(theEnv,1,args,newval,TRUE) == FALSE)
00481         return(NULL);
00482      }
00483    return(sp);
00484   }
00485 
00486 /***************************************************
00487   NAME         : AssignSlotToDataObject
00488   DESCRIPTION  : Assigns the value of a multifield
00489                  slot to a data object
00490   INPUTS       : 1) The data object buffer
00491                  2) The instance slot
00492   RETURNS      : Nothing useful
00493   SIDE EFFECTS : Data object fields set
00494   NOTES        : Assumes slot is a multislot
00495  ***************************************************/
00496 static void AssignSlotToDataObject(
00497   DATA_OBJECT *theDataObject,
00498   INSTANCE_SLOT *theSlot)
00499   {
00500    theDataObject->type = (unsigned short) theSlot->type;
00501    theDataObject->value = theSlot->value;
00502    theDataObject->begin = 0;
00503    SetpDOEnd(theDataObject,GetInstanceSlotLength(theSlot));
00504   }
00505 
00506 #endif
00507 
00508 /***************************************************
00509   NAME         :
00510   DESCRIPTION  :
00511   INPUTS       :
00512   RETURNS      :
00513   SIDE EFFECTS :
00514   NOTES        :
00515  ***************************************************/
00516 
00517