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 : AddClass
DESCRIPTION : Determines the precedence list of the new class.
If it is valid, the routine checks to see if the class
already exists. If it does not, all the subclass
links are made from the class's direct superclasses,
and the class is inserted in the hash table. If it
does, all sublclasses are deleted. An error will occur
if any instances of the class (direct or indirect) exist.
If all checks out, the old definition is replaced by the new.
INPUTS : The new class description
RETURNS : Nothing useful
SIDE EFFECTS : The class is deleted if there is an error.
NOTES : No change in the class graph state will occur
if there were any errors.
Assumes class is not busy!!!
*****************************************************************************/
static void AddClass(
void *theEnv,
DEFCLASS *cls)
{
DEFCLASS *ctmp;
#if DEBUGGING_FUNCTIONS
int oldTraceInstances = FALSE,
oldTraceSlots = FALSE;
#endif
/* ===============================================
If class does not already exist, insert and
form progeny links with all direct superclasses
=============================================== */
cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls));
ctmp = (DEFCLASS *) EnvFindDefclass(theEnv,EnvGetDefclassName(theEnv,(void *) cls));
if (ctmp != NULL)
{
#if DEBUGGING_FUNCTIONS
oldTraceInstances = ctmp->traceInstances;
oldTraceSlots = ctmp->traceSlots;
#endif
DeleteClassUAG(theEnv,ctmp);
}
PutClassInTable(theEnv,cls);
BuildSubclassLinks(theEnv,cls);
InstallClass(theEnv,cls,TRUE);
AddConstructToModule((struct constructHeader *) cls);
FormInstanceTemplate(theEnv,cls);
FormSlotNameMap(theEnv,cls);
AssignClassID(theEnv,cls);
#if DEBUGGING_FUNCTIONS
if (cls->abstract)
{
cls->traceInstances = FALSE;
cls->traceSlots = FALSE;
}
else
{
if (oldTraceInstances)
cls->traceInstances = TRUE;
if (oldTraceSlots)
cls->traceSlots = TRUE;
}
#endif
#if DEBUGGING_FUNCTIONS
if (EnvGetConserveMemory(theEnv) == FALSE)
SetDefclassPPForm((void *) cls,CopyPPBuffer(theEnv));
#endif
#if DEFMODULE_CONSTRUCT
/* =========================================
Create a bitmap indicating whether this
class is in scope or not for every module
========================================= */
cls->scopeMap = (BITMAP_HN *) CreateClassScopeMap(theEnv,cls);
#endif
/* ==============================================
Define get- and put- handlers for public slots
============================================== */
CreatePublicSlotMessageHandlers(theEnv,cls);
}
/****************************************************
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;
}
static void AddDefglobal(
void *theEnv,
SYMBOL_HN *name,
DATA_OBJECT_PTR vPtr,
struct expr *ePtr)
{
struct defglobal *defglobalPtr;
intBool newGlobal = FALSE;
#if DEBUGGING_FUNCTIONS
int GlobalHadWatch = FALSE;
#endif
/*========================================================*/
/* If the defglobal is already defined, then use the old */
/* data structure and substitute new values. If it hasn't */
/* been defined, then create a new data structure. */
/*========================================================*/
defglobalPtr = QFindDefglobal(theEnv,name);
if (defglobalPtr == NULL)
{
newGlobal = TRUE;
defglobalPtr = get_struct(theEnv,defglobal);
}
else
{
DeinstallConstructHeader(theEnv,&defglobalPtr->header);
#if DEBUGGING_FUNCTIONS
GlobalHadWatch = defglobalPtr->watch;
#endif
}
/*===========================================*/
/* Remove the old values from the defglobal. */
/*===========================================*/
if (newGlobal == FALSE)
{
ValueDeinstall(theEnv,&defglobalPtr->current);
if (defglobalPtr->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); }
RemoveHashedExpression(theEnv,defglobalPtr->initial);
}
/*=======================================*/
/* Copy the new values to the defglobal. */
/*=======================================*/
defglobalPtr->current.type = vPtr->type;
if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value;
else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr);
ValueInstall(theEnv,&defglobalPtr->current);
defglobalPtr->initial = AddHashedExpression(theEnv,ePtr);
ReturnExpression(theEnv,ePtr);
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
/*=================================*/
/* Restore the old watch value to */
/* the defglobal if redefined. */
/*=================================*/
#if DEBUGGING_FUNCTIONS
defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals;
#endif
/*======================================*/
/* Save the name and pretty print form. */
/*======================================*/
defglobalPtr->header.name = name;
defglobalPtr->header.usrData = NULL;
IncrementSymbolCount(name);
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ defglobalPtr->header.ppForm = NULL; }
else
{ defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); }
defglobalPtr->inScope = TRUE;
/*=============================================*/
/* If the defglobal was redefined, we're done. */
/*=============================================*/
if (newGlobal == FALSE) return;
/*===================================*/
/* Copy the defglobal variable name. */
/*===================================*/
defglobalPtr->busyCount = 0;
defglobalPtr->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex);
/*=============================================*/
/* Add the defglobal to the list of defglobals */
/* for the current module. */
/*=============================================*/
AddConstructToModule(&defglobalPtr->header);
}
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 : 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);
}
/***********************************************************************
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);
}
