Измењен систем за руковање грешкама, додата "баци" функција и "услов" специјална форма

Makefile

@@ -20,14 +20,14 @@ L_SRC = инит.ћ
 INC = util.h read.h eval.h print.h internals.h
 OBJ = $(C_SRC:.c=.o)
 
-all: cirilisp
+all: cirilisp $(L_SRC)
 
 .c.o:
 	$(CC) -c $(CPPFLAGS) $(CFLAGS) $<
 
 $(OBJ): $(INC) $(L_SRC)
 
-cirilisp: $(OBJ) $(L_SRC)
+cirilisp: $(OBJ)
 	$(CC) -o $@ $(OBJ) $(LDFLAGS)
 
 clean:

cirilisp.c

@@ -17,7 +17,13 @@ int load(char *pathname)
 	}
 	object exp;
 	while (TYPE(exp = eval(read("", stream), globalEnv)) != EOFObject)
+	{
+		if (TYPE(exp) == errorObject)
+		{
+			print(exp);
+		}
 		deleteObject(exp);
+	}
 	eofStatus = 0;
 	fclose(stream);
 	return 1;
@@ -67,6 +73,7 @@ void init()
 	addSymbolInternal("прикажи", &displayInt, 0);
 	addSymbolInternal("штампај", &printInt, 0);
 	addSymbolInternal("почни", &beginInt, 0);
+	addSymbolInternal("баци", &throwInt, 0);
 	addSymbolInternal("направи-ниску", &makeStrInt, 0);
 	addSymbolInternal("дужина-ниске", &strLengthInt, 0);
 

eval.c

@@ -34,7 +34,7 @@ object eval(object input, env currentEnv)
 			{
 				result = copyObject(CAR(input));
 				deleteObject(input);
-				SIGERR(ERR(result));
+				CPYERR(ERR(result));
 			}
 
 			if (TYPE(CAR(input)) == procedureObject &&
@@ -60,7 +60,7 @@ object eval(object input, env currentEnv)
 						object err = copyObject(
 							CAR(*currentCell));
 						deleteObject(input);
-						SIGERR(ERR(err));
+						CPYERR(ERR(err));
 						break;
 					}
 					currentCell = &CDR(*currentCell);

internals.c

@@ -290,7 +290,7 @@ object defineInt(object parameters, env currentEnv)
 					currentEnv);
 			if (TYPE(value) == errorObject)
 			{
-				SIGERR(ERR(value));
+				CPYERR(ERR(value));
 			}
 			addSymbolVariable(SYM(result), value, currentEnv);
 		}
@@ -423,7 +423,7 @@ object ifInt(object parameters, env currentEnv)
 		predicate = eval(copyObject(CAR(parameters)), currentEnv);
 		if (TYPE(predicate) == errorObject)
 		{
-			SIGERR(ERR(predicate));
+			CPYERR(ERR(predicate));
 		}
 
 		if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
@@ -438,14 +438,14 @@ object ifInt(object parameters, env currentEnv)
 
 		if (TYPE(result) == errorObject)
 		{
-			SIGERR(ERR(result));
+			CPYERR(ERR(result));
 		}
 		break;
 	case 3:
 		predicate = eval(copyObject(CAR(parameters)), currentEnv);
 		if (TYPE(predicate) == errorObject)
 		{
-			SIGERR(ERR(predicate));
+			CPYERR(ERR(predicate));
 		}
 
 		if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
@@ -461,7 +461,7 @@ object ifInt(object parameters, env currentEnv)
 
 		if (TYPE(result) == errorObject)
 		{
-			SIGERR(ERR(result));
+			CPYERR(ERR(result));
 		}
 		break;
 	default:
@@ -758,6 +758,25 @@ object beginInt(object parameters)
 	return last;
 }
 
