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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4664 - (view) (download) (as text)

1 : dpvc 4664 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