#!perl
use v5.41.9;
use utf8;
use re "/aa";
use feature 'signatures';
use feature 'state';
use feature 'keyword_any';
use warnings;
no warnings 'experimental::keyword_any';
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
use Unicode::UCD qw(prop_aliases
                    prop_values
                    prop_value_aliases
                    prop_invlist
                    prop_invmap search_invlist
                    charprop
                    num
                    charblock
                   );
use constant DEBUG => $ENV{DEBUG} // 0;
require './regen/regen_lib.pl';
require './regen/charset_translations.pl';
require './lib/unicore/UCD.pl';
require './regen/mph.pl';

sub stack_trace {
    my $i = 0;
    my $return = "";
    while (1) {
        my @caller = caller $i++;
        last unless @caller;
        $return .= ":" if $return;
        $return .= $caller[2];
    }

    return "; called from line(s) $return";
}

print "Starting...\n" if DEBUG;

# This program outputs charclass_invlists.inc, which contains various inversion
# lists in the form of C arrays that are to be used as-is for inversion lists.
# Thus, the lists it contains are essentially pre-compiled, and need only a
# light-weight fast wrapper to make them usable at run-time.

# As such, this code knows about the internal structure of these lists, and
# any change made to that has to be done here as well.  A random number stored
# in the headers is used to minimize the possibility of things getting
# out-of-sync, or the wrong data structure being passed.  Currently that
# random number is:

my $VERSION_DATA_STRUCTURE_TYPE = 148565664;

# Mostly this is automated when a new Unicode version is applied, but there is
# a major pain in updating the line breaking rules.  You have to go look at
# the Unicode release notes.  Any changes in  UAX #14 and UAX #29 have to be
# manually factored in here.  See the comments at BREAK_PROPERTIES in this
# file

# charclass_invlists.inc now also contains inversion maps and enum definitions
# for those maps that have a finite number of possible values

# integer or float (no exponent)
my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;

# Also includes rationals
my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x;

# More than one code point may have the same code point as their fold.  This
# gives the maximum number in the current Unicode release.  (The folded-to
# code point is not included in this count.)  Most folds are pairs of code
# points, like 'B' and 'b', so this number is at least one.
my $max_fold_froms = 1;

my %keywords;
my $table_name_prefix = "UNI_";

# Matches valid C language enum names: begins with ASCII alphabetic, then any
# ASCII \w
my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax;

my $out_fh = open_new('charclass_invlists.inc', '>',
                      {style => '*', by => 'regen/mk_invlists.pl',
                      from => "Unicode::UCD"});

my $regexp_constants_fh = open_new('regexp_constants.h', '>',
                      {style => '*', by => 'regen/mk_invlists.pl',
                      from => "Unicode::UCD"});

my $in_file_pound_if = "";

my $max_hdr_len = 3;    # In headings, how wide a name is allowed?

print $out_fh <<'EOF';
/* See the generating file for comments */

EOF

print $regexp_constants_fh <<'EOF';
/* This gives the number of code points that can be in the bitmap of an ANYOF
 * node.  The shift number must currently be one of: 8..12.  It can't be less
 * than 8 (256) because some code relies on it being at least that.  Above 12
 * (4096), and you start running into warnings that some data structure widths
 * have been exceeded, though the test suite as of this writing still passes
 * for up through 16, which is as high as anyone would ever want to go,
 * encompassing all of the Unicode BMP, and thus including all the economically
 * important world scripts.  At 12 most of them are: including Arabic,
 * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
 * Japanese, nor Korean.  The regnode sizing data structure in regnodes.h currently
 * uses a U8, and the trie types TRIEC and AHOCORASICKC are larger than U8 for
 * shift values above 12.)  Be sure to benchmark before changing, as larger sizes
 * do significantly slow down the test suite. */

EOF

my $num_anyof_code_points = '(1 << 8)';

print $regexp_constants_fh "#define NUM_ANYOF_CODE_POINTS   $num_anyof_code_points\n\n";

$num_anyof_code_points = eval $num_anyof_code_points;

no warnings 'once';
print $out_fh <<"EOF";
/* The precision to use in "%.*e" formats */
#define PL_E_FORMAT_PRECISION $Unicode::UCD::e_precision
EOF

# enums that should be made public
my %public_enums = (
                    _Perl_SCX => 1
                    );

# The symbols generated by this program are all currently defined only in a
# single dot c each.  The code knows where most of them go, but this hash
# gives overrides for the exceptions to the typical place
my %exceptions_to_where_to_define =
                        (
                            #_Perl_IVCF => 'PERL_IN_REGCOMP_C',
                        );

my %where_to_define_enums = ();

my $applies_to_all_charsets_text = "all charsets";

my %gcb_enums;
my @gcb_short_enums;
my %gcb_abbreviations;
my %lb_enums;
my @lb_short_enums;
my %lb_abbreviations;
my %wb_enums;
my @wb_short_enums;
my %wb_abbreviations;

my @a2n;

my %prop_name_aliases;
# Invert this hash so that for each canonical name, we get a list of things
# that map to it (excluding itself)
foreach my $name (sort keys %Unicode::UCD::loose_property_name_of) {
    my $canonical = $Unicode::UCD::loose_property_name_of{$name};
    push @{$prop_name_aliases{$canonical}},  $name if $canonical ne $name;
}

# Output these tables in the same vicinity as each other, so that will get
# paged in at about the same time.  These are also assumed to be the exact
# same list as those properties used internally by perl.
my %keep_together = (
                        assigned => 1,
                        ascii => 1,
                        upper => 1,
                        lower => 1,
                        title => 1,
                        cased => 1,
                        uppercaseletter => 1,
                        lowercaseletter => 1,
                        titlecaseletter => 1,
                        casedletter => 1,
                        vertspace => 1,
                        xposixalnum => 1,
                        xposixalpha => 1,
                        xposixblank => 1,
                        xposixcntrl => 1,
                        xposixdigit => 1,
                        xposixgraph => 1,
                        xposixlower => 1,
                        xposixprint => 1,
                        xposixpunct => 1,
                        xposixspace => 1,
                        xposixupper => 1,
                        xposixword => 1,
                        xposixxdigit => 1,
                        posixalnum => 1,
                        posixalpha => 1,
                        posixblank => 1,
                        posixcntrl => 1,
                        posixdigit => 1,
                        posixgraph => 1,
                        posixlower => 1,
                        posixprint => 1,
                        posixpunct => 1,
                        posixspace => 1,
                        posixupper => 1,
                        posixword => 1,
                        posixxdigit => 1,
                        _perl_any_folds => 1,
                        _perl_folds_to_multi_char => 1,
                        _perl_is_in_multi_char_fold => 1,
                        _perl_non_final_folds => 1,
                        _perl_idstart => 1,
                        _perl_idcont => 1,
                        _perl_charname_begin => 1,
                        _perl_charname_continue => 1,
                        _perl_problematic_locale_foldeds_start => 1,
                        _perl_problematic_locale_folds => 1,
                        _perl_quotemeta => 1,
                    );
my %perl_tags;  # So can find synonyms of the above properties

my $unused_table_hdr = 'u';     # Heading for row or column for unused values

sub uniques {
    # Returns non-duplicated input values.  From "Perl Best Practices:
    # Encapsulated Cleverness".  p. 455 in first edition.

    my %seen;
    return grep { ! $seen{$_}++ } @_;
}

sub caselessly { lc $a cmp lc $b }

sub a2n($cp) {

    # Returns the input Unicode code point translated to native.

    return $cp if $cp !~ $integer_or_float_re || $cp > 255;
    return $a2n[$cp];
}

sub end_file_pound_if {
    if ($in_file_pound_if) {
        print $out_fh "\n#endif\t/* $in_file_pound_if */\n";
        $in_file_pound_if = "";
    }
}

sub end_charset_pound_if {
    print $out_fh "\n" . get_conditional_compile_line_end();
}

sub switch_pound_if ($name, $new_pound_if, $charset = undef) {
    my @new_pound_if = ref ($new_pound_if)
                       ? sort @$new_pound_if
                       : $new_pound_if;

    # Switch to new #if given by the 2nd argument.  If there is an override
    # for this, it instead switches to that.  The 1st argument is the
    # static's name, used only to check if there is an override for this
    #
    # The 'charset' parmameter, if present, is used to first end the charset
    # #if if we actually do a switch, and then restart it afterwards.  This
    # code, then assumes that the charset #if's are enclosed in the file ones.

    if (exists $exceptions_to_where_to_define{$name}) {
        @new_pound_if = $exceptions_to_where_to_define{$name};
    }

    foreach my $element (@new_pound_if) {

        # regcomp.c is arranged so that the tables are not compiled in
        # re_comp.c, but general enums and defines (which take no space) are
        # compiled */
        my $no_xsub = 1 if $name !~ /enum|define/
                        && $element =~ / PERL_IN_ (?: REGCOMP ) _C /x;
        $element = "defined($element)";
        $element = "($element && ! defined(PERL_IN_XSUB_RE))" if $no_xsub;
    }
    $new_pound_if = join " || ", @new_pound_if;

    # Change to the new one if different from old
    if ($in_file_pound_if ne $new_pound_if) {

        end_charset_pound_if() if defined $charset;

        # Exit any current #if
        if ($in_file_pound_if) {
            end_file_pound_if;
        }

        $in_file_pound_if = $new_pound_if;
        print $out_fh "\n#if $in_file_pound_if\n";

        start_charset_pound_if ($charset, 1) if defined $charset;
    }
}

sub start_charset_pound_if ($charset, $indent_level=undef) {
    print $out_fh "\n"
                . get_conditional_compile_line_start($charset, $indent_level);
}

