[gatest] Write a simple parser for playing with GA

Currently only PGA(3) is supported, but that's because the parser is
rather simple (recursive descent with a lame lexer), but it works well
enough for playing with geometric algebra without having to recompile
every time.

ruamoko/gatest/algebra.r

@@ -36,7 +36,7 @@
 	for (int i = 0; i < d + 1; i++) {
 		int         c = counts[i];
 		int         ind = indices[i];
-		a.grades[i] = [BasisGroup new:c basis:blades + ind - c];
+		a.grades[i] = [[BasisGroup new:c basis:blades + ind - c] retain];
 	}
 
 	if (p == 3 && m == 0 && z == 1) {

ruamoko/gatest/main.r

@@ -1,4 +1,9 @@
 #include <AutoreleasePool.h>
+#include <hash.h>
+#include <qfile.h>
+#include <script.h>
+#include <string.h>
+
 #include "algebra.h"
 #include "basisblade.h"
 #include "basisgroup.h"
@@ -20,8 +25,8 @@ arp_end (void)
 	autorelease_pool = nil;
 }
 
-int
+static void
-main ()
+basic_test (void)
 {
 	arp_start ();
 
@@ -94,5 +99,327 @@ main ()
 	printf ("point:%@\n", point);
 
 	arp_end ();
+}
+
+typedef struct var_s {
+	string name;
+	MultiVector *value;
+} var_t;
+
+static hashtab_t *symtab;
+
+typedef enum {
+	EOF, SEMI,
+	VAR, EQUAL,
+	ID, VALUE,
+	OPENP, CLOSEP,
+	OPENB, CLOSEB,
+	OPENS, CLOSES,
+	MUL, DIV, PLUS, MINUS,
+	WEDGE, ANTIWEDGE, DOT,
+	REVERSE,
+} token_e;
+
+script_t script;
+string token_str;
+token_e lookahead = -1;
+
+typedef struct token_s {
+	token_e     id;
+	union {
+		MultiVector *value;
+		string      name;
+	};
+} token_t;
+
+static token_t
+get_token ()
+{
+	if (!Script_TokenAvailable (script, 1)) {
+		return {EOF, nil};
+	}
+	Script_GetToken (script, 1);
+	switch (token_str) {
+		case "var": return {VAR, nil};
+		case "=":   return {EQUAL, nil};
+		case ";":   return {SEMI, nil};
+		case "(":   return {OPENP, nil};
+		case ")":   return {CLOSEP, nil};
+		case "[":   return {OPENB, nil};
+		case "]":   return {CLOSEB, nil};
+		case "{":   return {OPENS, nil};
+		case "}":   return {CLOSES, nil};
+		case "*":   return {MUL, nil};
+		case "/":   return {DIV, nil};
+		case "+":   return {PLUS, nil};
+		case "-":   return {MINUS, nil};
+		case "^":   return {WEDGE, nil};
+		case "&":   return {ANTIWEDGE, nil};
+		case ".":   return {DOT, nil};
+		case "~":   return {REVERSE, nil};
+	}
+	return {ID, .name = token_str };
+}
+
+static void
+syntax_error ()
+{
+	obj_error (nil, 0, "syntax error: %d\n", Script_GetLine (script));
+}
+
+static int
+match (token_e token)
+{
+	if (lookahead == -1) {
+		lookahead = get_token ().id;
+	}
+	return token == lookahead;
+}
+
+static void
+advance ()
+{
+	lookahead = get_token ().id;
+}
+
+static Algebra *algebra;
+static MultiVector *minus_one;
+static MultiVector *expression ();
+
+static int
+is_digit (string x)
+{
+	return (x == "0" || x == "1" || x == "2" || x == "3" ||
+			x == "4" || x == "5" || x == "6" || x == "7" ||
+			x == "8" || x == "9");
+}
+
+static int
+is_number (string x)
+{
+	return x == "." || is_digit (x);
+}
+
+static MultiVector *
+factor ()
+{
+	MultiVector *vec;
+	if (match (REVERSE)) {
+		advance ();
+		vec = [expression () reverse];
+	} else if (match (MINUS)) {
+		advance ();
+		vec = [minus_one product:expression ()];
+	} else if (match (OPENP)) {
+		advance ();
+		vec = expression ();
+		if (!match (CLOSEP)) {
+			syntax_error ();
+		}
+		advance ();
+	} else if (match (ID)) {
+		if (is_digit (str_mid (token_str, 0, 1))) {
+			string num_str = nil;
+			string blade_str = nil;
+			int pos = 0;
+			while (is_number (str_mid (token_str, pos, pos + 1))) {
+				pos++;
+			}
+			num_str = str_mid (token_str, 0, pos);
+			if (str_mid (token_str, pos, pos + 1) == "e") {
+				blade_str = str_mid (token_str, ++pos);
+			}
+			BasisBlade *blade = [BasisBlade basis:0];
+			pos = 0;
+			while (is_digit (str_mid (blade_str, pos, pos + 1))) {
+				int x = str_char (blade_str, pos++) - '1';
+				BasisBlade *new = [BasisBlade basis:1 << x];
+				blade = [blade outerProduct:new];
+			}
+
+			double num = strtod (num_str, nil) * [blade scale];
+			vec = [algebra ofGrade:[blade grade]];
+			*[vec componentFor:blade] = num;
+		} else {
+			var_t      *var = Hash_Find (symtab, token_str);
+			if (!var) {
+				syntax_error ();
+			}
+			vec = var.value;
+		}
+		advance ();
+	} else {
+		syntax_error ();
+		vec = nil;
+	}
+	return vec;
+}
+
+static MultiVector *
+high_term ()
+{
+	MultiVector *vec = nil;
+	SEL op = nil;
+	while (1) {
+		if (vec) {
+			vec = [vec performSelector:op withObject: factor()];
+		} else {
+			vec = factor ();
+		}
+		if (match (WEDGE)) {
+			op = @selector(wedge:);
+			advance ();
+		} else if (match (DOT)) {
+			op = @selector(dot:);
+			advance ();
+		} else {
+			return vec;
+		}
+	}
+}
+
+static MultiVector *
+term ()
+{
+	MultiVector *vec = nil;
+	SEL op = nil;
+	while (1) {
+		if (vec) {
+			vec = [vec performSelector:op withObject: high_term()];
+		} else {
+			vec = high_term ();
+		}
+		if (match (REVERSE) || match (OPENP) || match (ID)) {
+			op = @selector(product:);
+//		} else if (match (DIV)) {
+//			advance ();
+		} else {
+			return vec;
+		}
+	}
+}
+
+static MultiVector *
+expression ()
+{
+	MultiVector *vec = nil;
+	SEL op = nil;
+	while (1) {
+		if (vec) {
+			vec = [vec performSelector:op withObject: term()];
+		} else {
+			vec = term ();
+		}
+		if (match (PLUS)) {
+			op = @selector(plus:);
+			advance ();
+		} else if (match (MINUS)) {
+			op = @selector(minus:);
+			advance ();
+		} else {
+			return vec;
+		}
+	}
+}
+
+static var_t *
+assignment ()
+{
+	if (!match (ID) || is_digit (str_mid (token_str, 0, 1))) {
+		printf ("%s\n", token_str);
+		syntax_error ();
+	}
+	var_t      *var = Hash_Find (symtab, token_str);
+	if (!var) {
+		syntax_error ();
+	}
+	advance ();
+	if (!match (EQUAL)) {
+		syntax_error ();
+	}
+	advance ();
+	var.value = [expression () retain];
+	return var;
+}
+
+static var_t *
+declaration ()
+{
+	if (!match (ID) || is_digit (str_mid (token_str, 0, 1))) {
+		syntax_error ();
+	}
+	if (Hash_Find (symtab, token_str)) {
+		syntax_error ();
+	}
+	var_t *var = obj_malloc (sizeof (var_t));
+	var.name = str_hold (str_unmutable (token_str));
+	Hash_Add (symtab, var);
+	assignment ();
+	return var;
+}
+
+static int
+parse_script (string name, QFile file)
+{
+	script = Script_New ();
+	Script_SetSingle (script, "()[]{}/+-^&.~=;");
+	token_str = Script_FromFile (script, name, file);
+
+	while (!match (EOF)) {
+		arp_end ();
+		arp_start ();
+		var_t *var;
+		if (match (VAR)) {
+			advance ();
+			var = declaration ();
+			printf ("var %s = %@\n", var.name, var.value);
+		} else {
+			var = assignment ();
+			printf ("%s = %@\n", var.name, var.value);
+		}
+		advance ();
+	}
+
+	Script_Delete (script);
+	return 1;
+}
+
+static string
+get_symtab_key (void *var, void *unused)
+{
+	return ((var_t *) var).name;
+}
+
+int
+main (int argc, string *argv)
+{
+	symtab = Hash_NewTable (127, get_symtab_key, nil, nil);
+	if (argc < 2) {
+		basic_test ();
+	} else {
+		arp_start ();
+		algebra = [[Algebra PGA:3] retain];
+		arp_end ();
+		arp_start ();
+		double m1 = -1;
+		minus_one = [[algebra ofGrade:0 values:&m1] retain];
+		arp_end ();
+		arp_start ();
+		for (int i = 1; i < argc; i++) {
+			QFile       file = Qopen (argv[i], "rt");
+			if (file) {
+				arp_end ();
+				arp_start ();
+				int         res = parse_script (argv[i], file);
+				Qclose (file);
+				if (!res) {
+					return 1;
+				}
+			} else {
+				printf ("%s: failed to open '%s'\n", argv[0], argv[i]);
+				return 1;
+			}
+		}
+	}
 	return 0;
 }

