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