blob: b366d7c9859f6e7f2b5c2476630714f34b69f608 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
package FLAT::Regex::WithExtraOps;
use base 'FLAT::Regex';
use strict;
use Carp;
my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star negate shuffle ]);
sub _parser { $PARSER }
sub members {
my $self = shift;
wantarray ? @$self[0 .. $#$self] : $self->[0];
}
#### Precedence
# 30 ::star
# 20 ::concat
# 15 ::negate <---<< WithExtraOps
# 12 ::shuffle <---<< WithExtraOps
# 10 ::alt
# 0 ::atomic
###############################
package FLAT::Regex::Op::negate;
use base "FLAT::Regex::Op";
use Carp;
sub parse_spec { "'~' %s"; }
sub precedence { 15 } # between concat and alternation
sub as_string {
my ($self, $prec) = @_;
my $result = "~" . $self->members->as_string($self->precedence);
return $prec > $self->precedence ? "($result)" : $result;
}
sub from_parse {
my ($pkg, @item) = @_;
$pkg->new( $item[2] );
}
## note: "reverse" conflicts with perl builtin
sub reverse {
my $self = shift;
my $op = $self->members->reverse;
__PACKAGE__->new($op);
}
sub is_empty {
croak "Not implemented for negated regexes";
}
sub has_nonempty_string {
croak "Not implemented for negated regexes";
}
sub is_finite {
croak "Not implemented for negated regexes";
}
###############################
package FLAT::Regex::Op::shuffle;
use base 'FLAT::Regex::Op';
use Carp;
sub parse_spec { "%s(2.. /[&]/)" }
sub precedence { 12 }
sub as_string {
my ($self, $prec) = @_;
my $result = join "&",
map { $_->as_string($self->precedence) }
$self->members;
return $prec > $self->precedence ? "($result)" : $result;
}
sub as_perl_regex {
my $self = shift;
croak "Not implemented for shuffled regexes";
}
sub from_parse {
my ($pkg, @item) = @_;
$pkg->new( @{ $item[1] } );
}
sub as_pfa {
my $self = shift;
my @parts = map { $_->as_pfa } $self->members;
$parts[0]->shuffle( @parts[1..$#parts] );
}
# Implement?
sub reverse {
my $self = shift;
croak "Not implemented for shuffled regexes";
}
sub is_empty {
croak "Not implemented for shuffled regexes";
}
sub has_nonempty_string {
croak "Not implemented for shuffled regexes";
}
sub is_finite {
croak "Not implemented for shuffled regexes";
}
|