ruamoko/gatest/multivector.h

@@ -4,6 +4,7 @@
 
 @class Algebra;
 @class BasisLayout;
+@class BasisBlase;
 
 @interface MultiVector : Object
 {
@@ -19,9 +20,16 @@
 // NOTE: values must have the same layout as group
 +(MultiVector *) new:(Algebra *) algebra group:(BasisGroup *) group values:(double *) values;
 +(MultiVector *) copy:(MultiVector *) src;
+
+-(double *) components;
+-(int)indexFor:(unsigned)mask;
+-(double *) componentFor:(BasisBlade *) blade;
+
 -(MultiVector *) product:(MultiVector *) rhs;
 -(MultiVector *) wedge:(MultiVector *) rhs;
 -(MultiVector *) dot:(MultiVector *) rhs;
+-(MultiVector *) plus:(MultiVector *) rhs;
+-(MultiVector *) minus:(MultiVector *) rhs;
 -(MultiVector *) dual;
 -(MultiVector *) reverse;
 @end

ruamoko/gatest/multivector.r

@@ -89,6 +89,21 @@ static MultiVector *new_mv (Algebra *algebra, BasisLayout *layout)
 	return str;
 }
 
+-(double *) components
+{
+	return components;
+}
+
+-(int)indexFor:(unsigned)mask
+{
+	return [layout bladeIndex:mask];
+}
+
+-(double *) componentFor:(BasisBlade *) blade
+{
+	return &components[[layout bladeIndex:[blade mask]]];
+}
+
 -(MultiVector *) product:(MultiVector *) rhs
 {
 	MultiVector *prod = new_mv (algebra, nil);
@@ -179,6 +194,54 @@ static MultiVector *new_mv (Algebra *algebra, BasisLayout *layout)
 	return prod;
 }
 
