ЋИРИЛИСП-0,8: имплементирана контрола тока и основни предикати поређивања

Makefile

@@ -1,14 +1,15 @@
 # cirilisp - компајлер за ћирилични дијалекат лиспа
 
 # ћирилисп верзија
-VERSION = 0.7
+VERSION = 0,8
 
 # локација за инсталацију
 PREFIX = /usr/local
 
 # флегови за C компајлер и линкер
-# CFLAGS = -g -std=c99 -pedantic -Wall -O0
-CFLAGS  = -std=c99 -pedantic -Wall -O3
+CPPFLAGS = -D_POSIX_C_SOURCE=200200L
+CFLAGS = -g -std=c99 -pedantic -Wall -O0
+# CFLAGS  = -std=c99 -pedantic -Wall -O3
 LDFLAGS = -lm -lc
 
 CC = cc

eval.c

@@ -88,7 +88,7 @@ object apply(object procedure, object parameters, env currentEnv)
 	if (PROC_TYPE(procedure) == builtinProc)
 	{
 		object(*f)() = PROC_BUILTIN(procedure);
-		if (f == define || f == lambda)
+		if (f == define || f == lambda || f == ifStatement)
 		{
 			result = f(parameters, currentEnv);
 		}

init.c

@@ -25,4 +25,7 @@ void init()
 	addSymbolInternal("тачно->нетачно", &exactToInexact);
 	addSymbolInternal("нетачно->тачно", &inexactToExact);
 	addSymbolInternal("ламбда", &lambda);
+	addSymbolInternal("<", &less);
+	addSymbolInternal(">", &greater);
+	addSymbolInternal("ако", &ifStatement);
 }

internals.c

@@ -32,10 +32,6 @@ int allSyms(object list)
 }
 
 
-/*
-object ifStatement(object parameters)
-{
-*/
 
 object add(object parameters)
 {
@@ -328,3 +324,102 @@ object define(object parameters, env currentEnv)
 
 	return result;
 }
+
+object less(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;
+}
+
+object greater(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;
+}
+
+object ifStatement(object parameters, env currentEnv)
+{
+	object predicate, result;
+	switch (listLength(parameters))
+	{
+	case 2:
+		predicate = eval(CAR(parameters), currentEnv);
+
+		if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
+		{
+			TYPE(result) = unspecifiedObject;
+		}
+		else
+		{
+			result = eval(copyObject(CAR(CDR(parameters))),
+				currentEnv);
+		}
+		break;
+	case 3:
+		predicate = eval(CAR(parameters), currentEnv);
+
+		if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
+		{
+			result = eval(copyObject(CAR(CDR(CDR(parameters)))),
+				currentEnv);
+		}
+		else
+		{
+			result = eval(copyObject(CAR(CDR(parameters))),
+				currentEnv);
+		}
+		break;
+	default:
+		SIGERR(argumentNumberError);
+	}
+
+	return result;
+}

internals.h

@@ -8,5 +8,8 @@ object divide(object parameters);
 object exactToInexact(object parameters);
 object inexactToExact(object parameters);
 object quote(object parameters);
-object define(object parameters);
 object lambda(object parameters);
+object define(object parameters);
+object less(object parameters);
+object greater(object parameters);
+object ifStatement(object parameters);

read.c

@@ -4,6 +4,7 @@
 #include <wctype.h>
 #include <ctype.h>
 #include <string.h>
+#include <regex.h>
 
 #include "util.h"
 #include "read.h"
@@ -234,7 +235,15 @@ object getToken()
 	char *s = malloc(n * sizeof(char));
 	wcstombs(s, buffer, n);
 
-	if (isFracNumToken(s))
+	regex_t regNumberFrac, regNumberReal;
+	regcomp(&regNumberFrac, "^[-+]?[[:digit:]]+(/[[:digit:]]+)?$",
+						REG_EXTENDED);
+	regcomp(&regNumberReal, "^[-+]?[[:digit:]]*,[[:digit:]]+$",
+						REG_EXTENDED);
+	const int nmatches = 1;
+	regmatch_t a[nmatches];
+
+	if (!regexec(&regNumberFrac, s, nmatches, a, 0))
 	{
 		TYPE(result) = numberObject;
 		NUM_TYPE(result) = fractionNum;
@@ -244,7 +253,7 @@ object getToken()
 			1 : atoll(tmp + 1);
 		result = shortenFractionNum(result);
 	}
-	else if (isRealNumToken(s))
+	else if (!regexec(&regNumberReal, s, nmatches, a, 0))
 	{
 		TYPE(result) = numberObject;
 		NUM_TYPE(result) = realNum;
@@ -256,6 +265,8 @@ object getToken()
 		SYM(result) = malloc((strlen(s) + 1) * sizeof(char));
 		strcpy(SYM(result), s);
 	}
+	regfree(&regNumberFrac);
+	regfree(&regNumberReal);
 
 	return result;
 }

util.c

@@ -123,7 +123,7 @@ object referVariable(char *symbol,env currentEnv)
 	}
 }
 
-#define SPECIALFORMSNUM 3
+#define SPECIALFORMSNUM 4
 int isSpecialForm(char *symbol)
 {
 	int result = 0;
@@ -131,7 +131,8 @@ int isSpecialForm(char *symbol)
 	{
 		"навод",
 		"дефиниши",
-		"ламбда"
+		"ламбда",
+		"ако"
 	};
 
 	for (int i = 0; i < SPECIALFORMSNUM; ++i)
@@ -352,6 +353,11 @@ object shortenFractionNum(object a)
 				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);
+			}
 		}
 	}
 
@@ -453,6 +459,57 @@ object inverseNum(object a)
 	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;
+		}
+	}
+}
+
+object intToBool(int boolean)
+{
+	object result;
+	TYPE(result) = boolObject;
+	BOOL(result) = boolean == 0 ? 0 : 1;
+	return result;
+}
+
 procedure *createProcedure()
 {
 	return malloc(sizeof(procedure));

util.h

@@ -185,5 +185,10 @@ object plusNum(object a, object b);
 object minusNum(object a);
 object timesNum(object a, object b);
 object inverseNum(object a);
+int cmp(object a, object b);
+/* пореди два броја и враћа -1, 0, 1 у зависности од односа истих, претпоставља
+ * да су објекти бројеви */
+
+object intToBool(int boolean);
 
 procedure *createProcedure();