Menu
▾
▴
[WWcvs] pg: Added canBeInUnion and isSetOfReals methods to the Parser package
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 22:37:00
|
Log Message:
-----------
Added canBeInUnion and isSetOfReals methods to the Parser package
(similar to the ones in the Value package), replacing the
canBeInterval flag and other ad hoc checks.
Removed ability to form interval like [a] now that we have sets.
Modified Files:
--------------
pg/lib/Parser:
Constant.pm
Item.pm
List.pm
Value.pm
pg/lib/Parser/BOP:
subtract.pm
union.pm
pg/lib/Parser/List:
Interval.pm
List.pm
Set.pm
pg/lib/Value:
Formula.pm
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.16 -r1.17
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -47,15 +47,14 @@
sub check {
my $self = shift;
my $type = $self->{type}; my $value = $self->{value};
- $self->{canBeInterval} = $value->canBeInUnion;
$self->{isZero} = $value->isZero;
$self->{isOne} = $value->isOne;
}
#
-# Return the Value.pm object
+# Return the Value object
#
-sub eval {return (shift)->{value}}
+sub eval {(shift)->{value}}
#
# Call the Value object's reduce method and reset the flags
@@ -68,6 +67,11 @@
}
#
+# Pass on the request to the Value object
+#
+sub canBeInUnion {(shift)->{value}->canBeInUnion}
+
+#
# Return the item's list of coordinates
# (for points, vectors, matrices, etc.)
#
@@ -96,8 +100,6 @@
sub perl {
my $self = shift; my $parens = shift; my $matrix = shift;
my $perl = $self->{value}->perl(0,$matrix);
- $perl = "(($perl)->with(open=>'$self->{open}',close=>'$self->{close}'))"
- if $self->{canBeInterval} && $self->{open}.$self->{close} eq '[]';
$perl = '('.$perl.')' if $parens;
return $perl;
}
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.15 -r1.16
--- lib/Parser/List.pm
+++ lib/Parser/List.pm
@@ -31,8 +31,7 @@
if ($paren && $close && $paren->{formInterval}) {
$paren = $parens->{interval}
if ($paren->{close} ne $close || (scalar(@{$coords}) == 2 &&
- ($coords->[0]->{isInfinite} || $coords->[1]->{isInfinite})) ||
- (scalar(@{$coords}) == 1 && $coords->[0]->{isInfinite}));
+ ($coords->[0]->{isInfinite} || $coords->[1]->{isInfinite})));
}
my $type = Value::Type($paren->{type},scalar(@{$coords}),$entryType,
list => 1, formMatrix => $paren->{formMatrix});
@@ -54,28 +53,24 @@
foreach my $x (@{$coords}) {$zero = 0, last unless $x->{isZero}}
$list->{isZero} = 1 if $zero && scalar(@{$coords}) > 0;
- $list->checkInterval;
$list->_check;
# warn ">> $list->{type}{name} of $list->{type}{entryType}{name} of length $list->{type}{length}\n";
if ($list->{isConstant} && $context->flag('reduceConstants')) {
- my $saveCBI = $list->{canBeInterval}; $type = $list->{type};
+ $type = $list->{type};
$list = $context->{parser}{Value}->new($equation,[$list->eval]);
$list->{type} = $type; $list->{open} = $open; $list->{close} = $close;
$list->{value}->{open} = $open, $list->{value}->{close} = $close
if ref($list->{value});
- $list->{canBeInterval} = $saveCBI if $saveCBI;
}
return $list;
}
-sub checkInterval {
+sub canBeInUnion {
my $self = shift;
- if ((($self->{open} eq '(' || $self->{open} eq '[') &&
- ($self->{close} eq ')' || $self->{close} eq ']') && $self->length == 2) ||
- ($self->{open}.$self->{close} eq '[]' && $self->length == 1))
- {$self->{canBeInterval} = 1}
+ $self->length == 2 && $self->typeRef->{entryType}{name} eq 'Number' &&
+ $self->{open} =~ m/^[\(\[]$/ && $self->{close} =~ m/^[\)\]]$/;
}
sub _check {}
@@ -228,8 +223,9 @@
my $perl; my @p = ();
foreach my $x (@{$self->{coords}}) {push(@p,$x->perl)}
$perl = 'new Value::'.$self->type.'('.join(',',@p).')';
- $perl = "${perl}->with(open=>'$self->{open}',close=>'$self->{close}')"
- if $self->{canBeInterval} && $self->{open}.$self->{close} eq '[]';
+ $perl = "(${perl})->with(open=>'$self->{open}',close=>'$self->{close}')"
+ if $self->canBeInUnion ||
+ ($self->type eq 'List' && $self->{open}.$self->{close} ne '()');
$perl = '('.$perl.')' if $parens;
return $perl;
}
Index: Constant.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Constant.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Parser/Constant.pm -Llib/Parser/Constant.pm -u -r1.8 -r1.9
--- lib/Parser/Constant.pm
+++ lib/Parser/Constant.pm
@@ -24,8 +24,6 @@
ref => $ref, equation => $equation
}, $class;
$c->{isConstant} = 1 if $const->{isConstant};
- $c->{canBeInterval} = 1
- if Value::isValue($const->{value}) && $const->{value}{canBeInterval};
return $c;
}
@@ -47,6 +45,14 @@
}
#
+# Use constant to tell if it can be in a union
+#
+sub canBeInUnion {
+ my $self = shift;
+ Value::isValue($self->{def}{value}) && $self->{def}{value}->canBeInUnion;
+}
+
+#
# Return the constant's name
#
sub string {(shift)->{name}}
Index: Item.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Item.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/Item.pm -Llib/Parser/Item.pm -u -r1.7 -r1.8
--- lib/Parser/Item.pm
+++ lib/Parser/Item.pm
@@ -61,6 +61,13 @@
}
#
+# Check if an item can be in a union or is a set or reals
+# (overridden in subclasses)
+#
+sub canBeInUnion {0}
+sub isSetOfReals {(shift)->type =~ m/^(Interval|Union|Set)$/}
+
+#
# Add parens to an expression (alternating the type of paren)
#
sub addParens {
Index: union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/union.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Parser/BOP/union.pm -Llib/Parser/BOP/union.pm -u -r1.8 -r1.9
--- lib/Parser/BOP/union.pm
+++ lib/Parser/BOP/union.pm
@@ -14,14 +14,13 @@
sub _check {
my $self = shift;
return if ($self->checkStrings());
- if ($self->{lop}{canBeInterval} && $self->{rop}{canBeInterval}) {
+ if ($self->{lop}->canBeInUnion && $self->{rop}->canBeInUnion) {
$self->{type} = Value::Type('Union',2,$Value::Type{number});
- $self->{canBeInterval} = 1;
foreach my $op ('lop','rop') {
- if ($self->{$op}->type !~ m/^(Interval|Union|Set)$/) {
+ if (!$self->{$op}->isSetOfReals) {
if ($self->{$op}->class eq 'Value') {
$self->{$op}{value} = Value::Interval::promote($self->{$op}{value});
- } else {
+ } else {
$self->{$op} = bless $self->{$op}, 'Parser::List::Interval';
}
$self->{$op}->typeRef->{name} = $self->{equation}{context}{parens}{interval}{type};
@@ -30,6 +29,8 @@
} else {$self->Error("Operands of '%s' must be intervals or sets",$self->{bop})}
}
+sub canBeInUnion {(shift)->type eq 'Union'}
+
#
# Make a union of the two operands.
Index: subtract.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/subtract.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/BOP/subtract.pm -Llib/Parser/BOP/subtract.pm -u -r1.6 -r1.7
--- lib/Parser/BOP/subtract.pm
+++ lib/Parser/BOP/subtract.pm
@@ -14,13 +14,11 @@
return if ($self->checkStrings());
return if ($self->checkLists());
return if ($self->checkNumbers());
- if ($self->{lop}{canBeInterval} && $self->{rop}{canBeInterval}) {
- if ($self->{lop}->type =~ m/Interval|Union|Set/ ||
- $self->{rop}->type =~ m/Interval|Union|Set/) {
+ if ($self->{lop}->canBeInUnion && $self->{rop}->canBeInUnion) {
+ if ($self->{lop}->isSetOfReals || $self->{rop}->isSetOfReals) {
$self->{type} = Value::Type('Union',2,$Value::Type{number});
- $self->{canBeInterval} = 1;
foreach my $op ('lop','rop') {
- if ($self->{$op}->type !~ m/Interval|Union|Set/) {
+ if (!$self->{$op}->isSetOfReals) {
if ($self->{$op}->class eq 'Value') {
$self->{$op}{value} = Value::Interval::promote($self->{$op}{value});
} else {
@@ -37,6 +35,8 @@
else {$self->matchError($ltype,$rtype)}
}
+sub canBeInUnion {(shift)->type eq 'Union'}
+
#
# Do subtraction
#
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List/Set.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Llib/Parser/List/Set.pm -Llib/Parser/List/Set.pm -u -r1.1 -r1.2
--- lib/Parser/List/Set.pm
+++ lib/Parser/List/Set.pm
@@ -17,10 +17,7 @@
}
}
-sub checkInterval {
- my $self = shift;
- $self->{canBeInterval} = 1;
-}
+sub canBeInUnion {1}
#########################################################################
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List/List.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/List/List.pm -Llib/Parser/List/List.pm -u -r1.3 -r1.4
--- lib/Parser/List/List.pm
+++ lib/Parser/List/List.pm
@@ -23,4 +23,3 @@
#########################################################################
1;
-
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List/Interval.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/List/Interval.pm -Llib/Parser/List/Interval.pm -u -r1.7 -r1.8
--- lib/Parser/List/Interval.pm
+++ lib/Parser/List/Interval.pm
@@ -13,22 +13,21 @@
sub _check {
my $self = shift;
my $length = $self->{type}{length}; my $coords = $self->{coords};
- $self->Error("Intervals can have only two endpoints") if ($length > 2);
- $self->Error("Intervals must have at least one endpoint") if ($length == 0);
+ $self->Error("Intervals can have only two endpoints") if $length > 2;
+ $self->Error("Intervals must have two endpoints") if $length < 2;
$self->Error("Coordinates of intervals can only be numbers or infinity")
- if !$coords->[0]->isNumOrInfinity ||
- ($length == 2 && !$coords->[1]->isNumOrInfinity);
- $self->Error("Infinite intervals require two endpoints")
- if ($length == 1 && $coords->[0]{isInfinite});
+ if !$coords->[0]->isNumOrInfinity || !$coords->[1]->isNumOrInfinity;
$self->Error("The left endpoint of an interval can't be positive infinity")
- if ($coords->[0]{isInfinity});
+ if $coords->[0]{isInfinity};
$self->Error("The right endpoint of an interval can't be negative infinity")
- if ($length == 2 && $coords->[1]{isNegativeInfinity});
+ if $coords->[1]{isNegativeInfinity};
$self->Error("Infinite endpoints must be open")
if ($self->{open} ne '(' && $coords->[0]{isInfinite}) ||
- ($self->{close} ne ')' && $length == 2 && $coords->[1]{isInfinite});
+ ($self->{close} ne ')' && $coords->[1]{isInfinite});
}
+sub canBeInUnion {1}
+
#
# Use the Value.pm class to produce the result
#
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.35
retrieving revision 1.36
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.35 -r1.36
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -71,7 +71,7 @@
sub isZero {(shift)->{tree}{isZero}}
sub isOne {(shift)->{tree}{isOne}}
-sub isSetOfReals {(shift)->type =~ m/Interval|Set|Union/}
+sub isSetOfReals {(shift)->{tree}->isSetOfReals}
sub canBeInUnion {(shift)->{tree}->canBeInUnion}
############################################
|
