[qfcc] Implement multi-vector reversion

For a change, something that's actually general rather than specific to
PGA.

tools/qfcc/include/algebra.h

@@ -101,6 +101,9 @@ algebra_t *algebra_get (const struct type_s *type) __attribute__((pure));
 int algebra_type_assignable (const struct type_s *dst,
 							 const struct type_s *src) __attribute__((pure));
 struct type_s *algebra_base_type (const struct type_s *type) __attribute__((pure));
+bool is_mono_grade (const struct type_s *type) __attribute__((pure));
+int algebra_get_grade (const struct type_s *type) __attribute__((pure));
+int algebra_blade_grade (basis_blade_t blade) __attribute__((const));
 
 struct expr_s *algebra_binary_expr (int op, struct expr_s *e1,
 									struct expr_s *e2);

tools/qfcc/source/algebra.c

@@ -699,3 +699,62 @@ algebra_base_type (const type_t *type)
 	}
 	return ev_types[type->type];
 }
+
+int
+algebra_blade_grade (basis_blade_t blade)
+{
+	return count_bits (blade.mask);
+}
+
+bool
+is_mono_grade (const type_t *type)
+{
+	if (!is_algebra (type)) {
+		return true;
+	}
+	if (type->type == ev_invalid) {
+		return false;
+	}
+	auto alg = algebra_get (type);
+	auto layout = &alg->layout;
+	auto multivec = type->t.multivec;
+	int  grade = -1;
+	for (int i = 0; i < layout->count; i++) {
+		pr_uint_t   mask = 1u << i;
+		if (mask & multivec->group_mask) {
+			auto group = &layout->groups[i];
+			for (int j = 0; j < group->count; j++) {
+				int blade_grade = algebra_blade_grade (group->blades[j]);
+				if (grade == -1) {
+					grade = blade_grade;
+				}
+				if (blade_grade != grade) {
+					return false;
+				}
+			}
+		}
+	}
+	return true;
+}
+
+int
+algebra_get_grade (const type_t *type)
+{
+	if (!is_algebra (type)) {
+		return 0;
+	}
+	if (type->type == ev_invalid) {
+		return -1;
+	}
+	auto alg = algebra_get (type);
+	auto layout = &alg->layout;
+	auto multivec = type->t.multivec;
+	for (int i = 0; i < layout->count; i++) {
+		pr_uint_t   mask = 1u << i;
+		if (mask & multivec->group_mask) {
+			auto group = &layout->groups[i];
+			return algebra_blade_grade (group->blades[0]);
+		}
+	}
+	return 0;
+}

tools/qfcc/source/expr.c

@@ -2071,6 +2071,8 @@ bitnot_expr:
 			if (!is_math (get_type (e)))
 				return error (e, "invalid type for unary +");
 			return e;
+		case REVERSE:
+			return algebra_reverse (e);
 	}
 	internal_error (e, 0);
 }

tools/qfcc/source/expr_algebra.c

@@ -1421,14 +1421,56 @@ algebra_dual (expr_t *e)
 	return 0;
 }
 
+static void
+set_sign (pr_type_t *val, int sign, const type_t *type)
+{
+	if (is_float (type)) {
+		(*(float *) val) = sign;
+	} else {
+		(*(double *) val) = sign;
+	}
+}
+
 expr_t *
 algebra_reverse (expr_t *e)
 {
-	if (e) {
-		internal_error (e, "not implemented");
+	auto t = get_type (e);
+	auto algebra = algebra_get (t);
+	auto layout = &algebra->layout;
+	expr_t *r[layout->count] = {};
+	e = mvec_expr (e, algebra);
+	mvec_scatter (r, e, algebra);
+
+	for (int i = 0; i < layout->count; i++) {
+		if (!r[i]) {
+			continue;
+		}
+		auto ct = get_type (r[i]);
+		if (is_mono_grade (ct)) {
+			int grade = algebra_get_grade (ct);
+			if (grade & 2) {
+				r[i] = unary_expr ('-', r[i]);
+			}
+		} else {
+			auto group = &layout->groups[i];
+			pr_type_t ones[group->count * type_size (algebra->type)];
+			bool neg = false;
+			for (int j = 0; j < group->count; j++) {
+				int grade = algebra_blade_grade (group->blades[i]);
+				int sign = grade & 2 ? -1 : 1;
+				if (sign < 0) {
+					neg = true;
+				}
+				set_sign (&ones[j * type_size (algebra->type)], sign, ct);
+			}
+			if (neg) {
+				auto rev = new_value_expr (new_type_value (ct, ones));
+				r[i] = new_binary_expr (HADAMARD, r[i], rev);
+				r[i]->e.expr.type = ct;
+			}
+		}
 	}
-	notice (e, "not implemented");
-	return 0;
+	return mvec_gather (r, algebra);
 }
 
 expr_t *

tools/qfcc/source/qc-lex.l

@@ -273,7 +273,7 @@ STRING		\"(\\.|[^"\\])*\"
 "•"					{ return DOT; }
 "∧"					{ return WEDGE; }
 "∨"					{ return REGRESSIVE; }
-"†"					{ return DAGGER; }
+"†"					{ return REVERSE; }
 "∗"					{ return STAR; }
 "×"					{ return CROSS; }
 

tools/qfcc/source/qc-parse.y

@@ -144,7 +144,7 @@ int yylex (void);
 %left			'+' '-'
 %left			'*' '/' '%' MOD SCALE GEOMETRIC
 %left           HADAMARD CROSS DOT WEDGE REGRESSIVE
-%right	<op>	SIZEOF UNARY INCOP DAGGER STAR
+%right	<op>	SIZEOF UNARY INCOP REVERSE STAR
 %left			HYPERUNARY
 %left			'.' '(' '['
 
@@ -1701,6 +1701,7 @@ unary_expr
 	| unary_expr '.' unary_expr		{ $$ = field_expr ($1, $3); }
 	| INCOP unary_expr				{ $$ = incop_expr ($1, $2, 0); }
 	| unary_expr INCOP				{ $$ = incop_expr ($2, $1, 1); }
+	| unary_expr REVERSE			{ $$ = unary_expr (REVERSE, $1); }
 	| '+' cast_expr %prec UNARY	{ $$ = $2; }
 	| '-' cast_expr %prec UNARY	{ $$ = unary_expr ('-', $2); }
 	| '!' cast_expr %prec UNARY	{ $$ = unary_expr ('!', $2); }

tools/qfcc/test/pga2d.r

@@ -219,5 +219,16 @@ main (void)
 		printf ("didn't get 0: %g %g", tvec • tvecb, tvec * tvecb);
 		return 0;
 	}
+	e.mvec = e.mvec†;	// odd
+	if ((dvec3)e.vec != '4 6 1'd || (scalar_t)e.tvec != -20) {
+		printf ("odd† != '4 6 1' + -20: %lv %g\n", e.vec, e.tvec);
+		return 1;
+	}
+	s.mvec = s.mvec†;	// even
+	if (s.scalar != -9 || (dvec3)s.bvec != '-14 -44 -46'd) {
+		printf ("even† != -9, '-14 -44 -46': %g %lv\n",
+				s.scalar, s.bvec);
+		return 1;
+	}
 	return 0;		// to survive and prevail :)
 }