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