ALERROR CCodeChain::DefineGlobalInteger (const CString &sVar, int iValue)
{
ALERROR error;
ICCItem *pValue = CreateInteger(iValue);
error = DefineGlobal(sVar, pValue);
pValue->Discard(this);
return error;
}
CRandomState *CLispEng::CreateRandomState(CP seed) {
if (!seed)
seed = CreateInteger(Ext::Random().m_seed);
Push(seed);
CRandomState *pRS = (CRandomState*)m_consMan.CreateInstance();
pRS->m_rnd = Pop();
pRS->m_stub = CSPtr();
return pRS;
}
void DefglobalSetInteger(
Defglobal *theDefglobal,
long long value)
{
CLIPSValue cv;
cv.integerValue = CreateInteger(theDefglobal->header.env,value);
DefglobalSetValue(theDefglobal,&cv);
}
//
// Constructor
//
PathSearch::PathSearch(const char *name)
: Base(name),
start(-1, -1),
end(-1, -1),
rescan(FALSE)
{
// Create interface vars
varType = CreateString("type", "");
varOptimize = CreateInteger("optimize", FALSE, 0, 1);
}
/***************************************************
NAME : CheckForFacetConflicts
DESCRIPTION : Determines if all facets specified
(and inherited) for a slot are
consistent
INPUTS : 1) The slot descriptor
2) The parse record for the
type constraints on the slot
RETURNS : True if all OK,
false otherwise
SIDE EFFECTS : Min and Max fields replaced in
constraint for single-field slot
NOTES : None
***************************************************/
static bool CheckForFacetConflicts(
Environment *theEnv,
SlotDescriptor *sd,
CONSTRAINT_PARSE_RECORD *parsedConstraint)
{
if (sd->multiple == 0)
{
if (parsedConstraint->cardinality)
{
PrintErrorID(theEnv,"CLSLTPSR",3,true);
WriteString(theEnv,STDERR,"The 'cardinality' facet can only be used with multifield slots.\n");
return false;
}
else
{
ReturnExpression(theEnv,sd->constraint->minFields);
ReturnExpression(theEnv,sd->constraint->maxFields);
sd->constraint->minFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,1LL));
sd->constraint->maxFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,1LL));
}
}
if (sd->noDefault && sd->noWrite)
{
PrintErrorID(theEnv,"CLSLTPSR",4,true);
WriteString(theEnv,STDERR,"Slots with an 'access' facet value of 'read-only' must have a default value.\n");
return false;
}
if (sd->noWrite && (sd->createWriteAccessor || sd->overrideMessageSpecified))
{
PrintErrorID(theEnv,"CLSLTPSR",5,true);
WriteString(theEnv,STDERR,"Slots with an 'access' facet value of 'read-only' cannot have a write accessor.\n");
return false;
}
if (sd->noInherit && sd->publicVisibility)
{
PrintErrorID(theEnv,"CLSLTPSR",6,true);
WriteString(theEnv,STDERR,"Slots with a 'propagation' facet value of 'no-inherit' cannot have a 'visibility' facet value of 'public'.\n");
return false;
}
return true;
}
ICCItem *CCodeChain::CreateErrorCode (int iErrorCode)
// CreateError
//
// Creates an item
//
// iErrorCode: Error code (CCRESULT_???)
{
ICCItem *pError;
pError = CreateInteger(iErrorCode);
pError->SetError();
return pError;
}
ICCItem *CCodeChain::PoolUsage (void)
// PoolUsage
//
// Returns a count of each pool
{
int iPoolCount[POOL_COUNT];
int i;
ICCItem *pResult;
CCLinkedList *pList;
// Get the counts now so we don't affect the results
iPoolCount[INTEGER_POOL] = m_IntegerPool.GetCount();
iPoolCount[STRING_POOL] = m_StringPool.GetCount();
iPoolCount[LIST_POOL] = m_ListPool.GetCount();
iPoolCount[PRIMITIVE_POOL] = m_PrimitivePool.GetCount();
iPoolCount[SYMBOLTABLE_POOL] = m_SymbolTablePool.GetCount();
iPoolCount[LAMBDA_POOL] = m_LambdaPool.GetCount();
iPoolCount[ATOMTABLE_POOL] = m_AtomTablePool.GetCount();
iPoolCount[VECTOR_POOL] = m_VectorPool.GetCount();
iPoolCount[DOUBLE_POOL] = m_DoublePool.GetCount();
// Create
pResult = CreateLinkedList();
if (pResult->IsError())
return pResult;
pList = (CCLinkedList *)pResult;
for (i = 0; i < POOL_COUNT; i++)
{
ICCItem *pItem;
// Make an item for the count
pItem = CreateInteger(iPoolCount[i]);
// Add the item to the list
pList->Append(*this, pItem);
pItem->Discard(this);
}
return pList;
}
struct lhsParseNode *RestrictionParse(
Environment *theEnv,
const char *readSource,
struct token *theToken,
bool multifieldSlot,
CLIPSLexeme *theSlot,
unsigned short slotNumber,
CONSTRAINT_RECORD *theConstraints,
unsigned short position)
{
struct lhsParseNode *topNode = NULL, *lastNode = NULL, *nextNode;
int numberOfSingleFields = 0;
int numberOfMultifields = 0;
unsigned short startPosition = position;
bool error = false;
CONSTRAINT_RECORD *tempConstraints;
/*==================================================*/
/* Keep parsing fields until a right parenthesis is */
/* encountered. This will either indicate the end */
/* of an instance or deftemplate slot or the end of */
/* an ordered fact. */
/*==================================================*/
while (theToken->tknType != RIGHT_PARENTHESIS_TOKEN)
{
/*========================================*/
/* Look for either a single or multifield */
/* wildcard or a conjuctive restriction. */
/*========================================*/
if ((theToken->tknType == SF_WILDCARD_TOKEN) ||
(theToken->tknType == MF_WILDCARD_TOKEN))
{
nextNode = GetLHSParseNode(theEnv);
if (theToken->tknType == SF_WILDCARD_TOKEN)
{ nextNode->pnType = SF_WILDCARD_NODE; }
else
{ nextNode->pnType = MF_WILDCARD_NODE; }
nextNode->negated = false;
nextNode->exists = false;
GetToken(theEnv,readSource,theToken);
}
else
{
nextNode = ConjuctiveRestrictionParse(theEnv,readSource,theToken,&error);
if (nextNode == NULL)
{
ReturnLHSParseNodes(theEnv,topNode);
return NULL;
}
}
/*========================================================*/
/* Fix up the pretty print representation of a multifield */
/* slot so that the fields don't run together. */
/*========================================================*/
if ((theToken->tknType != RIGHT_PARENTHESIS_TOKEN) && (multifieldSlot == true))
{
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken->printForm);
}
/*========================================*/
/* Keep track of the number of single and */
/* multifield restrictions encountered. */
/*========================================*/
if ((nextNode->pnType == SF_WILDCARD_NODE) ||
(nextNode->pnType == SF_VARIABLE_NODE))
{ numberOfSingleFields++; }
else
{ numberOfMultifields++; }
/*===================================*/
/* Assign the slot name and indices. */
/*===================================*/
nextNode->slot = theSlot;
nextNode->slotNumber = slotNumber;
nextNode->index = position++;
/*==============================================*/
/* If we're not dealing with a multifield slot, */
/* attach the constraints directly to the node */
/* and return. */
/*==============================================*/
if (! multifieldSlot)
{
if (theConstraints == NULL)
{
if (nextNode->pnType == SF_VARIABLE_NODE)
{ nextNode->constraints = GetConstraintRecord(theEnv); }
else nextNode->constraints = NULL;
}
else nextNode->constraints = theConstraints;
return(nextNode);
}
/*====================================================*/
/* Attach the restriction to the list of restrictions */
/* already parsed for this slot or ordered fact. */
/*====================================================*/
if (lastNode == NULL) topNode = nextNode;
else lastNode->right = nextNode;
lastNode = nextNode;
}
/*=====================================================*/
/* Once we're through parsing, check to make sure that */
/* a single field slot was given a restriction. If the */
/* following test fails, then we know we're dealing */
/* with a multifield slot. */
/*=====================================================*/
if ((topNode == NULL) && (! multifieldSlot))
{
SyntaxErrorMessage(theEnv,"defrule");
return NULL;
}
/*===============================================*/
/* Loop through each of the restrictions in the */
/* list of restrictions for the multifield slot. */
/*===============================================*/
for (nextNode = topNode; nextNode != NULL; nextNode = nextNode->right)
{
/*===================================================*/
/* Assign a constraint record to each constraint. If */
/* the slot has an explicit constraint, then copy */
/* this and store it with the constraint. Otherwise, */
/* create a constraint record for a single field */
/* constraint and skip the constraint modifications */
/* for a multifield constraint. */
/*===================================================*/
if (theConstraints == NULL)
{
if (nextNode->pnType == SF_VARIABLE_NODE)
{ nextNode->constraints = GetConstraintRecord(theEnv); }
else
{ continue; }
}
else
{ nextNode->constraints = CopyConstraintRecord(theEnv,theConstraints); }
/*==========================================*/
/* Remove the min and max field constraints */
/* for the entire slot from the constraint */
/* record for this single constraint. */
/*==========================================*/
ReturnExpression(theEnv,nextNode->constraints->minFields);
ReturnExpression(theEnv,nextNode->constraints->maxFields);
nextNode->constraints->minFields = GenConstant(theEnv,SYMBOL_TYPE,SymbolData(theEnv)->NegativeInfinity);
nextNode->constraints->maxFields = GenConstant(theEnv,SYMBOL_TYPE,SymbolData(theEnv)->PositiveInfinity);
nextNode->derivedConstraints = true;
/*====================================================*/
/* If we're not dealing with a multifield constraint, */
/* then no further modifications are needed to the */
/* min and max constraints for this constraint. */
/*====================================================*/
if ((nextNode->pnType != MF_WILDCARD_NODE) && (nextNode->pnType != MF_VARIABLE_NODE))
{ continue; }
/*==========================================================*/
/* Create a separate constraint record to keep track of the */
/* cardinality information for this multifield constraint. */
/*==========================================================*/
tempConstraints = GetConstraintRecord(theEnv);
SetConstraintType(MULTIFIELD_TYPE,tempConstraints);
tempConstraints->singlefieldsAllowed = false;
tempConstraints->multifield = nextNode->constraints;
nextNode->constraints = tempConstraints;
/*=====================================================*/
/* Adjust the min and max field values for this single */
/* multifield constraint based on the min and max */
/* fields for the entire slot and the number of single */
/* field values contained in the slot. */
/*=====================================================*/
if (theConstraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity)
{
ReturnExpression(theEnv,tempConstraints->maxFields);
tempConstraints->maxFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,theConstraints->maxFields->integerValue->contents - numberOfSingleFields));
}
if ((numberOfMultifields == 1) && (theConstraints->minFields->value != SymbolData(theEnv)->NegativeInfinity))
{
ReturnExpression(theEnv,tempConstraints->minFields);
tempConstraints->minFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,theConstraints->minFields->integerValue->contents - numberOfSingleFields));
}
}
/*================================================*/
/* If a multifield slot is being parsed, place a */
/* node on top of the list of constraints parsed. */
/*================================================*/
if (multifieldSlot)
{
nextNode = GetLHSParseNode(theEnv);
nextNode->pnType = MF_WILDCARD_NODE;
nextNode->multifieldSlot = true;
nextNode->bottom = topNode;
nextNode->slot = theSlot;
nextNode->slotNumber = slotNumber;
nextNode->index = startPosition;
nextNode->constraints = theConstraints;
topNode = nextNode;
TallyFieldTypes(topNode->bottom);
}
/*=================================*/
/* Return the list of constraints. */
/*=================================*/
return(topNode);
}
ICCItem *CCodeChain::Link (const CString &sString, int iOffset, int *retiLinked, int *ioiCurLine)
// Link
//
// Parses the given string and converts it into a linked
// chain of items
{
char *pStart;
char *pPos;
ICCItem *pResult = NULL;
int iCurLine = (ioiCurLine ? *ioiCurLine : 1);
pStart = sString.GetPointer() + iOffset;
pPos = pStart;
// Skip any whitespace
pPos = SkipWhiteSpace(pPos, &iCurLine);
// If we've reached the end, then we have
// nothing
if (*pPos == '\0')
pResult = CreateNil();
// If we've got a literal quote, then remember it
else if (*pPos == SYMBOL_QUOTE)
{
int iLinked;
pPos++;
pResult = Link(sString, iOffset + (pPos - pStart), &iLinked, &iCurLine);
if (pResult->IsError())
return pResult;
pPos += iLinked;
// Make it a literal
pResult->SetQuoted();
}
// If we've got an open paren then we start a list
else if (*pPos == SYMBOL_OPENPAREN)
{
ICCItem *pNew = CreateLinkedList();
if (pNew->IsError())
return pNew;
CCLinkedList *pList = dynamic_cast<CCLinkedList *>(pNew);
// Keep reading until we find the end
pPos++;
// If the list is empty, then there's nothing to do
pPos = SkipWhiteSpace(pPos, &iCurLine);
if (*pPos == SYMBOL_CLOSEPAREN)
{
pList->Discard(this);
pResult = CreateNil();
pPos++;
}
// Get all the items in the list
else
{
while (*pPos != SYMBOL_CLOSEPAREN && *pPos != '\0')
{
ICCItem *pItem;
int iLinked;
pItem = Link(sString, iOffset + (pPos - pStart), &iLinked, &iCurLine);
if (pItem->IsError())
return pItem;
// Add the item to the list
pList->Append(this, pItem, NULL);
pItem->Discard(this);
// Move the position
pPos += iLinked;
// Skip whitespace
pPos = SkipWhiteSpace(pPos, &iCurLine);
}
// If we have a close paren then we're done; Otherwise we've
// got an error of some kind
if (*pPos == SYMBOL_CLOSEPAREN)
{
pPos++;
pResult = pList;
}
else
{
pList->Discard(this);
pResult = CreateParseError(iCurLine, CONSTLIT("Mismatched open parenthesis"));
}
}
}
// If this is an open brace then we've got a literal structure
else if (*pPos == SYMBOL_OPENBRACE)
{
ICCItem *pNew = CreateSymbolTable();
if (pNew->IsError())
return pNew;
CCSymbolTable *pTable = dynamic_cast<CCSymbolTable *>(pNew);
// Always literal
pTable->SetQuoted();
// Keep reading until we find the end
pPos++;
// If the list is empty, then there's nothing to do
pPos = SkipWhiteSpace(pPos, &iCurLine);
if (*pPos == SYMBOL_CLOSEBRACE)
{
pResult = pTable;
pPos++;
}
// Get all the items in the list
else
{
while (*pPos != SYMBOL_CLOSEBRACE && *pPos != '\0')
{
// Get the key
ICCItem *pKey;
int iLinked;
pKey = Link(sString, iOffset + (pPos - pStart), &iLinked, &iCurLine);
if (pKey->IsError())
{
pTable->Discard(this);
return pKey;
}
// Move the position and read a colon
pPos += iLinked;
pPos = SkipWhiteSpace(pPos, &iCurLine);
if (*pPos != SYMBOL_COLON)
{
pKey->Discard(this);
pTable->Discard(this);
return CreateParseError(iCurLine, CONSTLIT("Struct value not found."));
}
pPos++;
// Get the value
ICCItem *pValue;
pValue = Link(sString, iOffset + (pPos - pStart), &iLinked, &iCurLine);
if (pValue->IsError())
{
pKey->Discard(this);
pTable->Discard(this);
return pValue;
}
// Move the position
pPos += iLinked;
// Add the item to the table
pResult = pTable->AddEntry(this, pKey, pValue);
pKey->Discard(this);
pValue->Discard(this);
if (pResult->IsError())
{
pTable->Discard(this);
return pResult;
}
// Skip whitespace because otherwise we won't know whether we
// hit the end brace.
pPos = SkipWhiteSpace(pPos, &iCurLine);
}
// If we have a close paren then we're done; Otherwise we've
// got an error of some kind
if (*pPos == SYMBOL_CLOSEBRACE)
{
pPos++;
pResult = pTable;
}
else
{
pTable->Discard(this);
pResult = CreateParseError(iCurLine, CONSTLIT("Mismatched open brace"));
}
}
}
// If this is an open quote, then read everything until
// the close quote
else if (*pPos == SYMBOL_OPENQUOTE)
{
// Parse the string, until the end quote, parsing escape codes
char *pStartFragment = NULL;
CString sResultString;
bool bDone = false;
while (!bDone)
{
pPos++;
switch (*pPos)
{
case SYMBOL_CLOSEQUOTE:
case '\0':
{
if (pStartFragment)
{
sResultString.Append(CString(pStartFragment, pPos - pStartFragment));
pStartFragment = NULL;
}
bDone = true;
break;
}
case SYMBOL_BACKSLASH:
{
if (pStartFragment)
{
sResultString.Append(CString(pStartFragment, pPos - pStartFragment));
pStartFragment = NULL;
}
pPos++;
if (*pPos == '\0')
bDone = true;
else if (*pPos == 'n')
sResultString.Append(CString("\n", 1));
else if (*pPos == 'r')
sResultString.Append(CString("\r", 1));
else if (*pPos == 't')
sResultString.Append(CString("\t", 1));
else if (*pPos == '0')
sResultString.Append(CString("\0", 1));
else if (*pPos == 'x' || *pPos == 'X')
{
pPos++;
int iFirstDigit = strGetHexDigit(pPos);
pPos++;
int iSecondDigit = 0;
if (*pPos == '\0')
bDone = true;
else
iSecondDigit = strGetHexDigit(pPos);
char chChar = (char)(16 * iFirstDigit + iSecondDigit);
sResultString.Append(CString(&chChar, 1));
}
else
sResultString.Append(CString(pPos, 1));
break;
}
default:
{
if (pStartFragment == NULL)
pStartFragment = pPos;
break;
}
}
}
// If we found the close, then create a string; otherwise,
// it is an error
if (*pPos == SYMBOL_CLOSEQUOTE)
{
pResult = CreateString(sResultString);
// Always a literal
pResult->SetQuoted();
// Skip past quote
pPos++;
}
else
pResult = CreateParseError(iCurLine, CONSTLIT("Mismatched quote"));
}
// If this is a close paren, then it is an error
else if (*pPos == SYMBOL_CLOSEPAREN)
pResult = CreateParseError(iCurLine, CONSTLIT("Mismatched close parenthesis"));
// If this is a close brace, then it is an error
else if (*pPos == SYMBOL_CLOSEBRACE)
pResult = CreateParseError(iCurLine, CONSTLIT("Mismatched close brace"));
// Colons cannot appear alone
else if (*pPos == SYMBOL_COLON)
pResult = CreateParseError(iCurLine, CONSTLIT("':' character must appear inside quotes or in a struct definition."));
// Otherwise this is an string of some sort
else
{
char *pStartString;
CString sIdentifier;
int iInt;
bool bNotInteger;
pStartString = pPos;
// Look for whitespace
while (*pPos != '\0'
&& *pPos != ' ' && *pPos != '\n' && *pPos != '\r' && *pPos != '\t'
&& *pPos != SYMBOL_OPENPAREN
&& *pPos != SYMBOL_CLOSEPAREN
&& *pPos != SYMBOL_OPENQUOTE
&& *pPos != SYMBOL_CLOSEQUOTE
&& *pPos != SYMBOL_OPENBRACE
&& *pPos != SYMBOL_CLOSEBRACE
&& *pPos != SYMBOL_COLON
&& *pPos != SYMBOL_QUOTE
&& *pPos != ';')
pPos++;
// If we did not advance, then we clearly hit an error
if (pStartString == pPos)
pResult = CreateParseError(iCurLine, strPatternSubst(CONSTLIT("Unexpected character: %s"), CString(pPos, 1)));
// If we ended in a quote then that's a bug
else if (*pPos == SYMBOL_QUOTE)
pResult = CreateParseError(iCurLine, strPatternSubst(CONSTLIT("Identifiers must not use single quote characters: %s"),
strSubString(sString, iOffset + (pStartString - pStart), (pPos + 1 - pStartString))));
// Otherwise, get the identifier
else
{
// Create a string from the portion
sIdentifier = strSubString(sString, iOffset + (pStartString - pStart), (pPos - pStartString));
// Check to see if this is a reserved identifier
if (strCompareAbsolute(sIdentifier, CONSTLIT("Nil")) == 0)
pResult = CreateNil();
else if (strCompareAbsolute(sIdentifier, CONSTLIT("True")) == 0)
pResult = CreateTrue();
else
{
// If this is an integer, create an integer; otherwise
// create a string
iInt = strToInt(sIdentifier, 0, &bNotInteger);
if (bNotInteger)
pResult = CreateString(sIdentifier);
else
pResult = CreateInteger(iInt);
}
}
}
// Return the result and the number of characters
// that we read
if (retiLinked)
*retiLinked = (pPos - pStart);
if (ioiCurLine)
*ioiCurLine = iCurLine;
return pResult;
}
//
// Constructor
//
Mission::Mission(IControl *parent) : ICWindow(parent)
{
defaultRule = new IFaceVar(this, CreateString("defaultRule", ""));
fixedRule = new IFaceVar(this, CreateInteger("fixedRule", 0, 0, 1));
}