+-(MultiVector *) plus:(MultiVector *) rhs
+{
+	MultiVector *plus = new_mv (algebra, nil);
+	for (int i = 0; i < num_components; i++) {
+		double c = components[i];
+		if (!c) {
+			continue;
+		}
+		BasisBlade *b = [layout bladeAt:i];
+		int ind = [plus.layout bladeIndex:[b mask]];
+		plus.components[ind] += c;
+	}
+	for (int i = 0; i < rhs.num_components; i++) {
+		double c = rhs.components[i];
+		if (!c) {
+			continue;
+		}
+		BasisBlade *b = [rhs.layout bladeAt:i];
+		int ind = [plus.layout bladeIndex:[b mask]];
+		plus.components[ind] += c;
+	}
+	return plus;
+}
+
+-(MultiVector *) minus:(MultiVector *) rhs
+{
+	MultiVector *minus = new_mv (algebra, nil);
+	for (int i = 0; i < num_components; i++) {
+		double c = components[i];
+		if (!c) {
+			continue;
+		}
+		BasisBlade *b = [layout bladeAt:i];
+		int ind = [minus.layout bladeIndex:[b mask]];
+		minus.components[ind] += c;
+	}
+	for (int i = 0; i < rhs.num_components; i++) {
+		double c = rhs.components[i];
+		if (!c) {
+			continue;
+		}
+		BasisBlade *b = [rhs.layout bladeAt:i];
+		int ind = [minus.layout bladeIndex:[b mask]];
+		minus.components[ind] -= c;
+	}
+	return minus;
+}
+
 -(MultiVector *) dual
 {
 	MultiVector *dual = new_mv (algebra, nil);