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