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   91412 use warnings;
  2         2  
  2         49  
28 2     2   7 use strict;
  2         2  
  2         27  
29 2     2   5 use utf8;
  2         2  
  2         8  
30              
31 2     2   434 use Moo;
  2         8688  
  2         7  
32             extends 'Karel::Parser';
33 2     2   1499 use namespace::clean;
  2         7413  
  2         6  
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 ));
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   29 }->{ $_[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   91 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 => [value]
77              
78             Defs ::= Def+ separator => SC action => defs
79             Def ::= (SCMaybe) (< prikaz >) (SC) NewCommand (SC) Prog (SC) (konec)
80             action => def
81             NewCommand ::= alpha valid_name action => concat
82             Prog ::= Commands action => ::first
83             Commands ::= Command+ separator => SC action => list
84             Command ::= vlevo action => left
85             | krok action => forward
86             | poloz action => drop
87             | zvedni action => pick
88             | stuj action => stop
89             | (opakuj SC) Num (SC Times SC) Prog (SC hotovo)
90             action => repeat
91             | (dokud SC) Condition (SC) Prog (hotovo) action => While
92             | (kdyz SC) Condition (SC) Prog (hotovo) action => If
93             | (kdyz SC) Condition (SC) Prog (jinak SC) Prog (hotovo)
94             action => If
95             | NewCommand action => call
96             Condition ::= (je SC) Object action => ::first
97             | (neni SC) Object action => negate
98             Object ::= znacka action => object
99             | zed action => object
100             | sever action => object
101             | vychod action => object
102             | jih action => object
103             | zapad action => object
104             Num ::= non_zero action => ::first
105             | non_zero digits action => concat
106             Times ::= krat
107             | x
108             Comment ::= (octothorpe non_lf lf)
109             SC ::= SpComm+
110             SCMaybe ::= SpComm*
111             SpComm ::= Comment
112             || space
113              
114             alpha ~ [[:lower:]]
115             valid_name ~ [-[:lower:]_0-9]+
116             non_zero ~ [1-9]
117             digits ~ [0-9]+
118             space ~ [\s]+
119             non_lf ~ [^\n]*
120             lf ~ [\n]
121             x ~ [x×]
122              
123             __DSL__
124              
125             $dsl .= join "\n", map "$_ ~ '$terminals{$_}'", keys %terminals;
126              
127             around _dsl => sub { $dsl };
128              
129             around _action_class => sub { 'Karel::Parser::Czech::Actions' };
130              
131             __PACKAGE__