Имплементиран тип објекта:процедура

eval.c

@@ -11,29 +11,9 @@ object eval(object input)
 {
 	object result;
 
-	if (TYPE(input) == nilObject || TYPE(input) == numberObject ||
+	if (TYPE(input) == symbolObject)
-			TYPE(input) == errorObject)
 	{
-		result = copyObject(input);
+		result = referVariable(SYM(input));
-	}
-	else if (TYPE(input) == symbolObject)
-	{
-		if (symbolExists(SYM(input)))
-		{
-			if (typeOf(SYM(input)) == variableSymbol)
-			{
-				result = referVariable(SYM(input));
-			}
-			else
-			{
-				result = copyObject(input);
-			}
-		}
-		else
-		{
-			TYPE(result) = errorObject;
-			ERR(result) = unrecognizedSymbolError;
-		}
 	}
 	else if (TYPE(input) == consObject)
 	{
@@ -44,25 +24,33 @@ object eval(object input)
 		}
 		else
 		{
+			int specialForm = 0;
+			if (TYPE(CAR(input)) == symbolObject &&
+					isSpecialForm(SYM(CAR(input))))
+			{
+				specialForm = 1;
+				CAR(input) = eval(CAR(input));
+			}
+
 			object *currentCell = &input;
 			int noErrors = 1;
-			while (TYPE(*currentCell) != nilObject)
+			if (!specialForm)
 			{
-				if (TYPE(CAR(input)) != symbolObject ||
+				while (TYPE(*currentCell) != nilObject)
-					!isSpecialForm(SYM(CAR(input))))
 				{
 					CAR(*currentCell) =
 						eval(CAR(*currentCell));
-				}
 
-				if (TYPE(CAR(*currentCell)) == errorObject)
+					if (TYPE(CAR(*currentCell)) == errorObject)
-				{
+					{
-					noErrors = 0;
+						noErrors = 0;
-					TYPE(result) = errorObject;
+						TYPE(result) = errorObject;
-					ERR(result) = ERR(CAR(*currentCell));
+						ERR(result) =
-					break;
+							ERR(CAR(*currentCell));
+						break;
+					}
+					currentCell = &CDR(*currentCell);
 				}
-				currentCell = &CDR(*currentCell);
 			}
 
 			if (noErrors)
@@ -71,36 +59,71 @@ object eval(object input)
 			}
 		}
 	}
+	else
+	{
+		result = copyObject(input);
+	}
 
 	deleteObject(input);
 	return result;
 }
 
-object apply(object function, object parameters)
+object apply(object procedure, object parameters)
 {
 	object result;
 
-	if (TYPE(function) != symbolObject)
+	if (TYPE(procedure) != procedureObject)
 	{
-		deleteObject(function);
 		TYPE(result) = errorObject;
 		ERR(result) = notApplicableError;
+		return result;
 	}
-	else if (symbolExists(SYM(function)))
+
+	object(*f)() = PROC_BUILTIN(procedure);
+	if (PROC_TYPE(procedure) == builtinProc)
 	{
-		object(*f)();
+		result = f(parameters);
-		if ((f = internalFunction(SYM(function))) != NULL)
+		return result;
-		{
-			result = f(parameters);
-		}
 	}
-	else
+
+	object args = copyObject(PROC_COMP_ARGS(procedure));
+	object body = copyObject(PROC_COMP_BODY(procedure));
+	if (listLength(parameters) != listLength(args))
 	{
-		deleteObject(function);
 		TYPE(result) = errorObject;
-		ERR(result) = unrecognizedSymbolError;
+		ERR(result) = argumentNumberError;
+		return result;
 	}
 
+	if (!createTable())
+	{
+		deleteObject(args);
+		deleteObject(body);
+		TYPE(result) = errorObject;
+		ERR(result) = maxRecursionDepthError;
+		return result;
+	}
+	object *currentArg = &args;
+	object *currentParam = &parameters;
+	while (TYPE(*currentArg) != nilObject)
+	{
+		addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam));
+		currentArg = &CDR(*currentArg);
+		currentParam = &CDR(*currentParam);
+	}
+	object *currentSubProc = &body;
+	while (TYPE(*currentSubProc) != nilObject)
+	{
+		CAR(*currentSubProc) = eval(CAR(*currentSubProc));
+		if (TYPE(CDR(*currentSubProc)) == nilObject)
+		{
+			result = CAR(*currentSubProc);
+		}
+		currentSubProc = &CDR(*currentSubProc);
+	}
+	deleteObject(args);
+	deleteObject(body);
+	removeTable();
+
 	return result;
 }
