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