ICCItem *fnAtmCreate (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnAtmCreate
//
// Creates a new atom table
//
// (atmAtomTable ((atom1 entry1) (atom2 entry2) ... (atomn entryn))) -> atmtable
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pAtomTable;
ICCItem *pList;
int i;
// Evaluate the argument
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("l"));
if (pArgs->IsError())
return pArgs;
// Create the table
pAtomTable = pCC->CreateAtomTable();
if (pAtomTable->IsError())
return pAtomTable;
// Add each entry
pList = pArgs->Head(pCC);
for (i = 0; i < pList->GetCount(); i++)
{
ICCItem *pPair = pList->GetElement(i);
ICCItem *pResult;
// Make sure we have two elements
if (pPair->GetCount() != 2)
{
pAtomTable->Discard(pCC);
return pCC->CreateError(CONSTLIT("Invalid format for atom table entry:"), pPair);
}
// Get the atom and the entry
pResult = pAtomTable->AddEntry(pCC, pPair->GetElement(0), pPair->GetElement(1));
if (pResult->IsError())
{
pAtomTable->Discard(pCC);
return pResult;
}
pResult->Discard(pCC);
}
// Done
pArgs->Discard(pCC);
return pAtomTable;
}
ICCItem *fnForLoop (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnForLoop
//
// Evaluates an expression for a given number of iterations
// Iterates from "from" to "to" inclusive.
//
// (for var from to exp)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pResult;
ICCItem *pVar;
ICCItem *pBody;
ICCItem *pLocalSymbols;
ICCItem *pOldSymbols;
ICCItem *pError;
int i, iFrom, iTo, iVarOffset;
// Evaluate the arguments and validate them
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("qiiu"));
if (pArgs->IsError())
return pArgs;
pVar = pArgs->GetElement(0);
iFrom = pArgs->GetElement(1)->GetIntegerValue();
iTo = pArgs->GetElement(2)->GetIntegerValue();
pBody = pArgs->GetElement(3);
// Setup the locals. We start by creating a local symbol table
pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
{
pArgs->Discard(pCC);
return pLocalSymbols;
}
// Associate the enumaration variable
pError = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
if (pError->IsError())
{
pArgs->Discard(pCC);
return pError;
}
pError->Discard(pCC);
// Setup the context
if (pCtx->pLocalSymbols)
pLocalSymbols->SetParent(pCtx->pLocalSymbols);
else
pLocalSymbols->SetParent(pCtx->pLexicalSymbols);
pOldSymbols = pCtx->pLocalSymbols;
pCtx->pLocalSymbols = pLocalSymbols;
// Start with a default result
pResult = pCC->CreateNil();
// Get the offset of the variable so we don't have to
// search for it all the time
iVarOffset = pLocalSymbols->FindOffset(pCC, pVar);
// Loop over all elements of the list
for (i = iFrom; i <= iTo; i++)
{
ICCItem *pItem = pCC->CreateInteger(i);
// Clean up the previous result
pResult->Discard(pCC);
// Set the element
pLocalSymbols->AddByOffset(pCC, iVarOffset, pItem);
pItem->Discard(pCC);
// Eval
pResult = pCC->Eval(pCtx, pBody);
if (pResult->IsError())
break;
}
// Clean up
pCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
// Done
pArgs->Discard(pCC);
return pResult;
}
ICCItem *fnFilter (CEvalContext *pCtx, ICCItem *pArgs, DWORD dwData)
// fnFilter
//
// Filters a list based on a boolean expression.
//
// (filter list var exp) -> list
{
int i;
CCodeChain *pCC = pCtx->pCC;
if (pArgs->GetElement(0)->IsNil())
return pCC->CreateNil();
// Args
ICCItem *pSource = pArgs->GetElement(0);
ICCItem *pVar = pArgs->GetElement(1);
ICCItem *pBody = pArgs->GetElement(2);
// Create a destination list
ICCItem *pResult = pCC->CreateLinkedList();
if (pResult->IsError())
return pResult;
CCLinkedList *pList = (CCLinkedList *)pResult;
// Setup the locals. We start by creating a local symbol table
ICCItem *pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
{
pResult->Discard(pCC);
return pLocalSymbols;
}
// Associate the enumaration variable
ICCItem *pError = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
if (pError->IsError())
{
pLocalSymbols->Discard(pCC);
pResult->Discard(pCC);
return pError;
}
pError->Discard(pCC);
// Setup the context
if (pCtx->pLocalSymbols)
pLocalSymbols->SetParent(pCtx->pLocalSymbols);
else
pLocalSymbols->SetParent(pCtx->pLexicalSymbols);
ICCItem *pOldSymbols = pCtx->pLocalSymbols;
pCtx->pLocalSymbols = pLocalSymbols;
// Get the offset of the variable so we don't have to
// search for it all the time
int iVarOffset = pLocalSymbols->FindOffset(pCC, pVar);
// Loop over all elements of the list
for (i = 0; i < pSource->GetCount(); i++)
{
ICCItem *pItem = pSource->GetElement(i);
// Set the element
pLocalSymbols->AddByOffset(pCC, iVarOffset, pItem);
// Eval
ICCItem *pSelect = pCC->Eval(pCtx, pBody);
if (pSelect->IsError())
{
pResult->Discard(pCC);
pResult = pSelect;
break;
}
// If the evaluation is not Nil, then we include the
// item in the result
if (!pSelect->IsNil())
pList->Append(pCC, pItem, NULL);
pSelect->Discard(pCC);
}
// Clean up
pCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
// Done
if (pResult->GetCount() > 0)
return pResult;
else
{
pResult->Discard(pCC);
return pCC->CreateNil();
}
}
ICCItem *fnEnum (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnEnum
//
// Enumerates the elements of a list
//
// (enum list item-var exp)
// (enumwhile list condition item-var exp)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pResult;
ICCItem *pVar;
ICCItem *pBody;
ICCItem *pList;
ICCItem *pCondition;
ICCItem *pLocalSymbols;
ICCItem *pOldSymbols;
ICCItem *pError;
int i, iVarOffset;
// Evaluate the arguments and validate them
if (dwData == FN_ENUM_WHILE)
{
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("vuqu"));
if (pArgs->IsError())
return pArgs;
pList = pArgs->GetElement(0);
pCondition = pArgs->GetElement(1);
pVar = pArgs->GetElement(2);
pBody = pArgs->GetElement(3);
}
else
{
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("vqu"));
if (pArgs->IsError())
return pArgs;
pList = pArgs->GetElement(0);
pCondition = NULL;
pVar = pArgs->GetElement(1);
pBody = pArgs->GetElement(2);
}
// Setup the locals. We start by creating a local symbol table
pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
{
pArgs->Discard(pCC);
return pLocalSymbols;
}
// Associate the enumaration variable
pError = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
if (pError->IsError())
{
pArgs->Discard(pCC);
return pError;
}
pError->Discard(pCC);
// Setup the context
if (pCtx->pLocalSymbols)
pLocalSymbols->SetParent(pCtx->pLocalSymbols);
else
pLocalSymbols->SetParent(pCtx->pLexicalSymbols);
pOldSymbols = pCtx->pLocalSymbols;
pCtx->pLocalSymbols = pLocalSymbols;
// Start with a default result
pResult = pCC->CreateNil();
// Get the offset of the variable so we don't have to
// search for it all the time
iVarOffset = pLocalSymbols->FindOffset(pCC, pVar);
// Loop over all elements of the list
for (i = 0; i < pList->GetCount(); i++)
{
// Check the condition
if (pCondition)
{
ICCItem *pEval;
// Evaluate the condition
pEval = pCC->Eval(pCtx, pCondition);
if (pEval->IsError())
{
pResult->Discard(pCC);
pResult = pEval;
break;
}
// If the condition is Nil, then we're done
if (pEval->IsNil())
{
pEval->Discard(pCC);
break;
}
}
ICCItem *pItem = pList->GetElement(i);
// Clean up the previous result
pResult->Discard(pCC);
// Set the element
pLocalSymbols->AddByOffset(pCC, iVarOffset, pItem);
// Eval
pResult = pCC->Eval(pCtx, pBody);
if (pResult->IsError())
break;
}
// Clean up
pCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
// Done
pArgs->Discard(pCC);
return pResult;
}
ICCItem *fnBlock (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnBlock
//
// Evaluates a list of expressions
//
// (block (locals ...) exp1 exp2 ... expn)
// (errblock (error locals ...) exp1 exp2 ... expn onerror)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pResult;
ICCItem *pLocals;
ICCItem *pExp;
ICCItem *pLocalSymbols;
ICCItem *pVar;
ICCItem *pOldSymbols;
int i;
// The first argument must be a list of locals
pLocals = pArguments->Head(pCC);
if (pLocals == NULL || !pLocals->IsList())
return pCC->CreateError(CONSTLIT("Locals list expected:"), pLocals);
// If this is an error block then we must have at least one local
if (dwData == FN_BLOCK_ERRBLOCK && pLocals->GetCount() == 0)
return pCC->CreateError(CONSTLIT("errblock must have an 'error' local variable"), NULL);
// Now loop over the remaining arguments, evaluating each in turn
pExp = pArguments->GetElement(1);
// If there are no expressions, then we just return Nil
if (pExp == NULL)
return pCC->CreateNil();
// Setup the locals. We start by creating a local symbol table
pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
return pLocalSymbols;
pLocalSymbols->SetLocalFrame();
// Loop over each item and associate it
for (i = 0; i < pLocals->GetCount(); i++)
{
ICCItem *pItem;
pVar = pLocals->GetElement(i);
pItem = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
if (pItem->IsError())
{
pLocalSymbols->Discard(pCC);
return pItem;
}
pItem->Discard(pCC);
}
// Setup the context
if (pCtx->pLocalSymbols)
pLocalSymbols->SetParent(pCtx->pLocalSymbols);
else
pLocalSymbols->SetParent(pCtx->pLexicalSymbols);
pOldSymbols = pCtx->pLocalSymbols;
pCtx->pLocalSymbols = pLocalSymbols;
// Start with a default result
pResult = pCC->CreateNil();
// Loop (starting with the second arg)
for (i = 1; i < pArguments->GetCount(); i++)
{
pExp = pArguments->GetElement(i);
// If this is an error block and this is the last expression,
// then it must be error condition and we don't want to
// execute it.
if (i+1 == pArguments->GetCount() && dwData == FN_BLOCK_ERRBLOCK)
break;
// Evaluate the expression
pResult->Discard(pCC);
pResult = pCC->Eval(pCtx, pExp);
// If we got an error, handle it
if (pResult->IsError())
{
// If this is an error block, then find the last expression
// and evaluate it.
if (dwData == FN_BLOCK_ERRBLOCK)
{
ICCItem *pItem;
// Set the first local variable to be the error result
pVar = pLocals->Head(pCC);
pItem = pLocalSymbols->AddEntry(pCC, pVar, pResult);
pItem->Discard(pCC);
pResult->Discard(pCC);
// Find the last expression
pExp = pArguments->GetElement(pArguments->GetCount() - 1);
// Evaluate it
pResult = pCC->Eval(pCtx, pExp);
}
// Regardless, leave the block and return the result
break;
}
}
// Clean up
pCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
// Done
return pResult;
}
ICCItem *fnAtmTable (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnAtmTable
//
// Various atom table manipulations
//
// (atmAddEntry symTable symbol entry) -> entry
// (atmDeleteEntry symTable symbol) -> True
// (atmLookup symTable symbol) -> entry
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pSymTable;
ICCItem *pSymbol;
ICCItem *pResult;
// Evaluate the arguments and validate them
if (dwData == FN_ATMTABLE_ADDENTRY)
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("xiv"));
else if (dwData == FN_ATMTABLE_LIST)
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("x"));
else
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("xi"));
if (pArgs->IsError())
return pArgs;
// Get the args
pSymTable = pArgs->Head(pCC);
// Do the right thing
switch (dwData)
{
case FN_ATMTABLE_ADDENTRY:
{
ICCItem *pEntry;
pSymbol = pArgs->GetElement(1);
pEntry = pArgs->GetElement(2);
pResult = pSymTable->AddEntry(pCC, pSymbol, pEntry);
// If we succeeded, return the entry
if (!pResult->IsError())
{
pResult->Discard(pCC);
pResult = pEntry->Reference();
}
break;
}
case FN_ATMTABLE_DELETEENTRY:
{
pResult = pCC->CreateNil();
break;
}
case FN_ATMTABLE_LIST:
{
pResult = pSymTable->ListSymbols(pCC);
break;
}
case FN_ATMTABLE_LOOKUP:
{
pSymbol = pArgs->GetElement(1);
pResult = pSymTable->Lookup(pCC, pSymbol);
break;
}
default:
ASSERT(FALSE);
return NULL;
}
// Done
pArgs->Discard(pCC);
return pResult;
}
ICCItem *fnSet (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnSet
//
// Bind an identifier to some value
//
// (set var exp)
// (setq var exp)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pVar;
ICCItem *pValue;
int iFrame, iOffset;
ICCItem *pSymTable;
// Evaluate the arguments and validate them
if (dwData == FN_SET_SET)
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("sv"));
else
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("qv"));
if (pArgs->IsError())
return pArgs;
// First is the variable; next is the value
pVar = pArgs->GetElement(0);
pValue = pArgs->GetElement(1);
// Figure out which symbol table to start with
if (pCtx->pLocalSymbols)
pSymTable = pCtx->pLocalSymbols;
else
pSymTable = pCtx->pLexicalSymbols;
// If this variable has already been bound, then use a short-cut
if (pVar->GetBinding(&iFrame, &iOffset))
{
while (iFrame > 0)
{
pSymTable = pSymTable->GetParent();
iFrame--;
}
pSymTable->AddByOffset(pCC, iOffset, pValue);
}
else
{
ICCItem *pError;
pError = pSymTable->AddEntry(pCC, pVar, pValue);
// Check for error
if (pError->IsError())
{
pArgs->Discard(pCC);
return pError;
}
pError->Discard(pCC);
}
// Keep a reference to the value, so we can return it
pValue->Reference();
// Done with these
pArgs->Discard(pCC);
// Done
return pValue;
}
ICCItem *fnPageMap (CEvalContext *pEvalCtx, ICCItem *pArgs, DWORD dwData)
// fnPageMap
//
// (pageMap address|pageID enumMethod ['excludeNil] var exp) -> filtered list
{
CCodeChain *pCC = pEvalCtx->pCC;
// Args
ICCItem *pAddress = pArgs->GetElement(0);
ICCItem *pMethod = pArgs->GetElement(1);
bool bExcludeNil;
int iOptionalArg = 2;
if (pArgs->GetCount() > 4)
bExcludeNil = strEquals(pArgs->GetElement(iOptionalArg++)->GetStringValue(), CONSTLIT("excludeNil"));
else
bExcludeNil = false;
ICCItem *pVar = pArgs->GetElement(iOptionalArg++);
ICCItem *pBody = pArgs->GetElement(iOptionalArg++);
// Open the page
IPage *pPage;
CString sError;
if (g_PM.OpenPage(pAddress->GetStringValue(), &pPage, &sError) != NOERROR)
return pCC->CreateError(sError, NULL);
// Prepare the method
SPageEnumCtx EnumCtx;
if (pPage->EnumReset(*pCC, pMethod, EnumCtx, &sError))
{
g_PM.ClosePage(pPage);
return pCC->CreateError(sError, NULL);
}
// Create a destination list
ICCItem *pResult = pCC->CreateLinkedList();
if (pResult->IsError())
{
g_PM.ClosePage(pPage);
return pResult;
}
CCLinkedList *pList = (CCLinkedList *)pResult;
// Setup the locals. We start by creating a local symbol table
ICCItem *pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
{
pResult->Discard(pCC);
g_PM.ClosePage(pPage);
return pLocalSymbols;
}
// Associate the enumaration variable
ICCItem *pError = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
if (pError->IsError())
{
pLocalSymbols->Discard(pCC);
pResult->Discard(pCC);
g_PM.ClosePage(pPage);
return pError;
}
pError->Discard(pCC);
// Setup the context
if (pEvalCtx->pLocalSymbols)
pLocalSymbols->SetParent(pEvalCtx->pLocalSymbols);
else
pLocalSymbols->SetParent(pEvalCtx->pLexicalSymbols);
ICCItem *pOldSymbols = pEvalCtx->pLocalSymbols;
pEvalCtx->pLocalSymbols = pLocalSymbols;
// Get the offset of the variable so we don't have to
// search for it all the time
int iVarOffset = pLocalSymbols->FindOffset(pCC, pVar);
// Enumerate the page
while (pPage->EnumHasMore(EnumCtx))
{
ICCItem *pItem = pPage->EnumGetNext(*pCC, EnumCtx);
if (pItem->IsError())
{
pResult->Discard(pCC);
pResult = pItem;
break;
}
// Set the element
pLocalSymbols->AddByOffset(pCC, iVarOffset, pItem);
// Eval
ICCItem *pMapped = pCC->Eval(pEvalCtx, pBody);
if (pMapped->IsError())
{
pItem->Discard(pCC);
pResult->Discard(pCC);
pResult = pMapped;
break;
}
// If the evaluation is not Nil, then we include the
// item in the result
if (!bExcludeNil || !pMapped->IsNil())
pList->Append(*pCC, pMapped);
pItem->Discard(pCC);
pMapped->Discard(pCC);
}
// Clean up
pEvalCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
g_PM.ClosePage(pPage);
// Done
if (pResult->GetCount() > 0)
return pResult;
else
{
pResult->Discard(pCC);
return pCC->CreateNil();
}
}
ICCItem *CCLambda::Execute (CEvalContext *pCtx, ICCItem *pArgs)
// Execute
//
// Executes the function and returns a result
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pItem;
ICCItem *pOldSymbols;
ICCItem *pLocalSymbols;
ICCItem *pVar;
ICCItem *pArg;
ICCItem *pResult;
int i;
BOOL bNoEval;
// We must have been initialized
if (m_pArgList == NULL || m_pCode == NULL)
return pCC->CreateNil();
// 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();
// Set up the symbol table
pLocalSymbols = pCC->CreateSymbolTable();
if (pLocalSymbols->IsError())
return pLocalSymbols;
// Loop over each item and associate it
for (i = 0; i < m_pArgList->GetCount(); i++)
{
pVar = m_pArgList->GetElement(i);
pArg = pArgs->GetElement(i);
// If the name of this variable is %args, then the rest of the arguments
// should go into a list
if (strCompareAbsolute(pVar->GetStringValue(), CONSTLIT("%args")) == 0)
{
ICCItem *pVarArgs;
// If there are arguments left, add them to a list
if (pArg)
{
int j;
ICCItem *pError;
CCLinkedList *pList;
// Create a list
pVarArgs = pCC->CreateLinkedList();
if (pVarArgs->IsError())
{
pLocalSymbols->Discard(pCC);
return pVarArgs;
}
pList = (CCLinkedList *)pVarArgs;
// Add each argument to the list
for (j = i; j < pArgs->GetCount(); j++)
{
pArg = pArgs->GetElement(j);
if (bNoEval)
pResult = pArg->Reference();
else
pResult = pCC->Eval(pCtx, pArg);
pList->Append(pCC, pResult, &pError);
pResult->Discard(pCC);
if (pError->IsError())
{
pVarArgs->Discard(pCC);
pLocalSymbols->Discard(pCC);
return pError;
}
pError->Discard(pCC);
}
}
else
pVarArgs = pCC->CreateNil();
// Add to the local symbol table
pItem = pLocalSymbols->AddEntry(pCC, pVar, pVarArgs);
pVarArgs->Discard(pCC);
}
// Bind the variable to the argument
else if (pArg == NULL)
pItem = pLocalSymbols->AddEntry(pCC, pVar, pCC->CreateNil());
else
{
ICCItem *pResult;
// Evaluate the arg and add to the table
if (bNoEval)
pResult = pArg->Reference();
else
pResult = pCC->Eval(pCtx, pArg);
pItem = pLocalSymbols->AddEntry(pCC, pVar, pResult);
pResult->Discard(pCC);
}
// Check for error
if (pItem->IsError())
{
pLocalSymbols->Discard(pCC);
return pItem;
}
pItem->Discard(pCC);
}
// Setup the context
pLocalSymbols->SetParent(pCtx->pLexicalSymbols);
pOldSymbols = pCtx->pLocalSymbols;
pCtx->pLocalSymbols = pLocalSymbols;
// Evalute the code
pResult = pCC->Eval(pCtx, m_pCode);
// Clean up
pCtx->pLocalSymbols = pOldSymbols;
pLocalSymbols->Discard(pCC);
return pResult;
}