File Coverage

blib/lib/MarpaX/Languages/M4/Impl/Default/Eval.pm
Criterion Covered Total %
statement 963 1047 91.9
branch 313 704 44.4
condition 42 144 29.1
subroutine 69 74 93.2
pod n/a
total 1387 1969 70.4


line stmt bran cond sub pod time code
1 1     1   9 use Moops;
  1         3  
  1         9  
2              
3             # PODNAME: MarpaX::Languages::M4::Impl::Default::Eval
4              
5             # ABSTRACT: Eval Marpa actions
6              
7 1     1   3276 class MarpaX::Languages::M4::Impl::Default::Eval {
  1     1   44  
  1         9  
  1         3  
  1         83  
  1         6  
  1         3  
  1         9  
  1         289  
  1         2  
  1         22  
  1         62  
  1         2  
  1         45  
  1         5  
  1         2  
  1         89  
  1         50  
  1         8  
  1         3  
  1         9  
  1         5220  
  1         3  
  1         8  
  1         401  
  1         2  
  1         8  
  1         136  
  1         2  
  1         9  
  1         77  
  1         3  
  1         6  
  1         263  
  1         4  
  1         10  
  1         903  
  1         3  
  1         10  
  1         2268  
  1         4  
  1         4  
  1         2  
  1         28  
  1         5  
  1         2  
  1         47  
  1         5  
  1         2  
  1         98  
  1         5674  
  0         0  
8 1     1   5 use Bit::Vector;
  1         2  
  1         54  
9 1     1   6 use Types::Common::Numeric -all;
  1         2  
  1         8  
10 1     1   6233 use MarpaX::Languages::M4::Impl::Default::BaseConversion;
  1         3  
  1         12  
11              
12 1         13 our $VERSION = '0.018'; # VERSION
13              
14 1         2 our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY
15              
16             #
17             # Marpa dislike exceptions throws as objects, because of wanted
18             # backward compatibility with very old versions of Perl.
19             # So we will use Marpa::R2::Context::bail() method
20             #
21              
22             has bits => {
23             is => 'ro',
24             isa => PositiveInt,
25 168         14575 default => sub {$MarpaX::Languages::M4::Impl::Default::INTEGER_BITS}
26 1         3 };
27              
28             has SELF => {
29             is => 'ro',
30             isa => ConsumerOf ['MarpaX::Languages::M4::Role::Impl'],
31 168         40807 default => sub {$MarpaX::Languages::M4::Impl::Default::SELF}
32 1         890 };
33              
34 1 50 33 1   3494 method _eval (ConsumerOf['Bit::Vector'] $expression) {
  1 50   162   3  
  1 50       163  
  1 50       7  
  1 50       2  
  1 50       135  
  1         1326  
  162         7563  
  162         563  
  162         633  
  162         554  
  162         325  
  162         245  
  162         706  
  162         679  
  162         810  
  162         319  
35 162         368 return $expression;
36             }
37              
38 1 50   1   2232 method _invalidOp (Str $op) {
  1 50   2   4  
  1 50       221  
  1 50       10  
  1 50       3  
  1         165  
  1         187  
  2         94  
  2         10  
  2         7  
  2         7  
  2         3  
  2         9  
  2         3  
39 2         58 Marpa::R2::Context::bail( 'Invalid operator in '
40             . $self->SELF->impl_quote('eval') . ': '
41             . $self->SELF->impl_quote($op) );
42             }
43              
44 1 50 33 1   3789 method _noop (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   3  
  1 50       171  
  1 50       6  
  1 50       2  
  1 50       108  
  1 50       6  
  1 50       2  
  1 50       130  
  1         137  
  2         74  
  2         6  
  2         5  
  2         6  
  2         2  
  2         7  
  2         6  
  2         5  
  2         4  
  2         3  
  2         8  
  2         7  
  2         9  
  2         3  
45 2         5 return $expression;
46             }
47              
48 1 50 33 1   4057 method _lneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   3   2  
  1 50       153  
  1 50       9  
  1 50       3  
  1 50       106  
  1 50       6  
  1 50       1  
  1 50       204  
  1         138  
  3         135  
  3         11  
  3         11  
  3         11  
  3         6  
  3         10  
  3         12  
  3         10  
  3         7  
  3         6  
  3         15  
  3         16  
  3         17  
  3         5  
49 3         25 return Bit::Vector->new_Dec( $self->bits, $expression->is_empty() );
50             }
51              
52 1 50 33 1   8401 method _exp (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   4  
  1 50       268  
  1 50       9  
  1 50       4  
  1 50       280  
  1 50       10  
  1 50       4  
  1 50       158  
  1 50       8  
  1 50       3  
  1 50       522  
  1 50       134  
  21         1209  
  21         92  
  21         100  
  21         89  
  21         53  
  21         51  
  21         128  
  21         137  
  21         176  
  21         94  
  21         79  
  21         42  
  21         80  
  21         80  
  21         88  
  21         45  
  21         45  
  21         180  
  21         123  
  21         154  
  21         61  
53 21 100       189 if ( $expression2->to_Dec() < 0 ) {
54 1         36 Marpa::R2::Context::bail( 'Negative exponent in '
55             . $self->SELF->impl_quote('eval') . ': '
56             . $self->SELF->impl_quote( $expression1->to_Dec ) . ' '
57             . $self->SELF->impl_quote($op) . ' '
58             . $self->SELF->impl_quote( $expression2->to_Dec ) );
59             }
60              
61 20 100 100     165 if ( $expression1->to_Dec() == 0 && $expression2->to_Dec() == 0 ) {
62 1         51 Marpa::R2::Context::bail( 'Divide by zero in '
63             . $self->SELF->impl_quote('eval') . ': '
64             . $self->SELF->impl_quote( $expression1->to_Dec ) . ' '
65             . $self->SELF->impl_quote($op) . ' '
66             . $self->SELF->impl_quote( $expression2->to_Dec ) );
67             }
68              
69 19         73 my $s = $expression1->Shadow;
70 19         139 $s->Power( $expression1, $expression2 );
71 19         68 return $s;
72             }
73              
74 1 50 33 1   6087 method _neg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   13   3  
  1 50       262  
  1 50       9  
  1 50       4  
  1 50       180  
  1 50       9  
  1 50       2  
  1 50       231  
  1         138  
  13         678  
  13         40  
  13         44  
  13         39  
  13         26  
  13         41  
  13         47  
  13         42  
  13         19  
  13         22  
  13         65  
  13         68  
  13         76  
  13         28  