{   # Closure
    my $fh;
    my $in_doinit = 0;

    sub output_table_header($in_fh,
                            $type,         # typedef of table, like UV, UV*
                            $name,         # name of table
                            $comment = "", # Optional comment to put on header
                                           # line
                            @sizes         # Optional sizes of each array
                                           # index.  If omitted, there is a
                                           # single index whose size is
                                           # computed by the C compiler.
    ) {

        $fh = $in_fh;
        # Output to $fh the heading for a table given by the other inputs
        $type =~ s/ \s+ $ //x;

        # If a the typedef is a ptr, add in an extra const
        $type .= " const" if $type =~ / \* $ /x;

        $comment = "" unless defined $comment;
        $comment = "  /* $comment */" if $comment;

        my $array_declaration;
        if (@sizes) {
            $array_declaration = "";
            $array_declaration .= "[$_]" for @sizes;
        }
        else {
            $array_declaration = '[]';
        }

        my $declaration = "$type ${name}$array_declaration";

        # Things not matching this are static.  Otherwise, it is an external
        # constant, initialized only under DOINIT.
        #
        # (Currently everything is static)
        if ($in_file_pound_if !~ / PERL_IN_ (?: ) _C /x) {
            $in_doinit = 0;
            print $fh "\nstatic const $declaration = {$comment\n";
        }
        else {
            $in_doinit = 1;
            print $fh <<EOF;

#    ifndef DOINIT

EXTCONST $declaration;

#    else

EXTCONST $declaration = {$comment
EOF
        }
    }

    sub output_table_trailer() {

        # Close out a table started by output_table_header()

        print $fh "};\n";
        if ($in_doinit) {
            print $fh "\n#    endif  /* DOINIT */\n\n";
            $in_doinit = 0;
        }
    }
} # End closure

sub output_invlist ($name,
                    $invlist,       # Reference to inversion list array
                    $charset = "")  # name of character set for comment
{
    print "  output_invlist($name) $charset\n" if DEBUG;

    die "No inversion list for $name" unless defined $invlist
                                             && ref $invlist eq 'ARRAY';

    # Output the inversion list $invlist using the name $name for it.
    # It is output in the exact internal form for inversion lists.

    # Is the last element of the header 0, or 1 ?
    my $zero_or_one = 0;
    if (@$invlist && $invlist->[0] != 0) {
        unshift @$invlist, 0;
        $zero_or_one = 1;
    }

    $charset = "for $charset" if $charset;
    output_table_header($out_fh, "UV", "${name}_invlist", $charset);

    my $count = @$invlist;
    print $out_fh <<EOF;
\t$count,\t/* Number of elements */
\t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */
\t$zero_or_one,\t/* 0 if the list starts at 0;
\t\t   1 if it starts at the element beyond 0 */
EOF

    # The main body are the UVs passed in to this routine.  Do the final
    # element separately
    for my $i (0 .. @$invlist - 1) {
        printf $out_fh "\t0x%X", $invlist->[$i];
        print $out_fh "," if $i < @$invlist - 1;
        print $out_fh "\n";
    }

    output_table_trailer();
}

sub output_invmap ($name,
                   $invmap,       # Reference to inversion map array
                   $prop_name,
                   $input_format, # The inversion map's format
                   $default,      # The property value for code points who
                                  # otherwise don't have a value specified.
                   $extra_enums,  # comma-separated list of our additions to
                                  # the property's standard possible values
                   $charset = "") # name of character set for comment
{
    print "  output_invmap($name,$prop_name) $charset\n" if DEBUG;

    # Output the inversion map $invmap for property $prop_name, but use $name
    # as the actual data structure's name.

    my $count = @$invmap;

    my $output_format;
    my $invmap_declaration_type;
    my $enum_declaration_type;
    my $aux_declaration_type;
    my %enums;
    my $name_prefix;

    if ($input_format =~ / ^ [as] l? $ /x) {
        $prop_name = (prop_aliases($prop_name))[1]
     // $prop_name =~ s/^_Perl_//r; # Get full name
        my $short_name = (prop_aliases($prop_name))[0] // $prop_name;
        my @input_enums;

        # Find all the possible input values.  These become the enum names
        # that comprise the inversion map.  For inputs that don't have sub
        # lists, we can just get the unique values.  Otherwise, we have to
        # expand the sublists first.
        if ($input_format !~ / ^ a /x) {
            if ($input_format ne 'sl') {
                @input_enums = sort caselessly uniques(@$invmap);
            }
            else {
                foreach my $element (@$invmap) {
                    if (ref $element) {
                        push @input_enums, @$element;
                    }
                    else {
                        push @input_enums, $element;
                    }
                }
                @input_enums = sort caselessly uniques(@input_enums);
            }
        }

        # The internal enums come last, and in the order specified.
        #
        # The internal one named EDGE is also used a marker.  Any ones that
        # come after it are used in the algorithms below, and so must be
        # defined, even if the release of Unicode this is being compiled for
        # doesn't use them.   But since no code points are assigned to them in
        # such a release, those values will never be accessed.  We collapse
        # all of them into a single placholder row and a column.  The
        # algorithms below will fill in those cells with essentially garbage,
        # but they are never read, so it doesn't matter.  This allows the
        # algorithm to remain the same from release to release.
        #
        # In one case, regexec.c also uses a placeholder which must be defined
        # here, and we put it in the unused row and column as its value is
        # never read.
        #
        my @enums = @input_enums;
        my @extras;
        my @unused_enums;
        my $unused_enum_value = @enums;
        if ($extra_enums ne "") {
            @extras = split /,/, $extra_enums;
            my $seen_EDGE = 0;

            # Don't add if already there.
            foreach my $this_extra (@extras) {
                next if grep { $_ eq $this_extra } @enums;
                if ($this_extra eq 'EDGE') {
                    push @enums, $this_extra;
                    $seen_EDGE = 1;
                }
                elsif ($seen_EDGE) {
                    push @unused_enums, $this_extra;
                }
                else {
                    push @enums, $this_extra;
                }
            }

            @unused_enums = sort caselessly @unused_enums;
            $unused_enum_value = @enums;    # All unused have the same value,
                                            # one beyond the final used one
        }

        # These properties have extra tables written out for them that we want
        # to make as compact and legible as possible.  So we find short names
        # for their property values.  For non-official ones we will need to
        # add a legend at the top of the table to say what the abbreviation
        # stands for.
        my $property_needs_table_re = qr/ ^  _Perl_ (?: GCB | LB | WB ) $ /x;

        my %short_enum_name;
        my %need_explanation;   # For non-official abbreviations, we will need
                                # to explain what the one we come up with
                                # stands for
        my $type = lc $prop_name;
        if ($name =~ $property_needs_table_re) {
            my @short_names;  # List of already used abbreviations, so we
                              # don't duplicate
            for my $enum (@enums) {
                my $short_enum;
                my $is_official_name = 0;

                # Special case this wb property value to make the
                # name more clear
                if ($enum eq 'Perl_Tailored_HSpace') {
                    $short_enum = 'hs';
                }
                elsif ($enum eq 'EDGE') {
                    $short_enum = $enum;
                }
                else {
                    # lhs needs extra parens as per API
                    ($short_enum) = prop_value_aliases($type, $enum);
                    if (defined $short_enum) {
                        $is_official_name = 1;  # Use the official short name
                    }
                    else {
                        # But if there is no official name, use the name that
                        # came from the data (if any).  Otherwise, the name
                        # had to come from the extras list.  There are two
                        # types of values in that list.
                        #
                        # First are those enums that are not part of the
                        # property, but are defined by the code in this file.
                        # By convention these have all-caps names.  We use the
                        # lowercased name for these.
                        #
                        # Second are enums that are needed to get the
                        # algorithms below to work and/or to get regexec.c to
                        # compile, but don't exist in all Unicode releases.
                        # These are handled outside this loop as
                        # 'unused_enums' (as they are unused they all get
                        # collapsed into a single column, and their names
                        # don't matter)
                        if (grep { $_ eq $enum } @input_enums) {
                            $short_enum = $enum;
                        }
                        else {
                            $short_enum = lc $enum;
                        }
                    }

                    # If our short name is too long, or we already know that
                    # the name is an abbreviation, truncate to make sure it's
                    # short enough, and remember that we did this so we can
                    # later add a comment in the generated file
                    if (length $short_enum > $max_hdr_len) {
                        # First try using just the letters immediately after
                        # underscores
                        my @segments = split /_+/, $short_enum;
                        if (@segments == 2 && length $segments[0] == 2) {
                            # But for just two segments where the first is
                            # exactly two letters like 'AB_Cfoo', make that
                            # 'ABC' Many synthetic split names are like this,
                            # with the first two letters being the short name
                            # of the first property.
                            $short_enum = $segments[0]
                                        . substr($segments[1], 0, 1);
                            if (   length $segments[1] == 2
                                && grep { $_ eq $short_enum } @short_names)
                            {
                                $short_enum = $segments[0]
                                            . substr($segments[1], 1, 1);
                            }
                        }
                        else {
                            if (@segments > 2) {
                                # For 2 or more underscores, just join
                                # together the initial letters of each one
                                $short_enum = join "",
                                                   map { substr($_, 0, 1) }
                                                                    @segments;
                            }
                            else {
                                # Finally, try using just the uppercase
                                # letters of the name; if it is something like
                                # FooBar, FB is a better abbreviation than
                                # Foo.  That's not the case if it is entirely
                                # lowercase.
                                my $uc = $short_enum;
                                $uc =~ s/[[:^upper:]]//g;
                                $short_enum = $uc if length $uc > 1
                                            && length $uc < length $short_enum;
                            }

                            # Truncate to the maximum permissible length
                            $short_enum = substr($short_enum, 0, $max_hdr_len);
                            $is_official_name = 0;
                        }

                        # If the name we are to display conflicts, try another.
                        if (grep { $_ eq $short_enum } @short_names) {
                            $is_official_name = 0;
                            do { # The increment operator on strings doesn't
                                 # work on those containing an '_', so get rid
                                 # of any final portion.
                                $short_enum =~ s/_//g;
                                $short_enum++;
                            } while grep { $_ eq $short_enum } @short_names;
                        }
                    }
                }

                push @short_names, $short_enum;
                $short_enum_name{$enum} = $short_enum;
                $need_explanation{$enum} = $short_enum unless $is_official_name;
            }
        } # End of calculating short enum names for certain properties

        # Assign a value to each element of the enum type we are creating.
        # The default value always gets 0; the others are arbitrarily
        # assigned, but for the properties which have the extra table, it is
        # in the order we have computed above so the rows and columns appear
        # alphabetically by heading abbreviation, except we make the edge last
        my $enum_val = 0;
        my $canonical_default = prop_value_aliases($prop_name, $default);
        $default = $canonical_default if defined $canonical_default;
        $enums{$default} = $enum_val++;

        for my $enum (sort {
                             ($name !~ $property_needs_table_re)
                             ? lc $a cmp lc $b
                             : $a eq 'EDGE'
                               ? 1
                               : $b eq 'EDGE'
                                 ? -1
                                 :     lc $short_enum_name{$a}
                                   cmp lc $short_enum_name{$b}
                                    or $a cmp $b
                           } @enums)
        {
            $enums{$enum} = $enum_val++ unless exists $enums{$enum};
        }

        # Now calculate the data for the special tables output for these
        # properties.
        if ($name =~ $property_needs_table_re) {

            # The data includes the hashes %gcb_enums, %lb_enums, etc.
            # Similarly we calculate column headings for the tables.
            #
            # We use string evals to allow the same code to work on
            # all the tables

            # Skip if we've already done this code, which populated
            # this hash
            if (eval "! \%${type}_enums") {

                # For each enum in the type ...
                foreach my $enum (keys %enums) {
                    my $value = $enums{$enum};
                    my $short_enum = $short_enum_name{$enum};

                    # Remember the mapping from the property value
                    # (enum) name to its value.
                    eval "\$${type}_enums{$enum} = $value";
                    die $@ if $@;

                    # Remember the inverse mapping to the short name
                    # so that we can properly label the generated
                    # table's rows and columns
                    eval "\$${type}_short_enums[$value] = '$short_enum'";
                    die $@ if $@;

                    # And note the abbreviations that need explanation
                    if ($need_explanation{$enum}) {
                        eval "\$${type}_abbreviations{$short_enum} = '$enum'";
                        die $@ if $@;
                    }
                }

                # Each unused enum has the same value.  They all are collapsed
                # into one row and one column, named $unused_table_hdr.
                if (@unused_enums) {
                    eval "\$${type}_short_enums['$unused_enum_value'] = '$unused_table_hdr'";
                    die $@ if $@;

                    foreach my $enum (@unused_enums) {
                        eval "\$${type}_enums{$enum} = $unused_enum_value";
                        die $@ if $@;
                    }
                }
            }
        }

        # The short property names tend to be two lower case letters, but it
        # looks better for those if they are upper. XXX
        $short_name = uc($short_name) if length($short_name) < 3
                                || substr($short_name, 0, 1) =~ /[[:lower:]]/;
        $name_prefix = "${short_name}_";

        # Start the enum definition for this map
        my @enum_definition;
        my @enum_list;
        foreach my $enum (keys %enums) {
            $enum_list[$enums{$enum}] = $enum;
        }
        foreach my $i (0 .. @enum_list - 1) {
            push @enum_definition, ",\n" if $i > 0;

            my $name = $enum_list[$i];
            push @enum_definition, "\t${name_prefix}$name = $i";
        }
        if (@unused_enums) {
            foreach my $unused (@unused_enums) {
                push @enum_definition,
                            ",\n\t${name_prefix}$unused = $unused_enum_value";
            }
        }

        # For an 'l' property, we need extra enums, because some of the
        # elements are lists.  Each such distinct list is placed in its own
        # auxiliary map table.  Here, we go through the inversion map, and for
        # each distinct list found, create an enum value for it, numbered -1,
        # -2, ....
        my %multiples;
        my $aux_table_prefix = "AUX_TABLE_";
        if ($input_format =~ /l/) {
            foreach my $element (@$invmap) {

                # A regular scalar is not one of the lists we're looking for
                # at this stage.
                next unless ref $element;

                my $joined;
                if ($input_format =~ /a/) { # These are already ordered
                    $joined = join ",", @$element;
                }
                else {
                    $joined = join ",", sort caselessly @$element;
                }
                my $already_found = exists $multiples{$joined};

                my $i;
                if ($already_found) {   # Use any existing one
                    $i = $multiples{$joined};
                }
                else {  # Otherwise increment to get a new table number
                    $i = keys(%multiples) + 1;
                    $multiples{$joined} = $i;
                }

                # This changes the inversion map for this entry to not be the
                # list
                $element = "use_$aux_table_prefix$i";

                # And add to the enum values
                if (! $already_found) {
                    push @enum_definition, ",\n\t${name_prefix}$element = -$i";
                }
            }
        }

        $enum_declaration_type = "${name_prefix}enum";

        # Finished with the enum definition.  Inversion map stuff is used only
        # by regexec or utf-8 (if it is for code points) , unless it is in the
        # enum exception list
        my $where = (exists $where_to_define_enums{$name})
                    ? $where_to_define_enums{$name}
                    : ($input_format =~ /a/)
                       ? 'PERL_IN_UTF8_C'
                       : 'PERL_IN_REGEXEC_C';

        if (! exists $public_enums{$name}) {
            switch_pound_if($name, $where, $charset);
        }
        else {
            end_charset_pound_if;
            end_file_pound_if;
            start_charset_pound_if($charset, 1);
        }

        # If the enum only contains one element, that is a dummy, default one
        if (scalar @enum_definition > 1) {

            # Currently unneeded
            #print $out_fh "\n#define ${name_prefix}ENUM_COUNT ",
            #                                   ..scalar keys %enums, "\n";

            if ($input_format =~ /l/) {
                print $out_fh
                "\n",
                "/* Negative enum values indicate the need to use an",
                    " auxiliary table\n",
                " * consisting of the list of enums this one expands to.",
                    "  The absolute\n",
                " * values of the negative enums are indices into a table",
                    " of the auxiliary\n",
                " * tables' addresses */";
            }
            print $out_fh "\ntypedef enum {\n";
            print $out_fh join "", @enum_definition;
            print $out_fh "\n";
            print $out_fh "} $enum_declaration_type;\n";
        }

        switch_pound_if($name, $where, $charset);

        # The inversion lists here have to be UV because inversion lists are
        # capable of storing any code point, and even though the ones here
        # are only Unicode ones, which need just 21 bits, they are linked to
        # directly, rather than copied.  The inversion map and aux tables also
        # only need be 21 bits, and so we can get away with declaring them
        # 32-bits to save a little space and memory (on some 64-bit
        # platforms), as they are copied.
        $invmap_declaration_type = ($input_format =~ /s/)
                                 ? $enum_declaration_type
                                 : "I32";
        $aux_declaration_type = ($input_format =~ /s/)
                                 ? $enum_declaration_type
                                 : "U32";

        $output_format = "${name_prefix}%s";

        # If there are auxiliary tables, output them.
        if (%multiples) {

            print $out_fh "\n#define HAS_${name_prefix}AUX_TABLES\n";

            # Invert keys and values
            my %inverted_mults;
            while (my ($key, $value) = each %multiples) {
                $inverted_mults{$value} = $key;
            }

            # Output them in sorted order
            my @sorted_table_list = sort { $a <=> $b } keys %inverted_mults;

            # Keep track of how big each aux table is
            my @aux_counts;

            # Output each aux table.
            foreach my $table_number (@sorted_table_list) {
                my $table = $inverted_mults{$table_number};
                output_table_header($out_fh,
                                $aux_declaration_type,
                                "$name_prefix$aux_table_prefix$table_number");

                # Earlier, we joined the elements of this table together with
                # a comma
                my @elements = split ",", $table;

                $aux_counts[$table_number] = scalar @elements;
                for my $i (0 .. @elements - 1) {
                    print $out_fh  ",\n" if $i > 0;
                    if ($input_format =~ /a/) {
                        printf $out_fh "\t0x%X", $elements[$i];
                    }
                    else {
                        print $out_fh "\t${name_prefix}$elements[$i]";
                    }
                }

                print $out_fh "\n";
                output_table_trailer();
            }

            # Output the table that is indexed by the absolute value of the
            # aux table enum and contains pointers to the tables output just
            # above
            output_table_header($out_fh, "$aux_declaration_type *",
                                   "${name_prefix}${aux_table_prefix}ptrs");
            print $out_fh "\tNULL,\t/* Placeholder */\n";
            for my $i (1 .. @sorted_table_list) {
                print $out_fh  ",\n" if $i > 1;
                print $out_fh  "\t$name_prefix$aux_table_prefix$i";
            }
            print $out_fh "\n";
            output_table_trailer();

            print $out_fh
              "\n/* Parallel table to the above, giving the number of elements"
            . " in each table\n * pointed to */\n";
            output_table_header($out_fh, "U8",
                                   "${name_prefix}${aux_table_prefix}lengths");
            print $out_fh "\t0,\t/* Placeholder */\n";
            for my $i (1 .. @sorted_table_list) {
                print $out_fh ",\n" if $i > 1;
                print $out_fh
                    "\t$aux_counts[$i]\t/* $name_prefix$aux_table_prefix$i */";
            }
            print $out_fh "\n";
            output_table_trailer();
        } # End of outputting the auxiliary and associated tables

        # The scx property used in regexec.c needs a specialized table which
        # is most convenient to output here, while the data structures set up
        # above are still extant.  This table contains the code point that is
        # the zero digit of each script, indexed by script enum value.
        if (lc $short_name eq 'scx') {
            my @decimals_invlist = prop_invlist("Numeric_Type=Decimal");
            my %script_zeros;

            # Find all the decimal digits.  The 0 of each range is always the
            # 0th element, except in some early Unicode releases, so check for
            # that.
            for (my $i = 0; $i < @decimals_invlist; $i += 2) {
                my $code_point = $decimals_invlist[$i];
                next if num(chr($code_point)) ne '0';

                # Turn the scripts this zero is in into a list.
                my @scripts = split ",",
                  charprop($code_point, "_Perl_SCX", '_perl_core_internal_ok');
                $code_point = sprintf("0x%x", $code_point);

                foreach my $script (@scripts) {
                    if (! exists $script_zeros{$script}) {
                        $script_zeros{$script} = $code_point;
                    }
                    elsif (ref $script_zeros{$script}) {
                        push $script_zeros{$script}->@*, $code_point;
                    }
                    else {  # Turn into a list if this is the 2nd zero of the
                            # script
                        my $existing = $script_zeros{$script};
                        undef $script_zeros{$script};
                        push $script_zeros{$script}->@*, $existing, $code_point;
                    }
                }
            }

            # @script_zeros contains the zero, sorted by the script's enum
            # value
            my @script_zeros;
            foreach my $script (keys %script_zeros) {
                my $enum_value = $enums{$script};
                $script_zeros[$enum_value] = $script_zeros{$script};
            }

            print $out_fh
            "\n/* This table, indexed by the script enum, gives the zero"
          . " code point for that\n * script; 0 if the script has multiple"
          . " digit sequences.  Scripts without a\n * digit sequence use"
          . " ASCII [0-9], hence are marked '0' */\n";
            output_table_header($out_fh, "UV", "script_zeros");
            for my $i (0 .. @script_zeros - 1) {
                my $code_point = $script_zeros[$i];
                if (defined $code_point) {
                    $code_point = " 0" if ref $code_point;
                    print $out_fh "\t$code_point";
                }
                elsif (lc $enum_list[$i] eq 'inherited') {
                    print $out_fh "\t 0";
                }
                else {  # The only digits a script without its own set accepts
                        # is [0-9]
                    print $out_fh "\t'0'";
                }
                print $out_fh "," if $i < @script_zeros - 1;
                print $out_fh "\t/* $enum_list[$i] */";
                print $out_fh "\n";
            }
            output_table_trailer();
        } # End of special handling of scx
    }
    else {
        die "'$input_format' invmap() format for '$prop_name' unimplemented";
    }

    die "No inversion map for $prop_name" unless defined $invmap
                                             && ref $invmap eq 'ARRAY'
                                             && $count;

    # Now output the inversion map proper
    $charset = "for $charset" if $charset;
    output_table_header($out_fh, $invmap_declaration_type,
                                    "${name}_invmap",
                                    $charset);

    # The main body are the scalars passed in to this routine.
    for my $i (0 .. $count - 1) {
        my $element = $invmap->[$i];
        my $full_element_name = prop_value_aliases($prop_name, $element);
        if ($input_format =~ /a/ && $element !~ /\D/) {
            $element = ($element == 0)
                       ? 0
                       : sprintf("0x%X", $element);
        }
        else {
        $element = $full_element_name if defined $full_element_name;
        $element = $name_prefix . $element;
        }
        print $out_fh "\t$element";
        print $out_fh "," if $i < $count - 1;
        print $out_fh  "\n";
    }
    output_table_trailer();
}

sub mk_invlist_from_sorted_cp_list($list_ref) {

    # Returns an inversion list constructed from the sorted input array of
    # code points

    return unless @$list_ref;

    # Initialize to just the first element
    my @invlist = ( $list_ref->[0], $list_ref->[0] + 1);

    # For each succeeding element, if it extends the previous range, adjust
    # up, otherwise add it.
    for my $i (1 .. @$list_ref - 1) {
        if ($invlist[-1] == $list_ref->[$i]) {
            $invlist[-1]++;
        }
        else {
            push @invlist, $list_ref->[$i], $list_ref->[$i] + 1;
        }
    }
    return @invlist;
}

print "Reading Case Folding rules.\n" if DEBUG;
# Read in the Case Folding rules, and construct arrays of code points for the
# properties we need.
my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding");
die "Could not find inversion map for Case_Folding" unless defined $format;
die "Incorrect format '$format' for Case_Folding inversion map"
                                                    unless $format eq 'al'
                                                           || $format eq 'a';
print "Finished reading Case Folding rules.\n" if DEBUG;


sub _Perl_IVCF {

    # This creates a map of the inversion of case folding. i.e., given a
    # character, it gives all the other characters that fold to it.
    #
    # Inversion maps function kind of like a hash, with the inversion list
    # specifying the buckets (keys) and the inversion maps specifying the
    # contents of the corresponding bucket.  Effectively this function just
    # swaps the keys and values of the case fold hash.  But there are
    # complications.  Most importantly, More than one character can each have
    # the same fold.  This is solved by having a list of characters that fold
    # to a given one.

    my %new;

    # Go through the inversion list.
    for (my $i = 0; $i < @$cp_ref; $i++) {

        # Skip if nothing folds to this
        next if $folds_ref->[$i] == 0;

        # This entry which is valid from here to up (but not including) the
        # next entry is for the next $count characters, so that, for example,
        # A-Z is represented by one entry.
        my $cur_list = $cp_ref->[$i];
        my $count = $cp_ref->[$i+1] - $cur_list;

        # The fold of [$i] can be not just a single character, but a sequence
        # of multiple ones.  We deal with those here by just creating a string
        # consisting of them.  Otherwise, we use the single code point [$i]
        # folds to.
        my $cur_map = (ref $folds_ref->[$i])
                       ? join "", map { chr } $folds_ref->[$i]->@*
                       : $folds_ref->[$i];

        # Expand out this range
        while ($count > 0) {
            push @{$new{$cur_map}}, $cur_list;

            # A multiple-character fold is a string, and shouldn't need
            # incrementing anyway
            if (ref $folds_ref->[$i]) {
                die sprintf("Case fold for %x is multiple chars; should have"
                          . " a count of 1, but instead it was $count", $count)
                                                            unless $count == 1;
            }
            else {
                $cur_map++;
                $cur_list++;
            }
            $count--;
        }
    }

    # Now go through and make some adjustments.  We add synthetic entries for
    # three cases.
    # 1) If the fold of a Latin1-range character is above that range, some
    #    coding in regexec.c can be saved by creating a reverse map here.  The
    #    impetus for this is that U+B5 (MICRO SIGN) folds to the Greek small
    #    mu (U+3BC).  That fold isn't done at regex pattern compilation time
    #    if it means that the pattern would have to be translated into UTF-8,
    #    whose operation is slower.  At run time, having this reverse
    #    translation eliminates some special cases in the code.
    # 2) Two or more code points can fold to the same multiple character,
    #    sequence, as U+FB05 and U+FB06 both fold to 'st'.  This code is only
    #    for single character folds, but FB05 and FB06 are single characters
    #    that are equivalent folded, so we add entries so that they are
    #    considered to fold to each other
    # 3) If two or more above-Latin1 code points fold to the same Latin1 range
    #    one, we also add entries so that they are considered to fold to each
    #    other.  This is so that under /aa or /l matching, where folding to
    #    their Latin1 range code point is illegal, they still can fold to each
    #    other.  This situation happens in Unicode 3.0.1, but probably no
    #    other version.
    foreach my $fold (keys %new) {
        my $folds_to_string = $fold =~ /\D/;

        # If the bucket contains only one element, convert from an array to a
        # scalar
        if (scalar $new{$fold}->@* == 1) {
            $new{$fold} = $new{$fold}[0];

            # Handle case 1) above: if there were a Latin1 range code point
            # whose fold is above that range, this creates an extra entry that
            # maps the other direction, and would save some special case code.
            # (The one current case of this is handled in the else clause
            # below.)
            $new{$new{$fold}} = $fold if $new{$fold} < 256 && $fold > 255;
        }
        else {

            # Handle case 1) when there are multiple things that fold to an
            # above-Latin1 code point, at least one of which is in Latin1.
            if (! $folds_to_string && $fold > 255) {
                foreach my $cp ($new{$fold}->@*) {
                    if ($cp < 256) {
                        my @new_entry = grep { $_ != $cp } $new{$fold}->@*;
                        push @new_entry, $fold;
                        $new{$cp}->@* = @new_entry;
                    }
                }
            }

            # Otherwise, sort numerically.  This places the highest code point
            # in the list at the tail end.  This is because Unicode keeps the
            # lowercase code points as higher ordinals than the uppercase, at
            # least for the ones that matter so far.  These are synthetic
            # entries, and we want to predictably have the lowercase (which is
            # more likely to be what gets folded to) in the same corresponding
            # position, so that other code can rely on that.  If some new
            # version of Unicode came along that violated this, we might have
            # to change so that the sort is based on upper vs lower instead.
            # (The lower-comes-after isn't true of native EBCDIC, but here we
            # are dealing strictly with Unicode values).
            @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@*
                                                        unless $folds_to_string;
            # We will be working with a copy of this sorted entry.
            my @source_list = $new{$fold}->@*;
            if (! $folds_to_string) {

                # This handles situation 2) listed above, which only arises if
                # what is being folded-to (the fold) is in the Latin1 range.
                if ($fold > 255 ) {
                    undef @source_list;
                }
                else {
                    # And it only arises if there are two or more folders that
                    # fold to it above Latin1.  We look at just those.
                    @source_list = grep { $_ > 255 } @source_list;
                    undef @source_list if @source_list == 1;
                }
            }

            # Here, we've found the items we want to set up synthetic folds
            # for.  Add entries so that each folds to each other.
            foreach my $cp (@source_list) {
                my @rest = grep { $cp != $_ } @source_list;
                if (@rest == 1) {
                    $new{$cp} = $rest[0];
                }
                else {
                    push @{$new{$cp}}, @rest;
                }
            }
        }

        # We don't otherwise deal with multiple-character folds
        delete $new{$fold} if $folds_to_string;
    }


    # Now we have a hash that is the inversion of the case fold property.
    # First find the maximum number of code points that fold to the same one.
    foreach my $fold_to (keys %new) {
        if (ref $new{$fold_to}) {
            my $folders_count = scalar @{$new{$fold_to}};
            $max_fold_froms = $folders_count if $folders_count > $max_fold_froms;
        }
    }

    # Then convert the hash to an inversion map.
    my @sorted_folds = sort { $a <=> $b } keys %new;
    my (@invlist, @invmap);

    # We know that nothing folds to the controls (whose ordinals start at 0).
    # And the first real entries are the lowest in the hash.
    push @invlist, 0, $sorted_folds[0];
    push @invmap, 0, $new{$sorted_folds[0]};

    # Go through the remainder of the hash keys (which are the folded code
    # points)
    for (my $i = 1; $i < @sorted_folds; $i++) {

        # Get the current one, and the one prior to it.
        my $fold = $sorted_folds[$i];
        my $prev_fold = $sorted_folds[$i-1];

        # If the current one is not just 1 away from the prior one, we close
        # out the range containing the previous fold, and know that the gap
        # doesn't have anything that folds.
        if ($fold - 1 != $prev_fold) {
            push @invlist, $prev_fold + 1;
            push @invmap, 0;

            # And start a new range
            push @invlist, $fold;
            push @invmap, $new{$fold};
        }
        elsif ($new{$fold} - 1 != $new{$prev_fold}) {

            # Here the current fold is just 1 greater than the previous, but
            # the new map isn't correspondingly 1 greater than the previous,
            # the old range is ended, but since there is no gap, we don't have
            # to insert anything else.
            push @invlist, $fold;
            push @invmap, $new{$fold};

        } # else { Otherwise, this new entry just extends the previous }

        die "In IVCF: $invlist[-1] <= $invlist[-2]"
                                               if $invlist[-1] <= $invlist[-2];
    }

    # And add an entry that indicates that everything above this, to infinity,
    # does not have a case fold.
    push @invlist, $sorted_folds[-1] + 1;
    push @invmap, 0;

    push @invlist, 0x110000;
    push @invmap, 0;

    # All Unicode versions have some places where multiple code points map to
    # the same one, so the format always has an 'l'
    return \@invlist, \@invmap, 'al', $default;
}

sub prop_name_for_cmp ($name) { # Sort helper

    # Returns the input lowercased, with non-alphas removed, as well as
    # everything starting with a comma

    $name =~ s/,.*//;
    $name =~ s/[[:^alpha:]]//g;
    return lc $name;
}

sub UpperLatin1 {
    my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
    return \@return;
}

sub _Perl_CCC_non0_non230 {

    # Create an inversion list of code points with non-zero canonical
    # combining class that also don't have 230 as the class number.  This is
    # part of a Unicode Standard rule

    my @nonzeros = prop_invlist("ccc=0");
    shift @nonzeros;    # Invert so is "ccc != 0"

    my @return;

    # Expand into list of code points, while excluding those with ccc == 230
    for (my $i = 0; $i < @nonzeros; $i += 2) {
        my $upper = ($i + 1) < @nonzeros
                    ? $nonzeros[$i+1] - 1      # In range
                    : $Unicode::UCD::MAX_CP;  # To infinity.
        for my $j ($nonzeros[$i] .. $upper) {
            my @ccc_names = prop_value_aliases("ccc", charprop($j, "ccc"));

            # Final element in @ccc_names will be all numeric
            push @return, $j if $ccc_names[-1] != 230;
        }
    }

    @return = sort { $a <=> $b } @return;
    @return = mk_invlist_from_sorted_cp_list(\@return);
    return \@return;
}

# BREAK_PROPERTIES

# All but the Sentence Break properties are implemented by two-dimensional
# tables, with additional small DFAs for when the tables are insufficient.
# (SB does not lend itself to tabular lookup, and is rarely changed, so it is
# all done in code in regexec.c.)  Unicode publishes properties which assign a
# break class to every Unicode code point, even ones that haven't been
# assigned to be characters.  (Perl uses that class for all non-Unicode code
# points.)  Unicode also publishes rules for breaking based on those break
# classes.  Here we create tables for each break property that for a string
# xy, which have break classes x' and y', we tell whether a break is allowed
# between x and y or not.  The rows of this table are the various x'; the
# columns, the y'.  Often the table entry will be just the booleans 0 or 1.
# But increasingly in newer Unicode versions, more context is needed to make
# this determination.  Looking around at the context requires a DFA.  Each of
# these is hand-coded in regexec.c, and is identified by a number which is
# a case: in a switch() statement there.  This program creates #defines for
# those DFA numbers.  XXX an enhancement would be to make these enums.  The
# (x,y) cell contents when a DFA is needed are described below.
#
# The Unicode rules are listed in UAX #14 and UAX #29 in priority order for
# each type of break.  When context is needed, more than one DFA may apply to
# a given cell.  For example, in the Line Break property, when x is a space,
# and y is almost anything else, we have to look behind to see what came
# before the space. (Usualy we have to back up to the first non-space when
# there are multiple spaces in a row.)  If that non-space is a quote we likely
# will have a different rule than if it is a right parenthesis.  For all cells
# in this type of situation, this program creates a chain of DFAs to apply in
# priority order.  The first one that matches the situation is used; if none
# do, there is a fallback 0 or 1 that ends the chain.
#
# This program creates a linear array of all the chains strung together.  What
# gets stored in the (x,y) cell of the main table is the index into this array
# where the first DFA number for its chain is stored.
#
# Unicode no longer feels constrained to make their rules easy to implement
# in a pair-wise table.  An example is in Unicode 15.1, where new GCB rules
# make use of a new property, Indic_Conjunct_Break that is unrelated to GCB.
# In order for Perl to continue using the table, we have to make new
# equivalence classes in GCB for the Indic property values.  Thus we would
# need to split the code points in class GCBx into the ones that are in
# GCBx-nonIndic, the ones that are in GCBx-Indic1, the ones that are in
# GCBx-Indic2, ....  And class GCBx would be subdivided into the appropriate
# subclasses.  (It turns out that many of these don't contain any code points,
# so aren't actually needed)  It is now possible to tell mktables what a split
# should be, and it takes care of the rest, passing to this program the
# results, in a data structure.

# These functions access the cells of a break table, converting any mnemonics
# to numeric.  They need $enums to be able to do this.
sub expand_column($table_size, $splits, $enums, $x) {
    print STDERR __FILE__, ": ", __LINE__, ": Entering expand_column ",
                 stack_trace(), "\n",
                 Dumper $x, $table_size, $enums, $splits if DEBUG;

    # Expand a row or column denoted by $x into its constituents.  $x may be
    # one of:
    #   '*'     Use the entire column
    #   A number giving the enum value of the column
    #   A string giving the full name enum value of the column
    #   A list, each element of which can be a number or string as above,
    #       or another list.  The first element of the list may be the single
    #       character '^' which means to expand to everything (except edges)
    #       but the remainder of the list.
    #   If the string contains any number of substrings '_sans_', it will be
    #   split by the substring and the split sections ware considered names to
    #       be individually expanded and the result subtracted from the
    #       leftmost name.  So A_sans_B_sans_C is equivalent to
    #       (A - B) + (A - C)

    my @list;
    my @excludes;
    if (ref $x) {
        if ($x->[0] eq '^') {
            push @list, expand_column($table_size, $splits, $enums, '*')->@*;
            # Get rid of the '^' and expand the input, yielding a list of
            # things to exclude
            @excludes = expand_column($table_size, $splits, $enums,
                                                     [ @$x[1 .. $#$x] ])->@*;

            # Unicode doesn't consider this to be something to be part of the
            # complement of.
            push @excludes, 'EDGE';
        }
        else {
            push @list, expand_column($table_size, $splits, $enums, $_)->@*
                                                                    for $x->@*;
        }
    }
    elsif ($x eq '*') { # Call recursively with
        push @list, expand_column($table_size, $splits, $enums, $_)->@*
                                                     for 0 .. $table_size - 1;
    }
    elsif ($x =~ /_sans_/) {
        my @groups = split /_sans_/, $x;
        push @list, expand_column($table_size, $splits, $enums, $groups[0])->@*;
        push @excludes, expand_column($table_size, $splits, $enums,
                                      $groups[$_])->@* for 1 .. $#groups;
    }
    elsif ($splits->{$x}) {
        # If this single item $x expands to multiple ones, it will be a key in
        # %splits, and what it is to be replaced by is the value of the key.
        # In order to avoid infinite recursion, $x is not expanded, but tacked
        # on as-is, should the expansion include it.
        my @split_expansion = $splits->{$x}->@*;
        my @sans_x = grep { $_ ne $x } @split_expansion;
        push @list, expand_column($table_size, $splits, $enums, \@sans_x)->@*;

        # If it was in the original, the removed array will be smaller
        # than the original.
        push @list, $x if @sans_x < @split_expansion;
    }
    elsif ($x ne "") {
        push @list, $x;
    }
    else {
        die "Trying to expand empty string"
          . stack_trace() . "\n" . Dumper $enums;
    }

    for my $which (\@list, \@excludes) {
        foreach my $element ($which->@*) {
            next unless $element =~ /\D/;
            $element = $enums->{$element};
        }
    }

    # Map everything to a number
    for my $which (\@list, \@excludes) {
        foreach my $element ($which->@*) {
            next unless $element =~ /\D/;
            $element = $enums->{$element};
        }
    }

    my %list;
    $list{$_} = 1 for @list;
    delete $list{$_} for @excludes;     # This is how we exclude things
    @list = keys %list;

    if (@list == 0 || @list == 1 && $list[0] eq "") {
        die "Expansion is to nothing" . stack_trace() . "\n"
          . Dumper $x, $splits, $enums;
    }

    print STDERR __FILE__, ": ", __LINE__, ": expanded column returning ",
                 Dumper \@list if DEBUG;
    return \@list;
}

sub get_cell_list($table_size, $splits, $enums, $x, $y, $me_too = undef) {
    my @x = expand_column($table_size, $splits, $enums, $x)->@*;
    my @y = expand_column($table_size, $splits, $enums, $y)->@*;
    my @list;

    if (! $me_too) {
        for my $row (@x) {
            push @list, [$row, $_], for @y;
        }
    }
    else {

        # $me_too is a hashref that ties together multiple cells so that when
        # the master cell is to be changed, the follower cells automatically
        # have the same thing happen.  All that is needed is to look for tied
        # cells whenever we are generating a list of them, and then add the
        # follower cells to the list.
        for my $row (@x) {
            for my $column (@y) {
                push @list, [$row, $column];
                my $me_too_key = "$row,$column";
                if ($me_too->{$me_too_key}) {
                    foreach my $pair ($me_too->{$me_too_key}->@*) {
                        my $copy_x = $pair->[0];
                        my $copy_y = $pair->[1];
                        next if any {   $copy_x == $_->[0]
                                     && $copy_y == $_->[1]
                                    } @list;
                        push @list, [ $copy_x, $copy_y ];
                    }
                }
            }
        }
    }

    # It's a lot easier to work with under debugging if the list is sorted.
    @list = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @list
                                                                    if DEBUG;

    return \@list;
}

sub set_cells($table, $table_size, $splits, $enums, $x, $y, $value, $rule,
              $has_unused, $me_too = undef)
{
    print STDERR __FILE__, ": ", __LINE__, ": Entering set_cells",
                 stack_trace(), "\n",
                 Dumper $x, $y, $value, $rule, $has_unused, $me_too, $enums
                                                                if DEBUG;
    # Set cells given by ($x,$y) in $table (whose size is $table_size) to
    # $value. $x and/or $y may expand to multiple cells.  All are set to
    # $value.  $splits, $enums, and $me_too give data to help in performing
    # that expansion.  All such are set to $value, and $rule is associated
    # with why they are set here.
    # $has_unused indicates if there is a row and column of unused values in
    #   this Unicode version.  This will always be true with modern Unicodes.
    #
    # $value is a scalar if the cell is to receive an unconditional value.
    # Otherwise it is an arrayref that determines a DFA to run. [0] is the
    # name of the DFA, and [1] is the value to return should the DFA match.

    # Unicode gives a list of rules to check, in priority order.  The first
    # one that matches ends the process, and what it says to return is what
    # regexec.c uses.  This function is called with the highest priority rules
    # first.  So an unconditional value already in the cell has higher
    # priority than whatever the current call says, and that wins out.  But a
    # DFA is conditional; only if it matches does it return; otherwise the
    # next lower priority thing is tried, ending with an unconditional value.
    # For these, this return keeps an array in the cell containing the DFAs to
    # try, in order.  A new one to be added is simply pushed to the end of the
    # array.  Eventually, an unconditional value will be passed, and that
    # becomes the fallback value to return if none of the higher priority DFAs
    # match.  Should this function be called with another DFA after that, it
    # would have no effect, as the unconditional value would prevail, so such
    # calls don't get added to the list.

    if (! defined $value) {
        die "Setting cells to undef"
            . stack_trace() . "\n"
            . Dumper $enums, $x, $y, $value, $rule;
    }

    if (! defined $rule) {
        die "Undefined rule"
            . stack_trace() . "\n"
            . Dumper $enums, $x, $y, $value;
    }

    # Currently don't handle multiple rules; just take the first
    $rule = $rule->[0] if ref $rule;

    # If rule isn't strictly numeric, make it so while defining
    # $rule_as_string to include the non-numerics.
    my $rule_as_string;
    my $numeric_rule = $rule;
    if ($numeric_rule =~ s/\D//g) {
        $rule_as_string = $rule;
        $rule = $numeric_rule;
    }

    # The new entry is a scalar if it is an unconditional value; otherwise it
    # is an array defining the DFA.
    my $new_entry;
    if (ref $value) {   # The interpreter will die if it isn't an array, so no
                        # need to check ourselves
        # The array has the enum name in [0], and the value to return if it
        # matches in [1].
        if ($value->[1] =~ /\D/) {
            die "Setting cells to a non-numeric return in [1]"
              . stack_trace() . "\n"
              . Dumper $enums, $x, $y, $value, $rule;
        }

        $new_entry = $value;
    }
    else {  # new value is unconditional
        if ($value =~ /\D/) {
            die "Setting cells to a non-numeric value "
              . stack_trace() . "\n"
              . Dumper $enums, $x, $y, $value, $rule;
        }

        $new_entry = { value => $value, rule => $rule };
        $new_entry->{rule_as_string} = $rule_as_string
                                                   if defined $rule_as_string;
    }

    # Expand the inputs to the actual list of cells this call applies to
    my $list_ref = get_cell_list($table_size, $splits, $enums, $x, $y,
                                 $me_too);

    # For each such cell ...
    for my $pair_ref ($list_ref->@*) {

        # Get its x and y coordinates
        my $x = $pair_ref->[0];
        my $y = $pair_ref->[1];

        # Check its validity
        for my $which (\$x, \$y) {
            if ($$which =~ /\D/) {
                my $resolves_to = $enums->{$$which};
                if (! defined $resolves_to) {
                    die "cell index $$which is unknown when trying to set"
                      . " [$x,$y] to $value"
                      . stack_trace() . "\n"
                      . Dumper $enums;
                }

                $$which = $resolves_to;
            }

            next if $$which < $table_size;

            die "Setting cell [$x,$y] outside table bounds of"
              . " [$table_size,$table_size]"
              . stack_trace() . "\n"
              . Dumper $enums;
        }

        # Now ready to set its contents.  If nothing is currently in the cell,
        # can add this value without needing to know anything else about it.
        if (! defined $table->[$x][$y]) {

            # But handle cells that are unused in current Unicode specially.
            if ($has_unused && (   $x == $table_size - 1
                                || $y == $table_size - 1))
            {
                # A cell in the last row or column is unused,  Its contents
                # are immaterial, except it is better to not put a dfa in it,
                # as that might be the only use of that dfa, so it is
                # effectively unused, and keeping it out here means we can do
                # #ifdef's in regexec.c to not actually generate code for it.
                # 0 for the value could just as easily have been 1.
                $table->[$x][$y] = { value => 0, rule => $rule };
            }
            elsif (ref $new_entry eq 'ARRAY') {
                push $table->[$x][$y]->@*, $new_entry->@*;
            }
            else {
                $table->[$x][$y] = $new_entry;
            }
        }
        elsif (ref $table->[$x][$y] eq 'HASH') {

            # Here the cell's value is an unconditional one.  That means it
            # has been locked with a higher priority rule than this new one.
            next;
        }
        elsif (ref $table->[$x][$y] ne 'ARRAY') {
            die "Somehow cell [$x,$y] is wrongly not an array"
              . " [$table_size,$table_size]"
              . stack_trace() . "\n"
              . Dumper $enums;
        }
        elsif ($table->[$x][$y]->@* % 2 == 1) {

            # Here the cell's value is an array with an odd number of
            # elements.  The final one, making it odd, must be an
            # unconditional fall-back rule to use if all the dfa's fail.  So
            # the cell is locked.
            next;
        }
        else {

            # Otherwise, the cell is an array with an even number of elements,
            # so is available to add this lower priority rule to.
            if (ref $new_entry eq 'ARRAY') {

                # But it is possible for this function to get called multiple
                # times with the same value.  Don't add it if already there.
                # Theoretically, any existing occurrence would be only the
                # final DFA, in element [-2].
                next if $value->[0] eq $table->[$x][$y][-2];

                push $table->[$x][$y]->@*, $new_entry->@*;
            }
            else {  # Will be a hashref
                push $table->[$x][$y]->@*, $new_entry;
            }
        }

        print STDERR __FILE__, ": ", __LINE__,
          ": Just set \$table->[$x][$y] = ", Dumper $table->[$x][$y] if DEBUG;
    }
}

sub add_dfa($table, $table_size, $splits, $enums, $dfas, $x, $y, $dfa,
            $rule, $has_unused, $me_too = undef)
{
    my $match_return = $dfas->{$dfa}{match_return}
          // die "$dfa not defined for [$x,$y] "
               . stack_trace() . "\n"
               . Dumper $dfas, $enums;
    # Many refer to e.g., WB_BREAK; if so, need to dereference
    $match_return = $dfas->{$match_return}{match_return}
                                                    if $match_return =~ /\D/;
    set_cells($table, $table_size, $splits, $enums, $x, $y,
              [ $dfa, $match_return ], $rule, $has_unused, $me_too);
}

sub output_table_common($property, $dfas_ref, $table_ref, $short_names_ref,
                        $all_enums_ref, $splits_ref, $abbreviations_ref,
                        $has_unused)
{
    # Common subroutine to actually output the generated rules table.

    my $size = @$table_ref;

    # Used to find how wide a column needs to be to fit the maximum width
    # entry in it.
    my @spacing;

    # Go through the table looking for DFAs.  A cell with an array ref in it
    # denotes a DFA.
    #   [0] is the index of the highest priority dfa;
    #   [1] is what to return if it matches
    #   [2] is the index of the next highest priority dfa
    #   [3] is what to return if it matches.
    # and so on.  Elements in even numbered indices are the dfa; what to
    # return are the odd numbered ones.
    # The final odd-numbered element is the unconditional return if none of
    # the DFA's matched.
    #
    # First, as we find dfa's in the table, store them in a a hash to get just
    # the unique ones.  Join each step in each dfa together into a string that
    # gives all its actions.  And keep a list of every cell each dfa applies
    # to.
    # To make the output table sparser, hence more readable, the rule number
    # for the default rule is not output.  Calculate that number now as well;
    # it is the highest rule number.

    my %unique_dfas;
    my $max_rule_number = 0;
    for my $x (0 .. $size - 1) {
        for my $y (0 .. $size - 1) {
            my $value = $table_ref->[$x][$y];
            if (ref $value eq 'HASH') {     # Not a dfa
                $max_rule_number = $value->{rule}
                                        if $max_rule_number < $value->{rule};
                next;
            }

            # Here is a dfa.  Easier to read this code if use array instead of
            # dereffing.  Element [0] is the highest priority dfa.  The final
            # element is a hash defining the value to use if no dfa matched.
            # Every other element is a subarray with two elements: [0] is the
            # XXX and [1] is the value to return if the corresponding dfa matches.
            my @values = $value->@*;

            # There is generally no point in pursuing a dfa if its matching
            # value is the same as what is returned if it doesn't match.
            # There may be cases where the runtime decision varies, so
            # shouldn't be optimized out.  The dfa hash indicates if that is
            # the case
            #
            # Start with the final result if nothing matches, and back up the
            # stack until we find a dfa that would lead to a different result.
            my $final = pop @values;
            while (   @values > 1
                   && ! $dfas_ref->{$values[-2]}{dont_optimize_out})
            {
                my $match = $dfas_ref->{$values[-2]}{match_return};
                $match = $dfas_ref->{$match}{match_return} if $match =~ /\D/;
                last if $match != $final->{value};
                pop @values; pop @values;
            }

            # If the stack gets completely emptied, replace the cell with the
            # unconditional result.
            if (@values == 0) {
                $table_ref->[$x][$y] = $final;
                next;
            }

            # Otherwise the value that goes into the cell will be an index
            # into the dfa table, calculated later.  For now, we save the rule
            # number of the highest priority dfa, found in [0].
            undef $table_ref->[$x][$y];

            my $rule = $dfas_ref->{$values[0]}{rule};

            # Currently don't handle multiple rules; just take the first
            $rule = $rule->[0] if ref $rule;

            if ($rule =~ s/\D//g) {
                $table_ref->[$x][$y]{rule} = $rule;
                $table_ref->[$x][$y]{rule_as_string} =
                                                $dfas_ref->{$values[0]}{rule};
            }
            else {
                $table_ref->[$x][$y]{rule} = $rule;
            }

            # Serialize the stack into a single string.
            my $this_dfa_stack = join '!', @values, $final->{value};

            # Use a hash with the serialized value as a key so as to get just
            # the unique possible dfa chains.  Add this cell to the ones this
            # chain applies to.
            push $unique_dfas{$this_dfa_stack}->@*, [ $x, $y, $final->{rule} ];
        }
    }

    # Now create a linear table of all the unique dfa's.  Start with two
    # placeholder bytes, which avoid runtime clumsiness.
    my $indent = " " x 4;
    my @output_dfas = (
                        "${indent}0,\t/* [0] placeholder */",
                        "${indent}1,\t/* [1] placeholder */",
                      );

    # We will output the table shortest first, this will minimize the number
    # of three digit entries in the table, as those will come after most other
    # entries.
    foreach my $chain (sort {
                              my $a_count = split '!', $a;
                              my $b_count = split '!', $b;
                                 $a_count <=> $b_count
                              or $a cmp $b;
                            } keys %unique_dfas)
    {
        my %final_rules;

        # And its value in the hash is a list of cells it applies to.
        foreach my $cell ($unique_dfas{$chain}->@*) {
            my $x = $cell->[0];
            my $y = $cell->[1];
            my $final_rule = $cell->[2];

            # Set the value to just the numeric portion, for later sorting
            $final_rules{$final_rule} = $final_rule =~ s/\D//gr;
            $table_ref->[$x][$y]{value} = scalar @output_dfas;

            my $value = scalar @output_dfas;
            $table_ref->[$x][$y]{value} = $value;

            # Keep track of the maximum width in this column so far..
            my $value_width = length $value;
            $spacing[$y] = $value_width if ! defined $spacing[$y]
                                        || $spacing[$y] < $value_width;
        }

        my $else_string = '[' . @output_dfas . '] ';
        my @steps = split '!', $chain;
        for (my $i = 0; $i < @steps - 1; $i += 2) {
            my $dfa_name = $steps[$i];
            my $success_return = $steps[$i+1];
            my $numeric = $dfas_ref->{$dfa_name}{enum};
            my $rule_name = $dfas_ref->{$dfa_name}{rule};
            if (ref $rule_name) {
                $rule_name = "Rules $property"
                           . join ", $property", $rule_name->@*;
            }
            else {
                $rule_name = "Rule $property$rule_name";
            }
            push @output_dfas,
                    "$indent$numeric,\t/* $else_string$dfa_name ($rule_name) */";
            push @output_dfas,
                    "$indent$success_return,\t/*\tif matches, return"
                  . " $success_return */";

            $else_string = "\telse try ";
        }

        my $final_rules_string = "(Rule";
        $final_rules_string .= 's' if keys %final_rules > 1;
        $final_rules_string .= " $property"
                            . join(",", sort {     $final_rules{$a}
                                               <=> $final_rules{$b}
                                             } keys %final_rules)
                            . ')';
        push @output_dfas, "$indent$steps[-1],\t/*\telse return $steps[-1] "
                         . " $final_rules_string */";
    }
    $output_dfas[-1] =~ s/,//;

    # Create a hash for creating #defines for regexec.c to determine if a
    # class is of a given type.  There are two sources for the definitions.
    # The first is the enums for this property.  This is a hash like
    #    CM => 6
    # where the keys are all the names the break classes can possibly be.  The
    # second is the hash defining the components when a break property class
    # has been split up because Unicode wants to refer to a subset of the
    # class, such as
    #      'CP' => [ 'CP', 'East_Asian_CP' ],
    # which means that CP is actually comprised of a subset of the entire CP,
    # plus the intersection of East_Asian characters with CP.
    #
    # The latter type is done first, as it has extra information not known to
    # $all_enums_ref, and the code below only looks at the first instance.
    my %defines;
    foreach my $source ($splits_ref, $all_enums_ref) {
        next unless keys $source->%*;

        foreach my $class (keys $source->%*) {

            # No duplicates allowed
            next if defined $defines{$class};

            # One of the sources is an array.  For the other one, convert it
            # to an array so that the same code can be used for both.
            my @expansion = (ref $source->{$class})
                            ? $source->{$class}->@*
                            : $class;

            # Look through each component that makes up this class.  We sort
            # to standardize the output so that the lowest numbered enum will
            # appear first in the expansion
            my $rhs = "";
            foreach my $contributor ( sort { $all_enums_ref->{$a} <=>
                                             $all_enums_ref->{$b}
                                           } @expansion)
            {
                # Get its numeric enum value
                my $enum = $all_enums_ref->{$contributor};

                # Internal enums don't show up externally
                next if $enum < 0;

                # The final row/column is garbage, and no macro should include
                # anything in it.
                if ($has_unused && $enum >= $size - 1) {
                    $rhs = '0' if $rhs eq "";
                    next;
                }

                # Add a branch component for this one.
                $rhs .= ' || ' if $rhs ne "";
                $rhs .= "x == $enum";   # 'x' is the formal parameter name
            }

            # If entirely empty, no component wasn't garbage; that is, all
            # components are garbage
            next unless $rhs ne "";

            # The rhs looks like 'CP == 5 || CP == 8'.  If there is no '||',
            # (that is, it is a single branch), we can use a simple #define
            # expansion.  But if multiple, we need a scratch variable to avoid
            # evaluating the parameter more than once.  regexec.c has to be
            # chummy enough with us to know to declare, for example,
            # 'isGCB_scratch' and not use it itself.  (The compilation will
            # fail if it doesn't, when needed.)
            my $name = "${property}_$class";
            if ($rhs !~ /\Q||/) {
                $defines{$class} = { lhs => "is$name(x)", rhs => $rhs };
            }
            else {
                my $var_name = "is${property}_scratch";
                $rhs =~ s/\bx\b/$var_name/g;  # Change to use variable instead
                $defines{$class} = {
                                     lhs => "is$name(x)",
                                     rhs => "$var_name = (x), $rhs"
                                   };
            }
        }
    }

    # And output them
    print $out_fh "\n" if keys %defines;
    for my $def(sort { $defines{$a}{lhs} cmp $defines{$b}{lhs} }
                                                                keys %defines)
    {
        print $out_fh "#define $defines{$def}{lhs} ($defines{$def}{rhs})\n";
    }

    # Now output the dfa #define list, sorted by numeric value
    print $out_fh "\n" if keys $dfas_ref->%*;
    if ($dfas_ref) {
        my $max_name_length = 0;
        my @defines;

        # Put in order, and at the same time find the longest name
        while (my ($enum, $hash) = each %$dfas_ref) {
            my $value = $hash->{enum};
            $defines[$value] = $enum;

            my $length = length $enum;
            $max_name_length = $length if $length > $max_name_length;
        }

        print $out_fh <<~EOT;

        /* regexec.c 'case' statements use these symbols whose values are in
         * the below table to denote the DFA to execute for the corresponding
         * cell.  '_v_' in the names shows where the candidate break position
         * is. */
        EOT

        # Output, so that the values are vertically aligned in a column after
        # the longest name
        foreach my $i (0 .. @defines - 1) {
            next unless defined $defines[$i];
            printf $out_fh "#define %-*s  %2d\n",
                                      $max_name_length,
                                       $defines[$i],
                                          $i;
        }
        print $out_fh "\n";
    }

    # Being above a U8 is not currently handled
    my $table_type = 'U8';

    # Determine width of each column, so that heading will fit
    for my $i (0 .. $size - 1) {
        no warnings 'numeric';
        $short_names_ref->[$i] = '$' if $short_names_ref->[$i] eq 'EDGE';
        my $name_width = length($short_names_ref->[$i]);
        $spacing[$i] = $name_width if ! defined $spacing[$i]
                                     || $spacing[$i] < $name_width;;
    }

    output_table_header($out_fh, $table_type, "${property}_table", undef,
                        $size, $size);

    # Calculate the column heading line
    my $header_line = "/*"
                    . (" " x $max_hdr_len)  # We let the row heading meld to
                                            # the '*/' for those that are at
                                            # the max
                    . " " x 3;    # Space for '*/ '

    # Now each column
    for my $i (0 .. $size - 1) {
        $header_line .= sprintf "%*s", $spacing[$i] + 1, # +1 for the ','
                                       $short_names_ref->[$i];
    }
    $header_line .= " */\n";

    my $text = "The comment rows give Unicode's rule number that applies"
             . " to the cell immediately above it, except it is left blank"
             . " for cells populated by the table's default rule."
             . '  ^ and $ stand for their respective edges';

    foreach my $abbr (sort caselessly keys %$abbreviations_ref) {
        next if $abbr eq 'EDGE';
        $text .= "; '$abbr' stands for '$abbreviations_ref->{$abbr}'";
    }

    if ($has_unused) {
        $text .= "; $unused_table_hdr stands for \"unused in this Unicode"
              .  " release\" (and the data in its row and column are"
              .  " garbage).  See perluniprops for the rest"
    }

    $indent = " " x 3;
    $text = $indent . "/* $text */";

    # Wrap the text so that it is no wider than the table, which the header
    # line gives.
    my $output_width = length $header_line;
    while (length $text > $output_width) {
        my $cur_line = substr($text, 0, $output_width);

        # Find the first blank back from the right end to wrap at.
        for (my $i = $output_width -1; $i > 0; $i--) {
            if (substr($text, $i, 1) eq " ") {
                print $out_fh substr($text, 0, $i), "\n";

                # Set so will look at just the remaining tail (which will be
                # indented and have a '*' after the indent
                $text = $indent . " * " . substr($text, $i + 1);
                last;
            }
        }
    }

    # And any remaining
    print $out_fh $text, "\n" if $text;

    # We calculated the header line earlier just to get its width so that we
    # could make sure the annotations fit into that.
    print $out_fh $header_line;

    # Now output the bulk of the table.
    for my $i (0 .. $size - 1) {

        # First the row heading.
        my $row_header = $short_names_ref->[$i];
        $row_header = '^' if $row_header eq '$';    # left edge

        # Center the label, biased towards the right
        use integer;
        my $padding = ($max_hdr_len - length $row_header) / 2;
        $row_header .= " " x $padding;
        no integer;

        printf $out_fh "/*%*s*/ ", $max_hdr_len, $row_header;
        print $out_fh "{";  # Then the brace for this row

        # Then each column
        for my $j (0 .. $size -1) {
            printf $out_fh "%*d", $spacing[$j], $table_ref->[$i][$j]{value};
            print $out_fh "," if $j < $size - 1;
        }
        print $out_fh " }";
        print $out_fh "," if $i < $size - 1;
        print $out_fh "\n";

        # Then the rule numbers; None for the garbage row
        next if $has_unused && $i >= $size - 1;

        # This line is accumulated in a string before being printed so that
        # trailing space can be trimmed
        my $comments = '//' . " " x ($max_hdr_len + 4);
        for my $j (0 .. $size - 1 - $has_unused) {

            # {rule} was set up to be entirely numeric.  If the original rule
            # also contained letters, {rule_as_string} is defined We output
            # only as much of the rule as fits in the column
            my $rule = $table_ref->[$i][$j]{rule};

            # Print only blanks for the default rule; print as string if has
            # non-numeric portion; else as a pure number
            if ($rule == $max_rule_number) {

                # Don't output default rule; makes output more readable
                $comments .= " " x ($spacing[$j]);
            }
            elsif (defined $table_ref->[$i][$j]{rule_as_string}) {

                $comments .= sprintf "%*.*s", $spacing[$j], $spacing[$j],
                                     $table_ref->[$i][$j]{rule_as_string};
            }
            else {
                $comments .= sprintf "%*d", $spacing[$j], $rule;
            }
            $comments .= " " if $j < $size - 1 - $has_unused;
        }
        print $out_fh $comments, "\n";
    }

    output_table_trailer();

    print $out_fh "\n";
    output_table_header($out_fh, $table_type, "${property}_dfa_table");
    print $out_fh "\t/* [n] corresponds to the numbers in the above table's cells */\n";
    print $out_fh  join("\n", @output_dfas), "\n";
    output_table_trailer();
}

sub setup_splits($to_enum, $table_size, $has_unused, $splits) {
    state $synthetic_enum = -1;

    # $splits is a hashref that maps break names to what they expand to, like
    #     'CP' => [ 'CP', 'East_Asian_CP' ],
    # $to_enum is a hashref that maps break names to their respective enum
    # numbers, like
    #     'CP' => 8, Close_Parenthesis => 8,
    #
    # What this function does is add to $splits all the equivalent names, so
    # that not only is there a
    #     'CP' => [ 'CP', 'East_Asian_CP' ],
    # but also a
    #     'Close_Parenthesis' => [ 'CP', 'East_Asian_CP' ]
    # This avoids extra work eash time in the main code having to worry about
    # possibly different spellings of the same thing.  There is no need to
    # create entries expanding 'CP' in the array, as those do already get
    # resolved to the correct enum

    # First create a true inversion of the hash.  So, we would have
    #   8 => [ 'CP', 'Close_Parenthesis' ],
    # to denote that both CP and Close_Parenthesis map to 8 in the original
    # hash.  At this time this is used only in this routine, but it could be
    # of more general use.
    my %enum_to_names;
    while (my ($key, $value) = each $to_enum->%*) {
        push $enum_to_names{$value}->@*, $key;
    }

    # Order the expansions, so that items that depend on others are done after
    # those others have been themselves expanded.  This relies on the data
    # structure not being recursive, but each item that is expanded has a top
    # level entry in $splits.
    my @ordered;
    my %new_splits;
    while (keys $splits->%*){
        my $before_count = keys $splits->%*;

        # Look at each item that is split
        foreach my $name (keys $splits->%*) {

            # If any of the items this expands to are themselves split, this
            # one isn't ready to be processed.  But an item can refer to
            # itself.  That shouldn't count XXX
            next if any { defined $splits->{$_} }
                    grep { $_ ne $name } $splits->{$name}->@*;

            push @ordered, $name;
            $new_splits{$name} = delete $splits->{$name};
        }

        die "Would be infinite loop in ", Dumper $splits
                                        if $before_count == keys $splits->%*;
    }

    # Now go through each item that is split.
    foreach my $name (@ordered) {

        # Find this item's enum.  Treat an item whose enum indicates it is not
        # used in this Unicode version as not defined.
        my $enum = $to_enum->{$name};
        if (defined $enum && (! $has_unused || $enum < $table_size - 1)) {

            # Get the list of all this item's equivalent names
            my @equivalents = $enum_to_names{$enum}->@*;

            # And add en entry for each equivalent.  These are references as
            # opposed to copies, as they are just links to the original thing.
            my $expansion = $new_splits{$name};

            foreach my $equivalent (@equivalents) {
                next if $equivalent eq $name;
                $new_splits{$equivalent} = $expansion;
            }
        }
        else {
            # Here the item is split, and:
            #   1) it doesn't have an enum or
            #   2) its enum is such that it appears to be unused in this
            #      Unicode version.
            #  It must be that it is the name of an internal convenience macro
            #  that is a shorthand for one or more break classes.  Unicode,
            #  for example, defines AHLetter to mean either ALetter or
            #  Hebrew_Letter, because those are commonly grouped together.
            #  Doing this makes the rules easier to read.  For these, we
            #  create an internal-only enum, distinguished by external ones by
            #  being negative.
            $enum = $synthetic_enum--;
            $to_enum->{$name} = $enum;
            $enum_to_names{$enum}->@* = $name;

            # The components of these may also be split.  Go through each
            # component, and if it is split, substitute its split value.
            my $this_split = $new_splits{$name};
            for (my $i = $this_split->@* - 1; $i >= 0; $i--) {
                my $component = $this_split->[$i];
                my $component_new_splits = $new_splits{$component};
                next unless $component_new_splits;
                splice $this_split->@*, $i, 1, $component_new_splits->@*;
            }
        }
    }

    #print STDERR __FILE__, ": ", __LINE__, ": ", Dumper \%new_splits;
    return %new_splits;
}

sub output_GCB_table() {

    # Create and output the pair table for use in determining Grapheme Cluster
    # Breaks, given in http://www.unicode.org/reports/tr29/.
    my @gcb_table;
    my $table_size = @gcb_short_enums;

    # Is there a row and column for unused values in this release?
    my $has_unused = $gcb_short_enums[$table_size-1] eq $unused_table_hdr;

    # Get all the enum names.  Start with the long; add in the short
    my %gcb_all_enums = %gcb_enums;
    $gcb_all_enums{ $gcb_short_enums[$_] } = $_ for 0 .. $table_size - 1;

    my %gcb_splits = setup_splits(\%gcb_all_enums, $table_size, $has_unused,
                                  {
                                    %Unicode::UCD::gcb_components,
                                  }
                                 );

    my $gcb_enum = 2;
    my %gcb_dfas = (
        GCB_NOBREAK                => {
                                        enum => 0,
                                        match_return => 0,
                                      },
        GCB_BREAKABLE              => {
                                        enum => 1,
                                        match_return => 1,
                                      },
        GCB_InCB_Consonant_then_InCB_Extend_or_InCB_Linker_v_InCB_Consonant => {
                                        enum => $gcb_enum++,
                                        match_return => 'GCB_NOBREAK',
                                        rule => '9c',
                                      },
        GCB_EB_or_EBG_then_Extend_v_EM => {
                                        enum => $gcb_enum++,
                                        match_return => 'GCB_NOBREAK',
                                        rule => 10,
                                      },
        GCB_ExtPict_then_Extend_then_ZWJ_v_ExtPict => {
                                        enum => $gcb_enum++,
                                        match_return => 'GCB_NOBREAK',
                                        rule => 11,
                                      },
        GCB_various_then_RI_v_RI   => {
                                        enum => $gcb_enum++,
                                        match_return => 'GCB_NOBREAK',
                                        rule => [12, 13],
                                      },
    );

    # These just call the generic table access functions with the correct data
    # structures.  This hides this necessary boiler plate from the callers,
    # making them easier to read.
    my sub set_gcb_cells($x, $y, $value, $rule) {
        return set_cells(\@gcb_table, $table_size, \%gcb_splits,
                         \%gcb_all_enums, $x, $y, $value, $rule, $has_unused);
    }
    my sub set_gcb_breakable($x, $y, $rule) {
        return set_gcb_cells($x, $y, $gcb_dfas{GCB_BREAKABLE}{match_return},
                             $rule);
    }
    my sub set_gcb_nobreak($x, $y, $rule) {
        return set_gcb_cells($x, $y, $gcb_dfas{GCB_NOBREAK}{match_return},
                             $rule);
    }
    my sub add_gcb_dfa($x, $y, $dfa, $rule) {

        # None of the DFAs in this property reference the current value of the
        # cell.  The '1' indicates that
        return add_dfa(\@gcb_table, $table_size, \%gcb_splits, \%gcb_all_enums,
                       \%gcb_dfas, $x, $y, $dfa, $rule, $has_unused);
    }

    my ($lhs, $rhs, $dfa, $rule);

    # Break at the start and end of text, unless the text is empty
    set_gcb_nobreak('EDGE', 'EDGE', 1);
    # GB1  sot  ÷
    set_gcb_breakable('EDGE', '*', 1);
    # GB2   ÷  eot
    set_gcb_breakable('*', 'EDGE', 2);

    # GB3  CR  ×  LF
    set_gcb_nobreak('CR', 'LF', 3);

    # Do not break between a CR and LF. Otherwise, break before and after
    # controls.
    # GB4  ( Control | CR | LF )  ÷
    set_gcb_breakable($_, '*', 4) for qw(Control CR LF);
    # GB5   ÷  ( Control | CR | LF )
    set_gcb_breakable('*', $_, 5) for qw(Control CR LF);

    # Do not break Hangul syllable or other conjoining sequences.
    # GB6  L  ×  ( L | V | LV | LVT )
    set_gcb_nobreak('L', $_, 6) for qw(L V LV LVT);

    # GB7  ( LV | V )  ×  ( V | T )
    for $lhs (qw(LV V)) {
        set_gcb_nobreak($lhs, $_, 7) for qw(V T);
    }

    # Do not break Hangul syllable sequences.
    # GB8  ( LVT | T)  ×  T
    set_gcb_nobreak($_, 'T', 8) for qw(LVT T);

    # Do not break before extending characters or ZWJ.
    # Do not break before SpacingMarks, or after Prepend characters.
    # GB9   ×  ( Extend | ZWJ )
    set_gcb_nobreak('*', $_, 9) for qw(Extend ZWJ);
    # GB9a  × SpacingMark
    set_gcb_nobreak('*', 'SpacingMark', '9a');
    # GB9b  Prepend  ×
    set_gcb_nobreak('Prepend', '*', '9b');

    # GB9c  \p{InCB=Consonant} [ \p{InCB=Extend} \p{InCB=Linker} ]*
    #       \p{InCB=Linker}    [ \p{InCB=Extend} \p{InCB=Linker} ]*
    #   ×   \p{InCB=Consonant}
    $dfa = 'GCB_InCB_Consonant_then_InCB_Extend_or_InCB_Linker_v_InCB_Consonant';
    add_gcb_dfa( [ qw(InCB_Consonant
                      InCB_Linker
                      InCB_Extend) ], 'InCB_Consonant', $dfa, '9c');

    # GB10  ( E_Base | E_Base_GAZ ) Extend* ×  E_Modifier
    $rule = 10;
    add_gcb_dfa('Extend', 'E_Modifier', 'GCB_EB_or_EBG_then_Extend_v_EM',
                $rule);
    set_gcb_nobreak('E_Base', 'E_Modifier', $rule);
    set_gcb_nobreak('E_Base_GAZ', 'E_Modifier', $rule);

    # This and the rule GB10 obsolete starting with Unicode 11.0, can be left
    # in as there are no code points that match, so the code won't ever get
    # executed.
    # Do not break within emoji modifier sequences or emoji zwj sequences.
    # Pre 11.0: GB11  ZWJ  × ( Glue_After_Zwj | E_Base_GAZ )
    set_gcb_nobreak('ZWJ', $_, 11) for qw(Glue_After_Zwj  E_Base_GAZ);

    # Post 11.0: GB11   \p{Extended_Pictographic} Extend* ZWJ
    #                 × \p{Extended_Pictographic}
    $dfa = 'GCB_ExtPict_then_Extend_then_ZWJ_v_ExtPict';
    add_gcb_dfa('ZWJ', 'Extended_Pictographic', $dfa, 11);

    # Do not break within emoji flag sequences. That is, do not break between
    # regional indicator (RI) symbols if there is an odd number of RI
    # characters before the break point.  Must be resolved in runtime code.
    #
    # GB12 sot (RI RI)* RI × RI
    # GB13 [^RI] (RI RI)* RI × RI
    $rule = 12;
    add_gcb_dfa('RI', 'RI', 'GCB_various_then_RI_v_RI', $rule);

    # Otherwise, break everywhere.
    # GB99   Any ÷  Any
    set_gcb_breakable('*', '*', 99);

    output_table_common('GCB', \%gcb_dfas, \@gcb_table, \@gcb_short_enums,
                        \%gcb_all_enums, \%gcb_splits, \%gcb_abbreviations,
                        $has_unused);
}

sub output_LB_table() {

    # Create and output the enums, #defines, and pair table for use in
    # determining Line Breaks.  This uses the default line break algorithm,
    # given in http://www.unicode.org/reports/tr14/.

    my @lb_table;
    my $table_size = @lb_short_enums;
    my %lb_me_too;

    # Is there a row and column for unused values in this release?
    my $has_unused = $lb_short_enums[$table_size-1] eq $unused_table_hdr;

    # Get all the enum names.  Start with the long; add in the short
    my %lb_all_enums = %lb_enums;
    $lb_all_enums{ $lb_short_enums[$_] } = $_ for 0 .. $table_size - 1;

    my %lb_splits = setup_splits(\%lb_all_enums, $table_size, $has_unused,
                      {
                        %Unicode::UCD::lb_components,
                        AKish => [ qw(Aksara  Dotted_Circle  Aksara_Start) ],
                      }
    );

    my $lb_enum = 2;
    my %lb_dfas = (
        LB_NOBREAK                    => {
                                            enum => 0,
                                            match_return => 0,
                                          },
        LB_BREAKABLE                   => {
                                             enum => 1,
                                             match_return => 1,
                                           },
        LB_ZW_then_SP_v_any             => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_BREAKABLE',
                                             rule => 8,
                                           },
        LB_CM_ZWJ_v_any                 => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             dont_optimize_out => 1,
                                             rule => 9,
                                           },
        LB_OP_then_SP_v_any             => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 14,
                                           },
        LB_QU_then_SP_v_OP              => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 15,
                                           },
        LB_various_then_PiQ_then_SP_v_any => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '15a',
                                           },
        LB_any_v_PfQ_then_various       => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '15b',
                                           },
        LB_SP_v_IS_then_NU              => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_BREAKABLE',
                                             rule => '15c',
                                           },
        LB_CL_or_CP_then_SP_v_NS        => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 16,
                                           },
        LB_B2_then_SP_v_B2             => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 17,
                                           },
        LB_any_v_QU_then_nonEA_or_eot   => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '19a',
                                           },
        LB_nonEA_or_sot_then_QU_v_any   => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '19a',
                                           },
        LB_various_then_HY_or_HH_v_AL_or_HL  => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '20a',
                                           },
        LB_HL_then_HY_or_HH_v_nonHL => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '21a',
                                           },
        LB_NU_then_SY_or_IS_then_CL_or_CP_v_PO_or_PR  => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 25,
                                           },
        LB_PO_or_PR_v_OP_then_IS_then_NU => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 25,
                                           },
        LB_NU_then_SY_or_IS_v_NU        => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => 25,
                                           },
        LB_AKish_v_AKish_then_VF        => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '28a',
                                           },
        LB_AKish_then_VI_v_AK_or_DOTTED => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '28a',
                                           },
        LB_various_then_RI_v_RI         => {
                                             enum => $lb_enum++,
                                             match_return => 'LB_NOBREAK',
                                             rule => '30a',
                                           },
    );

    # Construct the LB pair table.  This is based on the rules in
    # http://www.unicode.org/reports/tr14/, but modified as those rules are
    # designed for someone taking a string of text and sequentially going
    # through it to find the break opportunities, whereas, Perl requires
    # determining if a given random spot is a break opportunity, without
    # knowing all the entire string before it.
    #
    # These just call the generic table access functions with the correct data
    # structures.  This hides this necessary boiler plate from the callers,
    # making them easier to read.
    my sub set_lb_cells($x, $y, $value, $rule) {
        return set_cells(\@lb_table, $table_size, \%lb_splits, \%lb_all_enums,
                         $x, $y, $value, $rule, $has_unused, \%lb_me_too);
    }
    my sub set_lb_breakable($x, $y, $rule) {
        return set_lb_cells($x, $y, $lb_dfas{LB_BREAKABLE}{match_return},
                            $rule);
    }
    my sub set_lb_nobreak($x, $y, $rule) {
        return set_lb_cells($x, $y, $lb_dfas{LB_NOBREAK}{match_return}, $rule);
    }
    my sub add_lb_dfa($x, $y, $dfa, $rule) {
        return add_dfa(\@lb_table, $table_size, \%lb_splits, \%lb_all_enums,
                       \%lb_dfas, $x, $y, $dfa, $rule, $has_unused,
                       \%lb_me_too);

    }
    my sub set_lb_me_too($source_x, $source_y, $copy_x, $copy_y, $rule) {
        my @source = get_cell_list($table_size, \%lb_splits, \%lb_all_enums,
                                   $source_x, $source_y)->@*;
        my @copy = get_cell_list($table_size, \%lb_splits, \%lb_all_enums,
                                 $copy_x, $copy_y)->@*;
        foreach my $source_pair (@source) {
            foreach my $copy_pair (@copy) {
                push $lb_me_too{"$source_pair->[0],$source_pair->[1]"}->@*,
                     [ $copy_pair->[0], $copy_pair->[1] ];
            }
        }
    }

    my ($lhs, $rhs, $dfa, $rule);

    # LB1 Assign a line breaking class to each code point of the input.
    # Resolve AI, CB, CJ, SA, SG, and XX into other line breaking classes
    # depending on criteria outside the scope of this algorithm.
    #
    # In the absence of such criteria all characters with a specific
    # combination of original class and General_Category property value are
    # resolved as follows:
    # Original     Resolved  General_Category
    # AI, SG, XX      AL      Any
    # SA              CM      Only Mn or Mc
    # SA              AL      Any except Mn and Mc
    # CJ              NS      Any
    #
    # This is done in mktables, so we never see any of the remapped-from
    # classes.

    # LB2 Never break at the start of text.
    # sot ×
    set_lb_nobreak('EDGE', '*', 2);

    # LB3 Always break at the end of text.
    # ! eot
    set_lb_breakable('*', 'EDGE', 3);

    # LB4 Always break after hard line breaks.
    # BK !
    set_lb_breakable('BK', '*', 4);

    # LB5 Treat CR followed by LF, as well as CR, LF, and NL as hard line
    # breaks.
    # CR × LF
    $rule = 5;
    set_lb_nobreak('CR', 'LF', $rule);
    # CR !
    # LF !
    # NL !
    set_lb_breakable($_, '*', $rule) for qw(CR LF NL);

    # LB6 Do not break before hard line breaks.
    # × ( BK | CR | LF | NL )
    set_lb_nobreak('*', $_, 6) for qw(BK CR LF NL);

    # LB7 Do not break before spaces or zero width space.
    # × SP
    set_lb_nobreak('*', 'SP', 7);
    # × ZW
    set_lb_nobreak('*', 'ZWSpace', 7);

    # LB8 Break before any character following a zero-width space, even if one
    # or more spaces intervene.
    # Firstly,
    # ZW ÷
    set_lb_breakable('ZWSpace', '*', 8);

    # Next ZW SP+ ÷
    add_lb_dfa('SP', '*', 'LB_ZW_then_SP_v_any', 8);

    # LB8a Do not break after a zero width joiner
    # ZWJ ×
    set_lb_nobreak('ZWJ', '*', '8a');

    # LB9 Do not break a combining character sequence; treat it as if it has
    # the line breaking class of the base character in all of the
    # higher-numbered rules.  Treat ZWJ as if it were CM
    # Treat X (CM|ZWJ)* as if it were X.
    # where X is any line break class except BK, CR, LF, NL, SP, or ZW.
    #
    # khw found this language confusing, but basically it works out to don't
    # break between a character and a character that combines with it,
    # inheriting the type of nobreak from whatever the previous rules have
    # filled in.  If the order is reversed, and the combining character
    # precedes another one, we have to backup at runtime to find out if the
    # combining character attached to an earlier character or not.
    my @CM_doesnt_combine = qw(BK CR LF NL SP ZWSpace EDGE);

    # When the CM or ZWJ is the first in the pair, we don't know without
    # looking behind whether the CM or ZWJ is going to attach to an earlier
    # character, or not.  So have to figure this out at runtime in the code
    add_lb_dfa($_, '*', 'LB_CM_ZWJ_v_any', 9) for qw(CM ZWJ);

    # For the classes where the CM or ZWJ combines, it doesn't break,
    # but it inherits the type of nobreak from the master character.
    set_lb_nobreak( [ '^', @CM_doesnt_combine ], $_, 9) for qw(CM ZWJ);

    # LB10 Treat any remaining combining mark or ZWJ as AL.  This catches the
    # case where a CM or ZWJ is the first character on the line or follows SP,
    # BK, CR, LF, NL, or ZW.
    for my $i (@CM_doesnt_combine) {
        set_lb_me_too($i, 'AL', $i, 'CM', 10);
        set_lb_me_too($i, 'AL', $i, 'ZWJ', 10);
    }

    # Special case this here to avoid having to do a special case in the code,
    # by making this the same as other things with a SP in front of them that
    # don't break, we avoid an extra test
    #set_lb_nobreak_ignoring_SP('SP', 'WJ', $rule);

    # LB11 Do not break before or after Word joiner and related characters.
    # × WJ
    set_lb_nobreak('*', 'WJ', 11);
    # WJ ×
    set_lb_nobreak('WJ', '*', 11);

    # LB12 Do not break after NBSP and related characters.
    # GL ×
    set_lb_nobreak('GL', '*', 12);

    # LB12a Do not break before NBSP and related characters, except after
    # spaces and hyphens.
    # [^SP BA HY] × GL
    set_lb_nobreak([ qw(^ SP BA HY HH) ], 'GL', '12a');

    # LB13 Do not break before ‘]’ or ‘!’ or ‘;’ or ‘/’, even after spaces, as
    # tailored by example 7 in http://www.unicode.org/reports/tr14/#Examples
    # × CL
    # × CP
    # × EX
    # × SY
    set_lb_nobreak('*', $_, 13) for qw(CL CP EX SY);

    # LB14 Do not break after ‘[’, even after spaces.
    # OP SP* ×
    set_lb_nobreak('OP', '*', 14);
    add_lb_dfa('SP', '*', 'LB_OP_then_SP_v_any', 14);

    # LB15 Do not break within ‘”[’, even with intervening spaces.
    # QU SP* × OP
    # LB15 is superceded by LB15a, when that is present
    if (   ! defined $lb_all_enums{Pi_QU}
        || (   $has_unused && $lb_all_enums{Pi_QU} >= $table_size - 1))
    {
        set_lb_nobreak('QU', 'OP', 15);
        add_lb_dfa('SP', 'OP', 'LB_QU_then_SP_v_OP', 15);
    }

    # LB15a Do not break after an unresolved initial punctuation that lies at
    # the start of the line, after a space, after opening punctuation, or
    # after an unresolved quotation mark, even after spaces.
    # (sot | BK | CR | LF | NL | OP | QU | GL | SP | ZW) [\p{Pi}&QU] SP* ×
    $dfa = 'LB_various_then_PiQ_then_SP_v_any';
    add_lb_dfa('Pi_QU', '*', $dfa, '15a');
    add_lb_dfa('SP', '*', $dfa, '15a');

    # LB15b Do not break before an unresolved final punctuation that lies at
    # the end of the line, before a space, before a prohibited break, or
    # before an unresolved quotation mark, even after spaces.
    # × [\p{Pf}&QU] ( SP | GL | WJ | CL | QU | CP | EX | IS | SY | BK | CR
    #               | LF | NL | ZW | eot)
    $dfa = 'LB_any_v_PfQ_then_various';
    add_lb_dfa('*', 'Pf_QU', $dfa, '15b');

    # LB15c Break before a decimal mark that follows a space, for instance, in
    # ‘subtract .5’.
    # SP ÷ IS NU
    add_lb_dfa('SP', 'IS', 'LB_SP_v_IS_then_NU', '15c');

    # LB15d Otherwise, do not break before ‘;’, ‘,’, or ‘.’, even after
    # spaces.
    # × IS
    set_lb_nobreak('*', 'IS', '15d');

    # LB16 Do not break between closing punctuation and a nonstarter even with
    # intervening spaces.
    # (CL | CP) SP* × NS
    $rule = 16;
    set_lb_nobreak($_, 'NS', $rule) for qw(CL CP);
    add_lb_dfa('SP', 'NS', 'LB_CL_or_CP_then_SP_v_NS', $rule);

    # LB17 Do not break within ‘——’, even with intervening spaces.
    # B2 SP* × B2
    set_lb_nobreak('B2', 'B2', 17);
    add_lb_dfa('SP', 'B2', 'LB_B2_then_SP_v_B2', 17);

    # LB18 Break after spaces
    # SP ÷
    set_lb_breakable('SP', '*', 18);

    # LB19 Do not break before non-initial unresolved quotation marks, such as
    # ‘ ” ’ or ‘ " ’, nor after non-final unresolved quotation marks, such as
    # ‘ “ ’ or ‘ " ’.
    # × [ QU - \p{Pi} ]
    #   [ QU - \p{Pf} ] ×
    $rule = 19;
    set_lb_nobreak('*', qw(QU_sans_Pi), $rule);
    set_lb_nobreak(qw(QU_sans_Pf), '*', $rule);

    # LB19a Unless surrounded by East Asian characters, do not break either
    # side of any unresolved quotation marks.
    $rule = '19a';

    # [^$EastAsian] × QU
    set_lb_nobreak( [ qw(^ EA) ], 'QU', $rule);

    # × QU ( [^$EastAsian] | eot )
    $dfa = 'LB_any_v_QU_then_nonEA_or_eot';
    add_lb_dfa('*', 'QU', $dfa, $rule);

    # QU × [^$EastAsian]
    set_lb_nobreak( 'QU', [ qw(^ EA) ], $rule );

    # ( sot | [^$EastAsian] ) QU ×
    $dfa = 'LB_nonEA_or_sot_then_QU_v_any';
    add_lb_dfa('QU', '*', $dfa, $rule);

    # LB20 Break before and after unresolved CB.
    # ÷ CB
    # CB ÷
    # Conditional breaks should be resolved external to the line breaking
    # rules. However, the default action is to treat unresolved CB as breaking
    # before and after.
    $rule = 20;
    set_lb_breakable('*', 'CB', $rule);
    set_lb_breakable('CB', '*', $rule);

    # LB20a Do not break after a word-initial hyphen.
    #   ( sot | BK | CR | LF | NL | SP | ZW | CB | GL )
    #   ( HY | HH )
    # × ( AL | HL )
    $dfa = 'LB_various_then_HY_or_HH_v_AL_or_HL';
    for $lhs (qw(HY HH)) {
        add_lb_dfa($lhs, $_, $dfa, '20a') for qw(AL HL);
    }

    # LB21 Do not break before hyphen-minus, other hyphens, fixed-width
    # spaces, small kana, and other non-starters, or after acute accents.
    # × BA
    # × HH
    # × HY
    # × NS
    $rule = 21;
    set_lb_nobreak('*', $_, $rule) for qw(BA HH HY NS);
    # BB ×
    set_lb_nobreak('BB', '*', $rule);

    # LB21a Don't break after the hyphen in Hebrew + Hyphen + non-Hebrew.
    # HL (HY | HH) × [^HL]
    $rule = '21a';
    $dfa = 'LB_HL_then_HY_or_HH_v_nonHL';
    add_lb_dfa($_, [ qw(^ HL) ], $dfa, $rule) for qw(HY HH);

    # LB21b Don’t break between Solidus and Hebrew letters.
    # SY × HL
    set_lb_nobreak('SY', 'HL', '21b');

    # LB22 Do not break before ellipses
    set_lb_nobreak('*', 'IN', 22);

    # LB23 Do not break between digits and letters
    # (AL | HL) × NU
    $rule = 23;
    set_lb_nobreak('AL', 'NU', $rule);
    set_lb_nobreak('HL', 'NU', $rule);

    # NU × (AL | HL)
    set_lb_nobreak('NU', 'AL', $rule);
    set_lb_nobreak('NU', 'HL', $rule);

    # LB23a Do not break between numeric prefixes and ideographs, or between
    # ideographs and numeric postfixes.
    # PR × (ID | EB | EM)
    $rule = '23a';
    set_lb_nobreak('PR', $_, $rule) for qw(ID EB EM);

    # (ID | EB | EM) × PO
    set_lb_nobreak($_, 'PO', $rule) for qw(ID EB EM);

    # LB24 Do not break between numeric prefix/postfix and letters, or between
    # letters and prefix/postfix.
    # (PR | PO) × (AL | HL)
    $rule = 24;
    for $lhs (qw(PR PO)) {
        set_lb_nobreak($lhs, $_, $rule) for qw(AL HL);
    }

    # (AL | HL) × (PR | PO)
    for $lhs (qw(AL HL)) {
        set_lb_nobreak($lhs, $_, $rule) for qw(PR PO);
    }

    # LB25 Do not break numbers:
    # NU ( SY | IS )* CL × PO
    # NU ( SY | IS )* CP × PO
    # NU ( SY | IS )* CL × PR
    # NU ( SY | IS )* CP × PR
    # NU ( SY | IS )* × PO
    # NU ( SY | IS )* × PR
    #
    # PO × OP NU
    # PO × OP IS NU
    # PO × NU
    # PR × OP NU
    # PR × OP IS NU
    #
    # PR × NU
    # HY × NU
    # IS × NU
    #
    # NU ( SY | IS )* × NU
    #
    # The first six can be rewritten as
    # NU ( SY | IS )* ( CL | CP )? × ( PO | PR )
    $dfa = 'LB_NU_then_SY_or_IS_then_CL_or_CP_v_PO_or_PR';
    for $lhs (qw(CL CP SY IS)) {
        add_lb_dfa($lhs, $_, $dfa, $rule) for qw(PO PR);
    }
    set_lb_nobreak('NU', $_, $rule) for qw(PO PR);

    # We can move PO × NU out of the second group to the next group without
    # affecting any priorities, since it operates only on PO and the remaining
    # ones in that group operate only on PR  This leaves in this group
    # PO × OP NU
    # PO × OP IS NU
    # PR × OP NU
    # PR × OP IS NU
    $dfa = 'LB_PO_or_PR_v_OP_then_IS_then_NU';
    add_lb_dfa($_, 'OP', $dfa, $rule) for qw(PO PR);

    # The next group is now
    # PO × NU
    # PR × NU
    # HY × NU
    # IS × NU
    set_lb_nobreak($_, 'NU', $rule) for qw(PO PR HY IS);

    # And the final item is
    # NU ( SY | IS )* × NU
    $dfa = 'LB_NU_then_SY_or_IS_v_NU';
    add_lb_dfa($_, 'NU', $dfa, $rule) for qw(SY IS);
    set_lb_nobreak('NU', 'NU', $rule);

    # LB26 Do not break a Korean syllable.
    # JL × (JL | JV | H2 | H3)
    $rule = 26;
    set_lb_nobreak('JL', $_, $rule) for qw(JL JV H2 H3);

    # (JV | H2) × (JV | JT)
    for $lhs (qw(JV H2)) {
        set_lb_nobreak($lhs, $_, $rule) for qw(JV JT);
    }

    # (JT | H3) × JT
    set_lb_nobreak('JT', 'JT', $rule);
    set_lb_nobreak('H3', 'JT', $rule);

    # LB27 Treat a Korean Syllable Block the same as ID.
    # (JL | JV | JT | H2 | H3) × PO
    $rule = 27;
    set_lb_nobreak($_, 'PO', $rule) for qw(JL JV JT H2 H3);

    # PR × (JL | JV | JT | H2 | H3)
    set_lb_nobreak('PR', $_, $rule) for qw(JL JV JT H2 H3);

    # LB28 Do not break between alphabetics (“at”).
    # (AL | HL) × (AL | HL)
    for $lhs (qw(AL HL)) {
        set_lb_nobreak($lhs, $_, 28) for qw(AL HL);
    }

    # LB28a Do not break inside the orthographic syllables of Brahmic scripts.
    # AP × (AK | ◌ | AS)
    $rule = '28a';
    set_lb_nobreak('AP', 'AKish', $rule);

    # (AK | ◌ | AS) × (VF | VI)
    set_lb_nobreak('AKish', $_, $rule) for qw(VF VI);

    # (AK | ◌ | AS) VI × (AK | ◌)
    $dfa = 'LB_AKish_then_VI_v_AK_or_DOTTED';
    add_lb_dfa('VI', $_, $dfa, $rule) for qw(AK Dotted_Circle);

    # (AK | ◌ | AS) × (AK | ◌ | AS) VF
    $dfa = 'LB_AKish_v_AKish_then_VF';
    add_lb_dfa('AKish', 'AKish', $dfa, $rule);

    # LB29 Do not break between numeric punctuation and alphabetics (“e.g.”).
    # IS × (AL | HL)
    set_lb_nobreak('IS', $_, 29) for qw(AL HL);

    # LB30 Do not break between letters, numbers, or ordinary symbols and
    # non-East-Asian opening punctuation nor non-East-Asian closing
    # parentheses.
    # (AL | HL | NU) × [OP-[\p{ea=F}\p{ea=W}\p{ea=H}]]
    $rule = 30;
    set_lb_nobreak($_, 'OP_sans_EA', $rule) for qw(AL  HL  NU);

    # [CP-[\p{ea=F}\p{ea=W}\p{ea=H}]] × (AL | HL | NU)
    set_lb_nobreak('CP_sans_EA', $_, $rule) for qw(AL  HL  NU);

    # LB30a Break between two regional indicator symbols if and only if there
    # are an even number of regional indicators preceding the position of the
    # break.
    # sot (RI RI)* RI × RI
    # [^RI] (RI RI)* RI × RI
    add_lb_dfa('RI', 'RI', 'LB_various_then_RI_v_RI', '30a');

    # LB30b Do not break between an emoji base (or potential emoji) and an
    # emoji modifier.
    # EB × EM
    $rule = '30b';
    set_lb_nobreak('EB', 'EM', $rule);

    # [\p{Extended_Pictographic}&\p{Cn}] × EM
    set_lb_nobreak('Cn_ExtPict', 'EM', $rule);

    # LB31. Break everywhere else
    set_lb_breakable('*', '*', 31);

    output_table_common('LB', \%lb_dfas, \@lb_table, \@lb_short_enums,
                        \%lb_all_enums, \%lb_splits, \%lb_abbreviations,
                        $has_unused);
}

