/********************************************************
NAME : CreateInitialDefinstances
DESCRIPTION : Makes the initial-object definstances
structure for creating an initial-object
which will match default object patterns
in defrules
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : initial-object definstances created
NOTES : None
********************************************************/
static void CreateInitialDefinstances(
void *theEnv)
{
EXPRESSION *tmp;
DEFINSTANCES *theDefinstances;
theDefinstances = get_struct(theEnv,definstances);
InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances,
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
theDefinstances->busy = 0;
tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance"));
tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
tmp->argList->nextArg =
GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));
theDefinstances->mkinstance = PackExpression(theEnv,tmp);
ReturnExpression(theEnv,tmp);
IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));
ExpressionInstall(theEnv,theDefinstances->mkinstance);
AddConstructToModule((struct constructHeader *) theDefinstances);
}
/****************************************************
NAME : AddDeffunction
DESCRIPTION : Adds a deffunction to the list of
deffunctions
INPUTS : 1) The symbolic name
2) The action expressions
3) The minimum number of arguments
4) The maximum number of arguments
(can be -1)
5) The number of local variables
6) A flag indicating if this is
a header call so that the
deffunction can be recursively
called
RETURNS : The new deffunction (NULL on errors)
SIDE EFFECTS : Deffunction structures allocated
NOTES : Assumes deffunction is not executing
****************************************************/
static DEFFUNCTION *AddDeffunction(
void *theEnv,
SYMBOL_HN *name,
EXPRESSION *actions,
int min,
int max,
int lvars,
int headerp)
{
DEFFUNCTION *dfuncPtr;
unsigned oldbusy;
#if DEBUGGING_FUNCTIONS
unsigned DFHadWatch = FALSE;
#endif
/*===============================================================*/
/* If the deffunction doesn't exist, create a new structure to */
/* contain it and add it to the List of deffunctions. Otherwise, */
/* use the existing structure and remove the pretty print form */
/* and interpretive code. */
/*===============================================================*/
dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name));
if (dfuncPtr == NULL)
{
dfuncPtr = get_struct(theEnv,deffunctionStruct);
InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
IncrementSymbolCount(name);
dfuncPtr->code = NULL;
dfuncPtr->minNumberOfParameters = min;
dfuncPtr->maxNumberOfParameters = max;
dfuncPtr->numberOfLocalVars = lvars;
dfuncPtr->busy = 0;
dfuncPtr->executing = 0;
}
else
{
#if DEBUGGING_FUNCTIONS
DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
#endif
dfuncPtr->minNumberOfParameters = min;
dfuncPtr->maxNumberOfParameters = max;
dfuncPtr->numberOfLocalVars = lvars;
oldbusy = dfuncPtr->busy;
ExpressionDeinstall(theEnv,dfuncPtr->code);
dfuncPtr->busy = oldbusy;
ReturnPackedExpression(theEnv,dfuncPtr->code);
dfuncPtr->code = NULL;
SetDeffunctionPPForm((void *) dfuncPtr,NULL);
/* =======================================
Remove the deffunction from the list so
that it can be added at the end
======================================= */
RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
}
AddConstructToModule((struct constructHeader *) dfuncPtr);
/* ==================================
Install the new interpretive code.
================================== */
if (actions != NULL)
{
/* ===============================
If a deffunction is recursive,
do not increment its busy count
based on self-references
=============================== */
oldbusy = dfuncPtr->busy;
ExpressionInstall(theEnv,actions);
dfuncPtr->busy = oldbusy;
dfuncPtr->code = actions;
}
/* ===============================================================
Install the pretty print form if memory is not being conserved.
=============================================================== */
#if DEBUGGING_FUNCTIONS
EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv));
#endif
return(dfuncPtr);
}
bool ParseDeffacts(
Environment *theEnv,
const char *readSource)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
CLIPSLexeme *deffactsName;
struct expr *temp;
Deffacts *newDeffacts;
bool deffactsError;
struct token inputToken;
/*=========================*/
/* Parsing initialization. */
/*=========================*/
deffactsError = false;
SetPPBufferStatus(theEnv,true);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(deffacts ");
/*==========================================================*/
/* Deffacts can not be added when a binary image is loaded. */
/*==========================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == true) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deffacts");
return true;
}
#endif
/*============================*/
/* Parse the deffacts header. */
/*============================*/
deffactsName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deffacts",
(FindConstructFunction *) FindDeffactsInModule,
(DeleteConstructFunction *) Undeffacts,"$",true,
true,true,false);
if (deffactsName == NULL) { return true; }
/*===============================================*/
/* Parse the list of facts in the deffacts body. */
/*===============================================*/
temp = BuildRHSAssert(theEnv,readSource,&inputToken,&deffactsError,false,false,"deffacts");
if (deffactsError == true) { return true; }
if (ExpressionContainsVariables(temp,false))
{
LocalVariableErrorMessage(theEnv,"a deffacts construct");
ReturnExpression(theEnv,temp);
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)
{
ReturnExpression(theEnv,temp);
return false;
}
/*==========================*/
/* Create the new deffacts. */
/*==========================*/
ExpressionInstall(theEnv,temp);
newDeffacts = get_struct(theEnv,deffacts);
IncrementLexemeCount(deffactsName);
InitializeConstructHeader(theEnv,"deffacts",DEFFACTS,&newDeffacts->header,deffactsName);
newDeffacts->assertList = PackExpression(theEnv,temp);
ReturnExpression(theEnv,temp);
/*=======================================================*/
/* Save the pretty print representation of the deffacts. */
/*=======================================================*/
if (GetConserveMemory(theEnv) == true)
{ newDeffacts->header.ppForm = NULL; }
else
{ newDeffacts->header.ppForm = CopyPPBuffer(theEnv); }
/*=============================================*/
/* Add the deffacts to the appropriate module. */
/*=============================================*/
AddConstructToModule(&newDeffacts->header);
#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */
/*================================================================*/
/* Return false to indicate the deffacts was successfully parsed. */
/*================================================================*/
return false;
}
/*********************************************************************
NAME : ParseDefinstances
DESCRIPTION : Parses and allocates a definstances construct
INPUTS : The logical name of the input source
RETURNS : FALSE if no errors, TRUE otherwise
SIDE EFFECTS : Definstances parsed and created
NOTES : H/L Syntax :
(definstances <name> [active] [<comment>]
<instance-definition>+)
<instance-definition> ::=
(<instance-name> of <class-name> <slot-override>*)
<slot-override> ::= (<slot-name> <value-expression>*)
*********************************************************************/
static int ParseDefinstances(
void *theEnv,
char *readSource)
{
SYMBOL_HN *dname;
void *mkinsfcall;
EXPRESSION *mkinstance,*mkbot = NULL;
DEFINSTANCES *dobj;
int active;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,(char*)"(definstances ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,(char*)"definstances");
return(TRUE);
}
#endif
dname = ParseDefinstancesName(theEnv,readSource,&active);
if (dname == NULL)
return(TRUE);
dobj = get_struct(theEnv,definstances);
InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) dobj,dname);
dobj->busy = 0;
dobj->mkinstance = NULL;
#if DEFRULE_CONSTRUCT
if (active)
mkinsfcall = (void *) FindFunction(theEnv,(char*)"active-make-instance");
else
mkinsfcall = (void *) FindFunction(theEnv,(char*)"make-instance");
#else
mkinsfcall = (void *) FindFunction(theEnv,(char*)"make-instance");
#endif
while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
{
mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall);
mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource);
if (mkinstance == NULL)
{
ReturnExpression(theEnv,dobj->mkinstance);
rtn_struct(theEnv,definstances,dobj);
return(TRUE);
}
if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE)
{
LocalVariableErrorMessage(theEnv,(char*)"definstances");
ReturnExpression(theEnv,mkinstance);
ReturnExpression(theEnv,dobj->mkinstance);
rtn_struct(theEnv,definstances,dobj);
return(TRUE);
}
if (mkbot == NULL)
dobj->mkinstance = mkinstance;
else
GetNextArgument(mkbot) = mkinstance;
mkbot = mkinstance;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
ReturnExpression(theEnv,dobj->mkinstance);
rtn_struct(theEnv,definstances,dobj);
SyntaxErrorMessage(theEnv,(char*)"definstances");
return(TRUE);
}
else
{
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,dobj->mkinstance);
rtn_struct(theEnv,definstances,dobj);
return(FALSE);
}
#if DEBUGGING_FUNCTIONS
if (EnvGetConserveMemory(theEnv) == FALSE)
{
if (dobj->mkinstance != NULL)
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)")\n");
SetDefinstancesPPForm((void *) dobj,CopyPPBuffer(theEnv));
}
#endif
mkinstance = dobj->mkinstance;
dobj->mkinstance = PackExpression(theEnv,mkinstance);
ReturnExpression(theEnv,mkinstance);
IncrementSymbolCount(GetDefinstancesNamePointer((void *) dobj));
ExpressionInstall(theEnv,dobj->mkinstance);
}
AddConstructToModule((struct constructHeader *) dobj);
return(FALSE);
}
