Add basic code for parser/evaluator. Can do simple stranding

8 files changed, 228 insertions, 15 deletions

diff --git a/apl9.h b/apl9.h
index 6b5445c..e487b63 100644
--- a/apl9.h
+++ b/apl9.h
@@ -20,7 +20,8 @@ typedef enum
 
 typedef enum
 {
-	AtypeInt
+	AtypeInt,
+	AtypeArray
 } arrayDataType;
 
 /* Data types */
@@ -32,18 +33,20 @@ struct Array
 	arrayDataType type;
 	int rank;
 	int *shape;
+	int size;
 	union {
 		char *rawdata;
 		vlong *intdata;
+		Array **arraydata;
 	};
 };
 
 struct Datum
 {
 	datumTag tag;
-	Rune *strrep;
 	union {
 		Array *array;
+		int code;
 	};
 };
 
@@ -51,15 +54,33 @@ struct Datum
 /* print.c */
 Rune *ppdatum(Datum);
 Rune *ppdatums(Datum *, int);
+Rune *pparray(Array *);
 
 /* lexer.c */
 Datum *lexline(Rune *, int *);
 
 /* array.c */
+Array *mkarray(int, int, int);
 Array *mkscalarint(vlong);
+Array *duparray(Array *);
+int simplearray(Array *);
+int simplescalar(Array *);
 
 /* eval.c */
 Datum *eval(Datum *, int *);
 
+/* Monadic functions from functions.h */
+Array *fnEnclose(Array *);
+Array *fnNest(Array *);
+Array *fnRavel(Array *);
+
+/* Dyadic functions from functions.h */
+Array *fnCatenateFirst(Array *, Array *);
+
 /* Global variables */
-Rune *errormsg; /* eval.c */
\ No newline at end of file
+extern Rune *errormsg; /* eval.c */
+extern int datasizes[]; /* array.c */
+extern Rune primfuncnames[]; /* lexer.c */
+extern Rune primmonopnames[]; /* lexer.c */
+extern Rune primdyadopnames[]; /* lexer.c */
+extern Rune primhybridnames[]; /* lexer.c */
\ No newline at end of file
diff --git a/array.c b/array.c
index 766ccd8..4f904e1 100644
--- a/array.c
+++ b/array.c
@@ -5,7 +5,8 @@
 #include "apl9.h"
 
 int datasizes[] = {
-	[AtypeInt] = sizeof(vlong)
+	[AtypeInt] = sizeof(vlong),
+	[AtypeArray] = sizeof(Array *)
 };
 
 Array *
@@ -13,6 +14,8 @@ mkarray(arrayDataType t, int rank, int size)
 {
 	Array *a = malloc(sizeof(Array));
 	a->rank = rank;
+	a->type = t;
+	a->size = size;
 	a->shape = malloc(sizeof(int) * rank);
 	a->rawdata = malloc(datasizes[t] * size);
 	a->type = t;
@@ -26,4 +29,26 @@ mkscalarint(vlong i)
 	a->intdata[0] = i;
 
 	return a;
-}
\ No newline at end of file
+}
+
+Array *
+duparray(Array *a)
+{
+	Array *b = mkarray(a->type, a->rank, a->size);
+	memcpy(b->shape, a->shape, sizeof(int) * a->rank);
+	memcpy(b->rawdata, a->rawdata, datasizes[a->type]*a->size);
+	/* TODO duplicate recursivley */
+	return b;
+}
+
+int
+simplearray(Array *a)
+{
+	return a->type != AtypeArray;
+}
+
+int
+simplescalar(Array *a)
+{
+	return simplearray(a) && a->rank == 0;
+}
diff --git a/eval.c b/eval.c
index baabf21..9c737ff 100644
--- a/eval.c
+++ b/eval.c
@@ -6,10 +6,88 @@
 
 Rune *errormsg;
 