75 13         41 my $s = $expression->Shadow;
76 13         54 $s->Negate($expression);
77 13         29 return $s;
78             }
79              
80 1 50 33 1   5990 method _bneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   6  
  1 50       244  
  1 50       11  
  1 50       4  
  1 50       187  
  1 50       9  
  1 50       3  
  1 50       225  
  1         133  
  2         87  
  2         6  
  2         7  
  2         6  
  2         4  
  2         5  
  2         6  
  2         5  
  2         4  
  2         3  
  2         9  
  2         9  
  2         10  
  2         4  
81 2         6 my $s = $expression->Shadow;
82 2         9 $s->Complement($expression);
83 2         5 return $s;
84             }
85              
86 1 50 33 1   8342 method _mul (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 12   4  
  1 50       243  
  1 50       9  
  1 50       4  
  1 50       271  
  1 50       10  
  1 50       3  
  1 50       165  
  1 50       8  
  1 50       3  
  1 50       269  
  1 50       132  
  12         542  
  12         33  
  12         30  
  12         29  
  12         20  
  12         19  
  12         41  
  12         48  
  12         57  
  12         29  
  12         31  
  12         17  
  12         34  
  12         25  
  12         29  
  12         14  
  12         17  
  12         33  
  12         38  
  12         45  
  12         18  
87 12         37 my $s = $expression1->Shadow;
88 12         45 $s->Multiply( $expression1, $expression2 );
89 12         30 return $s;
90             }
91              
92 1 50 33 1   8373 method _div (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   5  
  1 50       266  
  1 50       9  
  1 50       3  
  1 50       289  
  1 50       10  
  1 50       3  
  1 50       202  
  1 50       9  
  1 50       4  
  1 50       326  
  1 50       149  
  5         285  
  5         20  
  5         19  
  5         19  
  5         12  
  5         9  
  5         33  
  5         36  
  5         41  
  5         26  
  5         20  
  5         17  
  5         23  
  5         26  
  5         18  
  5         11  
  5         10  
  5         33  
  5         28  
  5         34  
  5         13  
93 5         21 my $s = $expression1->Shadow;
94             try {
95 5     5   287 $s->Divide( $expression1, $expression2, $expression1->Shadow );
96             }
97             catch {
98 2     2   45 $s = undef;
99 5         37 };
100 5         67 return $s;
101             }
102              
103 1 50 33 1   8408 method _mod (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   4  
  1 50       270  
  1 50       10  
  1 50       3  
  1 50       267  
  1 50       11  
  1 50       3  
  1 50       163  
  1 50       8  
  1 50       4  
  1 50       347  
  1 50       154  
  5         274  
  5         19  
  5         18  
  5         19  
  5         59  
  5         13  
  5         30  
  5         34  
  5         42  
  5         24  
  5         28  
  5         12  
  5         22  
  5         23  
  5         20  
  5         11  
  5         14  
  5         28  
  5         25  
  5         31  
  5         14  
104 5         24 my $s = $expression1->Shadow;
105             try {
106 5     5   286 $expression1->Shadow->Divide( $expression1, $expression2, $s );
107             }
108             catch {
109 2     2   60 $s = undef;
110 5         45 };
111 5         59 return $s;
112             }
113              
114 1 50 33 1   5450 method _add (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 82   3  
  1 50       148  
  1 50       6  
  1 50       2  
  1 50       156  
  1 50       6  
  1 50       2  
  1 50       118  
  1 50       5  
  1 50       2  
  1 50       153  
  1 50       136  
  82         3897  
  82         295  
  82         278  
  82         240  
  82         133  
  82         125  
  82         359  
  82         454  
  82         522  
  82         262  
  82         249  
  82         152  
  82         247  
  82         249  
  82         258  
  82         129  
  82         150  
  82         301  
  82         296  
  82         469  
  82         156  
115 82         287 my $s = $expression1->Shadow;
116 82         400 $s->add( $expression1, $expression2, 0 );
117 82         251 return $s;
118             }
119              
120 1 50 33 1   4515 method _sub (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   2  
  1 50       141  
  1 50       6  
  1 50       2  
  1 50       147  
  1 50       6  
  1 50       1  
  1 50       96  
  1 50       5  
  1 50       2  
  1 50       142  
  1 50       136  
  21         984  
  21         79  
  21         69  
  21         66  
  21         34  
  21         45  
  21         107  
  21         122  
  21         174  
  21         78  
  21         76  
  21         40  
  21         75  
  21         55  
  21         57  
  21         37  
  21         27  
  21         77  
  21         81  
  21         101  
  21         33  
121 21         61 my $s = $expression1->Shadow;
122 21         83 $s->subtract( $expression1, $expression2, 0 );
123 21         66 return $s;
124             }
125              
126             # From GNU M4 source code:
127             # Minimize undefined C behavior (shifting by a negative number,
128             # shifting by the width or greater, left shift overflow, or
129             # right shift of a negative number). Implement Java 32-bit
130             # wrap-around semantics. This code assumes that the
131             # implementation-defined overflow when casting unsigned to
132             # a signed is a silent twos-complement wrap-around. */
133 1 50 33 1   4297 method _left (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       144  
  1 50       6  
  1 50       2  
  1 50       149  
  1 50       6  
  1 50       2  
  1 50       93  
  1 50       6  
  1 50       2  
  1 50       135  
  1 50       144  
  1         45  
  1         4  
  1         4  
  1         5  
  1         3  
  1         2  
  1         6  
  1         6  
  1         7  
  1         4  
  1         3  
  1         2  
  1         4  
  1         3  
  1         4  
  1         3  
  1         3  
  1         4  
  1         9  
  1         7  
  1         2  
134 1         12 $expression1->Insert( 0, $expression2->to_Dec() % $self->bits );
135 1         3 return $expression1;
136             }
137              
138 1 50 33 1   4331 method _right (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       135  
  1 50       6  
  1 50       2  
  1 50       149  
  1 50       5  
  1 50       2  
  1 50       87  
  1 50       5  
  1 50       2  
  1 50       195  
  1 50       137  
  2         93  
  2         7  
  2         7  
  2         8  
  2         5  
  2         4  
  2         10  
  2         12  
  2         13  
  2         8  
  2         7  
  2         4  
  2         7  
  2         8  
  2         9  
  2         4  
  2         2  
  2         10  
  2         9  
  2         11  
  2         4  
139 2         9 my $u1 = $expression1->Clone;
140 2 50       8 if ( $expression1->Sign < 0 ) {
141 2         8 $u1->Complement($u1);
142             }
143 2         21 $u1->Delete( 0, $expression2->to_Dec() % $self->bits );
144 2 50       8 if ( $expression1->Sign < 0 ) {
145 2         6 $u1->Complement($u1);
146             }
147 2         8 return $u1;
148             }
149              
150 1 50 33 1   4242 method _gt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 13   2  
  1 50       147  
  1 50       6  
  1 50       2  
  1 50       142  
  1 50       6  
  1 50       2  
  1 50       87  
  1 50       5  
  1 50       2  
  1 50       153  
  1 50       169  
  13         611  
  13         48  
  13         50  
  13         48  
  13         19  
  13         30  
  13         61  
  13         82  
  13         87  
  13         46  
  13         38  
  13         21  
  13         45  
  13         37  
  13         41  
  13         27  
  13         29  
  13         53  
  13         53  
  13         70  
  13         27  
