Merge branch 'release-4.16.1'
[i3/i3] / generate-command-parser.pl
1 #!/usr/bin/env perl
2 # vim:ts=4:sw=4:expandtab
3 #
4 # i3 - an improved dynamic tiling window manager
5 # © 2009 Michael Stapelberg and contributors (see also: LICENSE)
6 #
7 # generate-command-parser.pl: script to generate parts of the command parser
8 # from its specification file parser-specs/commands.spec.
9 #
10 # Requires only perl >= 5.10, no modules.
11
12 use strict;
13 use warnings;
14 use Data::Dumper;
15 use Getopt::Long;
16 use v5.10;
17
18 my $input = '';
19 my $prefix = '';
20 my $result = GetOptions(
21     'input=s' => \$input,
22     'prefix=s' => \$prefix
23 );
24
25 die qq|Input file "$input" does not exist!| unless -e $input;
26
27 # reads in a whole file
28 sub slurp {
29     open my $fh, '<', shift;
30     local $/;
31     <$fh>;
32 }
33
34 # Stores the different states.
35 my %states;
36
37 my @raw_lines = split("\n", slurp($input));
38 my @lines;
39
40 # XXX: In the future, we might switch to a different way of parsing this. The
41 # parser is in many ways not good — one obvious one is that it is hand-crafted
42 # without a good reason, also it preprocesses lines and forgets about line
43 # numbers. Luckily, this is just an implementation detail and the specification
44 # for the i3 command parser is in-tree (not user input).
45 # -- michael, 2012-01-12
46
47 # First step of preprocessing:
48 # Join token definitions which are spread over multiple lines.
49 for my $line (@raw_lines) {
50     next if $line =~ /^\s*#/ || $line =~ /^\s*$/;
51
52     if ($line =~ /^\s+->/) {
53         # This is a continued token definition, append this line to the
54         # previous one.
55         $lines[$#lines] = $lines[$#lines] . $line;
56     } else {
57         push @lines, $line;
58         next;
59     }
60 }
61
62 # First step: We build up the data structure containing all states and their
63 # token rules.
64
65 my $current_state;
66
67 for my $line (@lines) {
68     if (my ($state) = ($line =~ /^state ([A-Z0-9_]+):$/)) {
69         #say "got a new state: $state";
70         $current_state = $state;
71     } else {
72         # Must be a token definition:
73         # [identifier = ] <tokens> -> <action>
74         #say "token definition: $line";
75
76         my ($identifier, $tokens, $action) =
77             ($line =~ /
78                 ^\s*                  # skip leading whitespace
79                 ([a-z_]+ \s* = \s*|)  # optional identifier
80                 (.*?) -> \s*          # token
81                 (.*)                  # optional action
82              /x);
83
84         # Cleanup the identifier (if any).
85         $identifier =~ s/^\s*(\S+)\s*=\s*$/$1/g;
86
87         # The default action is to stay in the current state.
88         $action = $current_state if length($action) == 0;
89
90         #say "identifier = *$identifier*, token = *$tokens*, action = *$action*";
91         for my $token (split(',', $tokens)) {
92             # Cleanup trailing/leading whitespace.
93             $token =~ s/^\s*//g;
94             $token =~ s/\s*$//g;
95             my $store_token = {
96                 token => $token,
97                 identifier => $identifier,
98                 next_state => $action,
99             };
100             if (exists $states{$current_state}) {
101                 push @{$states{$current_state}}, $store_token;
102             } else {
103                 $states{$current_state} = [ $store_token ];
104             }
105         }
106     }
107 }
108
109 # Second step: Generate the enum values for all states.
110
111 # It is important to keep the order the same, so we store the keys once.
112 # We sort descendingly by length to be able to replace occurrences of the state
113 # name even when one state’s name is included in another one’s (like FOR_WINDOW
114 # is in FOR_WINDOW_COMMAND).
115 my @keys = sort { (length($b) <=> length($a)) or ($a cmp $b) } keys %states;
116
117 open(my $enumfh, '>', "GENERATED_${prefix}_enums.h");
118
119 my %statenum;
120 say $enumfh 'typedef enum {';
121 my $cnt = 0;
122 for my $state (@keys, '__CALL') {
123     say $enumfh ',' if $cnt > 0;
124     print $enumfh "    $state = $cnt";
125     $statenum{$state} = $cnt;
126     $cnt++;
127 }
128 say $enumfh "\n} cmdp_state;";
129 close($enumfh);
130
131 # Third step: Generate the call function.
132 open(my $callfh, '>', "GENERATED_${prefix}_call.h");
133 my $resultname = uc(substr($prefix, 0, 1)) . substr($prefix, 1) . 'ResultIR';
134 say $callfh "static void GENERATED_call(const int call_identifier, struct $resultname *result) {";
135 say $callfh '    switch (call_identifier) {';
136 my $call_id = 0;
137 for my $state (@keys) {
138     my $tokens = $states{$state};
139     for my $token (@$tokens) {
140         next unless $token->{next_state} =~ /^call /;
141         my ($cmd) = ($token->{next_state} =~ /^call (.*)/);
142         my ($next_state) = ($cmd =~ /; ([A-Z_]+)$/);
143         $cmd =~ s/; ([A-Z_]+)$//;
144         # Go back to the INITIAL state unless told otherwise.
145         $next_state ||= 'INITIAL';
146         my $fmt = $cmd;
147         # Replace the references to identified literals (like $workspace) with
148         # calls to get_string(). Also replaces state names (like FOR_WINDOW)
149         # with their ID (useful for cfg_criteria_init(FOR_WINDOW) e.g.).
150         $cmd =~ s/$_/$statenum{$_}/g for @keys;
151         $cmd =~ s/\$([a-z_]+)/get_string("$1")/g;
152         $cmd =~ s/\&([a-z_]+)/get_long("$1")/g;
153         # For debugging/testing, we print the call using printf() and thus need
154         # to generate a format string. The format uses %d for <number>s,
155         # literal numbers or state IDs and %s for NULL, <string>s and literal
156         # strings.
157
158         # remove the function name temporarily, so that the following
159         # replacements only apply to the arguments.
160         my ($funcname) = ($fmt =~ /^(.+)\(/);
161         $fmt =~ s/^$funcname//;
162
163         $fmt =~ s/$_/%d/g for @keys;
164         $fmt =~ s/\$([a-z_]+)/%s/g;
165         $fmt =~ s/\&([a-z_]+)/%ld/g;
166         $fmt =~ s/"([a-z0-9_]+)"/%s/g;
167         $fmt =~ s/(?:-?|\b)[0-9]+\b/%d/g;
168
169         $fmt = $funcname . $fmt;
170
171         say $callfh "         case $call_id:";
172         say $callfh "             result->next_state = $next_state;";
173         say $callfh '#ifndef TEST_PARSER';
174         my $real_cmd = $cmd;
175         if ($real_cmd =~ /\(\)/) {
176             $real_cmd =~ s/\(/(&current_match, result/;
177         } else {
178             $real_cmd =~ s/\(/(&current_match, result, /;
179         }
180         say $callfh "             $real_cmd;";
181         say $callfh '#else';
182         # debug
183         $cmd =~ s/[^(]+\(//;
184         $cmd =~ s/\)$//;
185         $cmd = ", $cmd" if length($cmd) > 0;
186         $cmd =~ s/, NULL//g;
187         say $callfh qq|           fprintf(stderr, "$fmt\\n"$cmd);|;
188         # The cfg_criteria functions have side-effects which are important for
189         # testing. They are implemented as stubs in the test parser code.
190         if ($real_cmd =~ /^cfg_criteria/) {
191             say $callfh qq|       $real_cmd;|;
192         }
193         say $callfh '#endif';
194         say $callfh "             break;";
195         $token->{next_state} = "call $call_id";
196         $call_id++;
197     }
198 }
199 say $callfh '        default:';
200 say $callfh '            printf("BUG in the parser. state = %d\n", call_identifier);';
201 say $callfh '            assert(false);';
202 say $callfh '    }';
203 say $callfh '}';
204 close($callfh);
205
206 # Fourth step: Generate the token datastructures.
207
208 open(my $tokfh, '>', "GENERATED_${prefix}_tokens.h");
209
210 for my $state (@keys) {
211     my $tokens = $states{$state};
212     say $tokfh 'static cmdp_token tokens_' . $state . '[' . scalar @$tokens . '] = {';
213     for my $token (@$tokens) {
214         my $call_identifier = 0;
215         my $token_name = $token->{token};
216         if ($token_name =~ /^'/) {
217             # To make the C code simpler, we leave out the trailing single
218             # quote of the literal. We can do strdup(literal + 1); then :).
219             $token_name =~ s/'$//;
220         }
221         my $next_state = $token->{next_state};
222         if ($next_state =~ /^call /) {
223             ($call_identifier) = ($next_state =~ /^call ([0-9]+)$/);
224             $next_state = '__CALL';
225         }
226         my $identifier = $token->{identifier};
227         say $tokfh qq|    { "$token_name", "$identifier", $next_state, { $call_identifier } },|;
228     }
229     say $tokfh '};';
230 }
231
232 say $tokfh 'static cmdp_token_ptr tokens[' . scalar @keys . '] = {';
233 for my $state (@keys) {
234     my $tokens = $states{$state};
235     say $tokfh '    { tokens_' . $state . ', ' . scalar @$tokens . ' },';
236 }
237 say $tokfh '};';
238
239 close($tokfh);