+typedef Datum (*evalfn)(Datum, Datum);
+
+Datum strand(Datum, Datum);
+
+int bindingstrengths[12][12] = {
+/*	A  F  H  MO DO AF (  )  {  }  [  ] */
+	1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* FA */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ( */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* { */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* } */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
+};
+
+evalfn evalfns[12][12] = {
+/*	A  F  H  MO DO AF (  )  {  }  [  ] */
+	strand, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* F */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* H */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* MO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* DO */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* FA */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ( */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ) */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* { */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* } */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* [ */
+	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* ] */
+};
+
+
 Datum *
 eval(Datum *tokens, int *ntoks)
 {
-	*ntoks = 0;
-	errormsg = L"Evaluator not written yet";
+	while(*ntoks > 1){
+		int maxlevel = 0;
+		int offset;
+		evalfn fn = nil;
+		print("CURRENT: %S\n", ppdatums(tokens, *ntoks));
+		for(offset = (*ntoks)-1; offset >= 0; offset--){
+			int level;
+			if(offset == 0)
+				level = 0;
+			else{
+				Datum left = tokens[offset-1];
+				Datum right = tokens[offset];
+				level = bindingstrengths[left.tag][right.tag];
+			}
+			if(level < maxlevel){
+				Datum left = tokens[offset];
+				Datum right = tokens[offset+1];
+				fn = evalfns[left.tag][right.tag];
+				print("Reducing %S and %S\n", ppdatum(left), ppdatum(right));
+				break;
+			}else if(level > maxlevel)
+				maxlevel = level;
+		}
+		if(maxlevel == 0){
+			errormsg = L"No reduce rule. Syntax error.";
+			*ntoks = 0;
+		}else{
+			tokens[offset] = fn(tokens[offset],tokens[offset+1]);
+			for(int i = offset+1; i < (*ntoks)-1; i++)
+				tokens[i] = tokens[i+1];
+			(*ntoks)--;
+		}
+	}
 	return tokens;
+}
+
+Datum
+strand(Datum left, Datum right)
+{
+	print("Stranding\n");
+	Datum result;
+	result.tag = ArrayTag;
+	result.array = fnCatenateFirst(left.array,fnEnclose(right.array));
+	return result;
 }
\ No newline at end of file
diff --git a/functions.c b/functions.c
new file mode 100644
index 0000000..6ff653a
--- /dev/null
+++ b/functions.c
@@ -0,0 +1,54 @@
+#include <u.h>
+#include <libc.h>
+#include <bio.h>
+
+#include "apl9.h"
+
+Array *
+fnCatenateFirst(Array *left, Array *right)
+{
+	/* not even close to being right, but it works for stranding :) */
+	if(left->rank == 0)
+		left = fnRavel(left);
+	if(right->rank == 0)
+		right = fnRavel(right);
+	
+	print("Catenating: %S and %S\n", pparray(left), pparray(right));
+	/* assume two vectors of same type for now */
+	Array *res = mkarray(left->type, 1, left->size+right->size);
+	res->shape[0] = left->shape[0] + right->shape[0];
+	memcpy(res->rawdata, left->rawdata, datasizes[res->type]*left->size);
+	memcpy(res->rawdata+datasizes[res->type]*left->size, right->rawdata, datasizes[res->type]*right->size);
+	return res;
+}
+
+Array *
+fnNest(Array *right)
+{
+	if(simplearray(right))
+		return fnEnclose(right);
+	else
+		return right;
+}
+
+Array *
+fnEnclose(Array *right)
+{
+	if(simplescalar(right))
+		return right;
+	else{
+		Array *res = mkarray(AtypeArray, 0, 1);
+		res->arraydata[0] = right;
+		return res;
+	}
+}
+
+Array *
+fnRavel(Array *right)
+{
+	Array *res = duparray(right);
+	res->rank = 1;
+	res->shape = realloc(res->shape, sizeof(int) * 1);
+	res->shape[0] = res->size;
+	return res;
+}
\ No newline at end of file
diff --git a/lexer.c b/lexer.c
index 68e925b..21a5da8 100644
--- a/lexer.c
+++ b/lexer.c
@@ -29,19 +29,15 @@ lexline(Rune *line, int *ntoks)
 			case '[': tokens[*ntoks].tag = LBracketTag; break;
 			case ']': tokens[*ntoks].tag = RBracketTag; break;
 			}
