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   6 use Moops;
  1         2  
  1         7  
2              
3             # PODNAME: MarpaX::Languages::M4::Impl::Default::Eval
4              
5             # ABSTRACT: Eval Marpa actions
6              
7 1     1   2920 class MarpaX::Languages::M4::Impl::Default::Eval {
  1     1   29  
  1         5  
  1         2  
  1         63  
  1         6  
  1         2  
  1         8  
  1         304  
  1         2  
  1         23  
  1         63  
  1         2  
  1         45  
  1         5  
  1         2  
  1         83  
  1         31  
  1         5  
  1         2  
  1         6  
  1         4557  
  1         2  
  1         8  
  1         397  
  1         2  
  1         8  
  1         139  
  1         2  
  1         8  
  1         73  
  1         3  
  1         6  
  1         207  
  1         2  
  1         7  
  1         835  
  1         2  
  1         7  
  1         1866  
  1         4  
  1         5  
  1         6  
  1         24  
  1         5  
  1         2  
  1         44  
  1         5  
  1         2  
  1         93  
  1         5838  
  0         0  
8 1     1   5 use Bit::Vector;
  1         2  
  1         50  
9 1     1   9 use Types::Common::Numeric -all;
  1         2  
  1         8  
10 1     1   5436 use MarpaX::Languages::M4::Impl::Default::BaseConversion;
  1         2  
  1         11  
11              
12 1         14 our $VERSION = '0.020'; # VERSION
13              
14 1         4 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         15880 default => sub {$MarpaX::Languages::M4::Impl::Default::INTEGER_BITS}
26 1         4 };
27              
28             has SELF => {
29             is => 'ro',
30             isa => ConsumerOf ['MarpaX::Languages::M4::Role::Impl'],
31 168         41898 default => sub {$MarpaX::Languages::M4::Impl::Default::SELF}
32 1         952 };
33              
34 1 50 33 1   2906 method _eval (ConsumerOf['Bit::Vector'] $expression) {
  1 50   162   2  
  1 50       157  
  1 50       6  
  1 50       2  
  1 50       135  
  1         1455  
  162         7658  
  162         702  
  162         668  
  162         659  
  162         338  
  162         261  
  162         864  
  162         784  
  162         1036  
  162         375  
35 162         510 return $expression;
36             }
37              
38 1 50   1   1783 method _invalidOp (Str $op) {
  1 50   2   2  
  1 50       127  
  1 50       7  
  1 50       2  
  1         98  
  1         220  
  2         105  
  2         12  
  2         11  
  2         12  
  2         6  
  2         11  
  2         5  
39 2         83 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   3078 method _noop (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   3  
  1 50       185  
  1 50       7  
  1 50       1  
  1 50       109  
  1 50       5  
  1 50       2  
  1 50       124  
  1         140  
  2         109  
  2         10  
  2         13  
  2         8  
  2         5  
  2         11  
  2         11  
  2         10  
  2         5  
  2         5  
  2         15  
  2         12  
  2         13  
  2         5  
45 2         6 return $expression;
46             }
47              
48 1 50 33 1   3009 method _lneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   3   1  
  1 50       136  
  1 50       6  
  1 50       2  
  1 50       104  
  1 50       5  
  1 50       2  
  1 50       131  
  1         137  
  3         143  
  3         15  
  3         14  
  3         14  
  3         7  
  3         14  
  3         11  
  3         11  
  3         7  
  3         10  
  3         18  
  3         17  
  3         22  
  3         7  
49 3         32 return Bit::Vector->new_Dec( $self->bits, $expression->is_empty() );
50             }
51              
52 1 50 33 1   4576 method _exp (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   3  
  1 50       153  
  1 50       6  
  1 50       2  
  1 50       157  
  1 50       6  
  1 50       3  
  1 50       95  
  1 50       5  
  1 50       2  
  1 50       285  
  1 50       139  
  21         1079  
  21         103  
  21         117  
  21         130  
  21         53  
  21         69  
  21         152  
  21         160  
  21         194  
  21         115  
  21         96  
  21         52  
  21         109  
  21         84  
  21         115  
  21         47  
  21         58  
  21         143  
  21         141  
  21         136  
  21         55  
53 21 100       184 if ( $expression2->to_Dec() < 0 ) {
54 1         66 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     145 if ( $expression1->to_Dec() == 0 && $expression2->to_Dec() == 0 ) {
62 1         56 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         83 my $s = $expression1->Shadow;
70 19         163 $s->Power( $expression1, $expression2 );
71 19         56 return $s;
72             }
73              
74 1 50 33 1   3346 method _neg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   13   2  
  1 50       140  
  1 50       7  
  1 50       2  
  1 50       107  
  1 50       6  
  1 50       2  
  1 50       141  
  1         162  
  13         749  
  13         70  
  13         59  
  13         48  
  13         25  
  13         57  
  13         48  
  13         58  
  13         29  
  13         25  
  13         88  
  13         95  
  13         101  
  13         31  
75 13         51 my $s = $expression->Shadow;
76 13         68 $s->Negate($expression);
77 13         39 return $s;
78             }
79              
80 1 50 33 1   3187 method _bneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   2  
  1 50       167  
  1 50       6  
  1 50       2  
  1 50       103  
  1 50       7  
  1 50       5  
  1 50       136  
  1         142  
  2         91  
  2         9  
  2         6  
  2         7  
  2         3  
  2         8  
  2         7  
  2         7  
  2         3  
  2         3  
  2         12  
  2         11  
  2         14  
  2         3  
81 2         6 my $s = $expression->Shadow;
82 2         9 $s->Complement($expression);
83 2         7 return $s;
84             }
85              
86 1 50 33 1   4458 method _mul (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 12   3  
  1 50       151  
  1 50       6  
  1 50       2  
  1 50       152  
  1 50       5  
  1 50       3  
  1 50       96  
  1 50       6  
  1 50       2  
  1 50       167  
  1 50       137  
  12         530  
  12         35  
  12         36  
  12         34  
  12         21  
  12         15  
  12         54  
  12         46  
  12         65  
  12         40  
  12         36  
  12         21  
  12         39  
  12         36  
  12         30  
  12         21  
  12         18  
  12         50  
  12         33  
  12         47  
  12         25  
87 12         43 my $s = $expression1->Shadow;
88 12         51 $s->Multiply( $expression1, $expression2 );
89 12         27 return $s;
90             }
91              
92 1 50 33 1   4559 method _div (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   3  
  1 50       149  
  1 50       6  
  1 50       2  
  1 50       153  
  1 50       5  
  1 50       2  
  1 50       86  
  1 50       5  
  1 50       2  
  1 50       260  
  1 50       139  
  5         251  
  5         22  
  5         26  
  5         29  
  5         14  
  5         17  
  5         36  
  5         39  
  5         50  
  5         31  
  5         31  
  5         12  
  5         22  
  5         29  
  5         23  
  5         10  
  5         13  
  5         33  
  5         26  
  5         34  
  5         12  
93 5         25 my $s = $expression1->Shadow;
94             try {
95 5     5   245 $s->Divide( $expression1, $expression2, $expression1->Shadow );
96             }
97             catch {
98 2     2   39 $s = undef;
99 5         42 };
100 5         62 return $s;
101             }
102              
103 1 50 33 1   4820 method _mod (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   4  
  1 50       156  
  1 50       7  
  1 50       2  
  1 50       156  
  1 50       5  
  1 50       3  
  1 50       95  
  1 50       6  
  1 50       1  
  1 50       245  
  1 50       138  
  5         228  
  5         25  
  5         25  
  5         23  
  5         13  
  5         7  
  5         31  
  5         31  
  5         42  
  5         22  
  5         24  
  5         9  
  5         29  
  5         20  
  5         26  
  5         10  
  5         11  
  5         28  
  5         26  
  5         34  
  5         10  
104 5         20 my $s = $expression1->Shadow;
105             try {
106 5     5   261 $expression1->Shadow->Divide( $expression1, $expression2, $s );
107             }
108             catch {
109 2     2   40 $s = undef;
110 5         34 };
111 5         54 return $s;
112             }
113              
114 1 50 33 1   4509 method _add (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 82   3  
  1 50       169  
  1 50       6  
  1 50       2  
  1 50       152  
  1 50       6  
  1 50       3  
  1 50       87  
  1 50       5  
  1 50       2  
  1 50       154  
  1 50       140  
  82         4001  
  82         402  
  82         303  
  82         310  
  82         152  
  82         192  
  82         465  
  82         468  
  82         667  
  82         409  
  82         261  
  82         139  
  82         279  
  82         292  
  82         336  
  82         193  
  82         133  
  82         385  
  82         322  
  82         432  
  82         230  
115 82         347 my $s = $expression1->Shadow;
116 82         340 $s->add( $expression1, $expression2, 0 );
117 82         256 return $s;
118             }
119              
120 1 50 33 1   4398 method _sub (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   2  
  1 50       146  
  1 50       5  
  1 50       3  
  1 50       147  
  1 50       5  
  1 50       2  
  1 50       86  
  1 50       6  
  1 50       6  
  1 50       158  
  1 50       138  
  21         1398  
  21         89  
  21         91  
  21         101  
  21         44  
  21         57  
  21         135  
  21         150  
  21         169  
  21         99  
  21         94  
  21         45  
  21         109  
  21         92  
  21         86  
  21         48  
  21         46  
  21         127  
  21         106  
  21         114  
  21         62  
121 21         97 my $s = $expression1->Shadow;
122 21         152 $s->subtract( $expression1, $expression2, 0 );
123 21         58 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   4501 method _left (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   3  
  1 50       130  
  1 50       6  
  1 50       2  
  1 50       156  
  1 50       6  
  1 50       1  
  1 50       93  
  1 50       5  
  1 50       3  
  1 50       148  
  1 50       141  
  1         49  
  1         5  
  1         6  
  1         4  
  1         3  
  1         3  
  1         14  
  1         9  
  1         10  
  1         5  
  1         6  
  1         3  
  1         5  
  1         5  
  1         6  
  1         3  
  1         2  
  1         7  
  1         5  
  1         8  
  1         3  
134 1         15 $expression1->Insert( 0, $expression2->to_Dec() % $self->bits );
135 1         3 return $expression1;
136             }
137              
138 1 50 33 1   4418 method _right (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       144  
  1 50       6  
  1 50       2  
  1 50       192  
  1 50       7  
  1 50       2  
  1 50       97  
  1 50       7  
  1 50       2  
  1 50       200  
  1 50       139  
  2         95  
  2         9  
  2         12  
  2         9  
  2         4  
  2         5  
  2         13  
  2         14  
  2         16  
  2         11  
  2         7  
  2         3  
  2         9  
  2         7  
  2         11  
  2         5  
  2         4  
  2         12  
  2         10  
  2         13  
  2         5  
139 2         11 my $u1 = $expression1->Clone;
140 2 50       15 if ( $expression1->Sign < 0 ) {
141 2         11 $u1->Complement($u1);
142             }
143 2         24 $u1->Delete( 0, $expression2->to_Dec() % $self->bits );
144 2 50       13 if ( $expression1->Sign < 0 ) {
145 2         7 $u1->Complement($u1);
146             }
147 2         6 return $u1;
148             }
149              
150 1 50 33 1   4428 method _gt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 13   3  
  1 50       135  
  1 50       6  
  1 50       2  
  1 50       164  
  1 50       5  
  1 50       2  
  1 50       89  
  1 50       6  
  1 50       2  
  1 50       158  
  1 50       139  
  13         602  
  13         63  
  13         69  
  13         64  
  13         32  
  13         28  
  13         86  
  13         105  
  13         123  
  13         84  
  13         71  
  13         29  
  13         68  
  13         59  
  13         55  
  13         29  
  13         37  
  13         72  
  13         74  
  13         101  
  13         30  
151 13 100       174 return Bit::Vector->new_Dec( $self->bits,
152             ( $expression1->Compare($expression2) > 0 ) ? 1 : 0 );
153             }
154              
155 1 50 33 1   4259 method _ge (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       151  
  1 50       6  
  1 50       2  
  1 50       154  
  1 50       6  
  1 50       101  
  1 50       98  
  1 50       6  
  1 50       2  
  1 50       141  
  1 50       150  
  1         48  
  1         5  
  1         6  
  1         5  
  1         3  
  1         3  
  1         7  
  1         8  
  1         10  
  1         6  
  1         5  
  1         2  
  1         6  
  1         5  
  1         5  
  1         2  
  1         2  
  1         6  
  1         6  
  1         7  
  1         3  
156 1 50       16 return Bit::Vector->new_Dec( $self->bits,
157             ( $expression1->Compare($expression2) >= 0 ) ? 1 : 0 );
158             }
159              
160 1 50 33 1   4344 method _lt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       129  
  1 50       6  
  1 50       2  
  1 50       168  
  1 50       5  
  1 50       2  
  1 50       90  
  1 50       5  
  1 50       3  
  1 50       150  
  1 50       142  
  1         49  
  1         6  
  1         5  
  1         5  
  1         3  
  1         2  
  1         9  
  1         7  
  1         11  
  1         5  
  1         6  
  1         2  
  1         6  
  1         4  
  1         5  
  1         3  
  1         3  
  1         6  
  1         7  
  1         7  
  1         27  
