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; }