-			tokens[*ntoks].strrep = runesmprint("%C", line[offset]);
 			offset++;
 		}else if(runestrchr(primfuncnames, line[offset])){
 			tokens[*ntoks].tag = FunctionTag;
-			tokens[*ntoks].strrep = runesmprint("%C", line[offset]);
 			offset++;
 		}else if(runestrchr(primmonopnames, line[offset])){
 			tokens[*ntoks].tag = MonadicOpTag;
-			tokens[*ntoks].strrep = runesmprint("%C", line[offset]);
 			offset++;
 		}else if(runestrchr(primdyadopnames, line[offset])){
 			tokens[*ntoks].tag = DyadicOpTag;
-			tokens[*ntoks].strrep = runesmprint("%C", line[offset]);
 			offset++;
 		}else if(isdigitrune(line[offset])){
 			char buf[64];
@@ -53,7 +49,6 @@ lexline(Rune *line, int *ntoks)
 			*p = 0;
 			tokens[*ntoks].tag = ArrayTag;
 			tokens[*ntoks].array = mkscalarint(atoll(buf));
-			tokens[*ntoks].strrep = runesmprint("%s", buf);
 		}else{
 			print("Can't lex: %S\n", &line[offset]);
 			*ntoks = 0;
diff --git a/main.c b/main.c
index 04264b1..b2867c9 100644
--- a/main.c
+++ b/main.c
@@ -24,7 +24,7 @@ main(void)
 			else
 				print("ERROR: %S\n", errormsg);
 		}else{
-			ppdatum(*result);
+			print("%S\n", ppdatum(*result));
 			free(result);
 		}
 	}
@@ -51,7 +51,6 @@ evalline(Rune *line)
 {
 	int ntoks;
 	Datum *tokens = lexline(line, &ntoks);
-	print("Evaluating line (n=%d): %S\n", ntoks, ppdatums(tokens, ntoks));
 	Datum *result = eval(tokens, &ntoks);
 	if(ntoks == 1)
 		return result;
diff --git a/mkfile b/mkfile
index 266453c..ce8f6ec 100644
--- a/mkfile
+++ b/mkfile
@@ -7,6 +7,7 @@ OFILES=\
 	eval.$O\
 	print.$O\
 	array.$O\
+	functions.$O\
 
 HFILES=\
 	apl9.h\
diff --git a/print.c b/print.c
index c457647..7935413 100644
--- a/print.c
+++ b/print.c
@@ -7,7 +7,22 @@
 Rune *
 ppdatum(Datum d)
 {
-	return runestrdup(d.strrep);
+	Rune *result;
+	switch(d.tag){
+	case ArrayTag: result = pparray(d.array); break;
+	case FunctionTag: result = runesmprint("%C", primfuncnames[d.code]); break;
+	case HybridTag: result = runesmprint("%C", primhybridnames[d.code]); break;
+	case MonadicOpTag: result = runesmprint("%C", primmonopnames[d.code]); break;
+	case DyadicOpTag: result = runesmprint("%C", primdyadopnames[d.code]); break;
+	case LParTag: result = runestrdup(L"("); break;
+	case RParTag: result = runestrdup(L")"); break;
+	case LCurlTag: result = runestrdup(L"{"); break;
+	case RCurlTag: result = runestrdup(L"}"); break;
+	case LBracketTag: result = runestrdup(L"["); break;
+	case RBracketTag: result = runestrdup(L"]"); break;
+	default: result = runesmprint("<not printable %d>", d.tag);
+	}
+	return result;
 }
 
 Rune *
@@ -22,4 +37,29 @@ ppdatums(Datum *ds, int n)
 		free(tmp);
 	}
 	return res;
+}
+
+Rune *
+pparray(Array *a)
+{
+	/* can only print integer vectors and scalars for now, also nested */
+	if(a->type == AtypeArray){
+		Rune *res = runesmprint("[");
+		Rune *tmp;
+		for(int i = 0; i < a->size; i++){
+			tmp = res;
+			res = runesmprint("%S%S%s", res, pparray(a->arraydata[i]), (i+1<a->size)?" ":"]");
+			free(tmp);
+		}
+		return res;
+	}else{
+		Rune *res = runesmprint("");
+		Rune *tmp;
+		for(int i = 0; i < a->size; i++){
+			tmp = res;
+			res = runesmprint("%S%lld%s", res, a->intdata[i], (i+1<a->size)?" ":"");
+			free(tmp);
+		}
+		return res;
+	}
 }
\ No newline at end of file