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

2019-02-10 22:21:20 +01:00 · 2019-02-10 22:21:20 +01:00 · 75b9ad436e
parent d86e1ba7c0
commit 75b9ad436e
9 changed files with 319 additions and 57 deletions
--- a/22
+++ b/22
@ -16,7 +16,8 @@ LDFLAGS = -lm -lc
 CC = cc

 C_SRC = cirilisp.c read.c eval.c print.c util.c internals.c
-TCH_SRC = инит.ћ
+L_SRC = инит.ћ
+INC = util.h read.h eval.h print.h internals.h
 OBJ = $(C_SRC:.c=.o)

 all: cirilisp
@ -24,17 +25,26 @@ all: cirilisp
 .c.o:
 	$(CC) -c $(CPPFLAGS) $(CFLAGS) $<

-$(OBJ): util.h read.h eval.h print.h internals.h $(TCH_SRC)
+$(OBJ): $(INC) $(L_SRC)

-cirilisp: $(OBJ) $(TCH_SRC)
+cirilisp: $(OBJ) $(L_SRC)
 	$(CC) -o $@ $(OBJ) $(LDFLAGS)

 clean:
 	-rm -f cirilisp $(OBJ) cirilisp-$(VERSION).tar.gz

+# штампа садржај свих фајлова са изворним кодом, користи се за бројање линија,
+# значајних линија, итд.
+concat:
+	@cat $(C_SRC) $(INC) $(L_SRC) Makefile
+
+# филтрира дати улаз и штампа само "значајне" линије кода
+sloc:
+	@grep -v "^[[:space:]]*[{}]\{0,1\}[;\\]\{0,1\}$$"
+
 dist: clean
 	mkdir -p cirilisp-$(VERSION)
-	cp -r Makefile util.h read.h eval.h print.h $(C_SRC) cirilisp-$(VERSION)
+	cp -r Makefile $(INC) $(C_SRC) $(L_SRC) cirilisp-$(VERSION)
 	tar -cf cirilisp-$(VERSION).tar cirilisp-$(VERSION)
 	gzip cirilisp-$(VERSION).tar
 	rm -rf cirilisp-$(VERSION)
@ -44,7 +54,7 @@ install: all
 	mkdir -p $(DESTDIR)$(LIBPREFIX)/cirilisp
 	cp -f cirilisp $(DESTDIR)$(PREFIX)/bin
 	chmod 755 $(DESTDIR)$(PREFIX)/bin/cirilisp
-	cp -f $(TCH_SRC) $(DESTDIR)$(LIBPREFIX)/cirilisp
+	cp -f $(L_SRC) $(DESTDIR)$(LIBPREFIX)/cirilisp
 #	mkdir -p $(DESTDIR)$(MANPREFIX)/man1
 #	sed "s/VERSION/$(VERSION)/g" < cirilisp.1 > $(DESTDIR)$(MANPREFIX)/man1/dwm.1
 #	chmod 644 $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1
@ -54,4 +64,4 @@ uninstall:
 	rm -rf $(DESTDIR)$(LIBPREFIX)/cirilisp
 #	rm -f $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1

-.PHONY: all clean dist install uninstall
+.PHONY: all clean dist install uninstall concat sloc
--- a/cirilisp.c
+++ b/cirilisp.c
@ -15,8 +15,9 @@ int load(char *pathname)
 	{
 		return 0;
 	}
-	while (TYPE(eval(read("", stream), globalEnv)) != EOFObject)
-		;
+	object exp;
+	while (TYPE(exp = eval(read("", stream), globalEnv)) != EOFObject)
+		deleteObject(exp);
 	eofStatus = 0;
 	fclose(stream);
 	return 1;
@ -45,7 +46,20 @@ void init()
 	addSymbolInternal("ламбда", &lambdaInt, 1);
 	addSymbolInternal("<", &lessInt, 0);
 	addSymbolInternal(">", &greaterInt, 0);
