[qfcc] Implement multi-vector dual

It's implemented as the Hodge dual, which is probably reasonable until
people complain. Both ⋆ and ! are supported, though the former is a
little hard to see in Consola.

tools/qfcc/include/algebra.h

@@ -87,6 +87,7 @@ bool is_algebra (const struct type_s *type) __attribute__((pure));
 struct type_s *algebra_type (struct type_s *type, struct expr_s *params);
 struct type_s *algebra_subtype (struct type_s *type, struct attribute_s *attr);
 struct type_s *algebra_mvec_type (algebra_t *algebra, pr_uint_t group_mask);
+int algebra_count_flips (const algebra_t *alg, pr_uint_t a, pr_uint_t b) __attribute__((pure));
 struct ex_value_s *algebra_blade_value (algebra_t *alg, const char *name);
 struct symtab_s *algebra_scope (struct type_s *type, struct symtab_s *curscope);
 void algebra_print_type_str (struct dstring_s *str, const struct type_s *type);

tools/qfcc/source/algebra.c

@@ -492,6 +492,23 @@ static int pga_swaps_3d[16] = {
 	[0xd] = 1,	// e032
 };
 
+int
+algebra_count_flips (const algebra_t *alg, pr_uint_t a, pr_uint_t b)
+{
+	bool pga_2d = (alg->plus == 2 && alg->minus == 0 && alg->zero == 1);
+	bool pga_3d = (alg->plus == 3 && alg->minus == 0 && alg->zero == 1);
+	int swaps = count_flips (a, b);
+	if (pga_2d) {
+		swaps += pga_swaps_2d[a];
+		swaps += pga_swaps_2d[b];
+	}
+	if (pga_3d) {
+		swaps += pga_swaps_3d[a];
+		swaps += pga_swaps_3d[b];
+	}
+	return swaps;
+}
+
 ex_value_t *
 algebra_blade_value (algebra_t *alg, const char *name)
 {

tools/qfcc/source/expr.c

@@ -1881,6 +1881,9 @@ unary_expr (int op, expr_t *e)
 			}
 			break;
 		case '!':
+			if (is_algebra (get_type (e))) {
+				return algebra_dual (e);
+			}
 			if (is_constant (e)) {
 				switch (extract_type (e)) {
 					case ev_entity:
@@ -1969,6 +1972,9 @@ unary_expr (int op, expr_t *e)
 			}
 			break;
 		case '~':
+			if (is_algebra (get_type (e))) {
+				return algebra_reverse (e);
+			}
 			if (is_constant (e)) {
 				switch (extract_type (e)) {
 					case ev_string:
@@ -2076,6 +2082,8 @@ bitnot_expr:
 			return e;
 		case REVERSE:
 			return algebra_reverse (e);
+		case DUAL:
+			return algebra_dual (e);
 	}
 	internal_error (e, 0);
 }

tools/qfcc/source/expr_algebra.c

@@ -1342,7 +1342,8 @@ geometric_product (expr_t *e1, expr_t *e2)
 static expr_t *
 regressive_product (expr_t *e1, expr_t *e2)
 {
-	internal_error (e1, "not implemented");
+	notice (e1, "not implemented");
+	return 0;
 }
 
 static expr_t *
@@ -1458,11 +1459,39 @@ algebra_negate (expr_t *e)
 expr_t *
 algebra_dual (expr_t *e)
 {
-	if (e) {
-		internal_error (e, "not implemented");
+	if (!is_algebra (get_type (e))) {
+		//FIXME check for being in an @algebra { } block
+		return error (e, "cannot take the dual of a scalar without context");
 	}
-	notice (e, "not implemented");
-	return 0;
+	auto algebra = algebra_get (get_type (e));
+	auto layout = &algebra->layout;
+
+	expr_t *a[layout->count] = {};
+	expr_t *b[layout->count] = {};
+	e = mvec_expr (e, algebra);
+	mvec_scatter (a, e, algebra);
+
+	pr_uint_t I_mask = (1u << algebra->dimension) - 1;
+	for (int i = 0; i < layout->count; i++) {
+		if (!a[i]) {
+			continue;
+		}
+		auto group = &layout->groups[i];
+		//FIXME assumes groups are mono-grade (either come up with something
+		//or reject mixed-grade groups)
+		pr_uint_t mask = I_mask ^ group->blades[0].mask;
+		int dual_ind = layout->group_map[layout->mask_map[mask]][0];
+		auto dual_group = &layout->groups[dual_ind];
+		auto dual_type = algebra_mvec_type (algebra, dual_group->group_mask);
+		auto dual = cast_expr (dual_type, a[i]);
+		if (algebra_count_flips (algebra, group->blades[0].mask, mask) & 1) {
+			b[dual_ind] = unary_expr ('-', dual);
+		} else {
+			b[dual_ind] = dual;
+		}
+	}
+
+	return mvec_gather (b, algebra);
 }
 
 static void

tools/qfcc/source/qc-lex.l

@@ -276,6 +276,7 @@ STRING		\"(\\.|[^"\\])*\"
 "†"					{ return REVERSE; }
 "∗"					{ return STAR; }
 "×"					{ return CROSS; }
+"⋆"					{ return DUAL; }
 
 "%%"				{
 						return MOD;

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 REVERSE STAR
+%right	<op>	SIZEOF UNARY INCOP REVERSE STAR DUAL
 %left			HYPERUNARY
 %left			'.' '(' '['
 
@@ -1702,6 +1702,7 @@ unary_expr
 	| INCOP unary_expr				{ $$ = incop_expr ($1, $2, 0); }
 	| unary_expr INCOP				{ $$ = incop_expr ($2, $1, 1); }
 	| unary_expr REVERSE			{ $$ = unary_expr (REVERSE, $1); }
+	| DUAL cast_expr %prec UNARY	{ $$ = unary_expr (DUAL, $2); }
 	| '+' cast_expr %prec UNARY	{ $$ = $2; }
 	| '-' cast_expr %prec UNARY	{ $$ = unary_expr ('-', $2); }
 	| '!' cast_expr %prec UNARY	{ $$ = unary_expr ('!', $2); }

tools/qfcc/test/pga2d.r

@@ -252,5 +252,18 @@ main (void)
 				s.scalar, s.bvec);
 		return 1;
 	}
+	evengrades_t dual_e;
+	dual_e.mvec = ⋆e.mvec;	// test both dual operators
+	if ((dvec3)dual_e.bvec != '-2 -3 -0.5'd || dual_e.scalar != 10) {
+		printf ("⋆odd != '-2 -3 -0.5' + 10: %lv %g\n", e.vec, e.tvec);
+		return 1;
+	}
+	oddgrades_t dual_s;
+	dual_s.mvec = !s.mvec;	// test both dual operators
+	if ((scalar_t)dual_s.tvec != 4.5 || (dvec3)dual_s.vec != '7 22 23'd) {
+		printf ("!even != 4.5, '7 22 23': %g %lv\n",
+				s.scalar, s.bvec);
+		return 1;
+	}
 	return 0;		// to survive and prevail :)
 }