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