[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 5353 - (download) (as text) (annotate)
Fri Aug 17 21:36:31 2007 UTC (12 years, 6 months ago) by dpvc
File size: 6544 byte(s)
Finished the comment that was left incomplete.  (Sorry about that.)

    1 loadMacros("Parser.pl");
    2 
    3 sub _contextLimitedPowers_init {}; # don't load it again
    4 
    5 =head3 LimitedPowers::NoBaseE();
    6 =head3 LimitedPowers::OnlyIntegers();
    7 =head3 LimitedPowers::OnlyNonNegativeIntegers();
    8 =head3 LimitedPowers::OnlyPositiveIntegers();
    9 =head3 LimitedPowers::OnlyNonTrivialPositiveIntegers();
   10 
   11 ##########################################################
   12 #
   13 #  Implements subclasses of the "^" operator that restrict
   14 #  the base or power that is allowed.  There are four
   15 #  available restrictions:
   16 #
   17 #    No raising e to a power
   18 #    Only allowing integer powers (positive or negative)
   19 #    Only allowing positive interger powers
   20 #    Only allowing positive interger powers (and 0)
   21 #
   22 #  You install these via one of the commands:
   23 #
   24 #    LimitedPowers::NoBaseE();
   25 #    LimitedPowers::OnlyIntegers();
   26 #    LimitedPowers::OnlyPositiveIntegers();
   27 #    LimitedPowers::OnlyNonNegativeIntegers();
   28 #
   29 #  Only one of the three can be in effect at a time; setting
   30 #  a second one overrides the first.
   31 #
   32 #  These function affect the current context, or you can pass
   33 #  a context reference, as in
   34 #
   35 #    $context = Context("Numeric")->copy;
   36 #    LimitedPowers::OnlyIntegers($context);
   37 #
   38 #  For the Interger power functions, you can pass additional
   39 #  parameters that control the range of values that are allowed
   40 #  for the powers.  The oprtions include:
   41 #
   42 #    minPower => m      only integer powers bigger than or equal
   43 #                       to m are allowed.  (If m is undef, then
   44 #                       there is no minimum power.)
   45 #
   46 #    maxPower => M      only integer powers less than or equal
   47 #                       to M are allowed.  (If M is undef, then
   48 #                       there is no maximum power.)
   49 #
   50 #    message => "text"  a description of the type of power
   51 #                       allowed (e.g., "positive integer constants");
   52 #
   53 #    checker => code    a reference to a subroutine that will be
   54 #                       used to check if the powers are acceptable.
   55 #                       It should accept a reference to the BOP::power
   56 #                       structure and return 1 or 0 depending on
   57 #                       whether the power is OK or not.
   58 #
   59 #  For example:
   60 #
   61 #    LimitedPowers::OnlyIntegers(
   62 #         minPower => -5, maxPower => 5,
   63 #         message => "integer constants between -5 and 5",
   64 #    );
   65 #
   66 #  would accept only powers between -5 and 5, while
   67 #
   68 #    LimitedPowers::OnlyIntegers(
   69 #      checker => sub {
   70 #        return 0 unless LimitedPowers::isInteger(@_);
   71 #        my $self = shift; my $p = shift; # the power as a constant
   72 #        return $p != 0 && $p != 1;
   73 #      },
   74 #      message => "integer constants other than 0 or 1",
   75 #    );
   76 #
   77 #  would accept any integer power other than 0 and 1.
   78 #
   79 ##########################################################
   80 
   81 =cut
   82 
   83 package LimitedPowers;
   84 
   85 sub NoBaseE {
   86   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   87   $context->operators->set(
   88     '^'  => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
   89     '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval', @_},
   90   );
   91 }
   92 
   93 sub OnlyIntegers {
   94   my $context = (Value::isContext($_[0]) ? shift : Value->context);
   95   $context->operators->set(
   96     '^'  => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants", @_},
   97     '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants",@_},
   98   );
   99 }
  100 
  101 sub OnlyNonNegativeIntegers {
  102   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  103   OnlyIntegers($context, minPower=>0, message=>"non-negative integer constants", @_);
  104 }
  105 
  106 sub OnlyPositiveIntegers {
  107   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  108   OnlyIntegers($context, minPower => 1, message => "positive integer constants", @_);
  109 }
  110 
  111 sub OnlyNonTrivialPositiveIntegers {
  112   my $context = (Value::isContext($_[0]) ? shift : Value->context);
  113   OnlyIntegers($context, minPower=>2, message=>"integer constants bigger than 1", @_);
  114 }
  115 
  116 #
  117 #  Test for whether the power is an integer in the specified range
  118 #
  119 sub isInteger {
  120   my $self = shift; my $n = shift;
  121   my $def = $self->{def};
  122   return 0 if defined($def->{minPower}) && $n < $def->{minPower};
  123   return 0 if defined($def->{maxPower}) && $n > $def->{maxPower};
  124   return Value::Real->make($n - int($n)) == 0;
  125 }
  126 
  127 #
  128 #  Legacy code to accommodate older approach to setting the operators
  129 #
  130 our @NoBaseE = (
  131   '^'  => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
  132   '**' => {class => 'LimitedPowers::NoBaseE', isCommand=>1, perl=>'LimitedPowers::NoBaseE->_eval'},
  133 );
  134 our @OnlyIntegers = (
  135   '^'  => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
  136   '**' => {class => 'LimitedPowers::OnlyIntegers', message => "integer constants"},
  137 );
  138 our @OnlyNonNegativeIntegers = (
  139   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
  140   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 0, message => "non-negative integer constants"},
  141 );
  142 our @OnlyPositiveIntegers = (
  143   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
  144   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 1, message => "positive integer constants"},
  145 );
  146 our @OnlyNonTrivialPositiveIntegers = (
  147   '^'  => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
  148   '**' => {class => 'LimitedPowers::OnlyIntegers', minPower => 2, message => "integer constants bigger than 1"},
  149 );
  150 
  151 
  152 ##################################################
  153 
  154 package LimitedPowers::NoBaseE;
  155 @ISA = qw(Parser::BOP::power);
  156 
  157 my $e = CORE::exp(1);
  158 
  159 sub _check {
  160   my $self = shift;
  161   $self->SUPER::_check(@_);
  162   $self->Error("Can't raise e to a power") if $self->{lop}->string eq 'e';
  163 }
  164 
  165 sub _eval {
  166   my $self = shift;
  167   Value::cmp_Message("Can't raise e to a power") if $_[0] - $e == 0;
  168   $self->SUPER::_eval(@_);
  169 }
  170 
  171 ##################################################
  172 
  173 package LimitedPowers::OnlyIntegers;
  174 @ISA = qw(Parser::BOP::power);
  175 
  176 sub _check {
  177   my $self = shift; my $p = $self->{rop}; my $def = $self->{def};
  178   my $checker = (defined($def->{checker}) ? $def->{checker} :  \&LimitedPowers::isInteger);
  179   $self->SUPER::_check(@_);
  180   $self->Error("Powers must be $def->{message}")
  181     if $p->type ne 'Number' || !$p->{isConstant} || !&{$checker}($self,$p->eval);
  182 }
  183 
  184 ##################################################
  185 
  186 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9