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