[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 4664 - (download) (as text) (annotate)
Sun Nov 26 21:15:24 2006 UTC (13 years, 3 months ago) by dpvc
File size: 2935 byte(s)
This file implements special power operators that check for special
conditions (like no powers of 'e', or only integer powers).  See the
contents of the file for documentation.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9