151 13 100       128 return Bit::Vector->new_Dec( $self->bits,
152             ( $expression1->Compare($expression2) > 0 ) ? 1 : 0 );
153             }
154              
155 1 50 33 1   4185 method _ge (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       123  
  1 50       6  
  1 50       1  
  1 50       172  
  1 50       6  
  1 50       93  
  1 50       96  
  1 50       6  
  1 50       2  
  1 50       143  
  1 50       145  
  1         47  
  1         5  
  1         5  
  1         4  
  1         2  
  1         4  
  1         5  
  1         7  
  1         7  
  1         5  
  1         5  
  1         2  
  1         5  
  1         4  
  1         3  
  1         2  
  1         2  
  1         6  
  1         5  
  1         6  
  1         2  
156 1 50       12 return Bit::Vector->new_Dec( $self->bits,
157             ( $expression1->Compare($expression2) >= 0 ) ? 1 : 0 );
158             }
159              
160 1 50 33 1   4161 method _lt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       126  
  1 50       6  
  1 50       2  
  1 50       150  
  1 50       6  
  1 50       2  
  1 50       91  
  1 50       6  
  1 50       2  
  1 50       136  
  1 50       135  
  1         47  
  1         5  
  1         4  
  1         7  
  1         3  
  1         3  
  1         9  
  1         9  
  1         12  
  1         7  
  1         7  
  1         3  
  1         6  
  1         8  
  1         6  
  1         4  
  1         2  
  1         8  
  1         9  
  1         7  
  1         2  
