/*************************************************************
NAME : ParseDefinstancesName
DESCRIPTION : Parses definstance name and optional comment
and optional "active" keyword
INPUTS : 1) The logical name of the input source
2) Buffer to hold flag indicating if
definstances should cause pattern-matching
to occur during slot-overrides
RETURNS : Address of name symbol, or
NULL if there was an error
SIDE EFFECTS : Token after name or comment is scanned
NOTES : Assumes "(definstances" has already
been scanned.
*************************************************************/
static SYMBOL_HN *ParseDefinstancesName(
void *theEnv,
char *readSource,
int *active)
{
SYMBOL_HN *dname;
*active = FALSE;
dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,(char*)"definstances",
EnvFindDefinstances,EnvUndefinstances,(char*)"@",
TRUE,FALSE,TRUE);
if (dname == NULL)
return(NULL);
#if DEFRULE_CONSTRUCT
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE :
(strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0))
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)" ");
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
*active = TRUE;
}
#endif
if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)" ");
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
return(dname);
}
globle int ParseDefmodule(
void *theEnv,
char *readSource)
{
SYMBOL_HN *defmoduleName;
struct defmodule *newDefmodule;
struct token inputToken;
int i;
struct moduleItem *theItem;
struct portItem *portSpecs, *nextSpec;
struct defmoduleItemHeader *theHeader;
struct callFunctionItem *defineFunctions;
struct defmodule *redefiningMainModule = NULL;
int parseError;
struct portItem *oldImportList = NULL, *oldExportList = NULL;
short overwrite = FALSE;
/*================================================*/
/* Flush the buffer which stores the pretty print */
/* representation for a module. Add the already */
/* parsed keyword defmodule to this buffer. */
/*================================================*/
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defmodule ");
/*===============================*/
/* Modules cannot be loaded when */
/* a binary load is in effect. */
/*===============================*/
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defmodule");
return(TRUE);
}
#endif
/*=====================================================*/
/* Parse the name and comment fields of the defmodule. */
/* Remove the defmodule if it already exists. */
/*=====================================================*/
defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
EnvFindDefmodule,DeleteDefmodule,"+",
TRUE,TRUE,FALSE);
if (defmoduleName == NULL) { return(TRUE); }
if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
{ redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }
/*==============================================*/
/* Create the defmodule structure if necessary. */
/*==============================================*/
if (redefiningMainModule == NULL)
{
newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
if (newDefmodule)
{ overwrite = TRUE; }
else
{
newDefmodule = get_struct(theEnv,defmodule);
newDefmodule->name = defmoduleName;
newDefmodule->usrData = NULL;
newDefmodule->next = NULL;
}
}
else
{
overwrite = TRUE;
newDefmodule = redefiningMainModule;
}
if (overwrite)
{
oldImportList = newDefmodule->importList;
oldExportList = newDefmodule->exportList;
}
newDefmodule->importList = NULL;
newDefmodule->exportList = NULL;
/*===================================*/
/* Finish parsing the defmodule (its */
/* import/export specifications). */
/*===================================*/
parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);
/*====================================*/
/* Check for import/export conflicts. */
/*====================================*/
if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);
/*======================================================*/
/* If an error occured in parsing or an import conflict */
/* was detected, abort the definition of the defmodule. */
/* If we're only checking syntax, then we want to exit */
/* at this point as well. */
/*======================================================*/
if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
{
while (newDefmodule->importList != NULL)
{
nextSpec = newDefmodule->importList->next;
rtn_struct(theEnv,portItem,newDefmodule->importList);
newDefmodule->importList = nextSpec;
}
while (newDefmodule->exportList != NULL)
{
nextSpec = newDefmodule->exportList->next;
rtn_struct(theEnv,portItem,newDefmodule->exportList);
newDefmodule->exportList = nextSpec;
}
if ((redefiningMainModule == NULL) && (! overwrite))
{ rtn_struct(theEnv,defmodule,newDefmodule); }
if (overwrite)
{
newDefmodule->importList = oldImportList;
newDefmodule->exportList = oldExportList;
}
if (parseError) return(TRUE);
return(FALSE);
}
/*===============================================*/
/* Increment the symbol table counts for symbols */
/* used in the defmodule data structures. */
/*===============================================*/
if (redefiningMainModule == NULL)
{ IncrementSymbolCount(newDefmodule->name); }
else
{
if ((newDefmodule->importList != NULL) ||
(newDefmodule->exportList != NULL))
{ DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
}
for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
{
if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
}
for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
{
if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
}
/*====================================================*/
/* Allocate storage for the module's construct lists. */
/*====================================================*/
if (redefiningMainModule != NULL) { /* Do nothing */ }
else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
else
{
newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
(i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
i++, theItem = theItem->next)
{
if (theItem->allocateFunction == NULL)
{ newDefmodule->itemsArray[i] = NULL; }
else
{
newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
(*theItem->allocateFunction)(theEnv);
theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
theHeader->theModule = newDefmodule;
theHeader->firstItem = NULL;
theHeader->lastItem = NULL;
}
}
}
/*=======================================*/
/* Save the pretty print representation. */
/*=======================================*/
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ newDefmodule->ppForm = NULL; }
else
{ newDefmodule->ppForm = CopyPPBuffer(theEnv); }
/*==============================================*/
/* Add the defmodule to the list of defmodules. */
/*==============================================*/
if (redefiningMainModule == NULL)
{
if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
}
EnvSetCurrentModule(theEnv,(void *) newDefmodule);
/*=========================================*/
/* Call any functions required by other */
/* constructs when a new module is defined */
/*=========================================*/
for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
defineFunctions != NULL;
defineFunctions = defineFunctions->next)
{ (* (void (*)(void *)) defineFunctions->func)(theEnv); }
/*===============================================*/
/* Defmodule successfully parsed with no errors. */
/*===============================================*/
return(FALSE);
}
/***************************************************************************
NAME : ParseDeffunction
DESCRIPTION : Parses the deffunction construct
INPUTS : The input logical name
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Creates valid deffunction definition
NOTES : H/L Syntax :
(deffunction <name> [<comment>]
(<single-field-varible>* [<multifield-variable>])
<action>*)
***************************************************************************/
globle BOOLEAN ParseDeffunction(
void *theEnv,
char *readSource)
{
SYMBOL_HN *deffunctionName;
EXPRESSION *actions;
EXPRESSION *parameterList;
SYMBOL_HN *wildcard;
int min,max,lvars,DeffunctionError = FALSE;
short overwrite = FALSE, owMin = 0, owMax = 0;
DEFFUNCTION *dptr;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(deffunction ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deffunctions");
return(TRUE);
}
#endif
/* =====================================================
Parse the name and comment fields of the deffunction.
===================================================== */
deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction",
EnvFindDeffunction,NULL,
"!",TRUE,TRUE,TRUE);
if (deffunctionName == NULL)
return(TRUE);
if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE)
return(TRUE);
/*==========================*/
/* Parse the argument list. */
/*==========================*/
parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard,
&min,&max,&DeffunctionError,NULL);
if (DeffunctionError)
return(TRUE);
/*===================================================================*/
/* Go ahead and add the deffunction so it can be recursively called. */
/*===================================================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
dptr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(deffunctionName));
if (dptr == NULL)
{ dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
else
{
overwrite = TRUE;
owMin = (short) dptr->minNumberOfParameters;
owMax = (short) dptr->maxNumberOfParameters;
dptr->minNumberOfParameters = min;
dptr->maxNumberOfParameters = max;
}
}
else
{ dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
if (dptr == NULL)
{
ReturnExpression(theEnv,parameterList);
return(TRUE);
}
/*==================================================*/
/* Parse the actions contained within the function. */
/*==================================================*/
PPCRAndIndent(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseProcActions(theEnv,"deffunction",readSource,
&DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard,
NULL,NULL,&lvars,NULL);
if (actions == NULL)
{
ReturnExpression(theEnv,parameterList);
if (overwrite)
{
dptr->minNumberOfParameters = owMin;
dptr->maxNumberOfParameters = owMax;
}
if ((dptr->busy == 0) && (! overwrite))
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
RemoveDeffunction(theEnv,dptr);
}
return(TRUE);
}
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deffunction to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,parameterList);
ReturnPackedExpression(theEnv,actions);
if (overwrite)
{
dptr->minNumberOfParameters = owMin;
dptr->maxNumberOfParameters = owMax;
}
else
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
RemoveDeffunction(theEnv,dptr);
}
return(FALSE);
}
/*=============================*/
/* Reformat the closing token. */
/*=============================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm);
SavePPBuffer(theEnv,"\n");
/*======================*/
/* Add the deffunction. */
/*======================*/
AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE);
ReturnExpression(theEnv,parameterList);
return(DeffunctionError);
}
/***************************************************************************************
NAME : ParseDefclass
DESCRIPTION : (defclass ...) is a construct (as
opposed to a function), thus no variables
may be used. This means classes may only
be STATICALLY defined (like rules).
INPUTS : The logical name of the router
for the parser input
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Inserts valid class definition into
Class Table.
NOTES : H/L Syntax :
(defclass <name> [<comment>]
(is-a <superclass-name>+)
<class-descriptor>*)
<class-descriptor> :== (slot <name> <slot-descriptor>*) |
(role abstract|concrete) |
(pattern-match reactive|non-reactive)
These are for documentation only:
(message-handler <name> [<type>])
<slot-descriptor> :== (default <default-expression>) |
(default-dynamic <default-expression>) |
(storage shared|local) |
(access read-only|read-write|initialize-only) |
(propagation no-inherit|inherit) |
(source composite|exclusive)
(pattern-match reactive|non-reactive)
(visibility public|private)
(override-message <message-name>)
(type ...) |
(cardinality ...) |
(allowed-symbols ...) |
(allowed-strings ...) |
(allowed-numbers ...) |
(allowed-integers ...) |
(allowed-floats ...) |
(allowed-values ...) |
(allowed-instance-names ...) |
(allowed-classes ...) |
(range ...)
<default-expression> ::= ?NONE | ?VARIABLE | <expression>*
***************************************************************************************/
globle int ParseDefclass(
void *theEnv,
char *readSource)
{
SYMBOL_HN *cname;
DEFCLASS *cls;
PACKED_CLASS_LINKS *sclasses,*preclist;
TEMP_SLOT_LINK *slots = NULL;
int roleSpecified = FALSE,
abstract = FALSE,
parseError;
#if DEFRULE_CONSTRUCT
int patternMatchSpecified = FALSE,
reactive = TRUE;
#endif
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defclass ");
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defclass");
return(TRUE);
}
#endif
cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass",
EnvFindDefclass,NULL,"#",TRUE,
TRUE,TRUE);
if (cname == NULL)
return(TRUE);
if (ValidClassName(theEnv,ValueToString(cname),&cls) == FALSE)
return(TRUE);
sclasses = ParseSuperclasses(theEnv,readSource,cname);
if (sclasses == NULL)
return(TRUE);
preclist = FindPrecedenceList(theEnv,cls,sclasses);
if (preclist == NULL)
{
DeletePackedClassLinks(theEnv,sclasses,TRUE);
return(TRUE);
}
parseError = FALSE;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
{
SyntaxErrorMessage(theEnv,"defclass");
parseError = TRUE;
break;
}
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,"(");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defclass");
parseError = TRUE;
break;
}
if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ROLE_RLN) == 0)
{
if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN,
&roleSpecified,&abstract) == FALSE)
{
parseError = TRUE;
break;
}
}
#if DEFRULE_CONSTRUCT
else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_RLN) == 0)
{
if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN,
&patternMatchSpecified,&reactive) == FALSE)
{
parseError = TRUE;
break;
}
}
#endif
else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SLOT_RLN) == 0)
{
slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,FALSE);
if (slots == NULL)
{
parseError = TRUE;
break;
}
}
else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SGL_SLOT_RLN) == 0)
{
slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,TRUE);
if (slots == NULL)
{
parseError = TRUE;
break;
}
}
else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MLT_SLOT_RLN) == 0)
{
slots = ParseSlot(theEnv,readSource,slots,preclist,TRUE,TRUE);
if (slots == NULL)
{
parseError = TRUE;
break;
}
}
else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),HANDLER_DECL) == 0)
{
if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == FALSE)
{
parseError = TRUE;
break;
}
}
else
{
SyntaxErrorMessage(theEnv,"defclass");
parseError = TRUE;
break;
}
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) || (parseError == TRUE))
{
DeletePackedClassLinks(theEnv,sclasses,TRUE);
DeletePackedClassLinks(theEnv,preclist,TRUE);
DeleteSlots(theEnv,slots);
return(TRUE);
}
SavePPBuffer(theEnv,"\n");
/* =========================================================================
The abstract/reactive qualities of a class are inherited if not specified
========================================================================= */
if (roleSpecified == FALSE)
{
if (preclist->classArray[1]->system && /* Change to cause */
(DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* default role of */
{ abstract = FALSE; } /* classes to be concrete. */
else
{ abstract = preclist->classArray[1]->abstract; }
}
#if DEFRULE_CONSTRUCT
if (patternMatchSpecified == FALSE)
{
if ((preclist->classArray[1]->system) && /* Change to cause */
(! abstract) && /* default pattern-match */
(DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* of classes to be */
{ reactive = TRUE; } /* reactive. */
else
{ reactive = preclist->classArray[1]->reactive; }
}
/* ================================================================
An abstract class cannot have direct instances, thus it makes no
sense for it to be reactive since it will have no objects to
respond to pattern-matching
================================================================ */
if (abstract && reactive)
{
PrintErrorID(theEnv,"CLASSPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n");
DeletePackedClassLinks(theEnv,sclasses,TRUE);
DeletePackedClassLinks(theEnv,preclist,TRUE);
DeleteSlots(theEnv,slots);
return(TRUE);
}
#endif
/* =======================================================
If we're only checking syntax, don't add the
successfully parsed defclass to the KB.
======================================================= */
if (ConstructData(theEnv)->CheckSyntaxMode)
{
DeletePackedClassLinks(theEnv,sclasses,TRUE);
DeletePackedClassLinks(theEnv,preclist,TRUE);
DeleteSlots(theEnv,slots);
return(FALSE);
}
cls = NewClass(theEnv,cname);
cls->abstract = abstract;
#if DEFRULE_CONSTRUCT
cls->reactive = reactive;
#endif
cls->directSuperclasses.classCount = sclasses->classCount;
cls->directSuperclasses.classArray = sclasses->classArray;
/* =======================================================
This is a hack to let functions which need to iterate
over a class AND its superclasses to conveniently do so
The real precedence list starts in position 1
======================================================= */
preclist->classArray[0] = cls;
cls->allSuperclasses.classCount = preclist->classCount;
cls->allSuperclasses.classArray = preclist->classArray;
rtn_struct(theEnv,packedClassLinks,sclasses);
rtn_struct(theEnv,packedClassLinks,preclist);
/* =================================
Shove slots into contiguous array
================================= */
if (slots != NULL)
PackSlots(theEnv,cls,slots);
AddClass(theEnv,cls);
return(FALSE);
}
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;
}
globle int ParseDeftemplate(
void *theEnv,
char *readSource)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *deftemplateName;
struct deftemplate *newDeftemplate;
struct templateSlot *slots;
struct token inputToken;
/*================================================*/
/* Initialize pretty print and error information. */
/*================================================*/
DeftemplateData(theEnv)->DeftemplateError = FALSE;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SavePPBuffer(theEnv,"(deftemplate ");
/*==============================================================*/
/* Deftemplates can not be added when a binary image is loaded. */
/*==============================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deftemplate");
return(TRUE);
}
#endif
/*=======================================================*/
/* Parse the name and comment fields of the deftemplate. */
/*=======================================================*/
#if DEBUGGING_FUNCTIONS
DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0;
#endif
deftemplateName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deftemplate",
EnvFindDeftemplate,EnvUndeftemplate,"%",
TRUE,TRUE,DEFMODULE_CONSTRUCT);
if (deftemplateName == NULL) return(TRUE);
if (ReservedPatternSymbol(theEnv,ValueToString(deftemplateName),"deftemplate"))
{
ReservedPatternSymbolErrorMsg(theEnv,ValueToString(deftemplateName),"a deftemplate name");
return(TRUE);
}
/*===========================================*/
/* Parse the slot fields of the deftemplate. */
/*===========================================*/
slots = SlotDeclarations(theEnv,readSource,&inputToken);
if (DeftemplateData(theEnv)->DeftemplateError == TRUE) return(TRUE);
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deftemplate to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnSlots(theEnv,slots);
return(FALSE);
}
/*=====================================*/
/* Create a new deftemplate structure. */
/*=====================================*/
newDeftemplate = get_struct(theEnv,deftemplate);
newDeftemplate->header.name = deftemplateName;
newDeftemplate->header.next = NULL;
newDeftemplate->header.usrData = NULL;
newDeftemplate->slotList = slots;
newDeftemplate->implied = FALSE;
newDeftemplate->numberOfSlots = 0;
newDeftemplate->busyCount = 0;
newDeftemplate->watch = 0;
newDeftemplate->inScope = TRUE;
newDeftemplate->patternNetwork = NULL;
newDeftemplate->factList = NULL;
newDeftemplate->lastFact = NULL;
newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex);
/*================================*/
/* Determine the number of slots. */
/*================================*/
while (slots != NULL)
{
newDeftemplate->numberOfSlots++;
slots = slots->next;
}
/*====================================*/
/* Store pretty print representation. */
/*====================================*/
if (EnvGetConserveMemory(theEnv) == TRUE)
{ newDeftemplate->header.ppForm = NULL; }
else
{ newDeftemplate->header.ppForm = CopyPPBuffer(theEnv); }
/*=======================================================================*/
/* If a template is redefined, then we want to restore its watch status. */
/*=======================================================================*/
#if DEBUGGING_FUNCTIONS
if ((BitwiseTest(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0)) || EnvGetWatchItem(theEnv,"facts"))
{ EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); }
#endif
/*==============================================*/
/* Add deftemplate to the list of deftemplates. */
/*==============================================*/
AddConstructToModule(&newDeftemplate->header);
InstallDeftemplate(theEnv,newDeftemplate);
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
return(FALSE);
}
globle int ParseDeffacts(
char *readSource)
{
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *deffactsName;
struct expr *temp;
struct deffacts *newDeffacts;
int deffactsError;
struct token inputToken;
/*=========================*/
/* Parsing initialization. */
/*=========================*/
deffactsError = FALSE;
SetPPBufferStatus(ON);
FlushPPBuffer();
SetIndentDepth(3);
SavePPBuffer("(deffacts ");
/*==========================================================*/
/* Deffacts can not be added when a binary image is loaded. */
/*==========================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded() == TRUE) && (! CheckSyntaxMode))
{
CannotLoadWithBloadMessage("deffacts");
return(TRUE);
}
#endif
/*============================*/
/* Parse the deffacts header. */
/*============================*/
deffactsName = GetConstructNameAndComment(readSource,&inputToken,"deffacts",
FindDeffacts,Undeffacts,"$",TRUE,
TRUE,TRUE);
if (deffactsName == NULL) { return(TRUE); }
/*===============================================*/
/* Parse the list of facts in the deffacts body. */
/*===============================================*/
temp = BuildRHSAssert(readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts");
if (deffactsError == TRUE) { return(TRUE); }
if (ExpressionContainsVariables(temp,FALSE))
{
LocalVariableErrorMessage("a deffacts construct");
ReturnExpression(temp);
return(TRUE);
}
SavePPBuffer("\n");
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deffacts to the KB. */
/*==============================================*/
if (CheckSyntaxMode)
{
ReturnExpression(temp);
return(FALSE);
}
/*==========================*/
/* Create the new deffacts. */
/*==========================*/
ExpressionInstall(temp);
newDeffacts = get_struct(deffacts);
newDeffacts->header.name = deffactsName;
IncrementSymbolCount(deffactsName);
newDeffacts->assertList = PackExpression(temp);
newDeffacts->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(NULL,FindModuleItem("deffacts")->moduleIndex);
newDeffacts->header.next = NULL;
newDeffacts->header.usrData = NULL;
ReturnExpression(temp);
/*=======================================================*/
/* Save the pretty print representation of the deffacts. */
/*=======================================================*/
if (GetConserveMemory() == TRUE)
{ newDeffacts->header.ppForm = NULL; }
else
{ newDeffacts->header.ppForm = CopyPPBuffer(); }
/*=============================================*/
/* 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 : ParseDefmessageHandler
DESCRIPTION : Parses a message-handler for a class of objects
INPUTS : The logical name of the input source
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Handler allocated and inserted into class
NOTES : H/L Syntax:
(defmessage-handler <class> <name> [<type>] [<comment>]
(<params>)
<action>*)
<params> ::= <var>* | <var>* $?<name>
***********************************************************************/
globle int ParseDefmessageHandler(
void *theEnv,
char *readSource)
{
DEFCLASS *cls;
SYMBOL_HN *cname,*mname,*wildcard;
unsigned mtype = MPRIMARY;
int min,max,error,lvars;
EXPRESSION *hndParams,*actions;
HANDLER *hnd;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defmessage-handler ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
return(TRUE);
}
#endif
cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT);
if (cname == NULL)
return(TRUE);
cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
if (cls == NULL)
{
PrintErrorID(theEnv,"MSGPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
return(TRUE);
}
if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
{
PrintErrorID(theEnv,"MSGPSR",8,FALSE);
EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
EnvPrintRouter(theEnv,WERROR,".\n");
return(TRUE);
}
if (HandlersExecuting(cls))
{
PrintErrorID(theEnv,"MSGPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n");
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv," ");
mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
{
SavePPBuffer(theEnv," ");
if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
{
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
if (mtype == MERROR)
return(TRUE);
#if ! IMPERATIVE_MESSAGE_HANDLERS
if (mtype == MAROUND)
return(TRUE);
#endif
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
else
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
PPBackup(theEnv);
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
hnd = FindHandlerByAddress(cls,mname,mtype);
if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
{
EnvPrintRouter(theEnv,WDIALOG," Handler ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname));
EnvPrintRouter(theEnv,WDIALOG," ");
EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]);
EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n"));
}
if ((hnd != NULL) ? hnd->system : FALSE)
{
PrintErrorID(theEnv,"MSGPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n");
return(TRUE);
}
hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL);
hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams,
&wildcard,&min,&max,&error,IsParameterSlotReference);
if (error)
return(TRUE);
PPCRAndIndent(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseProcActions(theEnv,"message-handler",readSource,
&DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard,
SlotReferenceVar,BindSlotReference,&lvars,
(void *) cls);
if (actions == NULL)
{
ReturnExpression(theEnv,hndParams);
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv,"\n");
/* ===================================================
If we're only checking syntax, don't add the
successfully parsed defmessage-handler to the KB.
=================================================== */
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(FALSE);
}
if (hnd != NULL)
{
ExpressionDeinstall(theEnv,hnd->actions);
ReturnPackedExpression(theEnv,hnd->actions);
if (hnd->ppForm != NULL)
rm(theEnv,(void *) hnd->ppForm,
(sizeof(char) * (strlen(hnd->ppForm)+1)));
}
else
{
hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype);
IncrementSymbolCount(hnd->name);
}
ReturnExpression(theEnv,hndParams);
hnd->minParams = min;
hnd->maxParams = max;
hnd->localVarCount = lvars;
hnd->actions = actions;
ExpressionInstall(theEnv,hnd->actions);
#if DEBUGGING_FUNCTIONS
/* ===================================================
Old handler trace status is automatically preserved
=================================================== */
if (EnvGetConserveMemory(theEnv) == FALSE)
hnd->ppForm = CopyPPBuffer(theEnv);
else
#endif
hnd->ppForm = NULL;
return(FALSE);
}
globle int ParseDefrule(
void *theEnv,
const char *readSource)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *ruleName;
struct lhsParseNode *theLHS;
struct expr *actions;
struct token theToken;
struct defrule *topDisjunct, *tempPtr;
struct defruleModule *theModuleItem;
int error;
/*================================================*/
/* Flush the buffer which stores the pretty print */
/* representation for a rule. Add the already */
/* parsed keyword defrule to this buffer. */
/*================================================*/
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SavePPBuffer(theEnv,"(defrule ");
/*=========================================================*/
/* Rules cannot be loaded when a binary load is in effect. */
/*=========================================================*/
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defrule");
return(TRUE);
}
#endif
/*================================================*/
/* Parse the name and comment fields of the rule, */
/* deleting the rule if it already exists. */
/*================================================*/
#if DEBUGGING_FUNCTIONS
DefruleData(theEnv)->DeletedRuleDebugFlags = 0;
#endif
ruleName = GetConstructNameAndComment(theEnv,readSource,&theToken,"defrule",
EnvFindDefruleInModule,EnvUndefrule,"*",FALSE,
TRUE,TRUE,FALSE);
if (ruleName == NULL) return(TRUE);
/*============================*/
/* Parse the LHS of the rule. */
/*============================*/
theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName),&error);
if (error)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(TRUE);
}
/*============================*/
/* Parse the RHS of the rule. */
/*============================*/
ClearParsedBindNames(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseRuleRHS(theEnv,readSource);
if (actions == NULL)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
ReturnLHSParseNodes(theEnv,theLHS);
return(TRUE);
}
/*=======================*/
/* Process the rule LHS. */
/*=======================*/
topDisjunct = ProcessRuleLHS(theEnv,theLHS,actions,ruleName,&error);
ReturnExpression(theEnv,actions);
ClearParsedBindNames(theEnv);
ReturnLHSParseNodes(theEnv,theLHS);
if (error)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(TRUE);
}
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed defrule to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(FALSE);
}
PatternData(theEnv)->SalienceExpression = NULL;
/*======================================*/
/* Save the nice printout of the rules. */
/*======================================*/
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ topDisjunct->header.ppForm = NULL; }
else
{ topDisjunct->header.ppForm = CopyPPBuffer(theEnv); }
/*=======================================*/
/* Store a pointer to the rule's module. */
/*=======================================*/
theModuleItem = (struct defruleModule *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex);
for (tempPtr = topDisjunct; tempPtr != NULL; tempPtr = tempPtr->disjunct)
{
tempPtr->header.whichModule = (struct defmoduleItemHeader *) theModuleItem;
tempPtr->header.ppForm = topDisjunct->header.ppForm;
}
/*===============================================*/
/* Rule completely parsed. Add to list of rules. */
/*===============================================*/
AddToDefruleList(topDisjunct);
/*========================================================================*/
/* If a rule is redefined, then we want to restore its breakpoint status. */
/*========================================================================*/
#if DEBUGGING_FUNCTIONS
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,0))
{ EnvSetBreak(theEnv,topDisjunct); }
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,1) || EnvGetWatchItem(theEnv,"activations"))
{ EnvSetDefruleWatchActivations(theEnv,ON,(void *) topDisjunct); }
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,2) || EnvGetWatchItem(theEnv,"rules"))
{ EnvSetDefruleWatchFirings(theEnv,ON,(void *) topDisjunct); }
#endif
/*================================*/
/* Perform the incremental reset. */
/*================================*/
IncrementalReset(theEnv,topDisjunct);
/*=============================================*/
/* Return FALSE to indicate no errors occured. */
/*=============================================*/
#endif
return(FALSE);
}