make_perl_groups.pl

Documentation: regexp/syntax

     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
    14use strict;
    15use warnings;
    16
    17my @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
    34my @perlclasses = (
    35	"\\d",
    36	"\\s",
    37	"\\w",
    38);
    39
    40my %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
    46sub 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
    67sub 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
    86my $gen = 0;
    87
    88sub 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
   104my $gofmt;
   105
   106if (@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
   114select $gofmt;
   115
   116print <<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
   123package syntax
   124
   125EOF
   126
   127PrintClasses("perl", @perlclasses);
   128PrintClasses("posix", @posixclasses);
View as plain text