sub output_WB_table() {

    # Create and output the enums, #defines, and pair table for use in
    # determining Word Breaks, given in http://www.unicode.org/reports/tr29/.

    my @wb_table;
    my $table_size = @wb_short_enums;

    # Is there a row and column for unused values in this release?
    my $has_unused = $wb_short_enums[$table_size-1] eq $unused_table_hdr;

    # Construct the WB pair table.

    # Get all the enum names.  Start with the long; add in the short
    my %wb_all_enums = %wb_enums;
    $wb_all_enums{ $wb_short_enums[$_] } = $_ for 0 .. $table_size - 1;

    my %wb_splits = setup_splits(\%wb_all_enums, $table_size, $has_unused,
                               { %Unicode::UCD::wb_components,
                                 AHLetter   => [ qw(ALetter Hebrew_Letter) ],
                                 MidNumLetQ => [ qw(MidNumLet Single_Quote) ],
                               }
                              );

    # This uses the same mechanism in the other bounds tables generated by
    # this file.  The dfas that could override a 0 or 1 are added to those
    # numbers; the dfas that clearly don't depend on the underlying rule
    # simply overwrite
    my $wb_enum = 2;
    my %wb_dfas = (
        WB_NOBREAK                      => {
                                             enum => 0,
                                             match_return => 0,
                                           },
        WB_BREAKABLE                    => {
                                             enum => 1,
                                             match_return => 1,
                                           },
        WB_hs_v_hs_then_Extend_or_FO_or_ZWJ => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_BREAKABLE',
                                             rule => '2z',
                                           },
        WB_Extend_or_FO_or_ZWJ_then_foo => {
                                             enum => $wb_enum++,
                                             match_return => 255,
                                             rule => 4,
                                           },
        WB_AHL_v_ML_or_MNLQ_then_AHL    => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => 6,
                                           },
        WB_AHL_then_ML_or_MNLQ_v_AHL    => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => 7,
                                           },
        WB_HL_v_DQ_then_HL              => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => '7b',
                                           },
        WB_HL_then_DQ_v_HL              => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => '7c',
                                           },
        WB_NU_then_MN_or_MNLQ_v_NU      => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => 11,
                                           },
        WB_NU_v_MN_or_MNLQ_then_NU      => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => 12,
                                           },
        WB_various_then_RI_v_RI         => {
                                             enum => $wb_enum++,
                                             match_return => 'WB_NOBREAK',
                                             rule => [ 15, 16 ],
                                           },
    );

    # These just call the generic table access functions with the correct data
    # structures.  This hides this necessary boiler plate from the callers,
    # making them easier to read.
    my sub set_wb_cells($x, $y, $value, $rule) {
        return set_cells(\@wb_table, $table_size, \%wb_splits, \%wb_all_enums,
                         $x, $y, $value, $rule, $has_unused);
    }
    my sub set_wb_breakable($x, $y, $rule) {
        return set_wb_cells($x, $y, $wb_dfas{WB_BREAKABLE}{match_return},
                            $rule);
    }
    my sub set_wb_nobreak($x, $y, $rule) {
        return set_wb_cells($x, $y, $wb_dfas{WB_NOBREAK}{match_return}, $rule);
    }
    my sub add_wb_dfa($x, $y, $dfa, $rule) {
        return add_dfa(\@wb_table, $table_size, \%wb_splits, \%wb_all_enums,
                       \%wb_dfas, $x, $y, $dfa, $rule, $has_unused);
    }

    my ($lhs, $rhs, $dfa, $rule);

    # Break at the start and end of text, unless the text is empty
    set_wb_nobreak('EDGE', 'EDGE', 1);
    # WB1  sot  ÷  Any
    set_wb_breakable('*', 'EDGE', 1);
    # WB2  Any  ÷  eot
    set_wb_breakable('EDGE', '*', 2);

    # Perl tailoring: Do not break horizontal space followed by Extend or
    # Format or ZWJ
    $rule = '2z';
    set_wb_nobreak('Perl_Tailored_HSpace', $_, $rule) for qw(Extend Format ZWJ);
    add_wb_dfa('Perl_Tailored_HSpace', 'Perl_Tailored_HSpace',
               'WB_hs_v_hs_then_Extend_or_FO_or_ZWJ', $rule);
    set_wb_nobreak('Perl_Tailored_HSpace', 'Perl_Tailored_HSpace', $rule);

    # Perl tailoring: Do not break within white space.
    # WB3  CR  ×  LF
    # et.al.
    my @space_list = qw(CR LF Newline Perl_Tailored_HSpace);
    set_wb_nobreak(\@space_list, \@space_list, 3);

    # Break before and after newlines
    # WB3a  (Newline | CR | LF)  ÷
    # WB3b     ÷  (Newline | CR | LF)
    # et. al.
    set_wb_breakable(\@space_list, '*', '3a');
    set_wb_breakable('*', \@space_list, '3b');

    # Do not break within emoji zwj sequences.
    # WB3c ZWJ × ( Glue_After_Zwj | EBG )
    #      ZWJ × \p{Extended_Pictographic}
    set_wb_nobreak('ZWJ', $_, '3c') for qw(Glue_After_Zwj
                                           E_Base_GAZ
                                           Extended_Pictographic);

    # Keep horizontal whitespace together
    # Use perl's tailoring instead
    # WB3d WSegSpace × WSegSpace
    #set_wb_nobreak('WSegSpace', 'WSegSpace', '3d');

    # Ignore Format and Extend characters, except after sot, CR, LF, and
    # Newline.  (The rules above have handled these cases.) This also has the
    # effect of:
    #   Any × (Format | Extend | ZWJ)
    #
    # WB4  X (Extend | Format | ZWJ)* → X
    # Implied is that these attach to the character before them, except for
    # the characters that mark the end of a region of text.
    $rule = 4;
    set_wb_nobreak('*', $_, $rule) for qw(Extend Format ZWJ);

    # Implied is that these attach to the character before them, except for
    # the characters that mark the end of a region of text.
    $dfa = 'WB_Extend_or_FO_or_ZWJ_then_foo';
    add_wb_dfa($_, '*', $dfa, $rule) for qw(Extend Format ZWJ);

    # Do not break between most letters.
    # WB5  AHLetter  ×  AHLetter
    set_wb_nobreak('AHLetter', 'AHLetter', 5);

    # Do not break letters across certain punctuation.
    # WB6  AHLetter  ×  (MidLetter | MidNumLetQ)  AHLetter
    $rule = 6;
    $dfa = 'WB_AHL_v_ML_or_MNLQ_then_AHL';
    add_wb_dfa('AHLetter', 'MidNumLetQ', $dfa, $rule);
    add_wb_dfa('AHLetter', 'MidLetter', $dfa, $rule);

    # WB7   AHLetter (MidLetter | MidNumLetQ) × AHLetter
    $rule = 7;
    $dfa = 'WB_AHL_then_ML_or_MNLQ_v_AHL';
    add_wb_dfa($_, 'AHLetter', $dfa, $rule) for qw(MidLetter MidNumLetQ);

    # WB7a  Hebrew_Letter  ×  Single_Quote
    set_wb_nobreak('Hebrew_Letter', 'Single_Quote', '7a');

    # WB7b  Hebrew_Letter  ×  Double_Quote Hebrew_Letter
    add_wb_dfa('Hebrew_Letter', 'Double_Quote', 'WB_HL_v_DQ_then_HL', '7b');

    # WB7c  Hebrew_Letter Double_Quote  ×  Hebrew_Letter
    add_wb_dfa('Double_Quote', 'Hebrew_Letter', 'WB_HL_then_DQ_v_HL', '7c');

    # WB8  Numeric  ×  Numeric
    set_wb_nobreak('Numeric', 'Numeric', 8);

    # WB9  AHLetter  ×  Numeric
    set_wb_nobreak('AHLetter', 'Numeric', 9);

    # Do not break within sequences of digits, or digits adjacent to letters
    # (“3a”, or “A3”).
    # WB10  Numeric  ×  AHLetter
    set_wb_nobreak('Numeric', 'AHLetter', 10);

    # WB11  Numeric (MidNum | (MidNumLetQ)  ×  Numeric
    $rule = 11;
    $dfa = 'WB_NU_then_MN_or_MNLQ_v_NU';
    add_wb_dfa($_, 'Numeric', $dfa, $rule) for qw(MidNum MidNumLetQ);

    # Do not break within sequences, such as “3.2” or “3,456.789”.
    # WB12  Numeric  ×  (MidNum | MidNumLetQ) Numeric
    $rule = 12;
    $dfa = 'WB_NU_v_MN_or_MNLQ_then_NU';
    add_wb_dfa('Numeric', $_, $dfa, $rule) for qw(MidNum MidNumLetQ);

    # Do not break between Katakana.
    # WB13  Katakana  ×  Katakana
    set_wb_nobreak('Katakana', 'Katakana', 13);

    # WB13a  (AHLetter | Numeric | Katakana | ExtendNumLet) × ExtendNumLet
    set_wb_nobreak($_, 'ExtendNumLet', '13a') for qw(AHLetter
                                                     Numeric
                                                     Katakana
                                                     ExtendNumLet);
    # Do not break from extenders.
    # WB13b  ExtendNumLet  ×  (AHLetter | Numeric | Katakana)
    $rule = '13b';
    set_wb_nobreak('ExtendNumLet', $_, '13b') for qw(AHLetter Numeric Katakana);

    # Do not break within emoji modifier sequences.
    # WB14  ( E_Base | EBG )  ×  E_Modifier
    $rule = 14;
    set_wb_nobreak('E_Base', 'E_Modifier', $rule);
    set_wb_nobreak('E_Base_GAZ', 'E_Modifier', $rule);

    # Do not break within emoji flag sequences. That is, do not break between
    # regional indicator (RI) symbols if there is an odd number of RI
    # characters before the break point.
    # WB15   sot    (RI RI)* RI × RI
    # WB16  [^RI] (RI RI)* RI × RI
    add_wb_dfa('RI', 'RI', 'WB_various_then_RI_v_RI', 15);

    # Otherwise, break everywhere (including around ideographs).
    # WB99  Any  ÷  Any
    set_wb_breakable('*', '*', 99);

    output_table_common('WB', \%wb_dfas, \@wb_table, \@wb_short_enums,
                        \%wb_all_enums, \%wb_splits, \%wb_abbreviations,
                        $has_unused);
}

