static void ClearDeffacts(
void *theEnv)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
struct expr *stub;
struct deffacts *newDeffacts;
/*=====================================*/
/* Create the data structures for the */
/* expression (assert (initial-fact)). */
/*=====================================*/
stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert"));
stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact"));
ExpressionInstall(theEnv,stub);
/*=============================================*/
/* Create a deffacts data structure to contain */
/* the expression and initialize it. */
/*=============================================*/
newDeffacts = get_struct(theEnv,deffacts);
newDeffacts->header.whichModule =
(struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL);
newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact");
IncrementSymbolCount(newDeffacts->header.name);
newDeffacts->assertList = PackExpression(theEnv,stub);
newDeffacts->header.next = NULL;
newDeffacts->header.ppForm = NULL;
newDeffacts->header.usrData = NULL;
ReturnExpression(theEnv,stub);
/*===========================================*/
/* Store the deffacts in the current module. */
/*===========================================*/
AddConstructToModule(&newDeffacts->header);
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
}
/********************************************************
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);
}
Deftemplate *CreateImpliedDeftemplate(
Environment *theEnv,
CLIPSLexeme *deftemplateName,
bool setFlag)
{
Deftemplate *newDeftemplate;
newDeftemplate = get_struct(theEnv,deftemplate);
newDeftemplate->header.name = deftemplateName;
newDeftemplate->header.ppForm = NULL;
newDeftemplate->header.usrData = NULL;
newDeftemplate->header.constructType = DEFTEMPLATE;
newDeftemplate->header.env = theEnv;
newDeftemplate->slotList = NULL;
newDeftemplate->implied = setFlag;
newDeftemplate->numberOfSlots = 0;
newDeftemplate->inScope = 1;
newDeftemplate->patternNetwork = NULL;
newDeftemplate->factList = NULL;
newDeftemplate->lastFact = NULL;
newDeftemplate->busyCount = 0;
newDeftemplate->watch = false;
newDeftemplate->header.next = NULL;
#if DEBUGGING_FUNCTIONS
if (GetWatchItem(theEnv,"facts") == 1)
{ DeftemplateSetWatch(newDeftemplate,true); }
#endif
newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex);
AddConstructToModule(&newDeftemplate->header);
InstallDeftemplate(theEnv,newDeftemplate);
return(newDeftemplate);
}
globle struct deftemplate *CreateImpliedDeftemplate(
SYMBOL_HN *deftemplateName,
int setFlag)
{
struct deftemplate *newDeftemplate;
newDeftemplate = get_struct(deftemplate);
newDeftemplate->header.name = deftemplateName;
newDeftemplate->header.ppForm = NULL;
newDeftemplate->header.usrData = NULL;
newDeftemplate->slotList = NULL;
newDeftemplate->implied = setFlag;
newDeftemplate->numberOfSlots = 0;
newDeftemplate->inScope = 1;
newDeftemplate->patternNetwork = NULL;
newDeftemplate->busyCount = 0;
newDeftemplate->watch = FALSE;
newDeftemplate->header.next = NULL;
#if FUZZY_DEFTEMPLATES
newDeftemplate->hasFuzzySlots = FALSE;
newDeftemplate->fuzzyTemplate = NULL;
#endif
#if DEBUGGING_FUNCTIONS
if (GetWatchItem("facts"))
{ SetDeftemplateWatch(ON,(void *) newDeftemplate); }
#endif
newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(NULL,DeftemplateModuleIndex);
AddConstructToModule(&newDeftemplate->header);
InstallDeftemplate(newDeftemplate);
return(newDeftemplate);
}
/****************************************************
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);
}
/*****************************************************************************
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);
}
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);
}
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 : CreateSystemClasses
DESCRIPTION : Creates the built-in system classes
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : System classes inserted in the
class hash table
NOTES : The binary/load save indices for the primitive
types (integer, float, symbol and string,
multifield, external-address and fact-address)
are very important. Need to be able to refer
to types with the same index regardless of
whether the object system is installed or
not. Thus, the bsave/blaod indices of these
classes match their integer codes.
WARNING!!: Assumes no classes exist yet!
***************************************************************/
globle void CreateSystemClasses(
void *theEnv)
{
DEFCLASS *user,*any,*primitive,*number,*lexeme,*address,*instance;
#if DEFRULE_CONSTRUCT
DEFCLASS *initialObject;
#endif
/* ===================================
Add canonical slot name entries for
the is-a and name fields - used for
object patterns
=================================== */
AddSlotName(theEnv,DefclassData(theEnv)->ISA_SYMBOL,ISA_ID,TRUE);
AddSlotName(theEnv,DefclassData(theEnv)->NAME_SYMBOL,NAME_ID,TRUE);
/* =========================================================
Bsave Indices for non-primitive classes start at 9
Object is 9, Primitive is 10, Number is 11,
Lexeme is 12, Address is 13, and Instance is 14.
because: float = 0, integer = 1, symbol = 2, string = 3,
multifield = 4, and external-address = 5 and
fact-address = 6, instance-adress = 7 and
instance-name = 8.
========================================================= */
any = AddSystemClass(theEnv,OBJECT_TYPE_NAME,NULL);
primitive = AddSystemClass(theEnv,PRIMITIVE_TYPE_NAME,any);
user = AddSystemClass(theEnv,USER_TYPE_NAME,any);
number = AddSystemClass(theEnv,NUMBER_TYPE_NAME,primitive);
DefclassData(theEnv)->PrimitiveClassMap[INTEGER] = AddSystemClass(theEnv,INTEGER_TYPE_NAME,number);
DefclassData(theEnv)->PrimitiveClassMap[FLOAT] = AddSystemClass(theEnv,FLOAT_TYPE_NAME,number);
lexeme = AddSystemClass(theEnv,LEXEME_TYPE_NAME,primitive);
DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] = AddSystemClass(theEnv,SYMBOL_TYPE_NAME,lexeme);
DefclassData(theEnv)->PrimitiveClassMap[STRING] = AddSystemClass(theEnv,STRING_TYPE_NAME,lexeme);
DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] = AddSystemClass(theEnv,MULTIFIELD_TYPE_NAME,primitive);
address = AddSystemClass(theEnv,ADDRESS_TYPE_NAME,primitive);
DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] = AddSystemClass(theEnv,EXTERNAL_ADDRESS_TYPE_NAME,address);
DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] = AddSystemClass(theEnv,FACT_ADDRESS_TYPE_NAME,address);
instance = AddSystemClass(theEnv,INSTANCE_TYPE_NAME,primitive);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] = AddSystemClass(theEnv,INSTANCE_ADDRESS_TYPE_NAME,instance);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] = AddSystemClass(theEnv,INSTANCE_NAME_TYPE_NAME,instance);
#if DEFRULE_CONSTRUCT
initialObject = AddSystemClass(theEnv,INITIAL_OBJECT_CLASS_NAME,user);
initialObject->abstract = 0;
initialObject->reactive = 1;
#endif
/* ================================================================================
INSTANCE-ADDRESS is-a INSTANCE and ADDRESS. The links between INSTANCE-ADDRESS
and ADDRESS still need to be made.
=============================================================================== */
AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->directSuperclasses,address,-1);
AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->allSuperclasses,address,2);
AddClassLink(theEnv,&address->directSubclasses,DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS],-1);
/* =======================================================================
The order of the class in the list MUST correspond to their type codes!
See CONSTANT.H
======================================================================= */
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FLOAT]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INTEGER]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[SYMBOL]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[STRING]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]);
AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]);
AddConstructToModule((struct constructHeader *) any);
AddConstructToModule((struct constructHeader *) primitive);
AddConstructToModule((struct constructHeader *) number);
AddConstructToModule((struct constructHeader *) lexeme);
AddConstructToModule((struct constructHeader *) address);
AddConstructToModule((struct constructHeader *) instance);
AddConstructToModule((struct constructHeader *) user);
#if DEFRULE_CONSTRUCT
AddConstructToModule((struct constructHeader *) initialObject);
#endif
for (any = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ;
any != NULL ;
any = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) any))
AssignClassID(theEnv,any);
}
/*********************************************************************
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);
}
