5 use Unicode::UCD qw(prop_aliases
9 prop_invmap search_invlist
13 require './regen/regen_lib.pl';
14 require './regen/charset_translations.pl';
15 require './lib/unicore/Heavy.pl';
18 # This program outputs charclass_invlists.h, which contains various inversion
19 # lists in the form of C arrays that are to be used as-is for inversion lists.
20 # Thus, the lists it contains are essentially pre-compiled, and need only a
21 # light-weight fast wrapper to make them usable at run-time.
23 # As such, this code knows about the internal structure of these lists, and
24 # any change made to that has to be done here as well. A random number stored
25 # in the headers is used to minimize the possibility of things getting
26 # out-of-sync, or the wrong data structure being passed. Currently that
29 my $VERSION_DATA_STRUCTURE_TYPE = 148565664;
31 # charclass_invlists.h now also contains inversion maps and enum definitions
32 # for those maps that have a finite number of possible values
35 my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
37 # More than one code point may have the same code point as their fold. This
38 # gives the maximum number in the current Unicode release. (The folded-to
39 # code point is not included in this count.) Most folds are pairs of code
40 # points, like 'B' and 'b', so this number is at least one.
41 my $max_fold_froms = 1;
44 my $table_name_prefix = "UNI_";
46 # Matches valid C language enum names: begins with ASCII alphabetic, then any
48 my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax;
50 my $out_fh = open_new('charclass_invlists.h', '>',
51 {style => '*', by => 'regen/mk_invlists.pl',
52 from => "Unicode::UCD"});
54 my $in_file_pound_if = "";
56 my $max_hdr_len = 3; # In headings, how wide a name is allowed?
58 print $out_fh "/* See the generating file for comments */\n\n";
60 # enums that should be made public
65 # The symbols generated by this program are all currently defined only in a
66 # single dot c each. The code knows where most of them go, but this hash
67 # gives overrides for the exceptions to the typical place
68 my %exceptions_to_where_to_define =
70 #_Perl_IVCF => 'PERL_IN_REGCOMP_C',
73 my %where_to_define_enums = ();
75 my $applies_to_all_charsets_text = "all charsets";
79 my %gcb_abbreviations;
89 my %prop_name_aliases;
90 # Invert this hash so that for each canonical name, we get a list of things
91 # that map to it (excluding itself)
92 foreach my $name (sort keys %utf8::loose_property_name_of) {
93 my $canonical = $utf8::loose_property_name_of{$name};
94 push @{$prop_name_aliases{$canonical}}, $name if $canonical ne $name;
97 # Output these tables in the same vicinity as each other, so that will get
98 # paged in at about the same time. These are also assumed to be the exact
99 # same list as those properties used internally by perl.
100 my %keep_together = (
107 uppercaseletter => 1,
108 lowercaseletter => 1,
109 titlecaseletter => 1,
138 _perl_any_folds => 1,
139 _perl_folds_to_multi_char => 1,
140 _perl_is_in_multi_char_fold => 1,
141 _perl_non_final_folds => 1,
144 _perl_charname_begin => 1,
145 _perl_charname_continue => 1,
146 _perl_problematic_locale_foldeds_start => 1,
147 _perl_problematic_locale_folds => 1,
148 _perl_quotemeta => 1,
150 my %perl_tags; # So can find synonyms of the above properties
152 my $unused_table_hdr = 'u'; # Heading for row or column for unused values
155 # Returns non-duplicated input values. From "Perl Best Practices:
156 # Encapsulated Cleverness". p. 455 in first edition.
159 return grep { ! $seen{$_}++ } @_;
165 # Returns the input Unicode code point translated to native.
167 return $cp if $cp !~ $numeric_re || $cp > 255;
171 sub end_file_pound_if {
172 if ($in_file_pound_if) {
173 print $out_fh "\n#endif\t/* $in_file_pound_if */\n";
174 $in_file_pound_if = "";
178 sub end_charset_pound_if {
179 print $out_fh "\n" . get_conditional_compile_line_end();
182 sub switch_pound_if ($$;$) {
184 my $new_pound_if = shift;
187 my @new_pound_if = ref ($new_pound_if)
188 ? sort @$new_pound_if
191 # Switch to new #if given by the 2nd argument. If there is an override
192 # for this, it instead switches to that. The 1st argument is the
193 # static's name, used only to check if there is an override for this
195 # The 'charset' parmameter, if present, is used to first end the charset
196 # #if if we actually do a switch, and then restart it afterwards. This
197 # code, then assumes that the charset #if's are enclosed in the file ones.
199 if (exists $exceptions_to_where_to_define{$name}) {
200 @new_pound_if = $exceptions_to_where_to_define{$name};
203 foreach my $element (@new_pound_if) {
205 # regcomp.c is arranged so that the tables are not compiled in
207 my $no_xsub = 1 if $element =~ / PERL_IN_ (?: REGCOMP ) _C /x;
208 $element = "defined($element)";
209 $element = "($element && ! defined(PERL_IN_XSUB_RE))" if $no_xsub;
211 $new_pound_if = join " || ", @new_pound_if;
213 # Change to the new one if different from old
214 if ($in_file_pound_if ne $new_pound_if) {
216 end_charset_pound_if() if defined $charset;
218 # Exit any current #if
219 if ($in_file_pound_if) {
223 $in_file_pound_if = $new_pound_if;
224 print $out_fh "\n#if $in_file_pound_if\n";
226 start_charset_pound_if ($charset, 1) if defined $charset;
230 sub start_charset_pound_if ($;$) {
231 print $out_fh "\n" . get_conditional_compile_line_start(shift, shift);
238 sub output_table_header($$$;$@) {
240 # Output to $fh the heading for a table given by the other inputs
243 my ($type, # typedef of table, like UV, UV*
244 $name, # name of table
245 $comment, # Optional comment to put on header line
246 @sizes # Optional sizes of each array index. If omitted,
247 # there is a single index whose size is computed by
251 $type =~ s/ \s+ $ //x;
253 # If a the typedef is a ptr, add in an extra const
254 $type .= " const" if $type =~ / \* $ /x;
256 $comment = "" unless defined $comment;
257 $comment = " /* $comment */" if $comment;
259 my $array_declaration;
261 $array_declaration = "";
262 $array_declaration .= "[$_]" for @sizes;
265 $array_declaration = '[]';
268 my $declaration = "$type ${name}$array_declaration";
270 # Things not matching this are static. Otherwise, it is an external
271 # constant, initialized only under DOINIT.
273 # (Currently everything is static)
274 if ($in_file_pound_if !~ / PERL_IN_ (?: ) _C /x) {
276 print $fh "\nstatic const $declaration = {$comment\n";
284 EXTCONST $declaration;
288 EXTCONST $declaration = {$comment
293 sub output_table_trailer() {
295 # Close out a table started by output_table_header()
299 print $fh "\n# endif /* DOINIT */\n\n";
306 sub output_invlist ($$;$) {
308 my $invlist = shift; # Reference to inversion list array
309 my $charset = shift // ""; # name of character set for comment
311 die "No inversion list for $name" unless defined $invlist
312 && ref $invlist eq 'ARRAY';
314 # Output the inversion list $invlist using the name $name for it.
315 # It is output in the exact internal form for inversion lists.
317 # Is the last element of the header 0, or 1 ?
319 if (@$invlist && $invlist->[0] != 0) {
320 unshift @$invlist, 0;
324 $charset = "for $charset" if $charset;
325 output_table_header($out_fh, "UV", "${name}_invlist", $charset);
327 my $count = @$invlist;
329 \t$count,\t/* Number of elements */
330 \t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */
331 \t$zero_or_one,\t/* 0 if the list starts at 0;
332 \t\t 1 if it starts at the element beyond 0 */
335 # The main body are the UVs passed in to this routine. Do the final
337 for my $i (0 .. @$invlist - 1) {
338 printf $out_fh "\t0x%X", $invlist->[$i];
339 print $out_fh "," if $i < @$invlist - 1;
343 output_table_trailer();
346 sub output_invmap ($$$$$$$) {
348 my $invmap = shift; # Reference to inversion map array
349 my $prop_name = shift;
350 my $input_format = shift; # The inversion map's format
351 my $default = shift; # The property value for code points who
352 # otherwise don't have a value specified.
353 my $extra_enums = shift; # comma-separated list of our additions to the
354 # property's standard possible values
355 my $charset = shift // ""; # name of character set for comment
357 # Output the inversion map $invmap for property $prop_name, but use $name
358 # as the actual data structure's name.
360 my $count = @$invmap;
363 my $invmap_declaration_type;
364 my $enum_declaration_type;
365 my $aux_declaration_type;
369 if ($input_format =~ / ^ [as] l? $ /x) {
370 $prop_name = (prop_aliases($prop_name))[1] // $prop_name =~ s/^_Perl_//r; # Get full name
371 my $short_name = (prop_aliases($prop_name))[0] // $prop_name;
374 # Find all the possible input values. These become the enum names
375 # that comprise the inversion map. For inputs that don't have sub
376 # lists, we can just get the unique values. Otherwise, we have to
377 # expand the sublists first.
378 if ($input_format !~ / ^ a /x) {
379 if ($input_format ne 'sl') {
380 @input_enums = sort(uniques(@$invmap));
383 foreach my $element (@$invmap) {
385 push @input_enums, @$element;
388 push @input_enums, $element;
391 @input_enums = sort(uniques(@input_enums));
395 # The internal enums come last, and in the order specified.
397 # The internal one named EDGE is also used a marker. Any ones that
398 # come after it are used in the algorithms below, and so must be
399 # defined, even if the release of Unicode this is being compiled for
400 # doesn't use them. But since no code points are assigned to them in
401 # such a release, those values will never be accessed. We collapse
402 # all of them into a single placholder row and a column. The
403 # algorithms below will fill in those cells with essentially garbage,
404 # but they are never read, so it doesn't matter. This allows the
405 # algorithm to remain the same from release to release.
407 # In one case, regexec.c also uses a placeholder which must be defined
408 # here, and we put it in the unused row and column as its value is
411 my @enums = @input_enums;
414 my $unused_enum_value = @enums;
415 if ($extra_enums ne "") {
416 @extras = split /,/, $extra_enums;
419 # Don't add if already there.
420 foreach my $this_extra (@extras) {
421 next if grep { $_ eq $this_extra } @enums;
422 if ($this_extra eq 'EDGE') {
423 push @enums, $this_extra;
427 push @unused_enums, $this_extra;
430 push @enums, $this_extra;
434 @unused_enums = sort @unused_enums;
435 $unused_enum_value = @enums; # All unused have the same value,
436 # one beyond the final used one
439 # Assign a value to each element of the enum type we are creating.
440 # The default value always gets 0; the others are arbitrarily
443 my $canonical_default = prop_value_aliases($prop_name, $default);
444 $default = $canonical_default if defined $canonical_default;
445 $enums{$default} = $enum_val++;
447 for my $enum (@enums) {
448 $enums{$enum} = $enum_val++ unless exists $enums{$enum};
451 # Calculate the data for the special tables output for these properties.
452 if ($name =~ / ^ _Perl_ (?: GCB | LB | WB ) $ /x) {
454 # The data includes the hashes %gcb_enums, %lb_enums, etc.
455 # Similarly we calculate column headings for the tables.
457 # We use string evals to allow the same code to work on
459 my $type = lc $prop_name;
461 # Skip if we've already done this code, which populated
463 if (eval "! \%${type}_enums") {
465 # For each enum in the type ...
466 foreach my $enum (sort keys %enums) {
467 my $value = $enums{$enum};
469 my $abbreviated_from;
471 # Special case this wb property value to make the
473 if ($enum eq 'Perl_Tailored_HSpace') {
475 $abbreviated_from = $enum;
479 # Use the official short name, if found.
480 ($short) = prop_value_aliases($type, $enum);
482 if (! defined $short) {
484 # But if there is no official name, use the name
485 # that came from the data (if any). Otherwise,
486 # the name had to come from the extras list.
487 # There are two types of values in that list.
489 # First are those enums that are not part of the
490 # property, but are defined by this code. By
491 # convention these have all-caps names. We use
492 # the lowercased name for these.
494 # Second are enums that are needed to get the
495 # algorithms below to work and/or to get regexec.c
496 # to compile, but don't exist in all Unicode
497 # releases. These are handled outside this loop
499 if (grep { $_ eq $enum } @input_enums) {
508 # If our short name is too long, or we already
509 # know that the name is an abbreviation, truncate
510 # to make sure it's short enough, and remember
511 # that we did this so we can later add a comment in the
513 if ( $abbreviated_from
514 || length $short > $max_hdr_len)
516 $short = substr($short, 0, $max_hdr_len);
517 $abbreviated_from = $enum
518 unless $abbreviated_from;
519 # If the name we are to display conflicts, try
522 \$${type}_abbreviations{$short}")
526 # The increment operator on strings doesn't work
527 # on those containing an '_', so just use the
529 my @short = split '_', $short;
531 $short = join "_", @short;
534 eval "\$${type}_abbreviations{$short} = '$enum'";
538 # Remember the mapping from the property value
539 # (enum) name to its value.
540 eval "\$${type}_enums{$enum} = $value";
543 # Remember the inverse mapping to the short name
544 # so that we can properly label the generated
545 # table's rows and columns
546 eval "\$${type}_short_enums[$value] = '$short'";
550 # Each unused enum has the same value. They all are collapsed
551 # into one row and one column, named $unused_table_hdr.
553 eval "\$${type}_short_enums['$unused_enum_value'] = '$unused_table_hdr'";
556 foreach my $enum (@unused_enums) {
557 eval "\$${type}_enums{$enum} = $unused_enum_value";
564 # The short names tend to be two lower case letters, but it looks
565 # better for those if they are upper. XXX
566 $short_name = uc($short_name) if length($short_name) < 3
567 || substr($short_name, 0, 1) =~ /[[:lower:]]/;
568 $name_prefix = "${short_name}_";
570 # Start the enum definition for this map
573 foreach my $enum (keys %enums) {
574 $enum_list[$enums{$enum}] = $enum;
576 foreach my $i (0 .. @enum_list - 1) {
577 push @enum_definition, ",\n" if $i > 0;
579 my $name = $enum_list[$i];
580 push @enum_definition, "\t${name_prefix}$name = $i";
583 foreach my $unused (@unused_enums) {
584 push @enum_definition,
585 ",\n\t${name_prefix}$unused = $unused_enum_value";
589 # For an 'l' property, we need extra enums, because some of the
590 # elements are lists. Each such distinct list is placed in its own
591 # auxiliary map table. Here, we go through the inversion map, and for
592 # each distinct list found, create an enum value for it, numbered -1,
595 my $aux_table_prefix = "AUX_TABLE_";
596 if ($input_format =~ /l/) {
597 foreach my $element (@$invmap) {
599 # A regular scalar is not one of the lists we're looking for
601 next unless ref $element;
604 if ($input_format =~ /a/) { # These are already ordered
605 $joined = join ",", @$element;
608 $joined = join ",", sort @$element;
610 my $already_found = exists $multiples{$joined};
613 if ($already_found) { # Use any existing one
614 $i = $multiples{$joined};
616 else { # Otherwise increment to get a new table number
617 $i = keys(%multiples) + 1;
618 $multiples{$joined} = $i;
621 # This changes the inversion map for this entry to not be the
623 $element = "use_$aux_table_prefix$i";
625 # And add to the enum values
626 if (! $already_found) {
627 push @enum_definition, ",\n\t${name_prefix}$element = -$i";
632 $enum_declaration_type = "${name_prefix}enum";
634 # Finished with the enum definition. Inversion map stuff is used only
635 # by regexec or utf-8 (if it is for code points) , unless it is in the
636 # enum exception list
637 my $where = (exists $where_to_define_enums{$name})
638 ? $where_to_define_enums{$name}
639 : ($input_format =~ /a/)
641 : 'PERL_IN_REGEXEC_C';
643 if (! exists $public_enums{$name}) {
644 switch_pound_if($name, $where, $charset);
647 end_charset_pound_if;
649 start_charset_pound_if($charset, 1);
652 # If the enum only contains one element, that is a dummy, default one
653 if (scalar @enum_definition > 1) {
656 #print $out_fh "\n#define ${name_prefix}ENUM_COUNT ",
657 # ..scalar keys %enums, "\n";
659 if ($input_format =~ /l/) {
662 "/* Negative enum values indicate the need to use an",
663 " auxiliary table\n",
664 " * consisting of the list of enums this one expands to.",
666 " * values of the negative enums are indices into a table",
667 " of the auxiliary\n",
668 " * tables' addresses */";
670 print $out_fh "\ntypedef enum {\n";
671 print $out_fh join "", @enum_definition;
673 print $out_fh "} $enum_declaration_type;\n";
676 switch_pound_if($name, $where, $charset);
678 $invmap_declaration_type = ($input_format =~ /s/)
679 ? $enum_declaration_type
681 $aux_declaration_type = ($input_format =~ /s/)
682 ? $enum_declaration_type
685 $output_format = "${name_prefix}%s";
687 # If there are auxiliary tables, output them.
690 print $out_fh "\n#define HAS_${name_prefix}AUX_TABLES\n";
692 # Invert keys and values
694 while (my ($key, $value) = each %multiples) {
695 $inverted_mults{$value} = $key;
698 # Output them in sorted order
699 my @sorted_table_list = sort { $a <=> $b } keys %inverted_mults;
701 # Keep track of how big each aux table is
704 # Output each aux table.
705 foreach my $table_number (@sorted_table_list) {
706 my $table = $inverted_mults{$table_number};
707 output_table_header($out_fh,
708 $aux_declaration_type,
709 "$name_prefix$aux_table_prefix$table_number");
711 # Earlier, we joined the elements of this table together with a comma
712 my @elements = split ",", $table;
714 $aux_counts[$table_number] = scalar @elements;
715 for my $i (0 .. @elements - 1) {
716 print $out_fh ",\n" if $i > 0;
717 if ($input_format =~ /a/) {
718 printf $out_fh "\t0x%X", $elements[$i];
721 print $out_fh "\t${name_prefix}$elements[$i]";
726 output_table_trailer();
729 # Output the table that is indexed by the absolute value of the
730 # aux table enum and contains pointers to the tables output just
732 output_table_header($out_fh, "$aux_declaration_type *",
733 "${name_prefix}${aux_table_prefix}ptrs");
734 print $out_fh "\tNULL,\t/* Placeholder */\n";
735 for my $i (1 .. @sorted_table_list) {
736 print $out_fh ",\n" if $i > 1;
737 print $out_fh "\t$name_prefix$aux_table_prefix$i";
740 output_table_trailer();
743 "\n/* Parallel table to the above, giving the number of elements"
744 . " in each table\n * pointed to */\n";
745 output_table_header($out_fh, "U8",
746 "${name_prefix}${aux_table_prefix}lengths");
747 print $out_fh "\t0,\t/* Placeholder */\n";
748 for my $i (1 .. @sorted_table_list) {
749 print $out_fh ",\n" if $i > 1;
750 print $out_fh "\t$aux_counts[$i]\t/* $name_prefix$aux_table_prefix$i */";
753 output_table_trailer();
754 } # End of outputting the auxiliary and associated tables
756 # The scx property used in regexec.c needs a specialized table which
757 # is most convenient to output here, while the data structures set up
758 # above are still extant. This table contains the code point that is
759 # the zero digit of each script, indexed by script enum value.
760 if (lc $short_name eq 'scx') {
761 my @decimals_invlist = prop_invlist("Numeric_Type=Decimal");
764 # Find all the decimal digits. The 0 of each range is always the
765 # 0th element, except in some early Unicode releases, so check for
767 for (my $i = 0; $i < @decimals_invlist; $i += 2) {
768 my $code_point = $decimals_invlist[$i];
769 next if num(chr($code_point)) ne '0';
771 # Turn the scripts this zero is in into a list.
772 my @scripts = split ",",
773 charprop($code_point, "_Perl_SCX", '_perl_core_internal_ok');
774 $code_point = sprintf("0x%x", $code_point);
776 foreach my $script (@scripts) {
777 if (! exists $script_zeros{$script}) {
778 $script_zeros{$script} = $code_point;
780 elsif (ref $script_zeros{$script}) {
781 push $script_zeros{$script}->@*, $code_point;
783 else { # Turn into a list if this is the 2nd zero of the
785 my $existing = $script_zeros{$script};
786 undef $script_zeros{$script};
787 push $script_zeros{$script}->@*, $existing, $code_point;
792 # @script_zeros contains the zero, sorted by the script's enum
795 foreach my $script (keys %script_zeros) {
796 my $enum_value = $enums{$script};
797 $script_zeros[$enum_value] = $script_zeros{$script};
801 "\n/* This table, indexed by the script enum, gives the zero"
802 . " code point for that\n * script; 0 if the script has multiple"
803 . " digit sequences. Scripts without a\n * digit sequence use"
804 . " ASCII [0-9], hence are marked '0' */\n";
805 output_table_header($out_fh, "UV", "script_zeros");
806 for my $i (0 .. @script_zeros - 1) {
807 my $code_point = $script_zeros[$i];
808 if (defined $code_point) {
809 $code_point = " 0" if ref $code_point;
810 print $out_fh "\t$code_point";
812 elsif (lc $enum_list[$i] eq 'inherited') {
813 print $out_fh "\t 0";
815 else { # The only digits a script without its own set accepts
817 print $out_fh "\t'0'";
819 print $out_fh "," if $i < @script_zeros - 1;
820 print $out_fh "\t/* $enum_list[$i] */";
823 output_table_trailer();
824 } # End of special handling of scx
827 die "'$input_format' invmap() format for '$prop_name' unimplemented";
830 die "No inversion map for $prop_name" unless defined $invmap
831 && ref $invmap eq 'ARRAY'
834 # Now output the inversion map proper
835 $charset = "for $charset" if $charset;
836 output_table_header($out_fh, $invmap_declaration_type,
840 # The main body are the scalars passed in to this routine.
841 for my $i (0 .. $count - 1) {
842 my $element = $invmap->[$i];
843 my $full_element_name = prop_value_aliases($prop_name, $element);
844 if ($input_format =~ /a/ && $element !~ /\D/) {
845 $element = ($element == 0)
847 : sprintf("0x%X", $element);
850 $element = $full_element_name if defined $full_element_name;
851 $element = $name_prefix . $element;
853 print $out_fh "\t$element";
854 print $out_fh "," if $i < $count - 1;
857 output_table_trailer();
860 sub mk_invlist_from_sorted_cp_list {
862 # Returns an inversion list constructed from the sorted input array of
865 my $list_ref = shift;
867 return unless @$list_ref;
869 # Initialize to just the first element
870 my @invlist = ( $list_ref->[0], $list_ref->[0] + 1);
872 # For each succeeding element, if it extends the previous range, adjust
873 # up, otherwise add it.
874 for my $i (1 .. @$list_ref - 1) {
875 if ($invlist[-1] == $list_ref->[$i]) {
879 push @invlist, $list_ref->[$i], $list_ref->[$i] + 1;
885 # Read in the Case Folding rules, and construct arrays of code points for the
886 # properties we need.
887 my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding");
888 die "Could not find inversion map for Case_Folding" unless defined $format;
889 die "Incorrect format '$format' for Case_Folding inversion map"
890 unless $format eq 'al'
894 # This creates a map of the inversion of case folding. i.e., given a
895 # character, it gives all the other characters that fold to it.
897 # Inversion maps function kind of like a hash, with the inversion list
898 # specifying the buckets (keys) and the inversion maps specifying the
899 # contents of the corresponding bucket. Effectively this function just
900 # swaps the keys and values of the case fold hash. But there are
901 # complications. Most importantly, More than one character can each have
902 # the same fold. This is solved by having a list of characters that fold
907 # Go through the inversion list.
908 for (my $i = 0; $i < @$cp_ref; $i++) {
910 # Skip if nothing folds to this
911 next if $folds_ref->[$i] == 0;
913 # This entry which is valid from here to up (but not including) the
914 # next entry is for the next $count characters, so that, for example,
915 # A-Z is represented by one entry.
916 my $cur_list = $cp_ref->[$i];
917 my $count = $cp_ref->[$i+1] - $cur_list;
919 # The fold of [$i] can be not just a single character, but a sequence
920 # of multiple ones. We deal with those here by just creating a string
921 # consisting of them. Otherwise, we use the single code point [$i]
923 my $cur_map = (ref $folds_ref->[$i])
924 ? join "", map { chr } $folds_ref->[$i]->@*
927 # Expand out this range
929 push @{$new{$cur_map}}, $cur_list;
931 # A multiple-character fold is a string, and shouldn't need
932 # incrementing anyway
933 if (ref $folds_ref->[$i]) {
934 die sprintf("Case fold for %x is multiple chars; should have"
935 . " a count of 1, but instead it was $count", $count)
946 # Now go through and make some adjustments. We add synthetic entries for
948 # 1) Two or more code points can fold to the same multiple character,
949 # sequence, as U+FB05 and U+FB06 both fold to 'st'. This code is only
950 # for single character folds, but FB05 and FB06 are single characters
951 # that are equivalent folded, so we add entries so that they are
952 # considered to fold to each other
953 # 2) If two or more above-Latin1 code points fold to the same Latin1 range
954 # one, we also add entries so that they are considered to fold to each
955 # other. This is so that under /aa or /l matching, where folding to
956 # their Latin1 range code point is illegal, they still can fold to each
957 # other. This situation happens in Unicode 3.0.1, but probably no
959 foreach my $fold (keys %new) {
960 my $folds_to_string = $fold =~ /\D/;
962 # If the bucket contains only one element, convert from an array to a
964 if (scalar $new{$fold}->@* == 1) {
965 $new{$fold} = $new{$fold}[0];
969 # Otherwise, sort numerically. This places the highest code point
970 # in the list at the tail end. This is because Unicode keeps the
971 # lowercase code points as higher ordinals than the uppercase, at
972 # least for the ones that matter so far. These are synthetic
973 # entries, and we want to predictably have the lowercase (which is
974 # more likely to be what gets folded to) in the same corresponding
975 # position, so that other code can rely on that. If some new
976 # version of Unicode came along that violated this, we might have
977 # to change so that the sort is based on upper vs lower instead.
978 # (The lower-comes-after isn't true of native EBCDIC, but here we
979 # are dealing strictly with Unicode values).
980 @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@*
981 unless $folds_to_string;
982 # We will be working with a copy of this sorted entry.
983 my @source_list = $new{$fold}->@*;
984 if (! $folds_to_string) {
986 # This handles situation 2) listed above, which only arises if
987 # what is being folded-to (the fold) is in the Latin1 range.
992 # And it only arises if there are two or more folders that
993 # fold to it above Latin1. We look at just those.
994 @source_list = grep { $_ > 255 } @source_list;
995 undef @source_list if @source_list == 1;
999 # Here, we've found the items we want to set up synthetic folds
1000 # for. Add entries so that each folds to each other.
1001 foreach my $cp (@source_list) {
1002 my @rest = grep { $cp != $_ } @source_list;
1004 $new{$cp} = $rest[0];
1007 push @{$new{$cp}}, @rest;
1012 # We don't otherwise deal with multiple-character folds
1013 delete $new{$fold} if $folds_to_string;
1017 # Now we have a hash that is the inversion of the case fold property.
1018 # First find the maximum number of code points that fold to the same one.
1019 foreach my $fold_to (keys %new) {
1020 if (ref $new{$fold_to}) {
1021 my $folders_count = scalar @{$new{$fold_to}};
1022 $max_fold_froms = $folders_count if $folders_count > $max_fold_froms;
1026 # Then convert the hash to an inversion map.
1027 my @sorted_folds = sort { $a <=> $b } keys %new;
1028 my (@invlist, @invmap);
1030 # We know that nothing folds to the controls (whose ordinals start at 0).
1031 # And the first real entries are the lowest in the hash.
1032 push @invlist, 0, $sorted_folds[0];
1033 push @invmap, 0, $new{$sorted_folds[0]};
1035 # Go through the remainder of the hash keys (which are the folded code
1037 for (my $i = 1; $i < @sorted_folds; $i++) {
1039 # Get the current one, and the one prior to it.
1040 my $fold = $sorted_folds[$i];
1041 my $prev_fold = $sorted_folds[$i-1];
1043 # If the current one is not just 1 away from the prior one, we close
1044 # out the range containing the previous fold, and know that the gap
1045 # doesn't have anything that folds.
1046 if ($fold - 1 != $prev_fold) {
1047 push @invlist, $prev_fold + 1;
1050 # And start a new range
1051 push @invlist, $fold;
1052 push @invmap, $new{$fold};
1054 elsif ($new{$fold} - 1 != $new{$prev_fold}) {
1056 # Here the current fold is just 1 greater than the previous, but
1057 # the new map isn't correspondingly 1 greater than the previous,
1058 # the old range is ended, but since there is no gap, we don't have
1059 # to insert anything else.
1060 push @invlist, $fold;
1061 push @invmap, $new{$fold};
1063 } # else { Otherwise, this new entry just extends the previous }
1065 die "In IVCF: $invlist[-1] <= $invlist[-2]"
1066 if $invlist[-1] <= $invlist[-2];
1069 # And add an entry that indicates that everything above this, to infinity,
1070 # does not have a case fold.
1071 push @invlist, $sorted_folds[-1] + 1;
1074 # All Unicode versions have some places where multiple code points map to
1075 # the same one, so the format always has an 'l'
1076 return \@invlist, \@invmap, 'al', $default;
1079 sub prop_name_for_cmp ($) { # Sort helper
1082 # Returns the input lowercased, with non-alphas removed, as well as
1083 # everything starting with a comma
1086 $name =~ s/[[:^alpha:]]//g;
1091 my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
1095 sub output_table_common {
1097 # Common subroutine to actually output the generated rules table.
1100 $table_value_defines_ref,
1103 $abbreviations_ref) = @_;
1104 my $size = @$table_ref;
1106 # Output the #define list, sorted by numeric value
1107 if ($table_value_defines_ref) {
1108 my $max_name_length = 0;
1111 # Put in order, and at the same time find the longest name
1112 while (my ($enum, $value) = each %$table_value_defines_ref) {
1113 $defines[$value] = $enum;
1115 my $length = length $enum;
1116 $max_name_length = $length if $length > $max_name_length;
1121 # Output, so that the values are vertically aligned in a column after
1123 foreach my $i (0 .. @defines - 1) {
1124 next unless defined $defines[$i];
1125 printf $out_fh "#define %-*s %2d\n",
1132 my $column_width = 2; # We currently allow 2 digits for the number
1134 # Being above a U8 is not currently handled
1135 my $table_type = 'U8';
1137 # If a name is longer than the width set aside for a column, its column
1138 # needs to have increased spacing so that the name doesn't get truncated
1139 # nor run into an adjacent column
1142 # Is there a row and column for unused values in this release?
1143 my $has_unused = $names_ref->[$size-1] eq $unused_table_hdr;
1145 for my $i (0 .. $size - 1) {
1146 no warnings 'numeric';
1147 $spacers[$i] = " " x (length($names_ref->[$i]) - $column_width);
1150 output_table_header($out_fh, $table_type, "${property}_table", undef, $size, $size);
1152 # Calculate the column heading line
1153 my $header_line = "/* "
1154 . (" " x $max_hdr_len) # We let the row heading meld to
1155 # the '*/' for those that are at
1157 . " " x 3; # Space for '*/ '
1159 for my $i (0 .. $size - 1) {
1160 $header_line .= sprintf "%s%*s",
1162 $column_width + 1, # 1 for the ','
1165 $header_line .= " */\n";
1167 # If we have annotations, output it now.
1168 if ($has_unused || scalar %$abbreviations_ref) {
1170 foreach my $abbr (sort keys %$abbreviations_ref) {
1171 $text .= "; " if $text;
1172 $text .= "'$abbr' stands for '$abbreviations_ref->{$abbr}'";
1175 $text .= "; $unused_table_hdr stands for 'unused in this Unicode"
1176 . " release (and the data in the row or column are garbage)"
1179 my $indent = " " x 3;
1180 $text = $indent . "/* $text */";
1182 # Wrap the text so that it is no wider than the table, which the
1183 # header line gives.
1184 my $output_width = length $header_line;
1185 while (length $text > $output_width) {
1186 my $cur_line = substr($text, 0, $output_width);
1188 # Find the first blank back from the right end to wrap at.
1189 for (my $i = $output_width -1; $i > 0; $i--) {
1190 if (substr($text, $i, 1) eq " ") {
1191 print $out_fh substr($text, 0, $i), "\n";
1193 # Set so will look at just the remaining tail (which will
1194 # be indented and have a '*' after the indent
1195 $text = $indent . " * " . substr($text, $i + 1);
1202 print $out_fh $text, "\n" if $text;
1205 # We calculated the header line earlier just to get its width so that we
1206 # could make sure the annotations fit into that.
1207 print $out_fh $header_line;
1209 # Now output the bulk of the table.
1210 for my $i (0 .. $size - 1) {
1212 # First the row heading.
1213 printf $out_fh "/* %-*s*/ ", $max_hdr_len, $names_ref->[$i];
1214 print $out_fh "{"; # Then the brace for this row
1217 for my $j (0 .. $size -1) {
1218 print $out_fh $spacers[$j];
1219 printf $out_fh "%*d", $column_width, $table_ref->[$i][$j];
1220 print $out_fh "," if $j < $size - 1;
1223 print $out_fh "," if $i < $size - 1;
1227 output_table_trailer();
1230 sub output_GCB_table() {
1232 # Create and output the pair table for use in determining Grapheme Cluster
1233 # Breaks, given in http://www.unicode.org/reports/tr29/.
1237 GCB_RI_then_RI => 2, # Rules 12 and 13
1238 GCB_EX_then_EM => 3, # Rule 10
1239 GCB_Maybe_Emoji_NonBreak => 4,
1242 # The table is constructed in reverse order of the rules, to make the
1243 # lower-numbered, higher priority ones override the later ones, as the
1244 # algorithm stops at the earliest matching rule
1247 my $table_size = @gcb_short_enums;
1249 # Otherwise, break everywhere.
1251 for my $i (0 .. $table_size - 1) {
1252 for my $j (0 .. $table_size - 1) {
1253 $gcb_table[$i][$j] = 1;
1257 # Do not break within emoji flag sequences. That is, do not break between
1258 # regional indicator (RI) symbols if there is an odd number of RI
1259 # characters before the break point. Must be resolved in runtime code.
1261 # GB12 sot (RI RI)* RI × RI
1262 # GB13 [^RI] (RI RI)* RI × RI
1263 $gcb_table[$gcb_enums{'Regional_Indicator'}]
1264 [$gcb_enums{'Regional_Indicator'}] = $gcb_actions{GCB_RI_then_RI};
1266 # Post 11.0: GB11 \p{Extended_Pictographic} Extend* ZWJ
1267 # × \p{Extended_Pictographic}
1268 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'XPG_XX'}] =
1269 $gcb_actions{GCB_Maybe_Emoji_NonBreak};
1271 # This and the rule GB10 obsolete starting with Unicode 11.0, can be left
1272 # in as there are no code points that match, so the code won't ever get
1274 # Do not break within emoji modifier sequences or emoji zwj sequences.
1275 # Pre 11.0: GB11 ZWJ × ( Glue_After_Zwj | E_Base_GAZ )
1276 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'Glue_After_Zwj'}] = 0;
1277 $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'E_Base_GAZ'}] = 0;
1279 # GB10 ( E_Base | E_Base_GAZ ) Extend* × E_Modifier
1280 $gcb_table[$gcb_enums{'Extend'}][$gcb_enums{'E_Modifier'}]
1281 = $gcb_actions{GCB_EX_then_EM};
1282 $gcb_table[$gcb_enums{'E_Base'}][$gcb_enums{'E_Modifier'}] = 0;
1283 $gcb_table[$gcb_enums{'E_Base_GAZ'}][$gcb_enums{'E_Modifier'}] = 0;
1285 # Do not break before extending characters or ZWJ.
1286 # Do not break before SpacingMarks, or after Prepend characters.
1288 # GB9a × SpacingMark
1289 # GB9 × ( Extend | ZWJ )
1290 for my $i (0 .. @gcb_table - 1) {
1291 $gcb_table[$gcb_enums{'Prepend'}][$i] = 0;
1292 $gcb_table[$i][$gcb_enums{'SpacingMark'}] = 0;
1293 $gcb_table[$i][$gcb_enums{'Extend'}] = 0;
1294 $gcb_table[$i][$gcb_enums{'ZWJ'}] = 0;
1297 # Do not break Hangul syllable sequences.
1298 # GB8 ( LVT | T) × T
1299 $gcb_table[$gcb_enums{'LVT'}][$gcb_enums{'T'}] = 0;
1300 $gcb_table[$gcb_enums{'T'}][$gcb_enums{'T'}] = 0;
1302 # GB7 ( LV | V ) × ( V | T )
1303 $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'V'}] = 0;
1304 $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'T'}] = 0;
1305 $gcb_table[$gcb_enums{'V'}][$gcb_enums{'V'}] = 0;
1306 $gcb_table[$gcb_enums{'V'}][$gcb_enums{'T'}] = 0;
1308 # GB6 L × ( L | V | LV | LVT )
1309 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'L'}] = 0;
1310 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'V'}] = 0;
1311 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LV'}] = 0;
1312 $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LVT'}] = 0;
1314 # Do not break between a CR and LF. Otherwise, break before and after
1316 # GB5 ÷ ( Control | CR | LF )
1317 # GB4 ( Control | CR | LF ) ÷
1318 for my $i (0 .. @gcb_table - 1) {
1319 $gcb_table[$i][$gcb_enums{'Control'}] = 1;
1320 $gcb_table[$i][$gcb_enums{'CR'}] = 1;
1321 $gcb_table[$i][$gcb_enums{'LF'}] = 1;
1322 $gcb_table[$gcb_enums{'Control'}][$i] = 1;
1323 $gcb_table[$gcb_enums{'CR'}][$i] = 1;
1324 $gcb_table[$gcb_enums{'LF'}][$i] = 1;
1328 $gcb_table[$gcb_enums{'CR'}][$gcb_enums{'LF'}] = 0;
1330 # Break at the start and end of text, unless the text is empty
1333 for my $i (0 .. @gcb_table - 1) {
1334 $gcb_table[$i][$gcb_enums{'EDGE'}] = 1;
1335 $gcb_table[$gcb_enums{'EDGE'}][$i] = 1;
1337 $gcb_table[$gcb_enums{'EDGE'}][$gcb_enums{'EDGE'}] = 0;
1339 output_table_common('GCB', \%gcb_actions,
1340 \@gcb_table, \@gcb_short_enums, \%gcb_abbreviations);
1343 sub output_LB_table() {
1345 # Create and output the enums, #defines, and pair table for use in
1346 # determining Line Breaks. This uses the default line break algorithm,
1347 # given in http://www.unicode.org/reports/tr14/, but tailored by example 7
1348 # in that page, as the Unicode-furnished tests assume that tailoring.
1350 # The result is really just true or false. But we follow along with tr14,
1351 # creating a rule which is false for something like X SP* X. That gets
1352 # encoding 2. The rest of the actions are synthetic ones that indicate
1353 # some context handling is required. These each are added to the
1354 # underlying 0, 1, or 2, instead of replacing them, so that the underlying
1355 # value can be retrieved. Actually only rules from 7 through 18 (which
1356 # are the ones where space matter) are possible to have 2 added to them.
1357 # The others below add just 0 or 1. It might be possible for one
1358 # synthetic rule to be added to another, yielding a larger value. This
1359 # doesn't happen in the Unicode 8.0 rule set, and as you can see from the
1360 # names of the middle grouping below, it is impossible for that to occur
1361 # for them because they all start with mutually exclusive classes. That
1362 # the final rule can't be added to any of the others isn't obvious from
1363 # its name, so it is assigned a power of 2 higher than the others can get
1364 # to so any addition would preserve all data. (And the code will reach an
1365 # assert(0) on debugging builds should this happen.)
1369 LB_NOBREAK_EVEN_WITH_SP_BETWEEN => 2,
1371 LB_CM_ZWJ_foo => 3, # Rule 9
1372 LB_SP_foo => 6, # Rule 18
1373 LB_PR_or_PO_then_OP_or_HY => 9, # Rule 25
1374 LB_SY_or_IS_then_various => 11, # Rule 25
1375 LB_HY_or_BA_then_foo => 13, # Rule 21
1376 LB_RI_then_RI => 15, # Rule 30a
1378 LB_various_then_PO_or_PR => (1<<5), # Rule 25
1381 # Construct the LB pair table. This is based on the rules in
1382 # http://www.unicode.org/reports/tr14/, but modified as those rules are
1383 # designed for someone taking a string of text and sequentially going
1384 # through it to find the break opportunities, whereas, Perl requires
1385 # determining if a given random spot is a break opportunity, without
1386 # knowing all the entire string before it.
1388 # The table is constructed in reverse order of the rules, to make the
1389 # lower-numbered, higher priority ones override the later ones, as the
1390 # algorithm stops at the earliest matching rule
1393 my $table_size = @lb_short_enums;
1395 # LB31. Break everywhere else
1396 for my $i (0 .. $table_size - 1) {
1397 for my $j (0 .. $table_size - 1) {
1398 $lb_table[$i][$j] = $lb_actions{'LB_BREAKABLE'};
1402 # LB30b Do not break between an emoji base and an emoji modifier.
1404 $lb_table[$lb_enums{'E_Base'}][$lb_enums{'E_Modifier'}]
1405 = $lb_actions{'LB_NOBREAK'};
1407 # LB30a Break between two regional indicator symbols if and only if there
1408 # are an even number of regional indicators preceding the position of the
1410 # sot (RI RI)* RI × RI
1411 # [^RI] (RI RI)* RI × RI
1412 $lb_table[$lb_enums{'Regional_Indicator'}]
1413 [$lb_enums{'Regional_Indicator'}] = $lb_actions{'LB_RI_then_RI'};
1415 # LB30 Do not break between letters, numbers, or ordinary symbols and
1416 # opening or closing parentheses.
1417 # (AL | HL | NU) × OP
1418 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Open_Punctuation'}]
1419 = $lb_actions{'LB_NOBREAK'};
1420 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Open_Punctuation'}]
1421 = $lb_actions{'LB_NOBREAK'};
1422 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Open_Punctuation'}]
1423 = $lb_actions{'LB_NOBREAK'};
1425 # CP × (AL | HL | NU)
1426 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Alphabetic'}]
1427 = $lb_actions{'LB_NOBREAK'};
1428 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Hebrew_Letter'}]
1429 = $lb_actions{'LB_NOBREAK'};
1430 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Numeric'}]
1431 = $lb_actions{'LB_NOBREAK'};
1433 # LB29 Do not break between numeric punctuation and alphabetics (“e.g.”).
1435 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Alphabetic'}]
1436 = $lb_actions{'LB_NOBREAK'};
1437 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1438 = $lb_actions{'LB_NOBREAK'};
1440 # LB28 Do not break between alphabetics (“at”).
1441 # (AL | HL) × (AL | HL)
1442 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Alphabetic'}]
1443 = $lb_actions{'LB_NOBREAK'};
1444 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Alphabetic'}]
1445 = $lb_actions{'LB_NOBREAK'};
1446 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Hebrew_Letter'}]
1447 = $lb_actions{'LB_NOBREAK'};
1448 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Hebrew_Letter'}]
1449 = $lb_actions{'LB_NOBREAK'};
1451 # LB27 Treat a Korean Syllable Block the same as ID.
1452 # (JL | JV | JT | H2 | H3) × IN
1453 $lb_table[$lb_enums{'JL'}][$lb_enums{'Inseparable'}]
1454 = $lb_actions{'LB_NOBREAK'};
1455 $lb_table[$lb_enums{'JV'}][$lb_enums{'Inseparable'}]
1456 = $lb_actions{'LB_NOBREAK'};
1457 $lb_table[$lb_enums{'JT'}][$lb_enums{'Inseparable'}]
1458 = $lb_actions{'LB_NOBREAK'};
1459 $lb_table[$lb_enums{'H2'}][$lb_enums{'Inseparable'}]
1460 = $lb_actions{'LB_NOBREAK'};
1461 $lb_table[$lb_enums{'H3'}][$lb_enums{'Inseparable'}]
1462 = $lb_actions{'LB_NOBREAK'};
1464 # (JL | JV | JT | H2 | H3) × PO
1465 $lb_table[$lb_enums{'JL'}][$lb_enums{'Postfix_Numeric'}]
1466 = $lb_actions{'LB_NOBREAK'};
1467 $lb_table[$lb_enums{'JV'}][$lb_enums{'Postfix_Numeric'}]
1468 = $lb_actions{'LB_NOBREAK'};
1469 $lb_table[$lb_enums{'JT'}][$lb_enums{'Postfix_Numeric'}]
1470 = $lb_actions{'LB_NOBREAK'};
1471 $lb_table[$lb_enums{'H2'}][$lb_enums{'Postfix_Numeric'}]
1472 = $lb_actions{'LB_NOBREAK'};
1473 $lb_table[$lb_enums{'H3'}][$lb_enums{'Postfix_Numeric'}]
1474 = $lb_actions{'LB_NOBREAK'};
1476 # PR × (JL | JV | JT | H2 | H3)
1477 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JL'}]
1478 = $lb_actions{'LB_NOBREAK'};
1479 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JV'}]
1480 = $lb_actions{'LB_NOBREAK'};
1481 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JT'}]
1482 = $lb_actions{'LB_NOBREAK'};
1483 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H2'}]
1484 = $lb_actions{'LB_NOBREAK'};
1485 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H3'}]
1486 = $lb_actions{'LB_NOBREAK'};
1488 # LB26 Do not break a Korean syllable.
1489 # JL × (JL | JV | H2 | H3)
1490 $lb_table[$lb_enums{'JL'}][$lb_enums{'JL'}] = $lb_actions{'LB_NOBREAK'};
1491 $lb_table[$lb_enums{'JL'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1492 $lb_table[$lb_enums{'JL'}][$lb_enums{'H2'}] = $lb_actions{'LB_NOBREAK'};
1493 $lb_table[$lb_enums{'JL'}][$lb_enums{'H3'}] = $lb_actions{'LB_NOBREAK'};
1495 # (JV | H2) × (JV | JT)
1496 $lb_table[$lb_enums{'JV'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1497 $lb_table[$lb_enums{'H2'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'};
1498 $lb_table[$lb_enums{'JV'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1499 $lb_table[$lb_enums{'H2'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1502 $lb_table[$lb_enums{'JT'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1503 $lb_table[$lb_enums{'H3'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'};
1505 # LB25 Do not break between the following pairs of classes relevant to
1506 # numbers, as tailored by example 7 in
1507 # http://www.unicode.org/reports/tr14/#Examples
1508 # We follow that tailoring because Unicode's test cases expect it
1509 # (PR | PO) × ( OP | HY )? NU
1510 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Numeric'}]
1511 = $lb_actions{'LB_NOBREAK'};
1512 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Numeric'}]
1513 = $lb_actions{'LB_NOBREAK'};
1515 # Given that (OP | HY )? is optional, we have to test for it in code.
1516 # We add in the action (instead of overriding) for this, so that in
1517 # the code we can recover the underlying break value.
1518 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Open_Punctuation'}]
1519 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1520 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Open_Punctuation'}]
1521 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1522 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hyphen'}]
1523 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1524 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hyphen'}]
1525 += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'};
1528 $lb_table[$lb_enums{'Open_Punctuation'}][$lb_enums{'Numeric'}]
1529 = $lb_actions{'LB_NOBREAK'};
1530 $lb_table[$lb_enums{'Hyphen'}][$lb_enums{'Numeric'}]
1531 = $lb_actions{'LB_NOBREAK'};
1533 # NU (NU | SY | IS)* × (NU | SY | IS | CL | CP )
1534 # which can be rewritten as:
1535 # NU (SY | IS)* × (NU | SY | IS | CL | CP )
1536 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Numeric'}]
1537 = $lb_actions{'LB_NOBREAK'};
1538 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Break_Symbols'}]
1539 = $lb_actions{'LB_NOBREAK'};
1540 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Infix_Numeric'}]
1541 = $lb_actions{'LB_NOBREAK'};
1542 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Punctuation'}]
1543 = $lb_actions{'LB_NOBREAK'};
1544 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Parenthesis'}]
1545 = $lb_actions{'LB_NOBREAK'};
1547 # Like earlier where we have to test in code, we add in the action so
1548 # that we can recover the underlying values. This is done in rules
1549 # below, as well. The code assumes that we haven't added 2 actions.
1550 # Shoul a later Unicode release break that assumption, then tests
1551 # should start failing.
1552 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Numeric'}]
1553 += $lb_actions{'LB_SY_or_IS_then_various'};
1554 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Break_Symbols'}]
1555 += $lb_actions{'LB_SY_or_IS_then_various'};
1556 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Infix_Numeric'}]
1557 += $lb_actions{'LB_SY_or_IS_then_various'};
1558 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Punctuation'}]
1559 += $lb_actions{'LB_SY_or_IS_then_various'};
1560 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Parenthesis'}]
1561 += $lb_actions{'LB_SY_or_IS_then_various'};
1562 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Numeric'}]
1563 += $lb_actions{'LB_SY_or_IS_then_various'};
1564 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Break_Symbols'}]
1565 += $lb_actions{'LB_SY_or_IS_then_various'};
1566 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Infix_Numeric'}]
1567 += $lb_actions{'LB_SY_or_IS_then_various'};
1568 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Punctuation'}]
1569 += $lb_actions{'LB_SY_or_IS_then_various'};
1570 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Parenthesis'}]
1571 += $lb_actions{'LB_SY_or_IS_then_various'};
1573 # NU (NU | SY | IS)* (CL | CP)? × (PO | PR)
1574 # which can be rewritten as:
1575 # NU (SY | IS)* (CL | CP)? × (PO | PR)
1576 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Postfix_Numeric'}]
1577 = $lb_actions{'LB_NOBREAK'};
1578 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Prefix_Numeric'}]
1579 = $lb_actions{'LB_NOBREAK'};
1581 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Postfix_Numeric'}]
1582 += $lb_actions{'LB_various_then_PO_or_PR'};
1583 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Postfix_Numeric'}]
1584 += $lb_actions{'LB_various_then_PO_or_PR'};
1585 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Postfix_Numeric'}]
1586 += $lb_actions{'LB_various_then_PO_or_PR'};
1587 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Postfix_Numeric'}]
1588 += $lb_actions{'LB_various_then_PO_or_PR'};
1590 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Prefix_Numeric'}]
1591 += $lb_actions{'LB_various_then_PO_or_PR'};
1592 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Prefix_Numeric'}]
1593 += $lb_actions{'LB_various_then_PO_or_PR'};
1594 $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Prefix_Numeric'}]
1595 += $lb_actions{'LB_various_then_PO_or_PR'};
1596 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Prefix_Numeric'}]
1597 += $lb_actions{'LB_various_then_PO_or_PR'};
1599 # LB24 Do not break between numeric prefix/postfix and letters, or between
1600 # letters and prefix/postfix.
1601 # (PR | PO) × (AL | HL)
1602 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Alphabetic'}]
1603 = $lb_actions{'LB_NOBREAK'};
1604 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1605 = $lb_actions{'LB_NOBREAK'};
1606 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Alphabetic'}]
1607 = $lb_actions{'LB_NOBREAK'};
1608 $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hebrew_Letter'}]
1609 = $lb_actions{'LB_NOBREAK'};
1611 # (AL | HL) × (PR | PO)
1612 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Prefix_Numeric'}]
1613 = $lb_actions{'LB_NOBREAK'};
1614 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Prefix_Numeric'}]
1615 = $lb_actions{'LB_NOBREAK'};
1616 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Postfix_Numeric'}]
1617 = $lb_actions{'LB_NOBREAK'};
1618 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Postfix_Numeric'}]
1619 = $lb_actions{'LB_NOBREAK'};
1621 # LB23a Do not break between numeric prefixes and ideographs, or between
1622 # ideographs and numeric postfixes.
1623 # PR × (ID | EB | EM)
1624 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Ideographic'}]
1625 = $lb_actions{'LB_NOBREAK'};
1626 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Base'}]
1627 = $lb_actions{'LB_NOBREAK'};
1628 $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Modifier'}]
1629 = $lb_actions{'LB_NOBREAK'};
1631 # (ID | EB | EM) × PO
1632 $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Postfix_Numeric'}]
1633 = $lb_actions{'LB_NOBREAK'};
1634 $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Postfix_Numeric'}]
1635 = $lb_actions{'LB_NOBREAK'};
1636 $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Postfix_Numeric'}]
1637 = $lb_actions{'LB_NOBREAK'};
1639 # LB23 Do not break between digits and letters
1641 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Numeric'}]
1642 = $lb_actions{'LB_NOBREAK'};
1643 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Numeric'}]
1644 = $lb_actions{'LB_NOBREAK'};
1647 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Alphabetic'}]
1648 = $lb_actions{'LB_NOBREAK'};
1649 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Hebrew_Letter'}]
1650 = $lb_actions{'LB_NOBREAK'};
1652 # LB22 Do not break between two ellipses, or between letters, numbers or
1653 # exclamations and ellipsis.
1655 $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Inseparable'}]
1656 = $lb_actions{'LB_NOBREAK'};
1657 $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Inseparable'}]
1658 = $lb_actions{'LB_NOBREAK'};
1661 $lb_table[$lb_enums{'Exclamation'}][$lb_enums{'Inseparable'}]
1662 = $lb_actions{'LB_NOBREAK'};
1664 # (ID | EB | EM) × IN
1665 $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Inseparable'}]
1666 = $lb_actions{'LB_NOBREAK'};
1667 $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Inseparable'}]
1668 = $lb_actions{'LB_NOBREAK'};
1669 $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Inseparable'}]
1670 = $lb_actions{'LB_NOBREAK'};
1673 $lb_table[$lb_enums{'Inseparable'}][$lb_enums{'Inseparable'}]
1674 = $lb_actions{'LB_NOBREAK'};
1677 $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Inseparable'}]
1678 = $lb_actions{'LB_NOBREAK'};
1680 # LB21b Don’t break between Solidus and Hebrew letters.
1682 $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Hebrew_Letter'}]
1683 = $lb_actions{'LB_NOBREAK'};
1685 # LB21a Don't break after Hebrew + Hyphen.
1687 for my $i (0 .. @lb_table - 1) {
1688 $lb_table[$lb_enums{'Hyphen'}][$i]
1689 += $lb_actions{'LB_HY_or_BA_then_foo'};
1690 $lb_table[$lb_enums{'Break_After'}][$i]
1691 += $lb_actions{'LB_HY_or_BA_then_foo'};
1694 # LB21 Do not break before hyphen-minus, other hyphens, fixed-width
1695 # spaces, small kana, and other non-starters, or after acute accents.
1700 for my $i (0 .. @lb_table - 1) {
1701 $lb_table[$i][$lb_enums{'Break_After'}] = $lb_actions{'LB_NOBREAK'};
1702 $lb_table[$i][$lb_enums{'Hyphen'}] = $lb_actions{'LB_NOBREAK'};
1703 $lb_table[$i][$lb_enums{'Nonstarter'}] = $lb_actions{'LB_NOBREAK'};
1704 $lb_table[$lb_enums{'Break_Before'}][$i] = $lb_actions{'LB_NOBREAK'};
1707 # LB20 Break before and after unresolved CB.
1710 # Conditional breaks should be resolved external to the line breaking
1711 # rules. However, the default action is to treat unresolved CB as breaking
1713 for my $i (0 .. @lb_table - 1) {
1714 $lb_table[$i][$lb_enums{'Contingent_Break'}]
1715 = $lb_actions{'LB_BREAKABLE'};
1716 $lb_table[$lb_enums{'Contingent_Break'}][$i]
1717 = $lb_actions{'LB_BREAKABLE'};
1720 # LB19 Do not break before or after quotation marks, such as ‘ ” ’.
1723 for my $i (0 .. @lb_table - 1) {
1724 $lb_table[$i][$lb_enums{'Quotation'}] = $lb_actions{'LB_NOBREAK'};
1725 $lb_table[$lb_enums{'Quotation'}][$i] = $lb_actions{'LB_NOBREAK'};
1728 # LB18 Break after spaces
1730 for my $i (0 .. @lb_table - 1) {
1731 $lb_table[$lb_enums{'Space'}][$i] = $lb_actions{'LB_BREAKABLE'};
1734 # LB17 Do not break within ‘——’, even with intervening spaces.
1736 $lb_table[$lb_enums{'Break_Both'}][$lb_enums{'Break_Both'}]
1737 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1739 # LB16 Do not break between closing punctuation and a nonstarter even with
1740 # intervening spaces.
1741 # (CL | CP) SP* × NS
1742 $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Nonstarter'}]
1743 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1744 $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Nonstarter'}]
1745 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1748 # LB15 Do not break within ‘”[’, even with intervening spaces.
1750 $lb_table[$lb_enums{'Quotation'}][$lb_enums{'Open_Punctuation'}]
1751 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1753 # LB14 Do not break after ‘[’, even after spaces.
1755 for my $i (0 .. @lb_table - 1) {
1756 $lb_table[$lb_enums{'Open_Punctuation'}][$i]
1757 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1760 # LB13 Do not break before ‘]’ or ‘!’ or ‘;’ or ‘/’, even after spaces, as
1761 # tailored by example 7 in http://www.unicode.org/reports/tr14/#Examples
1767 for my $i (0 .. @lb_table - 1) {
1768 $lb_table[$i][$lb_enums{'Exclamation'}]
1769 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1771 next if $i == $lb_enums{'Numeric'};
1773 $lb_table[$i][$lb_enums{'Close_Punctuation'}]
1774 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1775 $lb_table[$i][$lb_enums{'Close_Parenthesis'}]
1776 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1777 $lb_table[$i][$lb_enums{'Infix_Numeric'}]
1778 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1779 $lb_table[$i][$lb_enums{'Break_Symbols'}]
1780 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1783 # LB12a Do not break before NBSP and related characters, except after
1784 # spaces and hyphens.
1786 for my $i (0 .. @lb_table - 1) {
1787 next if $i == $lb_enums{'Space'}
1788 || $i == $lb_enums{'Break_After'}
1789 || $i == $lb_enums{'Hyphen'};
1791 # We don't break, but if a property above has said don't break even
1792 # with space between, don't override that (also in the next few rules)
1793 next if $lb_table[$i][$lb_enums{'Glue'}]
1794 == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1795 $lb_table[$i][$lb_enums{'Glue'}] = $lb_actions{'LB_NOBREAK'};
1798 # LB12 Do not break after NBSP and related characters.
1800 for my $i (0 .. @lb_table - 1) {
1801 next if $lb_table[$lb_enums{'Glue'}][$i]
1802 == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1803 $lb_table[$lb_enums{'Glue'}][$i] = $lb_actions{'LB_NOBREAK'};
1806 # LB11 Do not break before or after Word joiner and related characters.
1809 for my $i (0 .. @lb_table - 1) {
1810 if ($lb_table[$i][$lb_enums{'Word_Joiner'}]
1811 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1813 $lb_table[$i][$lb_enums{'Word_Joiner'}] = $lb_actions{'LB_NOBREAK'};
1815 if ($lb_table[$lb_enums{'Word_Joiner'}][$i]
1816 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1818 $lb_table[$lb_enums{'Word_Joiner'}][$i] = $lb_actions{'LB_NOBREAK'};
1822 # Special case this here to avoid having to do a special case in the code,
1823 # by making this the same as other things with a SP in front of them that
1824 # don't break, we avoid an extra test
1825 $lb_table[$lb_enums{'Space'}][$lb_enums{'Word_Joiner'}]
1826 = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'};
1828 # LB9 and LB10 are done in the same loop
1830 # LB9 Do not break a combining character sequence; treat it as if it has
1831 # the line breaking class of the base character in all of the
1832 # higher-numbered rules. Treat ZWJ as if it were CM
1833 # Treat X (CM|ZWJ)* as if it were X.
1834 # where X is any line break class except BK, CR, LF, NL, SP, or ZW.
1836 # LB10 Treat any remaining combining mark or ZWJ as AL. This catches the
1837 # case where a CM or ZWJ is the first character on the line or follows SP,
1838 # BK, CR, LF, NL, or ZW.
1839 for my $i (0 .. @lb_table - 1) {
1841 # When the CM or ZWJ is the first in the pair, we don't know without
1842 # looking behind whether the CM or ZWJ is going to attach to an
1843 # earlier character, or not. So have to figure this out at runtime in
1845 $lb_table[$lb_enums{'Combining_Mark'}][$i]
1846 = $lb_actions{'LB_CM_ZWJ_foo'};
1847 $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_CM_ZWJ_foo'};
1849 if ( $i == $lb_enums{'Mandatory_Break'}
1850 || $i == $lb_enums{'EDGE'}
1851 || $i == $lb_enums{'Carriage_Return'}
1852 || $i == $lb_enums{'Line_Feed'}
1853 || $i == $lb_enums{'Next_Line'}
1854 || $i == $lb_enums{'Space'}
1855 || $i == $lb_enums{'ZWSpace'})
1857 # For these classes, a following CM doesn't combine, and should do
1858 # whatever 'Alphabetic' would do.
1859 $lb_table[$i][$lb_enums{'Combining_Mark'}]
1860 = $lb_table[$i][$lb_enums{'Alphabetic'}];
1861 $lb_table[$i][$lb_enums{'ZWJ'}]
1862 = $lb_table[$i][$lb_enums{'Alphabetic'}];
1865 # For these classes, the CM or ZWJ combines, so doesn't break,
1866 # inheriting the type of nobreak from the master character.
1867 if ($lb_table[$i][$lb_enums{'Combining_Mark'}]
1868 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1870 $lb_table[$i][$lb_enums{'Combining_Mark'}]
1871 = $lb_actions{'LB_NOBREAK'};
1873 if ($lb_table[$i][$lb_enums{'ZWJ'}]
1874 != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'})
1876 $lb_table[$i][$lb_enums{'ZWJ'}]
1877 = $lb_actions{'LB_NOBREAK'};
1882 # LB8a Do not break after a zero width joiner
1884 for my $i (0 .. @lb_table - 1) {
1885 $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_NOBREAK'};
1888 # LB8 Break before any character following a zero-width space, even if one
1889 # or more spaces intervene.
1891 for my $i (0 .. @lb_table - 1) {
1892 $lb_table[$lb_enums{'ZWSpace'}][$i] = $lb_actions{'LB_BREAKABLE'};
1895 # Because of LB8-10, we need to look at context for "SP x", and this must
1896 # be done in the code. So override the existing rules for that, by adding
1897 # a constant to get new rules that tell the code it needs to look at
1898 # context. By adding this action instead of replacing the existing one,
1899 # we can get back to the original rule if necessary.
1900 for my $i (0 .. @lb_table - 1) {
1901 $lb_table[$lb_enums{'Space'}][$i] += $lb_actions{'LB_SP_foo'};
1904 # LB7 Do not break before spaces or zero width space.
1907 for my $i (0 .. @lb_table - 1) {
1908 $lb_table[$i][$lb_enums{'Space'}] = $lb_actions{'LB_NOBREAK'};
1909 $lb_table[$i][$lb_enums{'ZWSpace'}] = $lb_actions{'LB_NOBREAK'};
1912 # LB6 Do not break before hard line breaks.
1913 # × ( BK | CR | LF | NL )
1914 for my $i (0 .. @lb_table - 1) {
1915 $lb_table[$i][$lb_enums{'Mandatory_Break'}] = $lb_actions{'LB_NOBREAK'};
1916 $lb_table[$i][$lb_enums{'Carriage_Return'}] = $lb_actions{'LB_NOBREAK'};
1917 $lb_table[$i][$lb_enums{'Line_Feed'}] = $lb_actions{'LB_NOBREAK'};
1918 $lb_table[$i][$lb_enums{'Next_Line'}] = $lb_actions{'LB_NOBREAK'};
1921 # LB5 Treat CR followed by LF, as well as CR, LF, and NL as hard line breaks.
1926 for my $i (0 .. @lb_table - 1) {
1927 $lb_table[$lb_enums{'Carriage_Return'}][$i]
1928 = $lb_actions{'LB_BREAKABLE'};
1929 $lb_table[$lb_enums{'Line_Feed'}][$i] = $lb_actions{'LB_BREAKABLE'};
1930 $lb_table[$lb_enums{'Next_Line'}][$i] = $lb_actions{'LB_BREAKABLE'};
1932 $lb_table[$lb_enums{'Carriage_Return'}][$lb_enums{'Line_Feed'}]
1933 = $lb_actions{'LB_NOBREAK'};
1935 # LB4 Always break after hard line breaks.
1937 for my $i (0 .. @lb_table - 1) {
1938 $lb_table[$lb_enums{'Mandatory_Break'}][$i]
1939 = $lb_actions{'LB_BREAKABLE'};
1942 # LB3 Always break at the end of text.
1944 # LB2 Never break at the start of text.
1946 for my $i (0 .. @lb_table - 1) {
1947 $lb_table[$i][$lb_enums{'EDGE'}] = $lb_actions{'LB_BREAKABLE'};
1948 $lb_table[$lb_enums{'EDGE'}][$i] = $lb_actions{'LB_NOBREAK'};
1951 # LB1 Assign a line breaking class to each code point of the input.
1952 # Resolve AI, CB, CJ, SA, SG, and XX into other line breaking classes
1953 # depending on criteria outside the scope of this algorithm.
1955 # In the absence of such criteria all characters with a specific
1956 # combination of original class and General_Category property value are
1957 # resolved as follows:
1958 # Original Resolved General_Category
1960 # SA CM Only Mn or Mc
1961 # SA AL Any except Mn and Mc
1964 # This is done in mktables, so we never see any of the remapped-from
1967 output_table_common('LB', \%lb_actions,
1968 \@lb_table, \@lb_short_enums, \%lb_abbreviations);
1971 sub output_WB_table() {
1973 # Create and output the enums, #defines, and pair table for use in
1974 # determining Word Breaks, given in http://www.unicode.org/reports/tr29/.
1976 # This uses the same mechanism in the other bounds tables generated by
1977 # this file. The actions that could override a 0 or 1 are added to those
1978 # numbers; the actions that clearly don't depend on the underlying rule
1984 WB_Ex_or_FO_or_ZWJ_then_foo => 3,
1987 WB_LE_or_HL_then_MB_or_ML_or_SQ => 8,
1988 WB_MB_or_ML_or_SQ_then_LE_or_HL => 10,
1989 WB_MB_or_MN_or_SQ_then_NU => 12,
1990 WB_NU_then_MB_or_MN_or_SQ => 14,
1991 WB_RI_then_RI => 16,
1994 # Construct the WB pair table.
1995 # The table is constructed in reverse order of the rules, to make the
1996 # lower-numbered, higher priority ones override the later ones, as the
1997 # algorithm stops at the earliest matching rule
2000 my $table_size = @wb_short_enums;
2002 # Otherwise, break everywhere (including around ideographs).
2004 for my $i (0 .. $table_size - 1) {
2005 for my $j (0 .. $table_size - 1) {
2006 $wb_table[$i][$j] = $wb_actions{'WB_BREAKABLE'};
2010 # Do not break within emoji flag sequences. That is, do not break between
2011 # regional indicator (RI) symbols if there is an odd number of RI
2012 # characters before the break point.
2013 # WB16 [^RI] (RI RI)* RI × RI
2014 # WB15 sot (RI RI)* RI × RI
2015 $wb_table[$wb_enums{'Regional_Indicator'}]
2016 [$wb_enums{'Regional_Indicator'}] = $wb_actions{'WB_RI_then_RI'};
2018 # Do not break within emoji modifier sequences.
2019 # WB14 ( E_Base | EBG ) × E_Modifier
2020 $wb_table[$wb_enums{'E_Base'}][$wb_enums{'E_Modifier'}]
2021 = $wb_actions{'WB_NOBREAK'};
2022 $wb_table[$wb_enums{'E_Base_GAZ'}][$wb_enums{'E_Modifier'}]
2023 = $wb_actions{'WB_NOBREAK'};
2025 # Do not break from extenders.
2026 # WB13b ExtendNumLet × (ALetter | Hebrew_Letter | Numeric | Katakana)
2027 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ALetter'}]
2028 = $wb_actions{'WB_NOBREAK'};
2029 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'XPG_LE'}]
2030 = $wb_actions{'WB_NOBREAK'};
2031 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Hebrew_Letter'}]
2032 = $wb_actions{'WB_NOBREAK'};
2033 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Numeric'}]
2034 = $wb_actions{'WB_NOBREAK'};
2035 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Katakana'}]
2036 = $wb_actions{'WB_NOBREAK'};
2038 # WB13a (ALetter | Hebrew_Letter | Numeric | Katakana | ExtendNumLet)
2040 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ExtendNumLet'}]
2041 = $wb_actions{'WB_NOBREAK'};
2042 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'ExtendNumLet'}]
2043 = $wb_actions{'WB_NOBREAK'};
2044 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtendNumLet'}]
2045 = $wb_actions{'WB_NOBREAK'};
2046 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtendNumLet'}]
2047 = $wb_actions{'WB_NOBREAK'};
2048 $wb_table[$wb_enums{'Katakana'}][$wb_enums{'ExtendNumLet'}]
2049 = $wb_actions{'WB_NOBREAK'};
2050 $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtendNumLet'}]
2051 = $wb_actions{'WB_NOBREAK'};
2053 # Do not break between Katakana.
2054 # WB13 Katakana × Katakana
2055 $wb_table[$wb_enums{'Katakana'}][$wb_enums{'Katakana'}]
2056 = $wb_actions{'WB_NOBREAK'};
2058 # Do not break within sequences, such as “3.2” or “3,456.789”.
2059 # WB12 Numeric × (MidNum | MidNumLet | Single_Quote) Numeric
2060 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNumLet'}]
2061 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2062 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNum'}]
2063 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2064 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Single_Quote'}]
2065 += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'};
2067 # WB11 Numeric (MidNum | (MidNumLet | Single_Quote)) × Numeric
2068 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Numeric'}]
2069 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2070 $wb_table[$wb_enums{'MidNum'}][$wb_enums{'Numeric'}]
2071 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2072 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Numeric'}]
2073 += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'};
2075 # Do not break within sequences of digits, or digits adjacent to letters
2077 # WB10 Numeric × (ALetter | Hebrew_Letter)
2078 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ALetter'}]
2079 = $wb_actions{'WB_NOBREAK'};
2080 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'XPG_LE'}]
2081 = $wb_actions{'WB_NOBREAK'};
2082 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Hebrew_Letter'}]
2083 = $wb_actions{'WB_NOBREAK'};
2085 # WB9 (ALetter | Hebrew_Letter) × Numeric
2086 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Numeric'}]
2087 = $wb_actions{'WB_NOBREAK'};
2088 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'Numeric'}]
2089 = $wb_actions{'WB_NOBREAK'};
2090 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Numeric'}]
2091 = $wb_actions{'WB_NOBREAK'};
2093 # WB8 Numeric × Numeric
2094 $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Numeric'}]
2095 = $wb_actions{'WB_NOBREAK'};
2097 # Do not break letters across certain punctuation.
2098 # WB7c Hebrew_Letter Double_Quote × Hebrew_Letter
2099 $wb_table[$wb_enums{'Double_Quote'}][$wb_enums{'Hebrew_Letter'}]
2100 += $wb_actions{'WB_DQ_then_HL'};
2102 # WB7b Hebrew_Letter × Double_Quote Hebrew_Letter
2103 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Double_Quote'}]
2104 += $wb_actions{'WB_HL_then_DQ'};
2106 # WB7a Hebrew_Letter × Single_Quote
2107 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}]
2108 = $wb_actions{'WB_NOBREAK'};
2110 # WB7 (ALetter | Hebrew_Letter) (MidLetter | MidNumLet | Single_Quote)
2111 # × (ALetter | Hebrew_Letter)
2112 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ALetter'}]
2113 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2114 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'XPG_LE'}]
2115 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2116 $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Hebrew_Letter'}]
2117 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2118 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ALetter'}]
2119 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2120 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'XPG_LE'}]
2121 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2122 $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'Hebrew_Letter'}]
2123 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2124 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ALetter'}]
2125 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2126 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'XPG_LE'}]
2127 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2128 $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Hebrew_Letter'}]
2129 += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'};
2131 # WB6 (ALetter | Hebrew_Letter) × (MidLetter | MidNumLet
2132 # | Single_Quote) (ALetter | Hebrew_Letter)
2133 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidNumLet'}]
2134 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2135 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'MidNumLet'}]
2136 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2137 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidNumLet'}]
2138 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2139 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidLetter'}]
2140 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2141 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'MidLetter'}]
2142 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2143 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidLetter'}]
2144 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2145 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Single_Quote'}]
2146 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2147 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'Single_Quote'}]
2148 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2149 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}]
2150 += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'};
2152 # Do not break between most letters.
2153 # WB5 (ALetter | Hebrew_Letter) × (ALetter | Hebrew_Letter)
2154 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ALetter'}]
2155 = $wb_actions{'WB_NOBREAK'};
2156 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'ALetter'}]
2157 = $wb_actions{'WB_NOBREAK'};
2158 $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Hebrew_Letter'}]
2159 = $wb_actions{'WB_NOBREAK'};
2160 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'Hebrew_Letter'}]
2161 = $wb_actions{'WB_NOBREAK'};
2162 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ALetter'}]
2163 = $wb_actions{'WB_NOBREAK'};
2164 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'XPG_LE'}]
2165 = $wb_actions{'WB_NOBREAK'};
2166 $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Hebrew_Letter'}]
2167 = $wb_actions{'WB_NOBREAK'};
2168 $wb_table[$wb_enums{'XPG_LE'}][$wb_enums{'XPG_LE'}]
2169 = $wb_actions{'WB_NOBREAK'};
2171 # Ignore Format and Extend characters, except after sot, CR, LF, and
2172 # Newline. This also has the effect of: Any × (Format | Extend | ZWJ)
2173 # WB4 X (Extend | Format | ZWJ)* → X
2174 for my $i (0 .. @wb_table - 1) {
2175 $wb_table[$wb_enums{'Extend'}][$i]
2176 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2177 $wb_table[$wb_enums{'Format'}][$i]
2178 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2179 $wb_table[$wb_enums{'ZWJ'}][$i]
2180 = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'};
2182 for my $i (0 .. @wb_table - 1) {
2183 $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'};
2184 $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'};
2185 $wb_table[$i][$wb_enums{'ZWJ'}] = $wb_actions{'WB_NOBREAK'};
2188 # Implied is that these attach to the character before them, except for
2189 # the characters that mark the end of a region of text. The rules below
2190 # override the ones set up here, for all the characters that need
2192 for my $i (0 .. @wb_table - 1) {
2193 $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'};
2194 $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'};
2197 # Keep horizontal whitespace together
2198 # Use perl's tailoring instead
2199 # WB3d WSegSpace × WSegSpace
2200 #$wb_table[$wb_enums{'WSegSpace'}][$wb_enums{'WSegSpace'}]
2201 # = $wb_actions{'WB_NOBREAK'};
2203 # Do not break within emoji zwj sequences.
2204 # WB3c ZWJ × ( Glue_After_Zwj | EBG )
2205 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'Glue_After_Zwj'}]
2206 = $wb_actions{'WB_NOBREAK'};
2207 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'E_Base_GAZ'}]
2208 = $wb_actions{'WB_NOBREAK'};
2209 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'XPG_XX'}]
2210 = $wb_actions{'WB_NOBREAK'};
2211 $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'XPG_LE'}]
2212 = $wb_actions{'WB_NOBREAK'};
2214 # Break before and after newlines
2215 # WB3b ÷ (Newline | CR | LF)
2216 # WB3a (Newline | CR | LF) ÷
2218 for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2219 for my $j (0 .. @wb_table - 1) {
2220 $wb_table[$j][$wb_enums{$i}] = $wb_actions{'WB_BREAKABLE'};
2221 $wb_table[$wb_enums{$i}][$j] = $wb_actions{'WB_BREAKABLE'};
2225 # But do not break within white space.
2228 for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2229 for my $j ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') {
2230 $wb_table[$wb_enums{$i}][$wb_enums{$j}] = $wb_actions{'WB_NOBREAK'};
2234 # And do not break horizontal space followed by Extend or Format or ZWJ
2235 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Extend'}]
2236 = $wb_actions{'WB_NOBREAK'};
2237 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Format'}]
2238 = $wb_actions{'WB_NOBREAK'};
2239 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'ZWJ'}]
2240 = $wb_actions{'WB_NOBREAK'};
2241 $wb_table[$wb_enums{'Perl_Tailored_HSpace'}]
2242 [$wb_enums{'Perl_Tailored_HSpace'}]
2243 = $wb_actions{'WB_hs_then_hs'};
2245 # Break at the start and end of text, unless the text is empty
2248 for my $i (0 .. @wb_table - 1) {
2249 $wb_table[$i][$wb_enums{'EDGE'}] = $wb_actions{'WB_BREAKABLE'};
2250 $wb_table[$wb_enums{'EDGE'}][$i] = $wb_actions{'WB_BREAKABLE'};
2252 $wb_table[$wb_enums{'EDGE'}][$wb_enums{'EDGE'}] = 0;
2254 output_table_common('WB', \%wb_actions,
2255 \@wb_table, \@wb_short_enums, \%wb_abbreviations);
2258 sub sanitize_name ($) {
2259 # Change the non-word characters in the input string to standardized word
2262 my $sanitized = shift;
2263 $sanitized =~ s/=/__/;
2264 $sanitized =~ s/&/_AMP_/;
2265 $sanitized =~ s/\./_DOT_/;
2266 $sanitized =~ s/-/_MINUS_/;
2267 $sanitized =~ s!/!_SLASH_!;
2272 switch_pound_if ('ALL', 'PERL_IN_REGCOMP_C');
2274 output_invlist("Latin1", [ 0, 256 ]);
2275 output_invlist("AboveLatin1", [ 256 ]);
2279 # We construct lists for all the POSIX and backslash sequence character
2280 # classes in two forms:
2281 # 1) ones which match only in the ASCII range
2282 # 2) ones which match either in the Latin1 range, or the entire Unicode range
2284 # These get compiled in, and hence affect the memory footprint of every Perl
2285 # program, even those not using Unicode. To minimize the size, currently
2286 # the Latin1 version is generated for the beyond ASCII range except for those
2287 # lists that are quite small for the entire range, such as for \s, which is 22
2288 # UVs long plus 4 UVs (currently) for the header.
2290 # To save even more memory, the ASCII versions could be derived from the
2291 # larger ones at runtime, saving some memory (minus the expense of the machine
2292 # instructions to do so), but these are all small anyway, so their total is
2295 # In the list of properties below that get generated, the L1 prefix is a fake
2296 # property that means just the Latin1 range of the full property (whose name
2297 # has an X prefix instead of L1).
2299 # An initial & means to use the subroutine from this file instead of an
2300 # official inversion list.
2302 # Below is the list of property names to generate. '&' means to use the
2303 # subroutine to generate the inversion list instead of the generic code
2304 # below. Some properties have a comma-separated list after the name,
2305 # These are extra enums to add to those found in the Unicode tables.
2307 # Ignore non-alpha in sort
2309 push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
2311 _Perl_GCB,EDGE,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,XPG_XX
2312 _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
2313 _Perl_SB,EDGE,SContinue,CR,Extend,LF
2314 _Perl_WB,Perl_Tailored_HSpace,EDGE,UNKNOWN,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,XPG_XX,XPG_LE
2315 _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
2323 # NOTE that the convention is that extra enum values come
2324 # after the property name, separated by commas, with the enums
2325 # that aren't ever defined by Unicode coming last, at least 4
2326 # all-uppercase characters. The others are enum names that
2327 # are needed by perl, but aren't in all Unicode releases.
2330 my @perl_prop_synonyms;
2332 my @deprecated_messages = ""; # Element [0] is a placeholder
2333 my %deprecated_tags;
2335 my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x;
2337 # Create another hash that maps floating point x.yyEzz representation to what
2338 # %stricter_to_file_of does for the equivalent rational. A typical entry in
2339 # the latter hash is
2341 # 'nv=1/2' => 'Nv/1_2',
2343 # From that, this loop creates an entry
2345 # 'nv=5.00e-01' => 'Nv/1_2',
2347 # %stricter_to_file_of contains far more than just the rationals. Instead we
2348 # use %utf8::nv_floating_to_rational which should have an entry for each
2349 # nv in the former hash.
2350 my %floating_to_file_of;
2351 foreach my $key (keys %utf8::nv_floating_to_rational) {
2352 my $value = $utf8::nv_floating_to_rational{$key};
2353 $floating_to_file_of{$key} = $utf8::stricter_to_file_of{"nv=$value"};
2356 # Collect all the binary properties from data in lib/unicore
2357 # Sort so that complements come after the main table, and the shortest
2358 # names first, finally alphabetically. Also, sort together the tables we want
2359 # to be kept together, and prefer those with 'posix' in their names, which is
2360 # what the C code is expecting their names to be.
2361 foreach my $property (sort
2362 { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
2363 or $b =~ /posix/i <=> $a =~ /posix/i
2364 or $b =~ /perl/i <=> $a =~ /perl/i
2365 or $a =~ $float_e_format <=> $b =~ $float_e_format
2366 or $a =~ /!/ <=> $b =~ /!/
2367 or length $a <=> length $b
2369 } keys %utf8::loose_to_file_of,
2370 keys %utf8::stricter_to_file_of,
2371 keys %floating_to_file_of
2374 # These two hashes map properties to values that can be considered to
2375 # be checksums. If two properties have the same checksum, they have
2376 # identical entries. Otherwise they differ in some way.
2377 my $tag = $utf8::loose_to_file_of{$property};
2378 $tag = $utf8::stricter_to_file_of{$property} unless defined $tag;
2379 $tag = $floating_to_file_of{$property} unless defined $tag;
2381 # The tag may contain an '!' meaning it is identical to the one formed
2382 # by removing the !, except that it is inverted.
2383 my $inverted = $tag =~ s/!//;
2385 # This hash is lacking the property name
2386 $property = "nv=$property" if $property =~ $float_e_format;
2388 # The list of 'prop=value' entries that this single entry expands to
2391 # Split 'property=value' on the equals sign, with $lhs being the whole
2392 # thing if there is no '='
2393 my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x;
2395 # $lhs then becomes the property name. See if there are any synonyms
2396 # for this property.
2397 if (exists $prop_name_aliases{$lhs}) {
2399 # If so, do the combinatorics so that a new entry is added for
2400 # each legal property combined with the property value (which is
2402 foreach my $alias (@{$prop_name_aliases{$lhs}}) {
2404 # But, there are some ambiguities, like 'script' is a synonym
2405 # for 'sc', and 'sc' can stand alone, meaning something
2406 # entirely different than 'script'. 'script' cannot stand
2407 # alone. Don't add if the potential new lhs is in the hash of
2408 # stand-alone properties.
2410 next if $rhs eq "" && grep { $alias eq $_ }
2411 keys %utf8::loose_property_to_file_of;
2413 my $new_entry = $alias . $rhs;
2414 push @this_entries, $new_entry;
2418 # Above, we added the synonyms for the base entry we're now
2419 # processing. But we haven't dealt with it yet. If we already have a
2420 # property with the identical characteristics, this becomes just a
2422 if (exists $enums{$tag}) {
2423 push @this_entries, $property;
2425 else { # Otherwise, create a new entry.
2427 # Add to the list of properties to generate inversion lists for.
2428 push @bin_props, uc $property;
2430 # Create a rule for the parser
2431 if (! exists $keywords{$property}) {
2432 $keywords{$property} = token_name($property);
2435 # And create an enum for it.
2436 $enums{$tag} = $table_name_prefix . uc sanitize_name($property);
2438 $perl_tags{$tag} = 1 if exists $keep_together{lc $property};
2440 # Some properties are deprecated. This hash tells us so, and the
2441 # warning message to raise if they are used.
2442 if (exists $utf8::why_deprecated{$tag}) {
2443 $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages;
2444 push @deprecated_messages, $utf8::why_deprecated{$tag};
2447 # Our sort above should have made sure that we see the
2448 # non-inverted version first, but this makes sure.
2449 warn "$property is inverted!!!" if $inverted;
2452 # Everything else is #defined to be the base enum, inversion is
2453 # indicated by negating the value.
2454 my $defined_to = "";
2455 $defined_to .= "-" if $inverted;
2456 $defined_to .= $enums{$tag};
2458 # Go through the entries that evaluate to this.
2459 @this_entries = uniques @this_entries;
2460 foreach my $define (@this_entries) {
2462 # There is a rule for the parser for each.
2463 $keywords{$define} = $defined_to;
2465 # And a #define for all simple names equivalent to a perl property,
2466 # except those that begin with 'is' or 'in';
2467 if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) {
2468 push @perl_prop_synonyms, "#define "
2469 . $table_name_prefix
2470 . uc(sanitize_name($define))
2476 @bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
2479 @perl_prop_synonyms = sort(uniques(@perl_prop_synonyms));
2480 push @props, @bin_props;
2482 foreach my $prop (@props) {
2484 # For the Latin1 properties, we change to use the eXtended version of the
2485 # base property, then go through the result and get rid of everything not
2486 # in Latin1 (above 255). Actually, we retain the element for the range
2487 # that crosses the 255/256 boundary if it is one that matches the
2488 # property. For example, in the Word property, there is a range of code
2489 # points that start at U+00F8 and goes through U+02C1. Instead of
2490 # artificially cutting that off at 256 because 256 is the first code point
2491 # above Latin1, we let the range go to its natural ending. That gives us
2492 # extra information with no added space taken. But if the range that
2493 # crosses the boundary is one that doesn't match the property, we don't
2494 # start a new range above 255, as that could be construed as going to
2495 # infinity. For example, the Upper property doesn't include the character
2496 # at 255, but does include the one at 256. We don't include the 256 one.
2497 my $prop_name = $prop;
2498 my $is_local_sub = $prop_name =~ s/^&//;
2499 my $extra_enums = "";
2500 $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
2501 my $lookup_prop = $prop_name;
2502 $prop_name = sanitize_name($prop_name);
2503 $prop_name = $table_name_prefix . $prop_name if grep { lc $lookup_prop eq lc $_ } @bin_props;
2504 my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
2505 or $lookup_prop =~ s/^L1//);
2507 $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
2508 ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;
2510 for my $charset (get_supported_code_pages()) {
2511 @a2n = @{get_a2n($charset)};
2517 my $maps_to_code_point;
2519 my $same_in_all_code_pages;
2520 if ($is_local_sub) {
2521 my @return = eval $lookup_prop;
2523 my $invlist_ref = shift @return;
2524 @invlist = @$invlist_ref;
2525 if (@return) { # If has other values returned , must be an
2527 my $invmap_ref = shift @return;
2528 @invmap = @$invmap_ref;
2529 $map_format = shift @return;
2530 $map_default = shift @return;
2534 @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok');
2537 # If couldn't find a non-empty inversion list, see if it is
2538 # instead an inversion map
2539 my ($list_ref, $map_ref, $format, $default)
2540 = prop_invmap($lookup_prop, '_perl_core_internal_ok');
2542 # An empty return here could mean an unknown property, or
2543 # merely that the original inversion list is empty. Call
2544 # in scalar context to differentiate
2545 my $count = prop_invlist($lookup_prop,
2546 '_perl_core_internal_ok');
2547 if (defined $count) {
2548 # Short-circuit an empty inversion list.
2549 output_invlist($prop_name, \@invlist, $charset);
2552 die "Could not find inversion list for '$lookup_prop'"
2555 @invlist = @$list_ref;
2556 @invmap = @$map_ref;
2557 $map_format = $format;
2558 $map_default = $default;
2559 $maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x;
2560 $to_adjust = $map_format =~ /a/;
2565 # Re-order the Unicode code points to native ones for this platform.
2566 # This is only needed for code points below 256, because native code
2567 # points are only in that range. For inversion maps of properties
2568 # where the mappings are adjusted (format =~ /a/), this reordering
2569 # could mess up the adjustment pattern that was in the input, so that
2570 # has to be dealt with.
2572 # And inversion maps that map to code points need to eventually have
2573 # all those code points remapped to native, and it's better to do that
2574 # here, going through the whole list not just those below 256. This
2575 # is because some inversion maps have adjustments (format =~ /a/)
2576 # which may be affected by the reordering. This code needs to be done
2577 # both for when we are translating the inversion lists for < 256, and
2578 # for the inversion maps for everything. By doing both in this loop,
2579 # we can share that code.
2581 # So, we go through everything for an inversion map to code points;
2582 # otherwise, we can skip any remapping at all if we are going to
2583 # output only the above-Latin1 values, or if the range spans the whole
2584 # of 0..256, as the remap will also include all of 0..256 (256 not
2585 # 255 because a re-ordering could cause 256 to need to be in the same
2587 if ( (@invmap && $maps_to_code_point)
2589 && $invlist[0] < 256
2590 && ( $invlist[0] != 0
2591 || (scalar @invlist != 1 && $invlist[1] < 256))))
2593 $same_in_all_code_pages = 0;
2594 if (! @invmap) { # Straight inversion list
2595 # Look at all the ranges that start before 257.
2598 last if $invlist[0] > 256;
2599 my $upper = @invlist > 1
2600 ? $invlist[1] - 1 # In range
2602 # To infinity. You may want to stop much much
2603 # earlier; going this high may expose perl
2604 # deficiencies with very large numbers.
2606 for my $j ($invlist[0] .. $upper) {
2607 push @latin1_list, a2n($j);
2610 shift @invlist; # Shift off the range that's in the list
2611 shift @invlist; # Shift off the range not in the list
2614 # Here @invlist contains all the ranges in the original that
2615 # start at code points above 256, and @latin1_list contains
2616 # all the native code points for ranges that start with a
2617 # Unicode code point below 257. We sort the latter and
2618 # convert it to inversion list format. Then simply prepend it
2619 # to the list of the higher code points.
2620 @latin1_list = sort { $a <=> $b } @latin1_list;
2621 @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list);
2622 unshift @invlist, @latin1_list;
2624 else { # Is an inversion map
2626 # This is a similar procedure as plain inversion list, but has
2627 # multiple buckets. A plain inversion list just has two
2628 # buckets, 1) 'in' the list; and 2) 'not' in the list, and we
2629 # pretty much can ignore the 2nd bucket, as it is completely
2630 # defined by the 1st. But here, what we do is create buckets
2631 # which contain the code points that map to each, translated
2632 # to native and turned into an inversion list. Thus each
2633 # bucket is an inversion list of native code points that map
2634 # to it or don't map to it. We use these to create an
2635 # inversion map for the whole property.
2637 # As mentioned earlier, we use this procedure to not just
2638 # remap the inversion list to native values, but also the maps
2639 # of code points to native ones. In the latter case we have
2640 # to look at the whole of the inversion map (or at least to
2641 # above Unicode; as the maps of code points above that should
2642 # all be to the default).
2643 my $upper_limit = (! $maps_to_code_point)
2645 : (Unicode::UCD::UnicodeVersion() eq '1.1.5')
2649 my %mapped_lists; # A hash whose keys are the buckets.
2651 last if $invlist[0] > $upper_limit;
2653 # This shouldn't actually happen, as prop_invmap() returns
2654 # an extra element at the end that is beyond $upper_limit
2655 die "inversion map (for $prop_name) that extends to infinity is unimplemented" unless @invlist > 1;
2659 # A hash key can't be a ref (we are only expecting arrays
2660 # of scalars here), so convert any such to a string that
2661 # will be converted back later (using a vertical tab as
2663 if (ref $invmap[0]) {
2664 $bucket = join "\cK", map { a2n($_) } @{$invmap[0]};
2666 elsif ($maps_to_code_point && $invmap[0] =~ $numeric_re) {
2668 # Do convert to native for maps to single code points.
2669 # There are some properties that have a few outlier
2670 # maps that aren't code points, so the above test
2672 $bucket = a2n($invmap[0]);
2674 $bucket = $invmap[0];
2677 # We now have the bucket that all code points in the range
2678 # map to, though possibly they need to be adjusted. Go
2679 # through the range and put each translated code point in
2680 # it into its bucket.
2681 my $base_map = $invmap[0];
2682 for my $j ($invlist[0] .. $invlist[1] - 1) {
2684 # The 1st code point doesn't need adjusting
2687 # Skip any non-numeric maps: these are outliers
2688 # that aren't code points.
2689 && $base_map =~ $numeric_re
2691 # 'ne' because the default can be a string
2692 && $base_map ne $map_default)
2694 # We adjust, by incrementing each the bucket and
2695 # the map. For code point maps, translate to
2698 $bucket = ($maps_to_code_point)
2703 # Add the native code point to the bucket for the
2705 push @{$mapped_lists{$bucket}}, a2n($j);
2706 } # End of loop through all code points in the range
2708 # Get ready for the next range
2711 } # End of loop through all ranges in the map.
2713 # Here, @invlist and @invmap retain all the ranges from the
2714 # originals that start with code points above $upper_limit.
2715 # Each bucket in %mapped_lists contains all the code points
2716 # that map to that bucket. If the bucket is for a map to a
2717 # single code point, the bucket has been converted to native.
2718 # If something else (including multiple code points), no
2719 # conversion is done.
2721 # Now we recreate the inversion map into %xlated, but this
2722 # time for the native character set.
2724 foreach my $bucket (keys %mapped_lists) {
2726 # Sort and convert this bucket to an inversion list. The
2727 # result will be that ranges that start with even-numbered
2728 # indexes will be for code points that map to this bucket;
2729 # odd ones map to some other bucket, and are discarded
2731 @{$mapped_lists{$bucket}}
2732 = sort{ $a <=> $b} @{$mapped_lists{$bucket}};
2733 @{$mapped_lists{$bucket}}
2734 = mk_invlist_from_sorted_cp_list(\@{$mapped_lists{$bucket}});
2736 # Add each even-numbered range in the bucket to %xlated;
2737 # so that the keys of %xlated become the range start code
2738 # points, and the values are their corresponding maps.
2739 while (@{$mapped_lists{$bucket}}) {
2740 my $range_start = $mapped_lists{$bucket}->[0];
2741 if ($bucket =~ /\cK/) {
2742 @{$xlated{$range_start}} = split /\cK/, $bucket;
2745 # If adjusting, and there is more than one thing
2746 # that maps to the same thing, they must be split
2747 # so that later the adjusting doesn't think the
2748 # subsequent items can go away because of the
2750 my $range_end = ($to_adjust && $bucket != $map_default)
2751 ? $mapped_lists{$bucket}->[1] - 1
2753 for my $i ($range_start .. $range_end) {
2754 $xlated{$i} = $bucket;
2757 shift @{$mapped_lists{$bucket}}; # Discard odd ranges
2758 shift @{$mapped_lists{$bucket}}; # Get ready for next
2761 } # End of loop through all the buckets.
2763 # Here %xlated's keys are the range starts of all the code
2764 # points in the inversion map. Construct an inversion list
2766 my @new_invlist = sort { $a <=> $b } keys %xlated;
2768 # If the list is adjusted, we want to munge this list so that
2769 # we only have one entry for where consecutive code points map
2770 # to consecutive values. We just skip the subsequent entries
2771 # where this is the case.
2774 for my $i (0 .. @new_invlist - 1) {
2776 && $new_invlist[$i-1] + 1 == $new_invlist[$i]
2777 && $xlated{$new_invlist[$i-1]} =~ $numeric_re
2778 && $xlated{$new_invlist[$i]} =~ $numeric_re
2779 && $xlated{$new_invlist[$i-1]} + 1 == $xlated{$new_invlist[$i]};
2780 push @temp, $new_invlist[$i];
2782 @new_invlist = @temp;
2785 # The inversion map comes from %xlated's values. We can
2786 # unshift each onto the front of the untouched portion, in
2787 # reverse order of the portion we did process.
2788 foreach my $start (reverse @new_invlist) {
2789 unshift @invmap, $xlated{$start};
2792 # Finally prepend the inversion list we have just constructed to the
2793 # one that contains anything we didn't process.
2794 unshift @invlist, @new_invlist;
2797 elsif (@invmap) { # inversion maps can't cope with this variable
2798 # being true, even if it could be true
2799 $same_in_all_code_pages = 0;
2802 $same_in_all_code_pages = 1;
2805 # prop_invmap() returns an extra final entry, which we can now
2813 die "Unimplemented to do a Latin-1 only inversion map" if @invmap;
2814 for my $i (0 .. @invlist - 1 - 1) {
2815 if ($invlist[$i] > 255) {
2817 # In an inversion list, even-numbered elements give the code
2818 # points that begin ranges that match the property;
2819 # odd-numbered give ones that begin ranges that don't match.
2820 # If $i is odd, we are at the first code point above 255 that
2821 # doesn't match, which means the range it is ending does
2822 # match, and crosses the 255/256 boundary. We want to include
2823 # this ending point, so increment $i, so the splice below
2824 # includes it. Conversely, if $i is even, it is the first
2825 # code point above 255 that matches, which means there was no
2826 # matching range that crossed the boundary, and we don't want
2827 # to include this code point, so splice before it.
2828 $i++ if $i % 2 != 0;
2830 # Remove everything past this.
2831 splice @invlist, $i;
2832 splice @invmap, $i if @invmap;
2837 elsif ($nonl1_only) {
2838 my $found_nonl1 = 0;
2839 for my $i (0 .. @invlist - 1 - 1) {
2840 next if $invlist[$i] < 256;
2842 # Here, we have the first element in the array that indicates an
2843 # element above Latin1. Get rid of all previous ones.
2844 splice @invlist, 0, $i;
2845 splice @invmap, 0, $i if @invmap;
2847 # If this one's index is not divisible by 2, it means that this
2848 # element is inverting away from being in the list, which means
2849 # all code points from 256 to this one are in this list (or
2850 # map to the default for inversion maps)
2852 unshift @invlist, 256;
2853 unshift @invmap, $map_default if @invmap;
2858 if (! $found_nonl1) {
2859 warn "No non-Latin1 code points in $prop_name";
2860 output_invlist($prop_name, []);
2865 switch_pound_if ($prop_name, 'PERL_IN_REGCOMP_C');
2866 start_charset_pound_if($charset, 1) unless $same_in_all_code_pages;
2868 output_invlist($prop_name, \@invlist, ($same_in_all_code_pages)
2869 ? $applies_to_all_charsets_text
2873 output_invmap($prop_name, \@invmap, $lookup_prop, $map_format,
2874 $map_default, $extra_enums, $charset);
2877 last if $same_in_all_code_pages;
2878 end_charset_pound_if;
2882 switch_pound_if ('binary_property_tables', 'PERL_IN_REGCOMP_C');
2884 print $out_fh "\nconst char * deprecated_property_msgs[] = {\n\t";
2885 print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages;
2886 print $out_fh "\n};\n";
2888 my @enums = sort values %enums;
2890 # Save a copy of these before modification
2891 my @invlist_names = map { "${_}_invlist" } @enums;
2893 # Post-process the enums for deprecated properties.
2894 if (scalar keys %deprecated_tags) {
2895 my $seen_deprecated = 0;
2896 foreach my $enum (@enums) {
2897 if (grep { $_ eq $enum } keys %deprecated_tags) {
2899 # Change the enum name for this deprecated property to a
2900 # munged one to act as a placeholder in the typedef. Then
2901 # make the real name be a #define whose value is such that
2902 # its modulus with the number of enums yields the index into
2903 # the table occupied by the placeholder. And so that dividing
2904 # the #define value by the table length gives an index into
2905 # the table of deprecation messages for the corresponding
2907 my $revised_enum = "${enum}_perl_aux";
2908 if (! $seen_deprecated) {
2909 $seen_deprecated = 1;
2912 print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n";
2913 $enum = $revised_enum;
2918 print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,\n\t";
2919 print $out_fh join ",\n\t", @enums;
2921 print $out_fh "} binary_invlist_enum;\n";
2922 print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n";
2924 output_table_header($out_fh, "UV *", "uni_prop_ptrs");
2925 print $out_fh "\tNULL,\t/* Placeholder */\n";
2927 print $out_fh join ",\n\t", @invlist_names;
2930 output_table_trailer();
2932 print $out_fh join "\n", "\n",
2935 "/* Synonyms for perl properties */",
2936 @perl_prop_synonyms,
2938 #"# endif /* DOINIT */",
2941 switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C');
2949 print $out_fh <<"EOF";
2951 /* More than one code point may have the same code point as their fold. This
2952 * gives the maximum number in the current Unicode release. (The folded-to
2953 * code point is not included in this count.) For example, both 'S' and
2954 * \\x{17F} fold to 's', so the number for that fold is 2. Another way to
2955 * look at it is the maximum length of all the IVCF_AUX_TABLE's */
2956 #define MAX_FOLD_FROMS $max_fold_froms
2959 my $sources_list = "lib/unicore/mktables.lst";
2960 my @sources = qw(regen/mk_invlists.pl
2961 lib/unicore/mktables
2963 regen/charset_translations.pl
2964 regen/mk_PL_charclass.pl
2967 # Depend on mktables’ own sources. It’s a shorter list of files than
2968 # those that Unicode::UCD uses.
2969 if (! open my $mktables_list, '<', $sources_list) {
2971 # This should force a rebuild once $sources_list exists
2972 push @sources, $sources_list;
2975 while(<$mktables_list>) {
2978 push @sources, "lib/unicore/$_" if /^[^#]/;
2983 read_only_bottom_close_and_rename($out_fh, \@sources);
2985 require './regen/mph.pl';
2989 my $name = sanitize_name(shift);
2990 warn "$name contains non-word" if $name =~ /\W/;
2992 return "$table_name_prefix\U$name"
2995 my $keywords_fh = open_new('uni_keywords.h', '>',
2996 {style => '*', by => 'regen/mk_invlists.pl',
3000 print $keywords_fh <<"EOF";
3001 /* The precision to use in "%.*e" formats */
3002 #define PL_E_FORMAT_PRECISION $utf8::e_precision
3006 my ($second_level, $seed1, $length_all_keys, $smart_blob, $rows) = MinimalPerfectHash::make_mph_from_hash(\%keywords);
3007 print $keywords_fh MinimalPerfectHash::make_algo($second_level, $seed1, $length_all_keys, $smart_blob, $rows, undef, undef, undef, 'match_uniprop' );
3009 push @sources, 'regen/mph.pl';
3010 read_only_bottom_close_and_rename($keywords_fh, \@sources);