sub sanitize_name ($sanitized) {
    # Change the non-word characters in the input string to standardized word
    # equivalents

    $sanitized =~ s/=/__/;
    $sanitized =~ s/&/_AMP_/;
    $sanitized =~ s/\./_DOT_/;
    $sanitized =~ s/-/_MINUS_/;
    $sanitized =~ s!/!_SLASH_!;

    return $sanitized;
}

sub token_name {
    my $name = sanitize_name(shift);
    warn "$name contains non-word" if $name =~ /\W/;

    return "$table_name_prefix\U$name"
}

switch_pound_if ('ALL', 'PERL_IN_REGCOMP_C');

output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);

if ($num_anyof_code_points == 256) {    # Same as Latin1
    print $out_fh
            "\nstatic const UV * const InBitmap_invlist = Latin1_invlist;\n";
}
else {
    output_invlist("InBitmap", [ 0, $num_anyof_code_points ]);
}

end_file_pound_if;

# We construct lists for all the POSIX and backslash sequence character
# classes in two forms:
#   1) ones which match only in the ASCII range
#   2) ones which match either in the Latin1 range, or the entire Unicode range
#
# These get compiled in, and hence affect the memory footprint of every Perl
# program, even those not using Unicode.  To minimize the size, currently
# the Latin1 version is generated for the beyond ASCII range except for those
# lists that are quite small for the entire range, such as for \s, which is 22
# UVs long plus 4 UVs (currently) for the header.
#
# To save even more memory, the ASCII versions could be derived from the
# larger ones at runtime, saving some memory (minus the expense of the machine
# instructions to do so), but these are all small anyway, so their total is
# about 100 UVs.
#
# In the list of properties below that get generated, the L1 prefix is a fake
# property that means just the Latin1 range of the full property (whose name
# has an X prefix instead of L1).
#
# An initial & means to use the subroutine from this file instead of an
# official inversion list.
#
print "Computing unicode properties\n" if DEBUG;