161 1 50       15 return Bit::Vector->new_Dec( $self->bits,
162             ( $expression1->Compare($expression2) < 0 ) ? 1 : 0 );
163             }
164              
165 1 0 0 1   4183 method _le (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       120  
  1 0       64  
  1 0       3  
  1 0       150  
  1 0       6  
  1 0       2  
  1 0       86  
  1 0       9  
  1 0       2  
  1 0       138  
  1 0       135  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
166 0 0       0 return Bit::Vector->new_Dec( $self->bits,
167             ( $expression1->Compare($expression2) <= 0 ) ? 1 : 0 );
168             }
169              
170 1 50 33 1   4158 method _eq (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 3   2  
  1 50       123  
  1 50       5  
  1 50       2  
  1 50       152  
  1 50       5  
  1 50       2  
  1 50       87  
  1 50       5  
  1 50       1  
  1 50       140  
  1 50       134  
  3         93  
  3         11  
  3         13  
  3         12  
  3         8  
  3         7  
  3         20  
  3         21  
  3         22  
  3         14  
  3         13  
  3         7  
  3         15  
  3         10  
  3         10  
  3         4  
  3         7  
  3         14  
  3         15  
  3         18  
  3         7  
171 3 100       31 return Bit::Vector->new_Dec( $self->bits,
172             ( $expression1->Compare($expression2) == 0 ) ? 1 : 0 );
173             }
174              
175 1 50 33 1   4191 method _eq2 (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       121  
  1 50       5  
  1 50       2  
  1 50       145  
  1 50       5  
  1 50       2  
  1 50       94  
  1 50       5  
  1 50       2  
  1 50       140  
  1 50       134  
  1         51  
  1         6  
  1         4  
  1         5  
  1         3  
  1         2  
  1         8  
  1         7  
  1         8  
  1         5  
  1         4  
  1         3  
  1         5  
  1         3  
  1         5  
  1         2  
  1         3  
  1         6  
  1         5  
  1         6  
  1         2  
176 1         32 $self->SELF->logger_warn('Warning: recommend == instead of =');
177 1         6 return $self->_eq( $expression1, $op, $expression2 );
178             }
179              
180 1 0 0 1   4161 method _ne (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       122  
  1 0       6  
  1 0       1  
  1 0       144  
  1 0       5  
  1 0       2  
  1 0       112  
  1 0       6  
  1 0       2  
  1 0       170  
  1 0       139  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
181 0 0       0 return Bit::Vector->new_Dec( $self->bits,
182             ( $expression1->Compare($expression2) != 0 ) ? 1 : 0 );
183             }
184              
185 1 0 0 1   4186 method _band (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       123  
  1 0       5  
  1 0       3  
  1 0       146  
  1 0       6  
  1 0       1  
  1 0       87  
  1 0       5  
  1 0       2  
  1 0       145  
  1 0       135  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
186 0         0 my $s = $expression1->Shadow;
187 0         0 $s->Intersection( $expression1, $expression2 );
188 0         0 return $s;
189             }
190              
191 1 50 33 1   4195 method _bxor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       118  
  1 50       6  
  1 50       2  
  1 50       144  
  1 50       6  
  1 50       2  
  1 50       86  
  1 50       5  
  1 50       2  
  1 50       138  
  1 50       133  
  2         124  
  2         12  
  2         10  
  2         9  
  2         6  
  2         3  
  2         10  
  2         15  
  2         17  
  2         10  
  2         9  
  2         4  
  2         8  
  2         9  
  2         8  
  2         5  
  2         6  
  2         11  
  2         12  
  2         14  
  2         5  
