X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2308ab830eeb3b85bac797c2cb240ce1f9af2710..f97008e2f5934e56fd1dbd3d685308da14fddb30:/regen/mk_invlists.pl diff --git a/regen/mk_invlists.pl b/regen/mk_invlists.pl index 27e1e15..fbec6c7 100644 --- a/regen/mk_invlists.pl +++ b/regen/mk_invlists.pl @@ -7,9 +7,13 @@ use Unicode::UCD qw(prop_aliases prop_value_aliases prop_invlist prop_invmap search_invlist + charprop + num ); -require 'regen/regen_lib.pl'; -require 'regen/charset_translations.pl'; +require './regen/regen_lib.pl'; +require './regen/charset_translations.pl'; +require './lib/unicore/Heavy.pl'; +use re "/aa"; # This program outputs charclass_invlists.h, which contains various inversion # lists in the form of C arrays that are to be used as-is for inversion lists. @@ -22,42 +26,121 @@ require 'regen/charset_translations.pl'; # out-of-sync, or the wrong data structure being passed. Currently that # random number is: -# charclass_invlists.h now also has a partial implementation of inversion -# maps; enough to generate tables for the line break properties, such as GCB +# charclass_invlists.h now also contains inversion maps and enum definitions +# for those maps that have a finite number of possible values my $VERSION_DATA_STRUCTURE_TYPE = 148565664; # integer or float -my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /ax; +my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x; + +my %keywords; +my $table_name_prefix = "PL_"; # Matches valid C language enum names: begins with ASCII alphabetic, then any # ASCII \w my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax; my $out_fh = open_new('charclass_invlists.h', '>', - {style => '*', by => $0, + {style => '*', by => 'regen/mk_invlists.pl', from => "Unicode::UCD"}); -my $in_file_pound_if = 0; +my $in_file_pound_if = ""; + +my $max_hdr_len = 3; # In headings, how wide a name is allowed? print $out_fh "/* See the generating file for comments */\n\n"; +# enums that should be made public +my %public_enums = ( + _Perl_SCX => 1 + ); + # The symbols generated by this program are all currently defined only in a # single dot c each. The code knows where most of them go, but this hash # gives overrides for the exceptions to the typical place my %exceptions_to_where_to_define = - ( NonL1_Perl_Non_Final_Folds => 'PERL_IN_REGCOMP_C', - AboveLatin1 => 'PERL_IN_REGCOMP_C', - Latin1 => 'PERL_IN_REGCOMP_C', - UpperLatin1 => 'PERL_IN_REGCOMP_C', - _Perl_Any_Folds => 'PERL_IN_REGCOMP_C', - _Perl_Folds_To_Multi_Char => 'PERL_IN_REGCOMP_C', - _Perl_IDCont => 'PERL_IN_UTF8_C', - _Perl_IDStart => 'PERL_IN_UTF8_C', + ( + #_Perl_IVCF => 'PERL_IN_REGCOMP_C', ); +my %where_to_define_enums = (); + +my $applies_to_all_charsets_text = "all charsets"; + +my %gcb_enums; +my @gcb_short_enums; +my %gcb_abbreviations; +my %lb_enums; +my @lb_short_enums; +my %lb_abbreviations; +my %wb_enums; +my @wb_short_enums; +my %wb_abbreviations; + my @a2n; +my %prop_name_aliases; +# Invert this hash so that for each canonical name, we get a list of things +# that map to it (excluding itself) +foreach my $name (sort keys %utf8::loose_property_name_of) { + my $canonical = $utf8::loose_property_name_of{$name}; + push @{$prop_name_aliases{$canonical}}, $name if $canonical ne $name; +} + +# Output these tables in the same vicinity as each other, so that will get +# paged in at about the same time. These are also assumed to be the exact +# same list as those properties used internally by perl. +my %keep_together = ( + assigned => 1, + ascii => 1, + upper => 1, + lower => 1, + title => 1, + cased => 1, + uppercaseletter => 1, + lowercaseletter => 1, + titlecaseletter => 1, + casedletter => 1, + vertspace => 1, + xposixalnum => 1, + xposixalpha => 1, + xposixblank => 1, + xposixcntrl => 1, + xposixdigit => 1, + xposixgraph => 1, + xposixlower => 1, + xposixprint => 1, + xposixpunct => 1, + xposixspace => 1, + xposixupper => 1, + xposixword => 1, + xposixxdigit => 1, + posixalnum => 1, + posixalpha => 1, + posixblank => 1, + posixcntrl => 1, + posixdigit => 1, + posixgraph => 1, + posixlower => 1, + posixprint => 1, + posixpunct => 1, + posixspace => 1, + posixupper => 1, + posixword => 1, + posixxdigit => 1, + _perl_any_folds => 1, + _perl_folds_to_multi_char => 1, + _perl_idstart => 1, + _perl_idcont => 1, + _perl_charname_begin => 1, + _perl_charname_continue => 1, + _perl_problematic_locale_foldeds_start => 1, + _perl_problematic_locale_folds => 1, + _perl_quotemeta => 1, + ); +my %perl_tags; # So can find synonyms of the above properties + sub uniques { # Returns non-duplicated input values. From "Perl Best Practices: # Encapsulated Cleverness". p. 455 in first edition. @@ -78,58 +161,80 @@ sub a2n($) { sub end_file_pound_if { if ($in_file_pound_if) { print $out_fh "\n#endif\t/* $in_file_pound_if */\n"; - $in_file_pound_if = 0; + $in_file_pound_if = ""; } } -sub switch_pound_if ($$) { +sub end_charset_pound_if { + print $out_fh "\n" . get_conditional_compile_line_end(); +} + +sub switch_pound_if ($$;$) { my $name = shift; my $new_pound_if = shift; + my $charset = shift; + + my @new_pound_if = ref ($new_pound_if) + ? sort @$new_pound_if + : $new_pound_if; # Switch to new #if given by the 2nd argument. If there is an override # for this, it instead switches to that. The 1st argument is the - # static's name, used to look up the overrides + # static's name, used only to check if there is an override for this + # + # The 'charset' parmameter, if present, is used to first end the charset + # #if if we actually do a switch, and then restart it afterwards. This + # code, then assumes that the charset #if's are enclosed in the file ones. if (exists $exceptions_to_where_to_define{$name}) { - $new_pound_if = $exceptions_to_where_to_define{$name}; + @new_pound_if = $exceptions_to_where_to_define{$name}; } - # Exit current #if if the new one is different from the old - if ($in_file_pound_if - && $in_file_pound_if !~ /$new_pound_if/) - { - end_file_pound_if; + foreach my $element (@new_pound_if) { + $element = "defined($element)"; } + $new_pound_if = join " || ", @new_pound_if; + + # Change to the new one if different from old + if ($in_file_pound_if ne $new_pound_if) { + + end_charset_pound_if() if defined $charset; + + # Exit any current #if + if ($in_file_pound_if) { + end_file_pound_if; + } - # Enter new #if, if not already in it. - if (! $in_file_pound_if) { - $in_file_pound_if = "defined($new_pound_if)"; + $in_file_pound_if = $new_pound_if; print $out_fh "\n#if $in_file_pound_if\n"; + + start_charset_pound_if ($charset, 1) if defined $charset; } } +sub start_charset_pound_if ($;$) { + print $out_fh "\n" . get_conditional_compile_line_start(shift, shift); +} + sub output_invlist ($$;$) { my $name = shift; my $invlist = shift; # Reference to inversion list array my $charset = shift // ""; # name of character set for comment die "No inversion list for $name" unless defined $invlist - && ref $invlist eq 'ARRAY' - && @$invlist; + && ref $invlist eq 'ARRAY'; # Output the inversion list $invlist using the name $name for it. # It is output in the exact internal form for inversion lists. # Is the last element of the header 0, or 1 ? my $zero_or_one = 0; - if ($invlist->[0] != 0) { + if (@$invlist && $invlist->[0] != 0) { unshift @$invlist, 0; $zero_or_one = 1; } my $count = @$invlist; - switch_pound_if ($name, 'PERL_IN_PERL_C'); - print $out_fh "\nstatic const UV ${name}_invlist[] = {"; print $out_fh " /* for $charset */" if $charset; print $out_fh "\n"; @@ -168,60 +273,419 @@ sub output_invmap ($$$$$$$) { my $count = @$invmap; my $output_format; - my $declaration_type; + my $invmap_declaration_type; + my $enum_declaration_type; + my $aux_declaration_type; my %enums; my $name_prefix; - if ($input_format eq 's') { - $prop_name = (prop_aliases($prop_name))[1]; # Get full name - my @enums = prop_values($prop_name); - if (! @enums) { - die "Only enum properties are currently handled; '$prop_name' isn't one"; + if ($input_format =~ / ^ [as] l? $ /x) { + $prop_name = (prop_aliases($prop_name))[1] // $prop_name =~ s/^_Perl_//r; # Get full name + my $short_name = (prop_aliases($prop_name))[0] // $prop_name; + my @input_enums; + + # Find all the possible input values. These become the enum names + # that comprise the inversion map. For inputs that don't have sub + # lists, we can just get the unique values. Otherwise, we have to + # expand the sublists first. + if ($input_format !~ / ^ a /x) { + if ($input_format ne 'sl') { + @input_enums = sort(uniques(@$invmap)); } else { + foreach my $element (@$invmap) { + if (ref $element) { + push @input_enums, @$element; + } + else { + push @input_enums, $element; + } + } + @input_enums = sort(uniques(@input_enums)); + } + } + + # The internal enums come last, and in the order specified. + my @enums = @input_enums; + my @extras; + if ($extra_enums ne "") { + @extras = split /,/, $extra_enums; + + # Don't add if already there. + foreach my $this_extra (@extras) { + next if grep { $_ eq $this_extra } @enums; + + push @enums, $this_extra; + } + } + + # Assign a value to each element of the enum type we are creating. + # The default value always gets 0; the others are arbitrarily + # assigned. + my $enum_val = 0; + my $canonical_default = prop_value_aliases($prop_name, $default); + $default = $canonical_default if defined $canonical_default; + $enums{$default} = $enum_val++; + + for my $enum (@enums) { + $enums{$enum} = $enum_val++ unless exists $enums{$enum}; + } + + # Calculate the data for the special tables output for these properties. + if ($name =~ / ^ _Perl_ (?: GCB | LB | WB ) $ /x) { + + # The data includes the hashes %gcb_enums, %lb_enums, etc. + # Similarly we calculate column headings for the tables. + # + # We use string evals to allow the same code to work on + # all the tables + my $type = lc $prop_name; + + my $placeholder = "a"; + + # Skip if we've already done this code, which populated + # this hash + if (eval "! \%${type}_enums") { + + # For each enum in the type ... + foreach my $enum (sort keys %enums) { + my $value = $enums{$enum}; + my $short; + my $abbreviated_from; + + # Special case this wb property value to make the + # name more clear + if ($enum eq 'Perl_Tailored_HSpace') { + $short = 'hs'; + $abbreviated_from = $enum; + } + else { + + # Use the official short name, if found. + ($short) = prop_value_aliases($type, $enum); + + if (! defined $short) { + + # But if there is no official name, use the name + # that came from the data (if any). Otherwise, + # the name had to come from the extras list. + # There are two types of values in that list. + # + # First are those enums that are not part of the + # property, but are defined by this code. By + # convention these have all-caps names of at least + # 4 characters. We use the lowercased name for + # thse. + # + # Second are enums that are needed to get + # regexec.c to compile, but don't exist in all + # Unicode releases. To get here, we must be + # compiling an earlier Unicode release that + # doesn't have that enum, so just use a unique + # anonymous name for it. + if (grep { $_ eq $enum } @input_enums) { + $short = $enum + } + elsif ($enum !~ / ^ [A-Z]{4,} $ /x) { + $short = $placeholder++; + } + else { + $short = lc $enum; + } + } + } + + # If our short name is too long, or we already + # know that the name is an abbreviation, truncate + # to make sure it's short enough, and remember + # that we did this so we can later add a comment in the + # generated file + if ( $abbreviated_from + || length $short > $max_hdr_len) + { + $short = substr($short, 0, $max_hdr_len); + $abbreviated_from = $enum + unless $abbreviated_from; + # If the name we are to display conflicts, try + # another. + while (eval "exists + \$${type}_abbreviations{$short}") + { + die $@ if $@; + + # The increment operator on strings doesn't work + # on those containing an '_', so just use the + # final portion. + my @short = split '_', $short; + $short[-1]++; + $short = join "_", @short; + } + + eval "\$${type}_abbreviations{$short} = '$enum'"; + die $@ if $@; + } - # Convert short names to long, add in the extras, and sort. - @enums = map { (prop_value_aliases($prop_name, $_))[1] } @enums; - push @enums, split /,/, $extra_enums if $extra_enums ne ""; - @enums = sort @enums; - - # Assign a value to each element of the enum. The default - # value always gets 0; the others are arbitrarily assigned. - my $enum_val = 0; - $default = prop_value_aliases($prop_name, $default); - $enums{$default} = $enum_val++; - for my $enum (@enums) { - $enums{$enum} = $enum_val++ unless exists $enums{$enum}; + # Remember the mapping from the property value + # (enum) name to its value. + eval "\$${type}_enums{$enum} = $value"; + die $@ if $@; + + # Remember the inverse mapping to the short name + # so that we can properly label the generated + # table's rows and columns + eval "\$${type}_short_enums[$value] = '$short'"; + die $@ if $@; } } + } - # Inversion map stuff is currently used only by regexec - switch_pound_if($name, 'PERL_IN_REGEXEC_C'); - { + # The short names tend to be two lower case letters, but it looks + # better for those if they are upper. XXX + $short_name = uc($short_name) if length($short_name) < 3 + || substr($short_name, 0, 1) =~ /[[:lower:]]/; + $name_prefix = "${short_name}_"; + + # Start the enum definition for this map + my @enum_definition; + my @enum_list; + foreach my $enum (keys %enums) { + $enum_list[$enums{$enum}] = $enum; + } + foreach my $i (0 .. @enum_list - 1) { + push @enum_definition, ",\n" if $i > 0; - my $short_name = (prop_aliases($prop_name))[0]; + my $name = $enum_list[$i]; + push @enum_definition, "\t${name_prefix}$name = $i"; + } - # The short names tend to be two lower case letters, but it looks - # better for those if they are upper. XXX - $short_name = uc($short_name) if length($short_name) < 3 - || substr($short_name, 0, 1) =~ /[[:lower:]]/; - $name_prefix = "${short_name}_"; - my $enum_count = keys %enums; - print $out_fh "\n#define ${name_prefix}ENUM_COUNT ", scalar keys %enums, "\n"; + # For an 'l' property, we need extra enums, because some of the + # elements are lists. Each such distinct list is placed in its own + # auxiliary map table. Here, we go through the inversion map, and for + # each distinct list found, create an enum value for it, numbered -1, + # -2, .... + my %multiples; + my $aux_table_prefix = "AUX_TABLE_"; + if ($input_format =~ /l/) { + foreach my $element (@$invmap) { + + # A regular scalar is not one of the lists we're looking for + # at this stage. + next unless ref $element; + + my $joined; + if ($input_format =~ /a/) { # These are already ordered + $joined = join ",", @$element; + } + else { + $joined = join ",", sort @$element; + } + my $already_found = exists $multiples{$joined}; - print $out_fh "\ntypedef enum {\n"; - print $out_fh "\t${name_prefix}$default = $enums{$default},\n"; - delete $enums{$default}; - foreach my $enum (sort { $a cmp $b } keys %enums) { - print $out_fh "\t${name_prefix}$enum = $enums{$enum}"; - print $out_fh "," if $enums{$enum} < $enum_count - 1; - print $out_fh "\n"; + my $i; + if ($already_found) { # Use any existing one + $i = $multiples{$joined}; + } + else { # Otherwise increment to get a new table number + $i = keys(%multiples) + 1; + $multiples{$joined} = $i; + } + + # This changes the inversion map for this entry to not be the + # list + $element = "use_$aux_table_prefix$i"; + + # And add to the enum values + if (! $already_found) { + push @enum_definition, ",\n\t${name_prefix}$element = -$i"; + } } - $declaration_type = "${name_prefix}enum"; - print $out_fh "} $declaration_type;\n"; + } + + $enum_declaration_type = "${name_prefix}enum"; + + # Finished with the enum definition. Inversion map stuff is used only + # by regexec or utf-8 (if it is for code points) , unless it is in the + # enum exception list + my $where = (exists $where_to_define_enums{$name}) + ? $where_to_define_enums{$name} + : ($input_format =~ /a/) + ? 'PERL_IN_UTF8_C' + : 'PERL_IN_REGEXEC_C'; - $output_format = "${name_prefix}%s"; + if (! exists $public_enums{$name}) { + switch_pound_if($name, $where, $charset); + } + else { + end_charset_pound_if; + end_file_pound_if; + start_charset_pound_if($charset, 1); } + + # If the enum only contains one element, that is a dummy, default one + if (scalar @enum_definition > 1) { + + # Currently unneeded + #print $out_fh "\n#define ${name_prefix}ENUM_COUNT ", + # ..scalar keys %enums, "\n"; + + if ($input_format =~ /l/) { + print $out_fh + "\n", + "/* Negative enum values indicate the need to use an", + " auxiliary table\n", + " * consisting of the list of enums this one expands to.", + " The absolute\n", + " * values of the negative enums are indices into a table", + " of the auxiliary\n", + " * tables' addresses */"; + } + print $out_fh "\ntypedef enum {\n"; + print $out_fh join "", @enum_definition; + print $out_fh "\n"; + print $out_fh "} $enum_declaration_type;\n"; + } + + switch_pound_if($name, $where, $charset); + + $invmap_declaration_type = ($input_format =~ /s/) + ? $enum_declaration_type + : "int"; + $aux_declaration_type = ($input_format =~ /s/) + ? $enum_declaration_type + : "unsigned int"; + + $output_format = "${name_prefix}%s"; + + # If there are auxiliary tables, output them. + if (%multiples) { + + print $out_fh "\n#define HAS_${name_prefix}AUX_TABLES\n"; + + # Invert keys and values + my %inverted_mults; + while (my ($key, $value) = each %multiples) { + $inverted_mults{$value} = $key; + } + + # Output them in sorted order + my @sorted_table_list = sort { $a <=> $b } keys %inverted_mults; + + # Keep track of how big each aux table is + my @aux_counts; + + # Output each aux table. + foreach my $table_number (@sorted_table_list) { + my $table = $inverted_mults{$table_number}; + print $out_fh "\nstatic const $aux_declaration_type $name_prefix$aux_table_prefix$table_number\[] = {\n"; + + # Earlier, we joined the elements of this table together with a comma + my @elements = split ",", $table; + + $aux_counts[$table_number] = scalar @elements; + for my $i (0 .. @elements - 1) { + print $out_fh ",\n" if $i > 0; + if ($input_format =~ /a/) { + printf $out_fh "\t0x%X", $elements[$i]; + } + else { + print $out_fh "\t${name_prefix}$elements[$i]"; + } + } + print $out_fh "\n};\n"; + } + + # Output the table that is indexed by the absolute value of the + # aux table enum and contains pointers to the tables output just + # above + print $out_fh "\nstatic const $aux_declaration_type * const ${name_prefix}${aux_table_prefix}ptrs\[] = {\n"; + print $out_fh "\tNULL,\t/* Placeholder */\n"; + for my $i (1 .. @sorted_table_list) { + print $out_fh ",\n" if $i > 1; + print $out_fh "\t$name_prefix$aux_table_prefix$i"; + } + print $out_fh "\n};\n"; + + print $out_fh + "\n/* Parallel table to the above, giving the number of elements" + . " in each table\n * pointed to */\n"; + print $out_fh "static const U8 ${name_prefix}${aux_table_prefix}lengths\[] = {\n"; + print $out_fh "\t0,\t/* Placeholder */\n"; + for my $i (1 .. @sorted_table_list) { + print $out_fh ",\n" if $i > 1; + print $out_fh "\t$aux_counts[$i]\t/* $name_prefix$aux_table_prefix$i */"; + } + print $out_fh "\n};\n"; + } # End of outputting the auxiliary and associated tables + + # The scx property used in regexec.c needs a specialized table which + # is most convenient to output here, while the data structures set up + # above are still extant. This table contains the code point that is + # the zero digit of each script, indexed by script enum value. + if (lc $short_name eq 'scx') { + my @decimals_invlist = prop_invlist("Numeric_Type=Decimal"); + my %script_zeros; + + # Find all the decimal digits. The 0 of each range is always the + # 0th element, except in some early Unicode releases, so check for + # that. + for (my $i = 0; $i < @decimals_invlist; $i += 2) { + my $code_point = $decimals_invlist[$i]; + next if num(chr($code_point)) ne '0'; + + # Turn the scripts this zero is in into a list. + my @scripts = split ",", + charprop($code_point, "_Perl_SCX", '_perl_core_internal_ok'); + $code_point = sprintf("0x%x", $code_point); + + foreach my $script (@scripts) { + if (! exists $script_zeros{$script}) { + $script_zeros{$script} = $code_point; + } + elsif (ref $script_zeros{$script}) { + push $script_zeros{$script}->@*, $code_point; + } + else { # Turn into a list if this is the 2nd zero of the + # script + my $existing = $script_zeros{$script}; + undef $script_zeros{$script}; + push $script_zeros{$script}->@*, $existing, $code_point; + } + } + } + + # @script_zeros contains the zero, sorted by the script's enum + # value + my @script_zeros; + foreach my $script (keys %script_zeros) { + my $enum_value = $enums{$script}; + $script_zeros[$enum_value] = $script_zeros{$script}; + } + + print $out_fh + "\n/* This table, indexed by the script enum, gives the zero" + . " code point for that\n * script; 0 if the script has multiple" + . " digit sequences. Scripts without a\n * digit sequence use" + . " ASCII [0-9], hence are marked '0' */\n"; + print $out_fh "static const UV script_zeros[] = {\n"; + for my $i (0 .. @script_zeros - 1) { + my $code_point = $script_zeros[$i]; + if (defined $code_point) { + $code_point = " 0" if ref $code_point; + print $out_fh "\t$code_point"; + } + elsif (lc $enum_list[$i] eq 'inherited') { + print $out_fh "\t 0"; + } + else { # The only digits a script without its own set accepts + # is [0-9] + print $out_fh "\t'0'"; + } + print $out_fh "," if $i < @script_zeros - 1; + print $out_fh "\t/* $enum_list[$i] */"; + print $out_fh "\n"; + } + print $out_fh "};\n"; + } # End of special handling of scx } else { die "'$input_format' invmap() format for '$prop_name' unimplemented"; @@ -231,14 +695,24 @@ sub output_invmap ($$$$$$$) { && ref $invmap eq 'ARRAY' && $count; - print $out_fh "\nstatic const $declaration_type ${name}_invmap[] = {"; + # Now output the inversion map proper + print $out_fh "\nstatic const $invmap_declaration_type ${name}_invmap[] = {"; print $out_fh " /* for $charset */" if $charset; print $out_fh "\n"; # The main body are the scalars passed in to this routine. for my $i (0 .. $count - 1) { my $element = $invmap->[$i]; - $element = $name_prefix . prop_value_aliases($prop_name, $element); + my $full_element_name = prop_value_aliases($prop_name, $element); + if ($input_format =~ /a/ && $element !~ /\D/) { + $element = ($element == 0) + ? 0 + : sprintf("0x%X", $element); + } + else { + $element = $full_element_name if defined $full_element_name; + $element = $name_prefix . $element; + } print $out_fh "\t$element"; print $out_fh "," if $i < $count - 1; print $out_fh "\n"; @@ -273,10 +747,11 @@ sub mk_invlist_from_sorted_cp_list { # Read in the Case Folding rules, and construct arrays of code points for the # properties we need. -my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding"); +my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding"); die "Could not find inversion map for Case_Folding" unless defined $format; die "Incorrect format '$format' for Case_Folding inversion map" - unless $format eq 'al'; + unless $format eq 'al' + || $format eq 'a'; my @has_multi_char_fold; my @is_non_final_fold; @@ -287,14 +762,195 @@ for my $i (0 .. @$folds_ref - 1) { # Add to the non-finals list each code point that is in a non-final # position for my $j (0 .. @{$folds_ref->[$i]} - 2) { - push @is_non_final_fold, $folds_ref->[$i][$j] - unless grep { $folds_ref->[$i][$j] == $_ } @is_non_final_fold; + push @is_non_final_fold, $folds_ref->[$i][$j]; } + @is_non_final_fold = uniques @is_non_final_fold; } sub _Perl_Non_Final_Folds { @is_non_final_fold = sort { $a <=> $b } @is_non_final_fold; - return mk_invlist_from_sorted_cp_list(\@is_non_final_fold); + my @return = mk_invlist_from_sorted_cp_list(\@is_non_final_fold); + return \@return; +} + +sub _Perl_IVCF { + + # This creates a map of the inversion of case folding. i.e., given a + # character, it gives all the other characters that fold to it. + # + # Inversion maps function kind of like a hash, with the inversion list + # specifying the buckets (keys) and the inversion maps specifying the + # contents of the corresponding bucket. Effectively this function just + # swaps the keys and values of the case fold hash. But there are + # complications. Most importantly, More than one character can each have + # the same fold. This is solved by having a list of characters that fold + # to a given one. + + my %new; + + # Go through the inversion list. + for (my $i = 0; $i < @$cp_ref; $i++) { + + # Skip if nothing folds to this + next if $folds_ref->[$i] == 0; + + # This entry which is valid from here to up (but not including) the + # next entry is for the next $count characters, so that, for example, + # A-Z is represented by one entry. + my $cur_list = $cp_ref->[$i]; + my $count = $cp_ref->[$i+1] - $cur_list; + + # The fold of [$i] can be not just a single character, but a sequence + # of multiple ones. We deal with those here by just creating a string + # consisting of them. Otherwise, we use the single code point [$i] + # folds to. + my $cur_map = (ref $folds_ref->[$i]) + ? join "", map { chr } $folds_ref->[$i]->@* + : $folds_ref->[$i]; + + # Expand out this range + while ($count > 0) { + push @{$new{$cur_map}}, $cur_list; + + # A multiple-character fold is a string, and shouldn't need + # incrementing anyway + if (ref $folds_ref->[$i]) { + die sprintf("Case fold for %x is multiple chars; should have" + . " a count of 1, but instead it was $count", $count) + unless $count == 1; + } + else { + $cur_map++; + $cur_list++; + } + $count--; + } + } + + # Now go through and make some adjustments. We add synthetic entries for + # two cases. + # 1) Two or more code points can fold to the same multiple character, + # sequence, as U+FB05 and U+FB06 both fold to 'st'. This code is only + # for single character folds, but FB05 and FB06 are single characters + # that are equivalent folded, so we add entries so that they are + # considered to fold to each other + # 2) If two or more above-Latin1 code points fold to the same Latin1 range + # one, we also add entries so that they are considered to fold to each + # other. This is so that under /aa or /l matching, where folding to + # their Latin1 range code point is illegal, they still can fold to each + # other. This situation happens in Unicode 3.0.1, but probably no + # other version. + foreach my $fold (keys %new) { + my $folds_to_string = $fold =~ /\D/; + + # If the bucket contains only one element, convert from an array to a + # scalar + if (scalar $new{$fold}->@* == 1) { + $new{$fold} = $new{$fold}[0]; + } + else { + + # Otherwise, sort numerically. This places the highest code point + # in the list at the tail end. This is because Unicode keeps the + # lowercase code points as higher ordinals than the uppercase, at + # least for the ones that matter so far. These are synthetic + # entries, and we want to predictably have the lowercase (which is + # more likely to be what gets folded to) in the same corresponding + # position, so that other code can rely on that. If some new + # version of Unicode came along that violated this, we might have + # to change so that the sort is based on upper vs lower instead. + # (The lower-comes-after isn't true of native EBCDIC, but here we + # are dealing strictly with Unicode values). + @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@* + unless $folds_to_string; + # We will be working with a copy of this sorted entry. + my @source_list = $new{$fold}->@*; + if (! $folds_to_string) { + + # This handles situation 2) listed above, which only arises if + # what is being folded-to (the fold) is in the Latin1 range. + if ($fold > 255 ) { + undef @source_list; + } + else { + # And it only arises if there are two or more folders that + # fold to it above Latin1. We look at just those. + @source_list = grep { $_ > 255 } @source_list; + undef @source_list if @source_list == 1; + } + } + + # Here, we've found the items we want to set up synthetic folds + # for. Add entries so that each folds to each other. + foreach my $cp (@source_list) { + my @rest = grep { $cp != $_ } @source_list; + if (@rest == 1) { + $new{$cp} = $rest[0]; + } + else { + push @{$new{$cp}}, @rest; + } + } + } + + # We don't otherwise deal with multiple-character folds + delete $new{$fold} if $folds_to_string; + } + + + # Now we have a hash that is the inversion of the case fold property. + # Convert it to an inversion map. + + my @sorted_folds = sort { $a <=> $b } keys %new; + my (@invlist, @invmap); + + # We know that nothing folds to the controls (whose ordinals start at 0). + # And the first real entries are the lowest in the hash. + push @invlist, 0, $sorted_folds[0]; + push @invmap, 0, $new{$sorted_folds[0]}; + + # Go through the remainder of the hash keys (which are the folded code + # points) + for (my $i = 1; $i < @sorted_folds; $i++) { + + # Get the current one, and the one prior to it. + my $fold = $sorted_folds[$i]; + my $prev_fold = $sorted_folds[$i-1]; + + # If the current one is not just 1 away from the prior one, we close + # out the range containing the previous fold, and know that the gap + # doesn't have anything that folds. + if ($fold - 1 != $prev_fold) { + push @invlist, $prev_fold + 1; + push @invmap, 0; + + # And start a new range + push @invlist, $fold; + push @invmap, $new{$fold}; + } + elsif ($new{$fold} - 1 != $new{$prev_fold}) { + + # Here the current fold is just 1 greater than the previous, but + # the new map isn't correspondingly 1 greater than the previous, + # the old range is ended, but since there is no gap, we don't have + # to insert anything else. + push @invlist, $fold; + push @invmap, $new{$fold}; + + } # else { Otherwise, this new entry just extends the previous } + + die "In IVCF: $invlist[-1] <= $invlist[-2]" + if $invlist[-1] <= $invlist[-2]; + } + + # And add an entry that indicates that everything above this, to infinity, + # does not have a case fold. + push @invlist, $sorted_folds[-1] + 1; + push @invmap, 0; + + # All Unicode versions have some places where multiple code points map to + # the same one, so the format always has an 'l' + return \@invlist, \@invmap, 'al', $default; } sub prop_name_for_cmp ($) { # Sort helper @@ -309,9 +965,1170 @@ sub prop_name_for_cmp ($) { # Sort helper } sub UpperLatin1 { - return mk_invlist_from_sorted_cp_list([ 128 .. 255 ]); + my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]); + return \@return; +} + +sub output_table_common { + + # Common subroutine to actually output the generated rules table. + + my ($property, + $table_value_defines_ref, + $table_ref, + $names_ref, + $abbreviations_ref) = @_; + my $size = @$table_ref; + + # Output the #define list, sorted by numeric value + if ($table_value_defines_ref) { + my $max_name_length = 0; + my @defines; + + # Put in order, and at the same time find the longest name + while (my ($enum, $value) = each %$table_value_defines_ref) { + $defines[$value] = $enum; + + my $length = length $enum; + $max_name_length = $length if $length > $max_name_length; + } + + print $out_fh "\n"; + + # Output, so that the values are vertically aligned in a column after + # the longest name + foreach my $i (0 .. @defines - 1) { + next unless defined $defines[$i]; + printf $out_fh "#define %-*s %2d\n", + $max_name_length, + $defines[$i], + $i; + } + } + + my $column_width = 2; # We currently allow 2 digits for the number + + # If the maximum value in the table is 1, it can be a bool. (Being above + # a U8 is not currently handled + my $max_element = 0; + for my $i (0 .. $size - 1) { + for my $j (0 .. $size - 1) { + next if $max_element >= $table_ref->[$i][$j]; + $max_element = $table_ref->[$i][$j]; + } + } + die "Need wider table column width given '$max_element" + if length $max_element > $column_width; + + my $table_type = ($max_element == 1) + ? 'bool' + : 'U8'; + + # If a name is longer than the width set aside for a column, its column + # needs to have increased spacing so that the name doesn't get truncated + # nor run into an adjacent column + my @spacers; + + # If we are being compiled on a Unicode version earlier than that which + # this file was designed for, it may be that some of the property values + # aren't in the current release, and so would be undefined if we didn't + # define them ourselves. Earlier code has done this, making them + # lowercase characters of length one. We look to see if any exist, so + # that we can add an annotation to the output table + my $has_placeholder = 0; + + for my $i (0 .. $size - 1) { + no warnings 'numeric'; + $has_placeholder = 1 if $names_ref->[$i] =~ / ^ [[:lower:]] $ /x; + $spacers[$i] = " " x (length($names_ref->[$i]) - $column_width); + } + + print $out_fh "\nstatic const $table_type ${property}_table[$size][$size] = {\n"; + + # Calculate the column heading line + my $header_line = "/* " + . (" " x $max_hdr_len) # We let the row heading meld to + # the '*/' for those that are at + # the max + . " " x 3; # Space for '*/ ' + # Now each column + for my $i (0 .. $size - 1) { + $header_line .= sprintf "%s%*s", + $spacers[$i], + $column_width + 1, # 1 for the ',' + $names_ref->[$i]; + } + $header_line .= " */\n"; + + # If we have annotations, output it now. + if ($has_placeholder || scalar %$abbreviations_ref) { + my $text = ""; + foreach my $abbr (sort keys %$abbreviations_ref) { + $text .= "; " if $text; + $text .= "'$abbr' stands for '$abbreviations_ref->{$abbr}'"; + } + if ($has_placeholder) { + $text .= "; other " if $text; + $text .= "lowercase names are placeholders for" + . " property values not defined until a later Unicode" + . " release, so are irrelevant in this one, as they are" + . " not assigned to any code points"; + } + + my $indent = " " x 3; + $text = $indent . "/* $text */"; + + # Wrap the text so that it is no wider than the table, which the + # header line gives. + my $output_width = length $header_line; + while (length $text > $output_width) { + my $cur_line = substr($text, 0, $output_width); + + # Find the first blank back from the right end to wrap at. + for (my $i = $output_width -1; $i > 0; $i--) { + if (substr($text, $i, 1) eq " ") { + print $out_fh substr($text, 0, $i), "\n"; + + # Set so will look at just the remaining tail (which will + # be indented and have a '*' after the indent + $text = $indent . " * " . substr($text, $i + 1); + last; + } + } + } + + # And any remaining + print $out_fh $text, "\n" if $text; + } + + # We calculated the header line earlier just to get its width so that we + # could make sure the annotations fit into that. + print $out_fh $header_line; + + # Now output the bulk of the table. + for my $i (0 .. $size - 1) { + + # First the row heading. + printf $out_fh "/* %-*s*/ ", $max_hdr_len, $names_ref->[$i]; + print $out_fh "{"; # Then the brace for this row + + # Then each column + for my $j (0 .. $size -1) { + print $out_fh $spacers[$j]; + printf $out_fh "%*d", $column_width, $table_ref->[$i][$j]; + print $out_fh "," if $j < $size - 1; + } + print $out_fh " }"; + print $out_fh "," if $i < $size - 1; + print $out_fh "\n"; + } + + print $out_fh "};\n"; +} + +sub output_GCB_table() { + + # Create and output the pair table for use in determining Grapheme Cluster + # Breaks, given in http://www.unicode.org/reports/tr29/. + my %gcb_actions = ( + GCB_NOBREAK => 0, + GCB_BREAKABLE => 1, + GCB_RI_then_RI => 2, # Rules 12 and 13 + GCB_EX_then_EM => 3, # Rule 10 + ); + + # The table is constructed in reverse order of the rules, to make the + # lower-numbered, higher priority ones override the later ones, as the + # algorithm stops at the earliest matching rule + + my @gcb_table; + my $table_size = @gcb_short_enums; + + # Otherwise, break everywhere. + # GB99 Any ÷ Any + for my $i (0 .. $table_size - 1) { + for my $j (0 .. $table_size - 1) { + $gcb_table[$i][$j] = 1; + } + } + + # Do not break within emoji flag sequences. That is, do not break between + # regional indicator (RI) symbols if there is an odd number of RI + # characters before the break point. Must be resolved in runtime code. + # + # GB12 sot (RI RI)* RI × RI + # GB13 [^RI] (RI RI)* RI × RI + $gcb_table[$gcb_enums{'Regional_Indicator'}] + [$gcb_enums{'Regional_Indicator'}] = $gcb_actions{GCB_RI_then_RI}; + + # Do not break within emoji modifier sequences or emoji zwj sequences. + # GB11 ZWJ × ( Glue_After_Zwj | E_Base_GAZ ) + $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'Glue_After_Zwj'}] = 0; + $gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'E_Base_GAZ'}] = 0; + + # GB10 ( E_Base | E_Base_GAZ ) Extend* × E_Modifier + $gcb_table[$gcb_enums{'Extend'}][$gcb_enums{'E_Modifier'}] + = $gcb_actions{GCB_EX_then_EM}; + $gcb_table[$gcb_enums{'E_Base'}][$gcb_enums{'E_Modifier'}] = 0; + $gcb_table[$gcb_enums{'E_Base_GAZ'}][$gcb_enums{'E_Modifier'}] = 0; + + # Do not break before extending characters or ZWJ. + # Do not break before SpacingMarks, or after Prepend characters. + # GB9b Prepend × + # GB9a × SpacingMark + # GB9 × ( Extend | ZWJ ) + for my $i (0 .. @gcb_table - 1) { + $gcb_table[$gcb_enums{'Prepend'}][$i] = 0; + $gcb_table[$i][$gcb_enums{'SpacingMark'}] = 0; + $gcb_table[$i][$gcb_enums{'Extend'}] = 0; + $gcb_table[$i][$gcb_enums{'ZWJ'}] = 0; + } + + # Do not break Hangul syllable sequences. + # GB8 ( LVT | T) × T + $gcb_table[$gcb_enums{'LVT'}][$gcb_enums{'T'}] = 0; + $gcb_table[$gcb_enums{'T'}][$gcb_enums{'T'}] = 0; + + # GB7 ( LV | V ) × ( V | T ) + $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'V'}] = 0; + $gcb_table[$gcb_enums{'LV'}][$gcb_enums{'T'}] = 0; + $gcb_table[$gcb_enums{'V'}][$gcb_enums{'V'}] = 0; + $gcb_table[$gcb_enums{'V'}][$gcb_enums{'T'}] = 0; + + # GB6 L × ( L | V | LV | LVT ) + $gcb_table[$gcb_enums{'L'}][$gcb_enums{'L'}] = 0; + $gcb_table[$gcb_enums{'L'}][$gcb_enums{'V'}] = 0; + $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LV'}] = 0; + $gcb_table[$gcb_enums{'L'}][$gcb_enums{'LVT'}] = 0; + + # Do not break between a CR and LF. Otherwise, break before and after + # controls. + # GB5 ÷ ( Control | CR | LF ) + # GB4 ( Control | CR | LF ) ÷ + for my $i (0 .. @gcb_table - 1) { + $gcb_table[$i][$gcb_enums{'Control'}] = 1; + $gcb_table[$i][$gcb_enums{'CR'}] = 1; + $gcb_table[$i][$gcb_enums{'LF'}] = 1; + $gcb_table[$gcb_enums{'Control'}][$i] = 1; + $gcb_table[$gcb_enums{'CR'}][$i] = 1; + $gcb_table[$gcb_enums{'LF'}][$i] = 1; + } + + # GB3 CR × LF + $gcb_table[$gcb_enums{'CR'}][$gcb_enums{'LF'}] = 0; + + # Break at the start and end of text, unless the text is empty + # GB1 sot ÷ + # GB2 ÷ eot + for my $i (0 .. @gcb_table - 1) { + $gcb_table[$i][$gcb_enums{'EDGE'}] = 1; + $gcb_table[$gcb_enums{'EDGE'}][$i] = 1; + } + $gcb_table[$gcb_enums{'EDGE'}][$gcb_enums{'EDGE'}] = 0; + + output_table_common('GCB', \%gcb_actions, + \@gcb_table, \@gcb_short_enums, \%gcb_abbreviations); +} + +sub output_LB_table() { + + # Create and output the enums, #defines, and pair table for use in + # determining Line Breaks. This uses the default line break algorithm, + # given in http://www.unicode.org/reports/tr14/, but tailored by example 7 + # in that page, as the Unicode-furnished tests assume that tailoring. + + # The result is really just true or false. But we follow along with tr14, + # creating a rule which is false for something like X SP* X. That gets + # encoding 2. The rest of the actions are synthetic ones that indicate + # some context handling is required. These each are added to the + # underlying 0, 1, or 2, instead of replacing them, so that the underlying + # value can be retrieved. Actually only rules from 7 through 18 (which + # are the ones where space matter) are possible to have 2 added to them. + # The others below add just 0 or 1. It might be possible for one + # synthetic rule to be added to another, yielding a larger value. This + # doesn't happen in the Unicode 8.0 rule set, and as you can see from the + # names of the middle grouping below, it is impossible for that to occur + # for them because they all start with mutually exclusive classes. That + # the final rule can't be added to any of the others isn't obvious from + # its name, so it is assigned a power of 2 higher than the others can get + # to so any addition would preserve all data. (And the code will reach an + # assert(0) on debugging builds should this happen.) + my %lb_actions = ( + LB_NOBREAK => 0, + LB_BREAKABLE => 1, + LB_NOBREAK_EVEN_WITH_SP_BETWEEN => 2, + + LB_CM_ZWJ_foo => 3, # Rule 9 + LB_SP_foo => 6, # Rule 18 + LB_PR_or_PO_then_OP_or_HY => 9, # Rule 25 + LB_SY_or_IS_then_various => 11, # Rule 25 + LB_HY_or_BA_then_foo => 13, # Rule 21 + LB_RI_then_RI => 15, # Rule 30a + + LB_various_then_PO_or_PR => (1<<5), # Rule 25 + ); + + # Construct the LB pair table. This is based on the rules in + # http://www.unicode.org/reports/tr14/, but modified as those rules are + # designed for someone taking a string of text and sequentially going + # through it to find the break opportunities, whereas, Perl requires + # determining if a given random spot is a break opportunity, without + # knowing all the entire string before it. + # + # The table is constructed in reverse order of the rules, to make the + # lower-numbered, higher priority ones override the later ones, as the + # algorithm stops at the earliest matching rule + + my @lb_table; + my $table_size = @lb_short_enums; + + # LB31. Break everywhere else + for my $i (0 .. $table_size - 1) { + for my $j (0 .. $table_size - 1) { + $lb_table[$i][$j] = $lb_actions{'LB_BREAKABLE'}; + } + } + + # LB30b Do not break between an emoji base and an emoji modifier. + # EB × EM + $lb_table[$lb_enums{'E_Base'}][$lb_enums{'E_Modifier'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB30a Break between two regional indicator symbols if and only if there + # are an even number of regional indicators preceding the position of the + # break. + # sot (RI RI)* RI × RI + # [^RI] (RI RI)* RI × RI + $lb_table[$lb_enums{'Regional_Indicator'}] + [$lb_enums{'Regional_Indicator'}] = $lb_actions{'LB_RI_then_RI'}; + + # LB30 Do not break between letters, numbers, or ordinary symbols and + # opening or closing parentheses. + # (AL | HL | NU) × OP + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Open_Punctuation'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Open_Punctuation'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Open_Punctuation'}] + = $lb_actions{'LB_NOBREAK'}; + + # CP × (AL | HL | NU) + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB29 Do not break between numeric punctuation and alphabetics (“e.g.”). + # IS × (AL | HL) + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB28 Do not break between alphabetics (“at”). + # (AL | HL) × (AL | HL) + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB27 Treat a Korean Syllable Block the same as ID. + # (JL | JV | JT | H2 | H3) × IN + $lb_table[$lb_enums{'JL'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JV'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JT'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H2'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H3'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # (JL | JV | JT | H2 | H3) × PO + $lb_table[$lb_enums{'JL'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JV'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JT'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H2'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H3'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # PR × (JL | JV | JT | H2 | H3) + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JL'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JV'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'JT'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H2'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'H3'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB26 Do not break a Korean syllable. + # JL × (JL | JV | H2 | H3) + $lb_table[$lb_enums{'JL'}][$lb_enums{'JL'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JL'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JL'}][$lb_enums{'H2'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JL'}][$lb_enums{'H3'}] = $lb_actions{'LB_NOBREAK'}; + + # (JV | H2) × (JV | JT) + $lb_table[$lb_enums{'JV'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H2'}][$lb_enums{'JV'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'JV'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H2'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; + + # (JT | H3) × JT + $lb_table[$lb_enums{'JT'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'H3'}][$lb_enums{'JT'}] = $lb_actions{'LB_NOBREAK'}; + + # LB25 Do not break between the following pairs of classes relevant to + # numbers, as tailored by example 7 in + # http://www.unicode.org/reports/tr14/#Examples + # We follow that tailoring because Unicode's test cases expect it + # (PR | PO) × ( OP | HY )? NU + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # Given that (OP | HY )? is optional, we have to test for it in code. + # We add in the action (instead of overriding) for this, so that in + # the code we can recover the underlying break value. + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Open_Punctuation'}] + += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; + $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Open_Punctuation'}] + += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hyphen'}] + += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; + $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hyphen'}] + += $lb_actions{'LB_PR_or_PO_then_OP_or_HY'}; + + # ( OP | HY ) × NU + $lb_table[$lb_enums{'Open_Punctuation'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hyphen'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # NU (NU | SY | IS)* × (NU | SY | IS | CL | CP ) + # which can be rewritten as: + # NU (SY | IS)* × (NU | SY | IS | CL | CP ) + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Break_Symbols'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Infix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Punctuation'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Close_Parenthesis'}] + = $lb_actions{'LB_NOBREAK'}; + + # Like earlier where we have to test in code, we add in the action so + # that we can recover the underlying values. This is done in rules + # below, as well. The code assumes that we haven't added 2 actions. + # Shoul a later Unicode release break that assumption, then tests + # should start failing. + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Numeric'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Break_Symbols'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Infix_Numeric'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Punctuation'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Close_Parenthesis'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Numeric'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Break_Symbols'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Infix_Numeric'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Punctuation'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Close_Parenthesis'}] + += $lb_actions{'LB_SY_or_IS_then_various'}; + + # NU (NU | SY | IS)* (CL | CP)? × (PO | PR) + # which can be rewritten as: + # NU (SY | IS)* (CL | CP)? × (PO | PR) + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Prefix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Postfix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Postfix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Postfix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Postfix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Prefix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Prefix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'Prefix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Prefix_Numeric'}] + += $lb_actions{'LB_various_then_PO_or_PR'}; + + # LB24 Do not break between numeric prefix/postfix and letters, or between + # letters and prefix/postfix. + # (PR | PO) × (AL | HL) + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Postfix_Numeric'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + + # (AL | HL) × (PR | PO) + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Prefix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Prefix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB23a Do not break between numeric prefixes and ideographs, or between + # ideographs and numeric postfixes. + # PR × (ID | EB | EM) + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'Ideographic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Base'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Prefix_Numeric'}][$lb_enums{'E_Modifier'}] + = $lb_actions{'LB_NOBREAK'}; + + # (ID | EB | EM) × PO + $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Postfix_Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB23 Do not break between digits and letters + # (AL | HL) × NU + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Numeric'}] + = $lb_actions{'LB_NOBREAK'}; + + # NU × (AL | HL) + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Alphabetic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB22 Do not break between two ellipses, or between letters, numbers or + # exclamations and ellipsis. + # (AL | HL) × IN + $lb_table[$lb_enums{'Alphabetic'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Hebrew_Letter'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # Exclamation × IN + $lb_table[$lb_enums{'Exclamation'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # (ID | EB | EM) × IN + $lb_table[$lb_enums{'Ideographic'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'E_Base'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'E_Modifier'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # IN × IN + $lb_table[$lb_enums{'Inseparable'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # NU × IN + $lb_table[$lb_enums{'Numeric'}][$lb_enums{'Inseparable'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB21b Don’t break between Solidus and Hebrew letters. + # SY × HL + $lb_table[$lb_enums{'Break_Symbols'}][$lb_enums{'Hebrew_Letter'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB21a Don't break after Hebrew + Hyphen. + # HL (HY | BA) × + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Hyphen'}][$i] + += $lb_actions{'LB_HY_or_BA_then_foo'}; + $lb_table[$lb_enums{'Break_After'}][$i] + += $lb_actions{'LB_HY_or_BA_then_foo'}; + } + + # LB21 Do not break before hyphen-minus, other hyphens, fixed-width + # spaces, small kana, and other non-starters, or after acute accents. + # × BA + # × HY + # × NS + # BB × + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Break_After'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'Hyphen'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'Nonstarter'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Break_Before'}][$i] = $lb_actions{'LB_NOBREAK'}; + } + + # LB20 Break before and after unresolved CB. + # ÷ CB + # CB ÷ + # Conditional breaks should be resolved external to the line breaking + # rules. However, the default action is to treat unresolved CB as breaking + # before and after. + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Contingent_Break'}] + = $lb_actions{'LB_BREAKABLE'}; + $lb_table[$lb_enums{'Contingent_Break'}][$i] + = $lb_actions{'LB_BREAKABLE'}; + } + + # LB19 Do not break before or after quotation marks, such as ‘ ” ’. + # × QU + # QU × + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Quotation'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'Quotation'}][$i] = $lb_actions{'LB_NOBREAK'}; + } + + # LB18 Break after spaces + # SP ÷ + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Space'}][$i] = $lb_actions{'LB_BREAKABLE'}; + } + + # LB17 Do not break within ‘——’, even with intervening spaces. + # B2 SP* × B2 + $lb_table[$lb_enums{'Break_Both'}][$lb_enums{'Break_Both'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + + # LB16 Do not break between closing punctuation and a nonstarter even with + # intervening spaces. + # (CL | CP) SP* × NS + $lb_table[$lb_enums{'Close_Punctuation'}][$lb_enums{'Nonstarter'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$lb_enums{'Close_Parenthesis'}][$lb_enums{'Nonstarter'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + + + # LB15 Do not break within ‘”[’, even with intervening spaces. + # QU SP* × OP + $lb_table[$lb_enums{'Quotation'}][$lb_enums{'Open_Punctuation'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + + # LB14 Do not break after ‘[’, even after spaces. + # OP SP* × + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Open_Punctuation'}][$i] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + } + + # LB13 Do not break before ‘]’ or ‘!’ or ‘;’ or ‘/’, even after spaces, as + # tailored by example 7 in http://www.unicode.org/reports/tr14/#Examples + # [^NU] × CL + # [^NU] × CP + # × EX + # [^NU] × IS + # [^NU] × SY + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Exclamation'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + + next if $i == $lb_enums{'Numeric'}; + + $lb_table[$i][$lb_enums{'Close_Punctuation'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$i][$lb_enums{'Close_Parenthesis'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$i][$lb_enums{'Infix_Numeric'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$i][$lb_enums{'Break_Symbols'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + } + + # LB12a Do not break before NBSP and related characters, except after + # spaces and hyphens. + # [^SP BA HY] × GL + for my $i (0 .. @lb_table - 1) { + next if $i == $lb_enums{'Space'} + || $i == $lb_enums{'Break_After'} + || $i == $lb_enums{'Hyphen'}; + + # We don't break, but if a property above has said don't break even + # with space between, don't override that (also in the next few rules) + next if $lb_table[$i][$lb_enums{'Glue'}] + == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$i][$lb_enums{'Glue'}] = $lb_actions{'LB_NOBREAK'}; + } + + # LB12 Do not break after NBSP and related characters. + # GL × + for my $i (0 .. @lb_table - 1) { + next if $lb_table[$lb_enums{'Glue'}][$i] + == $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + $lb_table[$lb_enums{'Glue'}][$i] = $lb_actions{'LB_NOBREAK'}; + } + + # LB11 Do not break before or after Word joiner and related characters. + # × WJ + # WJ × + for my $i (0 .. @lb_table - 1) { + if ($lb_table[$i][$lb_enums{'Word_Joiner'}] + != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) + { + $lb_table[$i][$lb_enums{'Word_Joiner'}] = $lb_actions{'LB_NOBREAK'}; + } + if ($lb_table[$lb_enums{'Word_Joiner'}][$i] + != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) + { + $lb_table[$lb_enums{'Word_Joiner'}][$i] = $lb_actions{'LB_NOBREAK'}; + } + } + + # Special case this here to avoid having to do a special case in the code, + # by making this the same as other things with a SP in front of them that + # don't break, we avoid an extra test + $lb_table[$lb_enums{'Space'}][$lb_enums{'Word_Joiner'}] + = $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}; + + # LB9 and LB10 are done in the same loop + # + # LB9 Do not break a combining character sequence; treat it as if it has + # the line breaking class of the base character in all of the + # higher-numbered rules. Treat ZWJ as if it were CM + # Treat X (CM|ZWJ)* as if it were X. + # where X is any line break class except BK, CR, LF, NL, SP, or ZW. + + # LB10 Treat any remaining combining mark or ZWJ as AL. This catches the + # case where a CM or ZWJ is the first character on the line or follows SP, + # BK, CR, LF, NL, or ZW. + for my $i (0 .. @lb_table - 1) { + + # When the CM or ZWJ is the first in the pair, we don't know without + # looking behind whether the CM or ZWJ is going to attach to an + # earlier character, or not. So have to figure this out at runtime in + # the code + $lb_table[$lb_enums{'Combining_Mark'}][$i] + = $lb_actions{'LB_CM_ZWJ_foo'}; + $lb_table[$lb_enums{'ZWJ'}][$i] = $lb_actions{'LB_CM_ZWJ_foo'}; + + if ( $i == $lb_enums{'Mandatory_Break'} + || $i == $lb_enums{'EDGE'} + || $i == $lb_enums{'Carriage_Return'} + || $i == $lb_enums{'Line_Feed'} + || $i == $lb_enums{'Next_Line'} + || $i == $lb_enums{'Space'} + || $i == $lb_enums{'ZWSpace'}) + { + # For these classes, a following CM doesn't combine, and should do + # whatever 'Alphabetic' would do. + $lb_table[$i][$lb_enums{'Combining_Mark'}] + = $lb_table[$i][$lb_enums{'Alphabetic'}]; + $lb_table[$i][$lb_enums{'ZWJ'}] + = $lb_table[$i][$lb_enums{'Alphabetic'}]; + } + else { + # For these classes, the CM or ZWJ combines, so doesn't break, + # inheriting the type of nobreak from the master character. + if ($lb_table[$i][$lb_enums{'Combining_Mark'}] + != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) + { + $lb_table[$i][$lb_enums{'Combining_Mark'}] + = $lb_actions{'LB_NOBREAK'}; + } + if ($lb_table[$i][$lb_enums{'ZWJ'}] + != $lb_actions{'LB_NOBREAK_EVEN_WITH_SP_BETWEEN'}) + { + $lb_table[$i][$lb_enums{'ZWJ'}] + = $lb_actions{'LB_NOBREAK'}; + } + } + } + + # LB8a Do not break between a zero width joiner and an ideograph, emoji + # base or emoji modifier. This rule prevents breaks within emoji joiner + # sequences. + # ZWJ × (ID | EB | EM) + $lb_table[$lb_enums{'ZWJ'}][$lb_enums{'Ideographic'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'ZWJ'}][$lb_enums{'E_Base'}] + = $lb_actions{'LB_NOBREAK'}; + $lb_table[$lb_enums{'ZWJ'}][$lb_enums{'E_Modifier'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB8 Break before any character following a zero-width space, even if one + # or more spaces intervene. + # ZW SP* ÷ + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'ZWSpace'}][$i] = $lb_actions{'LB_BREAKABLE'}; + } + + # Because of LB8-10, we need to look at context for "SP x", and this must + # be done in the code. So override the existing rules for that, by adding + # a constant to get new rules that tell the code it needs to look at + # context. By adding this action instead of replacing the existing one, + # we can get back to the original rule if necessary. + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Space'}][$i] += $lb_actions{'LB_SP_foo'}; + } + + # LB7 Do not break before spaces or zero width space. + # × SP + # × ZW + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Space'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'ZWSpace'}] = $lb_actions{'LB_NOBREAK'}; + } + + # LB6 Do not break before hard line breaks. + # × ( BK | CR | LF | NL ) + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'Mandatory_Break'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'Carriage_Return'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'Line_Feed'}] = $lb_actions{'LB_NOBREAK'}; + $lb_table[$i][$lb_enums{'Next_Line'}] = $lb_actions{'LB_NOBREAK'}; + } + + # LB5 Treat CR followed by LF, as well as CR, LF, and NL as hard line breaks. + # CR × LF + # CR ! + # LF ! + # NL ! + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Carriage_Return'}][$i] + = $lb_actions{'LB_BREAKABLE'}; + $lb_table[$lb_enums{'Line_Feed'}][$i] = $lb_actions{'LB_BREAKABLE'}; + $lb_table[$lb_enums{'Next_Line'}][$i] = $lb_actions{'LB_BREAKABLE'}; + } + $lb_table[$lb_enums{'Carriage_Return'}][$lb_enums{'Line_Feed'}] + = $lb_actions{'LB_NOBREAK'}; + + # LB4 Always break after hard line breaks. + # BK ! + for my $i (0 .. @lb_table - 1) { + $lb_table[$lb_enums{'Mandatory_Break'}][$i] + = $lb_actions{'LB_BREAKABLE'}; + } + + # LB3 Always break at the end of text. + # ! eot + # LB2 Never break at the start of text. + # sot × + for my $i (0 .. @lb_table - 1) { + $lb_table[$i][$lb_enums{'EDGE'}] = $lb_actions{'LB_BREAKABLE'}; + $lb_table[$lb_enums{'EDGE'}][$i] = $lb_actions{'LB_NOBREAK'}; + } + + # LB1 Assign a line breaking class to each code point of the input. + # Resolve AI, CB, CJ, SA, SG, and XX into other line breaking classes + # depending on criteria outside the scope of this algorithm. + # + # In the absence of such criteria all characters with a specific + # combination of original class and General_Category property value are + # resolved as follows: + # Original Resolved General_Category + # AI, SG, XX AL Any + # SA CM Only Mn or Mc + # SA AL Any except Mn and Mc + # CJ NS Any + # + # This is done in mktables, so we never see any of the remapped-from + # classes. + + output_table_common('LB', \%lb_actions, + \@lb_table, \@lb_short_enums, \%lb_abbreviations); +} + +sub output_WB_table() { + + # Create and output the enums, #defines, and pair table for use in + # determining Word Breaks, given in http://www.unicode.org/reports/tr29/. + + # This uses the same mechanism in the other bounds tables generated by + # this file. The actions that could override a 0 or 1 are added to those + # numbers; the actions that clearly don't depend on the underlying rule + # simply overwrite + my %wb_actions = ( + WB_NOBREAK => 0, + WB_BREAKABLE => 1, + WB_hs_then_hs => 2, + WB_Ex_or_FO_or_ZWJ_then_foo => 3, + WB_DQ_then_HL => 4, + WB_HL_then_DQ => 6, + WB_LE_or_HL_then_MB_or_ML_or_SQ => 8, + WB_MB_or_ML_or_SQ_then_LE_or_HL => 10, + WB_MB_or_MN_or_SQ_then_NU => 12, + WB_NU_then_MB_or_MN_or_SQ => 14, + WB_RI_then_RI => 16, + ); + + # Construct the WB pair table. + # The table is constructed in reverse order of the rules, to make the + # lower-numbered, higher priority ones override the later ones, as the + # algorithm stops at the earliest matching rule + + my @wb_table; + my $table_size = @wb_short_enums - 1; # -1 because we don't use UNKNOWN + die "UNKNOWN must be final WB enum" unless $wb_short_enums[-1] =~ /unk/i; + + # Otherwise, break everywhere (including around ideographs). + # WB99 Any ÷ Any + for my $i (0 .. $table_size - 1) { + for my $j (0 .. $table_size - 1) { + $wb_table[$i][$j] = $wb_actions{'WB_BREAKABLE'}; + } + } + + # Do not break within emoji flag sequences. That is, do not break between + # regional indicator (RI) symbols if there is an odd number of RI + # characters before the break point. + # WB16 [^RI] (RI RI)* RI × RI + # WB15 sot (RI RI)* RI × RI + $wb_table[$wb_enums{'Regional_Indicator'}] + [$wb_enums{'Regional_Indicator'}] = $wb_actions{'WB_RI_then_RI'}; + + # Do not break within emoji modifier sequences. + # WB14 ( E_Base | EBG ) × E_Modifier + $wb_table[$wb_enums{'E_Base'}][$wb_enums{'E_Modifier'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'E_Base_GAZ'}][$wb_enums{'E_Modifier'}] + = $wb_actions{'WB_NOBREAK'}; + + # Do not break from extenders. + # WB13b ExtendNumLet × (ALetter | Hebrew_Letter | Numeric | Katakana) + $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ALetter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Hebrew_Letter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Numeric'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'Katakana'}] + = $wb_actions{'WB_NOBREAK'}; + + # WB13a (ALetter | Hebrew_Letter | Numeric | Katakana | ExtendNumLet) + # × # ExtendNumLet + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ExtendNumLet'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ExtendNumLet'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ExtendNumLet'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Katakana'}][$wb_enums{'ExtendNumLet'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ExtendNumLet'}][$wb_enums{'ExtendNumLet'}] + = $wb_actions{'WB_NOBREAK'}; + + # Do not break between Katakana. + # WB13 Katakana × Katakana + $wb_table[$wb_enums{'Katakana'}][$wb_enums{'Katakana'}] + = $wb_actions{'WB_NOBREAK'}; + + # Do not break within sequences, such as “3.2” or “3,456.789”. + # WB12 Numeric × (MidNum | MidNumLet | Single_Quote) Numeric + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNumLet'}] + += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'MidNum'}] + += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Single_Quote'}] + += $wb_actions{'WB_NU_then_MB_or_MN_or_SQ'}; + + # WB11 Numeric (MidNum | (MidNumLet | Single_Quote)) × Numeric + $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Numeric'}] + += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; + $wb_table[$wb_enums{'MidNum'}][$wb_enums{'Numeric'}] + += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; + $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Numeric'}] + += $wb_actions{'WB_MB_or_MN_or_SQ_then_NU'}; + + # Do not break within sequences of digits, or digits adjacent to letters + # (“3a”, or “A3”). + # WB10 Numeric × (ALetter | Hebrew_Letter) + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'ALetter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Hebrew_Letter'}] + = $wb_actions{'WB_NOBREAK'}; + + # WB9 (ALetter | Hebrew_Letter) × Numeric + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Numeric'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Numeric'}] + = $wb_actions{'WB_NOBREAK'}; + + # WB8 Numeric × Numeric + $wb_table[$wb_enums{'Numeric'}][$wb_enums{'Numeric'}] + = $wb_actions{'WB_NOBREAK'}; + + # Do not break letters across certain punctuation. + # WB7c Hebrew_Letter Double_Quote × Hebrew_Letter + $wb_table[$wb_enums{'Double_Quote'}][$wb_enums{'Hebrew_Letter'}] + += $wb_actions{'WB_DQ_then_HL'}; + + # WB7b Hebrew_Letter × Double_Quote Hebrew_Letter + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Double_Quote'}] + += $wb_actions{'WB_HL_then_DQ'}; + + # WB7a Hebrew_Letter × Single_Quote + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}] + = $wb_actions{'WB_NOBREAK'}; + + # WB7 (ALetter | Hebrew_Letter) (MidLetter | MidNumLet | Single_Quote) + # × (ALetter | Hebrew_Letter) + $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'ALetter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + $wb_table[$wb_enums{'MidNumLet'}][$wb_enums{'Hebrew_Letter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'ALetter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + $wb_table[$wb_enums{'MidLetter'}][$wb_enums{'Hebrew_Letter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'ALetter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + $wb_table[$wb_enums{'Single_Quote'}][$wb_enums{'Hebrew_Letter'}] + += $wb_actions{'WB_MB_or_ML_or_SQ_then_LE_or_HL'}; + + # WB6 (ALetter | Hebrew_Letter) × (MidLetter | MidNumLet + # | Single_Quote) (ALetter | Hebrew_Letter) + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidNumLet'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidNumLet'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'MidLetter'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'MidLetter'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Single_Quote'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Single_Quote'}] + += $wb_actions{'WB_LE_or_HL_then_MB_or_ML_or_SQ'}; + + # Do not break between most letters. + # WB5 (ALetter | Hebrew_Letter) × (ALetter | Hebrew_Letter) + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'ALetter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ALetter'}][$wb_enums{'Hebrew_Letter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'ALetter'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Hebrew_Letter'}] + = $wb_actions{'WB_NOBREAK'}; + + # Ignore Format and Extend characters, except after sot, CR, LF, and + # Newline. This also has the effect of: Any × (Format | Extend | ZWJ) + # WB4 X (Extend | Format | ZWJ)* → X + for my $i (0 .. @wb_table - 1) { + $wb_table[$wb_enums{'Extend'}][$i] + = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; + $wb_table[$wb_enums{'Format'}][$i] + = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; + $wb_table[$wb_enums{'ZWJ'}][$i] + = $wb_actions{'WB_Ex_or_FO_or_ZWJ_then_foo'}; + } + for my $i (0 .. @wb_table - 1) { + $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'}; + $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'}; + $wb_table[$i][$wb_enums{'ZWJ'}] = $wb_actions{'WB_NOBREAK'}; + } + + # Implied is that these attach to the character before them, except for + # the characters that mark the end of a region of text. The rules below + # override the ones set up here, for all the characters that need + # overriding. + for my $i (0 .. @wb_table - 1) { + $wb_table[$i][$wb_enums{'Extend'}] = $wb_actions{'WB_NOBREAK'}; + $wb_table[$i][$wb_enums{'Format'}] = $wb_actions{'WB_NOBREAK'}; + } + + # Do not break within emoji zwj sequences. + # WB3c ZWJ × ( Glue_After_Zwj | EBG ) + $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'Glue_After_Zwj'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'ZWJ'}][$wb_enums{'E_Base_GAZ'}] + = $wb_actions{'WB_NOBREAK'}; + + # Break before and after white space + # WB3b ÷ (Newline | CR | LF) + # WB3a (Newline | CR | LF) ÷ + # et. al. + for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { + for my $j (0 .. @wb_table - 1) { + $wb_table[$j][$wb_enums{$i}] = $wb_actions{'WB_BREAKABLE'}; + $wb_table[$wb_enums{$i}][$j] = $wb_actions{'WB_BREAKABLE'}; + } + } + + # But do not break within white space. + # WB3 CR × LF + # et.al. + for my $i ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { + for my $j ('CR', 'LF', 'Newline', 'Perl_Tailored_HSpace') { + $wb_table[$wb_enums{$i}][$wb_enums{$j}] = $wb_actions{'WB_NOBREAK'}; + } + } + + # And do not break horizontal space followed by Extend or Format or ZWJ + $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Extend'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'Format'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Perl_Tailored_HSpace'}][$wb_enums{'ZWJ'}] + = $wb_actions{'WB_NOBREAK'}; + $wb_table[$wb_enums{'Perl_Tailored_HSpace'}] + [$wb_enums{'Perl_Tailored_HSpace'}] + = $wb_actions{'WB_hs_then_hs'}; + + # Break at the start and end of text, unless the text is empty + # WB2 Any ÷ eot + # WB1 sot ÷ Any + for my $i (0 .. @wb_table - 1) { + $wb_table[$i][$wb_enums{'EDGE'}] = $wb_actions{'WB_BREAKABLE'}; + $wb_table[$wb_enums{'EDGE'}][$i] = $wb_actions{'WB_BREAKABLE'}; + } + $wb_table[$wb_enums{'EDGE'}][$wb_enums{'EDGE'}] = 0; + + output_table_common('WB', \%wb_actions, + \@wb_table, \@wb_short_enums, \%wb_abbreviations); } +sub sanitize_name ($) { + # Change the non-word characters in the input string to standardized word + # equivalents + # + my $sanitized = shift; + $sanitized =~ s/=/__/; + $sanitized =~ s/&/_AMP_/; + $sanitized =~ s/\./_DOT_/; + $sanitized =~ s/-/_MINUS_/; + $sanitized =~ s!/!_SLASH_!; + + return $sanitized; +} + +switch_pound_if ('ALL', 'PERL_IN_UTF8_C'); + output_invlist("Latin1", [ 0, 256 ]); output_invlist("AboveLatin1", [ 256 ]); @@ -340,65 +2157,217 @@ end_file_pound_if; # An initial & means to use the subroutine from this file instead of an # official inversion list. -for my $charset (get_supported_code_pages()) { - print $out_fh "\n" . get_conditional_compile_line_start($charset); - - @a2n = @{get_a2n($charset)}; - no warnings 'qw'; - # Ignore non-alpha in sort - for my $prop (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw( - ASCII - Cased - VertSpace - XPerlSpace - XPosixAlnum - XPosixAlpha - XPosixBlank - XPosixCntrl - XPosixDigit - XPosixGraph - XPosixLower - XPosixPrint - XPosixPunct - XPosixSpace - XPosixUpper - XPosixWord - XPosixXDigit - _Perl_Any_Folds - &NonL1_Perl_Non_Final_Folds - _Perl_Folds_To_Multi_Char - &UpperLatin1 - _Perl_IDStart - _Perl_IDCont - Grapheme_Cluster_Break,EDGE - Word_Break,EDGE,UNKNOWN - Sentence_Break,EDGE - ) - ) { - - # For the Latin1 properties, we change to use the eXtended version of the - # base property, then go through the result and get rid of everything not - # in Latin1 (above 255). Actually, we retain the element for the range - # that crosses the 255/256 boundary if it is one that matches the - # property. For example, in the Word property, there is a range of code - # points that start at U+00F8 and goes through U+02C1. Instead of - # artificially cutting that off at 256 because 256 is the first code point - # above Latin1, we let the range go to its natural ending. That gives us - # extra information with no added space taken. But if the range that - # crosses the boundary is one that doesn't match the property, we don't - # start a new range above 255, as that could be construed as going to - # infinity. For example, the Upper property doesn't include the character - # at 255, but does include the one at 256. We don't include the 256 one. - my $prop_name = $prop; - my $is_local_sub = $prop_name =~ s/^&//; - my $extra_enums = ""; - $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x; - my $lookup_prop = $prop_name; - my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/ - or $lookup_prop =~ s/^L1//); - my $nonl1_only = 0; - $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only; - ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x; +# Below is the list of property names to generate. '&' means to use the +# subroutine to generate the inversion list instead of the generic code +# below. Some properties have a comma-separated list after the name, +# These are extra enums to add to those found in the Unicode tables. +no warnings 'qw'; + # Ignore non-alpha in sort +my @props; +push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw( + &NonL1_Perl_Non_Final_Folds + &UpperLatin1 + _Perl_GCB,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,EDGE + _Perl_LB,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,EDGE, + _Perl_SB,SContinue,CR,Extend,LF,EDGE + _Perl_WB,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,EDGE,UNKNOWN + _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID + Lowercase_Mapping + Titlecase_Mapping + Uppercase_Mapping + Simple_Case_Folding + Case_Folding + &_Perl_IVCF + ); + # NOTE that the convention is that extra enum values come + # after the property name, separated by commas, with the enums + # that aren't ever defined by Unicode coming last, at least 4 + # all-uppercase characters. The others are enum names that + # are needed by perl, but aren't in all Unicode releases. + +my @bin_props; +my @perl_prop_synonyms; +my %enums; +my @deprecated_messages = ""; # Element [0] is a placeholder +my %deprecated_tags; + +my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x; + +# Create another hash that maps floating point x.yyEzz representation to what +# %stricter_to_file_of does for the equivalent rational. A typical entry in +# the latter hash is +# +# 'nv=1/2' => 'Nv/1_2', +# +# From that, this loop creates an entry +# +# 'nv=5.00e-01' => 'Nv/1_2', +# +# %stricter_to_file_of contains far more than just the rationals. Instead we +# use %utf8::nv_floating_to_rational which should have an entry for each +# nv in the former hash. +my %floating_to_file_of; +foreach my $key (keys %utf8::nv_floating_to_rational) { + my $value = $utf8::nv_floating_to_rational{$key}; + $floating_to_file_of{$key} = $utf8::stricter_to_file_of{"nv=$value"}; +} + +# Collect all the binary properties from data in lib/unicore +# Sort so that complements come after the main table, and the shortest +# names first, finally alphabetically. Also, sort together the tables we want +# to be kept together, and prefer those with 'posix' in their names, which is +# what the C code is expecting their names to be. +foreach my $property (sort + { exists $keep_together{lc $b} <=> exists $keep_together{lc $a} + or $b =~ /posix/i <=> $a =~ /posix/i + or $b =~ /perl/i <=> $a =~ /perl/i + or $a =~ $float_e_format <=> $b =~ $float_e_format + or $a =~ /!/ <=> $b =~ /!/ + or length $a <=> length $b + or $a cmp $b + } keys %utf8::loose_to_file_of, + keys %utf8::stricter_to_file_of, + keys %floating_to_file_of +) { + + # These two hashes map properties to values that can be considered to + # be checksums. If two properties have the same checksum, they have + # identical entries. Otherwise they differ in some way. + my $tag = $utf8::loose_to_file_of{$property}; + $tag = $utf8::stricter_to_file_of{$property} unless defined $tag; + $tag = $floating_to_file_of{$property} unless defined $tag; + + # The tag may contain an '!' meaning it is identical to the one formed + # by removing the !, except that it is inverted. + my $inverted = $tag =~ s/!//; + + # This hash is lacking the property name + $property = "nv=$property" if $property =~ $float_e_format; + + # The list of 'prop=value' entries that this single entry expands to + my @this_entries; + + # Split 'property=value' on the equals sign, with $lhs being the whole + # thing if there is no '=' + my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x; + + # $lhs then becomes the property name. See if there are any synonyms + # for this property. + if (exists $prop_name_aliases{$lhs}) { + + # If so, do the combinatorics so that a new entry is added for + # each legal property combined with the property value (which is + # $rhs) + foreach my $alias (@{$prop_name_aliases{$lhs}}) { + + # But, there are some ambiguities, like 'script' is a synonym + # for 'sc', and 'sc' can stand alone, meaning something + # entirely different than 'script'. 'script' cannot stand + # alone. Don't add if the potential new lhs is in the hash of + # stand-alone properties. + no warnings 'once'; + next if $rhs eq "" && grep { $alias eq $_ } + keys %utf8::loose_property_to_file_of; + + my $new_entry = $alias . $rhs; + push @this_entries, $new_entry; + } + } + + # Above, we added the synonyms for the base entry we're now + # processing. But we haven't dealt with it yet. If we already have a + # property with the identical characteristics, this becomes just a + # synonym for it. + if (exists $enums{$tag}) { + push @this_entries, $property; + } + else { # Otherwise, create a new entry. + + # Add to the list of properties to generate inversion lists for. + push @bin_props, uc $property; + + # Create a rule for the parser + if (! exists $keywords{$property}) { + $keywords{$property} = token_name($property); + } + + # And create an enum for it. + $enums{$tag} = $table_name_prefix . uc sanitize_name($property); + + $perl_tags{$tag} = 1 if exists $keep_together{lc $property}; + + # Some properties are deprecated. This hash tells us so, and the + # warning message to raise if they are used. + if (exists $utf8::why_deprecated{$tag}) { + $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages; + push @deprecated_messages, $utf8::why_deprecated{$tag}; + } + + # Our sort above should have made sure that we see the + # non-inverted version first, but this makes sure. + warn "$property is inverted!!!" if $inverted; + } + + # Everything else is #defined to be the base enum, inversion is + # indicated by negating the value. + my $defined_to = ""; + $defined_to .= "-" if $inverted; + $defined_to .= $enums{$tag}; + + # Go through the entries that evaluate to this. + @this_entries = uniques @this_entries; + foreach my $define (@this_entries) { + + # There is a rule for the parser for each. + $keywords{$define} = $defined_to; + + # And a #define for all simple names equivalent to a perl property, + # except those that begin with 'is' or 'in'; + if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) { + push @perl_prop_synonyms, "#define " + . $table_name_prefix + . uc(sanitize_name($define)) + . " $defined_to"; + } + } +} + +@bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a} + or $a cmp $b + } @bin_props; +@perl_prop_synonyms = sort(uniques(@perl_prop_synonyms)); +push @props, @bin_props; + +foreach my $prop (@props) { + + # For the Latin1 properties, we change to use the eXtended version of the + # base property, then go through the result and get rid of everything not + # in Latin1 (above 255). Actually, we retain the element for the range + # that crosses the 255/256 boundary if it is one that matches the + # property. For example, in the Word property, there is a range of code + # points that start at U+00F8 and goes through U+02C1. Instead of + # artificially cutting that off at 256 because 256 is the first code point + # above Latin1, we let the range go to its natural ending. That gives us + # extra information with no added space taken. But if the range that + # crosses the boundary is one that doesn't match the property, we don't + # start a new range above 255, as that could be construed as going to + # infinity. For example, the Upper property doesn't include the character + # at 255, but does include the one at 256. We don't include the 256 one. + my $prop_name = $prop; + my $is_local_sub = $prop_name =~ s/^&//; + my $extra_enums = ""; + $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x; + my $lookup_prop = $prop_name; + $prop_name = sanitize_name($prop_name); + $prop_name = $table_name_prefix . $prop_name if grep { lc $lookup_prop eq lc $_ } @bin_props; + my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/ + or $lookup_prop =~ s/^L1//); + my $nonl1_only = 0; + $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only; + ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x; + + for my $charset (get_supported_code_pages()) { + @a2n = @{get_a2n($charset)}; my @invlist; my @invmap; @@ -406,26 +2375,51 @@ for my $charset (get_supported_code_pages()) { my $map_default; my $maps_to_code_point; my $to_adjust; + my $same_in_all_code_pages; if ($is_local_sub) { - @invlist = eval $lookup_prop; + my @return = eval $lookup_prop; + die $@ if $@; + my $invlist_ref = shift @return; + @invlist = @$invlist_ref; + if (@return) { # If has other values returned , must be an + # inversion map + my $invmap_ref = shift @return; + @invmap = @$invmap_ref; + $map_format = shift @return; + $map_default = shift @return; + } } else { @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok'); if (! @invlist) { - my ($list_ref, $map_ref, $format, $default); - ($list_ref, $map_ref, $format, $default) + # If couldn't find a non-empty inversion list, see if it is + # instead an inversion map + my ($list_ref, $map_ref, $format, $default) = prop_invmap($lookup_prop, '_perl_core_internal_ok'); - die "Could not find inversion list for '$lookup_prop'" unless $list_ref; - @invlist = @$list_ref; - @invmap = @$map_ref; - $map_format = $format; - $map_default = $default; - $maps_to_code_point = $map_format =~ /x/; - $to_adjust = $map_format =~ /a/; + if (! $list_ref) { + # An empty return here could mean an unknown property, or + # merely that the original inversion list is empty. Call + # in scalar context to differentiate + my $count = prop_invlist($lookup_prop, + '_perl_core_internal_ok'); + if (defined $count) { + # Short-circuit an empty inversion list. + output_invlist($prop_name, \@invlist, $charset); + last; + } + die "Could not find inversion list for '$lookup_prop'" + } + else { + @invlist = @$list_ref; + @invmap = @$map_ref; + $map_format = $format; + $map_default = $default; + $maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x; + $to_adjust = $map_format =~ /a/; + } } } - die "Could not find inversion list for '$lookup_prop'" unless @invlist; # Re-order the Unicode code points to native ones for this platform. # This is only needed for code points below 256, because native code @@ -449,40 +2443,42 @@ for my $charset (get_supported_code_pages()) { # of 0..256, as the remap will also include all of 0..256 (256 not # 255 because a re-ordering could cause 256 to need to be in the same # range as 255.) - if ((@invmap && $maps_to_code_point) - || (! $nonl1_only || ($invlist[0] < 256 - && ! ($invlist[0] == 0 && $invlist[1] > 256)))) + if ( (@invmap && $maps_to_code_point) + || ( @invlist + && $invlist[0] < 256 + && ( $invlist[0] != 0 + || (scalar @invlist != 1 && $invlist[1] < 256)))) { - + $same_in_all_code_pages = 0; if (! @invmap) { # Straight inversion list - # Look at all the ranges that start before 257. - my @latin1_list; - while (@invlist) { - last if $invlist[0] > 256; - my $upper = @invlist > 1 - ? $invlist[1] - 1 # In range - - # To infinity. You may want to stop much much - # earlier; going this high may expose perl - # deficiencies with very large numbers. - : $Unicode::UCD::MAX_CP; - for my $j ($invlist[0] .. $upper) { - push @latin1_list, a2n($j); - } + # Look at all the ranges that start before 257. + my @latin1_list; + while (@invlist) { + last if $invlist[0] > 256; + my $upper = @invlist > 1 + ? $invlist[1] - 1 # In range + + # To infinity. You may want to stop much much + # earlier; going this high may expose perl + # deficiencies with very large numbers. + : 256; + for my $j ($invlist[0] .. $upper) { + push @latin1_list, a2n($j); + } - shift @invlist; # Shift off the range that's in the list - shift @invlist; # Shift off the range not in the list - } + shift @invlist; # Shift off the range that's in the list + shift @invlist; # Shift off the range not in the list + } - # Here @invlist contains all the ranges in the original that start - # at code points above 256, and @latin1_list contains all the - # native code points for ranges that start with a Unicode code - # point below 257. We sort the latter and convert it to inversion - # list format. Then simply prepend it to the list of the higher - # code points. - @latin1_list = sort { $a <=> $b } @latin1_list; - @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list); - unshift @invlist, @latin1_list; + # Here @invlist contains all the ranges in the original that + # start at code points above 256, and @latin1_list contains + # all the native code points for ranges that start with a + # Unicode code point below 257. We sort the latter and + # convert it to inversion list format. Then simply prepend it + # to the list of the higher code points. + @latin1_list = sort { $a <=> $b } @latin1_list; + @latin1_list = mk_invlist_from_sorted_cp_list(\@latin1_list); + unshift @invlist, @latin1_list; } else { # Is an inversion map @@ -503,7 +2499,11 @@ for my $charset (get_supported_code_pages()) { # to look at the whole of the inversion map (or at least to # above Unicode; as the maps of code points above that should # all be to the default). - my $upper_limit = ($maps_to_code_point) ? 0x10FFFF : 256; + my $upper_limit = (! $maps_to_code_point) + ? 256 + : (Unicode::UCD::UnicodeVersion() eq '1.1.5') + ? 0xFFFF + : 0x10FFFF; my %mapped_lists; # A hash whose keys are the buckets. while (@invlist) { @@ -511,19 +2511,16 @@ for my $charset (get_supported_code_pages()) { # This shouldn't actually happen, as prop_invmap() returns # an extra element at the end that is beyond $upper_limit - die "inversion map that extends to infinity is unimplemented" unless @invlist > 1; + die "inversion map (for $prop_name) that extends to infinity is unimplemented" unless @invlist > 1; my $bucket; # A hash key can't be a ref (we are only expecting arrays # of scalars here), so convert any such to a string that # will be converted back later (using a vertical tab as - # the separator). Even if the mapping is to code points, - # we don't translate to native here because the code - # output_map() calls to output these arrays assumes the - # input is Unicode, not native. + # the separator). if (ref $invmap[0]) { - $bucket = join "\cK", @{$invmap[0]}; + $bucket = join "\cK", map { a2n($_) } @{$invmap[0]}; } elsif ($maps_to_code_point && $invmap[0] =~ $numeric_re) { @@ -576,9 +2573,9 @@ for my $charset (get_supported_code_pages()) { # originals that start with code points above $upper_limit. # Each bucket in %mapped_lists contains all the code points # that map to that bucket. If the bucket is for a map to a - # single code point is a single code point, the bucket has - # been converted to native. If something else (including - # multiple code points), no conversion is done. + # single code point, the bucket has been converted to native. + # If something else (including multiple code points), no + # conversion is done. # # Now we recreate the inversion map into %xlated, but this # time for the native character set. @@ -604,7 +2601,17 @@ for my $charset (get_supported_code_pages()) { @{$xlated{$range_start}} = split /\cK/, $bucket; } else { - $xlated{$range_start} = $bucket; + # If adjusting, and there is more than one thing + # that maps to the same thing, they must be split + # so that later the adjusting doesn't think the + # subsequent items can go away because of the + # adjusting. + my $range_end = ($to_adjust && $bucket != $map_default) + ? $mapped_lists{$bucket}->[1] - 1 + : $range_start; + for my $i ($range_start .. $range_end) { + $xlated{$i} = $bucket; + } } shift @{$mapped_lists{$bucket}}; # Discard odd ranges shift @{$mapped_lists{$bucket}}; # Get ready for next @@ -646,6 +2653,13 @@ for my $charset (get_supported_code_pages()) { unshift @invlist, @new_invlist; } } + elsif (@invmap) { # inversion maps can't cope with this variable + # being true, even if it could be true + $same_in_all_code_pages = 0; + } + else { + $same_in_all_code_pages = 1; + } # prop_invmap() returns an extra final entry, which we can now # discard. @@ -700,22 +2714,100 @@ for my $charset (get_supported_code_pages()) { $found_nonl1 = 1; last; } - die "No non-Latin1 code points in $lookup_prop" unless $found_nonl1; + if (! $found_nonl1) { + warn "No non-Latin1 code points in $prop_name"; + output_invlist($prop_name, []); + last; + } + } + + switch_pound_if ($prop_name, 'PERL_IN_UTF8_C'); + start_charset_pound_if($charset, 1) unless $same_in_all_code_pages; + + output_invlist($prop_name, \@invlist, ($same_in_all_code_pages) + ? $applies_to_all_charsets_text + : $charset); + + if (@invmap) { + output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, + $map_default, $extra_enums, $charset); } - output_invlist($prop_name, \@invlist, $charset); - output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, $map_default, $extra_enums, $charset) if @invmap; + last if $same_in_all_code_pages; + end_charset_pound_if; } - end_file_pound_if; - print $out_fh "\n" . get_conditional_compile_line_end(); } +switch_pound_if ('binary_property_tables', 'PERL_IN_UTF8_C'); + +print $out_fh "\nconst char * deprecated_property_msgs[] = {\n\t"; +print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages; +print $out_fh "\n};\n"; + +my @enums = sort values %enums; + +# Save a copy of these before modification +my @invlist_names = map { "${_}_invlist" } @enums; + +# Post-process the enums for deprecated properties. +if (scalar keys %deprecated_tags) { + my $seen_deprecated = 0; + foreach my $enum (@enums) { + if (grep { $_ eq $enum } keys %deprecated_tags) { + + # Change the enum name for this deprecated property to a + # munged one to act as a placeholder in the typedef. Then + # make the real name be a #define whose value is such that + # its modulus with the number of enums yields the index into + # the table occupied by the placeholder. And so that dividing + # the #define value by the table length gives an index into + # the table of deprecation messages for the corresponding + # warning. + my $revised_enum = "${enum}_perl_aux"; + if (! $seen_deprecated) { + $seen_deprecated = 1; + print $out_fh "\n"; + } + print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n"; + $enum = $revised_enum; + } + } +} + +print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,\n\t"; +print $out_fh join ",\n\t", @enums; +print $out_fh "\n"; +print $out_fh "} binary_invlist_enum;\n"; +print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n"; + +print $out_fh "\n/* Synonyms for perl properties */\n"; +print $out_fh join "\n", @perl_prop_synonyms, "\n"; + +print $out_fh "\nstatic const UV * const PL_uni_prop_ptrs\[] = {\n"; +print $out_fh "\tNULL,\t/* Placeholder */\n\t"; +print $out_fh join ",\n\t", @invlist_names; +print $out_fh "\n"; +print $out_fh "};\n"; + +switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C'); + +output_GCB_table(); +output_LB_table(); +output_WB_table(); + +end_file_pound_if; + my $sources_list = "lib/unicore/mktables.lst"; -my @sources = ($0, "lib/Unicode/UCD.pm"); +my @sources = qw(regen/mk_invlists.pl + lib/unicore/mktables + lib/Unicode/UCD.pm + regen/charset_translations.pl + regen/mk_PL_charclass.pl + ); { # Depend on mktables’ own sources. It’s a shorter list of files than # those that Unicode::UCD uses. - if (! open my $mktables_list, $sources_list) { + if (! open my $mktables_list, '<', $sources_list) { # This should force a rebuild once $sources_list exists push @sources, $sources_list; @@ -728,4 +2820,32 @@ my @sources = ($0, "lib/Unicode/UCD.pm"); } } } -read_only_bottom_close_and_rename($out_fh, \@sources) + +read_only_bottom_close_and_rename($out_fh, \@sources); + +require './regen/mph.pl'; + +sub token_name +{ + my $name = sanitize_name(shift); + warn "$name contains non-word" if $name =~ /\W/; + + return "$table_name_prefix\U$name" +} + +my $keywords_fh = open_new('uni_keywords.h', '>', + {style => '*', by => 'regen/mk_invlists.pl', + from => "mph.pl"}); + +no warnings 'once'; +print $keywords_fh <<"EOF"; +/* The precisionn to use in "%.*e" formats */ +#define PL_E_FORMAT_PRECISION $utf8::e_precision + +EOF + +my ($second_level, $seed1, $length_all_keys, $smart_blob, $rows) = MinimalPerfectHash::make_mph_from_hash(\%keywords); +print $keywords_fh MinimalPerfectHash::make_algo($second_level, $seed1, $length_all_keys, $smart_blob, $rows, undef, undef, undef, 'match_uniprop' ); + +push @sources, 'regen/mph.pl'; +read_only_bottom_close_and_rename($keywords_fh, \@sources);