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

Makefile

@@ -9,8 +9,8 @@ LIBPREFIX = $(PREFIX)/lib
 
 # флегови за C компајлер и линкер
 CPPFLAGS = -D_POSIX_C_SOURCE=200200L -DDESTDIR=\"$(DESTDIR)\"
-# CFLAGS = -g -std=c99 -pedantic -Wall -O0
-CFLAGS  = -std=c99 -pedantic -Wall -O3
+CFLAGS = -g -std=c99 -pedantic -Wall -O0
+# CFLAGS  = -std=c99 -pedantic -Wall -O3
 LDFLAGS = -lm -lc
 
 CC = cc

cirilisp.c

@@ -40,7 +40,8 @@ void init()
 	addSymbolInternal("*", &multiplyInt, 0);
 	addSymbolInternal("/", &divideInt, 0);
 	addSymbolInternal("навод", &quoteInt, 1);
-	addSymbolInternal("дефиниши", &defineInt, 1);
+	addSymbolInternal("опиши", &defineInt, 1);
+	addSymbolInternal("опиши-складњу", &defineMacroInt, 1);
 	addSymbolInternal("тачно->нетачно", &exactToInexactInt, 0);
 	addSymbolInternal("нетачно->тачно", &inexactToExactInt, 0);
 	addSymbolInternal("ламбда", &lambdaInt, 1);
@@ -62,6 +63,9 @@ void init()
 	addSymbolInternal("сдр", &cdrInt, 0);
 	addSymbolInternal("јед?", &eqvQInt, 0);
 	addSymbolInternal("примени", &applyInt, 0);
+	addSymbolInternal("прикажи", &displayInt, 0);
+	addSymbolInternal("штампај", &printInt, 0);
+	addSymbolInternal("почни", &beginInt, 0);
 
 	if (!load(DESTDIR"/usr/local/lib/cirilisp/инит.ћ"))
 	{

eval.c

@@ -7,7 +7,7 @@
 #include "eval.h"
 
 int currentRecursionDepth = 0;
-#define MAXRECURSIONDEPTH 1000
+int maxRecursionDepth = 10000;
 
 object apply(object function, object parameters, env currentEnv);
 
@@ -37,8 +37,7 @@ object eval(object input, env currentEnv)
 				SIGERR(ERR(result));
 			}
 
-			if (TYPE(CAR(input)) == procedureObject && 
-				PROC_TYPE(CAR(input)) == builtinProc &&
+			if (TYPE(CAR(input)) == procedureObject &&
 				PROC_SPECIAL(CAR(input)))
 			{
 				regularEvalOrder = 0;
@@ -73,6 +72,13 @@ object eval(object input, env currentEnv)
 				result = apply(CAR(input), CDR(input),
 						currentEnv);
 			}
+
+			if (TYPE(CAR(input)) == procedureObject &&
+				PROC_SPECIAL(CAR(input)) &&
+				PROC_TYPE(CAR(input)) == compoundProc)
+			{
+				result = eval(result, currentEnv);
+			}
 		}
 	}
 	else
@@ -161,7 +167,7 @@ object apply(object procedure, object parameters, env currentEnv)
 		return result;
 	}
 
-	if (++currentRecursionDepth > MAXRECURSIONDEPTH)
+	if (++currentRecursionDepth > maxRecursionDepth)
 	{
 		--currentRecursionDepth;
 		SIGERR(maxRecursionDepthError);

internals.c

@@ -1,7 +1,9 @@
 #include <string.h>
+#include <stdio.h>
 #include <stdlib.h>
 
 #include "util.h"
+#include "print.h"
 #include "eval.h"
 
 int allNums(object list)
@@ -261,6 +263,7 @@ object lambdaInt(object parameters, env currentEnv)
 		TYPE(result) = procedureObject;
 		PROC(result) = createProcedure();
 		PROC_TYPE(result) = compoundProc;
+		PROC_SPECIAL(result) = 0;
 		PROC_COMP_ARGS(result) = copyObject(CAR(parameters));
 		PROC_COMP_BODY(result) = copyObject(CDR(parameters));
 		PROC_COMP_ENV(result) = currentEnv;
@@ -328,6 +331,39 @@ object defineInt(object parameters, env currentEnv)
 	return result;
 }
 
