make_perl_groups.pl

     1  #!/usr/bin/perl
     2  # Copyright 2008 The Go Authors. All rights reserved.
     3  # Use of this source code is governed by a BSD-style
     4  # license that can be found in the LICENSE file.
     5  
     6  # Modified version of RE2's make_perl_groups.pl.
     7  
     8  # Generate table entries giving character ranges
     9  # for POSIX/Perl character classes.  Rather than
    10  # figure out what the definition is, it is easier to ask
    11  # Perl about each letter from 0-128 and write down
    12  # its answer.
    13  
    14  use strict;
    15  use warnings;
    16  
    17  my @posixclasses = (
    18  	"[:alnum:]",
    19  	"[:alpha:]",
    20  	"[:ascii:]",
    21  	"[:blank:]",
    22  	"[:cntrl:]",
    23  	"[:digit:]",
    24  	"[:graph:]",
    25  	"[:lower:]",
    26  	"[:print:]",
    27  	"[:punct:]",
    28  	"[:space:]",
    29  	"[:upper:]",
    30  	"[:word:]",
    31  	"[:xdigit:]",
    32  );
    33  
    34  my @perlclasses = (
    35  	"\\d",
    36  	"\\s",
    37  	"\\w",
    38  );
    39  
    40  my %overrides = (
    41  	# Prior to Perl 5.18, \s did not match vertical tab.
    42  	# RE2 preserves that original behaviour.
    43  	"\\s:11" => 0,
    44  );
    45  
    46  sub ComputeClass($) {
    47    my @ranges;
    48    my ($class) = @_;
    49    my $regexp = "[$class]";
    50    my $start = -1;
    51    for (my $i=0; $i<=129; $i++) {
    52      if ($i == 129) { $i = 256; }
    53      if ($i <= 128 && ($overrides{"$class:$i"} // chr($i) =~ $regexp)) {
    54        if ($start < 0) {
    55          $start = $i;
    56        }
    57      } else {
    58        if ($start >= 0) {
    59          push @ranges, [$start, $i-1];
    60        }
    61        $start = -1;
    62      }
    63    }
    64    return @ranges;
    65  }
    66  
    67  sub PrintClass($$@) {
    68    my ($cname, $name, @ranges) = @_;
    69    print "var code$cname = []rune{  /* $name */\n";
    70    for (my $i=0; $i<@ranges; $i++) {
    71      my @a = @{$ranges[$i]};
    72      printf "\t0x%x, 0x%x,\n", $a[0], $a[1];
    73    }
    74    print "}\n\n";
    75    my $n = @ranges;
    76    my $negname = $name;
    77    if ($negname =~ /:/) {
    78      $negname =~ s/:/:^/;
    79    } else {
    80      $negname =~ y/a-z/A-Z/;
    81    }
    82    return "\t`$name`: {+1, code$cname},\n" .
    83    	"\t`$negname`: {-1, code$cname},\n";
    84  }
    85  
    86  my $gen = 0;
    87  
    88  sub PrintClasses($@) {
    89    my ($cname, @classes) = @_;
    90    my @entries;
    91    foreach my $cl (@classes) {
    92      my @ranges = ComputeClass($cl);
    93      push @entries, PrintClass(++$gen, $cl, @ranges);
    94    }
    95    print "var ${cname}Group = map[string]charGroup{\n";
    96    foreach my $e (@entries) {
    97      print $e;
    98    }
    99    print "}\n";
   100    my $count = @entries;
   101  }
   102  
   103  # Prepare gofmt command
   104  my $gofmt;
   105  
   106  if (@ARGV > 0 && $ARGV[0] =~ /\.go$/) {
   107    # Send the output of gofmt to the given file
   108    open($gofmt, '|-', 'gofmt >'.$ARGV[0]) or die;
   109  } else {
   110    open($gofmt, '|-', 'gofmt') or die;
   111  }
   112  
   113  # Redirect STDOUT to gofmt input
   114  select $gofmt;
   115  
   116  print <<EOF;
   117  // Copyright 2013 The Go Authors. All rights reserved.
   118  // Use of this source code is governed by a BSD-style
   119  // license that can be found in the LICENSE file.
   120  
   121  // Code generated by make_perl_groups.pl; DO NOT EDIT.
   122  
   123  package syntax
   124  
   125  EOF
   126  
   127  PrintClasses("perl", @perlclasses);
   128  PrintClasses("posix", @posixclasses);
   129
View as plain text