/**********************************************
Build functions used by AddPatternParser() to
provide object access to the pattern network
**********************************************/
globle EXPRESSION *GenObjectPNConstantCompare(
void *theEnv,
struct lhsParseNode *theNode)
{
struct ObjectCmpPNConstant hack;
EXPRESSION *theExp;
unsigned short tmpType;
/* ===============================================================
If the value of a single field slot (or relation name) is being
compared against a constant, then use specialized routines for
doing the comparison.
If a constant comparison is being done within a multifield slot
and the constant's position has no multifields to the left or
no multifields to the right, then use the same routine used for
the single field slot case, but include the offset from either
the beginning or end of the slot.
Otherwise, use a general eq/neq test.
=============================================================== */
ClearBitString((void *) &hack,(int) sizeof(struct ObjectCmpPNConstant));
if (theNode->negated)
hack.fail = 1;
else
hack.pass = 1;
if (((theNode->withinMultifieldSlot == FALSE) ||
(theNode->multiFieldsAfter == 0) ||
(theNode->multiFieldsBefore == 0)) &&
(theNode->slotNumber != ISA_ID) && (theNode->slotNumber != NAME_ID))
{
if (theNode->withinMultifieldSlot == FALSE)
hack.fromBeginning = TRUE;
else if (theNode->multiFieldsBefore == 0)
{
hack.fromBeginning = TRUE;
hack.offset = theNode->singleFieldsBefore;
}
else
hack.offset = theNode->singleFieldsAfter;
theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,EnvAddBitMap(theEnv,(void *) &hack,
(int) sizeof(struct ObjectCmpPNConstant)));
theExp->argList = GenConstant(theEnv,theNode->type,theNode->value);
}
else
{
hack.general = 1;
theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,EnvAddBitMap(theEnv,(void *) &hack,
(int) sizeof(struct ObjectCmpPNConstant)));
theExp->argList = GenConstant(theEnv,0,NULL);
tmpType = theNode->type;
theNode->type = SF_VARIABLE;
GenObjectGetVar(theEnv,FALSE,theExp->argList,theNode,-1);
theNode->type = tmpType;
theExp->argList->nextArg = GenConstant(theEnv,theNode->type,theNode->value);
}
return(theExp);
}
/****************************************************
NAME : GenObjectLengthTest
DESCRIPTION : Generates a test on the cardinality
of a slot matching an object pattern
INPUTS : The first lhsParseNode for a slot
in an object pattern
RETURNS : Nothing useful
SIDE EFFECTS : The lhsParseNode network test is
modified to include the length test
NOTES : None
****************************************************/
globle void GenObjectLengthTest(
void *theEnv,
struct lhsParseNode *theNode)
{
struct ObjectMatchLength hack;
EXPRESSION *theTest;
if ((theNode->singleFieldsAfter == 0) &&
(theNode->type != SF_VARIABLE) &&
(theNode->type != SF_WILDCARD))
return;
ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength));
if ((theNode->type != MF_VARIABLE) &&
(theNode->type != MF_WILDCARD) &&
(theNode->multiFieldsAfter == 0))
hack.exactly = 1;
else
hack.exactly = 0;
if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD))
hack.minLength = 1 + theNode->singleFieldsAfter;
else
hack.minLength = theNode->singleFieldsAfter;
theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,EnvAddBitMap(theEnv,(void *) &hack,
(int) sizeof(struct ObjectMatchLength)));
if (theNode->constantSelector != NULL)
{ theNode->constantSelector->nextArg = CopyExpression(theEnv,theTest); }
theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest);
}
globle void *CreateDeftemplateScopeMap(
void *theEnv,
struct deftemplate *theDeftemplate)
{
unsigned scopeMapSize;
char *scopeMap;
char *templateName;
struct defmodule *matchModule, *theModule;
int moduleID,count;
void *theBitMap;
templateName = ValueToString(theDeftemplate->header.name);
matchModule = theDeftemplate->header.whichModule->theModule;
scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
scopeMap = (char *) gm2(theEnv,scopeMapSize);
ClearBitString((void *) scopeMap,scopeMapSize);
SaveCurrentModule(theEnv);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ;
theModule != NULL ;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule))
{
EnvSetCurrentModule(theEnv,(void *) theModule);
moduleID = (int) theModule->bsaveID;
if (FindImportedConstruct(theEnv,"deftemplate",matchModule,
templateName,&count,TRUE,NULL) != NULL)
SetBitMap(scopeMap,moduleID);
}
RestoreCurrentModule(theEnv);
theBitMap = EnvAddBitMap(theEnv,scopeMap,scopeMapSize);
IncrementBitMapCount(theBitMap);
rm(theEnv,(void *) scopeMap,scopeMapSize);
return(theBitMap);
}
/***************************************************
NAME : UpdateDefclassesScope
DESCRIPTION : This function updates the scope
bitmaps for existing classes when
a new module is defined
INPUTS : None
RETURNS : Nothing
SIDE EFFECTS : Class scope bitmaps are updated
NOTES : None
***************************************************/
static void UpdateDefclassesScope(
void *theEnv)
{
register unsigned i;
DEFCLASS *theDefclass;
int newModuleID,count;
char *newScopeMap;
unsigned newScopeMapSize;
char *className;
struct defmodule *matchModule;
newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID;
newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
newScopeMap = (char *) gm2(theEnv,newScopeMapSize);
for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
for (theDefclass = DefclassData(theEnv)->ClassTable[i] ;
theDefclass != NULL ;
theDefclass = theDefclass->nxtHash)
{
matchModule = theDefclass->header.whichModule->theModule;
className = ValueToString(theDefclass->header.name);
ClearBitString((void *) newScopeMap,newScopeMapSize);
GenCopyMemory(char,theDefclass->scopeMap->size,
newScopeMap,ValueToBitMap(theDefclass->scopeMap));
DecrementBitMapCount(theEnv,theDefclass->scopeMap);
if (theDefclass->system)
SetBitMap(newScopeMap,newModuleID);
else if (FindImportedConstruct(theEnv,(char*)"defclass",matchModule,
className,&count,TRUE,NULL) != NULL)
SetBitMap(newScopeMap,newModuleID);
theDefclass->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize);
IncrementBitMapCount(theDefclass->scopeMap);
}
rm(theEnv,(void *) newScopeMap,newScopeMapSize);
}
/****************************************************
NAME : GenObjectZeroLengthTest
DESCRIPTION : Generates a test on the cardinality
of a slot matching an object pattern
INPUTS : The first lhsParseNode for a slot
in an object pattern
RETURNS : Nothing useful
SIDE EFFECTS : The lhsParseNode network test is
modified to include the length test
NOTES : None
****************************************************/
globle void GenObjectZeroLengthTest(
void *theEnv,
struct lhsParseNode *theNode)
{
struct ObjectMatchLength hack;
EXPRESSION *theTest;
ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength));
hack.exactly = 1;
hack.minLength = 0;
theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,EnvAddBitMap(theEnv,(void *) &hack,
(int) sizeof(struct ObjectMatchLength)));
theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest);
}
/***************************************************
NAME : GenHandlerSlotReference
DESCRIPTION : Creates a bitmap of the class id
and slot index for the get or put
operation. The bitmap and operation
type are stored in the given
expression.
INPUTS : 1) The expression
2) The operation type
3) The class slot
RETURNS : Nothing useful
SIDE EFFECTS : Bitmap created and expression
initialized
NOTES : None
***************************************************/
static void GenHandlerSlotReference(
void *theEnv,
EXPRESSION *theExp,
unsigned short theType,
SLOT_DESC *sd)
{
HANDLER_SLOT_REFERENCE handlerReference;
ClearBitString(&handlerReference,sizeof(HANDLER_SLOT_REFERENCE));
handlerReference.classID = (unsigned short) sd->cls->id;
handlerReference.slotID = (unsigned) sd->slotName->id;
theExp->type = theType;
theExp->value = EnvAddBitMap(theEnv,(void *) &handlerReference,
(int) sizeof(HANDLER_SLOT_REFERENCE));
}
static void ReadNeededBitMaps(
void *theEnv)
{
char *bitMapStorage, *bitMapPtr;
unsigned long space;
long i;
unsigned short *tempSize;
/*=======================================*/
/* Determine the number of bitmaps to be */
/* read and space required for them. */
/*=======================================*/
GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfBitMaps,(unsigned long) sizeof(long int));
GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int));
if (SymbolData(theEnv)->NumberOfBitMaps == 0)
{
SymbolData(theEnv)->BitMapArray = NULL;
return;
}
/*=======================================*/
/* Allocate area for bitmaps to be read. */
/*=======================================*/
bitMapStorage = (char *) gm3(theEnv,(long) space);
GenReadBinary(theEnv,(void *) bitMapStorage,space);
/*================================================*/
/* Store the bitMap pointers in the bitmap array. */
/*================================================*/
SymbolData(theEnv)->BitMapArray = (BITMAP_HN **)
gm3(theEnv,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps);
bitMapPtr = bitMapStorage;
for (i = 0; i < SymbolData(theEnv)->NumberOfBitMaps; i++)
{
tempSize = (unsigned short *) bitMapPtr;
SymbolData(theEnv)->BitMapArray[i] = (BITMAP_HN *) EnvAddBitMap(theEnv,bitMapPtr+sizeof(unsigned short),*tempSize);
bitMapPtr += *tempSize + sizeof(unsigned short);
}
/*=========================*/
/* Free the bitmap buffer. */
/*=========================*/
rm3(theEnv,(void *) bitMapStorage,(long) space);
}
/*********************************************************
NAME : AddSystemClass
DESCRIPTION : Performs all necessary allocations
for adding a system class
INPUTS : 1) The name-string of the system class
2) The address of the parent class
(NULL if none)
RETURNS : The address of the new system class
SIDE EFFECTS : Allocations performed
NOTES : Assumes system-class name is unique
Also assumes SINGLE INHERITANCE for
system classes to simplify precedence
list determination
Adds classes to has table but NOT to
class list (this is responsibility
of caller)
*********************************************************/
static DEFCLASS *AddSystemClass(
void *theEnv,
char *name,
DEFCLASS *parent)
{
DEFCLASS *sys;
long i;
char defaultScopeMap[1];
sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
sys->abstract = 1;
#if DEFRULE_CONSTRUCT
sys->reactive = 0;
#endif
IncrementSymbolCount(sys->header.name);
sys->installed = 1;
sys->system = 1;
sys->hashTableIndex = HashClass(sys->header.name);
AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
if (parent != NULL)
{
AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
}
sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;
/* =========================================
Add default scope maps for a system class
There is only one module (MAIN) so far -
which has an id of 0
========================================= */
ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
IncrementBitMapCount(sys->scopeMap);
#endif
return(sys);
}
/***************************************************************
NAME : GenerateSlotComparisonTest
DESCRIPTION : Generates pattern and join network
expressions for comparing object
pattern variables
INPUTS : 1) A flag indicating if this is a
pattern or join network test
2) For a join test, a flag indicating
if it is a nand join
3) The intermediate parse node
for the first variable
4) The intermediate parse node
for the second variable
RETURNS : An expression for comparing the
variables
SIDE EFFECTS : Expression and bitmaps generated
NOTES : The following tests are generated
for the following scenarios:
SF slot w/ SF slot: PN_1 or JN_1
Example: (foo ?x) with (bar ?xy)
SF slot w/ SF reference in MF slot: PN_2 or JN_2
Example: (foo ?x) (bar ? ?x ? ?)
SF reference w/ SF reference: PN_3 or JN_3
Example: (foo ? ?x ?) and (bar ? ? ? ?x)
All other cases: EQ/NEQ general test
Example: (foo $? ?x $?) and (bar ?x)
***************************************************************/
static EXPRESSION *GenerateSlotComparisonTest(
void *theEnv,
int joinTest,
int isNand,
struct lhsParseNode *selfNode,
struct lhsParseNode *referringNode)
{
EXPRESSION *theExp;
struct ObjectCmpPNSingleSlotVars1 phack1;
struct ObjectCmpPNSingleSlotVars2 phack2;
struct ObjectCmpPNSingleSlotVars3 phack3;
struct ObjectCmpJoinSingleSlotVars1 jhack1;
struct ObjectCmpJoinSingleSlotVars2 jhack2;
struct ObjectCmpJoinSingleSlotVars3 jhack3;
struct lhsParseNode *firstNode;
if (isNand)
{ firstNode = referringNode; }
else
{ firstNode = selfNode; }
/* =========================================================
If we are comparing two single-field slot variables that
don't require multifield markers for lookup, use
a quick comparison. Otherwise, use a general eq/neq with
the pattern variable access routines
========================================================= */
if (IsSimpleSlotVariable(firstNode) && IsSimpleSlotVariable(referringNode))
{
/* ==============================
Compare two single-field slots
============================== */
if ((firstNode->withinMultifieldSlot == FALSE) &&
(referringNode->withinMultifieldSlot == FALSE))
{
ClearBitString((void *) &phack1,(int) sizeof(struct ObjectCmpPNSingleSlotVars1));
ClearBitString((void *) &jhack1,(int) sizeof(struct ObjectCmpJoinSingleSlotVars1));
if (selfNode->negated)
phack1.fail = jhack1.fail = 1;
else
phack1.pass = jhack1.pass = 1;
phack1.firstSlot = jhack1.firstSlot = (unsigned short) firstNode->slotNumber;
phack1.secondSlot = jhack1.secondSlot = (unsigned short) referringNode->slotNumber;
if (joinTest)
{
if (isNand)
{ jhack1.firstPattern = (unsigned short) referringNode->joinDepth; }
else
{ jhack1.firstPattern = 0; }
jhack1.firstPatternRHS = TRUE;
jhack1.secondPatternLHS = TRUE;
jhack1.secondPattern = (unsigned short) referringNode->joinDepth;
theExp = GenConstant(theEnv,OBJ_JN_CMP1,EnvAddBitMap(theEnv,(void *) &jhack1,
(int) sizeof(struct ObjectCmpJoinSingleSlotVars1)));
}
else
theExp = GenConstant(theEnv,OBJ_PN_CMP1,EnvAddBitMap(theEnv,(void *) &phack1,
(int) sizeof(struct ObjectCmpPNSingleSlotVars1)));
}
/* ============================================
Compare a single-field slot with a
single-field in a multifield slot (make sure
the multifield slot reference is first
============================================ */
else if ((firstNode->withinMultifieldSlot == FALSE) ||
(referringNode->withinMultifieldSlot == FALSE))
{
ClearBitString((void *) &phack2,(int) sizeof(struct ObjectCmpPNSingleSlotVars2));
ClearBitString((void *) &jhack2,(int) sizeof(struct ObjectCmpJoinSingleSlotVars2));
if (selfNode->negated)
phack2.fail = jhack2.fail = 1;
else
phack2.pass = jhack2.pass = 1;
if (firstNode->withinMultifieldSlot == TRUE)
{
phack2.firstSlot = jhack2.firstSlot = (unsigned short) firstNode->slotNumber;
phack2.secondSlot = jhack2.secondSlot = (unsigned short) referringNode->slotNumber;
if (joinTest)
{
if (isNand)
{ jhack2.firstPattern = (unsigned short) referringNode->joinDepth; }
else
{ jhack2.firstPattern = 0; }
jhack2.firstPatternRHS = TRUE;
jhack2.secondPatternLHS = TRUE;
jhack2.secondPattern = (unsigned short) referringNode->joinDepth;
}
if (firstNode->multiFieldsBefore == 0)
{
phack2.fromBeginning = jhack2.fromBeginning = 1;
phack2.offset = jhack2.offset = firstNode->singleFieldsBefore;
}
else
phack2.offset = jhack2.offset = firstNode->singleFieldsAfter;
}
else
{
phack2.firstSlot = jhack2.firstSlot = (unsigned short) referringNode->slotNumber;
phack2.secondSlot = jhack2.secondSlot = (unsigned short) firstNode->slotNumber;
if (joinTest)
{
if (isNand)
{ jhack2.secondPattern = (unsigned short) firstNode->joinDepth; }
else
{ jhack2.secondPattern = 0; }
jhack2.secondPatternRHS = TRUE;
jhack2.firstPatternLHS = TRUE;
jhack2.firstPattern = (unsigned short) referringNode->joinDepth;
}
if (referringNode->multiFieldsBefore == 0)
{
phack2.fromBeginning = jhack2.fromBeginning = 1;
phack2.offset = jhack2.offset = referringNode->singleFieldsBefore;
}
else
phack2.offset = jhack2.offset = referringNode->singleFieldsAfter;
}
if (joinTest)
theExp = GenConstant(theEnv,OBJ_JN_CMP2,EnvAddBitMap(theEnv,(void *) &jhack2,
(int) sizeof(struct ObjectCmpJoinSingleSlotVars2)));
else
theExp = GenConstant(theEnv,OBJ_PN_CMP2,EnvAddBitMap(theEnv,(void *) &phack2,
(int) sizeof(struct ObjectCmpPNSingleSlotVars2)));
}
/* ===================================
Compare two single-field references
within multifield slots
=================================== */
else
{
ClearBitString((void *) &phack3,(int) sizeof(struct ObjectCmpPNSingleSlotVars3));
ClearBitString((void *) &jhack3,(int) sizeof(struct ObjectCmpJoinSingleSlotVars3));
if (selfNode->negated)
phack3.fail = jhack3.fail = 1;
else
phack3.pass = jhack3.pass = 1;
phack3.firstSlot = jhack3.firstSlot = (unsigned short) firstNode->slotNumber;
phack3.secondSlot = jhack3.secondSlot = (unsigned short) referringNode->slotNumber;
if (firstNode->multiFieldsBefore == 0)
{
phack3.firstFromBeginning = jhack3.firstFromBeginning = 1;
phack3.firstOffset = jhack3.firstOffset = firstNode->singleFieldsBefore;
}
else
phack3.firstOffset = jhack3.firstOffset = firstNode->singleFieldsAfter;
if (referringNode->multiFieldsBefore == 0)
{
phack3.secondFromBeginning = jhack3.secondFromBeginning = 1;
phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsBefore;
}
else
phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsAfter;
if (joinTest)
{
if (isNand)
{ jhack3.firstPattern = (unsigned short) referringNode->joinDepth; }
else
{ jhack3.firstPattern = 0; }
jhack3.firstPatternRHS = TRUE;
jhack3.secondPatternLHS = TRUE;
jhack3.secondPattern = (unsigned short) referringNode->joinDepth;
theExp = GenConstant(theEnv,OBJ_JN_CMP3,EnvAddBitMap(theEnv,(void *) &jhack3,
(int) sizeof(struct ObjectCmpJoinSingleSlotVars3)));
}
else
theExp = GenConstant(theEnv,OBJ_PN_CMP3,EnvAddBitMap(theEnv,(void *) &phack3,
(int) sizeof(struct ObjectCmpPNSingleSlotVars3)));
}
}
/* ==================================================
General comparison for multifield slot references,
references which require multifield markers, and
object addresses
================================================== */
else
{
theExp = GenConstant(theEnv,FCALL,selfNode->negated ? ExpressionData(theEnv)->PTR_NEQ : ExpressionData(theEnv)->PTR_EQ);
theExp->argList = GenConstant(theEnv,0,NULL);
if (isNand)
{ GenObjectGetVar(theEnv,joinTest,theExp->argList,selfNode,NESTED_RHS); }
else
{ GenObjectGetVar(theEnv,joinTest,theExp->argList,selfNode,RHS); }
theExp->argList->nextArg = GenConstant(theEnv,0,NULL);
GenObjectGetVar(theEnv,joinTest,theExp->argList->nextArg,referringNode,LHS);
}
return(theExp);
}
/***************************************************
NAME : GenObjectGetVar
DESCRIPTION : Generates the expressions necessary
to access object pattern variables
INPUTS : 1) An integer code indicating if
this is a join network reference
or a pattern network reference
2) The expression for which to set
the type and value
3) The lhsParseNode for the
variable reference
4) For a join reference, the side from
which the variable must be retrieved.
RETURNS : Nothing useful
SIDE EFFECTS : The value is a packed long holding
pattern index, slot number,
field index, etc.
NOTES : None
***************************************************/
static void GenObjectGetVar(
void *theEnv,
int joinReference,
EXPRESSION *theItem,
struct lhsParseNode *theNode,
int side)
{
struct ObjectMatchVar1 hack1;
struct ObjectMatchVar2 hack2;
ClearBitString((void *) &hack1,(int) sizeof(struct ObjectMatchVar1));
ClearBitString((void *) &hack2,(int) sizeof(struct ObjectMatchVar2));
if (joinReference)
{
if (side == LHS)
{
hack1.lhs = 1;
hack2.lhs = 1;
hack1.whichPattern = (unsigned short) theNode->joinDepth;
hack2.whichPattern = (unsigned short) theNode->joinDepth;
}
else if (side == RHS)
{
hack1.rhs = 1;
hack2.rhs = 1;
hack1.whichPattern = (unsigned short) 0;
hack2.whichPattern = (unsigned short) 0;
}
else if (side == NESTED_RHS)
{
hack1.rhs = 1;
hack2.rhs = 1;
hack1.whichPattern = (unsigned short) theNode->joinDepth;
hack2.whichPattern = (unsigned short) theNode->joinDepth;
}
else
{
hack1.whichPattern = (unsigned short) theNode->joinDepth;
hack2.whichPattern = (unsigned short) theNode->joinDepth;
}
}
/* ========================
Access an object address
======================== */
if (theNode->slotNumber < 0)
{
hack1.objectAddress = 1;
SetpType(theItem,(joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1));
theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1));
return;
}
/* ======================================
Access the entire contents of the slot
====================================== */
if ((theNode->singleFieldsBefore == 0) &&
(theNode->singleFieldsAfter == 0) &&
(theNode->multiFieldsBefore == 0) &&
(theNode->multiFieldsAfter == 0) &&
((theNode->withinMultifieldSlot == FALSE) ||
(theNode->type == MF_VARIABLE) ||
(theNode->type == MF_WILDCARD)))
{
hack1.allFields = 1;
hack1.whichSlot = (unsigned short) theNode->slotNumber;
theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1);
theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1));
return;
}
/* =============================================================
Access a particular field(s) in a multifield slot pattern
containing at most one multifield variable and at least
one (or two if no multifield variables) single-field variable
============================================================= */
if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE) || ConstantType(theNode->type)) &&
((theNode->multiFieldsBefore == 0) || (theNode->multiFieldsAfter == 0)))
{
hack2.whichSlot = (unsigned short) theNode->slotNumber;
if (theNode->multiFieldsBefore == 0)
{
hack2.fromBeginning = 1;
hack2.beginningOffset = theNode->singleFieldsBefore;
}
else
{
hack2.fromEnd = 1;
hack2.endOffset = theNode->singleFieldsAfter;
}
theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2);
theItem->value = EnvAddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2));
return;
}
if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE) || ConstantType(theNode->type)) &&
(theNode->multiFieldsBefore == 0) &&
(theNode->multiFieldsAfter == 0))
{
hack2.whichSlot = (unsigned short) theNode->slotNumber;
hack2.fromBeginning = 1;
hack2.fromEnd = 1;
hack2.beginningOffset = theNode->singleFieldsBefore;
hack2.endOffset = theNode->singleFieldsAfter;
theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2);
theItem->value = EnvAddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2));
return;
}
/* ==================================================
General slot field access using multifield markers
================================================== */
hack1.whichSlot = (unsigned short) theNode->slotNumber;
hack1.whichField = (unsigned short) theNode->index;
theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1);
theItem->value = EnvAddBitMap(theEnv,(void *) &hack1,sizeof(struct ObjectMatchVar1));
}
globle struct expr *GetRHSPattern(
void *theEnv,
char *readSource,
struct token *tempToken,
int *error,
int constantsOnly,
int readFirstParen,
int checkFirstParen,
int endType)
{
struct expr *lastOne = NULL;
struct expr *nextOne, *firstOne, *argHead = NULL;
int printError, count;
struct deftemplate *theDeftemplate;
struct symbolHashNode *templateName;
char *nullBitMap = "\0";
/*=================================================*/
/* Get the opening parenthesis of the RHS pattern. */
/*=================================================*/
*error = FALSE;
if (readFirstParen) GetToken(theEnv,readSource,tempToken);
if (checkFirstParen)
{
if (tempToken->type == endType) return(NULL);
if (tempToken->type != LPAREN)
{
SyntaxErrorMessage(theEnv,"RHS patterns");
*error = TRUE;
return(NULL);
}
}
/*======================================================*/
/* The first field of an asserted fact must be a symbol */
/* (but not = or : which have special significance). */
/*======================================================*/
GetToken(theEnv,readSource,tempToken);
if (tempToken->type != SYMBOL)
{
SyntaxErrorMessage(theEnv,"first field of a RHS pattern");
*error = TRUE;
return(NULL);
}
else if ((strcmp(ValueToString(tempToken->value),"=") == 0) ||
(strcmp(ValueToString(tempToken->value),":") == 0))
{
SyntaxErrorMessage(theEnv,"first field of a RHS pattern");
*error = TRUE;
return(NULL);
}
/*=========================================================*/
/* Check to see if the relation name is a reserved symbol. */
/*=========================================================*/
templateName = (struct symbolHashNode *) tempToken->value;
if (ReservedPatternSymbol(theEnv,ValueToString(templateName),NULL))
{
ReservedPatternSymbolErrorMsg(theEnv,ValueToString(templateName),"a relation name");
*error = TRUE;
return(NULL);
}
/*============================================================*/
/* A module separator in the name is illegal in this context. */
/*============================================================*/
if (FindModuleSeparator(ValueToString(templateName)))
{
IllegalModuleSpecifierMessage(theEnv);
*error = TRUE;
return(NULL);
}
/*=============================================================*/
/* Determine if there is an associated deftemplate. If so, let */
/* the deftemplate parsing functions parse the RHS pattern and */
/* then return the fact pattern that was parsed. */
/*=============================================================*/
theDeftemplate = (struct deftemplate *)
FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(templateName),
&count,TRUE,NULL);
if (count > 1)
{
AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(templateName));
*error = TRUE;
return(NULL);
}
/*======================================================*/
/* If no deftemplate exists with the specified relation */
/* name, then create an implied deftemplate. */
/*======================================================*/
if (theDeftemplate == NULL)
#if (! BLOAD_ONLY) && (! RUN_TIME)
{
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
NoSuchTemplateError(theEnv,ValueToString(templateName));
*error = TRUE;
return(NULL);
}
#endif
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(templateName)))
{
ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(templateName),NULL,NULL);
*error = TRUE;
return(NULL);
}
#endif
if (! ConstructData(theEnv)->CheckSyntaxMode)
{ theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) templateName,TRUE); }
}
#else
{
NoSuchTemplateError(theEnv,ValueToString(templateName));
*error = TRUE;
return(NULL);
}
#endif
/*=========================================*/
/* If an explicit deftemplate exists, then */
/* parse the fact as a deftemplate fact. */
/*=========================================*/
if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE))
{
firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate);
firstOne->nextArg = ParseAssertTemplate(theEnv,readSource,tempToken,
error,endType,
constantsOnly,theDeftemplate);
if (*error)
{
ReturnExpression(theEnv,firstOne);
firstOne = NULL;
}
return(firstOne);
}
/*========================================*/
/* Parse the fact as an ordered RHS fact. */
/*========================================*/
firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate);
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(theEnv," ");
#endif
while ((nextOne = GetAssertArgument(theEnv,readSource,tempToken,
error,endType,constantsOnly,&printError)) != NULL)
{
if (argHead == NULL) argHead = nextOne;
else lastOne->nextArg = nextOne;
lastOne = nextOne;
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(theEnv," ");
#endif
}
/*===========================================================*/
/* If an error occurred, set the error flag and return NULL. */
/*===========================================================*/
if (*error)
{
if (printError) SyntaxErrorMessage(theEnv,"RHS patterns");
ReturnExpression(theEnv,firstOne);
ReturnExpression(theEnv,argHead);
return(NULL);
}
/*=====================================*/
/* Fix the pretty print representation */
/* of the RHS ordered fact. */
/*=====================================*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,tempToken->printForm);
#endif
/*==========================================================*/
/* Ordered fact assertions are processed by stuffing all of */
/* the fact's proposition (except the relation name) into a */
/* single multifield slot. */
/*==========================================================*/
firstOne->nextArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,EnvAddBitMap(theEnv,(void *) nullBitMap,1));
firstOne->nextArg->argList = argHead;
/*==============================*/
/* Return the RHS ordered fact. */
/*==============================*/
return(firstOne);
}
static struct expr *GetSlotAssertValues(
void *theEnv,
EXEC_STATUS,
struct templateSlot *slotPtr,
struct expr *firstSlot,
int *error)
{
struct expr *slotItem;
struct expr *newArg, *tempArg;
DATA_OBJECT theDefault;
char *nullBitMap = "\0";
/*==================================================*/
/* Determine if the slot is assigned in the assert. */
/*==================================================*/
slotItem = FindAssertSlotItem(slotPtr,firstSlot);
/*==========================================*/
/* If the slot is assigned, use that value. */
/*==========================================*/
if (slotItem != NULL)
{
newArg = slotItem->argList;
slotItem->argList = NULL;
}
/*=================================*/
/* Otherwise, use a default value. */
/*=================================*/
else
{
/*================================================*/
/* If the (default ?NONE) attribute was specified */
/* for the slot, then a value must be supplied. */
/*================================================*/
if (slotPtr->noDefault)
{
PrintErrorID(theEnv,execStatus,"TMPLTRHS",1,TRUE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Slot ");
EnvPrintRouter(theEnv,execStatus,WERROR,slotPtr->slotName->contents);
EnvPrintRouter(theEnv,execStatus,WERROR," requires a value because of its (default ?NONE) attribute.\n");
*error = TRUE;
return(NULL);
}
/*===================================================*/
/* If the (default ?DERIVE) attribute was specified */
/* (the default), then derive the default value from */
/* the slot's constraints. */
/*===================================================*/
else if ((slotPtr->defaultPresent == FALSE) &&
(slotPtr->defaultDynamic == FALSE))
{
DeriveDefaultFromConstraints(theEnv,execStatus,slotPtr->constraints,&theDefault,
(int) slotPtr->multislot,TRUE);
newArg = ConvertValueToExpression(theEnv,execStatus,&theDefault);
}
/*=========================================*/
/* Otherwise, use the expression contained */
/* in the default attribute. */
/*=========================================*/
else
{ newArg = CopyExpression(theEnv,execStatus,slotPtr->defaultList); }
}
/*=======================================================*/
/* Since a multifield slot default can contain a list of */
/* values, the values need to have a store-multifield */
/* function called wrapped around it to group all of the */
/* values into a single multifield value. */
/*=======================================================*/
if (slotPtr->multislot)
{
tempArg = GenConstant(theEnv,execStatus,FACT_STORE_MULTIFIELD,EnvAddBitMap(theEnv,execStatus,(void *) nullBitMap,1));
tempArg->argList = newArg;
newArg = tempArg;
}
/*==============================================*/
/* Return the value to be asserted in the slot. */
/*==============================================*/
return(newArg);
}
