[system] / trunk / pg / macros / contextLimitedPowers.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/contextLimitedPowers.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5332 - (download) (as text) (annotate)
Wed Aug 15 04:12:15 2007 UTC (12 years, 6 months ago) by dpvc
File size: 3475 byte(s)
Make @LimitedPowers::OnlyPositiveIntegers do as its name suggests and
rule out zero as well.  Added @LimitedPowers::OnlyNonNegativeIntegers
to handle 0 and positive values.

    1 
    2 loadMacros("Parser.pl");
    3 
    4 sub _contextLimitedPowers_init {}; # don't load it again
    5 
    6 =head3 Context("LimitedPowers")
    7 
    8 ##########################################################
    9 #
   10 #  Implements subclasses of the "^" operator that restrict
   11 #  the base or power that is allowed.  There are three
   12 #  available restrictions:
   13 #
   14 #    No raising e to a power
   15 #    Only allowing integer powers (positive or negative)
   16 #    Only allowing positive interger powers
   17 #    Only allowing positive interger powers (and 0)
   18 #
   19 #  You install these via one of the commands:
   20 #
   21 #    Context()->operators->set(@LimitedPowers::NoBaseE);
   22 #    Context()->operators->set(@LimitedPowers::OnlyIntegers);
   23 #    Context()->operators->set(@LimitedPowers::OnlyPositiveIntegers);
   24 #    Context()->operators->set(@LimitedPowers::OnlyNonNegativeIntegers);
   25 #
   26 #  Only one of the three can be in effect at a time; setting
   27 #  a second one overrides the first.
   28 #
   29 ##########################################################
   30 
   31 =cut
   32 
   33 package LimitedPowers;
   34 
   35 our @NoBaseE = (
   36   '^'  => {class => LimitedPowers::NoBaseE, isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
   37   '**' => {class => LimitedPowers::NoBaseE, isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
   38 );
   39 
   40 our @OnlyIntegers = (
   41   '^'  => {class => LimitedPowers::OnlyIntegers},
   42   '**' => {class => LimitedPowers::OnlyIntegers},
   43 );
   44 
   45 our @OnlyPositiveIntegers = (
   46   '^'  => {class => LimitedPowers::OnlyPositiveIntegers},
   47   '**' => {class => LimitedPowers::OnlyPositiveIntegers},
   48 );
   49 
   50 our @OnlyNonNegativeIntegers = (
   51   '^'  => {class => LimitedPowers::OnlyNonNegativeIntegers},
   52   '**' => {class => LimitedPowers::OnlyNonNegativeIntegers},
   53 );
   54 
   55 ##################################################
   56 
   57 package LimitedPowers::NoBaseE;
   58 @ISA = qw(Parser::BOP::power);
   59 
   60 my $e = CORE::exp(1);
   61 
   62 sub _check {
   63   my $self = shift;
   64   $self->SUPER::_check(@_);
   65   $self->Error("Can't raise e to a power") if $self->{lop}->string eq 'e';
   66 }
   67 
   68 sub _eval {
   69   my $self = shift;
   70   Value::cmp_Message("Can't raise e to a power") if $_[0] - $e == 0;
   71   $self->SUPER::_eval(@_);
   72 }
   73 
   74 ##################################################
   75 
   76 package LimitedPowers::OnlyIntegers;
   77 @ISA = qw(Parser::BOP::power);
   78 
   79 sub _check {
   80   my $self = shift; my $p = $self->{rop};
   81   $self->SUPER::_check(@_);
   82   $self->Error("Powers must be integer constants")
   83     if $p->type ne 'Number' || !$p->{isConstant} || !isInteger($p->eval);
   84 }
   85 
   86 sub isInteger {
   87   my $n = shift;
   88   return (Value::Real->make($n) - int($n)) == 0;
   89 }
   90 
   91 ##################################################
   92 
   93 package LimitedPowers::OnlyPositiveIntegers;
   94 @ISA = qw(Parser::BOP::power);
   95 
   96 sub _check {
   97   my $self = shift; my $p = $self->{rop};
   98   $self->SUPER::_check(@_);
   99   $self->Error("Powers must be positive integer constants")
  100     if $p->type ne 'Number' || !$p->{isConstant} || !isPositiveInteger($p->eval);
  101 }
  102 
  103 sub isPositiveInteger {
  104   my $n = shift;
  105   return $n > 0 && (Value::Real->make($n) - int($n)) == 0;
  106 }
  107 
  108 ##################################################
  109 
  110 package LimitedPowers::OnlyNonNegativeIntegers;
  111 @ISA = qw(Parser::BOP::power);
  112 
  113 sub _check {
  114   my $self = shift; my $p = $self->{rop};
  115   $self->SUPER::_check(@_);
  116   $self->Error("Powers must be non-negative integer constants")
  117     if $p->type ne 'Number' || !$p->{isConstant} || !isNonNegativeInteger($p->eval);
  118 }
  119 
  120 sub isNonNegativeInteger {
  121   my $n = shift;
  122   return $n >= 0 && (Value::Real->make($n) - int($n)) == 0;
  123 }
  124 
  125 ##################################################
  126 
  127 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9