cirilisp/util.c

#include <stdlib.h>
#include <limits.h>
#include <string.h>
#include <math.h>

#include "util.h"

env globalEnv = NULL;

char *commonErrs[] =
{
	"Конс објекат мора бити правилна листа да би могао бити евалуиран",
	"Неправилан конс \".\" оператер",
	"Неправилан тип аргумента прослеђен функцији",
	"Непознати симбол",
	"Објекат није примењив",
	"Дељење нулом",
	"Функцији није прослеђен правилан број аргумената",
	"Пређена је максимална дубина рекурзије",
	"Невалидан карактер",
	"Невалидна тараба-секвенца",
	"Неочекивани крај фајла",
	"Неочекивана заграда",
	"Недовољно меморије доступно"
};

entry **findEntry(entry **current, char *symbol)
{
	int cond;

	if (*current == NULL)
	{
		return current;
	}
	else if ((cond = strcmp(symbol, (*current)->name)) < 0)
	{
		return findEntry(&(*current)->left, symbol);
	}
	else if (cond > 0)
	{
		return findEntry(&(*current)->right, symbol);
	}
	else
	{
		return current;
	}
	/* случај у којем тражени симбол не постоји у табели, и случај у којем
	 * је он нађен враћају вредност на исти начин, али су гране тока
	 * одвојене ради читљивости */
}

void freeEntry(entry **current)
{
	free((*current)->name);
	deleteObject((*current)->value);
}

env createEnvironment(env enclosing)
{
	env result = malloc(sizeof(frame));
	result->table = NULL;
	result->enclosing = enclosing;
	return result;
}

void removeTable(entry **table)
{
	if ((*table) != NULL)
	{
		removeTable(&(*table)->left);
		removeTable(&(*table)->right);
		freeEntry(table);
		free(*table);
		*table = NULL;
	}
}

void removeEnvironment(env input)
{
	removeTable(&input->table);
	free(input);
}

