git.sur5r.net Git - i3/i3/blob - 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-Z_]+):$/)) {
  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 occurences 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) } keys %states;
 116
 117 open(my $enumfh, '>', "GENERATED_${prefix}_enums.h");
 118
 119 # XXX: we might want to have a way to do this without a trailing comma, but gcc
 120 # seems to eat it.
 121 my %statenum;
 122 say $enumfh 'typedef enum {';
 123 my $cnt = 0;
 124 for my $state (@keys, '__CALL') {
 125     say $enumfh "    $state = $cnt,";
 126     $statenum{$state} = $cnt;
 127     $cnt++;
 128 }
 129 say $enumfh '} cmdp_state;';
 130 close($enumfh);
 131
 132 # Third step: Generate the call function.
 133 open(my $callfh, '>', "GENERATED_${prefix}_call.h");
 134 my $resultname = uc(substr($prefix, 0, 1)) . substr($prefix, 1) . 'ResultIR';
 135 say $callfh "static void GENERATED_call(const int call_identifier, struct $resultname *result) {";
 136 say $callfh '    switch (call_identifier) {';
 137 my $call_id = 0;
 138 for my $state (@keys) {
 139     my $tokens = $states{$state};
 140     for my $token (@$tokens) {
 141         next unless $token->{next_state} =~ /^call /;
 142         my ($cmd) = ($token->{next_state} =~ /^call (.*)/);
 143         my ($next_state) = ($cmd =~ /; ([A-Z_]+)$/);
 144         $cmd =~ s/; ([A-Z_]+)$//;
 145         # Go back to the INITIAL state unless told otherwise.
 146         $next_state ||= 'INITIAL';
 147         my $fmt = $cmd;
 148         # Replace the references to identified literals (like $workspace) with
 149         # calls to get_string(). Also replaces state names (like FOR_WINDOW)
 150         # with their ID (useful for cfg_criteria_init(FOR_WINDOW) e.g.).
 151         $cmd =~ s/$_/$statenum{$_}/g for @keys;
 152         $cmd =~ s/\$([a-z_]+)/get_string("$1")/g;
 153         $cmd =~ s/\&([a-z_]+)/get_long("$1")/g;
 154         # For debugging/testing, we print the call using printf() and thus need
 155         # to generate a format string. The format uses %d for <number>s,
 156         # literal numbers or state IDs and %s for NULL, <string>s and literal
 157         # strings.
 158         $fmt =~ s/$_/%d/g for @keys;
 159         $fmt =~ s/\$([a-z_]+)/%s/g;
 160         $fmt =~ s/\&([a-z_]+)/%ld/g;
 161         $fmt =~ s/"([a-z0-9_]+)"/%s/g;
 162         $fmt =~ s/(?:-?|\b)[0-9]+\b/%d/g;
 163
 164         say $callfh "         case $call_id:";
 165         say $callfh "             result->next_state = $next_state;";
 166         say $callfh '#ifndef TEST_PARSER';
 167         my $real_cmd = $cmd;
 168         if ($real_cmd =~ /\(\)/) {
 169             $real_cmd =~ s/\(/(&current_match, result/;
 170         } else {
 171             $real_cmd =~ s/\(/(&current_match, result, /;
 172         }
 173         say $callfh "             $real_cmd;";
 174         say $callfh '#else';
 175         # debug
 176         $cmd =~ s/[^(]+\(//;
 177         $cmd =~ s/\)$//;
 178         $cmd = ", $cmd" if length($cmd) > 0;
 179         $cmd =~ s/, NULL//g;
 180         say $callfh qq|           fprintf(stderr, "$fmt\\n"$cmd);|;
 181         # The cfg_criteria functions have side-effects which are important for
 182         # testing. They are implemented as stubs in the test parser code.
 183         if ($real_cmd =~ /^cfg_criteria/) {
 184             say $callfh qq|       $real_cmd;|;
 185         }
 186         say $callfh '#endif';
 187         say $callfh "             break;";
 188         $token->{next_state} = "call $call_id";
 189         $call_id++;
 190     }
 191 }
 192 say $callfh '        default:';
 193 say $callfh '            printf("BUG in the parser. state = %d\n", call_identifier);';
 194 say $callfh '            assert(false);';
 195 say $callfh '    }';
 196 say $callfh '}';
 197 close($callfh);
 198
 199 # Fourth step: Generate the token datastructures.
 200
 201 open(my $tokfh, '>', "GENERATED_${prefix}_tokens.h");
 202
 203 for my $state (@keys) {
 204     my $tokens = $states{$state};
 205     say $tokfh 'static cmdp_token tokens_' . $state . '[' . scalar @$tokens . '] = {';
 206     for my $token (@$tokens) {
 207         my $call_identifier = 0;
 208         my $token_name = $token->{token};
 209         if ($token_name =~ /^'/) {
 210             # To make the C code simpler, we leave out the trailing single
 211             # quote of the literal. We can do strdup(literal + 1); then :).
 212             $token_name =~ s/'$//;
 213         }
 214         my $next_state = $token->{next_state};
 215         if ($next_state =~ /^call /) {
 216             ($call_identifier) = ($next_state =~ /^call ([0-9]+)$/);
 217             $next_state = '__CALL';
 218         }
 219         my $identifier = $token->{identifier};
 220         say $tokfh qq|    { "$token_name", "$identifier", $next_state, { $call_identifier } }, |;
 221     }
 222     say $tokfh '};';
 223 }
 224
 225 say $tokfh 'static cmdp_token_ptr tokens[' . scalar @keys . '] = {';
 226 for my $state (@keys) {
 227     my $tokens = $states{$state};
 228     say $tokfh '    { tokens_' . $state . ', ' . scalar @$tokens . ' },';
 229 }
 230 say $tokfh '};';
 231
 232 close($tokfh);