View of /trunk/pg/lib/Value/Infinity.pm

    1 ###########################################################################
    2 
    3 package Value::Infinity;
    4 my $pkg = 'Value::Infinity';
    5 
    6 use strict; no strict "refs";
    7 our @ISA = qw(Value);
    8 
    9 #
   10 #  Create an infinity object
   11 #
   12 sub new {
   13   my $self = shift; my $class = ref($self) || $self;
   14   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   15   Value::Error("Infinity should have no parameters") if scalar(@_);
   16   bless {
   17     data => [$self->getFlag('infiniteWord')],
   18     isInfinite => 1, isNegative => 0,
   19     context => $context,
   20   }, $class;
   21 }
   22 
   23 #
   24 #  Return the appropriate data.
   25 #
   26 sub length {0}
   27 sub typeRef {$Value::Type{infinity}}
   28 sub value {shift->{data}[0]}
   29 
   30 sub isZero {0}
   31 sub isOne {0}
   32 
   33 sub transferFlags {}
   34 
   35 ##################################################
   36 
   37 #
   38 #  Return an infinity or real
   39 #
   40 sub promote {
   41   my $self = shift; my $class = ref($self) || $self;
   42   my $context = (Value::isContext($_[0]) ? shift : $self->context);
   43   my $x = (scalar(@_) ? shift : $self); $x = [$x,@_] if scalar(@_) > 0;
   44   $x = Value::makeValue($x,context=>$context);
   45   return $x->inContext($context)
   46     if ref($x) eq $class || ref($x) eq $pkg || Value::isReal($x);
   47   Value::Error("Can't convert %s to %s",Value::showClass($x),$self->showClass);
   48 }
   49 
   50 ############################################
   51 #
   52 #  Operations on Infinities
   53 #
   54 
   55 sub neg {
   56   my $self = shift;
   57   my $neg = $self->Package("Infinity")->new($self->context);
   58   $neg->{isNegative} = !$self->{isNegative};
   59   $neg->{data}[0] = '-'.$neg->{data}[0] if $neg->{isNegative};
   60   return $neg;
   61 }
   62 
   63 sub compare {
   64   my ($l,$r,$flag) = @_;
   65   my $sgn = ($flag ? -1: 1);
   66   $r = $l->promote($r);
   67   return 0 if !$r->classMatch('Real') && $l->{isNegative} == $r->{isNegative};
   68   return ($l->{isNegative}? -$sgn: $sgn);
   69 }
   70 
   71 ############################################
   72 #
   73 #  Generate the various output formats
   74 #
   75 
   76 sub TeX {(shift->{isNegative} ? '-\infty ': '\infty ')}
   77 sub perl {(shift->{isNegative} ? '-(Infinity)': '(Infinity)')}
   78 
   79 ###########################################################################
   80 
   81 1;