ICCItem *CCLambda::CreateFromList (CCodeChain *pCC, ICCItem *pList, BOOL bArgsOnly)
// CreateFromList
//
// Initializes from a lambda list. Returns True if successful; error otherwise.
// The list must have exactly three elements:
// the symbol lambda
// a list of arguments
// a body of code
{
ICCItem *pArgs;
ICCItem *pBody;
// The first element must be the symbol lambda
if (bArgsOnly)
{
pArgs = pList->GetElement(0);
pBody = pList->GetElement(1);
}
else
{
pArgs = pList->GetElement(0);
if (pArgs == NULL || !pArgs->IsLambdaSymbol())
return pCC->CreateError(LITERAL("Lambda symbol expected"), pArgs);
pArgs = pList->GetElement(1);
pBody = pList->GetElement(2);
}
// The next item must be a list of arguments
if (pArgs == NULL || !pArgs->IsList())
return pCC->CreateError(LITERAL("Argument list expected"), pArgs);
m_pArgList = pArgs->Reference();
// The next item must exist
if (pBody == NULL)
{
m_pArgList->Discard(pCC);
m_pArgList = NULL;
return pCC->CreateError(LITERAL("Code expected"), pList);
}
m_pCode = pBody->Reference();
// Done
return pCC->CreateTrue();
}
ALERROR CCodeChain::Boot (void)
// Boot
//
// Initializes the object. Clean up is done in the destructor
{
ALERROR error;
int i;
ICCItem *pItem;
// Initialize memory error
m_sMemoryError.SetError();
m_sMemoryError.SetValue(LITERAL("Out of memory"));
// Initialize Nil
pItem = new CCNil;
if (pItem == NULL)
return ERR_FAIL;
m_pNil = pItem->Reference();
// Initialize True
pItem = new CCTrue;
if (pItem == NULL)
return ERR_FAIL;
m_pTrue = pItem->Reference();
// Initialize global symbol table
pItem = CreateSymbolTable();
if (pItem->IsError())
return ERR_FAIL;
m_pGlobalSymbols = pItem;
// Register the built-in primitives
for (i = 0; i < DEFPRIMITIVES_COUNT; i++)
if (error = RegisterPrimitive(&g_DefPrimitives[i]))
return error;
return NOERROR;
}
ICCItem *CCAtomTable::LookupEx (CCodeChain *pCC, ICCItem *pAtom, BOOL *retbFound)
// LookupEx
//
// Looks up the key and returns the association. If no
// Association is found, returns an error
{
ALERROR error;
int iValue;
ICCItem *pBinding;
error = m_Table.Find(pAtom->GetIntegerValue(), &iValue);
if (error)
{
if (error == ERR_NOTFOUND)
{
if (retbFound)
*retbFound = FALSE;
return pCC->CreateErrorCode(CCRESULT_NOTFOUND);
}
else
return pCC->CreateMemoryError();
}
pBinding = (ICCItem *)iValue;
ASSERT(pBinding);
if (retbFound)
*retbFound = TRUE;
return pBinding->Reference();
}
ICCItem *ICCItem::GetElement (CCodeChain *pCC, int iIndex)
// GetElement
//
// Returns an element that must be discarded
{
ICCItem *pItem = GetElement(iIndex);
if (pItem == NULL)
return pCC->CreateNil();
return pItem->Reference();
}
ICCItem *CListWrapper::GetEntryAtCursor (CCodeChain &CC)
// GetEntryAtCursor
//
// Returns the entry at the cursor
{
if (!IsCursorValid())
return CC.CreateNil();
ICCItem *pItem = m_pList->GetElement(m_iCursor);
return pItem->Reference();
}
ICCItem *CCSymbolTable::Clone (CCodeChain *pCC)
// Clone
//
// Clone this item
{
int i;
ICCItem *pNew = pCC->CreateSymbolTable();
CCSymbolTable *pNewTable = dynamic_cast<CCSymbolTable *>(pNew);
ASSERT(pNewTable);
// Add all the items to the table
for (i = 0; i < m_Symbols.GetCount(); i++)
{
CString sKey = m_Symbols.GetKey(i);
CObject *pValue = m_Symbols.GetValue(i);
ICCItem *pItem = (ICCItem *)pValue;
// Add to the new table
CObject *pOldEntry;
if (pNewTable->m_Symbols.ReplaceEntry(sKey, pItem->Reference(), TRUE, &pOldEntry) != NOERROR)
return pCC->CreateMemoryError();
// We better not have a previous entry (this can only happen if the existing symbol
// table has a duplicate entry).
ASSERT(pOldEntry == NULL);
}
// Clone the parent reference
if (m_pParent)
{
// Clone local frames, but not the global frame.
if (m_pParent->IsLocalFrame())
pNewTable->m_pParent = m_pParent->Clone(pCC);
else
pNewTable->m_pParent = m_pParent->Reference();
}
else
pNewTable->m_pParent = NULL;
pNewTable->m_bLocalFrame = m_bLocalFrame;
return pNewTable;
}
ICCItem *CCSymbolTable::LookupByOffset (CCodeChain *pCC, int iOffset)
// LookupByOffset
//
// Returns the value at the given offset
{
CObject *pNew = m_Symbols.GetValue(iOffset);
ICCItem *pBinding = dynamic_cast<ICCItem *>(pNew);
if (pBinding)
return pBinding->Reference();
else
return pCC->CreateErrorCode(CCRESULT_NOTFOUND);
}
ICCItem *CCodeChain::CreateSymbolTable (void)
// CreateSymbolTable
//
// Creates an item
{
ICCItem *pItem;
pItem = m_SymbolTablePool.CreateItem(this);
if (pItem->IsError())
return pItem;
pItem->Reset();
return pItem->Reference();
}
ICCItem *CCodeChain::CreateLinkedList (void)
// CreateLinkedList
//
// Creates an item
{
ICCItem *pItem;
pItem = m_ListPool.CreateItem(this);
if (pItem->IsError())
return pItem;
pItem->Reset();
return pItem->Reference();
}
ICCItem *CCSymbolTable::LookupEx (CCodeChain *pCC, ICCItem *pKey, BOOL *retbFound)
// LookupEx
//
// Looks up the key and returns the association. If no
// Association is found, we ask the parent. If none is found, returns an error
{
ALERROR error;
CObject *pNew;
ICCItem *pBinding;
if (error = m_Symbols.Lookup(pKey->GetStringValue(), &pNew))
{
if (error == ERR_NOTFOUND)
{
// If we could not find it in this symbol table, look for
// the symbol in the parent
if (m_pParent)
return m_pParent->LookupEx(pCC, pKey, retbFound);
else
{
if (retbFound)
*retbFound = FALSE;
return pCC->CreateErrorCode(CCRESULT_NOTFOUND);
}
}
else
return pCC->CreateMemoryError();
}
pBinding = dynamic_cast<ICCItem *>(pNew);
ASSERT(pBinding);
if (retbFound)
*retbFound = TRUE;
return pBinding->Reference();
}
ICCItem *CDockScreenStack::GetReturnData (const CString &sAttrib)
// GetReturnData
//
// Returns data for the given attribute. The caller is responsible for
// discarding this data.
{
CCodeChain &CC = g_pUniverse->GetCC();
if (IsEmpty())
return CC.CreateNil();
SDockFrame &Frame = m_Stack[m_Stack.GetCount() - 1];
if (Frame.pReturnData)
{
ICCItem *pResult = Frame.pReturnData->GetElement(sAttrib);
if (pResult)
return pResult->Reference();
}
return CC.CreateNil();
}
ICCItem *CCSymbolTable::SimpleLookup (CCodeChain *pCC, ICCItem *pKey, BOOL *retbFound, int *retiOffset)
// SimpleLookup
//
// Looks up the key and returns the association. If no
// Association is found, returns an error
{
ALERROR error;
CObject *pNew;
ICCItem *pBinding;
int iOffset;
if (error = m_Symbols.LookupEx(pKey->GetStringValue(), &iOffset))
{
if (error == ERR_NOTFOUND)
{
if (retbFound)
*retbFound = FALSE;
return pCC->CreateErrorCode(CCRESULT_NOTFOUND);
}
else
return pCC->CreateMemoryError();
}
pNew = m_Symbols.GetValue(iOffset);
pBinding = dynamic_cast<ICCItem *>(pNew);
ASSERT(pBinding);
if (retbFound)
*retbFound = TRUE;
if (retiOffset)
*retiOffset = iOffset;
return pBinding->Reference();
}
ICCItem *fnItem (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnItem
//
// Returns nth entry in a list (0-based)
//
// (item list nth) -> item
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pArgs;
ICCItem *pResult;
ICCItem *pList;
int iIndex;
// Evaluate the arguments and validate them
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("li"));
if (pArgs->IsError())
return pArgs;
// The first argument is the list
pList = pArgs->Head(pCC);
iIndex = pArgs->GetElement(1)->GetIntegerValue();
pResult = pList->GetElement(iIndex);
if (pResult == NULL)
pResult = pCC->CreateNil();
else
pResult = pResult->Reference();
// Done
pArgs->Discard(pCC);
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 *fnLogical (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnLogical
//
// Logical operators
//
// (and exp1 exp2 ... expn)
// (or exp1 exp2 ... expn)
{
CCodeChain *pCC = pCtx->pCC;
int i;
// Loop over all arguments
for (i = 0; i < pArguments->GetCount(); i++)
{
ICCItem *pResult;
ICCItem *pArg = pArguments->GetElement(i);
// Evaluate the item
if (pArg->IsQuoted())
pResult = pArg->Reference();
else
{
pResult = pCC->Eval(pCtx, pArg);
if (pResult->IsError())
return pResult;
}
// If we are evaluating NOT then reverse the value
if (dwData == FN_LOGICAL_NOT)
{
if (pResult->IsNil())
{
pResult->Discard(pCC);
return pCC->CreateTrue();
}
else
{
pResult->Discard(pCC);
return pCC->CreateNil();
}
}
// If we are evaluating AND and we've got Nil, then
// we can guarantee that the expression is Nil
else if (dwData == FN_LOGICAL_AND && pResult->IsNil())
return pResult;
// Otherwise, if we're evaluating OR and we've got non-Nil,
// then we can guarantee that the expression is True
else if (dwData == FN_LOGICAL_OR && !pResult->IsNil())
{
pResult->Discard(pCC);
return pCC->CreateTrue();
}
// Otherwise, we continue
pResult->Discard(pCC);
}
// If we get here then all the operands are the same (either all
// True or all Nil depending)
if (dwData == FN_LOGICAL_AND)
return pCC->CreateTrue();
else
return pCC->CreateNil();
}
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;
}
ALERROR CLanguageDataBlock::InitFromXML (SDesignLoadCtx &Ctx, CXMLElement *pDesc)
// InitFromXML
//
// Initializes from an XML block
{
int i;
for (i = 0; i < pDesc->GetContentElementCount(); i++)
{
CXMLElement *pItem = pDesc->GetContentElement(i);
CString sID = pItem->GetAttribute(ID_ATTRIB);
if (sID.IsBlank())
{
Ctx.sError = strPatternSubst(CONSTLIT("Invalid id in <Language> block"));
return ERR_FAIL;
}
if (strEquals(pItem->GetTag(), TEXT_TAG))
{
// Link the code
CCodeChainCtx CCCtx;
ICCItem *pCode = CCCtx.Link(pItem->GetContentText(0), 0, NULL);
if (pCode->IsError())
{
Ctx.sError = strPatternSubst(CONSTLIT("Language id: %s : %s"), sID, pCode->GetStringValue());
return ERR_FAIL;
}
// Add an entry
bool bIsNew;
SEntry *pEntry = m_Data.SetAt(sID, &bIsNew);
if (!bIsNew)
{
Ctx.sError = strPatternSubst(CONSTLIT("Duplicate <Language> element: %s"), sID);
return ERR_FAIL;
}
// If pCode is a string and not an identifier, then we can just
// store it directly.
if (pCode->IsIdentifier() && pCode->IsQuoted())
{
pEntry->pCode = NULL;
pEntry->sText = pCode->GetStringValue();
}
// Otherwise we store the code
else
pEntry->pCode = pCode->Reference();
// Done
CCCtx.Discard(pCode);
}
else if (strEquals(pItem->GetTag(), MESSAGE_TAG))
{
// Add an entry
bool bIsNew;
SEntry *pEntry = m_Data.SetAt(sID, &bIsNew);
if (!bIsNew)
{
Ctx.sError = strPatternSubst(CONSTLIT("Duplicate <Language> element: %s"), sID);
return ERR_FAIL;
}
// Set the text
pEntry->pCode = NULL;
pEntry->sText = pItem->GetAttribute(TEXT_ATTRIB);
}
else
{
Ctx.sError = strPatternSubst(CONSTLIT("Invalid element in <Language> block: <%s>"), pItem->GetTag());
return ERR_FAIL;
}
}
return NOERROR;
}
ICCItem *CCodeChain::UnstreamItem (IReadStream *pStream)
// UnstreamItem
//
// Load the item from an open stream
{
ALERROR error;
DWORD dwClass;
ICCItem *pItem;
ICCItem *pError;
// Read the object class
if (error = pStream->Read((char *)&dwClass, sizeof(dwClass), NULL))
return CreateSystemError(error);
// Instantiation an object of the right class
if (dwClass == OBJID_CCINTEGER)
pItem = m_IntegerPool.CreateItem(this);
else if (dwClass == OBJID_CCDOUBLE)
pItem = m_DoublePool.CreateItem(this);
else if (dwClass == OBJID_CCSTRING)
pItem = m_StringPool.CreateItem(this);
else if (dwClass == OBJID_CCLINKEDLIST)
pItem = m_ListPool.CreateItem(this);
else if (dwClass == OBJID_CCPRIMITIVE)
pItem = m_PrimitivePool.CreateItem(this);
else if (dwClass == OBJID_CCNIL)
pItem = m_pNil;
else if (dwClass == OBJID_CCTRUE)
pItem = m_pTrue;
else if (dwClass == OBJID_CCSYMBOLTABLE)
pItem = m_SymbolTablePool.CreateItem(this);
else if (dwClass == OBJID_CCLAMBDA)
pItem = m_LambdaPool.CreateItem(this);
else if (dwClass == OBJID_CCATOMTABLE)
pItem = m_AtomTablePool.CreateItem(this);
else if (dwClass == OBJID_CCVECTOROLD)
{
pItem = new CCVectorOld(this);
if (pItem == NULL)
pItem = CreateMemoryError();
}
else if (dwClass == OBJID_CCVECTOR)
pItem = m_VectorPool.CreateItem(this);
else
return CreateError(LITERAL("Unknown item type"), NULL);
// Check for error
if (pItem->IsError())
return pItem;
// We need to increment the reference here because the native
// create does not.
pItem->Reset();
pItem->Reference();
// Let the item load the rest
pError = pItem->Unstream(this, pStream);
if (pError->IsError())
{
pItem->Discard(this);
return pError;
}
pError->Discard(this);
// Done
return pItem;
}
ICCItem *fnEquality (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)
// fnEquality
//
// Equality and inequality
//
// (eq exp1 exp2 ... expn)
// (> exp1 exp2 ... expn)
// (>= exp1 exp2 ... expn)
// (< exp1 exp2 ... expn)
// (<= exp1 exp2 ... expn)
{
CCodeChain *pCC = pCtx->pCC;
ICCItem *pResult;
ICCItem *pExp;
ICCItem *pPrev = NULL;
ICCItem *pArgs;
int i;
// Evaluate the arguments and validate them
pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("*"));
if (pArgs->IsError())
return pArgs;
// Loop over all arguments
for (i = 0; i < pArgs->GetCount(); i++)
{
pExp = pArgs->GetElement(i);
if (pExp->IsError())
{
pExp->Reference();
pArgs->Discard(pCC);
return pExp;
}
if (pPrev)
{
int iResult = HelperCompareItems(pPrev, pExp);
BOOL bOk;
switch (dwData)
{
case FN_EQUALITY_EQ:
{
bOk = (iResult == 0);
break;
}
case FN_EQUALITY_LESSER:
{
bOk = (iResult < 0);
break;
}
case FN_EQUALITY_LESSER_EQ:
{
bOk = (iResult <= 0);
break;
}
case FN_EQUALITY_GREATER:
{
bOk = (iResult > 0);
break;
}
case FN_EQUALITY_GREATER_EQ:
{
bOk = (iResult >= 0);
break;
}
default:
ASSERT(FALSE);
}
// If we don't have a match, return
if (!bOk)
{
pArgs->Discard(pCC);
return pCC->CreateNil();
}
}
// Remember the previous element so that we can compare
pPrev = pExp;
}
// If we get here, then all items are ok
pArgs->Discard(pCC);
pResult = pCC->CreateTrue();
// Done
return pResult;
}
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;
}
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 *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;
}