void addSymbolInternal(char *symbol, object (*function)(), int isSpecialForm)
{
	entry **e = findEntry(&globalEnv->table, symbol);

	if (*e != NULL)
	{
		freeEntry(e);
	}
	else
	{
		*e = malloc(sizeof(entry));
	}

	TYPE((*e)->value) = procedureObject;
	PROC((*e)->value) = createProcedure();
	PROC_TYPE((*e)->value) = builtinProc;
	PROC_BUILTIN((*e)->value) = function;
	PROC_SPECIAL((*e)->value) = isSpecialForm;
	(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
	strcpy((*e)->name, symbol);
	(*e)->left = (*e)->right = NULL;
}

void addSymbolVariable(char *symbol, object variable, env currentEnv)
{
	entry **e = findEntry(&currentEnv->table, symbol);

	if (*e != NULL)
	{
		freeEntry(e);
	}
	else
	{
		*e = malloc(sizeof(entry));
		(*e)->left = (*e)->right = NULL;
	}

	(*e)->value = copyObject(variable);
	(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
	strcpy((*e)->name, symbol);
}

object referVariable(char *symbol, env currentEnv)
{
	entry **e = findEntry(&currentEnv->table, symbol);
	if (*e == NULL)
	{
		if (currentEnv->enclosing == NULL)
		{
			SIGERR(unrecognizedSymbolError);
		}
		else
		{
			return referVariable(symbol, currentEnv->enclosing);
		}
	}
	else
	{
		return copyObject((*e)->value);
	}
}

int properList(object list)
{
	object *current = &list;
	while (TYPE(*current) == consObject)
	{
		current = &CDR(*current);
	}
	return TYPE(*current) == nilObject;
}

int listLength(object list)
{
	object *current = &list;
	int i = 0;
	while (TYPE(*current) != nilObject)
	{
		current = &CDR(*current);
		++i;
	}
	return i;
}

int improperListLength(object list)
{
	object *current = &list;
	int i = 1;
	while (TYPE(*current) == consObject)
	{
		current = &CDR(*current);
		++i;
	}
	return i;
}

void deleteObject(object input)
{
	switch (TYPE(input))
	{
	case consObject:
		deleteObject(CAR(input));
		deleteObject(CDR(input));
		free(CONS(input));
		CONS(input) = NULL;
		break;
	case procedureObject:
		if (PROC_TYPE(input) == compoundProc)
		{
			deleteObject(PROC_COMP_ARGS(input));
			deleteObject(PROC_COMP_BODY(input));
		}
		free(PROC(input));
		PROC(input) = NULL;
		break;
	case symbolObject:
		if (SYM(input) == NULL)
		{
			break;
		}
		free(SYM(input));
		SYM(input) = NULL;
		break;
	case stringObject:
		if (STR(input) == NULL)
		{
			break;
		}
		free(STR(input));
		STR(input) = NULL;
		break;
	case errorObject:
		if (ERR(input) == NULL)
		{
			break;
		}
		free(ERR(input));
		ERR(input) = NULL;
		break;
	default:
		break;
	}

	TYPE(input) = nilObject;
}

object copyObject(object input)
{
	object result;
	TYPE(result) = TYPE(input);
	switch (TYPE(input))
	{
	case consObject:
		CONS(result) = malloc(sizeof(cons));
		CAR(result) = copyObject(CAR(input));
		CDR(result) = copyObject(CDR(input));
		break;
	case numberObject:
		NUM(result) = NUM(input);
		break;
	case symbolObject:
		SYM(result) =
			malloc(sizeof(char) * (strlen(SYM(input)) + 1));
		strcpy(SYM(result), SYM(input));
		break;
	case procedureObject:
		PROC(result) = malloc(sizeof(procedure));
		PROC_TYPE(result) = PROC_TYPE(input);
		PROC_SPECIAL(result) = PROC_SPECIAL(input);
		if (PROC_TYPE(result) == builtinProc)
		{
			PROC_BUILTIN(result) = PROC_BUILTIN(input);
		}
		else
		{
			PROC_COMP_ARGS(result) =
				copyObject(PROC_COMP_ARGS(input));
			PROC_COMP_BODY(result) =
				copyObject(PROC_COMP_BODY(input));
			PROC_COMP_ENV(result) = PROC_COMP_ENV(input);
		}
		break;
	case boolObject:
		BOOL(result) = BOOL(input);
		break;
	case stringObject:
		STR(result) =
			malloc(sizeof(char) * (strlen(STR(input)) + 1));
		strcpy(STR(result), STR(input));
		break;
	case charObject:
		CHR(result) = CHR(input);
		break;
	case errorObject:
		ERR(result) =
			malloc(sizeof(char) * (strlen(ERR(input)) + 1));
		strcpy(ERR(result), ERR(input));
		break;
	default:
		break;
	}

	return result;
}

object quoteExpression(object input)
{
	object result;

	TYPE(result) = consObject;
	CONS(result) = malloc(sizeof(cons));
	TYPE(CAR(result)) = symbolObject;
	SYM(CAR(result)) = malloc(sizeof(char) * (strlen("навод") + 1));
	strcpy(SYM(CAR(result)), "навод");
	TYPE(CDR(result)) = consObject;
	CONS(CDR(result)) = malloc(sizeof(cons));
	CAR(CDR(result)) = input;
	TYPE(CDR(CDR(result))) = nilObject;

	return result;
}

object longlongToNumber(long long int input)
{
	object result;
	TYPE(result) = numberObject;
	NUM_TYPE(result) = fractionNum;
	NUM_NUMER(result) = input;
	NUM_DENOM(result) = 1LL;

	return result;
}

object exactToInexactNum(object a)
{
	object result = copyObject(a);

	if (TYPE(result) == numberObject && NUM_TYPE(result) == fractionNum)
	{
		NUM_TYPE(result) = realNum;
		NUM_REAL(result) = (long double) NUM_NUMER(result) /
			(long double) NUM_DENOM(result);
	}

	return result;
}

object inexactToExactNum(object a)
{
	object result = copyObject(a);

	if (TYPE(result) == numberObject && NUM_TYPE(result) == realNum)
	{
		long long int divisor = 1;
		while (NUM_REAL(result) != floorl(NUM_REAL(result)) &&
				divisor <= INT_MAX)
		{
			NUM_REAL(result) *= 10.0L;
			divisor *= 10LL;
		}

		NUM_TYPE(result) = fractionNum;
		NUM_NUMER(result) = (long long int) floorl(NUM_REAL(result));
		NUM_DENOM(result) = divisor;

		result = shortenFractionNum(result);
	}

	return result;
}

long long int gcd(long long int a, long long int b)
/* највећи заједнички делилац */
{
	if (b == 0LL)
	{
		return a;
	}
	else
	{
		return gcd(b, a - b * (a / b));
	}
}
long long int lcm(long long int a, long long int b)
/* најмањи заједнички садржалац */
{
	if (a == 0LL && b == 0LL)
	{
		return 0L;
	}
	else
	{
		return llabs(a * b) / gcd(a, b);
	}
}

object shortenFractionNum(object a)
/* скраћује разломак, враћа грешку ако је неправилан разломак, уколико улаз
 * заиста јесте дат као разломак */
{
	object result = copyObject(a);

	if (TYPE(result) == numberObject && NUM_TYPE(result) == fractionNum)
	{
		if (NUM_DENOM(result) == 0)
		{
			deleteObject(result);
			SIGERR(divisionByZeroError);
		}
		else if (NUM_NUMER(result) == 0)
		{
			NUM_DENOM(result) = 1;
		}
		else
		{
			long long int divisor =
				gcd(NUM_NUMER(result), NUM_DENOM(result));
			NUM_NUMER(result) /= divisor;
			NUM_DENOM(result) /= divisor;
			if (NUM_DENOM(result) < 0)
			{
				NUM_DENOM(result) = -NUM_DENOM(result);
				NUM_NUMER(result) = -NUM_NUMER(result);
			}
		}
	}

	return result;
}

object plusNum(object a, object b)
{
	object result;
	TYPE(result) = numberObject;

	if (NUM_TYPE(a) == fractionNum && NUM_TYPE(b) == fractionNum)
	{
		NUM_TYPE(result) = fractionNum;
		NUM_NUMER(result) = NUM_NUMER(a) * NUM_DENOM(b) + NUM_NUMER(b) * NUM_DENOM(a);
		NUM_DENOM(result) = NUM_DENOM(a) * NUM_DENOM(b);
/*
 * TODO: имплементирати оптималнији начин множења разломака
		long long int denominator = lcm(NUM_DENOM(a), NUM_DENOM(b));
		NUM_NUMER(result) =
			NUM_NUMER(a) * (denominator / NUM_DENOM(a)) +
			NUM_NUMER(b) * (denominator / NUM_DENOM(b));
*/
		result =  shortenFractionNum(result);
	}
	else
	{
		NUM_TYPE(result) = realNum;
		NUM_REAL(result) = NUM_REAL(exactToInexactNum(a))
			+ NUM_REAL(exactToInexactNum(b));
	}

	return result;
}

object minusNum(object a)
{
	object result;
	result = copyObject(a);

	if (NUM_TYPE(result) == fractionNum)
	{
		NUM_NUMER(result) = -NUM_NUMER(result);
	}
	else if (NUM_TYPE(result) == realNum)
	{
		NUM_REAL(result) = -NUM_REAL(result);
	}

	return result;
}

object timesNum(object a, object b)
{
	object result;
	TYPE(result) = numberObject;

	if (NUM_TYPE(a) == fractionNum && NUM_TYPE(b) == fractionNum)
	{
		NUM_TYPE(result) = fractionNum;
		NUM_NUMER(result) = NUM_NUMER(a) * NUM_NUMER(b);
		NUM_DENOM(result) = NUM_DENOM(a) * NUM_DENOM(b);
		result = shortenFractionNum(result);
	}
	else
	{
		NUM_TYPE(result) = realNum;
		NUM_REAL(result) = NUM_REAL(exactToInexactNum(a)) *
			NUM_REAL(exactToInexactNum(b));
	}

	return result;
}

object inverseNum(object a)
{
	object result;
	result = copyObject(a);

	if (NUM_TYPE(result) == fractionNum)
	{
		if (NUM_NUMER(result) == 0)
		{
			deleteObject(result);
			SIGERR(divisionByZeroError);
		}
		else
		{
			NUM_NUMER(result) = NUM_DENOM(a);
			NUM_DENOM(result) = NUM_NUMER(a);
		}
	}
	else if (NUM_TYPE(result) == realNum)
	{
		NUM_REAL(result) = 1.0L/NUM_REAL(result);
	}

	return result;
}

int cmp(object a, object b)
{
	object aCmp = copyObject(a), bCmp = copyObject(b);
	if (NUM_TYPE(aCmp) == realNum || NUM_TYPE(bCmp) == realNum)
	{
		aCmp = exactToInexactNum(aCmp);
		bCmp = exactToInexactNum(bCmp);

		if (NUM_REAL(aCmp) > NUM_REAL(bCmp))
		{
			return 1;
		}
		else if (NUM_REAL(aCmp) < NUM_REAL(bCmp))
		{
			return -1;
		}
		else
		{
			return 0;
		}
	}
	else
	{
		long long int denom = lcm(NUM_DENOM(aCmp), NUM_DENOM(bCmp));
		NUM_NUMER(aCmp) = NUM_NUMER(aCmp) * (denom / NUM_DENOM(aCmp));
		NUM_NUMER(bCmp) = NUM_NUMER(bCmp) * (denom / NUM_DENOM(bCmp));
		NUM_DENOM(aCmp) = NUM_DENOM(bCmp) = denom;

		if (NUM_NUMER(aCmp) > NUM_NUMER(bCmp))
		{
			return 1;
		}
		else if (NUM_NUMER(aCmp) < NUM_NUMER(bCmp))
		{
			return -1;
		}
		else
		{
			return 0;
		}
	}
}

int integer(object a)
{
	if (NUM_TYPE(a) != fractionNum || NUM_DENOM(a) != 1)
	{
		return 0;
	}
	return 1;
}

object intToBool(int boolean)
{
	object result;
	TYPE(result) = boolObject;
	BOOL(result) = boolean == 0 ? 0 : 1;
	return result;
}

procedure *createProcedure()
{
	return malloc(sizeof(procedure));
}