cirilisp/util.c

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

#include "util.h"

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)())
{
	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;
	(*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)->value = copyObject(variable);
	(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
	strcpy((*e)->name, symbol);
	(*e)->left = (*e)->right = NULL;
}

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

#define SPECIALFORMSNUM 3
int isSpecialForm(char *symbol)
{
	int result = 0;
	char *specialForms[] =
	{
		"навод",
		"дефиниши",
		"ламбда"
	};

	for (int i = 0; i < SPECIALFORMSNUM; ++i)
	{
		if (!strcmp(symbol, specialForms[i]))
		{
			result = 1;
		}
	}

	return result;
}

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

void deleteObject(object input)
{
	if (TYPE(input) == symbolObject && SYM(input) != NULL)
	{
		free(SYM(input));
		SYM(input) = NULL;
	}
	else if (TYPE(input) == stringObject && STR(input) != NULL)
	{
		free(STR(input));
		STR(input) = NULL;
	}
	else if (TYPE(input) == procedureObject &&
			PROC_TYPE(input) == compoundProc)
	{
		deleteObject(PROC_COMP_ARGS(input));
		deleteObject(PROC_COMP_BODY(input));
		free(PROC(input));
		PROC(input) = NULL;
	}
	else if (TYPE(input) == consObject)
	{
		deleteObject(CAR(input));
		deleteObject(CDR(input));
		free(CONS(input));
		CONS(input) = NULL;
	}

	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);
		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) = ERR(input);
		break;
	default:
		break;
	}

	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);
			TYPE(result) = errorObject;
			ERR(result) = 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;
		}
	}

	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);
			TYPE(result) = errorObject;
			ERR(result) = 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;
}

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