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