Ejemplo n.º 1
0
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();
	}
Ejemplo n.º 2
0
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;
	}
Ejemplo n.º 3
0
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();
	}
Ejemplo n.º 4
0
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();
	}
Ejemplo n.º 5
0
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();
	}
Ejemplo n.º 6
0
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;
	}
Ejemplo n.º 7
0
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);
	}
Ejemplo n.º 8
0
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();
	}
Ejemplo n.º 9
0
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();
	}
Ejemplo n.º 10
0
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();
	}
Ejemplo n.º 11
0
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();
	}
Ejemplo n.º 12
0
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();
	}
Ejemplo n.º 13
0
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;
	}
Ejemplo n.º 14
0
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;
	}
Ejemplo n.º 15
0
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;
	}
Ejemplo n.º 16
0
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();
	}
Ejemplo n.º 17
0
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;
	}
Ejemplo n.º 19
0
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;
	}
Ejemplo n.º 20
0
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;
	}
Ejemplo n.º 21
0
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;
	}
Ejemplo n.º 22
0
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;
	}
Ejemplo n.º 23
0
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;
	}