192 2         10 my $s = $expression1->Shadow;
193 2         13 $s->ExclusiveOr( $expression1, $expression2 );
194 2         9 return $s;
195             }
196              
197 1 50 33 1   4177 method _bor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   8  
  1 50       132  
  1 50       6  
  1 50       2  
  1 50       148  
  1 50       5  
  1 50       2  
  1 50       85  
  1 50       6  
  1 50       1  
  1 50       143  
  1 50       134  
  2         121  
  2         8  
  2         9  
  2         9  
  2         5  
  2         4  
  2         11  
  2         15  
  2         15  
  2         10  
  2         9  
  2         5  
  2         10  
  2         9  
  2         8  
  2         4  
  2         5  
  2         13  
  2         9  
  2         17  
  2         5  
198 2         11 my $s = $expression1->Shadow;
199 2         12 $s->Union( $expression1, $expression2 );
200 2         6 return $s;
201             }
202             #
203             # M4 is short-circuiting valid syntax in case of '||' and '&&', so that things like
204             # 2 || 1 / 0 will not produce a fatal error. To produce such a behaviour
205             # only '||' or '&&' specific actions will be able to handle eventual undef value from
206             # prior actions
207             #
208 1 50 33 1   5058 method _land (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   1  
  1 50       122  
  1 50       6  
  1 50       2  
  1 50       148  
  1 50       6  
  1 50       2  
  1 50       87  
  1 50       6  
  1 50       2  
  1 50       251  
  1         133  
  2         222  
  2         13  
  2         10  
  2         11  
  2         4  
  2         5  
  2         14  
  2         16  
  2         23  
  2         14  
  2         10  
  2         6  
  2         11  
  2         9  
  2         11  
  2         5  
  2         14  
  2         4  
209 2         7 my $rc;
210 2 50       11 if ( !Undef->check($expression2) ) {
    100          
211 0 0 0     0 $rc = Bit::Vector->new_Dec( $self->bits,
212             ( !$expression1->is_empty() && !$expression2->is_empty() )
213             ? 1
214             : 0 );
215             }
216             elsif ( $expression1->is_empty() ) {
217             #
218             # Already zero
219             #
220 1         28 $rc = $expression1;
221             }
222             else {
223 1         81 Marpa::R2::Context::bail( 'Undefined right-hand expression in '
224             . $self->SELF->impl_quote('eval') . ': '
225             . $self->SELF->impl_quote( $expression1->to_Dec )
226             . ' '
227             . $self->SELF->impl_quote($op) );
228             }
229 1         7 return $rc;
230             }
231              
232 1 50 33 1   4790 method _lor (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       122  
  1 50       5  
  1 50       2  
  1 50       168  
  1 50       6  
  1 50       2  
  1 50       85  
  1 50       5  
  1 50       2  
  1 50       254  
  1         154  
  2         127  
  2         10  
  2         7  
  2         9  
  2         4  
  2         5  
  2         17  
  2         13  
  2         16  
  2         10  
  2         10  
  2         4  
  2         10  
  2         9  
  2         8  
  2         4  
  2         10  
  2         5  
233 2         5 my $rc;
234 2 50       11 if ( !Undef->check($expression2) ) {
    100          
235 0 0 0     0 $rc = Bit::Vector->new_Dec( $self->bits,
236             ( !$expression1->is_empty() || !$expression2->is_empty() )
237             ? 1
238             : 0 );
239             }
240             elsif ( !$expression1->is_empty() ) {
241 1         25 $rc = Bit::Vector->new_Dec( $self->bits, 1 );
242             }
243             else {
244 1         73 Marpa::R2::Context::bail( 'Undefined right-hand expression in '
245             . $self->SELF->impl_quote('eval') . ': '
246             . $self->SELF->impl_quote( $expression1->to_Dec )
247             . ' '
248             . $self->SELF->impl_quote($op) );
249             }
250 1         3 return $rc;
251             }
252             #
253             # Raw inputs are not allowed to fail. That's why we always subcall the _radix method
254             # whose implementation will use Bit::Vector::Multiply -> this will detect any
255             # overflow
256             #
257 1 50   1   1687 method _decimal (Str $lexeme) {
  1 50   339   3  
  1 50       120  
  1 50       6  
  1 50       1  
  1         82  
  1         144  
  339         377159  
  339         952  
  339         1184  
  339         940  
  339         506  
  339         973  
  339         569  
258             #
259             # decimalNumber ~ _DECDIGITS
260             #
261 339         1590 return $self->_radix("0r10:$lexeme");
262             }
263              
264 1 0   1   1698 method _octal (Str $lexeme) {
  1 0   0   2  
  1 0       123  
  1 0       5  
  1 0       2  
  1         87  
  1         159  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
265             #
266             # octalNumber ~ '0' _OCTDIGITS
267             #
268 0         0 substr( $lexeme, 0, 1, '' );
269 0         0 return $self->_radix("0r8:$lexeme");
270             }
271              
272 1 50   1   1644 method _hex (Str $lexeme) {
  1 50   2   2  
  1 50       116  
  1 50       6  
  1 50       2  
  1         85  
  1         143  
  2         4272  
  2         8  
  2         11  
  2         7  
  2         5  
  2         9  
  2         3  
273             #
274             # hexaNumber ~ '0x' _HEXDIGITS
275             #
276 2         12 substr( $lexeme, 0, 2, '' );
277 2         12 return $self->_radix("0r16:$lexeme");
278             }
279              
280 1 50   1   1715 method _binary (Str $lexeme) {
  1 50   1   2  
  1 50       120  
  1 50       5  
  1 50       1  
  1         89  
  1         155  
  1         52  
  1         4  
  1         5  
  1         4  
  1         2  
  1         5  
  1         2  
281             #
282             # binaryNumber ~ '0b' _BINDIGITS
283             #
284 1         5 substr( $lexeme, 0, 2, '' );
285 1         5 return $self->_radix( $lexeme, true );
286             }
287              
288 1 50   1   2807 method _radix (Str $lexeme, Bool $binary?) {
  1 50   344   2  
  1 50       139  
  1 50       6  
  1 50       2  
  1 50       101  
  1 100       6  
  1 50       2  
  1 100       385  
  1         141  
  344         3074  
  344         784  
  344         802  
  344         984  
  344         848  
  344         586  
  344         1018  
  344         1030  
  344         859  
  1         2  
  1         4  
  344         547  
289             #
290             # Per def it is this regexp
291             # C.f. grammar
292             #
293 344         550 my $radix;
294 344         630 my $input = $lexeme;
295 344 100       890 if ( !$binary ) {
296 343         2239 $lexeme =~ /0r([\d]+):([\da-zA-Z]+)/;
297 343         2044 $radix = substr( $lexeme, $-[1], $+[1] - $-[1] );
298 343         1339 $input = substr( $lexeme, $-[2], $+[2] - $-[2] );
299             }
300 344         1488 my $error = false;
301 344         1358 my $errorString = '';
302 344         592 my $rc;
303             try {
304 344     344   17011 $rc = MarpaX::Languages::M4::Impl::Default::BaseConversion
305             ->bitvector_fr_base( $self->bits, $radix, $input, $binary );
306             }
307             catch {
308 0     0   0 $error = true;
309 0         0 $errorString = "$_";
310 0         0 return;
311 344         2480 };
312 344 50       5353 if ($error) {
313 0         0 Marpa::R2::Context::bail( 'Cannot create number '
314             . $self->SELF->impl_quote($input)
315             . ' writen in base '
316             . $self->SELF->impl_quote($radix)
317             . ' using a bit vector of size '
318             . $self->SELF->impl_quote( $self->bits ) . ' : '
319             . $errorString );
320             }
321 344         1253 return $rc;
322             }
323              
324             }
325              
326             1;
327              
328             __END__
329              
330             =pod
331              
332             =encoding UTF-8
333              
334             =head1 NAME
335              
336             MarpaX::Languages::M4::Impl::Default::Eval - Eval Marpa actions
337              
338             =head1 VERSION
339              
340             version 0.018
341              
342             =head1 AUTHOR
343              
344             Jean-Damien Durand <jeandamiendurand@free.fr>
345              
346             =head1 COPYRIGHT AND LICENSE
347              
348             This software is copyright (c) 2015 by Jean-Damien Durand.
349              
350             This is free software; you can redistribute it and/or modify it under
351             the same terms as the Perl 5 programming language system itself.
352              
353             =cut