src/tools/check_bison_recursion.pl

   1 #! /usr/bin/perl
   2
   3 #################################################################
   4 #
   5 # check_bison_recursion.pl -- check for right recursion in Bison grammars
   6 #
   7 # The standard way to parse list constructs in Bison grammars is via left
   8 # recursion, wherein a nonterminal symbol has itself as the first symbol
   9 # in one of its expansion rules.  It is also possible to parse a list via
  10 # right recursion, wherein a nonterminal symbol has itself as the last
  11 # symbol of an expansion; but that's a bad way to write it because a long
  12 # enough list will result in parser stack overflow.  Since Bison doesn't
  13 # have any built-in way to warn about use of right recursion, we use this
  14 # script when we want to check for the problem.
  15 #
  16 # To use: run bison with the -v switch, then feed the produced y.output
  17 # file to this script.
  18 #
  19 # Copyright (c) 2011-2023, PostgreSQL Global Development Group
  20 #
  21 # src/tools/check_bison_recursion.pl
  22 #################################################################
  23
  24 use strict;
  25 use warnings;
  26
  27 my $debug = 0;
  28
  29 # must retain this across input lines
  30 my $cur_nonterminal;
  31
  32 # We parse the input and emit warnings on the fly.
  33 my $in_grammar = 0;
  34
  35 while (<>)
  36 {
  37         my $rule_number;
  38         my $rhs;
  39
  40         # We only care about the "Grammar" part of the input.
  41         if (m/^Grammar$/)
  42         {
  43                 $in_grammar = 1;
  44         }
  45         elsif (m/^Terminal/)
  46         {
  47                 $in_grammar = 0;
  48         }
  49         elsif ($in_grammar)
  50         {
  51                 if (m/^\s*(\d+)\s+(\S+):\s+(.*)$/)
  52                 {
  53
  54                         # first rule for nonterminal
  55                         $rule_number = $1;
  56                         $cur_nonterminal = $2;
  57                         $rhs = $3;
  58                 }
  59                 elsif (m/^\s*(\d+)\s+\|\s+(.*)$/)
  60                 {
  61
  62                         # additional rule for nonterminal
  63                         $rule_number = $1;
  64                         $rhs = $2;
  65                 }
  66         }
  67
  68         # Process rule if we found one
  69         if (defined $rule_number)
  70         {
  71
  72                 # deconstruct the RHS
  73                 $rhs =~ s|^/\* empty \*/$||;
  74                 my @rhs = split '\s', $rhs;
  75                 print "Rule $rule_number: $cur_nonterminal := @rhs\n" if $debug;
  76
  77                 # We complain if the nonterminal appears as the last RHS element
  78                 # but not elsewhere, since "expr := expr + expr" is reasonable
  79                 my $lastrhs = pop @rhs;
  80                 if (   defined $lastrhs
  81                         && $cur_nonterminal eq $lastrhs
  82                         && !grep { $cur_nonterminal eq $_ } @rhs)
  83                 {
  84                         print
  85                           "Right recursion in rule $rule_number: $cur_nonterminal := $rhs\n";
  86                 }
  87         }
  88 }
  89
  90 exit 0;