File Coverage

blib/lib/Karel/Parser/Czech.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1             package Karel::Parser::Czech;
2              
3             =head1 NAME
4              
5             =encoding UTF-8
6              
7             Karel::Parser::Czech
8              
9             =head1 DESCRIPTION
10              
11             Implements the Czech version of the Karel language:
12              
13             příkaz
14             vlevo
15             krok
16             polož
17             zvedni
18             stůj
19             když|dokud je|není značka|zeď|sever|východ|jih|západ
20             jinak
21             opakuj 5 krát|x
22             hotovo
23             konec
24              
25             =cut
26              
27 2     2   86239 use warnings;
  2         5  
  2         71  
28 2     2   8 use strict;
  2         3  
  2         34  
29 2     2   16 use utf8;
  2         3  
  2         11  
30              
31 2     2   600 use Moo;
  2         10879  
  2         11  
32             extends 'Karel::Parser';
33 2     2   1961 use namespace::clean;
  2         9349  
  2         8  
34              
35             { package # Hide from CPAN.
36             Karel::Parser::Czech::Actions;
37              
38             'Karel::Parser::Actions'->import(qw( def concat left forward pick
39             drop stop repeat While If
40             negate call list defs run ));
41              
42             sub object {
43             { značka => 'm',
44             zeď => 'w',
45             sever => 'N',
46             východ => 'E',
47             jih => 'S',
48             západ => 'W',
49 1     1   35 }->{ $_[1] }
50             }
51             }
52              
53             my %terminals = (
54             poloz => 'polož',
55             stuj => 'stůj',
56             kdyz => 'když',
57             prikaz => 'příkaz',
58             octothorpe => '#',
59             neni => 'není',
60             znacka => 'značka',
61             zed => 'zeď',
62             vychod => 'východ',
63             zapad => 'západ',
64             krat => 'krát',
65             );
66             $terminals{$_} = $_
67             for qw( vlevo krok hotovo jinak opakuj konec dokud zvedni je sever jih );
68 26     26   153 sub _terminals { \%terminals }
69              
70             my $dsl = << '__DSL__';
71              
72             :default ::= action => ::undef
73             lexeme default = latm => 1
74              
75             START ::= Defs action => ::first
76             | (Run SC) Command action => run
77             Run ::= 'run' action => [ values, start, length ]
78              
79             Defs ::= Def+ separator => SC action => defs
80             Def ::= Def2 action => [ values, start, length ]
81             Def2 ::= (SCMaybe) (prikaz) (SC) CommandDef (SC) Prog (SC) (konec)
82             action => def
83             NewCommand ::= CommandDef action => [ values, start, length ]
84             CommandDef ::= alpha valid_name action => concat
85             Prog ::= Commands action => ::first
86             Commands ::= Command+ separator => SC action => list
87             Command ::= Vlevo action => left
88             | Krok action => forward
89             | Poloz action => drop
90             | Zvedni action => pick
91             | Stuj action => stop
92             | Opakuj action => repeat
93             | Dokud action => While
94             | Kdyz action => If
95             | NewCommand action => call
96             Vlevo ::= vlevo action => [ start, length ]
97             Krok ::= krok action => [ start, length ]
98             Poloz ::= poloz action => [ start, length ]
99             Zvedni ::= zvedni action => [ start, length ]
100             Stuj ::= stuj action => [ start, length ]
101             Opakuj ::= (opakuj SC) Num (SC Times SC) Prog (SC hotovo)
102             action => [ values, start, length ]
103             Dokud ::= (dokud SC) Condition (SC) Prog (hotovo)
104             action => [ values, start, length ]
105             Kdyz ::= (kdyz SC) Condition (SC) Prog (hotovo)
106             action => [ values, start, length ]
107             | (kdyz SC) Condition (SC) Prog (SC jinak SC) Prog (hotovo)
108             action => [ values, start, length ]
109             Condition ::= (je SC) Object action => ::first
110             | (neni SC) Object action => negate
111             Object ::= znacka action => object
112             | zed action => object
113             | sever action => object
114             | vychod action => object
115             | jih action => object
116             | zapad action => object
117             Num ::= non_zero action => ::first
118             | non_zero digits action => concat
119             Times ::= krat
120             | x
121             Comment ::= (octothorpe non_lf lf)
122             SC ::= SpComm+
123             SCMaybe ::= SpComm*
124             SpComm ::= Comment
125             || space
126              
127             alpha ~ [[:lower:]]
128             valid_name ~ [-[:lower:]_0-9]+
129             non_zero ~ [1-9]
130             digits ~ [0-9]+
131             space ~ [\s]+
132             non_lf ~ [^\n]*
133             lf ~ [\n]
134             x ~ [x×]
135              
136             __DSL__
137              
138             $dsl .= join "\n", map "$_ ~ '$terminals{$_}'", keys %terminals;
139              
140             around _dsl => sub { $dsl };
141              
142             around _action_class => sub { 'Karel::Parser::Czech::Actions' };
143              
144             __PACKAGE__