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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.5332  
changed lines
  Added in v.5350

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9