161 1 50       17 return Bit::Vector->new_Dec( $self->bits,
162             ( $expression1->Compare($expression2) < 0 ) ? 1 : 0 );
163             }
164              
165 1 0 0 1   4434 method _le (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       134  
  1 0       103  
  1 0       3  
  1 0       190  
  1 0       6  
  1 0       3  
  1 0       95  
  1 0       6  
  1 0       2  
  1 0       151  
  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  
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   4326 method _eq (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 3   2  
  1 50       136  
  1 50       6  
  1 50       2  
  1 50       144  
  1 50       6  
  1 50       2  
  1 50       84  
  1 50       5  
  1 50       17  
  1 50       155  
  1 50       139  
  3         96  
  3         15  
  3         13  
  3         14  
  3         6  
  3         7  
  3         21  
  3         20  
  3         26  
  3         15  
  3         13  
  3         6  
  3         15  
  3         13  
  3         13  
  3         7  
  3         7  
  3         20  
  3         20  
  3         20  
  3         7  
171 3 100       35 return Bit::Vector->new_Dec( $self->bits,
172             ( $expression1->Compare($expression2) == 0 ) ? 1 : 0 );
173             }
174              
175 1 50 33 1   4315 method _eq2 (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       134  
  1 50       6  
  1 50       2  
  1 50       163  
  1 50       6  
  1 50       2  
  1 50       95  
  1 50       5  
  1 50       2  
  1 50       145  
  1 50       137  
  1         52  
  1         6  
  1         6  
  1         5  
  1         3  
  1         3  
  1         9  
  1         8  
  1         10  
  1         6  
  1         5  
  1         4  
  1         7  
  1         5  
  1         5  
  1         3  
  1         3  
  1         8  
  1         6  
  1         7  
  1         3  
176 1         39 $self->SELF->logger_warn('Warning: recommend == instead of =');
177 1         7 return $self->_eq( $expression1, $op, $expression2 );
178             }
179              
180 1 0 0 1   4409 method _ne (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       139  
  1 0       6  
  1 0       2  
  1 0       150  
  1 0       5  
  1 0       2  
  1 0       87  
  1 0       5  
  1 0       2  
  1 0       167  
  1 0       140  
  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   4349 method _band (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       131  
  1 0       6  
  1 0       2  
  1 0       151  
  1 0       5  
  1 0       2  
  1 0       98  
  1 0       6  
  1 0       2  
  1 0       149  
  1 0       194  
  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   4391 method _bxor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   3  
  1 50       131  
  1 50       6  
  1 50       5  
  1 50       147  
  1 50       6  
  1 50       2  
  1 50       90  
  1 50       6  
  1 50       2  
  1 50       146  
  1 50       147  
  2         93  
  2         8  
  2         10  
  2         11  
  2         4  
  2         4  
  2         15  
  2         14  
  2         19  
  2         11  
  2         10  
  2         6  
  2         11  
  2         11  
  2         10  
  2         5  
  2         5  
  2         14  
  2         13  
  2         15  
  2         6  
192 2         10 my $s = $expression1->Shadow;
193 2         11 $s->ExclusiveOr( $expression1, $expression2 );
194 2         8 return $s;
195             }
196              
197 1 50 33 1   4334 method _bor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       151  
  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       171  
  1 50       141  
  2         92  
  2         9  
  2         12  
  2         9  
  2         4  
  2         4  
  2         15  
  2         15  
  2         20  
  2         10  
  2         9  
  2         3  
  2         9  
  2         11  
  2         7  
  2         5  
  2         6  
  2         12  
  2         10  
  2         15  
  2         5  
198 2         13 my $s = $expression1->Shadow;
199 2         16 $s->Union( $expression1, $expression2 );
200 2         9 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   5000 method _land (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       160  
  1 50       6  
  1 50       1  
  1 50       153  
  1 50       5  
  1 50       2  
  1 50       93  
  1 50       5  
  1 50       5  
  1 50       255  
  1         139  
  2         96  
  2         9  
  2         9  
  2         11  
  2         4  
  2         5  
  2         13  
  2         13  
  2         13  
  2         11  
  2         10  
  2         5  
  2         9  
  2         8  
  2         9  
  2         6  
  2         11  
  2         6  
209 2         5 my $rc;
210 2 50       9 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         26 $rc = $expression1;
221             }
222             else {
223 1         61 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         4 return $rc;
230             }
231              
232 1 50 33 1   5016 method _lor (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   3  
  1 50       136  
  1 50       6  
  1 50       2  
  1 50       168  
  1 50       6  
  1 50       1  
  1 50       94  
  1 50       6  
  1 50       2  
  1 50       260  
  1         139  
  2         94  
  2         9  
  2         10  
  2         12  
  2         5  
  2         6  
  2         13  
  2         42  
  2         14  
  2         12  
  2         10  
  2         4  
  2         10  
  2         10  
  2         9  
  2         6  
  2         12  
  2         6  
233 2         7 my $rc;
234 2 50       8 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         30 $rc = Bit::Vector->new_Dec( $self->bits, 1 );
242             }
243             else {
244 1         62 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         4 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   1781 method _decimal (Str $lexeme) {
  1 50   339   2  
  1 50       130  
  1 50       6  
  1 50       2  
  1         81  
  1         139  
  339         374992  
  339         1096  
  339         1026  
  339         986  
  339         547  
  339         1159  
  339         791  
258             #
259             # decimalNumber ~ _DECDIGITS
260             #
261 339         1662 return $self->_radix("0r10:$lexeme");
262             }
263              
264 1 0   1   1710 method _octal (Str $lexeme) {
  1 0   0   2  
  1 0       129  
  1 0       6  
  1 0       1  
  1         84  
  1         142  
  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   1689 method _hex (Str $lexeme) {
  1 50   2   2  
  1 50       123  
  1 50       6  
  1 50       2  
  1         83  
  1         134  
  2         4614  
  2         14  
  2         11  
  2         9  
  2         4  
  2         10  
  2         5  
273             #
274             # hexaNumber ~ '0x' _HEXDIGITS
275             #
276 2         16 substr( $lexeme, 0, 2, '' );
277 2         15 return $self->_radix("0r16:$lexeme");
278             }
279              
280 1 50   1   1820 method _binary (Str $lexeme) {
  1 50   1   3  
  1 50       142  
  1 50       6  
  1 50       1  
  1         92  
  1         130  
  1         54  
  1         4  
  1         5  
  1         6  
  1         3  
  1         6  
  1         2  
281             #
282             # binaryNumber ~ '0b' _BINDIGITS
283             #
284 1         5 substr( $lexeme, 0, 2, '' );
285 1         6 return $self->_radix( $lexeme, true );
286             }
287              
288 1 50   1   2978 method _radix (Str $lexeme, Bool $binary?) {
  1 50   344   2  
  1 50       156  
  1 50       6  
  1 50       2  
  1 50       98  
  1 100       5  
  1 50       2  
  1 100       384  
  1         131  
  344         3241  
  344         915  
  344         1023  
  344         946  
  344         999  
  344         562  
  344         1123  
  344         1062  
  344         984  
  1         2  
  1         7  
  344         559  
289             #
290             # Per def it is this regexp
291             # C.f. grammar
292             #
293 344         497 my $radix;
294 344         653 my $input = $lexeme;
295 344 100       871 if ( !$binary ) {
296 343         2418 $lexeme =~ /0r([\d]+):([\da-zA-Z]+)/;
297 343         2258 $radix = substr( $lexeme, $-[1], $+[1] - $-[1] );
298 343         1552 $input = substr( $lexeme, $-[2], $+[2] - $-[2] );
299             }
300 344         1567 my $error = false;
301 344         1496 my $errorString = '';
302 344         542 my $rc;
303             try {
304 344     344   17733 $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         3028 };
312 344 50       6012 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         1210 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.020
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