From fedc1fea8c3b7911b7411f75cadd947dde570461 Mon Sep 17 00:00:00 2001
From: "K. Andrew Parker" <kparker@citytech.cuny.edu>
Date: Mon, 18 Mar 2024 19:59:40 -0400
Subject: [PATCH] incorporate code from @dpvc

---
 macros/contexts/contextBoolean.pl | 193 +++++++++++++++++++++---------
 1 file changed, 137 insertions(+), 56 deletions(-)

diff --git a/macros/contexts/contextBoolean.pl b/macros/contexts/contextBoolean.pl
index a79ec2236..57d3db207 100644
--- a/macros/contexts/contextBoolean.pl
+++ b/macros/contexts/contextBoolean.pl
@@ -8,6 +8,7 @@ sub Init {
 	my $context = $main::context{Boolean} = Parser::Context->getCopy('Numeric');
 	$context->{name} = 'Boolean';
 
+	$context->{parser}{Number}      = 'context::Boolean::Number';
 	$context->{parser}{Formula}     = 'context::Boolean::Formula';
 	$context->{value}{Formula}      = 'context::Boolean::Formula';
 	$context->{value}{Boolean}      = 'context::Boolean::Boolean';
@@ -26,7 +27,7 @@ sub Init {
 	$context->operators->are(
 		'or' => {
 			class         => 'context::Boolean::BOP::or',
-			precedence    => 1,
+			precedence    => 3,
 			associativity => 'left',
 			type          => 'bin',
 			rightparens   => 'same',
@@ -37,7 +38,7 @@ sub Init {
 		},
 		'and' => {
 			class         => 'context::Boolean::BOP::and',
-			precedence    => 1,
+			precedence    => 3,
 			associativity => 'left',
 			type          => 'bin',
 			rightparens   => 'same',
@@ -48,7 +49,7 @@ sub Init {
 		},
 		'xor' => {
 			class         => 'context::Boolean::BOP::xor',
-			precedence    => 1,
+			precedence    => 3,
 			associativity => 'left',
 			type          => 'bin',
 			rightparens   => 'same',
@@ -68,19 +69,21 @@ sub Init {
 			alternatives  => ["\x{00AC}"],
 		},
 		' ' => {
-			class         => 1,
+			class         => 3,
 			precedence    => 1,
 			associativity => 'left',
 			type          => 'bin',
 			string        => 'and',
 			hidden        => 1
 		},
-		'*'  => { alias => 'and' },
-		'+'  => { alias => 'or' },
-		'-'  => { alias => 'not' },
-		'!'  => { alias => 'not' },
-		'~'  => { alias => 'not', alternatives => ["\x{223C}"] },
-		'><' => { alias => 'xor' },
+		'*'   => { alias => 'and' },
+		'/\\' => { alias => 'and' },
+		'+'   => { alias => 'or' },
+		'\\/' => { alias => 'or' },
+		'-'   => { alias => 'not' },
+		'!'   => { alias => 'not' },
+		'~'   => { alias => 'not', alternatives => ["\x{223C}"] },
+		'><'  => { alias => 'xor' },
 	);
 
 	## redefine, but disable some usual context tokens for 'clearer' error messages
@@ -100,22 +103,103 @@ sub Init {
 	## Set up new reduction rules:
 	$context->reductions->set('x||1' => 1, 'x||0' => 1, 'x&&1' => 1, 'x&&0' => 1, '!!x' => 1);
 
-	## Value::inContext does not recognize our $context as second argument -- using inContext method instead
-	our $T = context::Boolean::Boolean->new(1)->inContext($context);
-	our $F = context::Boolean::Boolean->new(0)->inContext($context);
-
 	## Define constants for 'True' and 'False'
+	$context->constants->{namePattern} = qr/(?:\w|[\x{22A4}\x{22A5}])+/;
 	$context->constants->are(
-		'T'     => { value => $T, TeX => '\top ', perl => '$context::Boolean::T' },   #, alternatives => ["\x{22A4}"] },
-		'F'     => { value => $F, TeX => '\bot ', perl => '$context::Boolean::F' },   #, alternatives => ["\x{22A5}"] },
+		T => {
+			value        => context::Boolean::Boolean->new($context, 1),
+			string       => 'T',
+			TeX          => '\top',
+			perl         => 'context::Boolean->T',
+			isConstant   => 1,
+			alternatives => ["\x{22A4}"]
+		},
+		F => {
+			value        => context::Boolean::Boolean->new($context, 0),
+			string       => 'F',
+			TeX          => '\bot',
+			perl         => 'context::Boolean->F',
+			isConstant   => 1,
+			alternatives => ["\x{22A5}"]
+		},
 		'True'  => { alias => 'T' },
 		'False' => { alias => 'F' },
 	);
 
+	## add our methods to this context
+	bless $context, 'context::Boolean::Context';
+
 	## allow authors to create Boolean values
 	main::PG_restricted_eval('sub Boolean { Value->Package("Boolean()")->new(@_) }');
 }
 
+## top-level access to context-specific T and T
+sub T {
+	my $context = main::Context();
+	Value::Error("Context must be a Boolean context") unless $context->can('T');
+	return $context->T;
+}
+
+sub F {
+	my $context = main::Context();
+	Value::Error("Context must be a Boolean context") unless $context->can('F');
+	return $context->F;
+}
+
+## Subclass the Parser::Context to override copy() and add T and F functions
+package context::Boolean::Context;
+our @ISA = ('Parser::Context');
+
+sub copy {
+	my $self = shift->SUPER::copy(@_);
+	## update the T and F constants to refer to this context
+	$self->constants->set(
+		T => { value => context::Boolean::Boolean->new($self, 1) },
+		F => { value => context::Boolean::Boolean->new($self, 0) }
+	);
+	return $self;
+}
+
+## Access to the constant T and F values
+sub F { shift->constants->get('F')->{value} }
+sub T { shift->constants->get('T')->{value} }
+
+## Easy setting of precedence to different types
+sub setPrecedence {
+	my ($self, $order) = @_;
+	if ($order eq 'equal') {
+		$self->operators->set(
+			or  => { precedence => 3 },
+			xor => { precedence => 3 },
+			and => { precedence => 3 },
+			not => { precedence => 3 },
+		);
+	} elsif ($order eq 'oxan') {
+		$self->operators->set(
+			or  => { precedence => 1 },
+			xor => { precedence => 2 },
+			and => { precedence => 3 },
+			not => { precedence => 6 },
+		);
+	} else {
+		Value::Error("Unknown precedence class '%s'", $order);
+	}
+}
+
+## Subclass Parser::Number to return the constant T or F
+package context::Boolean::Number;
+our @ISA = ('Parser::Number');
+
+sub eval {
+	my $self = shift;
+	return $self->context->constants->get(('F', 'T')[ $self->{value} ])->{value};
+}
+
+sub perl {
+	my $self = shift;
+	return $self->context->constants->get(('F', 'T')[ $self->{value} ])->{perl};
+}
+
 ## Subclass Value::Formula for boolean formulas
 package context::Boolean::Formula;
 our @ISA = ('Value::Formula');
@@ -128,8 +212,8 @@ sub createRandomPoints {
 	my @points;
 	my @values;
 
-	my $T = $context::Boolean::T->inContext($context);
-	my $F = $context::Boolean::F->inContext($context);
+	my $T = $context->T;
+	my $F = $context->F;
 
 	my $f = $self->{f};
 	$f = $self->{f} = $self->perlFunction(undef, \@variables) unless $f;
@@ -163,63 +247,62 @@ sub perl {
 	my $lPerl  = $self->{lop}->perl(1) . '->value';
 	my $rPerl  = $self->{rop}->perl(2) . '->value';
 	my $result = "$lPerl $bop $rPerl";
-	return "($result ? \$context::Boolean::T : \$context::Boolean::F)";
+	return "($result ? context::Boolean->T : context::Boolean->F)";
 }
 
 package context::Boolean::BOP::or;
 our @ISA = qw(context::Boolean::BOP);
 
-sub _eval { ($_[1]->value || $_[2]->value ? $context::Boolean::T : $context::Boolean::F) }
+sub _eval {
+	my ($self, $l, $r) = @_;
+	return ($l->value || $r->value ? $self->context->T : $self->context->F);
+}
 
 sub _reduce {
-	my $self    = shift;
-	my $context = $self->{equation}{context};
-	my $reduce  = $context->{reduction};
-	my $l       = $self->{lop};
-	my $r       = $self->{rop};
+	my $self   = shift;
+	my $reduce = $self->context->{reduction};
+	my $l      = $self->{lop};
+	my $r      = $self->{rop};
 
 	return $self unless ($l->{isConstant} || $r->{isConstant});
 
-	# make sure we are comparing to an updated 'true'
-	my $T = $context::Boolean::T->inContext($context);
-
-	# using string since Parser::Number::eval is unblessed, while Parser::Constant::eval is a (truthy) MathObject
 	if ($l->{isConstant}) {
-		return $l->string eq "$T" ? ($reduce->{'x||1'} ? $l : $self) : ($reduce->{'x||0'} ? $r : $self);
+		return $l->eval->value ? ($reduce->{'x||1'} ? $l : $self) : ($reduce->{'x||0'} ? $r : $self);
 	} else {
-		return $r->string eq "$T" ? ($reduce->{'x||1'} ? $r : $self) : ($reduce->{'x||0'} ? $l : $self);
+		return $r->eval->value ? ($reduce->{'x||1'} ? $r : $self) : ($reduce->{'x||0'} ? $l : $self);
 	}
 }
 
 package context::Boolean::BOP::and;
 our @ISA = qw(context::Boolean::BOP);
 
-sub _eval { ($_[1]->value && $_[2]->value ? $context::Boolean::T : $context::Boolean::F) }
+sub _eval {
+	my ($self, $l, $r) = @_;
+	return ($l->value && $r->value ? $self->context->T : $self->context->F);
+}
 
 sub _reduce {
-	my $self    = shift;
-	my $context = $self->{equation}{context};
-	my $reduce  = $context->{reduction};
-	my $l       = $self->{lop};
-	my $r       = $self->{rop};
+	my $self   = shift;
+	my $reduce = $self->context->{reduction};
+	my $l      = $self->{lop};
+	my $r      = $self->{rop};
 
 	return $self unless ($l->{isConstant} || $r->{isConstant});
 
-	# make sure we are comparing to an updated 'true'
-	my $T = $context::Boolean::T->inContext($context);
-
-	# using string since Parser::Number::eval is unblessed, while Parser::Constant::eval is a (truthy) MathObject
 	if ($l->{isConstant}) {
-		return $l->string eq "$T" ? ($reduce->{'x&&1'} ? $r : $self) : ($reduce->{'x&&0'} ? $l : $self);
+		return $l->eval->value ? ($reduce->{'x&&1'} ? $r : $self) : ($reduce->{'x&&0'} ? $l : $self);
 	} else {
-		return $r->string eq "$T" ? ($reduce->{'x&&1'} ? $l : $self) : ($reduce->{'x&&0'} ? $r : $self);
+		return $r->eval->value ? ($reduce->{'x&&1'} ? $l : $self) : ($reduce->{'x&&0'} ? $r : $self);
 	}
 }
 
 package context::Boolean::BOP::xor;
 our @ISA = qw(context::Boolean::BOP);
 
-sub _eval { ($_[1]->value != $_[2]->value ? $context::Boolean::T : $context::Boolean::F) }
+sub _eval {
+	my ($self, $l, $r) = @_;
+	return ($l->value != $r->value ? $self->context->T : $self->context->F);
+}
 
 package context::Boolean::UOP::not;
 our @ISA = qw(Parser::UOP);
@@ -231,10 +314,9 @@ sub _check {
 }
 
 sub _reduce {
-	my $self    = shift;
-	my $context = $self->{equation}{context};
-	my $reduce  = $context->{reduction};
-	my $op      = $self->{op};
+	my $self   = shift;
+	my $reduce = $self->context->{reduction};
+	my $op     = $self->{op};
 
 	if ($op->isNeg && $reduce->{'!!x'}) {
 		delete $op->{op}{noParens};
@@ -242,24 +324,24 @@ sub _reduce {
 	}
 
 	if ($op->{isConstant} && $context->flag('reduceConstants')) {
-		# same issue with Parser::Number::eval being unblessed, check string instead
-		my $T   = $context::Boolean::T->inContext($context);
-		my $new = $op->string eq "$T" ? 0 : 1;
-		return $self->Item('Value')->new($self->{equation}, [$new]);
+		return $self->Item('Value')->new($self->{equation}, [ 1 - $op->value ]);
 	}
 	return $self;
 }
 
 sub isNeg {1}
 
-sub _eval { (!($_[1]->value) ? $context::Boolean::T : $context::Boolean::F) }
+sub _eval {
+	my ($self, $op) = @_;
+	return (!($op->value) ? $self->context->T : $self->context->F);
+}
 
 sub perl {
 	my $self   = shift;
 	my $op     = $self->{def}{perl} || $self->{def}{string};
 	my $perl   = $self->{op}->perl(1) . '->value';
 	my $result = "$op $perl";
-	return "($result ? \$context::Boolean::T : \$context::Boolean::F)";
+	return "($result ? context::Boolean->T : context::Boolean->F)";
 }
 
 package context::Boolean::Boolean;
@@ -286,7 +368,6 @@ sub checkBoolean {
 }
 
 sub compare {
-	# copypasta from other compare methods -- is this necessary?
 	my ($self, $l, $r) = Value::checkOpOrderWithPromote(@_);
 	return $l->value <=> $r->value;
 }
@@ -311,7 +392,7 @@ sub TeX {
 
 sub perl {
 	my $self = shift;
-	return $self->value ? '$context::Boolean::T' : '$context::Boolean::F';
+	return $self->value ? 'context::Boolean->T' : 'context::Boolean->F';
 }
 
 sub cmp_defaults { shift->SUPER::cmp_defaults(@_) }