[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 4997 - (download) (as text) (annotate)
Mon Jun 11 18:16:40 2007 UTC (12 years, 8 months ago) by gage
File size: 2726 byte(s)
Fixing docementation so that it can be read from the web.

    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 (and 0)
   17 #
   18 #  You install these via one of the commands:
   19 #
   20 #    Context()->operators->set(@LimitedPowers::NoBaseE);
   21 #    Context()->operators->set(@LimitedPowers::OnlyIntegers);
   22 #    Context()->operators->set(@LimitedPowers::OnlyPositiveIntegers);
   23 #
   24 #  Only one of the three can be in effect at a time; setting
   25 #  a second one overrides the first.
   26 #
   27 ##########################################################
   28 
   29 =cut
   30 
   31 package LimitedPowers;
   32 
   33 our @NoBaseE = (
   34   '^'  => {class => LimitedPowers::NoBaseE, isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
   35   '**' => {class => LimitedPowers::NoBaseE, isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
   36 );
   37 
   38 our @OnlyIntegers = (
   39   '^'  => {class => LimitedPowers::OnlyIntegers},
   40   '**' => {class => LimitedPowers::OnlyIntegers},
   41 );
   42 
   43 our @OnlyPositiveIntegers = (
   44   '^'  => {class => LimitedPowers::OnlyPositiveIntegers},
   45   '**' => {class => LimitedPowers::OnlyPositiveIntegers},
   46 );
   47 
   48 ##################################################
   49 
   50 package LimitedPowers::NoBaseE;
   51 @ISA = qw(Parser::BOP::power);
   52 
   53 my $e = CORE::exp(1);
   54 
   55 sub _check {
   56   my $self = shift;
   57   $self->SUPER::_check(@_);
   58   $self->Error("Can't raise e to a power") if $self->{lop}->string eq 'e';
   59 }
   60 
   61 sub _eval {
   62   my $self = shift;
   63   Value::cmp_Message("Can't raise e to a power") if $_[0] - $e == 0;
   64   $self->SUPER::_eval(@_);
   65 }
   66 
   67 ##################################################
   68 
   69 package LimitedPowers::OnlyIntegers;
   70 @ISA = qw(Parser::BOP::power);
   71 
   72 sub _check {
   73   my $self = shift; my $p = $self->{rop};
   74   $self->SUPER::_check(@_);
   75   $self->Error("Powers must be integer constants")
   76     if $p->type ne 'Number' || !$p->{isConstant} || !isInteger($p->eval);
   77 }
   78 
   79 sub isInteger {
   80   my $n = shift;
   81   return (Value::Real->make($n) - int($n)) == 0;
   82 }
   83 
   84 ##################################################
   85 
   86 package LimitedPowers::OnlyPositiveIntegers;
   87 @ISA = qw(Parser::BOP::power);
   88 
   89 sub _check {
   90   my $self = shift; my $p = $self->{rop};
   91   $self->SUPER::_check(@_);
   92   $self->Error("Powers must be positive integer constants")
   93     if $p->type ne 'Number' || !$p->{isConstant} || !isPositiveInteger($p->eval);
   94 }
   95 
   96 sub isPositiveInteger {
   97   my $n = shift;
   98   return $n >= 0 && (Value::Real->make($n) - int($n)) == 0;
   99 }
  100 
  101 ##################################################
  102 
  103 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9