File Coverage

File:lib/Parse/EBNF/Token.pm
Coverage:93.8%

linestmtbrancondsubtimecode
1package Parse::EBNF::Token;
2
3sub new {
4
61
61
156
        my ($class) = @_;
5
61
196
        my $self = bless {}, $class;
6
61
176
        $self->{error} = 0;
7
61
163
        return $self;
8}
9
10sub reduce_alternations {
11
51
51
125
        my ($self) = @_;
12
13
51
100
229
        return 1 unless $self->{type} eq 'list';
14
15
16        #
17        # reduce our own children first
18        #
19
20
21
21
35
71
        for my $token(@{$self->{tokens}}){
21
31
94
                $token->reduce_alternations();
22        }
23
24
25        #
26        # now check if we have any alts
27        #
28
29
21
42
        my $alts = 0;
30
21
21
34
71
        for my $token(@{$self->{tokens}}){
31
31
100
134
                $alts++ if $token->{type} eq 'alt';
32        }
33
34
21
100
99
        return 1 unless $alts;
35
36
37        #
38        # we have alts - change our base type and create new alt children
39        #
40
41
2
5
        my $our_tokens = $self->{tokens};
42
2
6
        $self->{tokens} = [];
43
2
6
        $self->{type} = 'alternation';
44
45
2
6
        my $current = Parse::EBNF::Token->new();
46
2
5
        $current->{type} = 'list';
47
2
7
        $current->{tokens} = [];
48
49
2
2
4
5
        for my $token(@{$our_tokens}){
50
51
6
100
22
                if ($token->{type} eq 'alt'){
52
53
2
2
4
6
                        push @{$self->{tokens}}, $current;
54
55
2
6
                        $current = Parse::EBNF::Token->new();
56
2
5
                        $current->{type} = 'list';
57
2
8
                        $current->{tokens} = [];
58
59                }else{
60
4
4
7
16
                        push @{$current->{tokens}}, $token;
61                }
62        }
63
64
2
2
5
7
        push @{$self->{tokens}}, $current;
65
66
2
9
        return 1;
67}
68
69sub reduce_repetition {
70
53
53
127
        my ($self) = @_;
71
72
53
100
100
395
        return 1 unless (($self->{type} eq 'list') || ($self->{type} eq 'alternation'));
73
74        #
75        # reduce our own children first
76        #
77
78
25
25
38
85
        for my $token(@{$self->{tokens}}){
79
33
85
                $token->reduce_repetition();
80        }
81
82
83        #
84        # do it
85        #
86
87
25
63
        my $old_tokens = $self->{tokens};
88
25
74
        $self->{tokens} = [];
89
90
25
25
41
62
        for my $token(@{$old_tokens}){
91
92
33
100
118
                if ($token->{type} =~ m!^rep (.*)$!){
93
94
3
8
                        my $new = Parse::EBNF::Token->new();
95
3
15
                        $new->{type} = 'repeat '.$1;
96
3
10
                        $new->{tokens} = [];
97
98
3
3
6
9
                        my $subject = pop @{$self->{tokens}};
99
100
3
50
10
                        unless (defined $subject){
101
0
0
                                $self->{error} = "repetition operator without suject";
102
0
0
                                return 0;
103                        }
104
105
3
3
5
11
                        push @{$new->{tokens}}, $subject;
106
107
3
3
5
14
                        push @{$self->{tokens}}, $new;
108                }else{
109
110
30
30
45
128
                        push @{$self->{tokens}}, $token;
111                }
112        }
113
114
25
92
        return 1;
115}
116
117sub reduce_empty {
118
53
53
126
        my ($self) = @_;
119
120
121        #
122        # reduce our own children first
123        #
124
125
53
100
179
        if (defined($self->{tokens})){
126
28
28
46
88
                for my $token(@{$self->{tokens}}){
127
33
90
                        $token->reduce_empty();
128                }
129        }
130
131
132        #
133        # reduce self?
134        #
135
136
53
100
188
        if ($self->{type} eq 'list'){
137
23
23
100
32
102
                if (scalar(@{$self->{tokens}}) == 1){
138
21
64
                        my $child = $self->{tokens}->[0];
139
140
21
21
63
35
85
191
                        for my $key(keys %{$self}){ delete $self->{$key}; }
141
21
21
64
44
72
258
                        for my $key(keys %{$child}){ $self->{$key} = $child->{$key}; }
142                }
143        }
144
145
53
193
        return 1;
146}
147
148sub reduce_rx {
149
32
32
76
        my ($self) = @_;
150
151
152        #
153        # reduce our own children first
154        #
155
156
32
100
110
        if (defined($self->{tokens})){
157
7
7
11
23
                for my $token(@{$self->{tokens}}){
158
12
39
                        $token->reduce_rx();
159                }
160        }
161
162
32
100
100
309
        return 1 unless (($self->{type} eq 'alternation') || ($self->{type} eq 'list'));
163
164
165        #
166        # see if we're in a position to reduce self...
167        #
168
169
4
4
8
14
        for my $token(@{$self->{tokens}}){
170
5
100
21
                next if $token->{type} eq 'literal';
171
3
50
11
                next if $token->{type} eq 'rx';
172
3
13
                return 1;
173        }
174
175
176        #
177        # we can reduce all of our children into a single rx
178        #
179
180
1
2
        my @rx;
181
182
1
1
4
5
        for my $token(@{$self->{tokens}}){
183
184
2
50
8
                if ($token->{type} eq 'literal'){
185
2
9
                        push @rx, '('.quotemeta($token->{content}).')';
186                }
187
188
2
50
10
                if ($token->{type} eq 'rx'){
189
0
0
                        push @rx, $token->{content};
190                }
191        }
192
193
1
3
        my $rx = '';
194
1
50
4
        $rx = join('', @rx) if $self->{type} eq 'list';
195
1
50
6
        $rx = join('|', @rx) if $self->{type} eq 'alternation';
196
197
1
2
        $self->{type} = 'rx';
198
1
3
        $self->{content} = $rx;
199
1
3
        $self->{tokens} = [];
200
201
1
6
        return 1;
202}
203
2041;
205