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         6  
2              
3             # PODNAME: MarpaX::Languages::M4::Impl::Default::Eval
4              
5             # ABSTRACT: Eval Marpa actions
6              
7 1     1   3026 class MarpaX::Languages::M4::Impl::Default::Eval {
  1     1   28  
  1         7  
  1         2  
  1         63  
  1         6  
  1         2  
  1         9  
  1         310  
  1         2  
  1         23  
  1         65  
  1         3  
  1         45  
  1         6  
  1         2  
  1         76  
  1         29  
  1         6  
  1         2  
  1         5  
  1         4853  
  1         3  
  1         8  
  1         428  
  1         2  
  1         8  
  1         140  
  1         2  
  1         9  
  1         72  
  1         3  
  1         6  
  1         274  
  1         2  
  1         9  
  1         823  
  1         2  
  1         6  
  1         2173  
  1         4  
  1         6  
  1         2  
  1         24  
  1         5  
  1         2  
  1         42  
  1         5  
  1         2  
  1         91  
  1         6785  
  0         0  
8 1     1   6 use Bit::Vector;
  1         2  
  1         56  
9 1     1   6 use Types::Common::Numeric -all;
  1         2  
  1         8  
10 1     1   5795 use MarpaX::Languages::M4::Impl::Default::BaseConversion;
  1         3  
  1         8  
11              
12 1         16 our $VERSION = '0.019'; # 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         16634 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         41785 default => sub {$MarpaX::Languages::M4::Impl::Default::SELF}
32 1         1134 };
33              
34 1 50 33 1   3123 method _eval (ConsumerOf['Bit::Vector'] $expression) {
  1 50   162   2  
  1 50       139  
  1 50       10  
  1 50       2  
  1 50       128  
  1         1975  
  162         8111  
  162         552  
  162         616  
  162         566  
  162         318  
  162         387  
  162         847  
  162         900  
  162         996  
  162         365  
35 162         399 return $expression;
36             }
37              
38 1 50   1   1806 method _invalidOp (Str $op) {
  1 50   2   2  
  1 50       196  
  1 50       7  
  1 50       3  
  1         104  
  1         247  
  2         121  
  2         11  
  2         11  
  2         11  
  2         6  
  2         11  
  2         7  
39 2         65 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   2967 method _noop (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   2  
  1 50       130  
  1 50       7  
  1 50       2  
  1 50       100  
  1 50       6  
  1 50       2  
  1 50       115  
  1         140  
  2         78  
  2         6  
  2         7  
  2         7  
  2         5  
  2         6  
  2         7  
  2         6  
  2         4  
  2         3  
  2         9  
  2         9  
  2         11  
  2         4  
45 2         6 return $expression;
46             }
47              
48 1 50 33 1   3004 method _lneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   3   3  
  1 50       139  
  1 50       7  
  1 50       2  
  1 50       108  
  1 50       6  
  1 50       3  
  1 50       126  
  1         167  
  3         240  
  3         14  
  3         15  
  3         13  
  3         10  
  3         18  
  3         15  
  3         17  
  3         9  
  3         5  
  3         32  
  3         24  
  3         24  
  3         10  
49 3         35 return Bit::Vector->new_Dec( $self->bits, $expression->is_empty() );
50             }
51              
52 1 50 33 1   4705 method _exp (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   2  
  1 50       157  
  1 50       8  
  1 50       2  
  1 50       189  
  1 50       7  
  1 50       2  
  1 50       91  
  1 50       6  
  1 50       2  
  1 50       274  
  1 50       140  
  21         1144  
  21         94  
  21         118  
  21         109  
  21         65  
  21         56  
  21         140  
  21         153  
  21         165  
  21         101  
  21         91  
  21         53  
  21         94  
  21         90  
  21         86  
  21         40  
  21         37  
  21         122  
  21         136  
  21         160  
  21         45  
53 21 100       187 if ( $expression2->to_Dec() < 0 ) {
54 1         32 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     144 if ( $expression1->to_Dec() == 0 && $expression2->to_Dec() == 0 ) {
62 1         43 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         75 my $s = $expression1->Shadow;
70 19         125 $s->Power( $expression1, $expression2 );
71 19         58 return $s;
72             }
73              
74 1 50 33 1   2995 method _neg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   13   2  
  1 50       152  
  1 50       10  
  1 50       3  
  1 50       116  
  1 50       6  
  1 50       2  
  1 50       131  
  1         141  
  13         868  
  13         51  
  13         60  
  13         44  
  13         27  
  13         59  
  13         65  
  13         51  
  13         27  
  13         27  
  13         77  
  13         86  
  13         124  
  13         29  
75 13         59 my $s = $expression->Shadow;
76 13         70 $s->Negate($expression);
77 13         48 return $s;
78             }
79              
80 1 50 33 1   2953 method _bneg (Str $op, ConsumerOf['Bit::Vector'] $expression) {
  1 50   2   2  
  1 50       125  
  1 50       6  
  1 50       1  
  1 50       101  
  1 50       6  
  1 50       2  
  1 50       126  
  1         136  
  2         101  
  2         9  
  2         8  
  2         5  
  2         5  
  2         8  
  2         6  
  2         5  
  2         5  
  2         3  
  2         10  
  2         9  
  2         12  
  2         4  
81 2         8 my $s = $expression->Shadow;
82 2         21 $s->Complement($expression);
83 2         9 return $s;
84             }
85              
86 1 50 33 1   4173 method _mul (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 12   2  
  1 50       126  
  1 50       5  
  1 50       3  
  1 50       150  
  1 50       6  
  1 50       2  
  1 50       96  
  1 50       6  
  1 50       2  
  1 50       178  
  1 50       160  
  12         888  
  12         41  
  12         34  
  12         40  
  12         17  
  12         21  
  12         59  
  12         59  
  12         71  
  12         42  
  12         35  
  12         23  
  12         38  
  12         31  
  12         34  
  12         23  
  12         24  
  12         50  
  12         60  
  12         64  
  12         22  
87 12         54 my $s = $expression1->Shadow;
88 12         56 $s->Multiply( $expression1, $expression2 );
89 12         48 return $s;
90             }
91              
92 1 50 33 1   4177 method _div (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   2  
  1 50       125  
  1 50       5  
  1 50       2  
  1 50       147  
  1 50       6  
  1 50       2  
  1 50       96  
  1 50       6  
  1 50       1  
  1 50       196  
  1 50       199  
  5         370  
  5         30  
  5         26  
  5         24  
  5         17  
  5         16  
  5         40  
  5         45  
  5         60  
  5         29  
  5         20  
  5         10  
  5         26  
  5         26  
  5         23  
  5         15  
  5         13  
  5         35  
  5         32  
  5         44  
  5         19  
93 5         29 my $s = $expression1->Shadow;
94             try {
95 5     5   397 $s->Divide( $expression1, $expression2, $expression1->Shadow );
96             }
97             catch {
98 2     2   68 $s = undef;
99 5         56 };
100 5         84 return $s;
101             }
102              
103 1 50 33 1   4443 method _mod (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 5   3  
  1 50       125  
  1 50       6  
  1 50       2  
  1 50       152  
  1 50       6  
  1 50       3  
  1 50       92  
  1 50       5  
  1 50       3  
  1 50       195  
  1 50       147  
  5         262  
  5         23  
  5         24  
  5         25  
  5         21  
  5         9  
  5         34  
  5         37  
  5         40  
  5         35  
  5         23  
  5         13  
  5         22  
  5         22  
  5         24  
  5         12  
  5         13  
  5         50  
  5         26  
  5         31  
  5         13  
104 5         21 my $s = $expression1->Shadow;
105             try {
106 5     5   281 $expression1->Shadow->Divide( $expression1, $expression2, $s );
107             }
108             catch {
109 2     2   55 $s = undef;
110 5         52 };
111 5         59 return $s;
112             }
113              
114 1 50 33 1   4218 method _add (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 82   2  
  1 50       163  
  1 50       11  
  1 50       3  
  1 50       171  
  1 50       6  
  1 50       2  
  1 50       95  
  1 50       6  
  1 50       2  
  1 50       194  
  1 50       143  
  82         4007  
  82         310  
  82         304  
  82         319  
  82         239  
  82         124  
  82         440  
  82         462  
  82         548  
  82         312  
  82         222  
  82         139  
  82         292  
  82         270  
  82         243  
  82         146  
  82         147  
  82         361  
  82         384  
  82         425  
  82         200  
115 82         292 my $s = $expression1->Shadow;
116 82         312 $s->add( $expression1, $expression2, 0 );
117 82         189 return $s;
118             }
119              
120 1 50 33 1   4547 method _sub (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 21   2  
  1 50       126  
  1 50       16  
  1 50       3  
  1 50       148  
  1 50       6  
  1 50       3  
  1 50       93  
  1 50       6  
  1 50       2  
  1 50       148  
  1 50       192  
  21         1132  
  21         132  
  21         91  
  21         77  
  21         55  
  21         36  
  21         111  
  21         123  
  21         154  
  21         91  
  21         66  
  21         37  
  21         81  
  21         77  
  21         75  
  21         54  
  21         35  
  21         108  
  21         99  
  21         116  
  21         48  
121 21         80 my $s = $expression1->Shadow;
122 21         139 $s->subtract( $expression1, $expression2, 0 );
123 21         62 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   4267 method _left (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   4  
  1 50       129  
  1 50       7  
  1 50       3  
  1 50       149  
  1 50       6  
  1 50       2  
  1 50       88  
  1 50       6  
  1 50       2  
  1 50       142  
  1 50       141  
  1         46  
  1         6  
  1         4  
  1         5  
  1         2  
  1         2  
  1         14  
  1         7  
  1         8  
  1         6  
  1         4  
  1         3  
  1         4  
  1         4  
  1         4  
  1         2  
  1         2  
  1         5  
  1         5  
  1         6  
  1         2  
134 1         13 $expression1->Insert( 0, $expression2->to_Dec() % $self->bits );
135 1         3 return $expression1;
136             }
137              
138 1 50 33 1   4310 method _right (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   3  
  1 50       132  
  1 50       6  
  1 50       1  
  1 50       153  
  1 50       6  
  1 50       2  
  1 50       87  
  1 50       6  
  1 50       2  
  1 50       195  
  1 50       140  
  2         127  
  2         8  
  2         7  
  2         6  
  2         6  
  2         4  
  2         11  
  2         13  
  2         13  
  2         7  
  2         8  
  2         4  
  2         8  
  2         8  
  2         8  
  2         5  
  2         4  
  2         11  
  2         10  
  2         10  
  2         5  
139 2         12 my $u1 = $expression1->Clone;
140 2 50       13 if ( $expression1->Sign < 0 ) {
141 2         8 $u1->Complement($u1);
142             }
143 2         24 $u1->Delete( 0, $expression2->to_Dec() % $self->bits );
144 2 50       9 if ( $expression1->Sign < 0 ) {
145 2         9 $u1->Complement($u1);
146             }
147 2         6 return $u1;
148             }
149              
150 1 50 33 1   4255 method _gt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 13   2  
  1 50       146  
  1 50       7  
  1 50       2  
  1 50       147  
  1 50       7  
  1 50       2  
  1 50       89  
  1 50       6  
  1 50       2  
  1 50       148  
  1 50       149  
  13         792  
  13         58  
  13         64  
  13         55  
  13         64  
  13         35  
  13         89  
  13         169  
  13         119  
  13         73  
  13         53  
  13         31  
  13         66  
  13         53  
  13         45  
  13         30  
  13         31  
  13         88  
  13         81  
  13         89  
  13         33  
151 13 100       171 return Bit::Vector->new_Dec( $self->bits,
152             ( $expression1->Compare($expression2) > 0 ) ? 1 : 0 );
153             }
154              
155 1 50 33 1   4395 method _ge (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       146  
  1 50       8  
  1 50       2  
  1 50       149  
  1 50       6  
  1 50       109  
  1 50       98  
  1 50       7  
  1 50       2  
  1 50       145  
  1 50       148  
  1         57  
  1         6  
  1         4  
  1         7  
  1         3  
  1         3  
  1         6  
  1         9  
  1         8  
  1         6  
  1         4  
  1         2  
  1         5  
  1         4  
  1         4  
  1         2  
  1         3  
  1         6  
  1         6  
  1         7  
  1         2  
156 1 50       14 return Bit::Vector->new_Dec( $self->bits,
157             ( $expression1->Compare($expression2) >= 0 ) ? 1 : 0 );
158             }
159              
160 1 50 33 1   4317 method _lt (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       133  
  1 50       6  
  1 50       1  
  1 50       175  
  1 50       6  
  1 50       3  
  1 50       99  
  1 50       6  
  1 50       2  
  1 50       145  
  1 50       141  
  1         82  
  1         8  
  1         10  
  1         7  
  1         4  
  1         3  
  1         10  
  1         10  
  1         13  
  1         7  
  1         6  
  1         5  
  1         10  
  1         7  
  1         7  
  1         3  
  1         4  
  1         12  
  1         9  
  1         13  
  1         4  
161 1 50       27 return Bit::Vector->new_Dec( $self->bits,
162             ( $expression1->Compare($expression2) < 0 ) ? 1 : 0 );
163             }
164              
165 1 0 0 1   4379 method _le (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       132  
  1 0       83  
  1 0       3  
  1 0       153  
  1 0       6  
  1 0       2  
  1 0       89  
  1 0       5  
  1 0       6  
  1 0       141  
  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   4512 method _eq (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 3   2  
  1 50       126  
  1 50       6  
  1 50       1  
  1 50       156  
  1 50       6  
  1 50       2  
  1 50       96  
  1 50       6  
  1 50       2  
  1 50       143  
  1 50       138  
  3         108  
  3         13  
  3         16  
  3         15  
  3         9  
  3         5  
  3         19  
  3         22  
  3         27  
  3         14  
  3         14  
  3         7  
  3         16  
  3         11  
  3         12  
  3         43  
  3         9  
  3         33  
  3         34  
  3         34  
  3         14  
171 3 100       82 return Bit::Vector->new_Dec( $self->bits,
172             ( $expression1->Compare($expression2) == 0 ) ? 1 : 0 );
173             }
174              
175 1 50 33 1   4757 method _eq2 (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 1   2  
  1 50       138  
  1 50       7  
  1 50       2  
  1 50       188  
  1 50       7  
  1 50       2  
  1 50       100  
  1 50       6  
  1 50       2  
  1 50       186  
  1 50       139  
  1         50  
  1         5  
  1         5  
  1         5  
  1         3  
  1         2  
  1         7  
  1         7  
  1         11  
  1         5  
  1         4  
  1         2  
  1         6  
  1         5  
  1         4  
  1         3  
  1         2  
  1         7  
  1         5  
  1         8  
  1         3  
176 1         30 $self->SELF->logger_warn('Warning: recommend == instead of =');
177 1         6 return $self->_eq( $expression1, $op, $expression2 );
178             }
179              
180 1 0 0 1   4363 method _ne (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       127  
  1 0       6  
  1 0       2  
  1 0       204  
  1 0       7  
  1 0       1  
  1 0       91  
  1 0       9  
  1 0       2  
  1 0       152  
  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   4464 method _band (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 0 0 0   2  
  1 0       122  
  1 0       6  
  1 0       2  
  1 0       153  
  1 0       6  
  1 0       2  
  1 0       92  
  1 0       6  
  1 0       2  
  1 0       148  
  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  
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   4668 method _bxor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       125  
  1 50       10  
  1 50       2  
  1 50       147  
  1 50       6  
  1 50       2  
  1 50       106  
  1 50       6  
  1 50       3  
  1 50       150  
  1 50       191  
  2         135  
  2         8  
  2         13  
  2         10  
  2         6  
  2         6  
  2         14  
  2         15  
  2         19  
  2         10  
  2         10  
  2         5  
  2         11  
  2         11  
  2         14  
  2         7  
  2         6  
  2         20  
  2         16  
  2         24  
  2         14  
192 2         16 my $s = $expression1->Shadow;
193 2         15 $s->ExclusiveOr( $expression1, $expression2 );
194 2         9 return $s;
195             }
196              
197 1 50 33 1   4557 method _bor (ConsumerOf['Bit::Vector'] $expression1, Str $op, ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   2  
  1 50       143  
  1 50       6  
  1 50       2  
  1 50       197  
  1 50       7  
  1 50       3  
  1 50       94  
  1 50       5  
  1 50       2  
  1 50       179  
  1 50       149  
  2         114  
  2         9  
  2         9  
  2         9  
  2         6  
  2         6  
  2         19  
  2         18  
  2         28  
  2         13  
  2         10  
  2         5  
  2         14  
  2         8  
  2         9  
  2         5  
  2         6  
  2         12  
  2         10  
  2         15  
  2         4  
198 2         10 my $s = $expression1->Shadow;
199 2         12 $s->Union( $expression1, $expression2 );
200 2         5 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   5108 method _land (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   3  
  1 50       125  
  1 50       6  
  1 50       2  
  1 50       184  
  1 50       7  
  1 50       2  
  1 50       97  
  1 50       5  
  1 50       2  
  1 50       259  
  1         143  
  2         124  
  2         11  
  2         10  
  2         11  
  2         6  
  2         4  
  2         14  
  2         20  
  2         17  
  2         12  
  2         10  
  2         6  
  2         13  
  2         10  
  2         10  
  2         6  
  2         14  
  2         5  
209 2         7 my $rc;
210 2 50       13 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         21 $rc = $expression1;
221             }
222             else {
223 1         77 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   5348 method _lor (ConsumerOf['Bit::Vector'] $expression1, Str $op, Undef|ConsumerOf['Bit::Vector'] $expression2) {
  1 50 33 2   3  
  1 50       138  
  1 50       6  
  1 50       2  
  1 50       195  
  1 50       7  
  1 50       1  
  1 50       102  
  1 50       5  
  1 50       2  
  1 50       277  
  1         142  
  2         154  
  2         12  
  2         13  
  2         13  
  2         6  
  2         13  
  2         18  
  2         21  
  2         24  
  2         14  
  2         13  
  2         6  
  2         14  
  2         12  
  2         12  
  2         7  
  2         14  
  2         8  
233 2         6 my $rc;
234 2 50       14 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         43 $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         5 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   1860 method _decimal (Str $lexeme) {
  1 50   339   2  
  1 50       127  
  1 50       6  
  1 50       2  
  1         80  
  1         141  
  339         394526  
  339         1089  
  339         1115  
  339         986  
  339         600  
  339         1278  
  339         543  
258             #
259             # decimalNumber ~ _DECDIGITS
260             #
261 339         1797 return $self->_radix("0r10:$lexeme");
262             }
263              
264 1 0   1   2100 method _octal (Str $lexeme) {
  1 0   0   3  
  1 0       129  
  1 0       6  
  1 0       2  
  1         86  
  1         132  
  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   1781 method _hex (Str $lexeme) {
  1 50   2   2  
  1 50       119  
  1 50       6  
  1 50       2  
  1         83  
  1         139  
  2         5030  
  2         13  
  2         10  
  2         9  
  2         6  
  2         11  
  2         3  
273             #
274             # hexaNumber ~ '0x' _HEXDIGITS
275             #
276 2         14 substr( $lexeme, 0, 2, '' );
277 2         17 return $self->_radix("0r16:$lexeme");
278             }
279              
280 1 50   1   1913 method _binary (Str $lexeme) {
  1 50   1   5  
  1 50       122  
  1 50       6  
  1 50       2  
  1         136  
  1         230  
  1         64  
  1         6  
  1         8  
  1         7  
  1         5  
  1         9  
  1         4  
281             #
282             # binaryNumber ~ '0b' _BINDIGITS
283             #
284 1         7 substr( $lexeme, 0, 2, '' );
285 1         6 return $self->_radix( $lexeme, true );
286             }
287              
288 1 50   1   3089 method _radix (Str $lexeme, Bool $binary?) {
  1 50   344   3  
  1 50       133  
  1 50       6  
  1 50       2  
  1 50       104  
  1 100       6  
  1 50       3  
  1 100       468  
  1         175  
  344         3479  
  344         956  
  344         798  
  344         1030  
  344         1060  
  344         598  
  344         927  
  344         956  
  344         880  
  1         2  
  1         5  
  344         752  
289             #
290             # Per def it is this regexp
291             # C.f. grammar
292             #
293 344         581 my $radix;
294 344         643 my $input = $lexeme;
295 344 100       831 if ( !$binary ) {
296 343         2326 $lexeme =~ /0r([\d]+):([\da-zA-Z]+)/;
297 343         2264 $radix = substr( $lexeme, $-[1], $+[1] - $-[1] );
298 343         1499 $input = substr( $lexeme, $-[2], $+[2] - $-[2] );
299             }
300 344         1800 my $error = false;
301 344         1557 my $errorString = '';
302 344         573 my $rc;
303             try {
304 344     344   18286 $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         2917 };
312 344 50       6043 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         1396 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.019
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