ICCItem *CCodeChain::CreateVectorGivenContent(TArray<int> vShape, CCLinkedList *pContentList)
// CreateVectorGivenContent (new)
//
// Creates a vector with given shape and content
{
int i;
CCVector *pVector;
ICCItem *pItem;
pItem = m_VectorPool.CreateItem(this);
if (pItem->IsError())
return pItem;
pItem->Reset();
pVector = dynamic_cast<CCVector *>(pItem);
pVector->SetContext(this);
pVector->SetShape(this, vShape);
pItem = pContentList->GetFlattened(this, NULL);
if (pItem->IsError())
{
pVector->Discard(this);
return pItem;
};
CCLinkedList *pFlattenedContentList = dynamic_cast<CCLinkedList *>(pItem);
TArray<double> vDataArray;
for (i = 0; i < pFlattenedContentList->GetCount(); i++)
{
vDataArray.Insert(pFlattenedContentList->GetElement(i)->GetDoubleValue());
};
pVector->SetArrayData(this, vDataArray);
// Done
pFlattenedContentList->Discard(this);
return pVector->Reference();
}
ICCItem *fnApply (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnApply
//
// Applies the given parameter list to the lambda expression
//
// (apply exp arg1 arg2 ... argn list)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pResult;
ICCItem *pFunction;
ICCItem *pLast;
CCLinkedList *pList;
int i;
// Evaluate the arguments and validate them
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("v*"));
if (pArgs->IsError())
return pArgs;
// We better have at least two arguments
if (pArgs->GetCount() < 2)
{
pArgs->Discard(pCC);
return pCC->CreateError(CONSTLIT("apply needs a function and a list of arguments."), NULL);
}
// The last argument better be a list
pLast = pArgs->GetElement(pArgs->GetCount() - 1);
if (!pLast->IsList())
{
pArgs->Discard(pCC);
return pCC->CreateError(CONSTLIT("Last argument for apply must be a list."), NULL);
}
// The first argument is the function
pFunction = pArgs->Head(pCC);
// Create a new list to store the arguments in
pResult = pCC->CreateLinkedList();
if (pResult->IsError())
{
pArgs->Discard(pCC);
return pResult;
}
pList = (CCLinkedList *)pResult;
// Add each of the arguments except the last
for (i = 1; i < pArgs->GetCount() - 1; i++)
{
pList->Append(pCC, pArgs->GetElement(i), &pResult);
if (pResult->IsError())
{
pList->Discard(pCC);
pArgs->Discard(pCC);
return pResult;
}
pResult->Discard(pCC);
}
// Add each of the elements of the last list
for (i = 0; i < pLast->GetCount(); i++)
{
pList->Append(pCC, pLast->GetElement(i), &pResult);
if (pResult->IsError())
{
pList->Discard(pCC);
pArgs->Discard(pCC);
return pResult;
}
pResult->Discard(pCC);
}
// Set the literal flag to indicate that the arguments should
// not be evaluated.
pList->SetQuoted();
// Execute the function
if (pFunction->IsFunction())
pResult = pFunction->Execute(pCtx, pList);
else
pResult = pFunction->Reference();
pList->Discard(pCC);
// Done
pArgs->Discard(pCC);
return pResult;
}
ICCItem *fnLinkedList (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnLinkedList
//
// Handles linked-list specific functions
//
// (lnkAppend linked-list item) -> list
// (lnkRemove linked-list index) -> list
// (lnkRemoveNil linked-list) -> list
// (lnkReplace linked-list index item) -> list
//
// HACK: This function has different behavior depending on the first
// argument. If the first argument is a variable holding a linked list,
// then the variable contents will be changed. If the variable holds Nil,
// then the variable contents are not changed. In all cases, the caller
// should structure the call as: (setq ListVar (lnkAppend ListVar ...))
// in order to handle all cases.
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pList;
CCLinkedList *pLinkedList;
ICCItem *pResult;
// Evaluate the arguments
if (dwData == FN_LINKEDLIST_APPEND)
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("lv"));
else if (dwData == FN_LINKEDLIST_REMOVE_NIL)
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("l"));
else
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("liv"));
if (pArgs->IsError())
return pArgs;
// Get the linked list
pList = pArgs->GetElement(0);
if (pList->GetClass()->GetObjID() == OBJID_CCLINKEDLIST)
pLinkedList = (CCLinkedList *)pList->Reference();
else if (pList->IsNil())
{
pList = pCC->CreateLinkedList();
if (pList->IsError())
{
pArgs->Discard(pCC);
return pList;
}
pLinkedList = (CCLinkedList *)pList;
}
else
{
pArgs->Discard(pCC);
return pCC->CreateError(CONSTLIT("Linked-list expected:"), NULL);
}
// Do the right thing
switch (dwData)
{
case FN_LINKEDLIST_APPEND:
{
ICCItem *pItem = pArgs->GetElement(1);
ICCItem *pError;
pLinkedList->Append(pCC, pItem, &pError);
if (pError->IsError())
{
pLinkedList->Discard(pCC);
pResult = pError;
}
else
{
pError->Discard(pCC);
pResult = pLinkedList;
}
break;
}
case FN_LINKEDLIST_REMOVE:
{
int iIndex = pArgs->GetElement(1)->GetIntegerValue();
// Make sure we're in range
if (iIndex < 0 || iIndex >= pLinkedList->GetCount())
{
pLinkedList->Discard(pCC);
pResult = pCC->CreateError(CONSTLIT("Index out of range:"), pArgs->GetElement(1));
}
else
{
pLinkedList->RemoveElement(pCC, iIndex);
pResult = pLinkedList;
}
break;
}
case FN_LINKEDLIST_REMOVE_NIL:
{
// Iterate over all elements and remove any elements that are Nil
int iIndex = 0;
while (iIndex < pLinkedList->GetCount())
{
if (pLinkedList->GetElement(iIndex)->IsNil())
pLinkedList->RemoveElement(pCC, iIndex);
else
iIndex++;
}
// Done
pResult = pLinkedList;
break;
}
case FN_LINKEDLIST_REPLACE:
{
int iIndex = pArgs->GetElement(1)->GetIntegerValue();
ICCItem *pItem = pArgs->GetElement(2);
// Make sure we're in range
if (iIndex < 0 || iIndex >= pLinkedList->GetCount())
{
pLinkedList->Discard(pCC);
pResult = pCC->CreateError(CONSTLIT("Index out of range:"), pArgs->GetElement(1));
}
else
{
pLinkedList->ReplaceElement(pCC, iIndex, pItem);
pResult = pLinkedList;
}
break;
}
default:
ASSERT(FALSE);
return NULL;
}
// Done
pArgs->Discard(pCC);
return pResult;
}
ICCItem *CCodeChain::EvaluateArgs (CEvalContext *pCtx, ICCItem *pArgs, const CString &sArgValidation)
// EvaluateArgs
//
// Evaluate arguments and validate their types
{
ICCItem *pArg;
ICCItem *pNew;
ICCItem *pError;
CCLinkedList *pEvalList;
char *pValidation;
int i;
BOOL bNoEval;
// If the argument list if quoted, then it means that the arguments
// have already been evaluated. This happens if we've been called by
// (apply).
bNoEval = pArgs->IsQuoted();
// Create a list to hold the results
pNew = CreateLinkedList();
if (pNew->IsError())
return pNew;
pEvalList = dynamic_cast<CCLinkedList *>(pNew);
// Start parsing at the beginning
pValidation = sArgValidation.GetPointer();
// If there is a '*' in the validation, figure out
// how many arguments it represents
int iVarArgs = Max(0, pArgs->GetCount() - (sArgValidation.GetLength() - 1));
// Loop over each argument
for (i = 0; i < pArgs->GetCount(); i++)
{
ICCItem *pResult;
pArg = pArgs->GetElement(i);
// If we're processing variable args, see if we're done
if (*pValidation == '*')
{
if (iVarArgs == 0)
pValidation++;
else
iVarArgs--;
}
// Evaluate the item. If the arg is 'q' or 'u' then we
// don't evaluate it.
if (bNoEval || *pValidation == 'q' || *pValidation == 'u')
pResult = pArg->Reference();
// If the arg is 'c' then we don't evaluate unless it is
// a lambda expression (or an identifier)
else if (*pValidation == 'c' && !pArg->IsLambdaExpression() && !pArg->IsIdentifier())
pResult = pArg->Reference();
// Evaluate
else
{
pResult = Eval(pCtx, pArg);
// We don't want to return on error because some functions
// might want to pass errors around
if (*pValidation != 'v' && *pValidation != '*')
{
if (pResult->IsError())
{
pEvalList->Discard(this);
return pResult;
}
}
}
// Check to see if the item is valid
switch (*pValidation)
{
// We expect a function...
case 'f':
{
if (!pResult->IsFunction())
{
pError = CreateError(LITERAL("Function expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a numeral...
//
// NOTE: We treat integer the same a numeral because it's not always
// clear to the user when they've created a double or an integer.
// It is up to the actual function to use the integer or double
// value appropriately.
case 'i':
case 'n':
{
if (!pResult->IsDouble() && !pResult->IsInteger())
{
pError = CreateError(LITERAL("Numeral expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a double...
case 'd':
{
if (!pResult->IsDouble())
{
pError = CreateError(LITERAL("Double expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a vEctor...
case 'e':
{
if (!(pResult->GetValueType() == ICCItem::Vector))
{
pError = CreateError(LITERAL("Vector expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a linked list
case 'k':
{
if (pResult->GetClass()->GetObjID() != OBJID_CCLINKEDLIST)
{
pError = CreateError(LITERAL("Linked-list expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a list
case 'l':
{
if (!pResult->IsList())
{
pError = CreateError(LITERAL("List expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect an identifier
case 's':
case 'q':
{
if (!pResult->IsIdentifier())
{
pError = CreateError(LITERAL("Identifier expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect an atom table
case 'x':
{
if (!pResult->IsAtomTable())
{
pError = CreateError(LITERAL("Atom table expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect a symbol table
case 'y':
{
if (!pResult->IsSymbolTable())
{
pError = CreateError(LITERAL("Symbol table expected"), pResult);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
break;
}
// We expect anything
case 'c':
case 'u':
case 'v':
break;
// We expect any number of anythings...
case '*':
break;
// Too many arguments
case '\0':
{
pError = CreateError(LITERAL("Too many arguments"), NULL);
pResult->Discard(this);
pEvalList->Discard(this);
return pError;
}
default:
ASSERT(FALSE);
}
// Add the result to the list
pEvalList->Append(*this, pResult);
pResult->Discard(this);
// Next validation sequence (note that *pValidation can never
// be '\0' because we return above if we find it)
if (*pValidation != '*')
pValidation++;
}
// Make sure we have enough arguments
if (*pValidation != '\0' && *pValidation != '*')
{
pError = CreateError(LITERAL("Insufficient arguments"), NULL);
pEvalList->Discard(this);
return pError;
}
// Return the evaluation list
return pEvalList;
}
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;
}