# Below is the list of property names to generate.  '&' means to use the
# subroutine to generate the inversion list instead of the generic code
# below.  Some properties have a comma-separated list after the name,
# These are extra enums to add to those found in the Unicode tables.
no warnings 'qw';
                        # Ignore non-alpha in sort
my @props;
push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
                    &UpperLatin1

                    _Perl_GCB,EDGE,E_Base,E_Base_GAZ,E_Modifier,ExtPict_XX,Glue_After_Zwj,InCB_Consonant,InCB_Consonant_XX,InCB_Extend,InCB_Extend_EX,InCB_Linker,InCB_Linker_EX,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ

                    _Perl_LB,EDGE,Aksara,Aksara_Prebase,Aksara_Start,AK,AP,Close_Parenthesis,Cn_ExtPict_ExtPict_ID,Contingent_Break,Dotted_Circle,Dotted_Circle_AL,East_Asian_CP,East_Asian_OP,E_Base,E_Modifier,H2,H3,Hebrew_Letter,JL,JT,JV,Next_Line,Pf_QU,Pi_QU,Regional_Indicator,HH,VF,VI,Virama,Virama_Final,Word_Joiner,ZWJ

                    _Perl_SB,EDGE,CR,Extend,LF,SContinue

                    _Perl_WB,Perl_Tailored_HSpace,EDGE,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,ExtPict_LE,ExtPict_XX,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,UNKNOWN,ZWJ

                    _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
                    Lowercase_Mapping
                    Titlecase_Mapping
                    Uppercase_Mapping
                    Simple_Case_Folding
                    Case_Folding
                    &_Perl_IVCF
                    &_Perl_CCC_non0_non230
                );
                # NOTE that the convention is that extra enum values come
                # after the property name, separated by commas, with the enums
                # that aren't ever defined by Unicode (with some exceptions)
                # containing at least 4 all-uppercase characters.

                # Some of the enums are current official property values that
                # are needed for the rules in constructing certain tables in
                # this file, and perhaps in regexec.c as well.  They are here
                # so that things don't crash when compiled on earlier Unicode
                # releases where they don't exist.  Thus the rules that use
                # them still get compiled, but no code point actually uses
                # them, hence they won't get exercized on such Unicode
                # versions, but the code will still compile and run, though
                # may not give the precise results that those versions would
                # expect, but reasonable results nonetheless.
                #
                # Other enums are due to the fact that Unicode has in more
                # recent versions added criteria to the rules in these extra
                # tables that are based on factors outside the property
                # values.  And those have to be accounted for, essentially by
                # here splitting certain enum equivalence classes based on
                # those extra rules.
                #
                # EDGE is supposed to be a boundary between some types of
                # enums, but khw thinks that isn't valid any more.