+object defineMacroInt(object parameters, env currentEnv)
+{
+	object result;
+	if (listLength(parameters) < 2)
+	{
+		SIGERR(argumentNumberError);
+	}
+	else if (TYPE(CAR(parameters)) != consObject)
+	{
+		SIGERR(typeError);
+	}
+	else
+	{
+		if (allSyms(CAR(parameters)))
+		{
+			result = copyObject(CAR(CAR(parameters)));
+			object args = copyObject(CDR(CAR(parameters)));
+			deleteObject(CAR(parameters));
+			CAR(parameters) = copyObject(args);
+			deleteObject(args);
+			object proc = lambdaInt(parameters, currentEnv);
+			PROC_SPECIAL(proc) = 1;
+			addSymbolVariable(SYM(result), proc, currentEnv);
+		}
+		else
+		{
+			SIGERR(typeError);
+		}
+	}
+
+	return result;
+}
+
 object cmpMultiple(object parameters, int flag)
 /* проверава помоћу cmp функције у util.h хедеру, да ли је дата листа, листа
  * строго опадајућих, једнаких, или строго растућих бројева, у зависности од
@@ -616,3 +652,55 @@ object applyInt(object parameters, env currentEnv)
 	}
 	return apply(CAR(parameters), CAR(CDR(parameters)), currentEnv);
 }
+
+object displayInt(object parameters)
+{
+	if (listLength(parameters) != 1)
+	{
+		SIGERR(argumentNumberError);
+	}
+
+	if (TYPE(CAR(parameters)) == stringObject)
+	{
+		printf("%s", STR(CAR(parameters)));
+	}
+	else if (TYPE(CAR(parameters)) == charObject)
+	{
+		putwchar(CHR(CAR(parameters)));
+	}
+	else
+	{
+		SIGERR(typeError);
+	}
+	return copyObject(CAR(parameters));
+}
+
+object printInt(object parameters)
+{
+	if (listLength(parameters) != 1)
+	{
+		SIGERR(argumentNumberError);
+	}
+
+	printValue(CAR(parameters));
+	return copyObject(CAR(parameters));
+}
+
+object beginInt(object parameters)
+{
+	object last;
+	if (listLength(parameters) == 0)
+	{
+		TYPE(last) = nilObject;
+	}
+	else
+	{
+		object *current = &parameters;
+		while (TYPE(CDR(*current)) != nilObject)
+		{
+			current = &CDR(*current);
+		}
+		last = copyObject(CAR(*current));
+	}
+	return last;
+}

internals.h

@@ -10,6 +10,7 @@ object inexactToExactInt(object parameters);
 object quoteInt(object parameters);
 object lambdaInt(object parameters, env currentEnv);
 object defineInt(object parameters, env currentEnv);
+object defineMacroInt(object parameters, env currentEnv);
 object lessInt(object parameters);
 object greaterInt(object parameters);
 object eqNumInt(object parameters);
@@ -28,3 +29,6 @@ object carInt(object parameters);
 object cdrInt(object parameters);
 object eqvQInt(object parameters);
 object applyInt(object parameters, env currentEnv);
+object displayInt(object parameters);
+object printInt(object parameters);
+object beginInt(object parameters);

print.h

@@ -1,3 +1,4 @@
 #pragma once
 
 int print(object input);
+void printValue(object input);

read.c

@@ -272,7 +272,8 @@ object dispatchedChar(wint_t c, FILE *stream)
 		else
 		{
 			unscanwc(c, stream);
-			while ((c = scanwc(stream)) != WEOF && !iswspace(c))
+			while ((c = scanwc(stream)) != WEOF &&
+				isConstituent(c))
 			{
 				if (i + 1 >= bufferSize)
 				{
@@ -280,6 +281,7 @@ object dispatchedChar(wint_t c, FILE *stream)
 				}
 				buffer[i++] = c;
 			}
+			unscanwc(c, stream);
 			buffer[i] = L'\0';
 			n = wcslen(buffer);
 			if (n == 1)

util.c

@@ -104,7 +104,7 @@ void addSymbolVariable(char *symbol, object variable, env currentEnv)
 	(*e)->left = (*e)->right = NULL;
 }
 
-object referVariable(char *symbol,env currentEnv)
+object referVariable(char *symbol, env currentEnv)
 {
 	entry **e = findEntry(&currentEnv->table, symbol);
 	if (*e == NULL)
@@ -211,10 +211,10 @@ object copyObject(object input)
 	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);
-			PROC_SPECIAL(result) = PROC_SPECIAL(input);
 		}
 		else
 		{

util.h

@@ -23,8 +23,8 @@
 
 #define PROC(x) ((x).value.proc)
 #define PROC_TYPE(x) ((x).value.proc->type)
+#define PROC_SPECIAL(x) ((x).value.proc->isSpecialForm)
 #define PROC_BUILTIN(x) ((x).value.proc->value.builtin.pointer)
-#define PROC_SPECIAL(x) ((x).value.proc->value.builtin.isSpecialForm)
 #define PROC_COMP_ARGS(x) ((x).value.proc->value.compound.args)
 #define PROC_COMP_BODY(x) ((x).value.proc->value.compound.body)
 #define PROC_COMP_ENV(x) ((x).value.proc->value.compound.environment)
@@ -136,18 +136,21 @@ struct entry
 struct frame
 {
 	entry *table;
+/* Макрои у табели се налазе као конс структуре где је car форма маркоа
+ * представљена у листи (м а1 а2 . остало) а cdr је дефиниција макроа
+ * представљена као симболички израз */
 	env enclosing;
 };
 
 struct procedure
 {
 	procType type;
+	int isSpecialForm;
 	union
 	{
 		struct
 		{
 			object (*pointer)(object);
-			int isSpecialForm;
 		} builtin;
 		struct
 		{
@@ -170,9 +173,6 @@ void addSymbolVariable(char *symbol, object variable, env currentEnv);
  * позива током корисничких дефиниција у програму, док се addSymbolInternal
  * користи у init.c да би се дефинисале "уграђене" процедуре */
 
-int symbolExists(char *symbol, env currentEnv);
-/* враћа 1 уколико симбол постоји и 0 у супротном */
-
 object referVariable(char *symbol, env currentEnv);
 /* враћа вредност на коју се односи име симбола у табели */
 /******************************* */

инит.ћ

@@ -1,8 +1,32 @@
-(дефиниши (није предикат)
+(опиши (саар џ) (сар (сар џ)))
+(опиши (садр џ) (сар (сдр џ)))
+(опиши (сдар џ) (сдр (сар џ)))
+(опиши (сддр џ) (сдр (сдр џ)))
+
+(опиши (није предикат)
 	(ако предикат #л #и))
 
-(дефиниши нил ())
+(опиши нил ())
 
-(дефиниши истинито #и) (дефиниши лажно #л)
+(опиши истинито #и) (опиши лажно #л)
 
-(дефиниши (листа . арг) арг)
+(опиши (листа . арг) арг)
+
+(опиши-складњу (и . предикати)
+	(ако (нил? предикати) #и
+		(ако (нил? (сдр предикати))
+			(сар предикати)
+			(листа 'ако (сар предикати)
+				(примени и (сдр предикати))
+				#л))))
+
+(опиши-складњу (или . предикати)
+	(ако (нил? предикати) #л
+		(ако (нил? (сдр предикати))
+			(сар предикати)
+			(листа 'ако (није (сар предикати))
+				(примени или (сдр предикати))
+				(сар предикати)))))
+
+#|(опиши-складњу (услов . клаузе)
+	(|#