+	addSymbolInternal("=", &eqNumInt, 0);
 	addSymbolInternal("ако", &ifInt, 1);
+	addSymbolInternal("нил?", &nilQInt, 0);
+	addSymbolInternal("конс?", &consQInt, 0);
+	addSymbolInternal("број?", &numberQInt, 0);
+	addSymbolInternal("симбол?", &symbolQInt, 0);
+	addSymbolInternal("процедура?", &procedureQInt, 0);
+	addSymbolInternal("булски?", &boolQInt, 0);
+	addSymbolInternal("ниска?", &stringQInt, 0);
+	addSymbolInternal("карактер?", &charQInt, 0);
+	addSymbolInternal("листа?", &listQInt, 0);
+	addSymbolInternal("листа", &listInt, 0);
+	addSymbolInternal("конс", &consInt, 0);
+	addSymbolInternal("јед?", &eqvQInt, 0);

 	if (!load("/usr/local/lib/cirilisp/инит.ћ"))
 	{
@ -58,7 +72,8 @@ void init()
 int main(int argc, char **argv)
 {
 	init();
-	while (print(eval(read("ШКЉ> ", stdin), globalEnv)));
+	while (print(eval(read("ШКЉ> ", stdin), globalEnv)))
+		;
 	printf("\nДостигнут крај улазног тока.\nЗбогом и дођите нам опет!\n");

 	return 0;
--- a/eval.c
+++ b/eval.c
@ -23,12 +23,20 @@ object eval(object input, env currentEnv)
 	{
 		if (!properList(input))
 		{
+			deleteObject(input);
 			SIGERR(improperListError);
 		}
 		else
 		{
 			int regularEvalOrder = 1;
 			CAR(input) = eval(CAR(input), currentEnv);
+			if (TYPE(CAR(input)) == errorObject)
+			{
+				result = copyObject(CAR(input));
+				deleteObject(input);
+				SIGERR(ERR(result));
+			}
+
 			if (TYPE(CAR(input)) == procedureObject && 
 				PROC_TYPE(CAR(input)) == builtinProc &&
 				PROC_SPECIAL(CAR(input)))
@ -76,6 +84,56 @@ object eval(object input, env currentEnv)
 	return result;
 }

+int bindArgs(object parameters, object args, env newEnv)
+/* на почетку извршавања функције, везује прослеђене параметре, за симболе у
+ * дефиницији функције, везивање се врши у новонасталом окружењу, уколико је
+ * параметри нису правилни за дате аргументе, враћа 0, уколико нема грешке
+ * враћа 1 */
+{
+	if (properList(args))
+	/* уколико је листа аргумената правилна, број аргумената је одређен */
+	{
+		if (listLength(parameters) != listLength(args))
+		{
+			return 0;
+		}
+		else
+		{
+			object *currentArg = &args;
+			object *currentParam = &parameters;
+			while (TYPE(*currentArg) != nilObject)
+			{
+				addSymbolVariable(SYM(CAR(*currentArg)),
+					CAR(*currentParam), newEnv);
+				currentArg = &CDR(*currentArg);
+				currentParam = &CDR(*currentParam);
+			}
+			return 1;
+		}
+	}
+	else
+	/* у супротном, број аргумената је само ограничен одоздо */
+	{
+		if (improperListLength(args) - 1 > listLength(parameters))
+		{
+			return 0;
+		}
+		else
+		{
+			object *currentArg = &args;
+			object *currentParam = &parameters;
+			while (TYPE(*currentArg) == consObject)
+			{
+				addSymbolVariable(SYM(CAR(*currentArg)),
+					CAR(*currentParam), newEnv);
+				currentArg = &CDR(*currentArg);
+				currentParam = &CDR(*currentParam);
+			}
+			return 1;
+		}
+	}
+}
+
 object apply(object procedure, object parameters, env currentEnv)
 {
 	object result;
@ -108,21 +166,16 @@ object apply(object procedure, object parameters, env currentEnv)
 	object args = copyObject(PROC_COMP_ARGS(procedure));
 	object body = copyObject(PROC_COMP_BODY(procedure));
 	env definitionEnv = PROC_COMP_ENV(procedure);
-	if (listLength(parameters) != listLength(args))
+
+	env procEnv = createEnvironment(definitionEnv);
+	if (!bindArgs(parameters, args, procEnv))
 	{
+		deleteObject(args);
+		deleteObject(body);
+		removeEnvironment(procEnv);
 		SIGERR(argumentNumberError);
 	}

-	env procEnv = createEnvironment(definitionEnv);
-	object *currentArg = &args;
-	object *currentParam = &parameters;
-	while (TYPE(*currentArg) != nilObject)
-	{
-		addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam),
-			procEnv);
-		currentArg = &CDR(*currentArg);
-		currentParam = &CDR(*currentParam);
-	}
 	object *currentSubProc = &body;
 	while (TYPE(*currentSubProc) != nilObject)
 	{
--- a/internals.c
+++ b/internals.c
@ -1,9 +1,12 @@
 #include <string.h>
+#include <stdlib.h>

 #include "util.h"
 #include "eval.h"

 int allNums(object list)
+/* проверава да ли је објекат листа чији је сваки члан број, претпоставља да је
+ * објекат валидна листа */
 {
 	object *currentCell = &list;
 	while (TYPE(*currentCell) != nilObject)
@ -18,9 +21,11 @@ int allNums(object list)
 }

 int allSyms(object list)
+/* проверава да ли је дати објекат симбол, или листа (правилна или крња), чији
+ * је сваки члан симбол */
 {
 	object *currentCell = &list;
-	while (TYPE(*currentCell) != nilObject)
+	while (TYPE(*currentCell) == consObject)
 	{
 		if (TYPE(CAR(*currentCell)) != symbolObject)
 		{
@ -28,11 +33,16 @@ int allSyms(object list)
 		}
 		currentCell = &CDR(*currentCell);
 	}
-	return 1;
+	switch (TYPE(*currentCell))
+	{
+	case symbolObject:
+	case nilObject:
+		return 1;
+	default:
+		return 0;
+	}
 }

-
-
 object addInt(object parameters)
 {
 	object result;
@ -200,7 +210,7 @@ object quoteInt(object parameters)

 int validArgumentList(object list)
 {
-	if (!properList(list) || !allSyms(list))
+	if (!allSyms(list))
 	{
 		return 0;
 	}
@ -208,10 +218,10 @@ int validArgumentList(object list)
 	{
 		int allUniqueSyms = 1;
 		object *currentSymbol1 = &list;
-		while (TYPE(*currentSymbol1) != nilObject)
+		while (TYPE(*currentSymbol1) == consObject)
 		{
 			object *currentSymbol2 = &CDR(*currentSymbol1);
-			while (TYPE(*currentSymbol2) != nilObject)
+			while (TYPE(*currentSymbol2) == consObject)
 			{
 				if (!strcmp(SYM(CAR(*currentSymbol1)),
 					SYM(CAR(*currentSymbol2))))
@ -221,6 +231,13 @@ int validArgumentList(object list)
 				}
 				currentSymbol2 = &CDR(*currentSymbol2);
 			}
+			if (TYPE(*currentSymbol2) == symbolObject &&
+				!strcmp(SYM(*currentSymbol2),
+				SYM(CAR(*currentSymbol1))))
+			{
+				allUniqueSyms = 0;
+				goto breakloop;
+			}
 			currentSymbol1 = &CDR(*currentSymbol1);
 		}
 breakloop:
@ -311,7 +328,10 @@ object defineInt(object parameters, env currentEnv)
 	return result;
 }

-object lessInt(object parameters)
+object cmpMultiple(object parameters, int flag)
+/* проверава помоћу cmp функције у util.h хедеру, да ли је дата листа, листа
+ * строго опадајућих, једнаких, или строго растућих бројева, у зависности од
+ * тога да ли је "flag" 1, 0 или -1 респективно */
 {
 	if (!allNums(parameters))
 	{
@ -327,7 +347,7 @@ object lessInt(object parameters)
 	object *current = &parameters;
 	while (TYPE(CDR(*current)) != nilObject)
 	{
-		if (cmp(CAR(*current), CAR(CDR(*current))) >= 0)
+		if (cmp(CAR(*current), CAR(CDR(*current))) != flag)
 		{
 			resultInt = 0;
 			break;
@ -341,34 +361,19 @@ object lessInt(object parameters)
 	return result;
 }

+object lessInt(object parameters)
+{
+	return cmpMultiple(parameters, -1);
+}
+
+object eqNumInt(object parameters)
+{
+	return cmpMultiple(parameters, 0);
+}
+
 object greaterInt(object parameters)
 {
-	if (!allNums(parameters))
-	{
-		SIGERR(typeError);
-	}
-
-	if (listLength(parameters) == 0 || listLength(parameters) == 1)
-	{
-		return intToBool(1);
-	}
-
-	int resultInt = 1;
-	object *current = &parameters;
-	while (TYPE(CDR(*current)) != nilObject)
-	{
-		if (cmp(CAR(*current), CAR(CDR(*current))) <= 0)
-		{
-			resultInt = 0;
-			break;
-		}
-		current = &CDR(*current);
-	}
-
-	object result;
-	TYPE(result) = boolObject;
-	BOOL(result) = resultInt;
-	return result;
+	return cmpMultiple(parameters, 1);
 }

 object ifInt(object parameters, env currentEnv)
@ -385,7 +390,7 @@ object ifInt(object parameters, env currentEnv)

 		if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
 		{
-			TYPE(result) = unspecifiedObject;
+			TYPE(result) = nilObject;
 		}
 		else
 		{
@ -427,3 +432,151 @@ object ifInt(object parameters, env currentEnv)

 	return result;
 }
+
+object checkType(object parameters, dataType type)
+{
+	if (listLength(parameters) != 1)
+	{
+		SIGERR(argumentNumberError);
+	}
+	object result;
+	TYPE(result) = boolObject;
+	BOOL(result) = (type == TYPE(CAR(parameters)));
+	return result;
+}
+
+object nilQInt(object parameters)
+{
+	return checkType(parameters, nilObject);
+}
+
+object consQInt(object parameters)
+{
+	return checkType(parameters, consObject);
+}
+
+object numberQInt(object parameters)
+{
+	return checkType(parameters, numberObject);
+}
+
+object symbolQInt(object parameters)
+{
+	return checkType(parameters, symbolObject);
+}
+
+object procedureQInt(object parameters)
+{
+	return checkType(parameters, procedureObject);
+}
+
+object boolQInt(object parameters)
+{
+	return checkType(parameters, boolObject);
+}
+
+object stringQInt(object parameters)
+{
+	return checkType(parameters, stringObject);
+}
+
+object charQInt(object parameters)
+{
+	return checkType(parameters, charObject);
+}
+
+object listQInt(object parameters)
+{
+	if (listLength(parameters) != 1)
+	{
+		SIGERR(argumentNumberError);
+	}
+	object result;
+	TYPE(result) = boolObject;
+	BOOL(result) = properList(CAR(parameters));
+	return result;
+}
+
+object listInt(object parameters)
+{
+	object result;
+	result = copyObject(parameters);
+	return result;
+}
+
+object consInt(object parameters)
+{
+	if (listLength(parameters) != 2)
+	{
+		SIGERR(argumentNumberError);
+	}
+	object result;
+	TYPE(result) = consObject;
+	CONS(result) = malloc(sizeof(cons));
+	CAR(result) = copyObject(CAR(parameters));
+	CDR(result) = copyObject(CAR(CDR(parameters)));
+	return result;
+}
+
+object eqvQInt(object parameters)
+{
+	if (listLength(parameters) != 2)
+	{
+		SIGERR(argumentNumberError);
+	}
+	object result;
+	TYPE(result) = boolObject;
+	BOOL(result) = 0;
+	if (TYPE(CAR(parameters)) != TYPE(CAR(CDR(parameters))))
+	{
+		BOOL(result) = 0;
+	}
+	else
+	{
+		switch (TYPE(CAR(parameters)))
+		{
+		case numberObject:
+			if (NUM_TYPE(CAR(parameters)) !=
+				NUM_TYPE(CAR(CDR(parameters))))
+			{
+				BOOL(result) = 0;
+			}
+			switch (NUM_TYPE(CAR(parameters)))
+			{
+			case fractionNum:
+				BOOL(result) = NUM_NUMER(CAR(parameters)) ==
+					NUM_NUMER(CAR(CDR(parameters))) &&
+					NUM_DENOM(CAR(parameters)) ==
+					NUM_DENOM(CAR(CDR(parameters)));
+				break;
+			case realNum:
+				BOOL(result) = NUM_REAL(CAR(parameters)) ==
+					NUM_REAL(CAR(CDR(parameters)));
+				break;
+			}
+			break;
+		case symbolObject:
+			BOOL(result) = !strcmp(SYM(CAR(parameters)),
+				SYM(CAR(CDR(parameters))));
+			break;
+		case boolObject:
+			BOOL(result) = !BOOL(CAR(parameters)) ==
+				!BOOL(CAR(CDR(parameters)));
+			break;
+		case stringObject:
+			BOOL(result) = !strcmp(STR(CAR(parameters)),
+				STR(CAR(CDR(parameters))));
+			break;
+		case charObject:
+			BOOL(result) = CHAR(CAR(parameters)) ==
+				CHAR(CAR(CDR(parameters)));
+			break;
+		case consObject:
+		case procedureObject:
+		default:
+			BOOL(result) = 0;
+			break;
+		}
+	}
+	return result;
+}
--- a/internals.h
+++ b/internals.h
@ -12,4 +12,17 @@ object lambdaInt(object parameters);
 object defineInt(object parameters);
 object lessInt(object parameters);
 object greaterInt(object parameters);
+object eqNumInt(object parameters);
 object ifInt(object parameters);
+object nilQInt(object parameters);
+object consQInt(object parameters);
+object numberQInt(object parameters);
+object symbolQInt(object parameters);
+object procedureQInt(object parameters);
+object boolQInt(object parameters);
+object stringQInt(object parameters);
+object charQInt(object parameters);
+object listQInt(object parameters);
+object listInt(object parameters);
+object consInt(object parameters);
+object eqvQInt(object parameters);
--- a/print.c
+++ b/print.c
@ -36,6 +36,7 @@ int print(object input)
 		printValue(input);
 		printf("\n\n");
 	}
+	deleteObject(input);
 	return 1;
 }

--- a/util.c
+++ b/util.c
@ -146,6 +146,18 @@ int listLength(object list)
 	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)
--- a/util.h
+++ b/util.h
@ -179,6 +179,10 @@ object referVariable(char *symbol, env currentEnv);

 int properList(object list);
 int listLength(object list);
+int improperListLength(object list);
+/* уколико објекат није конс, враћа 1, уколико јесте, враћа дужину крње листе
+ * укључујући задњи члан, уколико је дата правилна листа, нил се и даље рачуна
+ * као члан */
 void deleteObject(object input);
 object copyObject(object input);

--- a/инит.ћ
+++ b/инит.ћ
@ -1 +1,2 @@
-(дефиниши (= а б) (ако (> а б) #л (ако (< а б) #л #и)))
+(дефиниши (не предикат)
+	(ако предикат #л #и))