my @bin_props;
my @perl_prop_synonyms;
my %enums;
my @deprecated_messages = "";   # Element [0] is a placeholder
my %deprecated_tags;

my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x;

# Create another hash that maps floating point x.yyEzz representation to what
# %stricter_to_file_of does for the equivalent rational.  A typical entry in
# the latter hash is
#
#    'nv=1/2' => 'Nv/1_2',
#
# From that, this loop creates an entry
#
#    'nv=5.00e-01' => 'Nv/1_2',
#
# %stricter_to_file_of contains far more than just the rationals.  Instead we
# use %Unicode::UCD::nv_floating_to_rational which should have an entry for each
# nv in the former hash.
my %floating_to_file_of;
foreach my $key (keys %Unicode::UCD::nv_floating_to_rational) {
    my $value = $Unicode::UCD::nv_floating_to_rational{$key};
    $floating_to_file_of{$key} = $Unicode::UCD::stricter_to_file_of{"nv=$value"};
}

# Properties that are specified with a prop=value syntax
my @equals_properties;

# Collect all the binary properties from data in lib/unicore
# Sort so that complements come after the main table, and the shortest
# names first, finally alphabetically.  Also, sort together the tables we want
# to be kept together, and prefer those with 'posix' in their names, which is
# what the C code is expecting their names to be.
foreach my $property (sort
        {   exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
         or $b =~ /posix/i <=> $a =~ /posix/i
         or $b =~ /perl/i <=> $a =~ /perl/i
         or $a =~ $float_e_format <=> $b =~ $float_e_format
         or $a =~ /!/ <=> $b =~ /!/
         or length $a <=> length $b
         or $a cmp $b
        }   keys %Unicode::UCD::loose_to_file_of,
            keys %Unicode::UCD::stricter_to_file_of,
            keys %floating_to_file_of
) {

    # These two hashes map properties to values that can be considered to
    # be checksums.  If two properties have the same checksum, they have
    # identical entries.  Otherwise they differ in some way.
    my $tag = $Unicode::UCD::loose_to_file_of{$property};
    $tag = $Unicode::UCD::stricter_to_file_of{$property} unless defined $tag;
    $tag = $floating_to_file_of{$property} unless defined $tag;

    # The tag may contain an '!' meaning it is identical to the one formed
    # by removing the !, except that it is inverted.
    my $inverted = $tag =~ s/!//;

    # This hash is lacking the property name
    $property = "nv=$property" if $property =~ $float_e_format;

    # The list of 'prop=value' entries that this single entry expands to
    my @this_entries;

    # Split 'property=value' on the equals sign, with $lhs being the whole
    # thing if there is no '='
    my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x;

    # $lhs then becomes the property name.
    my $prop_value = $rhs =~ s/ ^ = //rx;

    push @equals_properties, $lhs if $prop_value ne "";

    # See if there are any synonyms for this property.
    if (exists $prop_name_aliases{$lhs}) {

        # If so, do the combinatorics so that a new entry is added for
        # each legal property combined with the property value (which is
        # $rhs)
        foreach my $alias (@{$prop_name_aliases{$lhs}}) {

            # But, there are some ambiguities, like 'script' is a synonym
            # for 'sc', and 'sc' can stand alone, meaning something
            # entirely different than 'script'.  'script' cannot stand
            # alone.  Don't add if the potential new lhs is in the hash of
            # stand-alone properties.
            no warnings 'once';
            next if $rhs eq "" &&  grep { $alias eq $_ }
                                    keys %Unicode::UCD::loose_property_to_file_of;

            my $new_entry = $alias . $rhs;
            push @this_entries, $new_entry;
        }
    }

    # Above, we added the synonyms for the base entry we're now
    # processing.  But we haven't dealt with it yet.  If we already have a
    # property with the identical characteristics, this becomes just a
    # synonym for it.

    if (exists $enums{$tag}) {
        push @this_entries, $property;
    }
    else { # Otherwise, create a new entry.

        # Add to the list of properties to generate inversion lists for.
        push @bin_props, uc $property;

        # Create a rule for the parser
        if (! exists $keywords{$property}) {
            $keywords{$property} = token_name($property);
        }

        # And create an enum for it.
        $enums{$tag} = $table_name_prefix . uc sanitize_name($property);

        $perl_tags{$tag} = 1 if exists $keep_together{lc $property};

        # Some properties are deprecated.  This hash tells us so, and the
        # warning message to raise if they are used.
        if (exists $Unicode::UCD::why_deprecated{$tag}) {
            $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages;
            push @deprecated_messages, $Unicode::UCD::why_deprecated{$tag};
        }

        # Our sort above should have made sure that we see the
        # non-inverted version first, but this makes sure.
        warn "$property is inverted!!!" if $inverted;
    }

    # Everything else is #defined to be the base enum, inversion is
    # indicated by negating the value.
    my $defined_to = "";
    $defined_to .= "-" if $inverted;
    $defined_to .= $enums{$tag};

    # Go through the entries that evaluate to this.
    @this_entries = uniques @this_entries;
    foreach my $define (@this_entries) {

        # There is a rule for the parser for each.
        $keywords{$define} = $defined_to;

        # And a #define for all simple names equivalent to a perl property,
        # except those that begin with 'is' or 'in';
        if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) {
            push @perl_prop_synonyms, "#define "
                                    . $table_name_prefix
                                    . uc(sanitize_name($define))
                                    . "   $defined_to";
        }
    }
}

@bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
                   or $a cmp $b
                  } @bin_props;
@perl_prop_synonyms = sort(uniques(@perl_prop_synonyms));
push @props, @bin_props;

foreach my $prop (@props) {

    # For the Latin1 properties, we change to use the eXtended version of the
    # base property, then go through the result and get rid of everything not
    # in Latin1 (above 255).  Actually, we retain the element for the range
    # that crosses the 255/256 boundary if it is one that matches the
    # property.  For example, in the Word property, there is a range of code
    # points that start at U+00F8 and goes through U+02C1.  Instead of
    # artificially cutting that off at 256 because 256 is the first code point
    # above Latin1, we let the range go to its natural ending.  That gives us
    # extra information with no added space taken.  But if the range that
    # crosses the boundary is one that doesn't match the property, we don't
    # start a new range above 255, as that could be construed as going to
    # infinity.  For example, the Upper property doesn't include the character
    # at 255, but does include the one at 256.  We don't include the 256 one.
    my $prop_name = $prop;
    my $is_local_sub = $prop_name =~ s/^&//;
    my $extra_enums = "";
    $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
    my $lookup_prop = $prop_name;
    $prop_name = sanitize_name($prop_name);
    $prop_name = $table_name_prefix . $prop_name
                                if grep { lc $lookup_prop eq lc $_ } @bin_props;
    my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
                    or $lookup_prop =~ s/^L1//);
    my $nonl1_only = 0;
    $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
    ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;

    for my $charset (get_supported_code_pages()) {
        @a2n = @{get_a2n($charset)};

        my @invlist;
        my @invmap;
        my $map_format = 0;
        my $map_default;
        my $maps_to_code_point = 0;
        my $to_adjust = 0;
        my $same_in_all_code_pages;
        if ($is_local_sub) {
            my @return = eval $lookup_prop;
            die $@ if $@;
            my $invlist_ref = shift @return;
            @invlist = @$invlist_ref;
            if (@return) {  # If has other values returned , must be an
                            # inversion map
                my $invmap_ref = shift @return;
                @invmap = @$invmap_ref;
                $map_format = shift @return;
                $map_default = shift @return;
            }
        }
        else {
            @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok');
            if (! @invlist) {

                # If couldn't find a non-empty inversion list, see if it is
                # instead an inversion map
                my ($list_ref, $map_ref, $format, $default)
                          = prop_invmap($lookup_prop, '_perl_core_internal_ok');
                if (! $list_ref) {
                    # An empty return here could mean an unknown property, or
                    # merely that the original inversion list is empty.  Call
                    # in scalar context to differentiate
                    my $count = prop_invlist($lookup_prop,
                                             '_perl_core_internal_ok');
                    if (defined $count) {
                        # Short-circuit an empty inversion list.
                        output_invlist($prop_name, \@invlist, $charset);
                        last;
                    }
                    die "Could not find inversion list for '$lookup_prop'"
                }
                else {
                    @invlist = @$list_ref;
                    @invmap = @$map_ref;
                    $map_format = $format;
                    $map_default = $default;
                }
            }
        }

        if ($map_format) {
            $maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x;
            $to_adjust = $map_format =~ /a/;
        }

        # Re-order the Unicode code points to native ones for this platform.
        # This is only needed for code points below 256, because native code
        # points are only in that range.  For inversion maps of properties
        # where the mappings are adjusted (format =~ /a/), this reordering
        # could mess up the adjustment pattern that was in the input, so that
        # has to be dealt with.
        #
        # And inversion maps that map to code points need to eventually have
        # all those code points remapped to native, and it's better to do that
        # here, going through the whole list not just those below 256.  This
        # is because some inversion maps have adjustments (format =~ /a/)
        # which may be affected by the reordering.  This code needs to be done
        # both for when we are translating the inversion lists for < 256, and
        # for the inversion maps for everything.  By doing both in this loop,
        # we can share that code.
        #
        # So, we go through everything for an inversion map to code points;
        # otherwise, we can skip any remapping at all if we are going to
        # output only the above-Latin1 values, or if the range spans the whole
        # of 0..256, as the remap will also include all of 0..256  (256 not
        # 255 because a re-ordering could cause 256 to need to be in the same
        # range as 255.)
        if (       (@invmap && $maps_to_code_point)
            || (    @invlist
                &&  $invlist[0] < 256
                && (    $invlist[0] != 0
                    || (scalar @invlist != 1 && $invlist[1] < 256))))
        {
            $same_in_all_code_pages = 0;
            if (! @invmap) {    # Straight inversion list
                # Look at all the ranges that start before 257.
                my @latin1_list;
                while (@invlist) {
                    last if $invlist[0] > 256;
                    my $upper = @invlist > 1
                                ? $invlist[1] - 1      # In range

                                # To infinity.  You may want to stop much much
                                # earlier; going this high may expose perl
                                # deficiencies with very large numbers.
                                : 256;
                    for my $j ($invlist[0] .. $upper) {
                        push @latin1_list, a2n($j);
                    }

                    shift @invlist; # Shift off the range that's in the list
                    shift @invlist; # Shift off the range not in the list
                }

                # Here @invlist contains all the ranges in the original that
                # start at code points above 256, and @latin1_list contains
                # all the native code points for ranges that start with a
                # Unicode code point below 257.  We sort the latter and
                # convert it to inversion list format.  Then simply prepend it
                # to the list of the higher code points.
                @latin1_list = sort { $a <=> $b } @latin1_list;
                @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list);
                unshift @invlist, @latin1_list;
            }
            else {  # Is an inversion map

                # This is a similar procedure as plain inversion list, but has
                # multiple buckets.  A plain inversion list just has two
                # buckets, 1) 'in' the list; and 2) 'not' in the list, and we
                # pretty much can ignore the 2nd bucket, as it is completely
                # defined by the 1st.  But here, what we do is create buckets
                # which contain the code points that map to each, translated
                # to native and turned into an inversion list.  Thus each
                # bucket is an inversion list of native code points that map
                # to it or don't map to it.  We use these to create an
                # inversion map for the whole property.

                # As mentioned earlier, we use this procedure to not just
                # remap the inversion list to native values, but also the maps
                # of code points to native ones.  In the latter case we have
                # to look at the whole of the inversion map (or at least to
                # above Unicode; as the maps of code points above that should
                # all be to the default).
                my $upper_limit = (! $maps_to_code_point)
                                   ? 256
                                   : (Unicode::UCD::UnicodeVersion() eq '1.1.5')
                                      ? 0xFFFF
                                      : 0x10FFFF;

                my %mapped_lists;   # A hash whose keys are the buckets.
                while (@invlist) {
                    last if $invlist[0] > $upper_limit;

                    # This shouldn't actually happen, as prop_invmap() returns
                    # an extra element at the end that is beyond $upper_limit
                    die "inversion map (for $prop_name) that extends to"
                      . " infinity is unimplemented" unless @invlist > 1;

                    my $bucket;

                    # A hash key can't be a ref (we are only expecting arrays
                    # of scalars here), so convert any such to a string that
                    # will be converted back later (using a vertical tab as
                    # the separator).
                    if (ref $invmap[0]) {
                        $bucket = join "\cK", map { a2n($_) }  @{$invmap[0]};
                    }
                    elsif (   $maps_to_code_point
                           && $invmap[0] =~ $integer_or_float_re)
                    {

                        # Do convert to native for maps to single code points.
                        # There are some properties that have a few outlier
                        # maps that aren't code points, so the above test
                        # skips those.  0 is never remapped.
                        $bucket = $invmap[0] == 0 ? 0 : a2n($invmap[0]);
                    } else {
                        $bucket = $invmap[0];
                    }

                    # We now have the bucket that all code points in the range
                    # map to, though possibly they need to be adjusted.  Go
                    # through the range and put each translated code point in
                    # it into its bucket.
                    my $base_map = $invmap[0];
                    for my $j ($invlist[0] .. $invlist[1] - 1) {
                        if ($to_adjust
                               # The 1st code point doesn't need adjusting
                            && $j > $invlist[0]

                               # Skip any non-numeric maps: these are outliers
                               # that aren't code points.
                            && $base_map =~ $integer_or_float_re

                               #  'ne' because the default can be a string
                            && $base_map ne $map_default)
                        {
                            # We adjust, by incrementing each the bucket and
                            # the map.  For code point maps, translate to
                            # native
                            $base_map++;
                            $bucket = ($maps_to_code_point)
                                      ? a2n($base_map)
                                      : $base_map;
                        }

                        # Add the native code point to the bucket for the
                        # current map
                        push @{$mapped_lists{$bucket}}, a2n($j);
                    } # End of loop through all code points in the range

                    # Get ready for the next range
                    shift @invlist;
                    shift @invmap;
                } # End of loop through all ranges in the map.

                # Here, @invlist and @invmap retain all the ranges from the
                # originals that start with code points above $upper_limit.
                # Each bucket in %mapped_lists contains all the code points
                # that map to that bucket.  If the bucket is for a map to a
                # single code point, the bucket has been converted to native.
                # If something else (including multiple code points), no
                # conversion is done.
                #
                # Now we recreate the inversion map into %xlated, but this
                # time for the native character set.
                my %xlated;
                foreach my $bucket (keys %mapped_lists) {

                    # Sort and convert this bucket to an inversion list.  The
                    # result will be that ranges that start with even-numbered
                    # indexes will be for code points that map to this bucket;
                    # odd ones map to some other bucket, and are discarded
                    # below.
                    @{$mapped_lists{$bucket}}
                                    = sort{ $a <=> $b} @{$mapped_lists{$bucket}};
                    @{$mapped_lists{$bucket}}
                     = mk_invlist_from_sorted_cp_list(
                                                    \@{$mapped_lists{$bucket}});

                    # Add each even-numbered range in the bucket to %xlated;
                    # so that the keys of %xlated become the range start code
                    # points, and the values are their corresponding maps.
                    while (@{$mapped_lists{$bucket}}) {
                        my $range_start = $mapped_lists{$bucket}->[0];
                        if ($bucket =~ /\cK/) {
                            @{$xlated{$range_start}} = split /\cK/, $bucket;
                        }
                        else {
                            # If adjusting, and there is more than one thing
                            # that maps to the same thing, they must be split
                            # so that later the adjusting doesn't think the
                            # subsequent items can go away because of the
                            # adjusting.
                            my $range_end = (     $to_adjust
                                               && $bucket != $map_default)
                                            ? $mapped_lists{$bucket}->[1] - 1
                                            : $range_start;
                            for my $i ($range_start .. $range_end) {
                                $xlated{$i} = $bucket;
                            }
                        }
                        shift @{$mapped_lists{$bucket}}; # Discard odd ranges
                        shift @{$mapped_lists{$bucket}}; # Get ready for next
                                                         # iteration
                    }
                } # End of loop through all the buckets.

                # Here %xlated's keys are the range starts of all the code
                # points in the inversion map.  Construct an inversion list
                # from them.
                my @new_invlist = sort { $a <=> $b } keys %xlated;

                # If the list is adjusted, we want to munge this list so that
                # we only have one entry for where consecutive code points map
                # to consecutive values.  We just skip the subsequent entries
                # where this is the case.
                if ($to_adjust) {
                    my @temp;
                    for my $i (0 .. @new_invlist - 1) {
                        next if $i > 0
                                && $new_invlist[$i-1] + 1 == $new_invlist[$i]
                                && $xlated{$new_invlist[$i-1]}
                                                        =~ $integer_or_float_re
                                && $xlated{$new_invlist[$i]}
                                                        =~ $integer_or_float_re
                                && $xlated{$new_invlist[$i-1]} + 1
                                                 == $xlated{$new_invlist[$i]};
                        push @temp, $new_invlist[$i];
                    }
                    @new_invlist = @temp;
                }

                # The inversion map comes from %xlated's values.  We can
                # unshift each onto the front of the untouched portion, in
                # reverse order of the portion we did process.
                foreach my $start (reverse @new_invlist) {
                    unshift @invmap, $xlated{$start};
                }

                # Finally prepend the inversion list we have just constructed
                # to the one that contains anything we didn't process.
                unshift @invlist, @new_invlist;
            }
        }
        elsif (@invmap) {   # inversion maps can't cope with this variable
                            # being true, even if it could be true
            $same_in_all_code_pages = 0;
        }
        else {
            $same_in_all_code_pages = 1;
        }

        # prop_invmap() returns an extra final entry, which we can now
        # discard.
        if (@invmap) {
            pop @invlist;
            pop @invmap;
        }

        if ($l1_only) {
            die "Unimplemented to do a Latin-1 only inversion map" if @invmap;
            for my $i (0 .. @invlist - 1 - 1) {
                if ($invlist[$i] > 255) {

                    # In an inversion list, even-numbered elements give the code
                    # points that begin ranges that match the property;
                    # odd-numbered give ones that begin ranges that don't match.
                    # If $i is odd, we are at the first code point above 255 that
                    # doesn't match, which means the range it is ending does
                    # match, and crosses the 255/256 boundary.  We want to
                    # include this ending point, so increment $i, so the
                    # splice below includes it.  Conversely, if $i is even, it
                    # is the first code point above 255 that matches, which
                    # means there was no matching range that crossed the
                    # boundary, and we don't want to include this code point,
                    # so splice before it.
                    $i++ if $i % 2 != 0;

                    # Remove everything past this.
                    splice @invlist, $i;
                    splice @invmap, $i if @invmap;
                    last;
                }
            }
        }
        elsif ($nonl1_only) {
            my $found_nonl1 = 0;
            for my $i (0 .. @invlist - 1 - 1) {
                next if $invlist[$i] < 256;

                # Here, we have the first element in the array that indicates an
                # element above Latin1.  Get rid of all previous ones.
                splice @invlist, 0, $i;
                splice @invmap, 0, $i if @invmap;

                # If this one's index is not divisible by 2, it means that this
                # element is inverting away from being in the list, which means
                # all code points from 256 to this one are in this list (or
                # map to the default for inversion maps)
                if ($i % 2 != 0) {
                    unshift @invlist, 256;
                    unshift @invmap, $map_default if @invmap;
                }
                $found_nonl1 = 1;
                last;
            }
            if (! $found_nonl1) {
                warn "No non-Latin1 code points in $prop_name";
                output_invlist($prop_name, []);
                last;
            }
        }

        switch_pound_if ($prop_name, 'PERL_IN_REGCOMP_C');
        start_charset_pound_if($charset, 1) unless $same_in_all_code_pages;

        output_invlist($prop_name, \@invlist, ($same_in_all_code_pages)
                                              ? $applies_to_all_charsets_text
                                              : $charset);

        if (@invmap) {
            output_invmap($prop_name, \@invmap, $lookup_prop, $map_format,
                          $map_default, $extra_enums, $charset);
        }

        last if $same_in_all_code_pages;
        end_charset_pound_if;
    }
}

