543 lines
11 KiB
C
543 lines
11 KiB
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(¤tEnv->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(¤tEnv->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)
|
||
{
|
||
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) == errorObject && ERR(input) != NULL)
|
||
{
|
||
free(ERR(input));
|
||
ERR(input) = NULL;
|
||
}
|
||
else if (TYPE(input) == procedureObject)
|
||
{
|
||
if (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);
|
||
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 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));
|
||
}
|