Exemple #1
0
ICCItem *fnVecCreate (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)

//	fnVecCreate
//
//	Creates a new vector of a given size
//
//	(vecVector size) -> vector
//
//	All elements of the vector are initialized to 0

	{
	CCodeChain *pCC = pCtx->pCC;
	ICCItem *pArgs;
	ICCItem *pVector;

	//	Evaluate the argument

	pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("i"));
	if (pArgs->IsError())
		return pArgs;

	//	Create the table

	pVector = pCC->CreateVector(pArgs->Head(pCC)->GetIntegerValue());

	//	Done

	pArgs->Discard(pCC);
	return pVector;
	}
Exemple #2
0
ICCItem *fnCount (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)

//	fnCount
//
//	Returns the number of elements in the list
//
//	(count list)

	{
	CCodeChain *pCC = pCtx->pCC;
	ICCItem *pArgs;
	ICCItem *pResult;
	ICCItem *pList;

	//	Evaluate the arguments and validate them

	pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("l"));
	if (pArgs->IsError())
		return pArgs;

	//	The first argument is the list

	pList = pArgs->Head(pCC);
	pResult = pCC->CreateInteger(pList->GetCount());

	//	Done

	pArgs->Discard(pCC);
	return pResult;
	}
Exemple #3
0
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;
	}
Exemple #4
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;
	}
Exemple #5
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;
	}
Exemple #6
0
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;
	}
Exemple #7
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;
	}
Exemple #8
0
ICCItem *fnItemInfo (CEvalContext *pCtx, ICCItem *pArguments, DWORD dwData)

//	fnItemInfo
//
//	Returns info about a single item
//
//	(isatom item) -> True/Nil
//	(iserror item) -> True/Nil
//	(isfunction item) -> True/Nil

	{
	CCodeChain *pCC = pCtx->pCC;
	ICCItem *pArgs;
	ICCItem *pResult;

	//	Evaluate the arguments and validate them

	pArgs = pCC->EvaluateArgs(pCtx, pArguments, CONSTLIT("v"));
	if (pArgs->IsError())
		return pArgs;

	//	Do the right thing

	switch (dwData)
		{
		case FN_ITEMINFO_ISERROR:
			{
			if (pArgs->Head(pCC)->IsError())
				pResult = pCC->CreateTrue();
			else
				pResult = pCC->CreateNil();
			break;
			}

		case FN_ITEMINFO_ISATOM:
			{
			if (pArgs->Head(pCC)->IsAtom())
				pResult = pCC->CreateTrue();
			else
				pResult = pCC->CreateNil();
			break;
			}

		case FN_ITEMINFO_ISINT:
			{
			pResult = pCC->CreateBool(pArgs->Head(pCC)->IsInteger() ? true : false);
			break;
			}

		case FN_ITEMINFO_ISFUNCTION:
			{
			if (pArgs->Head(pCC)->IsFunction())
				pResult = pCC->CreateTrue();
			else
				pResult = pCC->CreateNil();
			break;
			}

		case FN_ITEMINFO_ASINT:
			{
			pResult = pCC->CreateInteger(pArgs->Head(pCC)->GetIntegerValue());
			break;
			}

		case FN_ITEMINFO_HELP:
			{
			CString sHelp = pArgs->GetElement(0)->GetHelp();
			if (sHelp.IsBlank())
				pResult = pCC->CreateNil();
			else
				pResult = pCC->CreateString(sHelp);
			break;
			}

		default:
			ASSERT(FALSE);
			return NULL;
		}

	//	Done

	pArgs->Discard(pCC);
	return pResult;
	}