print "Finished computing unicode properties\n" if DEBUG;

print $out_fh "\nconst char * const deprecated_property_msgs[] = {\n\t";
print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages;
print $out_fh "\n};\n";

switch_pound_if ('binary_invlist_enum', 'PERL_IN_REGCOMP_C');

my @enums = sort values %enums;

# Save a copy of these before modification
my @invlist_names = map { "${_}_invlist" } @enums;

# Post-process the enums for deprecated properties.
if (scalar keys %deprecated_tags) {
    my $seen_deprecated = 0;
    foreach my $enum (@enums) {
        if (grep { $_ eq $enum } keys %deprecated_tags) {

            # Change the enum name for this deprecated property to a
            # munged one to act as a placeholder in the typedef.  Then
            # make the real name be a #define whose value is such that
            # its modulus with the number of enums yields the index into
            # the table occupied by the placeholder.  And so that dividing
            # the #define value by the table length gives an index into
            # the table of deprecation messages for the corresponding
            # warning.
            my $revised_enum = "${enum}_perl_aux";
            if (! $seen_deprecated) {
                $seen_deprecated = 1;
                print $out_fh "\n";
            }
            print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n";
            $enum = $revised_enum;
        }
    }
}

print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,",
              " /* So no real value is zero */\n\t";
print $out_fh join ",\n\t", @enums;
print $out_fh "\n";
print $out_fh "} binary_invlist_enum;\n";
print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n";

switch_pound_if ('binary_property_tables', 'PERL_IN_REGCOMP_C');

output_table_header($out_fh, "UV *", "uni_prop_ptrs");
print $out_fh "\tNULL,\t/* Placeholder */\n";
print $out_fh "\t";
print $out_fh join ",\n\t", @invlist_names;
print $out_fh "\n";

output_table_trailer();

switch_pound_if ('synonym defines', 'PERL_IN_REGCOMP_C');

print $out_fh join "\n", "\n",
                         #'#    ifdef DOINIT',
                         #"\n",
                         "/* Synonyms for perl properties */",
                         @perl_prop_synonyms,
                         #"\n",
                         #"#    endif  /* DOINIT */",
                         "\n";

switch_pound_if ('Valid property_values', 'PERL_IN_REGCOMP_C');

# Each entry is a pointer to a table of property values for some property.
# (Other properties may share this table.  The next two data structures allow
# this sharing to be implemented.)
my @values_tables = "NULL /* Placeholder so zero index is an error */";

# Keys are all the values of a property, strung together.  The value of each
# key is its index in @values_tables.  This is because many properties have
# the same values, and this allows the data to appear just once.
my %joined_values;

# #defines for indices into @values_tables, so can have synonyms resolved by
# the C compiler.
my @values_indices;

print "Computing short unicode properties\n" if DEBUG;
# Go through each property which is specifiable by \p{prop=value}, and create
# a hash with the keys being the canonicalized short property names, and the
# values for each property being all possible values that it can take on.
# Both the full value and its short, canonicalized into lc, sans punctuation
# version are included.
my %all_values;
for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) }
                 uniques @equals_properties)
{
    # Get and canonicalize the short name for this property.
    my ($short_name) = prop_aliases($property);
    $short_name = lc $short_name;
    $short_name =~ s/[ _-]//g;

    # Now look at each value this property can take on
    foreach my $value (prop_values($short_name)) {

        # And for each value, look at each synonym for it
        foreach my $alias (prop_value_aliases($short_name, $value)) {

            # Add each synonym
            push @{$all_values{$short_name}}, $alias;

            # As well as its canonicalized name.  khw made the decision to not
            # support the grandfathered L_ Gc property value
            $alias = lc $alias;
            $alias =~ s/[ _-]//g unless $alias =~ $numeric_re;
            push @{$all_values{$short_name}}, $alias;
        }
    }
}
print "Finished computing short unicode properties\n" if DEBUG;

# Also include the old style block names, using the recipe given in
# Unicode::UCD
foreach my $block (prop_values('block')) {
    push @{$all_values{'blk'}}, charblock((prop_invlist("block=$block"))[0]);
}

print "Creating property tables\n" if DEBUG;
# Now create output tables for each property in @equals_properties (the keys
# in %all_values) each containing that property's possible values as computed
# just above.
PROPERTY:
for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
                         or $a cmp $b } keys %all_values)
{
    @{$all_values{$property}} = uniques(@{$all_values{$property}});

    # String together the values for this property, sorted.  This string forms
    # a list definition, with each value as an entry in it, indented on a new
    # line.  The sorting is used to find properties that take on the exact
    # same values to share this string.
    my $joined = "\t\"";
    $joined .= join "\",\n\t\"",
                sort { ($a =~ $numeric_re && $b =~ $numeric_re)
                        ? eval $a <=> eval $b
                        :    prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
                          or $a cmp $b
                        } @{$all_values{$property}};
    # And add a trailing marker
    $joined .= "\",\n\tNULL\n";

    my $table_name = $table_name_prefix . $property . "_values";
    my $index_name = "${table_name}_index";

    # Add a rule for the parser that is just an empty value.  It will need to
    # know to look up empty things in the prop_value_ptrs[] table.

    $keywords{"$property="} = $index_name;
    if (exists $prop_name_aliases{$property}) {
        foreach my $alias (@{$prop_name_aliases{$property}}) {
            $keywords{"$alias="} = $index_name;
        }
    }

    # Also create rules for the synonyms of this property to point to the same
    # thing

    # If this property's values are the same as one we've already computed,
    # use that instead of creating a duplicate.  But we add a #define to point
    # to the proper one.
    if (exists $joined_values{$joined}) {
        push @values_indices, "#define $index_name  $joined_values{$joined}\n";
        next PROPERTY;
    }

    # And this property, now known to have unique values from any other seen
    # so far is about to be pushed onto @values_tables.  Its index is the
    # current count.
    push @values_indices, "#define $index_name  "
                         . scalar @values_tables . "\n";
    $joined_values{$joined} = $index_name;
    push @values_tables, $table_name;

    # Create the table for this set of values.
    output_table_header($out_fh, "char *", $table_name);
    print $out_fh $joined;
    output_table_trailer();
} # End of loop through the properties, and their values

# We have completely determined the table of the unique property values
output_table_header($out_fh, "char * const *",
                             "${table_name_prefix}prop_value_ptrs");
print $out_fh join ",\n", @values_tables;
print $out_fh "\n";
output_table_trailer();

# And the #defines for the indices in it
print $out_fh "\n\n", join "", @values_indices;

switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C');

output_GCB_table();
output_LB_table();
output_WB_table();

end_file_pound_if;

print "Computing fold data\n" if DEBUG;

print $regexp_constants_fh <<"EOF";

/* More than one code point may have the same code point as their fold.  This
 * gives the maximum number in the current Unicode release.  (The folded-to
 * code point is not included in this count.)  For example, both 'S' and
 * \\x{17F} fold to 's', so the number for that fold is 2.  Another way to
 * look at it is the maximum length of all the IVCF_AUX_TABLE's */
#define MAX_FOLD_FROMS $max_fold_froms
EOF

my $sources_list = "lib/unicore/mktables.lst";
my @sources = qw(regen/mk_invlists.pl
                 lib/unicore/mktables
                 lib/Unicode/UCD.pm
                 regen/charset_translations.pl
                 regen/mk_PL_charclass.pl
               );
{
    # Depend on mktables’ own sources.  It’s a shorter list of files than
    # those that Unicode::UCD uses.  Some may not actually have an effect on
    # the output of this program, but easier to just include all of them, and
    # no real harm in doing so, as it is rare for one such to change without
    # the others doing so as well.
    if (! open my $mktables_list, '<', $sources_list) {

          # This should force a rebuild once $sources_list exists
          push @sources, $sources_list;
    }
    else {
        while(<$mktables_list>) {
            last if /===/;
            chomp;
            push @sources, "lib/unicore/$_" if /^[^#]/;
        }
    }
}

read_only_bottom_close_and_rename($regexp_constants_fh, \@sources);

read_only_bottom_close_and_rename($out_fh, \@sources);

my %name_to_index;
for my $i (0 .. @enums - 1) {
    my $loose_name = $enums[$i] =~ s/^$table_name_prefix//r;
    $loose_name = lc $loose_name;
    $loose_name =~ s/__/=/;
    $loose_name =~ s/_dot_/./;
    $loose_name =~ s/_slash_/\//g;
    $name_to_index{$loose_name} = $i + 1;
}
# unsanitize, exclude &, maybe add these before sanitize
for my $i (0 .. @perl_prop_synonyms - 1) {
    my $loose_name_pair = $perl_prop_synonyms[$i] =~ s/#\s*define\s*//r;
    $loose_name_pair =~ s/\b$table_name_prefix//g;
    $loose_name_pair = lc $loose_name_pair;
    $loose_name_pair =~ s/__/=/g;
    $loose_name_pair =~ s/_dot_/./g;
    $loose_name_pair =~ s/_slash_/\//g;
    my ($synonym, $primary) = split / +/, $loose_name_pair;
    $name_to_index{$synonym} = $name_to_index{$primary};
}

my $uni_pl = open_new('lib/unicore/uni_keywords.pl', '>',
                      {style => '*', by => 'regen/mk_invlists.pl',
                      from => "Unicode::UCD"});
{
    print $uni_pl "\%Unicode::UCD::uni_prop_ptrs_indices = (\n";
    for my $name (sort keys %name_to_index) {
        print $uni_pl "    '$name' => $name_to_index{$name},\n";
    }
    print $uni_pl ");\n\n1;\n";
}

read_only_bottom_close_and_rename($uni_pl, \@sources);

print "Computing minimal perfect hash for unicode properties.\n" if DEBUG;

if (my $file= $ENV{DUMP_KEYWORDS_FILE}) {
    require Data::Dumper;

    open my $ofh, ">", $file
        or die "Failed to open DUMP_KEYWORDS_FILE '$file' for write: $!";
    print $ofh Data::Dumper->new([\%keywords],['*keywords'])
                           ->Sortkeys(1)->Useqq(1)->Dump();
    close $ofh;
    print "Wrote keywords to '$file'.\n";
}

my $keywords_fh = open_new('uni_keywords.h', '>',
                  {style => '*', by => 'regen/mk_invlists.pl',
                  from => "mph.pl"});

print $keywords_fh "\n#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD)\n\n";

my $mph= MinimalPerfectHash->new(
    source_hash => \%keywords,
    match_name => "match_uniprop",
    simple_split => $ENV{SIMPLE_SPLIT} // 0,
    randomize_squeeze => $ENV{RANDOMIZE_SQUEEZE} // 1,
    max_same_in_squeeze => $ENV{MAX_SAME} // 5,
    srand_seed => (lc($ENV{SRAND_SEED}//"") eq "auto")
                  ? undef
                  : $ENV{SRAND_SEED} // 1785235451, # I let perl pick a number
);
$mph->make_mph_with_split_keys();
print $keywords_fh $mph->make_algo();

print $keywords_fh "\n#endif /* #if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) */\n";

push @sources, 'regen/mph.pl';
read_only_bottom_close_and_rename($keywords_fh, \@sources);