-

init.c

@@ -16,6 +16,7 @@ void init()
 /* Омогућава библиотекама коришћеним у интерпретеру да протумаче српску
  * ћирилицу */
 
+	createTableStack(1000);
 	addSymbolInternal("+", &add);
 	addSymbolInternal("-", &subtract);
 	addSymbolInternal("*", &multiply);

internals.c

@@ -206,6 +206,11 @@ object define(object parameters)
 		addSymbolVariable(SYM(result),
 				eval(copyObject(CAR(CDR(parameters)))));
 	}
+	else
+	{
+		TYPE(result) = errorObject;
+		ERR(result) = typeError;
+	}
 
 	return result;
 }

print.c

@@ -17,7 +17,7 @@ void printValue(object input);
 
 void print(object input)
 {
-	if (input.type == errorObject)
+	if (TYPE(input) == errorObject)
 	{
 		fprintf(stderr, "\nГРЕШКА: %s\n\n", errors[ERR(input)]);
 	}
@@ -31,11 +31,11 @@ void print(object input)
 
 void printValue(object input)
 {
-	if (input.type == nilObject)
+	if (TYPE(input) == nilObject)
 	{
 		printf("()");
 	}
-	else if (input.type == numberObject)
+	else if (TYPE(input) == numberObject)
 	{
 		if (NUM_TYPE(input) == fractionNum)
 		{
@@ -50,11 +50,16 @@ void printValue(object input)
 			printf("%LF", NUM_REAL(input));
 		}
 	}
-	else if (input.type == symbolObject)
+	else if (TYPE(input) == procedureObject)
+	{
+		printf("<процедура:%s>", PROC_TYPE(input) == builtinProc ?
+				"уграђена" : "сложена");
+	}
+	else if (TYPE(input) == symbolObject)
 	{
 		printf("%s", SYM(input));
 	}
-	else if (input.type == consObject)
+	else if (TYPE(input) == consObject)
 	{
 		printf("(");
 		object *currentCell = &input;

symtable.c

@@ -7,21 +7,25 @@
 
 typedef struct entry
 {
-	symbolType type;
 	char *name;
-	union
+	object value;
-	{
-		object (*function)();
-		object variable;
-	} value;
 	struct entry *left;
 	struct entry *right;
 } entry;
-/* овај тип служи за имплементирање табеле симбола који могу бити дефинисани
+/* овај тип служи за имплементирање табеле симбола који помажу да се стварају
- * или путем интерне функције написане у интерпретеру, или је дефинисан
+ * променљиве и процедуре у ћирилиспу */
- * коришћењем самог Ћирилисп интерпретера */
 
-entry *root = NULL;
+entry **tables = NULL;
+#define GLOBALTABLE tables[0]
+int currentTable = 0;
+#define STACKMAX 1000
+/* динамички алоцирани стек табела симбола, где tables[0] означава глобалну
+ * табелу симбола, а сваки наредни члан означава табелу која постоји у
+ * контексту друге, већ постојеће. на пример, уколико имамо процедуру "ф" која
+ * у себи дефиинише и извршава процедуру "г", током извршавања "г", tables[0],
+ * [1] и [2] ће редом означавати: глобалну табелу, табелу процедуре "ф" и
+ * табелу процедуре "г", када је "г" евалуирано и ток контроле се пребацује на
+ * "ф", tables[2] се брише као и сви симболи дефинисани у њој */
 
 entry **findEntry(entry **current, char *symbol)
 {
@@ -51,27 +55,66 @@ entry **findEntry(entry **current, char *symbol)
 void freeEntry(entry **current)
 {
 	free((*current)->name);
-	if ((*current)->type == variableSymbol)
+	deleteObject((*current)->value);
+}
+
+void createTableStack(int size)
+{
+	tables = malloc(size * sizeof(entry *));
+	tables[0] = NULL;
+	currentTable = 0;
+}
+
+int createTable()
+{
+	if (currentTable >= STACKMAX)
 	{
-		deleteObject((*current)->value.variable);
+		return 0;
+	}
+	else
+	{
+		tables[++currentTable] = NULL;
+		return 1;
 	}
 }
 
-symbolType typeOf(char *symbol)
+void removeTableAux(entry **table)
 {
-	entry **e = findEntry(&root, symbol);
+	free((*table)->name);
-
+	deleteObject((*table)->value);
-	return (*e)->type;
+	if ((*table)->left != NULL)
+	{
+		removeTableAux(&(*table)->left);
+		free((*table)->left);
+		(*table)->left = NULL;
+	}
+	if ((*table)->right != NULL)
+	{
+		removeTableAux(&(*table)->right);
+		free((*table)->right);
+		(*table)->right = NULL;
+	}
 }
 
-int addSymbolInternal(char *symbol, object (*function)())
+int removeTable()
 {
-	int status = 1;
+	if (currentTable <= 0)
-	entry **e = findEntry(&root, symbol);
+	{
+		return 0;
+	}
+	else
+	{
+		removeTableAux(&tables[currentTable--]);
+		return 1;
+	}
+}
+
+void addSymbolInternal(char *symbol, object (*function)())
+{
+	entry **e = findEntry(&GLOBALTABLE, symbol);
 
 	if (*e != NULL)
 	{
-		status = 0;
 		freeEntry(e);
 	}
 	else
@@ -79,23 +122,21 @@ int addSymbolInternal(char *symbol, object (*function)())
 		*e = malloc(sizeof(entry));
 	}
 
-	(*e)->type = internalSymbol;
+	TYPE((*e)->value) = procedureObject;
+	PROC((*e)->value) = malloc(sizeof(procedure));
+	PROC_TYPE((*e)->value) = builtinProc;
+	PROC_BUILTIN((*e)->value) = function;
 	(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
 	strcpy((*e)->name, symbol);
-	(*e)->value.function = function;
 	(*e)->left = (*e)->right = NULL;
-
-	return status;
 }
 
-int addSymbolVariable(char *symbol, object variable)
+void addSymbolVariable(char *symbol, object variable)
 {
-	int status = 1;
+	entry **e = findEntry(&tables[currentTable], symbol);
-	entry **e = findEntry(&root, symbol);
 
 	if (*e != NULL)
 	{
-		status = 0;
 		freeEntry(e);
 	}
 	else
@@ -103,60 +144,58 @@ int addSymbolVariable(char *symbol, object variable)
 		*e = malloc(sizeof(entry));
 	}
 
-	(*e)->type = variableSymbol;
+	(*e)->value = copyObject(variable);
 	(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
 	strcpy((*e)->name, symbol);
-	(*e)->value.variable = copyObject(variable);
 	(*e)->left = (*e)->right = NULL;
-
-	return status;
 }
 
-int symbolExists(char *symbol)
+int symbolExistsAux(int index, char *symbol)
 {
-	int status = 1;
+	entry **e = findEntry(&tables[index], symbol);
-	entry **e = findEntry(&root, symbol);
 
 	if (*e == NULL)
 	{
+		if (index != 0)
+		{
+			return symbolExistsAux(index - 1, symbol);
+		}
 		return 0;
 	}
 	else
 	{
 		return 1;
 	}
-
-	return status;
 }
 
-object (*internalFunction(char *symbol)) (object)
+int symbolExists(char *symbol)
 {
-	entry **e = findEntry(&root, symbol);
+	return symbolExistsAux(currentTable, symbol);
-
-	if (*e == NULL || (*e)->type != internalSymbol)
-	{
-		return NULL;
-	}
-	else
-	{
-		return ((*e)->value.function);
-	}
 }
 
-object referVariable(char *symbol)
+object referVariableAux(int index, char *symbol)
 {
 	object result;
-	entry **e = findEntry(&root, symbol);
+	entry **e = findEntry(&tables[index], symbol);
 
-	if (*e == NULL || (*e)->type != variableSymbol)
+	if (*e == NULL)
 	{
+		if (index != 0)
+		{
+			return referVariableAux(index - 1, symbol);
+		}
 		TYPE(result) = errorObject;
 		ERR(result) = unrecognizedSymbolError;
 	}
 	else
 	{
-		result = (*e)->value.variable;
+		result = (*e)->value;
 	}
 
 	return result;
 }
+
+object referVariable(char *symbol)
+{
+	return referVariableAux(currentTable, symbol);
+}

symtable.h

@@ -2,25 +2,18 @@
 
 #include "util.h"
 
-typedef enum
+void createTableStack(int size);
-{
+int createTable();
-	internalSymbol,
+int removeTable();
-	variableSymbol
-} symbolType;
 
-int addSymbolInternal(char *symbol, object (*function)());
+void addSymbolInternal(char *symbol, object (*function)());
-int addSymbolVariable(char *symbol, object variable);
+void addSymbolVariable(char *symbol, object variable);
-/* служе за различите методе дефинисања нових симбола у језику
+/* функције помоћу којих се дефинишу нове променљиве: addSymbolVariable се
- * враћају 1 уколико је нови симбол успешно додат, а 0 уколико није
+ * позива током корисничких дефиниција у програму, док се addSymbolInternal
- * (постоји симбол са истим именом) */
+ * користи у init.c да би се дефинисале "уграђене" процедуре */
 
 int symbolExists(char *symbol);
 /* враћа 1 уколико симбол постоји и 0 у супротном */
-symbolType typeOf(char *symbol);
 
-object (*internalFunction(char *symbol)) (object parameters);
-/* враћа показивач на функцију уколико је симбол дефинисан као интерна
- * функција, NULL уколико симбол није функција или уколико не постоји
- * */
 object referVariable(char *symbol);
 /* враћа вредност на коју се односи име симбола у табели */

util.c

@@ -50,11 +50,19 @@ int listLength(object list)
 
 void deleteObject(object input)
 {
-	if ((TYPE(input) == symbolObject) && SYM(input) != NULL)
+	if (TYPE(input) == symbolObject && SYM(input) != NULL)
 	{
 		free(SYM(input));
 		SYM(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));

util.h

@@ -8,6 +8,12 @@
 #define SYM(x) ((x).value.symbol)
 #define ERR(x) ((x).value.err)
 
+#define PROC(x) ((x).value.proc)
+#define PROC_TYPE(x) ((x).value.proc->type)
+#define PROC_BUILTIN(x) ((x).value.proc->value.builtin)
+#define PROC_COMP_ARGS(x) ((x).value.proc->value.compound.args)
+#define PROC_COMP_BODY(x) ((x).value.proc->value.compound.body)
+
 #define NUM(x) ((x).value.num)
 #define NUM_TYPE(x) ((x).value.num.type)
 #define NUM_NUMER(x) ((x).value.num.value.fraction.numerator)
@@ -20,6 +26,7 @@ typedef enum
 	consObject,
 	numberObject,
 	symbolObject,
+	procedureObject,
 	errorObject
 } dataType;
 
@@ -31,19 +38,28 @@ typedef enum
 	notApplicableError,
 	divisionByZeroError,
 	argumentNumberError,
+	maxRecursionDepthError,
 	syntaxError
 } error;
 
-typedef struct object object;
-typedef struct cons cons;
-
 typedef enum
 {
 	fractionNum,
 	realNum
 } numType;
 
-typedef struct number
+typedef enum
+{
+	builtinProc,
+	compoundProc
+} procType;
+
+typedef struct number number;
+typedef struct object object;
+typedef struct cons cons;
+typedef struct procedure procedure;
+
+struct number
 {
 	numType type;
 	union
@@ -55,7 +71,7 @@ typedef struct number
 			long long int denominator;
 		} fraction;
 	} value;
-} number;
+};
 
 struct object
 {
@@ -66,6 +82,7 @@ struct object
 		char *symbol;
 		cons *consCell;
 		number num;
+		procedure *proc;
 	} value;
 };
 
@@ -75,6 +92,20 @@ struct cons
 	object cdr;
 };
 
+struct procedure
+{
+	procType type;
+	union
+	{
+		object (*builtin)(object);
+		struct
+		{
+			object args;
+			object body;
+		} compound;
+	} value;
+};
+
 int isSpecialForm(char *symbol);
 int properList(object list);
 int listLength(object list);