regen/mk_invlists.pl

   1 #!perl -w
   2 use 5.015;
   3 use strict;
   4 use warnings;
   5 use Unicode::UCD qw(prop_aliases
   6                     prop_values
   7                     prop_value_aliases
   8                     prop_invlist
   9                     prop_invmap search_invlist
  10                     charprop
  11                     num
  12                     charblock
  13                    );
  14 require './regen/regen_lib.pl';
  15 require './regen/charset_translations.pl';
  16 require './lib/unicore/UCD.pl';
  17 require './regen/mph.pl';
  18 use re "/aa";
  19
  20 # This program outputs charclass_invlists.h, which contains various inversion
  21 # lists in the form of C arrays that are to be used as-is for inversion lists.
  22 # Thus, the lists it contains are essentially pre-compiled, and need only a
  23 # light-weight fast wrapper to make them usable at run-time.
  24
  25 # As such, this code knows about the internal structure of these lists, and
  26 # any change made to that has to be done here as well.  A random number stored
  27 # in the headers is used to minimize the possibility of things getting
  28 # out-of-sync, or the wrong data structure being passed.  Currently that
  29 # random number is:
  30
  31 my $VERSION_DATA_STRUCTURE_TYPE = 148565664;
  32
  33 # charclass_invlists.h now also contains inversion maps and enum definitions
  34 # for those maps that have a finite number of possible values
  35
  36 # integer or float (no exponent)
  37 my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
  38
  39 # Also includes rationals
  40 my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x;
  41
  42 # More than one code point may have the same code point as their fold.  This
  43 # gives the maximum number in the current Unicode release.  (The folded-to
  44 # code point is not included in this count.)  Most folds are pairs of code
  45 # points, like 'B' and 'b', so this number is at least one.
  46 my $max_fold_froms = 1;
  47
  48 my %keywords;
  49 my $table_name_prefix = "UNI_";
  50
  51 # Matches valid C language enum names: begins with ASCII alphabetic, then any
  52 # ASCII \w
  53 my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax;
  54
  55 my $out_fh = open_new('charclass_invlists.h', '>',
  56                       {style => '*', by => 'regen/mk_invlists.pl',
  57                       from => "Unicode::UCD"});
  58
  59 my $in_file_pound_if = "";
  60
  61 my $max_hdr_len = 3;    # In headings, how wide a name is allowed?
  62
  63 print $out_fh "/* See the generating file for comments */\n\n";
  64
  65 print $out_fh <<'EOF';
  66 /* This gives the number of code points that can be in the bitmap of an ANYOF
  67  * node.  The shift number must currently be one of: 8..12.  It can't be less
  68  * than 8 (256) because some code relies on it being at least that.  Above 12
  69  * (4096), and you start running into warnings that some data structure widths
  70  * have been exceeded, though the test suite as of this writing still passes
  71  * for up through 16, which is as high as anyone would ever want to go,
  72  * encompassing all of the Unicode BMP, and thus including all the economically
  73  * important world scripts.  At 12 most of them are: including Arabic,
  74  * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
  75  * Japanese, nor Korean.  (The regarglen structure in regnodes.h is a U8, and
  76  * the trie types TRIEC and AHOCORASICKC are larger than U8 for shift values
  77  * above 12.)  Be sure to benchmark before changing, as larger sizes do
  78  * significantly slow down the test suite */
  79
  80 EOF
  81
  82 my $num_anyof_code_points = '(1 << 8)';
  83
  84 print $out_fh "#define NUM_ANYOF_CODE_POINTS   $num_anyof_code_points\n\n";
  85
  86 $num_anyof_code_points = eval $num_anyof_code_points;
  87
  88 no warnings 'once';
  89 print $out_fh <<"EOF";
  90 /* The precision to use in "%.*e" formats */
  91 #define PL_E_FORMAT_PRECISION $Unicode::UCD::e_precision
  92 EOF
  93
  94 # enums that should be made public
  95 my %public_enums = (
  96                     _Perl_SCX => 1
  97                     );
  98
  99 # The symbols generated by this program are all currently defined only in a
 100 # single dot c each.  The code knows where most of them go, but this hash
 101 # gives overrides for the exceptions to the typical place
 102 my %exceptions_to_where_to_define =
 103                         (
 104                             #_Perl_IVCF => 'PERL_IN_REGCOMP_C',
 105                         );
 106
 107 my %where_to_define_enums = ();
 108
 109 my $applies_to_all_charsets_text = "all charsets";
 110
 111 my %gcb_enums;
 112 my @gcb_short_enums;
 113 my %gcb_abbreviations;
 114 my %lb_enums;
 115 my @lb_short_enums;
 116 my %lb_abbreviations;
 117 my %wb_enums;
 118 my @wb_short_enums;
 119 my %wb_abbreviations;
 120
 121 my @a2n;
 122
 123 my %prop_name_aliases;
 124 # Invert this hash so that for each canonical name, we get a list of things
 125 # that map to it (excluding itself)
 126 foreach my $name (sort keys %Unicode::UCD::loose_property_name_of) {
 127     my $canonical = $Unicode::UCD::loose_property_name_of{$name};
 128     push @{$prop_name_aliases{$canonical}},  $name if $canonical ne $name;
 129 }
 130
 131 # Output these tables in the same vicinity as each other, so that will get
 132 # paged in at about the same time.  These are also assumed to be the exact
 133 # same list as those properties used internally by perl.
 134 my %keep_together = (
 135                         assigned => 1,
 136                         ascii => 1,
 137                         upper => 1,
 138                         lower => 1,
 139                         title => 1,
 140                         cased => 1,
 141                         uppercaseletter => 1,
 142                         lowercaseletter => 1,
 143                         titlecaseletter => 1,
 144                         casedletter => 1,
 145                         vertspace => 1,
 146                         xposixalnum => 1,
 147                         xposixalpha => 1,
 148                         xposixblank => 1,
 149                         xposixcntrl => 1,
 150                         xposixdigit => 1,
 151                         xposixgraph => 1,
 152                         xposixlower => 1,
 153                         xposixprint => 1,
 154                         xposixpunct => 1,
 155                         xposixspace => 1,
 156                         xposixupper => 1,
 157                         xposixword => 1,
 158                         xposixxdigit => 1,
 159                         posixalnum => 1,
 160                         posixalpha => 1,
 161                         posixblank => 1,
 162                         posixcntrl => 1,
 163                         posixdigit => 1,
 164                         posixgraph => 1,
 165                         posixlower => 1,
 166                         posixprint => 1,
 167                         posixpunct => 1,
 168                         posixspace => 1,
 169                         posixupper => 1,
 170                         posixword => 1,
 171                         posixxdigit => 1,
 172                         _perl_any_folds => 1,
 173                         _perl_folds_to_multi_char => 1,
 174                         _perl_is_in_multi_char_fold => 1,
 175                         _perl_non_final_folds => 1,
 176                         _perl_idstart => 1,
 177                         _perl_idcont => 1,
 178                         _perl_charname_begin => 1,
 179                         _perl_charname_continue => 1,
 180                         _perl_problematic_locale_foldeds_start => 1,
 181                         _perl_problematic_locale_folds => 1,
 182                         _perl_quotemeta => 1,
 183                     );
 184 my %perl_tags;  # So can find synonyms of the above properties
 185
 186 my $unused_table_hdr = 'u';     # Heading for row or column for unused values
 187
 188 sub uniques {
 189     # Returns non-duplicated input values.  From "Perl Best Practices:
 190     # Encapsulated Cleverness".  p. 455 in first edition.
 191
 192     my %seen;
 193     return grep { ! $seen{$_}++ } @_;
 194 }
 195
 196 sub caselessly { lc $a cmp lc $b }
 197
 198 sub a2n($) {
 199     my $cp = shift;
 200
 201     # Returns the input Unicode code point translated to native.
 202
 203     return $cp if $cp !~ $integer_or_float_re || $cp > 255;
 204     return $a2n[$cp];
 205 }
 206
 207 sub end_file_pound_if {
 208     if ($in_file_pound_if) {
 209         print $out_fh "\n#endif\t/* $in_file_pound_if */\n";
 210         $in_file_pound_if = "";
 211     }
 212 }
 213
 214 sub end_charset_pound_if {
 215     print $out_fh "\n" . get_conditional_compile_line_end();
 216 }
 217
 218 sub switch_pound_if ($$;$) {
 219     my $name = shift;
 220     my $new_pound_if = shift;
 221     my $charset = shift;
 222
 223     my @new_pound_if = ref ($new_pound_if)
 224                        ? sort @$new_pound_if
 225                        : $new_pound_if;
 226
 227     # Switch to new #if given by the 2nd argument.  If there is an override
 228     # for this, it instead switches to that.  The 1st argument is the
 229     # static's name, used only to check if there is an override for this
 230     #
 231     # The 'charset' parmameter, if present, is used to first end the charset
 232     # #if if we actually do a switch, and then restart it afterwards.  This
 233     # code, then assumes that the charset #if's are enclosed in the file ones.
 234
 235     if (exists $exceptions_to_where_to_define{$name}) {
 236         @new_pound_if = $exceptions_to_where_to_define{$name};
 237     }
 238
 239     foreach my $element (@new_pound_if) {
 240
 241         # regcomp.c is arranged so that the tables are not compiled in
 242         # re_comp.c, but general enums and defines (which take no space) are
 243         # compiled */
 244         my $no_xsub = 1 if $name !~ /enum|define/
 245                         && $element =~ / PERL_IN_ (?: REGCOMP ) _C /x;
 246         $element = "defined($element)";
 247         $element = "($element && ! defined(PERL_IN_XSUB_RE))" if $no_xsub;
 248     }
 249     $new_pound_if = join " || ", @new_pound_if;
 250
 251     # Change to the new one if different from old
 252     if ($in_file_pound_if ne $new_pound_if) {
 253
 254         end_charset_pound_if() if defined $charset;
 255
 256         # Exit any current #if
 257         if ($in_file_pound_if) {
 258             end_file_pound_if;
 259         }
 260
 261         $in_file_pound_if = $new_pound_if;
 262         print $out_fh "\n#if $in_file_pound_if\n";
 263
 264         start_charset_pound_if ($charset, 1) if defined $charset;
 265     }
 266 }
 267
 268 sub start_charset_pound_if ($;$) {
 269     print $out_fh "\n" . get_conditional_compile_line_start(shift, shift);
 270 }
 271
 272 {   # Closure
 273     my $fh;
 274     my $in_doinit = 0;
 275
 276     sub output_table_header($$$;$@) {
 277
 278         # Output to $fh the heading for a table given by the other inputs
 279
 280         $fh = shift;
 281         my ($type,      # typedef of table, like UV, UV*
 282             $name,      # name of table
 283             $comment,   # Optional comment to put on header line
 284             @sizes      # Optional sizes of each array index.  If omitted,
 285                         # there is a single index whose size is computed by
 286                         # the C compiler.
 287             ) = @_;
 288
 289         $type =~ s/ \s+ $ //x;
 290
 291         # If a the typedef is a ptr, add in an extra const
 292         $type .= " const" if $type =~ / \* $ /x;
 293
 294         $comment = "" unless defined $comment;
 295         $comment = "  /* $comment */" if $comment;
 296
 297         my $array_declaration;
 298         if (@sizes) {
 299             $array_declaration = "";
 300             $array_declaration .= "[$_]" for @sizes;
 301         }
 302         else {
 303             $array_declaration = '[]';
 304         }
 305
 306         my $declaration = "$type ${name}$array_declaration";
 307
 308         # Things not matching this are static.  Otherwise, it is an external
 309         # constant, initialized only under DOINIT.
 310         #
 311         # (Currently everything is static)
 312         if ($in_file_pound_if !~ / PERL_IN_ (?: ) _C /x) {
 313             $in_doinit = 0;
 314             print $fh "\nstatic const $declaration = {$comment\n";
 315         }
 316         else {
 317             $in_doinit = 1;
 318             print $fh <<EOF;
 319
 320 #    ifndef DOINIT
 321
 322 EXTCONST $declaration;
 323
 324 #    else
 325
 326 EXTCONST $declaration = {$comment
 327 EOF
 328         }
 329     }
 330
 331     sub output_table_trailer() {
 332
 333         # Close out a table started by output_table_header()
 334
 335         print $fh "};\n";
 336         if ($in_doinit) {
 337             print $fh "\n#    endif  /* DOINIT */\n\n";
 338             $in_doinit = 0;
 339         }
 340     }
 341 } # End closure
 342
 343
 344 sub output_invlist ($$;$) {
 345     my $name = shift;
 346     my $invlist = shift;     # Reference to inversion list array
 347     my $charset = shift // "";  # name of character set for comment
 348
 349     die "No inversion list for $name" unless defined $invlist
 350                                              && ref $invlist eq 'ARRAY';
 351
 352     # Output the inversion list $invlist using the name $name for it.
 353     # It is output in the exact internal form for inversion lists.
 354
 355     # Is the last element of the header 0, or 1 ?
 356     my $zero_or_one = 0;
 357     if (@$invlist && $invlist->[0] != 0) {
 358         unshift @$invlist, 0;
 359         $zero_or_one = 1;
 360     }
 361
 362     $charset = "for $charset" if $charset;
 363     output_table_header($out_fh, "UV", "${name}_invlist", $charset);
 364
 365     my $count = @$invlist;
 366     print $out_fh <<EOF;
 367 \t$count,\t/* Number of elements */
 368 \t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */
 369 \t$zero_or_one,\t/* 0 if the list starts at 0;
 370 \t\t   1 if it starts at the element beyond 0 */
 371 EOF
 372
 373     # The main body are the UVs passed in to this routine.  Do the final
 374     # element separately
 375     for my $i (0 .. @$invlist - 1) {
 376         printf $out_fh "\t0x%X", $invlist->[$i];
 377         print $out_fh "," if $i < @$invlist - 1;
 378         print $out_fh "\n";
 379     }
 380
 381     output_table_trailer();
 382 }
 383
 384 sub output_invmap ($$$$$$$) {
 385     my $name = shift;
 386     my $invmap = shift;     # Reference to inversion map array
 387     my $prop_name = shift;
 388     my $input_format = shift;   # The inversion map's format
 389     my $default = shift;        # The property value for code points who
 390                                 # otherwise don't have a value specified.
 391     my $extra_enums = shift;    # comma-separated list of our additions to the
 392                                 # property's standard possible values
 393     my $charset = shift // "";  # name of character set for comment
 394
 395     # Output the inversion map $invmap for property $prop_name, but use $name
 396     # as the actual data structure's name.
 397
 398     my $count = @$invmap;
 399
 400     my $output_format;
 401     my $invmap_declaration_type;
 402     my $enum_declaration_type;
 403     my $aux_declaration_type;
 404     my %enums;
 405     my $name_prefix;
 406
 407     if ($input_format =~ / ^ [as] l? $ /x) {
 408         $prop_name = (prop_aliases($prop_name))[1]
 409      // $prop_name =~ s/^_Perl_//r; # Get full name
 410         my $short_name = (prop_aliases($prop_name))[0] // $prop_name;
 411         my @input_enums;
 412
 413         # Find all the possible input values.  These become the enum names
 414         # that comprise the inversion map.  For inputs that don't have sub
 415         # lists, we can just get the unique values.  Otherwise, we have to
 416         # expand the sublists first.
 417         if ($input_format !~ / ^ a /x) {
 418             if ($input_format ne 'sl') {
 419                 @input_enums = sort caselessly uniques(@$invmap);
 420             }
 421             else {
 422                 foreach my $element (@$invmap) {
 423                     if (ref $element) {
 424                         push @input_enums, @$element;
 425                     }
 426                     else {
 427                         push @input_enums, $element;
 428                     }
 429                 }
 430                 @input_enums = sort caselessly uniques(@input_enums);
 431             }
 432         }
 433
 434         # The internal enums come last, and in the order specified.
 435         #
 436         # The internal one named EDGE is also used a marker.  Any ones that
 437         # come after it are used in the algorithms below, and so must be
 438         # defined, even if the release of Unicode this is being compiled for
 439         # doesn't use them.   But since no code points are assigned to them in
 440         # such a release, those values will never be accessed.  We collapse
 441         # all of them into a single placholder row and a column.  The
 442         # algorithms below will fill in those cells with essentially garbage,
 443         # but they are never read, so it doesn't matter.  This allows the
 444         # algorithm to remain the same from release to release.
 445         #
 446         # In one case, regexec.c also uses a placeholder which must be defined
 447         # here, and we put it in the unused row and column as its value is
 448         # never read.
 449         #
 450         my @enums = @input_enums;
 451         my @extras;
 452         my @unused_enums;
 453         my $unused_enum_value = @enums;
 454         if ($extra_enums ne "") {
 455             @extras = split /,/, $extra_enums;
 456             my $seen_EDGE = 0;
 457
 458             # Don't add if already there.
 459             foreach my $this_extra (@extras) {
 460                 next if grep { $_ eq $this_extra } @enums;
 461                 if ($this_extra eq 'EDGE') {
 462                     push @enums, $this_extra;
 463                     $seen_EDGE = 1;
 464                 }
 465                 elsif ($seen_EDGE) {
 466                     push @unused_enums, $this_extra;
 467                 }
 468                 else {
 469                     push @enums, $this_extra;
 470                 }
 471             }
 472
 473             @unused_enums = sort caselessly @unused_enums;
 474             $unused_enum_value = @enums;    # All unused have the same value,
 475                                             # one beyond the final used one
 476         }
 477
 478         # These properties have extra tables written out for them that we want
 479         # to make as compact and legible as possible.  So we find short names
 480         # for their property values.  For non-official ones we will need to
 481         # add a legend at the top of the table to say what the abbreviation
 482         # stands for.
 483         my $property_needs_table_re = qr/ ^  _Perl_ (?: GCB | LB | WB ) $ /x;
 484
 485         my %short_enum_name;
 486         my %need_explanation;   # For non-official abbreviations, we will need
 487                                 # to explain what the one we come up with
 488                                 # stands for
 489         my $type = lc $prop_name;
 490         if ($name =~ $property_needs_table_re) {
 491             my @short_names;  # List of already used abbreviations, so we
 492                               # don't duplicate
 493             for my $enum (@enums) {
 494                 my $short_enum;
 495                 my $is_official_name = 0;
 496
 497                 # Special case this wb property value to make the
 498                 # name more clear
 499                 if ($enum eq 'Perl_Tailored_HSpace') {
 500                     $short_enum = 'hs';
 501                 }
 502                 else {
 503
 504                     # Use the official short name, if found.
 505                     ($short_enum) = prop_value_aliases($type, $enum);
 506                     if ( defined $short_enum) {
 507                         $is_official_name = 1;
 508                     }
 509                     else {
 510                         # But if there is no official name, use the name that
 511                         # came from the data (if any).  Otherwise, the name
 512                         # had to come from the extras list.  There are two
 513                         # types of values in that list.
 514                         #
 515                         # First are those enums that are not part of the
 516                         # property, but are defined by the code in this file.
 517                         # By convention these have all-caps names.  We use the
 518                         # lowercased name for these.
 519                         #
 520                         # Second are enums that are needed to get the
 521                         # algorithms below to work and/or to get regexec.c to
 522                         # compile, but don't exist in all Unicode releases.
 523                         # These are handled outside this loop as
 524                         # 'unused_enums' (as they are unused they all get
 525                         # collapsed into a single column, and their names
 526                         # don't matter)
 527                         if (grep { $_ eq $enum } @input_enums) {
 528                             $short_enum = $enum
 529                         }
 530                         else {
 531                             $short_enum = lc $enum;
 532                         }
 533                     }
 534
 535                     # If our short name is too long, or we already know that
 536                     # the name is an abbreviation, truncate to make sure it's
 537                     # short enough, and remember that we did this so we can
 538                     # later add a comment in the generated file
 539                     if (length $short_enum > $max_hdr_len) {
 540                         # First try using just the uppercase letters of the name;
 541                         # if it is something like FooBar, FB is a better
 542                         # abbreviation than Foo.  That's not the case if it is
 543                         # entirely lowercase.
 544                         my $uc = $short_enum;
 545                         $uc =~ s/[[:^upper:]]//g;
 546                         $short_enum = $uc if length $uc > 1
 547                                           && length $uc < length $short_enum;
 548
 549                         $short_enum = substr($short_enum, 0, $max_hdr_len);
 550                         $is_official_name = 0;
 551                     }
 552                 }
 553
 554                 # If the name we are to display conflicts, try another.
 555                 if (grep { $_ eq $short_enum } @short_names) {
 556                     $is_official_name = 0;
 557                     do { # The increment operator on strings doesn't work on
 558                          # those containing an '_', so get rid of any final
 559                          # portion.
 560                         $short_enum =~ s/_//g;
 561                         $short_enum++;
 562                     } while grep { $_ eq $short_enum } @short_names;
 563                 }
 564
 565                 push @short_names, $short_enum;
 566                 $short_enum_name{$enum} = $short_enum;
 567                 $need_explanation{$enum} = $short_enum unless $is_official_name;
 568             }
 569         } # End of calculating short enum names for certain properties
 570
 571         # Assign a value to each element of the enum type we are creating.
 572         # The default value always gets 0; the others are arbitrarily
 573         # assigned, but for the properties which have the extra table, it is
 574         # in the order we have computed above so the rows and columns appear
 575         # alphabetically by heading abbreviation.
 576         my $enum_val = 0;
 577         my $canonical_default = prop_value_aliases($prop_name, $default);
 578         $default = $canonical_default if defined $canonical_default;
 579         $enums{$default} = $enum_val++;
 580
 581         for my $enum (sort { ($name =~ $property_needs_table_re)
 582                              ?     lc $short_enum_name{$a}
 583                                cmp lc $short_enum_name{$b}
 584                              : lc $a cmp lc $b
 585                            } @enums)
 586         {
 587             $enums{$enum} = $enum_val++ unless exists $enums{$enum};
 588         }
 589
 590         # Now calculate the data for the special tables output for these
 591         # properties.
 592         if ($name =~ $property_needs_table_re) {
 593
 594             # The data includes the hashes %gcb_enums, %lb_enums, etc.
 595             # Similarly we calculate column headings for the tables.
 596             #
 597             # We use string evals to allow the same code to work on
 598             # all the tables
 599
 600             # Skip if we've already done this code, which populated
 601             # this hash
 602             if (eval "! \%${type}_enums") {
 603
 604                 # For each enum in the type ...
 605                 foreach my $enum (keys %enums) {
 606                     my $value = $enums{$enum};
 607                     my $short_enum = $short_enum_name{$enum};
 608
 609                     # Remember the mapping from the property value
 610                     # (enum) name to its value.
 611                     eval "\$${type}_enums{$enum} = $value";
 612                     die $@ if $@;
 613
 614                     # Remember the inverse mapping to the short name
 615                     # so that we can properly label the generated
 616                     # table's rows and columns
 617                     eval "\$${type}_short_enums[$value] = '$short_enum'";
 618                     die $@ if $@;
 619
 620                     # And note the abbreviations that need explanation
 621                     if ($need_explanation{$enum}) {
 622                         eval "\$${type}_abbreviations{$short_enum} = '$enum'";
 623                         die $@ if $@;
 624                     }
 625                 }
 626
 627                 # Each unused enum has the same value.  They all are collapsed
 628                 # into one row and one column, named $unused_table_hdr.
 629                 if (@unused_enums) {
 630                     eval "\$${type}_short_enums['$unused_enum_value'] = '$unused_table_hdr'";
 631                     die $@ if $@;
 632
 633                     foreach my $enum (@unused_enums) {
 634                         eval "\$${type}_enums{$enum} = $unused_enum_value";
 635                         die $@ if $@;
 636                     }
 637                 }
 638             }
 639         }
 640
 641         # The short property names tend to be two lower case letters, but it
 642         # looks better for those if they are upper. XXX
 643         $short_name = uc($short_name) if length($short_name) < 3
 644                                 || substr($short_name, 0, 1) =~ /[[:lower:]]/;
 645         $name_prefix = "${short_name}_";
 646
 647         # Start the enum definition for this map
 648         my @enum_definition;
 649         my @enum_list;
 650         foreach my $enum (keys %enums) {
 651             $enum_list[$enums{$enum}] = $enum;
 652         }
 653         foreach my $i (0 .. @enum_list - 1) {
 654             push @enum_definition, ",\n" if $i > 0;
 655
 656             my $name = $enum_list[$i];
 657             push @enum_definition, "\t${name_prefix}$name = $i";
 658         }
 659         if (@unused_enums) {
 660             foreach my $unused (@unused_enums) {
 661                 push @enum_definition,
 662                             ",\n\t${name_prefix}$unused = $unused_enum_value";
 663             }
 664         }
 665
 666         # For an 'l' property, we need extra enums, because some of the
 667         # elements are lists.  Each such distinct list is placed in its own
 668         # auxiliary map table.  Here, we go through the inversion map, and for
 669         # each distinct list found, create an enum value for it, numbered -1,
 670         # -2, ....
 671         my %multiples;
 672         my $aux_table_prefix = "AUX_TABLE_";
 673         if ($input_format =~ /l/) {
 674             foreach my $element (@$invmap) {
 675
 676                 # A regular scalar is not one of the lists we're looking for
 677                 # at this stage.
 678                 next unless ref $element;
 679
 680                 my $joined;
 681                 if ($input_format =~ /a/) { # These are already ordered
 682                     $joined = join ",", @$element;
 683                 }
 684                 else {
 685                     $joined = join ",", sort caselessly @$element;
 686                 }
 687                 my $already_found = exists $multiples{$joined};
 688
 689                 my $i;
 690                 if ($already_found) {   # Use any existing one
 691                     $i = $multiples{$joined};
 692                 }
 693                 else {  # Otherwise increment to get a new table number
 694                     $i = keys(%multiples) + 1;
 695                     $multiples{$joined} = $i;
 696                 }
 697
 698                 # This changes the inversion map for this entry to not be the
 699                 # list
 700                 $element = "use_$aux_table_prefix$i";
 701
 702                 # And add to the enum values
 703                 if (! $already_found) {
 704                     push @enum_definition, ",\n\t${name_prefix}$element = -$i";
 705                 }
 706             }
 707         }
 708
 709         $enum_declaration_type = "${name_prefix}enum";
 710
 711         # Finished with the enum definition.  Inversion map stuff is used only
 712         # by regexec or utf-8 (if it is for code points) , unless it is in the
 713         # enum exception list
 714         my $where = (exists $where_to_define_enums{$name})
 715                     ? $where_to_define_enums{$name}
 716                     : ($input_format =~ /a/)
 717                        ? 'PERL_IN_UTF8_C'
 718                        : 'PERL_IN_REGEXEC_C';
 719
 720         if (! exists $public_enums{$name}) {
 721             switch_pound_if($name, $where, $charset);
 722         }
 723         else {
 724             end_charset_pound_if;
 725             end_file_pound_if;
 726             start_charset_pound_if($charset, 1);
 727         }
 728
 729         # If the enum only contains one element, that is a dummy, default one
 730         if (scalar @enum_definition > 1) {
 731
 732             # Currently unneeded
 733             #print $out_fh "\n#define ${name_prefix}ENUM_COUNT ",
 734             #                                   ..scalar keys %enums, "\n";
 735
 736             if ($input_format =~ /l/) {
 737                 print $out_fh
 738                 "\n",
 739                 "/* Negative enum values indicate the need to use an",
 740                     " auxiliary table\n",
 741                 " * consisting of the list of enums this one expands to.",
 742                     "  The absolute\n",
 743                 " * values of the negative enums are indices into a table",
 744                     " of the auxiliary\n",
 745                 " * tables' addresses */";
 746             }
 747             print $out_fh "\ntypedef enum {\n";
 748             print $out_fh join "", @enum_definition;
 749             print $out_fh "\n";
 750             print $out_fh "} $enum_declaration_type;\n";
 751         }
 752
 753         switch_pound_if($name, $where, $charset);
 754
 755         # The inversion lists here have to be UV because inversion lists are
 756         # capable of storing any code point, and even though the the ones here
 757         # are only Unicode ones, which need just 21 bits, they are linked to
 758         # directly, rather than copied.  The inversion map and aux tables also
 759         # only need be 21 bits, and so we can get away with declaring them
 760         # 32-bits to save a little space and memory (on some 64-bit
 761         # platforms), as they are copied.
 762         $invmap_declaration_type = ($input_format =~ /s/)
 763                                  ? $enum_declaration_type
 764                                  : "I32";
 765         $aux_declaration_type = ($input_format =~ /s/)
 766                                  ? $enum_declaration_type
 767                                  : "U32";
 768
 769         $output_format = "${name_prefix}%s";
 770
 771         # If there are auxiliary tables, output them.
 772         if (%multiples) {
 773
 774             print $out_fh "\n#define HAS_${name_prefix}AUX_TABLES\n";
 775
 776             # Invert keys and values
 777             my %inverted_mults;
 778             while (my ($key, $value) = each %multiples) {
 779                 $inverted_mults{$value} = $key;
 780             }
 781
 782             # Output them in sorted order
 783             my @sorted_table_list = sort { $a <=> $b } keys %inverted_mults;
 784
 785             # Keep track of how big each aux table is
 786             my @aux_counts;
 787
 788             # Output each aux table.
 789             foreach my $table_number (@sorted_table_list) {
 790                 my $table = $inverted_mults{$table_number};
 791                 output_table_header($out_fh,
 792                                 $aux_declaration_type,
 793                                 "$name_prefix$aux_table_prefix$table_number");
 794
 795                 # Earlier, we joined the elements of this table together with
 796                 # a comma
 797                 my @elements = split ",", $table;
 798
 799                 $aux_counts[$table_number] = scalar @elements;
 800                 for my $i (0 .. @elements - 1) {
 801                     print $out_fh  ",\n" if $i > 0;
 802                     if ($input_format =~ /a/) {
 803                         printf $out_fh "\t0x%X", $elements[$i];
 804                     }
 805                     else {
 806                         print $out_fh "\t${name_prefix}$elements[$i]";
 807                     }
 808                 }
 809
 810                 print $out_fh "\n";
 811                 output_table_trailer();
 812             }
 813
 814             # Output the table that is indexed by the absolute value of the
 815             # aux table enum and contains pointers to the tables output just
 816             # above
 817             output_table_header($out_fh, "$aux_declaration_type *",
 818                                    "${name_prefix}${aux_table_prefix}ptrs");
 819             print $out_fh "\tNULL,\t/* Placeholder */\n";
 820             for my $i (1 .. @sorted_table_list) {
 821                 print $out_fh  ",\n" if $i > 1;
 822                 print $out_fh  "\t$name_prefix$aux_table_prefix$i";
 823             }
 824             print $out_fh "\n";
 825             output_table_trailer();
 826
 827             print $out_fh
 828               "\n/* Parallel table to the above, giving the number of elements"
 829             . " in each table\n * pointed to */\n";
 830             output_table_header($out_fh, "U8",
 831                                    "${name_prefix}${aux_table_prefix}lengths");
 832             print $out_fh "\t0,\t/* Placeholder */\n";
 833             for my $i (1 .. @sorted_table_list) {
 834                 print $out_fh ",\n" if $i > 1;
 835                 print $out_fh
 836                     "\t$aux_counts[$i]\t/* $name_prefix$aux_table_prefix$i */";
 837             }
 838             print $out_fh "\n";
 839             output_table_trailer();
 840         } # End of outputting the auxiliary and associated tables
 841
 842         # The scx property used in regexec.c needs a specialized table which
 843         # is most convenient to output here, while the data structures set up
 844         # above are still extant.  This table contains the code point that is
 845         # the zero digit of each script, indexed by script enum value.
 846         if (lc $short_name eq 'scx') {
 847             my @decimals_invlist = prop_invlist("Numeric_Type=Decimal");
 848             my %script_zeros;
 849
 850             # Find all the decimal digits.  The 0 of each range is always the
 851             # 0th element, except in some early Unicode releases, so check for
 852             # that.
 853             for (my $i = 0; $i < @decimals_invlist; $i += 2) {
 854                 my $code_point = $decimals_invlist[$i];
 855                 next if num(chr($code_point)) ne '0';
 856
 857                 # Turn the scripts this zero is in into a list.
 858                 my @scripts = split ",",
 859                   charprop($code_point, "_Perl_SCX", '_perl_core_internal_ok');
 860                 $code_point = sprintf("0x%x", $code_point);
 861
 862                 foreach my $script (@scripts) {
 863                     if (! exists $script_zeros{$script}) {
 864                         $script_zeros{$script} = $code_point;
 865                     }
 866                     elsif (ref $script_zeros{$script}) {
 867                         push $script_zeros{$script}->@*, $code_point;
 868                     }
 869                     else {  # Turn into a list if this is the 2nd zero of the
 870                             # script
 871                         my $existing = $script_zeros{$script};
 872                         undef $script_zeros{$script};
 873                         push $script_zeros{$script}->@*, $existing, $code_point;
 874                     }
 875                 }
 876             }
 877
 878             # @script_zeros contains the zero, sorted by the script's enum
 879             # value
 880             my @script_zeros;
 881             foreach my $script (keys %script_zeros) {
 882                 my $enum_value = $enums{$script};
 883                 $script_zeros[$enum_value] = $script_zeros{$script};
 884             }
 885
 886             print $out_fh
 887             "\n/* This table, indexed by the script enum, gives the zero"
 888           . " code point for that\n * script; 0 if the script has multiple"
 889           . " digit sequences.  Scripts without a\n * digit sequence use"
 890           . " ASCII [0-9], hence are marked '0' */\n";
 891             output_table_header($out_fh, "UV", "script_zeros");
 892             for my $i (0 .. @script_zeros - 1) {
 893                 my $code_point = $script_zeros[$i];
 894                 if (defined $code_point) {
 895                     $code_point = " 0" if ref $code_point;
 896                     print $out_fh "\t$code_point";
 897                 }
 898                 elsif (lc $enum_list[$i] eq 'inherited') {
 899                     print $out_fh "\t 0";
 900                 }
 901                 else {  # The only digits a script without its own set accepts
 902                         # is [0-9]
 903                     print $out_fh "\t'0'";
 904                 }
 905                 print $out_fh "," if $i < @script_zeros - 1;
 906                 print $out_fh "\t/* $enum_list[$i] */";
 907                 print $out_fh "\n";
 908             }
 909             output_table_trailer();
 910         } # End of special handling of scx
 911     }
 912     else {
 913         die "'$input_format' invmap() format for '$prop_name' unimplemented";
 914     }
 915
 916     die "No inversion map for $prop_name" unless defined $invmap
 917                                              && ref $invmap eq 'ARRAY'
 918                                              && $count;
 919
 920     # Now output the inversion map proper
 921     $charset = "for $charset" if $charset;
 922     output_table_header($out_fh, $invmap_declaration_type,
 923                                     "${name}_invmap",
 924                                     $charset);
 925
 926     # The main body are the scalars passed in to this routine.
 927     for my $i (0 .. $count - 1) {
 928         my $element = $invmap->[$i];
 929         my $full_element_name = prop_value_aliases($prop_name, $element);
 930         if ($input_format =~ /a/ && $element !~ /\D/) {
 931             $element = ($element == 0)
 932                        ? 0
 933                        : sprintf("0x%X", $element);
 934         }
 935         else {
 936         $element = $full_element_name if defined $full_element_name;
 937         $element = $name_prefix . $element;
 938         }
 939         print $out_fh "\t$element";
 940         print $out_fh "," if $i < $count - 1;
 941         print $out_fh  "\n";
 942     }
 943     output_table_trailer();
 944 }
 945
 946 sub mk_invlist_from_sorted_cp_list {
 947
 948     # Returns an inversion list constructed from the sorted input array of
 949     # code points
 950
 951     my $list_ref = shift;
 952
 953     return unless @$list_ref;
 954
 955     # Initialize to just the first element
 956     my @invlist = ( $list_ref->[0], $list_ref->[0] + 1);
 957
 958     # For each succeeding element, if it extends the previous range, adjust
 959     # up, otherwise add it.
 960     for my $i (1 .. @$list_ref - 1) {
 961         if ($invlist[-1] == $list_ref->[$i]) {
 962             $invlist[-1]++;
 963         }
 964         else {
 965             push @invlist, $list_ref->[$i], $list_ref->[$i] + 1;
 966         }
 967     }
 968     return @invlist;
 969 }
 970
 971 # Read in the Case Folding rules, and construct arrays of code points for the
 972 # properties we need.
 973 my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding");
 974 die "Could not find inversion map for Case_Folding" unless defined $format;
 975 die "Incorrect format '$format' for Case_Folding inversion map"
 976                                                     unless $format eq 'al'
 977                                                            || $format eq 'a';
 978 sub _Perl_IVCF {
 979
 980     # This creates a map of the inversion of case folding. i.e., given a
 981     # character, it gives all the other characters that fold to it.
 982     #
 983     # Inversion maps function kind of like a hash, with the inversion list
 984     # specifying the buckets (keys) and the inversion maps specifying the
 985     # contents of the corresponding bucket.  Effectively this function just
 986     # swaps the keys and values of the case fold hash.  But there are
 987     # complications.  Most importantly, More than one character can each have
 988     # the same fold.  This is solved by having a list of characters that fold
 989     # to a given one.
 990
 991     my %new;
 992
 993     # Go through the inversion list.
 994     for (my $i = 0; $i < @$cp_ref; $i++) {
 995
 996         # Skip if nothing folds to this
 997         next if $folds_ref->[$i] == 0;
 998
 999         # This entry which is valid from here to up (but not including) the
1000         # next entry is for the next $count characters, so that, for example,
1001         # A-Z is represented by one entry.
1002         my $cur_list = $cp_ref->[$i];
1003         my $count = $cp_ref->[$i+1] - $cur_list;
1004
1005         # The fold of [$i] can be not just a single character, but a sequence
1006         # of multiple ones.  We deal with those here by just creating a string
1007         # consisting of them.  Otherwise, we use the single code point [$i]
1008         # folds to.
1009         my $cur_map = (ref $folds_ref->[$i])
1010                        ? join "", map { chr } $folds_ref->[$i]->@*
1011                        : $folds_ref->[$i];
1012
1013         # Expand out this range
1014         while ($count > 0) {
1015             push @{$new{$cur_map}}, $cur_list;
1016
1017             # A multiple-character fold is a string, and shouldn't need
1018             # incrementing anyway
1019             if (ref $folds_ref->[$i]) {
1020                 die sprintf("Case fold for %x is multiple chars; should have"
1021                           . " a count of 1, but instead it was $count", $count)
1022                                                             unless $count == 1;
1023             }
1024             else {
1025                 $cur_map++;
1026                 $cur_list++;
1027             }
1028             $count--;
1029         }
1030     }
1031
1032     # Now go through and make some adjustments.  We add synthetic entries for
1033     # three cases.
1034     # 1) If the fold of a Latin1-range character is above that range, some
1035     #    coding in regexec.c can be saved by creating a reverse map here.  The
1036     #    impetus for this is that U+B5 (MICRO SIGN) folds to the Greek small
1037     #    mu (U+3BC).  That fold isn't done at regex pattern compilation time
1038     #    if it means that the pattern would have to be translated into UTF-8,
1039     #    whose operation is slower.  At run time, having this reverse
1040     #    translation eliminates some special cases in the code.
1041     # 2) Two or more code points can fold to the same multiple character,
1042     #    sequence, as U+FB05 and U+FB06 both fold to 'st'.  This code is only
1043     #    for single character folds, but FB05 and FB06 are single characters
1044     #    that are equivalent folded, so we add entries so that they are
1045     #    considered to fold to each other
1046     # 3) If two or more above-Latin1 code points fold to the same Latin1 range
1047     #    one, we also add entries so that they are considered to fold to each
1048     #    other.  This is so that under /aa or /l matching, where folding to
1049     #    their Latin1 range code point is illegal, they still can fold to each
1050     #    other.  This situation happens in Unicode 3.0.1, but probably no
1051     #    other version.
1052     foreach my $fold (keys %new) {
1053         my $folds_to_string = $fold =~ /\D/;
1054
1055         # If the bucket contains only one element, convert from an array to a
1056         # scalar
1057         if (scalar $new{$fold}->@* == 1) {
1058             $new{$fold} = $new{$fold}[0];
1059
1060             # Handle case 1) above: if there were a Latin1 range code point
1061             # whose fold is above that range, this creates an extra entry that
1062             # maps the other direction, and would save some special case code.
1063             # (The one current case of this is handled in the else clause
1064             # below.)
1065             $new{$new{$fold}} = $fold if $new{$fold} < 256 && $fold > 255;
1066         }
1067         else {
1068
1069             # Handle case 1) when there are multiple things that fold to an
1070             # above-Latin1 code point, at least one of which is in Latin1.
1071             if (! $folds_to_string && $fold > 255) {
1072                 foreach my $cp ($new{$fold}->@*) {
1073                     if ($cp < 256) {
1074                         my @new_entry = grep { $_ != $cp } $new{$fold}->@*;
1075                         push @new_entry, $fold;
1076                         $new{$cp}->@* = @new_entry;
1077                     }
1078                 }
1079             }
1080
1081             # Otherwise, sort numerically.  This places the highest code point
1082             # in the list at the tail end.  This is because Unicode keeps the
1083             # lowercase code points as higher ordinals than the uppercase, at
1084             # least for the ones that matter so far.  These are synthetic
1085             # entries, and we want to predictably have the lowercase (which is
1086             # more likely to be what gets folded to) in the same corresponding
1087             # position, so that other code can rely on that.  If some new
1088             # version of Unicode came along that violated this, we might have
1089             # to change so that the sort is based on upper vs lower instead.
1090             # (The lower-comes-after isn't true of native EBCDIC, but here we
1091             # are dealing strictly with Unicode values).
1092             @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@*
1093                                                         unless $folds_to_string;
1094             # We will be working with a copy of this sorted entry.
1095             my @source_list = $new{$fold}->@*;
1096             if (! $folds_to_string) {
1097
1098                 # This handles situation 2) listed above, which only arises if
1099                 # what is being folded-to (the fold) is in the Latin1 range.
1100                 if ($fold > 255 ) {
1101                     undef @source_list;
1102                 }
1103                 else {
1104                     # And it only arises if there are two or more folders that
1105                     # fold to it above Latin1.  We look at just those.
1106                     @source_list = grep { $_ > 255 } @source_list;
1107                     undef @source_list if @source_list == 1;
1108                 }
1109             }
1110
1111             # Here, we've found the items we want to set up synthetic folds
1112             # for.  Add entries so that each folds to each other.
1113             foreach my $cp (@source_list) {
1114                 my @rest = grep { $cp != $_ } @source_list;
1115                 if (@rest == 1) {
1116                     $new{$cp} = $rest[0];
1117                 }
1118                 else {
1119                     push @{$new{$cp}}, @rest;
1120                 }
1121             }
1122         }
1123
1124         # We don't otherwise deal with multiple-character folds
1125         delete $new{$fold} if $folds_to_string;
1126     }
1127
1128
1129     # Now we have a hash that is the inversion of the case fold property.
1130     # First find the maximum number of code points that fold to the same one.
1131     foreach my $fold_to (keys %new) {
1132         if (ref $new{$fold_to}) {
1133             my $folders_count = scalar @{$new{$fold_to}};
1134             $max_fold_froms = $folders_count if $folders_count > $max_fold_froms;
1135         }
1136     }
1137
1138     # Then convert the hash to an inversion map.
1139     my @sorted_folds = sort { $a <=> $b } keys %new;
1140     my (@invlist, @invmap);
1141
1142     # We know that nothing folds to the controls (whose ordinals start at 0).
1143     # And the first real entries are the lowest in the hash.
1144     push @invlist, 0, $sorted_folds[0];
1145     push @invmap, 0, $new{$sorted_folds[0]};
1146
1147     # Go through the remainder of the hash keys (which are the folded code
1148     # points)
1149     for (my $i = 1; $i < @sorted_folds; $i++) {
1150
1151         # Get the current one, and the one prior to it.
1152         my $fold = $sorted_folds[$i];
1153         my $prev_fold = $sorted_folds[$i-1];
1154
1155         # If the current one is not just 1 away from the prior one, we close
1156         # out the range containing the previous fold, and know that the gap
1157         # doesn't have anything that folds.
1158         if ($fold - 1 != $prev_fold) {
1159             push @invlist, $prev_fold + 1;
1160             push @invmap, 0;
1161
1162             # And start a new range
1163             push @invlist, $fold;
1164             push @invmap, $new{$fold};
1165         }
1166         elsif ($new{$fold} - 1 != $new{$prev_fold}) {
1167
1168             # Here the current fold is just 1 greater than the previous, but
1169             # the new map isn't correspondingly 1 greater than the previous,
1170             # the old range is ended, but since there is no gap, we don't have
1171             # to insert anything else.
1172             push @invlist, $fold;
1173             push @invmap, $new{$fold};
1174
1175         } # else { Otherwise, this new entry just extends the previous }
1176
1177         die "In IVCF: $invlist[-1] <= $invlist[-2]"
1178                                                if $invlist[-1] <= $invlist[-2];
1179     }
1180
1181     # And add an entry that indicates that everything above this, to infinity,
1182     # does not have a case fold.
1183     push @invlist, $sorted_folds[-1] + 1;
1184     push @invmap, 0;
1185
1186     push @invlist, 0x110000;
1187     push @invmap, 0;
1188
1189     # All Unicode versions have some places where multiple code points map to
1190     # the same one, so the format always has an 'l'
1191     return \@invlist, \@invmap, 'al', $default;
1192 }
1193
1194 sub prop_name_for_cmp ($) { # Sort helper
1195     my $name = shift;
1196
1197     # Returns the input lowercased, with non-alphas removed, as well as
1198     # everything starting with a comma
1199
1200     $name =~ s/,.*//;
1201     $name =~ s/[[:^alpha:]]//g;
1202     return lc $name;
1203 }
1204
1205 sub UpperLatin1 {
1206     my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
1207     return \@return;
1208 }
1209
1210 sub _Perl_CCC_non0_non230 {
1211
1212     # Create an inversion list of code points with non-zero canonical
1213     # combining class that also don't have 230 as the class number.  This is
1214     # part of a Unicode Standard rule
1215
1216     my @nonzeros = prop_invlist("ccc=0");
1217     shift @nonzeros;    # Invert so is "ccc != 0"
1218
1219     my @return;
1220
1221     # Expand into list of code points, while excluding those with ccc == 230
1222     for (my $i = 0; $i < @nonzeros; $i += 2) {
1223         my $upper = ($i + 1) < @nonzeros
1224                     ? $nonzeros[$i+1] - 1      # In range
1225                     : $Unicode::UCD::MAX_CP;  # To infinity.
1226         for my $j ($nonzeros[$i] .. $upper) {
1227             my @ccc_names = prop_value_aliases("ccc", charprop($j, "ccc"));
1228
1229             # Final element in @ccc_names will be all numeric
1230             push @return, $j if $ccc_names[-1] != 230;
1231         }
1232     }
1233
1234     @return = sort { $a <=> $b } @return;
1235     @return = mk_invlist_from_sorted_cp_list(\@return);
1236     return \@return;
1237 }
1238
1239 sub output_table_common {
1240
1241     # Common subroutine to actually output the generated rules table.
1242
1243     my ($property,
1244         $table_value_defines_ref,
1245         $table_ref,
1246         $names_ref,
1247         $abbreviations_ref) = @_;
1248     my $size = @$table_ref;
1249
1250     # Output the #define list, sorted by numeric value
1251     if ($table_value_defines_ref) {
1252         my $max_name_length = 0;
1253         my @defines;
1254
1255         # Put in order, and at the same time find the longest name
1256         while (my ($enum, $value) = each %$table_value_defines_ref) {
1257             $defines[$value] = $enum;
1258
1259             my $length = length $enum;
1260             $max_name_length = $length if $length > $max_name_length;
1261         }
1262
1263         print $out_fh "\n";
1264
1265         # Output, so that the values are vertically aligned in a column after
1266         # the longest name
1267         foreach my $i (0 .. @defines - 1) {
1268             next unless defined $defines[$i];
1269             printf $out_fh "#define %-*s  %2d\n",
1270                                       $max_name_length,
1271                                        $defines[$i],
1272                                           $i;
1273         }
1274     }
1275
1276     my $column_width = 2;   # We currently allow 2 digits for the number
1277
1278     # Being above a U8 is not currently handled
1279     my $table_type = 'U8';
1280
1281     # If a name is longer than the width set aside for a column, its column
1282     # needs to have increased spacing so that the name doesn't get truncated
1283     # nor run into an adjacent column
1284     my @spacers;
1285
1286     # Is there a row and column for unused values in this release?
1287     my $has_unused = $names_ref->[$size-1] eq $unused_table_hdr;
1288
1289     for my $i (0 .. $size - 1) {
1290         no warnings 'numeric';
1291         $spacers[$i] = " " x (length($names_ref->[$i]) - $column_width);
1292     }
1293
1294     output_table_header($out_fh, $table_type, "${property}_table", undef,
1295                         $size, $size);
1296
1297     # Calculate the column heading line
1298     my $header_line = "/* "
1299                     . (" " x $max_hdr_len)  # We let the row heading meld to
1300                                             # the '*/' for those that are at
1301                                             # the max
1302                     . " " x 3;    # Space for '*/ '
1303     # Now each column
1304     for my $i (0 .. $size - 1) {
1305         $header_line .= sprintf "%s%*s",
1306                                 $spacers[$i],
1307                                     $column_width + 1, # 1 for the ','
1308                                      $names_ref->[$i];
1309     }
1310     $header_line .= " */\n";
1311
1312     # If we have annotations, output it now.
1313     if ($has_unused || scalar %$abbreviations_ref) {
1314         my $text = "";
1315         foreach my $abbr (sort caselessly keys %$abbreviations_ref) {
1316             $text .= "; " if $text;
1317             $text .= "'$abbr' stands for '$abbreviations_ref->{$abbr}'";
1318         }
1319         if ($has_unused) {
1320             $text .= "; $unused_table_hdr stands for 'unused in this Unicode"
1321                    . " release (and the data in its row and column are garbage)"
1322         }
1323
1324         my $indent = " " x 3;
1325         $text = $indent . "/* $text */";
1326
1327         # Wrap the text so that it is no wider than the table, which the
1328         # header line gives.
1329         my $output_width = length $header_line;
1330         while (length $text > $output_width) {
1331             my $cur_line = substr($text, 0, $output_width);
1332
1333             # Find the first blank back from the right end to wrap at.
1334             for (my $i = $output_width -1; $i > 0; $i--) {
1335                 if (substr($text, $i, 1) eq " ") {
1336                     print $out_fh substr($text, 0, $i), "\n";
1337
1338                     # Set so will look at just the remaining tail (which will
1339                     # be indented and have a '*' after the indent
1340                     $text = $indent . " * " . substr($text, $i + 1);
1341                     last;
1342                 }
1343             }
1344         }
1345
1346         # And any remaining
1347         print $out_fh $text, "\n" if $text;
1348     }
1349
1350     # We calculated the header line earlier just to get its width so that we
1351     # could make sure the annotations fit into that.
1352     print $out_fh $header_line;
1353
1354     # Now output the bulk of the table.
1355     for my $i (0 .. $size - 1) {
1356
1357         # First the row heading.
1358         printf $out_fh "/* %-*s*/ ", $max_hdr_len, $names_ref->[$i];
1359         print $out_fh "{";  # Then the brace for this row
1360
1361         # Then each column
1362         for my $j (0 .. $size -1) {
1363             print $out_fh $spacers[$j];
1364             printf $out_fh "%*d", $column_width, $table_ref->[$i][$j];
1365             print $out_fh "," if $j < $size - 1;
1366         }
1367         print $out_fh " }";
1368         print $out_fh "," if $i < $size - 1;
1369         print $out_fh "\n";
1370     }
1371
1372     output_table_trailer();
1373 }
1374
1375 sub output_GCB_table() {
1376
1377     # Create and output the pair table for use in determining Grapheme Cluster
1378     # Breaks, given in http://www.unicode.org/reports/tr29/.
1379     my %gcb_actions = (
1380         GCB_NOBREAK                      => 0,
1381         GCB_BREAKABLE                    => 1,
1382         GCB_RI_then_RI                   => 2,   # Rules 12 and 13
1383         GCB_EX_then_EM                   => 3,   # Rule 10
1384         GCB_Maybe_Emoji_NonBreak         => 4,
1385     );
1386
1387     # The table is constructed in reverse order of the rules, to make the
1388     # lower-numbered, higher priority ones override the later ones, as the
1389     # algorithm stops at the earliest matching rule
1390
1391     my @gcb_table;
1392     my $table_size = @gcb_short_enums;
1393
1394     # Otherwise, break everywhere.
1395     # GB99   Any ÷  Any
1396     for my $i (0 .. $table_size - 1) {
1397         for my $j (0 .. $table_size - 1) {
1398             $gcb_table[$i][$j] = 1;
1399         }
1400     }
1401
1402     # Do not break within emoji flag sequences. That is, do not break between
1403     # regional indicator (RI) symbols if there is an odd number of RI
1404     # characters before the break point.  Must be resolved in runtime code.
1405     #
1406     # GB12 sot (RI RI)* RI × RI
1407     # GB13 [^RI] (RI RI)* RI × RI
1408     $gcb_table[$gcb_enums{'Regional_Indicator'}]
1409               [$gcb_enums{'Regional_Indicator'}] = $gcb_actions{GCB_RI_then_RI};
1410
1411     # Post 11.0: GB11  \p{Extended_Pictographic} Extend* ZWJ
1412     #                                               × \p{Extended_Pictographic}
1413     $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'ExtPict_XX'}] =
1414                                          $gcb_actions{GCB_Maybe_Emoji_NonBreak};
1415
1416     # This and the rule GB10 obsolete starting with Unicode 11.0, can be left
1417     # in as there are no code points that match, so the code won't ever get
1418     # executed.
1419     # Do not break within emoji modifier sequences or emoji zwj sequences.
1420     # Pre 11.0: GB11  ZWJ  × ( Glue_After_Zwj | E_Base_GAZ )
1421     $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'Glue_After_Zwj'}] = 0;
1422     $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'E_Base_GAZ'}] = 0;
1423
1424     # GB10  ( E_Base | E_Base_GAZ ) Extend* ×  E_Modifier
1425     $gcb_table[$gcb_enums{'Extend'}][$gcb_enums{'E_Modifier'}]
1426                                                 = $gcb_actions{GCB_EX_then_EM};
1427     $gcb_table[$gcb_enums{'E_Base'}][$gcb_enums{'E_Modifier'}] = 0;
1428     $gcb_table[$gcb_enums{'E_Base_GAZ'}][$gcb_enums{'E_Modifier'}] = 0;
1429
1430     # Do not break before extending characters or ZWJ.
1431     # Do not break before SpacingMarks, or after Prepend characters.
1432     # GB9b  Prepend  ×
1433     # GB9a  × SpacingMark
1434     # GB9   ×  ( Extend | ZWJ )
1435     for my $i (0 .. @gcb_table - 1) {
1436         $gcb_table[$gcb_enums{'Prepend'}][$i] = 0;
1437         $gcb_table[$i][$gcb_enums{'SpacingMark'}] = 0;
1438         $gcb_table[$i][$gcb_enums{'Extend'}] = 0;
1439         $gcb_table[$i][$gcb_enums{'ZWJ'}] = 0;
1440     }
1441
1442     # Do not break Hangul syllable sequences.
1443     # GB8  ( LVT | T)  ×  T
1444     $gcb_table[$gcb_enums{'LVT'}][$gcb_enums{'T'}] = 0;
1445     $gcb_table[$gcb_enums{'T'}][$gcb_enums{'T'}] = 0;
1446
1447     # GB7  ( LV | V )  ×  ( V | T )
1448     $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'V'}] = 0;
1449     $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'T'}] = 0;
1450     $gcb_table[$gcb_enums{'V'}][$gcb_enums{'V'}] = 0;
1451     $gcb_table[$gcb_enums{'V'}][$gcb_enums{'T'}] = 0;
1452
1453     # GB6  L  ×  ( L | V | LV | LVT )
1454     $gcb_table[$gcb_enums{'L'}][$gcb_enums{'L'}] = 0;
1455     $gcb_table[$gcb_enums{'L'}][$gcb_enums{'V'}] = 0;
1456     $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LV'}] = 0;
1457     $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LVT'}] = 0;
1458
1459     # Do not break between a CR and LF. Otherwise, break before and after
1460     # controls.
1461     # GB5   ÷  ( Control | CR | LF )
1462     # GB4  ( Control | CR | LF )  ÷
1463     for my $i (0 .. @gcb_table - 1) {
1464         $gcb_table[$i][$gcb_enums{'Control'}] = 1;
1465         $gcb_table[$i][$gcb_enums{'CR'}] = 1;
1466         $gcb_table[$i][$gcb_enums{'LF'}] = 1;
1467         $gcb_table[$gcb_enums{'Control'}][$i] = 1;
1468         $gcb_table[$gcb_enums{'CR'}][$i] = 1;
1469         $gcb_table[$gcb_enums{'LF'}][$i] = 1;
1470     }
1471
1472     # GB3  CR  ×  LF
1473     $gcb_table[$gcb_enums{'CR'}][$gcb_enums{'LF'}] = 0;
1474
1475     # Break at the start and end of text, unless the text is empty
1476     # GB1  sot  ÷
1477     # GB2   ÷  eot
1478     for my $i (0 .. @gcb_table - 1) {
1479         $gcb_table[$i][$gcb_enums{'EDGE'}] = 1;
1480         $gcb_table[$gcb_enums{'EDGE'}][$i] = 1;
1481     }
1482     $gcb_table[$gcb_enums{'EDGE'}][$gcb_enums{'EDGE'}] = 0;
1483
1484     output_table_common('GCB', \%gcb_actions,
1485                         \@gcb_table, \@gcb_short_enums, \%gcb_abbreviations);
1486 }
1487
1488 sub output_LB_table() {
1489
1490     # Create and output the enums, #defines, and pair table for use in
1491     # determining Line Breaks.  This uses the default line break algorithm,
1492     # given in http://www.unicode.org/reports/tr14/, but tailored by example 7
1493     # in that page, as the Unicode-furnished tests assume that tailoring.
1494
1495     # The result is really just true or false.  But we follow along with tr14,
1496     # creating a rule which is false for something like X SP* X.  That gets
1497     # encoding 2.  The rest of the actions are synthetic ones that indicate
1498     # some context handling is required.  These each are added to the
1499     # underlying 0, 1, or 2, instead of replacing them, so that the underlying
1500     # value can be retrieved.  Actually only rules from 7 through 18 (which
1501     # are the ones where space matter) are possible to have 2 added to them.
1502     # The others below add just 0 or 1.  It might be possible for one
1503     # synthetic rule to be added to another, yielding a larger value.  This
1504     # doesn't happen in the Unicode 8.0 rule set, and as you can see from the
1505     # names of the middle grouping below, it is impossible for that to occur
1506     # for them because they all start with mutually exclusive classes.  That
1507     # the final rule can't be added to any of the others isn't obvious from
1508     # its name, so it is assigned a power of 2 higher than the others can get
1509     # to so any addition would preserve all data.  (And the code will reach an
1510     # assert(0) on debugging builds should this happen.)
1511     my %lb_actions = (
1512         LB_NOBREAK                      => 0,
1513         LB_BREAKABLE                    => 1,
1514         LB_NOBREAK_EVEN_WITH_SP_BETWEEN => 2,
1515
1516         LB_CM_ZWJ_foo                   => 3,   # Rule 9
1517         LB_SP_foo                       => 6,   # Rule 18
1518         LB_PR_or_PO_then_OP_or_HY       => 9,   # Rule 25
1519         LB_SY_or_IS_then_various        => 11,  # Rule 25
1520         LB_HY_or_BA_then_foo            => 13,  # Rule 21
1521         LB_RI_then_RI                   => 15,  # Rule 30a
1522
1523         LB_various_then_PO_or_PR        => (1<<5),  # Rule 25
1524     );
1525
1526     # Construct the LB pair table.  This is based on the rules in
1527     # http://www.unicode.org/reports/tr14/, but modified as those rules are
1528     # designed for someone taking a string of text and sequentially going
1529     # through it to find the break opportunities, whereas, Perl requires
1530     # determining if a given random spot is a break opportunity, without
1531     # knowing all the entire string before it.
1532     #
1533     # The table is constructed in reverse order of the rules, to make the
1534     # lower-numbered, higher priority ones override the later ones, as the
1535     # algorithm stops at the earliest matching rule
1536
1537     my @lb_table;
1538     my $table_size = @lb_short_enums;
1539
1540     # LB31. Break everywhere else
1541     for my $i (0 .. $table_size - 1) {
1542         for my $j (0 .. $table_size - 1) {
1543             $lb_table[$i][$j] = $lb_actions{'LB_BREAKABLE'};
1544         }
1545     }
1546
1547     # LB30b Do not break between an emoji base (or potential emoji) and an
1548     # emoji modifier.
1549
1550     # EB × EM
1551     # [\p{Extended_Pictographic}&\p{Cn}] × EM
1552     $lb_table[$lb_enums{'E_Base'}][$lb_enums{'E_Modifier'}]
1553                                                 = $lb_actions{'LB_NOBREAK'};
1554     $lb_table[$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}]
1555                       [$lb_enums{'E_Modifier'}] = $lb_actions{'LB_NOBREAK'};
1556
1557     # LB30a Break between two regional indicator symbols if and only if there
1558     # are an even number of regional indicators preceding the position of the
1559     # break.
1560     # sot (RI RI)* RI × RI
1561     # [^RI] (RI RI)* RI × RI
1562     $lb_table[$lb_enums{'Regional_Indicator'}]
1563              [$lb_enums{'Regional_Indicator'}] = $lb_actions{'LB_RI_then_RI'};
1564
1565     # LB30 Do not break between letters, numbers, or ordinary symbols and
1566     # non-East-Asian opening punctuation nor non-East-Asian closing
1567     # parentheses.
1568
1569     # (AL | HL | NU) × [OP-[\p{ea=F}\p{ea=W}\p{ea=H}]]
1570     # (what we call CP and OP here have already been modified by mktables to
1571     # exclude the ea items
1572     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Open_Punctuation'}]
1573                                                 = $lb_actions{'LB_NOBREAK'};
1574     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Open_Punctuation'}]
1575                                                 = $lb_actions{'LB_NOBREAK'};
1576     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Open_Punctuation'}]
1577                                                 = $lb_actions{'LB_NOBREAK'};
1578
1579     # [CP-[\p{ea=F}\p{ea=W}\p{ea=H}]] × (AL | HL | NU)
1580     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Alphabetic'}]
1581                                                 = $lb_actions{'LB_NOBREAK'};
1582     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Hebrew_Letter'}]
1583                                                 = $lb_actions{'LB_NOBREAK'};
1584     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Numeric'}]
1585                                                 = $lb_actions{'LB_NOBREAK'};
1586
1587     # LB29 Do not break between numeric punctuation and alphabetics (“e.g.”).
1588     # IS × (AL | HL)
1589     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Alphabetic'}]
1590                                                 = $lb_actions{'LB_NOBREAK'};
1591     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1592                                                 = $lb_actions{'LB_NOBREAK'};
1593
1594     # LB28 Do not break between alphabetics (“at”).
1595     # (AL | HL) × (AL | HL)
1596     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Alphabetic'}]
1597                                                 = $lb_actions{'LB_NOBREAK'};
1598     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Alphabetic'}]
1599                                                 = $lb_actions{'LB_NOBREAK'};
1600     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Hebrew_Letter'}]
1601                                                 = $lb_actions{'LB_NOBREAK'};
1602     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Hebrew_Letter'}]
1603                                                 = $lb_actions{'LB_NOBREAK'};
1604
1605     # LB27 Treat a Korean Syllable Block the same as ID.
1606     # (JL | JV | JT | H2 | H3) × PO
1607     $lb_table[$lb_enums{'JL'}][$lb_enums{'Postfix_Numeric'}]
1608                                                 = $lb_actions{'LB_NOBREAK'};
1609     $lb_table[$lb_enums{'JV'}][$lb_enums{'Postfix_Numeric'}]
1610                                                 = $lb_actions{'LB_NOBREAK'};
1611     $lb_table[$lb_enums{'JT'}][$lb_enums{'Postfix_Numeric'}]
1612                                                 = $lb_actions{'LB_NOBREAK'};
1613     $lb_table[$lb_enums{'H2'}][$lb_enums{'Postfix_Numeric'}]
1614                                                 = $lb_actions{'LB_NOBREAK'};
1615     $lb_table[$lb_enums{'H3'}][$lb_enums{'Postfix_Numeric'}]
1616                                                 = $lb_actions{'LB_NOBREAK'};
1617
1618     # PR × (JL | JV | JT | H2 | H3)
1619     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JL'}]
1620                                                 = $lb_actions{'LB_NOBREAK'};
1621     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JV'}]
1622                                                 = $lb_actions{'LB_NOBREAK'};
1623     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JT'}]
1624                                                 = $lb_actions{'LB_NOBREAK'};
1625     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H2'}]
1626                                                 = $lb_actions{'LB_NOBREAK'};
1627     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H3'}]
1628                                                 = $lb_actions{'LB_NOBREAK'};
1629
1630     # LB26 Do not break a Korean syllable.
1631     # JL × (JL | JV | H2 | H3)
1632     $lb_table[$lb_enums{'JL'}][$lb_enums{'JL'}] = $lb_actions{'LB_NOBREAK'};
1633     $lb_table[$lb_enums{'JL'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1634     $lb_table[$lb_enums{'JL'}][$lb_enums{'H2'}] = $lb_actions{'LB_NOBREAK'};
1635     $lb_table[$lb_enums{'JL'}][$lb_enums{'H3'}] = $lb_actions{'LB_NOBREAK'};
1636
1637     # (JV | H2) × (JV | JT)
1638     $lb_table[$lb_enums{'JV'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1639     $lb_table[$lb_enums{'H2'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1640     $lb_table[$lb_enums{'JV'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1641     $lb_table[$lb_enums{'H2'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1642
1643     # (JT | H3) × JT
1644     $lb_table[$lb_enums{'JT'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1645     $lb_table[$lb_enums{'H3'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1646
1647     # LB25 Do not break between the following pairs of classes relevant to
1648     # numbers, as tailored by example 7 in
1649     # http://www.unicode.org/reports/tr14/#Examples
1650     # We follow that tailoring because Unicode's test cases expect it
1651     # (PR | PO) × ( OP | HY )? NU
1652     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Numeric'}]
1653                                                 = $lb_actions{'LB_NOBREAK'};
1654     $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Numeric'}]
1655                                                 = $lb_actions{'LB_NOBREAK'};
1656
1657         # Given that (OP | HY )? is optional, we have to test for it in code.
1658         # We add in the action (instead of overriding) for this, so that in
1659         # the code we can recover the underlying break value.
1660     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Open_Punctuation'}]
1661                                     += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1662     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'East_Asian_OP'}]
1663                                     += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1664     $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Open_Punctuation'}]
1665                                     += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1666     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hyphen'}]
1667                                     += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1668     $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hyphen'}]
1669                                     += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1670
1671     # ( OP | HY ) × NU
1672     $lb_table[$lb_enums{'Open_Punctuation'}][$lb_enums{'Numeric'}]
1673                                                 = $lb_actions{'LB_NOBREAK'};
1674     $lb_table[$lb_enums{'East_Asian_OP'}][$lb_enums{'Numeric'}]
1675                                                 = $lb_actions{'LB_NOBREAK'};
1676     $lb_table[$lb_enums{'Hyphen'}][$lb_enums{'Numeric'}]
1677                                                 = $lb_actions{'LB_NOBREAK'};
1678
1679     # NU (NU | SY | IS)* × (NU | SY | IS | CL | CP )
1680     # which can be rewritten as:
1681     # NU (SY | IS)* × (NU | SY | IS | CL | CP )
1682     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Numeric'}]
1683                                                 = $lb_actions{'LB_NOBREAK'};
1684     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Break_Symbols'}]
1685                                                 = $lb_actions{'LB_NOBREAK'};
1686     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Infix_Numeric'}]
1687                                                 = $lb_actions{'LB_NOBREAK'};
1688     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Punctuation'}]
1689                                                 = $lb_actions{'LB_NOBREAK'};
1690     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Parenthesis'}]
1691                                                 = $lb_actions{'LB_NOBREAK'};
1692     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'East_Asian_CP'}]
1693                                                 = $lb_actions{'LB_NOBREAK'};
1694
1695         # Like earlier where we have to test in code, we add in the action so
1696         # that we can recover the underlying values.  This is done in rules
1697         # below, as well.  The code assumes that we haven't added 2 actions.
1698         # Shoul a later Unicode release break that assumption, then tests
1699         # should start failing.
1700     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Numeric'}]
1701                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1702     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Break_Symbols'}]
1703                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1704     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Infix_Numeric'}]
1705                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1706     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Punctuation'}]
1707                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1708     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Parenthesis'}]
1709                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1710     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'East_Asian_CP'}]
1711                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1712     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Numeric'}]
1713                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1714     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Break_Symbols'}]
1715                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1716     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Infix_Numeric'}]
1717                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1718     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Punctuation'}]
1719                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1720     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Parenthesis'}]
1721                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1722     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'East_Asian_CP'}]
1723                                     += $lb_actions{'LB_SY_or_IS_then_various'};
1724
1725     # NU (NU | SY | IS)* (CL | CP)? × (PO | PR)
1726     # which can be rewritten as:
1727     # NU (SY | IS)* (CL | CP)? × (PO | PR)
1728     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Postfix_Numeric'}]
1729                                                 = $lb_actions{'LB_NOBREAK'};
1730     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Prefix_Numeric'}]
1731                                                 = $lb_actions{'LB_NOBREAK'};
1732
1733     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Postfix_Numeric'}]
1734                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1735     $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Postfix_Numeric'}]
1736                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1737     $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Postfix_Numeric'}]
1738                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1739     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Postfix_Numeric'}]
1740                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1741     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Postfix_Numeric'}]
1742                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1743
1744     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Prefix_Numeric'}]
1745                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1746     $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Prefix_Numeric'}]
1747                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1748     $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Prefix_Numeric'}]
1749                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1750     $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Prefix_Numeric'}]
1751                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1752     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Prefix_Numeric'}]
1753                                     += $lb_actions{'LB_various_then_PO_or_PR'};
1754
1755     # LB24 Do not break between numeric prefix/postfix and letters, or between
1756     # letters and prefix/postfix.
1757     # (PR | PO) × (AL | HL)
1758     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Alphabetic'}]
1759                                                 = $lb_actions{'LB_NOBREAK'};
1760     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1761                                                 = $lb_actions{'LB_NOBREAK'};
1762     $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Alphabetic'}]
1763                                                 = $lb_actions{'LB_NOBREAK'};
1764     $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1765                                                 = $lb_actions{'LB_NOBREAK'};
1766
1767     # (AL | HL) × (PR | PO)
1768     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Prefix_Numeric'}]
1769                                                 = $lb_actions{'LB_NOBREAK'};
1770     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Prefix_Numeric'}]
1771                                                 = $lb_actions{'LB_NOBREAK'};
1772     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Postfix_Numeric'}]
1773                                                 = $lb_actions{'LB_NOBREAK'};
1774     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Postfix_Numeric'}]
1775                                                 = $lb_actions{'LB_NOBREAK'};
1776
1777     # LB23a Do not break between numeric prefixes and ideographs, or between
1778     # ideographs and numeric postfixes.
1779     # PR × (ID | EB | EM)
1780     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Ideographic'}]
1781                                                 = $lb_actions{'LB_NOBREAK'};
1782     $lb_table[$lb_enums{'Prefix_Numeric'}]
1783         [$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}]
1784                                                 = $lb_actions{'LB_NOBREAK'};
1785     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Base'}]
1786                                                 = $lb_actions{'LB_NOBREAK'};
1787     $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Modifier'}]
1788                                                 = $lb_actions{'LB_NOBREAK'};
1789
1790     # (ID | EB | EM) × PO
1791     $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Postfix_Numeric'}]
1792                                                 = $lb_actions{'LB_NOBREAK'};
1793     $lb_table[$lb_enums{'Unassigned_Extended_Pictographic_Ideographic'}]
1794                  [$lb_enums{'Postfix_Numeric'}] = $lb_actions{'LB_NOBREAK'};
1795     $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Postfix_Numeric'}]
1796                                                 = $lb_actions{'LB_NOBREAK'};
1797     $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Postfix_Numeric'}]
1798                                                 = $lb_actions{'LB_NOBREAK'};
1799
1800     # LB23 Do not break between digits and letters
1801     # (AL | HL) × NU
1802     $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Numeric'}]
1803                                                 = $lb_actions{'LB_NOBREAK'};
1804     $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Numeric'}]
1805                                                 = $lb_actions{'LB_NOBREAK'};
1806
1807     # NU × (AL | HL)
1808     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Alphabetic'}]
1809                                                 = $lb_actions{'LB_NOBREAK'};
1810     $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Hebrew_Letter'}]
1811                                                 = $lb_actions{'LB_NOBREAK'};
1812
1813     # LB22 Do not break before ellipses
1814     for my $i (0 .. @lb_table - 1) {
1815         $lb_table[$i][$lb_enums{'Inseparable'}] = $lb_actions{'LB_NOBREAK'};
1816     }
1817
1818     # LB21b Don’t break between Solidus and Hebrew letters.
1819     # SY × HL
1820     $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Hebrew_Letter'}]
1821                                                 = $lb_actions{'LB_NOBREAK'};
1822
1823     # LB21a Don't break after Hebrew + Hyphen.
1824     # HL (HY | BA) ×
1825     for my $i (0 .. @lb_table - 1) {
1826         $lb_table[$lb_enums{'Hyphen'}][$i]
1827                                         += $lb_actions{'LB_HY_or_BA_then_foo'};
1828         $lb_table[$lb_enums{'Break_After'}][$i]
1829                                         += $lb_actions{'LB_HY_or_BA_then_foo'};
1830     }
1831
1832     # LB21 Do not break before hyphen-minus, other hyphens, fixed-width
1833     # spaces, small kana, and other non-starters, or after acute accents.
1834     # × BA
1835     # × HY
1836     # × NS
1837     # BB ×
1838     for my $i (0 .. @lb_table - 1) {
1839         $lb_table[$i][$lb_enums{'Break_After'}] = $lb_actions{'LB_NOBREAK'};
1840         $lb_table[$i][$lb_enums{'Hyphen'}] = $lb_actions{'LB_NOBREAK'};
1841         $lb_table[$i][$lb_enums{'Nonstarter'}] = $lb_actions{'LB_NOBREAK'};
1842         $lb_table[$lb_enums{'Break_Before'}][$i] = $lb_actions{'LB_NOBREAK'};
1843     }
1844
1845     # LB20 Break before and after unresolved CB.
1846     # ÷ CB
1847     # CB ÷
1848     # Conditional breaks should be resolved external to the line breaking
1849     # rules. However, the default action is to treat unresolved CB as breaking
1850     # before and after.
1851     for my $i (0 .. @lb_table - 1) {
1852         $lb_table[$i][$lb_enums{'Contingent_Break'}]
1853                                                 = $lb_actions{'LB_BREAKABLE'};
1854         $lb_table[$lb_enums{'Contingent_Break'}][$i]
1855                                                 = $lb_actions{'LB_BREAKABLE'};
1856     }
1857
1858     # LB19 Do not break before or after quotation marks, such as ‘ ” ’.
1859     # × QU
1860     # QU ×
1861     for my $i (0 .. @lb_table - 1) {
1862         $lb_table[$i][$lb_enums{'Quotation'}] = $lb_actions{'LB_NOBREAK'};
1863         $lb_table[$lb_enums{'Quotation'}][$i] = $lb_actions{'LB_NOBREAK'};
1864     }
1865
1866     # LB18 Break after spaces
1867     # SP ÷
1868     for my $i (0 .. @lb_table - 1) {
1869         $lb_table[$lb_enums{'Space'}][$i] = $lb_actions{'LB_BREAKABLE'};
1870     }
1871
1872     # LB17 Do not break within ‘——’, even with intervening spaces.
1873     # B2 SP* × B2
1874     $lb_table[$lb_enums{'Break_Both'}][$lb_enums{'Break_Both'}]
1875                            = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1876
1877     # LB16 Do not break between closing punctuation and a nonstarter even with
1878     # intervening spaces.
1879     # (CL | CP) SP* × NS
1880     $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Nonstarter'}]
1881                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1882     $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Nonstarter'}]
1883                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1884     $lb_table[$lb_enums{'East_Asian_CP'}][$lb_enums{'Nonstarter'}]
1885                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1886
1887
1888     # LB15 Do not break within ‘”[’, even with intervening spaces.
1889     # QU SP* × OP
1890     $lb_table[$lb_enums{'Quotation'}][$lb_enums{'Open_Punctuation'}]
1891                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1892     $lb_table[$lb_enums{'Quotation'}][$lb_enums{'East_Asian_OP'}]
1893                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1894
1895     # LB14 Do not break after ‘[’, even after spaces.
1896     # OP SP* ×
1897     for my $i (0 .. @lb_table - 1) {
1898         $lb_table[$lb_enums{'Open_Punctuation'}][$i]
1899                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1900         $lb_table[$lb_enums{'East_Asian_OP'}][$i]
1901                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1902     }
1903
1904     # LB13 Do not break before ‘]’ or ‘!’ or ‘;’ or ‘/’, even after spaces, as
1905     # tailored by example 7 in http://www.unicode.org/reports/tr14/#Examples
1906     # [^NU] × CL
1907     # [^NU] × CP
1908     # × EX
1909     # [^NU] × IS
1910     # [^NU] × SY
1911     for my $i (0 .. @lb_table - 1) {
1912         $lb_table[$i][$lb_enums{'Exclamation'}]
1913                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1914
1915         next if $i == $lb_enums{'Numeric'};
1916
1917         $lb_table[$i][$lb_enums{'Close_Punctuation'}]
1918                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1919         $lb_table[$i][$lb_enums{'Close_Parenthesis'}]
1920                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1921         $lb_table[$i][$lb_enums{'East_Asian_CP'}]
1922                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1923         $lb_table[$i][$lb_enums{'Infix_Numeric'}]
1924                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1925         $lb_table[$i][$lb_enums{'Break_Symbols'}]
1926                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1927     }
1928
1929     # LB12a Do not break before NBSP and related characters, except after
1930     # spaces and hyphens.
1931     # [^SP BA HY] × GL
1932     for my $i (0 .. @lb_table - 1) {
1933         next if    $i == $lb_enums{'Space'}
1934                 || $i == $lb_enums{'Break_After'}
1935                 || $i == $lb_enums{'Hyphen'};
1936
1937         # We don't break, but if a property above has said don't break even
1938         # with space between, don't override that (also in the next few rules)
1939         next if $lb_table[$i][$lb_enums{'Glue'}]
1940                             == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1941         $lb_table[$i][$lb_enums{'Glue'}] = $lb_actions{'LB_NOBREAK'};
1942     }
1943
1944     # LB12 Do not break after NBSP and related characters.
1945     # GL ×
1946     for my $i (0 .. @lb_table - 1) {
1947         next if $lb_table[$lb_enums{'Glue'}][$i]
1948                             == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1949         $lb_table[$lb_enums{'Glue'}][$i] = $lb_actions{'LB_NOBREAK'};
1950     }
1951
1952     # LB11 Do not break before or after Word joiner and related characters.
1953     # × WJ
1954     # WJ ×
1955     for my $i (0 .. @lb_table - 1) {
1956         if ($lb_table[$i][$lb_enums{'Word_Joiner'}]
1957                         != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1958         {
1959             $lb_table[$i][$lb_enums{'Word_Joiner'}] = $lb_actions{'LB_NOBREAK'};
1960         }
1961         if ($lb_table[$lb_enums{'Word_Joiner'}][$i]
1962                         != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1963         {
1964             $lb_table[$lb_enums{'Word_Joiner'}][$i] = $lb_actions{'LB_NOBREAK'};
1965         }
1966     }
1967
1968     # Special case this here to avoid having to do a special case in the code,
1969     # by making this the same as other things with a SP in front of them that
1970     # don't break, we avoid an extra test
1971     $lb_table[$lb_enums{'Space'}][$lb_enums{'Word_Joiner'}]
1972                             = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1973
1974     # LB9 and LB10 are done in the same loop
1975     #
1976     # LB9 Do not break a combining character sequence; treat it as if it has
1977     # the line breaking class of the base character in all of the
1978     # higher-numbered rules.  Treat ZWJ as if it were CM
1979     # Treat X (CM|ZWJ)* as if it were X.
1980     # where X is any line break class except BK, CR, LF, NL, SP, or ZW.
1981
1982     # LB10 Treat any remaining combining mark or ZWJ as AL.  This catches the
1983     # case where a CM or ZWJ is the first character on the line or follows SP,
1984     # BK, CR, LF, NL, or ZW.
1985     for my $i (0 .. @lb_table - 1) {
1986
1987         # When the CM or ZWJ is the first in the pair, we don't know without
1988         # looking behind whether the CM or ZWJ is going to attach to an
1989         # earlier character, or not.  So have to figure this out at runtime in
1990         # the code
1991         $lb_table[$lb_enums{'Combining_Mark'}][$i]
1992                                         = $lb_actions{'LB_CM_ZWJ_foo'};
1993         $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_CM_ZWJ_foo'};
1994
1995         if (   $i == $lb_enums{'Mandatory_Break'}
1996             || $i == $lb_enums{'EDGE'}
1997             || $i == $lb_enums{'Carriage_Return'}
1998             || $i == $lb_enums{'Line_Feed'}
1999             || $i == $lb_enums{'Next_Line'}
2000             || $i == $lb_enums{'Space'}
2001             || $i == $lb_enums{'ZWSpace'})
2002         {
2003             # For these classes, a following CM doesn't combine, and should do
2004             # whatever 'Alphabetic' would do.
2005             $lb_table[$i][$lb_enums{'Combining_Mark'}]
2006                                     = $lb_table[$i][$lb_enums{'Alphabetic'}];
2007             $lb_table[$i][$lb_enums{'ZWJ'}]
2008                                     = $lb_table[$i][$lb_enums{'Alphabetic'}];
2009         }
2010         else {
2011             # For these classes, the CM or ZWJ combines, so doesn't break,
2012             # inheriting the type of nobreak from the master character.
2013             if ($lb_table[$i][$lb_enums{'Combining_Mark'}]
2014                             != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
2015             {
2016                 $lb_table[$i][$lb_enums{'Combining_Mark'}]
2017                                         = $lb_actions{'LB_NOBREAK'};
2018             }
2019             if ($lb_table[$i][$lb_enums{'ZWJ'}]
2020                             != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
2021             {
2022                 $lb_table[$i][$lb_enums{'ZWJ'}]
2023                                         = $lb_actions{'LB_NOBREAK'};
2024             }
2025         }
2026     }
2027
2028     # LB8a Do not break after a zero width joiner
2029     # ZWJ ×
2030     for my $i (0 .. @lb_table - 1) {
2031         $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_NOBREAK'};
2032     }
2033
2034     # LB8 Break before any character following a zero-width space, even if one
2035     # or more spaces intervene.
2036     # ZW SP* ÷
2037     for my $i (0 .. @lb_table - 1) {
2038         $lb_table[$lb_enums{'ZWSpace'}][$i] = $lb_actions{'LB_BREAKABLE'};
2039     }
2040
2041     # Because of LB8-10, we need to look at context for "SP x", and this must
2042     # be done in the code.  So override the existing rules for that, by adding
2043     # a constant to get new rules that tell the code it needs to look at
2044     # context.  By adding this action instead of replacing the existing one,
2045     # we can get back to the original rule if necessary.
2046     for my $i (0 .. @lb_table - 1) {
2047         $lb_table[$lb_enums{'Space'}][$i] += $lb_actions{'LB_SP_foo'};
2048     }
2049
2050     # LB7 Do not break before spaces or zero width space.
2051     # × SP
2052     # × ZW
2053     for my $i (0 .. @lb_table - 1) {
2054         $lb_table[$i][$lb_enums{'Space'}] = $lb_actions{'LB_NOBREAK'};
2055         $lb_table[$i][$lb_enums{'ZWSpace'}] = $lb_actions{'LB_NOBREAK'};
2056     }
2057
2058     # LB6 Do not break before hard line breaks.
2059     # × ( BK | CR | LF | NL )
2060     for my $i (0 .. @lb_table - 1) {
2061         $lb_table[$i][$lb_enums{'Mandatory_Break'}] = $lb_actions{'LB_NOBREAK'};
2062         $lb_table[$i][$lb_enums{'Carriage_Return'}] = $lb_actions{'LB_NOBREAK'};
2063         $lb_table[$i][$lb_enums{'Line_Feed'}] = $lb_actions{'LB_NOBREAK'};
2064         $lb_table[$i][$lb_enums{'Next_Line'}] = $lb_actions{'LB_NOBREAK'};
2065     }
2066
2067     # LB5 Treat CR followed by LF, as well as CR, LF, and NL as hard line breaks.
2068     # CR × LF
2069     # CR !
2070     # LF !
2071     # NL !
2072     for my $i (0 .. @lb_table - 1) {
2073         $lb_table[$lb_enums{'Carriage_Return'}][$i]
2074                                 = $lb_actions{'LB_BREAKABLE'};
2075         $lb_table[$lb_enums{'Line_Feed'}][$i] = $lb_actions{'LB_BREAKABLE'};
2076         $lb_table[$lb_enums{'Next_Line'}][$i] = $lb_actions{'LB_BREAKABLE'};
2077     }
2078     $lb_table[$lb_enums{'Carriage_Return'}][$lb_enums{'Line_Feed'}]
2079                             = $lb_actions{'LB_NOBREAK'};
2080
2081     # LB4 Always break after hard line breaks.
2082     # BK !
2083     for my $i (0 .. @lb_table - 1) {
2084         $lb_table[$lb_enums{'Mandatory_Break'}][$i]
2085                                 = $lb_actions{'LB_BREAKABLE'};
2086     }
2087
2088     # LB3 Always break at the end of text.
2089     # ! eot
2090     # LB2 Never break at the start of text.
2091     # sot ×
2092     for my $i (0 .. @lb_table - 1) {
2093         $lb_table[$i][$lb_enums{'EDGE'}] = $lb_actions{'LB_BREAKABLE'};
2094         $lb_table[$lb_enums{'EDGE'}][$i] = $lb_actions{'LB_NOBREAK'};
2095     }
2096
2097     # LB1 Assign a line breaking class to each code point of the input.
2098     # Resolve AI, CB, CJ, SA, SG, and XX into other line breaking classes
2099     # depending on criteria outside the scope of this algorithm.
2100     #
2101     # In the absence of such criteria all characters with a specific
2102     # combination of original class and General_Category property value are
2103     # resolved as follows:
2104     # Original     Resolved  General_Category
2105     # AI, SG, XX      AL      Any
2106     # SA              CM      Only Mn or Mc
2107     # SA              AL      Any except Mn and Mc
2108     # CJ              NS      Any
2109     #
2110     # This is done in mktables, so we never see any of the remapped-from
2111     # classes.
2112
2113     output_table_common('LB', \%lb_actions,
2114                         \@lb_table, \@lb_short_enums, \%lb_abbreviations);
2115 }
2116
2117 sub output_WB_table() {
2118
2119     # Create and output the enums, #defines, and pair table for use in
2120     # determining Word Breaks, given in http://www.unicode.org/reports/tr29/.
2121
2122     # This uses the same mechanism in the other bounds tables generated by
2123     # this file.  The actions that could override a 0 or 1 are added to those
2124     # numbers; the actions that clearly don't depend on the underlying rule
2125     # simply overwrite
2126     my %wb_actions = (
2127         WB_NOBREAK                      => 0,
2128         WB_BREAKABLE                    => 1,
2129         WB_hs_then_hs                   => 2,
2130         WB_Ex_or_FO_or_ZWJ_then_foo     => 3,
2131         WB_DQ_then_HL                   => 4,
2132         WB_HL_then_DQ                   => 6,
2133         WB_LE_or_HL_then_MB_or_ML_or_SQ => 8,
2134         WB_MB_or_ML_or_SQ_then_LE_or_HL => 10,
2135         WB_MB_or_MN_or_SQ_then_NU       => 12,
2136         WB_NU_then_MB_or_MN_or_SQ       => 14,
2137         WB_RI_then_RI                   => 16,
2138     );
2139
2140     # Construct the WB pair table.
2141     # The table is constructed in reverse order of the rules, to make the
2142     # lower-numbered, higher priority ones override the later ones, as the
2143     # algorithm stops at the earliest matching rule
2144
2145     my @wb_table;
2146     my $table_size = @wb_short_enums;
2147
2148     # Otherwise, break everywhere (including around ideographs).
2149     # WB99  Any  ÷  Any
2150     for my $i (0 .. $table_size - 1) {
2151         for my $j (0 .. $table_size - 1) {
2152             $wb_table[$i][$j] = $wb_actions{'WB_BREAKABLE'};
2153         }
2154     }
2155
2156     # Do not break within emoji flag sequences. That is, do not break between
2157     # regional indicator (RI) symbols if there is an odd number of RI
2158     # characters before the break point.
2159     # WB16  [^RI] (RI RI)* RI × RI
2160     # WB15   sot    (RI RI)* RI × RI
2161     $wb_table[$wb_enums{'Regional_Indicator'}]
2162              [$wb_enums{'Regional_Indicator'}] = $wb_actions{'WB_RI_then_RI'};
2163
2164     # Do not break within emoji modifier sequences.
2165     # WB14  ( E_Base | EBG )  ×  E_Modifier
2166     $wb_table[$wb_enums{'E_Base'}][$wb_enums{'E_Modifier'}]
2167                                                     = $wb_actions{'WB_NOBREAK'};
2168     $wb_table[$wb_enums{'E_Base_GAZ'}][$wb_enums{'E_Modifier'}]
2169                                                     = $wb_actions{'WB_NOBREAK'};
2170
2171     # Do not break from extenders.
2172     # WB13b  ExtendNumLet  ×  (ALetter | Hebrew_Letter | Numeric | Katakana)
2173     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ALetter'}]
2174                                                 = $wb_actions{'WB_NOBREAK'};
2175     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtPict_LE'}]
2176                                                 = $wb_actions{'WB_NOBREAK'};
2177     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Hebrew_Letter'}]
2178                                                 = $wb_actions{'WB_NOBREAK'};
2179     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Numeric'}]
2180                                                 = $wb_actions{'WB_NOBREAK'};
2181     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Katakana'}]
2182                                                 = $wb_actions{'WB_NOBREAK'};
2183
2184     # WB13a  (ALetter | Hebrew_Letter | Numeric | Katakana | ExtendNumLet)
2185     #        × ExtendNumLet
2186     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ExtendNumLet'}]
2187                                                 = $wb_actions{'WB_NOBREAK'};
2188     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ExtendNumLet'}]
2189                                                 = $wb_actions{'WB_NOBREAK'};
2190     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtendNumLet'}]
2191                                                 = $wb_actions{'WB_NOBREAK'};
2192     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtendNumLet'}]
2193                                                 = $wb_actions{'WB_NOBREAK'};
2194     $wb_table[$wb_enums{'Katakana'}][$wb_enums{'ExtendNumLet'}]
2195                                                 = $wb_actions{'WB_NOBREAK'};
2196     $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtendNumLet'}]
2197                                                 = $wb_actions{'WB_NOBREAK'};
2198
2199     # Do not break between Katakana.
2200     # WB13  Katakana  ×  Katakana
2201     $wb_table[$wb_enums{'Katakana'}][$wb_enums{'Katakana'}]
2202                                                 = $wb_actions{'WB_NOBREAK'};
2203
2204     # Do not break within sequences, such as “3.2” or “3,456.789”.
2205     # WB12  Numeric  ×  (MidNum | MidNumLet | Single_Quote) Numeric
2206     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNumLet'}]
2207                                     += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2208     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNum'}]
2209                                     += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2210     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Single_Quote'}]
2211                                     += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2212
2213     # WB11  Numeric (MidNum | (MidNumLet | Single_Quote))  ×  Numeric
2214     $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Numeric'}]
2215                                     += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2216     $wb_table[$wb_enums{'MidNum'}][$wb_enums{'Numeric'}]
2217                                     += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2218     $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Numeric'}]
2219                                     += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2220
2221     # Do not break within sequences of digits, or digits adjacent to letters
2222     # (“3a”, or “A3”).
2223     # WB10  Numeric  ×  (ALetter | Hebrew_Letter)
2224     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ALetter'}]
2225                                                 = $wb_actions{'WB_NOBREAK'};
2226     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtPict_LE'}]
2227                                                 = $wb_actions{'WB_NOBREAK'};
2228     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Hebrew_Letter'}]
2229                                                 = $wb_actions{'WB_NOBREAK'};
2230
2231     # WB9  (ALetter | Hebrew_Letter)  ×  Numeric
2232     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Numeric'}]
2233                                                 = $wb_actions{'WB_NOBREAK'};
2234     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Numeric'}]
2235                                                 = $wb_actions{'WB_NOBREAK'};
2236     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Numeric'}]
2237                                                 = $wb_actions{'WB_NOBREAK'};
2238
2239     # WB8  Numeric  ×  Numeric
2240     $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Numeric'}]
2241                                                 = $wb_actions{'WB_NOBREAK'};
2242
2243     # Do not break letters across certain punctuation.
2244     # WB7c  Hebrew_Letter Double_Quote  ×  Hebrew_Letter
2245     $wb_table[$wb_enums{'Double_Quote'}][$wb_enums{'Hebrew_Letter'}]
2246                                             += $wb_actions{'WB_DQ_then_HL'};
2247
2248     # WB7b  Hebrew_Letter  ×  Double_Quote Hebrew_Letter
2249     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Double_Quote'}]
2250                                             += $wb_actions{'WB_HL_then_DQ'};
2251
2252     # WB7a  Hebrew_Letter  ×  Single_Quote
2253     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}]
2254                                                 = $wb_actions{'WB_NOBREAK'};
2255
2256     # WB7  (ALetter | Hebrew_Letter) (MidLetter | MidNumLet | Single_Quote)
2257     #       × (ALetter | Hebrew_Letter)
2258     $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ALetter'}]
2259                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2260     $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ExtPict_LE'}]
2261                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2262     $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Hebrew_Letter'}]
2263                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2264     $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ALetter'}]
2265                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2266     $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ExtPict_LE'}]
2267                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2268     $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'Hebrew_Letter'}]
2269                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2270     $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ALetter'}]
2271                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2272     $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ExtPict_LE'}]
2273                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2274     $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Hebrew_Letter'}]
2275                             += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2276
2277     # WB6  (ALetter | Hebrew_Letter)  ×  (MidLetter | MidNumLet
2278     #       | Single_Quote) (ALetter | Hebrew_Letter)
2279     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidNumLet'}]
2280                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2281     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'MidNumLet'}]
2282                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2283     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidNumLet'}]
2284                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2285     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidLetter'}]
2286                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2287     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'MidLetter'}]
2288                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2289     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidLetter'}]
2290                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2291     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Single_Quote'}]
2292                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2293     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Single_Quote'}]
2294                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2295     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}]
2296                             += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2297
2298     # Do not break between most letters.
2299     # WB5  (ALetter | Hebrew_Letter)  ×  (ALetter | Hebrew_Letter)
2300     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ALetter'}]
2301                                                     = $wb_actions{'WB_NOBREAK'};
2302     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ALetter'}]
2303                                                     = $wb_actions{'WB_NOBREAK'};
2304     $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Hebrew_Letter'}]
2305                                                     = $wb_actions{'WB_NOBREAK'};
2306     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'Hebrew_Letter'}]
2307                                                     = $wb_actions{'WB_NOBREAK'};
2308     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ALetter'}]
2309                                                     = $wb_actions{'WB_NOBREAK'};
2310     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtPict_LE'}]
2311                                                     = $wb_actions{'WB_NOBREAK'};
2312     $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Hebrew_Letter'}]
2313                                                     = $wb_actions{'WB_NOBREAK'};
2314     $wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ExtPict_LE'}]
2315                                                     = $wb_actions{'WB_NOBREAK'};
2316
2317     # Ignore Format and Extend characters, except after sot, CR, LF, and
2318     # Newline.  This also has the effect of: Any × (Format | Extend | ZWJ)
2319     # WB4  X (Extend | Format | ZWJ)* → X
2320     for my $i (0 .. @wb_table - 1) {
2321         $wb_table[$wb_enums{'Extend'}][$i]
2322                                 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2323         $wb_table[$wb_enums{'Format'}][$i]
2324                                 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2325         $wb_table[$wb_enums{'ZWJ'}][$i]
2326                                 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2327     }
2328     for my $i (0 .. @wb_table - 1) {
2329         $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'};
2330         $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'};
2331         $wb_table[$i][$wb_enums{'ZWJ'}]    = $wb_actions{'WB_NOBREAK'};
2332     }
2333
2334     # Implied is that these attach to the character before them, except for
2335     # the characters that mark the end of a region of text.  The rules below
2336     # override the ones set up here, for all the characters that need
2337     # overriding.
2338     for my $i (0 .. @wb_table - 1) {
2339         $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'};
2340         $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'};
2341     }
2342
2343     # Keep horizontal whitespace together
2344     # Use perl's tailoring instead
2345     # WB3d WSegSpace × WSegSpace
2346     #$wb_table[$wb_enums{'WSegSpace'}][$wb_enums{'WSegSpace'}]
2347     #                                               = $wb_actions{'WB_NOBREAK'};
2348
2349     # Do not break within emoji zwj sequences.
2350     # WB3c ZWJ × ( Glue_After_Zwj | EBG )
2351     $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'Glue_After_Zwj'}]
2352                                                 = $wb_actions{'WB_NOBREAK'};
2353     $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'E_Base_GAZ'}]
2354                                                 = $wb_actions{'WB_NOBREAK'};
2355     $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_XX'}]
2356                                                 = $wb_actions{'WB_NOBREAK'};
2357     $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_LE'}]
2358                                                 = $wb_actions{'WB_NOBREAK'};
2359
2360     # Break before and after newlines
2361     # WB3b     ÷  (Newline | CR | LF)
2362     # WB3a  (Newline | CR | LF)  ÷
2363     # et. al.
2364     for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2365         for my $j (0 .. @wb_table - 1) {
2366             $wb_table[$j][$wb_enums{$i}] = $wb_actions{'WB_BREAKABLE'};
2367             $wb_table[$wb_enums{$i}][$j] = $wb_actions{'WB_BREAKABLE'};
2368         }
2369     }
2370
2371     # But do not break within white space.
2372     # WB3  CR  ×  LF
2373     # et.al.
2374     for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2375         for my $j ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2376             $wb_table[$wb_enums{$i}][$wb_enums{$j}] = $wb_actions{'WB_NOBREAK'};
2377         }
2378     }
2379
2380     # And do not break horizontal space followed by Extend or Format or ZWJ
2381     $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Extend'}]
2382                                                     = $wb_actions{'WB_NOBREAK'};
2383     $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Format'}]
2384                                                     = $wb_actions{'WB_NOBREAK'};
2385     $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'ZWJ'}]
2386                                                     = $wb_actions{'WB_NOBREAK'};
2387     $wb_table[$wb_enums{'Perl_Tailored_HSpace'}]
2388               [$wb_enums{'Perl_Tailored_HSpace'}]
2389                                                 = $wb_actions{'WB_hs_then_hs'};
2390
2391     # Break at the start and end of text, unless the text is empty
2392     # WB2  Any  ÷  eot
2393     # WB1  sot  ÷  Any
2394     for my $i (0 .. @wb_table - 1) {
2395         $wb_table[$i][$wb_enums{'EDGE'}] = $wb_actions{'WB_BREAKABLE'};
2396         $wb_table[$wb_enums{'EDGE'}][$i] = $wb_actions{'WB_BREAKABLE'};
2397     }
2398     $wb_table[$wb_enums{'EDGE'}][$wb_enums{'EDGE'}] = 0;
2399
2400     output_table_common('WB', \%wb_actions,
2401                         \@wb_table, \@wb_short_enums, \%wb_abbreviations);
2402 }
2403
2404 sub sanitize_name ($) {
2405     # Change the non-word characters in the input string to standardized word
2406     # equivalents
2407     #
2408     my $sanitized = shift;
2409     $sanitized =~ s/=/__/;
2410     $sanitized =~ s/&/_AMP_/;
2411     $sanitized =~ s/\./_DOT_/;
2412     $sanitized =~ s/-/_MINUS_/;
2413     $sanitized =~ s!/!_SLASH_!;
2414
2415     return $sanitized;
2416 }
2417
2418 sub token_name
2419 {
2420     my $name = sanitize_name(shift);
2421     warn "$name contains non-word" if $name =~ /\W/;
2422
2423     return "$table_name_prefix\U$name"
2424 }
2425
2426 switch_pound_if ('ALL', 'PERL_IN_REGCOMP_C');
2427
2428 output_invlist("Latin1", [ 0, 256 ]);
2429 output_invlist("AboveLatin1", [ 256 ]);
2430
2431 if ($num_anyof_code_points == 256) {    # Same as Latin1
2432     print $out_fh
2433             "\nstatic const UV * const InBitmap_invlist = Latin1_invlist;\n";
2434 }
2435 else {
2436     output_invlist("InBitmap", [ 0, $num_anyof_code_points ]);
2437 }
2438
2439 end_file_pound_if;
2440
2441 # We construct lists for all the POSIX and backslash sequence character
2442 # classes in two forms:
2443 #   1) ones which match only in the ASCII range
2444 #   2) ones which match either in the Latin1 range, or the entire Unicode range
2445 #
2446 # These get compiled in, and hence affect the memory footprint of every Perl
2447 # program, even those not using Unicode.  To minimize the size, currently
2448 # the Latin1 version is generated for the beyond ASCII range except for those
2449 # lists that are quite small for the entire range, such as for \s, which is 22
2450 # UVs long plus 4 UVs (currently) for the header.
2451 #
2452 # To save even more memory, the ASCII versions could be derived from the
2453 # larger ones at runtime, saving some memory (minus the expense of the machine
2454 # instructions to do so), but these are all small anyway, so their total is
2455 # about 100 UVs.
2456 #
2457 # In the list of properties below that get generated, the L1 prefix is a fake
2458 # property that means just the Latin1 range of the full property (whose name
2459 # has an X prefix instead of L1).
2460 #
2461 # An initial & means to use the subroutine from this file instead of an
2462 # official inversion list.
2463
2464 # Below is the list of property names to generate.  '&' means to use the
2465 # subroutine to generate the inversion list instead of the generic code
2466 # below.  Some properties have a comma-separated list after the name,
2467 # These are extra enums to add to those found in the Unicode tables.
2468 no warnings 'qw';
2469                         # Ignore non-alpha in sort
2470 my @props;
2471 push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
2472                     &UpperLatin1
2473                     _Perl_GCB,EDGE,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,ExtPict_XX
2474                     _Perl_LB,EDGE,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,East_Asian_CP,East_Asian_OP,Unassigned_Extended_Pictographic_Ideographic
2475                     _Perl_SB,EDGE,SContinue,CR,Extend,LF
2476                     _Perl_WB,Perl_Tailored_HSpace,EDGE,UNKNOWN,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,ExtPict_XX,ExtPict_LE
2477                     _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
2478                     Lowercase_Mapping
2479                     Titlecase_Mapping
2480                     Uppercase_Mapping
2481                     Simple_Case_Folding
2482                     Case_Folding
2483                     &_Perl_IVCF
2484                     &_Perl_CCC_non0_non230
2485                 );
2486                 # NOTE that the convention is that extra enum values come
2487                 # after the property name, separated by commas, with the enums
2488                 # that aren't ever defined by Unicode (with some exceptions)
2489                 # containing at least 4 all-uppercase characters.
2490
2491                 # Some of the enums are current official property values that
2492                 # are needed for the rules in constructing certain tables in
2493                 # this file, and perhaps in regexec.c as well.  They are here
2494                 # so that things don't crash when compiled on earlier Unicode
2495                 # releases where they don't exist.  Thus the rules that use
2496                 # them still get compiled, but no code point actually uses
2497                 # them, hence they won't get exercized on such Unicode
2498                 # versions, but the code will still compile and run, though
2499                 # may not give the precise results that those versions would
2500                 # expect, but reasonable results nonetheless.
2501                 #
2502                 # Other enums are due to the fact that Unicode has in more
2503                 # recent versions added criteria to the rules in these extra
2504                 # tables that are based on factors outside the property
2505                 # values.  And those have to be accounted for, essentially by
2506                 # here splitting certain enum equivalence classes based on
2507                 # those extra rules.
2508                 #
2509                 # EDGE is supposed to be a boundary between some types of
2510                 # enums, but khw thinks that isn't valid any more.
2511
2512 my @bin_props;
2513 my @perl_prop_synonyms;
2514 my %enums;
2515 my @deprecated_messages = "";   # Element [0] is a placeholder
2516 my %deprecated_tags;
2517
2518 my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x;
2519
2520 # Create another hash that maps floating point x.yyEzz representation to what
2521 # %stricter_to_file_of does for the equivalent rational.  A typical entry in
2522 # the latter hash is
2523 #
2524 #    'nv=1/2' => 'Nv/1_2',
2525 #
2526 # From that, this loop creates an entry
2527 #
2528 #    'nv=5.00e-01' => 'Nv/1_2',
2529 #
2530 # %stricter_to_file_of contains far more than just the rationals.  Instead we
2531 # use %Unicode::UCD::nv_floating_to_rational which should have an entry for each
2532 # nv in the former hash.
2533 my %floating_to_file_of;
2534 foreach my $key (keys %Unicode::UCD::nv_floating_to_rational) {
2535     my $value = $Unicode::UCD::nv_floating_to_rational{$key};
2536     $floating_to_file_of{$key} = $Unicode::UCD::stricter_to_file_of{"nv=$value"};
2537 }
2538
2539 # Properties that are specified with a prop=value syntax
2540 my @equals_properties;
2541
2542 # Collect all the binary properties from data in lib/unicore
2543 # Sort so that complements come after the main table, and the shortest
2544 # names first, finally alphabetically.  Also, sort together the tables we want
2545 # to be kept together, and prefer those with 'posix' in their names, which is
2546 # what the C code is expecting their names to be.
2547 foreach my $property (sort
2548         {   exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
2549          or $b =~ /posix/i <=> $a =~ /posix/i
2550          or $b =~ /perl/i <=> $a =~ /perl/i
2551          or $a =~ $float_e_format <=> $b =~ $float_e_format
2552          or $a =~ /!/ <=> $b =~ /!/
2553          or length $a <=> length $b
2554          or $a cmp $b
2555         }   keys %Unicode::UCD::loose_to_file_of,
2556             keys %Unicode::UCD::stricter_to_file_of,
2557             keys %floating_to_file_of
2558 ) {
2559
2560     # These two hashes map properties to values that can be considered to
2561     # be checksums.  If two properties have the same checksum, they have
2562     # identical entries.  Otherwise they differ in some way.
2563     my $tag = $Unicode::UCD::loose_to_file_of{$property};
2564     $tag = $Unicode::UCD::stricter_to_file_of{$property} unless defined $tag;
2565     $tag = $floating_to_file_of{$property} unless defined $tag;
2566
2567     # The tag may contain an '!' meaning it is identical to the one formed
2568     # by removing the !, except that it is inverted.
2569     my $inverted = $tag =~ s/!//;
2570
2571     # This hash is lacking the property name
2572     $property = "nv=$property" if $property =~ $float_e_format;
2573
2574     # The list of 'prop=value' entries that this single entry expands to
2575     my @this_entries;
2576
2577     # Split 'property=value' on the equals sign, with $lhs being the whole
2578     # thing if there is no '='
2579     my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x;
2580
2581     # $lhs then becomes the property name.
2582     my $prop_value = $rhs =~ s/ ^ = //rx;
2583
2584     push @equals_properties, $lhs if $prop_value ne "";
2585
2586     # See if there are any synonyms for this property.
2587     if (exists $prop_name_aliases{$lhs}) {
2588
2589         # If so, do the combinatorics so that a new entry is added for
2590         # each legal property combined with the property value (which is
2591         # $rhs)
2592         foreach my $alias (@{$prop_name_aliases{$lhs}}) {
2593
2594             # But, there are some ambiguities, like 'script' is a synonym
2595             # for 'sc', and 'sc' can stand alone, meaning something
2596             # entirely different than 'script'.  'script' cannot stand
2597             # alone.  Don't add if the potential new lhs is in the hash of
2598             # stand-alone properties.
2599             no warnings 'once';
2600             next if $rhs eq "" &&  grep { $alias eq $_ }
2601                                     keys %Unicode::UCD::loose_property_to_file_of;
2602
2603             my $new_entry = $alias . $rhs;
2604             push @this_entries, $new_entry;
2605         }
2606     }
2607
2608     # Above, we added the synonyms for the base entry we're now
2609     # processing.  But we haven't dealt with it yet.  If we already have a
2610     # property with the identical characteristics, this becomes just a
2611     # synonym for it.
2612
2613     if (exists $enums{$tag}) {
2614         push @this_entries, $property;
2615     }
2616     else { # Otherwise, create a new entry.
2617
2618         # Add to the list of properties to generate inversion lists for.
2619         push @bin_props, uc $property;
2620
2621         # Create a rule for the parser
2622         if (! exists $keywords{$property}) {
2623             $keywords{$property} = token_name($property);
2624         }
2625
2626         # And create an enum for it.
2627         $enums{$tag} = $table_name_prefix . uc sanitize_name($property);
2628
2629         $perl_tags{$tag} = 1 if exists $keep_together{lc $property};
2630
2631         # Some properties are deprecated.  This hash tells us so, and the
2632         # warning message to raise if they are used.
2633         if (exists $Unicode::UCD::why_deprecated{$tag}) {
2634             $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages;
2635             push @deprecated_messages, $Unicode::UCD::why_deprecated{$tag};
2636         }
2637
2638         # Our sort above should have made sure that we see the
2639         # non-inverted version first, but this makes sure.
2640         warn "$property is inverted!!!" if $inverted;
2641     }
2642
2643     # Everything else is #defined to be the base enum, inversion is
2644     # indicated by negating the value.
2645     my $defined_to = "";
2646     $defined_to .= "-" if $inverted;
2647     $defined_to .= $enums{$tag};
2648
2649     # Go through the entries that evaluate to this.
2650     @this_entries = uniques @this_entries;
2651     foreach my $define (@this_entries) {
2652
2653         # There is a rule for the parser for each.
2654         $keywords{$define} = $defined_to;
2655
2656         # And a #define for all simple names equivalent to a perl property,
2657         # except those that begin with 'is' or 'in';
2658         if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) {
2659             push @perl_prop_synonyms, "#define "
2660                                     . $table_name_prefix
2661                                     . uc(sanitize_name($define))
2662                                     . "   $defined_to";
2663         }
2664     }
2665 }
2666
2667 @bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
2668                    or $a cmp $b
2669                   } @bin_props;
2670 @perl_prop_synonyms = sort(uniques(@perl_prop_synonyms));
2671 push @props, @bin_props;
2672
2673 foreach my $prop (@props) {
2674
2675     # For the Latin1 properties, we change to use the eXtended version of the
2676     # base property, then go through the result and get rid of everything not
2677     # in Latin1 (above 255).  Actually, we retain the element for the range
2678     # that crosses the 255/256 boundary if it is one that matches the
2679     # property.  For example, in the Word property, there is a range of code
2680     # points that start at U+00F8 and goes through U+02C1.  Instead of
2681     # artificially cutting that off at 256 because 256 is the first code point
2682     # above Latin1, we let the range go to its natural ending.  That gives us
2683     # extra information with no added space taken.  But if the range that
2684     # crosses the boundary is one that doesn't match the property, we don't
2685     # start a new range above 255, as that could be construed as going to
2686     # infinity.  For example, the Upper property doesn't include the character
2687     # at 255, but does include the one at 256.  We don't include the 256 one.
2688     my $prop_name = $prop;
2689     my $is_local_sub = $prop_name =~ s/^&//;
2690     my $extra_enums = "";
2691     $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
2692     my $lookup_prop = $prop_name;
2693     $prop_name = sanitize_name($prop_name);
2694     $prop_name = $table_name_prefix . $prop_name
2695                                 if grep { lc $lookup_prop eq lc $_ } @bin_props;
2696     my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
2697                     or $lookup_prop =~ s/^L1//);
2698     my $nonl1_only = 0;
2699     $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
2700     ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;
2701
2702     for my $charset (get_supported_code_pages()) {
2703         @a2n = @{get_a2n($charset)};
2704
2705         my @invlist;
2706         my @invmap;
2707         my $map_format = 0;;
2708         my $map_default;
2709         my $maps_to_code_point = 0;
2710         my $to_adjust = 0;
2711         my $same_in_all_code_pages;
2712         if ($is_local_sub) {
2713             my @return = eval $lookup_prop;
2714             die $@ if $@;
2715             my $invlist_ref = shift @return;
2716             @invlist = @$invlist_ref;
2717             if (@return) {  # If has other values returned , must be an
2718                             # inversion map
2719                 my $invmap_ref = shift @return;
2720                 @invmap = @$invmap_ref;
2721                 $map_format = shift @return;
2722                 $map_default = shift @return;
2723             }
2724         }
2725         else {
2726             @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok');
2727             if (! @invlist) {
2728
2729                 # If couldn't find a non-empty inversion list, see if it is
2730                 # instead an inversion map
2731                 my ($list_ref, $map_ref, $format, $default)
2732                           = prop_invmap($lookup_prop, '_perl_core_internal_ok');
2733                 if (! $list_ref) {
2734                     # An empty return here could mean an unknown property, or
2735                     # merely that the original inversion list is empty.  Call
2736                     # in scalar context to differentiate
2737                     my $count = prop_invlist($lookup_prop,
2738                                              '_perl_core_internal_ok');
2739                     if (defined $count) {
2740                         # Short-circuit an empty inversion list.
2741                         output_invlist($prop_name, \@invlist, $charset);
2742                         last;
2743                     }
2744                     die "Could not find inversion list for '$lookup_prop'"
2745                 }
2746                 else {
2747                     @invlist = @$list_ref;
2748                     @invmap = @$map_ref;
2749                     $map_format = $format;
2750                     $map_default = $default;
2751                 }
2752             }
2753         }
2754
2755         if ($map_format) {
2756             $maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x;
2757             $to_adjust = $map_format =~ /a/;
2758         }
2759
2760         # Re-order the Unicode code points to native ones for this platform.
2761         # This is only needed for code points below 256, because native code
2762         # points are only in that range.  For inversion maps of properties
2763         # where the mappings are adjusted (format =~ /a/), this reordering
2764         # could mess up the adjustment pattern that was in the input, so that
2765         # has to be dealt with.
2766         #
2767         # And inversion maps that map to code points need to eventually have
2768         # all those code points remapped to native, and it's better to do that
2769         # here, going through the whole list not just those below 256.  This
2770         # is because some inversion maps have adjustments (format =~ /a/)
2771         # which may be affected by the reordering.  This code needs to be done
2772         # both for when we are translating the inversion lists for < 256, and
2773         # for the inversion maps for everything.  By doing both in this loop,
2774         # we can share that code.
2775         #
2776         # So, we go through everything for an inversion map to code points;
2777         # otherwise, we can skip any remapping at all if we are going to
2778         # output only the above-Latin1 values, or if the range spans the whole
2779         # of 0..256, as the remap will also include all of 0..256  (256 not
2780         # 255 because a re-ordering could cause 256 to need to be in the same
2781         # range as 255.)
2782         if (       (@invmap && $maps_to_code_point)
2783             || (    @invlist
2784                 &&  $invlist[0] < 256
2785                 && (    $invlist[0] != 0
2786                     || (scalar @invlist != 1 && $invlist[1] < 256))))
2787         {
2788             $same_in_all_code_pages = 0;
2789             if (! @invmap) {    # Straight inversion list
2790                 # Look at all the ranges that start before 257.
2791                 my @latin1_list;
2792                 while (@invlist) {
2793                     last if $invlist[0] > 256;
2794                     my $upper = @invlist > 1
2795                                 ? $invlist[1] - 1      # In range
2796
2797                                 # To infinity.  You may want to stop much much
2798                                 # earlier; going this high may expose perl
2799                                 # deficiencies with very large numbers.
2800                                 : 256;
2801                     for my $j ($invlist[0] .. $upper) {
2802                         push @latin1_list, a2n($j);
2803                     }
2804
2805                     shift @invlist; # Shift off the range that's in the list
2806                     shift @invlist; # Shift off the range not in the list
2807                 }
2808
2809                 # Here @invlist contains all the ranges in the original that
2810                 # start at code points above 256, and @latin1_list contains
2811                 # all the native code points for ranges that start with a
2812                 # Unicode code point below 257.  We sort the latter and
2813                 # convert it to inversion list format.  Then simply prepend it
2814                 # to the list of the higher code points.
2815                 @latin1_list = sort { $a <=> $b } @latin1_list;
2816                 @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list);
2817                 unshift @invlist, @latin1_list;
2818             }
2819             else {  # Is an inversion map
2820
2821                 # This is a similar procedure as plain inversion list, but has
2822                 # multiple buckets.  A plain inversion list just has two
2823                 # buckets, 1) 'in' the list; and 2) 'not' in the list, and we
2824                 # pretty much can ignore the 2nd bucket, as it is completely
2825                 # defined by the 1st.  But here, what we do is create buckets
2826                 # which contain the code points that map to each, translated
2827                 # to native and turned into an inversion list.  Thus each
2828                 # bucket is an inversion list of native code points that map
2829                 # to it or don't map to it.  We use these to create an
2830                 # inversion map for the whole property.
2831
2832                 # As mentioned earlier, we use this procedure to not just
2833                 # remap the inversion list to native values, but also the maps
2834                 # of code points to native ones.  In the latter case we have
2835                 # to look at the whole of the inversion map (or at least to
2836                 # above Unicode; as the maps of code points above that should
2837                 # all be to the default).
2838                 my $upper_limit = (! $maps_to_code_point)
2839                                    ? 256
2840                                    : (Unicode::UCD::UnicodeVersion() eq '1.1.5')
2841                                       ? 0xFFFF
2842                                       : 0x10FFFF;
2843
2844                 my %mapped_lists;   # A hash whose keys are the buckets.
2845                 while (@invlist) {
2846                     last if $invlist[0] > $upper_limit;
2847
2848                     # This shouldn't actually happen, as prop_invmap() returns
2849                     # an extra element at the end that is beyond $upper_limit
2850                     die "inversion map (for $prop_name) that extends to"
2851                       . " infinity is unimplemented" unless @invlist > 1;
2852
2853                     my $bucket;
2854
2855                     # A hash key can't be a ref (we are only expecting arrays
2856                     # of scalars here), so convert any such to a string that
2857                     # will be converted back later (using a vertical tab as
2858                     # the separator).
2859                     if (ref $invmap[0]) {
2860                         $bucket = join "\cK", map { a2n($_) }  @{$invmap[0]};
2861                     }
2862                     elsif (   $maps_to_code_point
2863                            && $invmap[0] =~ $integer_or_float_re)
2864                     {
2865
2866                         # Do convert to native for maps to single code points.
2867                         # There are some properties that have a few outlier
2868                         # maps that aren't code points, so the above test
2869                         # skips those.  0 is never remapped.
2870                         $bucket = $invmap[0] == 0 ? 0 : a2n($invmap[0]);
2871                     } else {
2872                         $bucket = $invmap[0];
2873                     }
2874
2875                     # We now have the bucket that all code points in the range
2876                     # map to, though possibly they need to be adjusted.  Go
2877                     # through the range and put each translated code point in
2878                     # it into its bucket.
2879                     my $base_map = $invmap[0];
2880                     for my $j ($invlist[0] .. $invlist[1] - 1) {
2881                         if ($to_adjust
2882                                # The 1st code point doesn't need adjusting
2883                             && $j > $invlist[0]
2884
2885                                # Skip any non-numeric maps: these are outliers
2886                                # that aren't code points.
2887                             && $base_map =~ $integer_or_float_re
2888
2889                                #  'ne' because the default can be a string
2890                             && $base_map ne $map_default)
2891                         {
2892                             # We adjust, by incrementing each the bucket and
2893                             # the map.  For code point maps, translate to
2894                             # native
2895                             $base_map++;
2896                             $bucket = ($maps_to_code_point)
2897                                       ? a2n($base_map)
2898                                       : $base_map;
2899                         }
2900
2901                         # Add the native code point to the bucket for the
2902                         # current map
2903                         push @{$mapped_lists{$bucket}}, a2n($j);
2904                     } # End of loop through all code points in the range
2905
2906                     # Get ready for the next range
2907                     shift @invlist;
2908                     shift @invmap;
2909                 } # End of loop through all ranges in the map.
2910
2911                 # Here, @invlist and @invmap retain all the ranges from the
2912                 # originals that start with code points above $upper_limit.
2913                 # Each bucket in %mapped_lists contains all the code points
2914                 # that map to that bucket.  If the bucket is for a map to a
2915                 # single code point, the bucket has been converted to native.
2916                 # If something else (including multiple code points), no
2917                 # conversion is done.
2918                 #
2919                 # Now we recreate the inversion map into %xlated, but this
2920                 # time for the native character set.
2921                 my %xlated;
2922                 foreach my $bucket (keys %mapped_lists) {
2923
2924                     # Sort and convert this bucket to an inversion list.  The
2925                     # result will be that ranges that start with even-numbered
2926                     # indexes will be for code points that map to this bucket;
2927                     # odd ones map to some other bucket, and are discarded
2928                     # below.
2929                     @{$mapped_lists{$bucket}}
2930                                     = sort{ $a <=> $b} @{$mapped_lists{$bucket}};
2931                     @{$mapped_lists{$bucket}}
2932                      = mk_invlist_from_sorted_cp_list(
2933                                                     \@{$mapped_lists{$bucket}});
2934
2935                     # Add each even-numbered range in the bucket to %xlated;
2936                     # so that the keys of %xlated become the range start code
2937                     # points, and the values are their corresponding maps.
2938                     while (@{$mapped_lists{$bucket}}) {
2939                         my $range_start = $mapped_lists{$bucket}->[0];
2940                         if ($bucket =~ /\cK/) {
2941                             @{$xlated{$range_start}} = split /\cK/, $bucket;
2942                         }
2943                         else {
2944                             # If adjusting, and there is more than one thing
2945                             # that maps to the same thing, they must be split
2946                             # so that later the adjusting doesn't think the
2947                             # subsequent items can go away because of the
2948                             # adjusting.
2949                             my $range_end = (     $to_adjust
2950                                                && $bucket != $map_default)
2951                                             ? $mapped_lists{$bucket}->[1] - 1
2952                                             : $range_start;
2953                             for my $i ($range_start .. $range_end) {
2954                                 $xlated{$i} = $bucket;
2955                             }
2956                         }
2957                         shift @{$mapped_lists{$bucket}}; # Discard odd ranges
2958                         shift @{$mapped_lists{$bucket}}; # Get ready for next
2959                                                          # iteration
2960                     }
2961                 } # End of loop through all the buckets.
2962
2963                 # Here %xlated's keys are the range starts of all the code
2964                 # points in the inversion map.  Construct an inversion list
2965                 # from them.
2966                 my @new_invlist = sort { $a <=> $b } keys %xlated;
2967
2968                 # If the list is adjusted, we want to munge this list so that
2969                 # we only have one entry for where consecutive code points map
2970                 # to consecutive values.  We just skip the subsequent entries
2971                 # where this is the case.
2972                 if ($to_adjust) {
2973                     my @temp;
2974                     for my $i (0 .. @new_invlist - 1) {
2975                         next if $i > 0
2976                                 && $new_invlist[$i-1] + 1 == $new_invlist[$i]
2977                                 && $xlated{$new_invlist[$i-1]}
2978                                                         =~ $integer_or_float_re
2979                                 && $xlated{$new_invlist[$i]}
2980                                                         =~ $integer_or_float_re
2981                                 && $xlated{$new_invlist[$i-1]} + 1
2982                                                  == $xlated{$new_invlist[$i]};
2983                         push @temp, $new_invlist[$i];
2984                     }
2985                     @new_invlist = @temp;
2986                 }
2987
2988                 # The inversion map comes from %xlated's values.  We can
2989                 # unshift each onto the front of the untouched portion, in
2990                 # reverse order of the portion we did process.
2991                 foreach my $start (reverse @new_invlist) {
2992                     unshift @invmap, $xlated{$start};
2993                 }
2994
2995                 # Finally prepend the inversion list we have just constructed
2996                 # to the one that contains anything we didn't process.
2997                 unshift @invlist, @new_invlist;
2998             }
2999         }
3000         elsif (@invmap) {   # inversion maps can't cope with this variable
3001                             # being true, even if it could be true
3002             $same_in_all_code_pages = 0;
3003         }
3004         else {
3005             $same_in_all_code_pages = 1;
3006         }
3007
3008         # prop_invmap() returns an extra final entry, which we can now
3009         # discard.
3010         if (@invmap) {
3011             pop @invlist;
3012             pop @invmap;
3013         }
3014
3015         if ($l1_only) {
3016             die "Unimplemented to do a Latin-1 only inversion map" if @invmap;
3017             for my $i (0 .. @invlist - 1 - 1) {
3018                 if ($invlist[$i] > 255) {
3019
3020                     # In an inversion list, even-numbered elements give the code
3021                     # points that begin ranges that match the property;
3022                     # odd-numbered give ones that begin ranges that don't match.
3023                     # If $i is odd, we are at the first code point above 255 that
3024                     # doesn't match, which means the range it is ending does
3025                     # match, and crosses the 255/256 boundary.  We want to
3026                     # include this ending point, so increment $i, so the
3027                     # splice below includes it.  Conversely, if $i is even, it
3028                     # is the first code point above 255 that matches, which
3029                     # means there was no matching range that crossed the
3030                     # boundary, and we don't want to include this code point,
3031                     # so splice before it.
3032                     $i++ if $i % 2 != 0;
3033
3034                     # Remove everything past this.
3035                     splice @invlist, $i;
3036                     splice @invmap, $i if @invmap;
3037                     last;
3038                 }
3039             }
3040         }
3041         elsif ($nonl1_only) {
3042             my $found_nonl1 = 0;
3043             for my $i (0 .. @invlist - 1 - 1) {
3044                 next if $invlist[$i] < 256;
3045
3046                 # Here, we have the first element in the array that indicates an
3047                 # element above Latin1.  Get rid of all previous ones.
3048                 splice @invlist, 0, $i;
3049                 splice @invmap, 0, $i if @invmap;
3050
3051                 # If this one's index is not divisible by 2, it means that this
3052                 # element is inverting away from being in the list, which means
3053                 # all code points from 256 to this one are in this list (or
3054                 # map to the default for inversion maps)
3055                 if ($i % 2 != 0) {
3056                     unshift @invlist, 256;
3057                     unshift @invmap, $map_default if @invmap;
3058                 }
3059                 $found_nonl1 = 1;
3060                 last;
3061             }
3062             if (! $found_nonl1) {
3063                 warn "No non-Latin1 code points in $prop_name";
3064                 output_invlist($prop_name, []);
3065                 last;
3066             }
3067         }
3068
3069         switch_pound_if ($prop_name, 'PERL_IN_REGCOMP_C');
3070         start_charset_pound_if($charset, 1) unless $same_in_all_code_pages;
3071
3072         output_invlist($prop_name, \@invlist, ($same_in_all_code_pages)
3073                                               ? $applies_to_all_charsets_text
3074                                               : $charset);
3075
3076         if (@invmap) {
3077             output_invmap($prop_name, \@invmap, $lookup_prop, $map_format,
3078                           $map_default, $extra_enums, $charset);
3079         }
3080
3081         last if $same_in_all_code_pages;
3082         end_charset_pound_if;
3083     }
3084 }
3085
3086 print $out_fh "\nconst char * const deprecated_property_msgs[] = {\n\t";
3087 print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages;
3088 print $out_fh "\n};\n";
3089
3090 switch_pound_if ('binary_invlist_enum', 'PERL_IN_REGCOMP_C');
3091
3092 my @enums = sort values %enums;
3093
3094 # Save a copy of these before modification
3095 my @invlist_names = map { "${_}_invlist" } @enums;
3096
3097 # Post-process the enums for deprecated properties.
3098 if (scalar keys %deprecated_tags) {
3099     my $seen_deprecated = 0;
3100     foreach my $enum (@enums) {
3101         if (grep { $_ eq $enum } keys %deprecated_tags) {
3102
3103             # Change the enum name for this deprecated property to a
3104             # munged one to act as a placeholder in the typedef.  Then
3105             # make the real name be a #define whose value is such that
3106             # its modulus with the number of enums yields the index into
3107             # the table occupied by the placeholder.  And so that dividing
3108             # the #define value by the table length gives an index into
3109             # the table of deprecation messages for the corresponding
3110             # warning.
3111             my $revised_enum = "${enum}_perl_aux";
3112             if (! $seen_deprecated) {
3113                 $seen_deprecated = 1;
3114                 print $out_fh "\n";
3115             }
3116             print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n";
3117             $enum = $revised_enum;
3118         }
3119     }
3120 }
3121
3122 print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,",
3123               " /* So no real value is zero */\n\t";
3124 print $out_fh join ",\n\t", @enums;
3125 print $out_fh "\n";
3126 print $out_fh "} binary_invlist_enum;\n";
3127 print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n";
3128
3129 switch_pound_if ('binary_property_tables', 'PERL_IN_REGCOMP_C');
3130
3131 output_table_header($out_fh, "UV *", "uni_prop_ptrs");
3132 print $out_fh "\tNULL,\t/* Placeholder */\n";
3133 print $out_fh "\t";
3134 print $out_fh join ",\n\t", @invlist_names;
3135 print $out_fh "\n";
3136
3137 output_table_trailer();
3138
3139 switch_pound_if ('synonym defines', 'PERL_IN_REGCOMP_C');
3140
3141 print $out_fh join "\n", "\n",
3142                          #'#    ifdef DOINIT',
3143                          #"\n",
3144                          "/* Synonyms for perl properties */",
3145                          @perl_prop_synonyms,
3146                          #"\n",
3147                          #"#    endif  /* DOINIT */",
3148                          "\n";
3149
3150 switch_pound_if ('Valid property_values', 'PERL_IN_REGCOMP_C');
3151
3152 # Each entry is a pointer to a table of property values for some property.
3153 # (Other properties may share this table.  The next two data structures allow
3154 # this sharing to be implemented.)
3155 my @values_tables = "NULL /* Placeholder so zero index is an error */";
3156
3157 # Keys are all the values of a property, strung together.  The value of each
3158 # key is its index in @values_tables.  This is because many properties have
3159 # the same values, and this allows the data to appear just once.
3160 my %joined_values;
3161
3162 # #defines for indices into @values_tables, so can have synonyms resolved by
3163 # the C compiler.
3164 my @values_indices;
3165
3166 # Go through each property which is specifiable by \p{prop=value}, and create
3167 # a hash with the keys being the canonicalized short property names, and the
3168 # values for each property being all possible values that it can take on.
3169 # Both the full value and its short, canonicalized into lc, sans punctuation
3170 # version are included.
3171 my %all_values;
3172 for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) }
3173                  uniques @equals_properties)
3174 {
3175     # Get and canonicalize the short name for this property.
3176     my ($short_name) = prop_aliases($property);
3177     $short_name = lc $short_name;
3178     $short_name =~ s/[ _-]//g;
3179
3180     # Now look at each value this property can take on
3181     foreach my $value (prop_values($short_name)) {
3182
3183         # And for each value, look at each synonym for it
3184         foreach my $alias (prop_value_aliases($short_name, $value)) {
3185
3186             # Add each synonym
3187             push @{$all_values{$short_name}}, $alias;
3188
3189             # As well as its canonicalized name.  khw made the decision to not
3190             # support the grandfathered L_ Gc property value
3191             $alias = lc $alias;
3192             $alias =~ s/[ _-]//g unless $alias =~ $numeric_re;
3193             push @{$all_values{$short_name}}, $alias;
3194         }
3195     }
3196 }
3197
3198 # Also include the old style block names, using the recipe given in
3199 # Unicode::UCD
3200 foreach my $block (prop_values('block')) {
3201     push @{$all_values{'blk'}}, charblock((prop_invlist("block=$block"))[0]);
3202 }
3203
3204 # Now create output tables for each property in @equals_properties (the keys
3205 # in %all_values) each containing that property's possible values as computed
3206 # just above.
3207 PROPERTY:
3208 for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
3209                          or $a cmp $b } keys %all_values)
3210 {
3211     @{$all_values{$property}} = uniques(@{$all_values{$property}});
3212
3213     # String together the values for this property, sorted.  This string forms
3214     # a list definition, with each value as an entry in it, indented on a new
3215     # line.  The sorting is used to find properties that take on the exact
3216     # same values to share this string.
3217     my $joined = "\t\"";
3218     $joined .= join "\",\n\t\"",
3219                 sort { ($a =~ $numeric_re && $b =~ $numeric_re)
3220                         ? eval $a <=> eval $b
3221                         :    prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
3222                           or $a cmp $b
3223                         } @{$all_values{$property}};
3224     # And add a trailing marker
3225     $joined .= "\",\n\tNULL\n";
3226
3227     my $table_name = $table_name_prefix . $property . "_values";
3228     my $index_name = "${table_name}_index";
3229
3230     # Add a rule for the parser that is just an empty value.  It will need to
3231     # know to look up empty things in the prop_value_ptrs[] table.
3232
3233     $keywords{"$property="} = $index_name;
3234     if (exists $prop_name_aliases{$property}) {
3235         foreach my $alias (@{$prop_name_aliases{$property}}) {
3236             $keywords{"$alias="} = $index_name;
3237         }
3238     }
3239
3240     # Also create rules for the synonyms of this property to point to the same
3241     # thing
3242
3243     # If this property's values are the same as one we've already computed,
3244     # use that instead of creating a duplicate.  But we add a #define to point
3245     # to the proper one.
3246     if (exists $joined_values{$joined}) {
3247         push @values_indices, "#define $index_name  $joined_values{$joined}\n";
3248         next PROPERTY;
3249     }
3250
3251     # And this property, now known to have unique values from any other seen
3252     # so far is about to be pushed onto @values_tables.  Its index is the
3253     # current count.
3254     push @values_indices, "#define $index_name  "
3255                          . scalar @values_tables . "\n";
3256     $joined_values{$joined} = $index_name;
3257     push @values_tables, $table_name;
3258
3259     # Create the table for this set of values.
3260     output_table_header($out_fh, "char *", $table_name);
3261     print $out_fh $joined;
3262     output_table_trailer();
3263 } # End of loop through the properties, and their values
3264
3265 # We have completely determined the table of the unique property values
3266 output_table_header($out_fh, "char * const *",
3267                              "${table_name_prefix}prop_value_ptrs");
3268 print $out_fh join ",\n", @values_tables;
3269 print $out_fh "\n";
3270 output_table_trailer();
3271
3272 # And the #defines for the indices in it
3273 print $out_fh "\n\n", join "", @values_indices;
3274
3275 switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C');
3276
3277 output_GCB_table();
3278 output_LB_table();
3279 output_WB_table();
3280
3281 end_file_pound_if;
3282
3283 print $out_fh <<"EOF";
3284
3285 /* More than one code point may have the same code point as their fold.  This
3286  * gives the maximum number in the current Unicode release.  (The folded-to
3287  * code point is not included in this count.)  For example, both 'S' and
3288  * \\x{17F} fold to 's', so the number for that fold is 2.  Another way to
3289  * look at it is the maximum length of all the IVCF_AUX_TABLE's */
3290 #define MAX_FOLD_FROMS $max_fold_froms
3291 EOF
3292
3293 my $sources_list = "lib/unicore/mktables.lst";
3294 my @sources = qw(regen/mk_invlists.pl
3295                  lib/unicore/mktables
3296                  lib/Unicode/UCD.pm
3297                  regen/charset_translations.pl
3298                  regen/mk_PL_charclass.pl
3299                );
3300 {
3301     # Depend on mktables’ own sources.  It’s a shorter list of files than
3302     # those that Unicode::UCD uses.
3303     if (! open my $mktables_list, '<', $sources_list) {
3304
3305           # This should force a rebuild once $sources_list exists
3306           push @sources, $sources_list;
3307     }
3308     else {
3309         while(<$mktables_list>) {
3310             last if /===/;
3311             chomp;
3312             push @sources, "lib/unicore/$_" if /^[^#]/;
3313         }
3314     }
3315 }
3316
3317 read_only_bottom_close_and_rename($out_fh, \@sources);
3318
3319 my %name_to_index;
3320 for my $i (0 .. @enums - 1) {
3321     my $loose_name = $enums[$i] =~ s/^$table_name_prefix//r;
3322     $loose_name = lc $loose_name;
3323     $loose_name =~ s/__/=/;
3324     $loose_name =~ s/_dot_/./;
3325     $loose_name =~ s/_slash_/\//g;
3326     $name_to_index{$loose_name} = $i + 1;
3327 }
3328 # unsanitize, exclude &, maybe add these before sanitize
3329 for my $i (0 .. @perl_prop_synonyms - 1) {
3330     my $loose_name_pair = $perl_prop_synonyms[$i] =~ s/#\s*define\s*//r;
3331     $loose_name_pair =~ s/\b$table_name_prefix//g;
3332     $loose_name_pair = lc $loose_name_pair;
3333     $loose_name_pair =~ s/__/=/g;
3334     $loose_name_pair =~ s/_dot_/./g;
3335     $loose_name_pair =~ s/_slash_/\//g;
3336     my ($synonym, $primary) = split / +/, $loose_name_pair;
3337     $name_to_index{$synonym} = $name_to_index{$primary};
3338 }
3339
3340 my $uni_pl = open_new('lib/unicore/uni_keywords.pl', '>',
3341                       {style => '*', by => 'regen/mk_invlists.pl',
3342                       from => "Unicode::UCD"});
3343 {
3344     print $uni_pl "\%Unicode::UCD::uni_prop_ptrs_indices = (\n";
3345     for my $name (sort keys %name_to_index) {
3346         print $uni_pl "    '$name' => $name_to_index{$name},\n";
3347     }
3348     print $uni_pl ");\n\n1;\n";
3349 }
3350
3351 read_only_bottom_close_and_rename($uni_pl, \@sources);
3352
3353 if (my $file= $ENV{DUMP_KEYWORDS_FILE}) {
3354     require Data::Dumper;
3355
3356     open my $ofh, ">", $file
3357         or die "Failed to open DUMP_KEYWORDS_FILE '$file' for write: $!";
3358     print $ofh Data::Dumper->new([\%keywords],['*keywords'])
3359                            ->Sortkeys(1)->Useqq(1)->Dump();
3360     close $ofh;
3361     print "Wrote keywords to '$file'.\n";
3362 }
3363
3364 my $keywords_fh = open_new('uni_keywords.h', '>',
3365                   {style => '*', by => 'regen/mk_invlists.pl',
3366                   from => "mph.pl"});
3367
3368 print $keywords_fh "\n#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD)\n\n";
3369
3370 my ($second_level, $seed1, $length_all_keys, $smart_blob, $rows)
3371                         = MinimalPerfectHash::make_mph_from_hash(\%keywords);
3372 print $keywords_fh MinimalPerfectHash::make_algo($second_level, $seed1,
3373                                                  $length_all_keys, $smart_blob,
3374                                                  $rows, undef, undef, undef,
3375                                                  'match_uniprop' );
3376 print $keywords_fh "\n#endif /* #if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) */\n";
3377
3378 push @sources, 'regen/mph.pl';
3379 read_only_bottom_close_and_rename($keywords_fh, \@sources);