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