+object throwInt(object parameters)
+{
+	if (listLength(parameters) != 1)
+	{
+		SIGERR(argumentNumberError);
+	}
+	if (TYPE(CAR(parameters)) != stringObject)
+	{
+		SIGERR(typeError);
+	}
+
+	object result;
+	TYPE(result) = errorObject;
+	ERR(result) = malloc((strlen(STR(CAR(parameters))) + 1) *
+			sizeof(char));
+	strcpy(ERR(result), STR(CAR(parameters)));
+	return result;
+}
+
 object makeStrInt(object parameters)
 {
 	object result;

internals.h

@@ -33,5 +33,6 @@ object applyInt(object parameters, env currentEnv);
 object displayInt(object parameters);
 object printInt(object parameters);
 object beginInt(object parameters);
+object throwInt(object parameters);
 object makeStrInt(object parameters);
 object strLengthInt(object parameters);

print.c

@@ -2,30 +2,13 @@
 
 #include "util.h"
 
-char *errors[] =
-{
-	"Конс објекат мора бити правилна листа да би могао бити евалуиран",
-	"Неправилан конс \".\" оператер",
-	"Неправилан тип аргумента прослеђен функцији",
-	"Непознати симбол",
-	"Објекат није примењив",
-	"Дељење нулом",
-	"Функцији није прослеђен правилан број аргумената",
-	"Пређена је максимална дубина рекурзије",
-	"Невалидан карактер",
-	"Невалидна тараба-секвенца",
-	"Неочекивани крај фајла",
-	"Неочекивана заграда",
-	"Недовољно меморије доступно"
-};
-
 void printValue(object input);
 
 int print(object input)
 {
 	if (TYPE(input) == errorObject)
 	{
-		fprintf(stderr, "\nГРЕШКА: %s\n\n", errors[ERR(input)]);
+		fprintf(stderr, "\nГРЕШКА: %s\n\n", ERR(input));
 	}
 	else if (TYPE(input) == EOFObject)
 	{

read.c

@@ -353,7 +353,8 @@ object macroFunction(wchar_t m, FILE *stream)
 		{
 			object currentObject = read("", stream);
 			if (TYPE(currentObject) == errorObject &&
-				ERR(currentObject) == unmatchedParenError)
+				!strcmp(ERR(currentObject),
+					commonErrs[unmatchedParenError]))
 			{
 				TYPE(*listCurrent) = nilObject;
 				break;
@@ -392,7 +393,7 @@ object macroFunction(wchar_t m, FILE *stream)
 		{
 			object error = copyObject(CAR(*listCurrent));
 			deleteObject(result);
-			SIGERR(ERR(error));
+			CPYERR(ERR(error));
 		}
 
 		int properDotComb = 1, dotPlace = -1, length;
@@ -443,7 +444,7 @@ object macroFunction(wchar_t m, FILE *stream)
 		expression = read("", stream);
 		if (TYPE(expression) == errorObject)
 		{
-			SIGERR(ERR(expression));
+			CPYERR(ERR(expression));
 		}
 		else if (TYPE(expression) == EOFObject)
 		{
@@ -481,8 +482,11 @@ object macroFunction(wchar_t m, FILE *stream)
 			if (c == L'\\')
 			{
 				c = scanwc(stream);
+				if (c != L'\n')
+				{
 					buffer[i++] = escapedWChar(c);
 				}
+			}
 			else
 			{
 				buffer[i++] = c;

util.c

@@ -5,6 +5,23 @@
 
 #include "util.h"
 
+char *commonErrs[] =
+{
+	"Конс објекат мора бити правилна листа да би могао бити евалуиран",
+	"Неправилан конс \".\" оператер",
+	"Неправилан тип аргумента прослеђен функцији",
+	"Непознати симбол",
+	"Објекат није примењив",
+	"Дељење нулом",
+	"Функцији није прослеђен правилан број аргумената",
+	"Пређена је максимална дубина рекурзије",
+	"Невалидан карактер",
+	"Невалидна тараба-секвенца",
+	"Неочекивани крај фајла",
+	"Неочекивана заграда",
+	"Недовољно меморије доступно"
+};
+
 entry **findEntry(entry **current, char *symbol)
 {
 	int cond;
@@ -170,6 +187,11 @@ void deleteObject(object input)
 		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 &&
 			PROC_TYPE(input) == compoundProc)
 	{
@@ -237,7 +259,9 @@ object copyObject(object input)
 		CHR(result) = CHR(input);
 		break;
 	case errorObject:
-		ERR(result) = ERR(input);
+		ERR(result) =
+			malloc(sizeof(char) * (strlen(ERR(input)) + 1));
+		strcpy(ERR(result), ERR(input));
 		break;
 	default:
 		break;

util.h

@@ -14,6 +14,16 @@
 #define ERR(x) ((x).value.err)
 
 #define SIGERR(error) \
+{\
+	object __result;\
+	TYPE(__result) = errorObject;\
+	ERR(__result) = malloc((strlen(commonErrs[error]) + 1) *\
+			sizeof(char));\
+	strcpy(ERR(__result), commonErrs[error]);\
+	return __result;\
+}
+
+#define CPYERR(error) \
 {\
 	object __result;\
 	TYPE(__result) = errorObject;\
@@ -67,6 +77,8 @@ typedef enum
 	outOfMemoryError
 } error;
 
+extern char *commonErrs[];
+
 typedef enum
 {
 	fractionNum,
@@ -107,7 +119,7 @@ struct object
 	dataType type;
 	union
 	{
-		error err;
+		char *err;
 		char *symbol;
 		char *string;
 		wchar_t character;

инит.ћ

@@ -2,16 +2,33 @@
 (опиши (садр џ) (сар (сдр џ)))
 (опиши (сдар џ) (сдр (сар џ)))
 (опиши (сддр џ) (сдр (сдр џ)))
+(опиши (сааар џ) (сар (сар (сар џ))))
+(опиши (саадр џ) (сар (сар (сдр џ))))
+(опиши (садар џ) (сар (сдр (сар џ))))
+(опиши (саддр џ) (сар (сдр (сдр џ))))
+(опиши (сдаар џ) (сдр (сар (сар џ))))
+(опиши (сдадр џ) (сдр (сар (сдр џ))))
+(опиши (сддар џ) (сдр (сдр (сар џ))))
+(опиши (сдддр џ) (сдр (сдр (сдр џ))))
+
+(опиши нил ())
 
 (опиши (није предикат)
 	(ако предикат #л #и))
 
-(опиши нил ())
-
 (опиши истинито #и) (опиши лажно #л)
 
 (опиши (листа . арг) арг)
 
+(опиши (дужина листа)
+	(опиши (дужина-пом листа акумулатор)
+		(ако (нил? листа)
+			акумулатор
+			(дужина-пом (сдр листа) (+ акумулатор 1))))
+	(ако (није (листа? листа))
+		(баци "Неправилан тип аргумента прослеђен функцији")
+		(дужина-пом листа 0)))
+
 (опиши-складњу (и . предикати)
 	(ако (нил? предикати) #и
 		(ако (нил? (сдр предикати))
@@ -28,5 +45,16 @@
 				(примени или (сдр предикати))
 				(сар предикати)))))
 
-#|(опиши-складњу (услов . клаузе)
-	(|#
+(опиши-складњу (услов . клаузе)
+	(ако (= (дужина клаузе) 0)
+		(баци "Конс позван са празном листом клауза")
+		(ако (није (и (конс? (сар клаузе)) (листа? (сар клаузе))))
+			(баци "Неправилна конс клауза")
+			(листа 'ако (саар клаузе)
+				(ако (нил? (сдар клаузе))
+					(саар клаузе)
+					(листа 'примени 'почни
+						(листа 'навод (сдар клаузе))))
+				(ако (нил? (сдр клаузе))
+					()
+					(примени услов (сдр клаузе)))))))