#!perl -w
use 5.015;
use strict;
use warnings;
use Unicode::UCD qw(prop_aliases
prop_values
prop_value_aliases
prop_invlist
prop_invmap search_invlist
charprop
num
charblock
);
require './regen/regen_lib.pl';
require './regen/charset_translations.pl';
require './lib/unicore/UCD.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.
# Thus, the lists it contains are essentially pre-compiled, and need only a
# light-weight fast wrapper to make them usable at run-time.
# As such, this code knows about the internal structure of these lists, and
# any change made to that has to be done here as well. A random number stored
# in the headers is used to minimize the possibility of things getting
# out-of-sync, or the wrong data structure being passed. Currently that
# random number is:
my $VERSION_DATA_STRUCTURE_TYPE = 148565664;
# charclass_invlists.h now also contains inversion maps and enum definitions
# for those maps that have a finite number of possible values
# integer or float (no exponent)
my $integer_or_float_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
# Also includes rationals
my $numeric_re = qr! $integer_or_float_re | ^ -? \d+ / \d+ $ !x;
# More than one code point may have the same code point as their fold. This
# gives the maximum number in the current Unicode release. (The folded-to
# code point is not included in this count.) Most folds are pairs of code
# points, like 'B' and 'b', so this number is at least one.
my $max_fold_froms = 1;
my %keywords;
my $table_name_prefix = "UNI_";
# 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 => 'regen/mk_invlists.pl',
from => "Unicode::UCD"});
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";
print $out_fh <<'EOF';
/* This gives the number of code points that can be in the bitmap of an ANYOF
* node. The shift number must currently be one of: 8..12. It can't be less
* than 8 (256) because some code relies on it being at least that. Above 12
* (4096), and you start running into warnings that some data structure widths
* have been exceeded, though the test suite as of this writing still passes
* for up through 16, which is as high as anyone would ever want to go,
* encompassing all of the Unicode BMP, and thus including all the economically
* important world scripts. At 12 most of them are: including Arabic,
* Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
* Japanese, nor Korean. (The regarglen structure in regnodes.h is a U8, and
* the trie types TRIEC and AHOCORASICKC are larger than U8 for shift values
* above 12.) Be sure to benchmark before changing, as larger sizes do
* significantly slow down the test suite */
EOF
my $num_anyof_code_points = '(1 << 8)';
print $out_fh "#define NUM_ANYOF_CODE_POINTS $num_anyof_code_points\n\n";
$num_anyof_code_points = eval $num_anyof_code_points;
no warnings 'once';
print $out_fh <<"EOF";
/* The precision to use in "%.*e" formats */
#define PL_E_FORMAT_PRECISION $Unicode::UCD::e_precision
EOF
# 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 =
(
#_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 %Unicode::UCD::loose_property_name_of) {
my $canonical = $Unicode::UCD::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_is_in_multi_char_fold => 1,
_perl_non_final_folds => 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
my $unused_table_hdr = 'u'; # Heading for row or column for unused values
sub uniques {
# Returns non-duplicated input values. From "Perl Best Practices:
# Encapsulated Cleverness". p. 455 in first edition.
my %seen;
return grep { ! $seen{$_}++ } @_;
}
sub caselessly { lc $a cmp lc $b }
sub a2n($) {
my $cp = shift;
# Returns the input Unicode code point translated to native.
return $cp if $cp !~ $integer_or_float_re || $cp > 255;
return $a2n[$cp];
}
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 = "";
}
}
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 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};
}
foreach my $element (@new_pound_if) {
# regcomp.c is arranged so that the tables are not compiled in
# re_comp.c, but general enums and defines (which take no space) are
# compiled */
my $no_xsub = 1 if $name !~ /enum|define/
&& $element =~ / PERL_IN_ (?: REGCOMP ) _C /x;
$element = "defined($element)";
$element = "($element && ! defined(PERL_IN_XSUB_RE))" if $no_xsub;
}
$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;
}
$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);
}
{ # Closure
my $fh;
my $in_doinit = 0;
sub output_table_header($$$;$@) {
# Output to $fh the heading for a table given by the other inputs
$fh = shift;
my ($type, # typedef of table, like UV, UV*
$name, # name of table
$comment, # Optional comment to put on header line
@sizes # Optional sizes of each array index. If omitted,
# there is a single index whose size is computed by
# the C compiler.
) = @_;
$type =~ s/ \s+ $ //x;
# If a the typedef is a ptr, add in an extra const
$type .= " const" if $type =~ / \* $ /x;
$comment = "" unless defined $comment;
$comment = " /* $comment */" if $comment;
my $array_declaration;
if (@sizes) {
$array_declaration = "";
$array_declaration .= "[$_]" for @sizes;
}
else {
$array_declaration = '[]';
}
my $declaration = "$type ${name}$array_declaration";
# Things not matching this are static. Otherwise, it is an external
# constant, initialized only under DOINIT.
#
# (Currently everything is static)
if ($in_file_pound_if !~ / PERL_IN_ (?: ) _C /x) {
$in_doinit = 0;
print $fh "\nstatic const $declaration = {$comment\n";
}
else {
$in_doinit = 1;
print $fh <<EOF;
# ifndef DOINIT
EXTCONST $declaration;
# else
EXTCONST $declaration = {$comment
EOF
}
}
sub output_table_trailer() {
# Close out a table started by output_table_header()
print $fh "};\n";
if ($in_doinit) {
print $fh "\n# endif /* DOINIT */\n\n";
$in_doinit = 0;
}
}
} # End closure
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';
# 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 && $invlist->[0] != 0) {
unshift @$invlist, 0;
$zero_or_one = 1;
}
$charset = "for $charset" if $charset;
output_table_header($out_fh, "UV", "${name}_invlist", $charset);
my $count = @$invlist;
print $out_fh <<EOF;
\t$count,\t/* Number of elements */
\t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */
\t$zero_or_one,\t/* 0 if the list starts at 0;
\t\t 1 if it starts at the element beyond 0 */
EOF
# The main body are the UVs passed in to this routine. Do the final
# element separately
for my $i (0 .. @$invlist - 1) {
printf $out_fh "\t0x%X", $invlist->[$i];
print $out_fh "," if $i < @$invlist - 1;
print $out_fh "\n";
}
output_table_trailer();
}
sub output_invmap ($$$$$$$) {
my $name = shift;
my $invmap = shift; # Reference to inversion map array
my $prop_name = shift;
my $input_format = shift; # The inversion map's format
my $default = shift; # The property value for code points who
# otherwise don't have a value specified.
my $extra_enums = shift; # comma-separated list of our additions to the
# property's standard possible values
my $charset = shift // ""; # name of character set for comment
# Output the inversion map $invmap for property $prop_name, but use $name
# as the actual data structure's name.
my $count = @$invmap;
my $output_format;
my $invmap_declaration_type;
my $enum_declaration_type;
my $aux_declaration_type;
my %enums;
my $name_prefix;
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 caselessly uniques(@$invmap);
}
else {
foreach my $element (@$invmap) {
if (ref $element) {
push @input_enums, @$element;
}
else {
push @input_enums, $element;
}
}
@input_enums = sort caselessly uniques(@input_enums);
}
}
# The internal enums come last, and in the order specified.
#
# The internal one named EDGE is also used a marker. Any ones that
# come after it are used in the algorithms below, and so must be
# defined, even if the release of Unicode this is being compiled for
# doesn't use them. But since no code points are assigned to them in
# such a release, those values will never be accessed. We collapse
# all of them into a single placholder row and a column. The
# algorithms below will fill in those cells with essentially garbage,
# but they are never read, so it doesn't matter. This allows the
# algorithm to remain the same from release to release.
#
# In one case, regexec.c also uses a placeholder which must be defined
# here, and we put it in the unused row and column as its value is
# never read.
#
my @enums = @input_enums;
my @extras;
my @unused_enums;
my $unused_enum_value = @enums;
if ($extra_enums ne "") {
@extras = split /,/, $extra_enums;
my $seen_EDGE = 0;
# Don't add if already there.
foreach my $this_extra (@extras) {
next if grep { $_ eq $this_extra } @enums;
if ($this_extra eq 'EDGE') {
push @enums, $this_extra;
$seen_EDGE = 1;
}
elsif ($seen_EDGE) {
push @unused_enums, $this_extra;
}
else {
push @enums, $this_extra;
}
}
@unused_enums = sort caselessly @unused_enums;
$unused_enum_value = @enums; # All unused have the same value,
# one beyond the final used one
}
# These properties have extra tables written out for them that we want
# to make as compact and legible as possible. So we find short names
# for their property values. For non-official ones we will need to
# add a legend at the top of the table to say what the abbreviation
# stands for.
my $property_needs_table_re = qr/ ^ _Perl_ (?: GCB | LB | WB ) $ /x;
my %short_enum_name;
my %need_explanation; # For non-official abbreviations, we will need
# to explain what the one we come up with
# stands for
my $type = lc $prop_name;
if ($name =~ $property_needs_table_re) {
my @short_names; # List of already used abbreviations, so we
# don't duplicate
for my $enum (@enums) {
my $short_enum;
my $is_official_name = 0;
# Special case this wb property value to make the
# name more clear
if ($enum eq 'Perl_Tailored_HSpace') {
$short_enum = 'hs';
}
else {
# Use the official short name, if found.
($short_enum) = prop_value_aliases($type, $enum);
if ( defined $short_enum) {
$is_official_name = 1;
}
else {
# 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 the code in this file.
# By convention these have all-caps names. We use the
# lowercased name for these.
#
# Second are enums that are needed to get the
# algorithms below to work and/or to get regexec.c to
# compile, but don't exist in all Unicode releases.
# These are handled outside this loop as
# 'unused_enums' (as they are unused they all get
# collapsed into a single column, and their names
# don't matter)
if (grep { $_ eq $enum } @input_enums) {
$short_enum = $enum
}
else {
$short_enum = 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 (length $short_enum > $max_hdr_len) {
# First try using just the uppercase letters of the name;
# if it is something like FooBar, FB is a better
# abbreviation than Foo. That's not the case if it is
# entirely lowercase.
my $uc = $short_enum;
$uc =~ s/[[:^upper:]]//g;
$short_enum = $uc if length $uc > 1
&& length $uc < length $short_enum;
$short_enum = substr($short_enum, 0, $max_hdr_len);
$is_official_name = 0;
}
}
# If the name we are to display conflicts, try another.
if (grep { $_ eq $short_enum } @short_names) {
$is_official_name = 0;
do { # The increment operator on strings doesn't work on
# those containing an '_', so get rid of any final
# portion.
$short_enum =~ s/_//g;
$short_enum++;
} while grep { $_ eq $short_enum } @short_names;
}
push @short_names, $short_enum;
$short_enum_name{$enum} = $short_enum;
$need_explanation{$enum} = $short_enum unless $is_official_name;
}
} # End of calculating short enum names for certain properties
# Assign a value to each element of the enum type we are creating.
# The default value always gets 0; the others are arbitrarily
# assigned, but for the properties which have the extra table, it is
# in the order we have computed above so the rows and columns appear
# alphabetically by heading abbreviation.
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 (sort { ($name =~ $property_needs_table_re)
? lc $short_enum_name{$a}
cmp lc $short_enum_name{$b}
: lc $a cmp lc $b
} @enums)
{
$enums{$enum} = $enum_val++ unless exists $enums{$enum};
}
# Now calculate the data for the special tables output for these
# properties.
if ($name =~ $property_needs_table_re) {
# 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
# 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 (keys %enums) {
my $value = $enums{$enum};
my $short_enum = $short_enum_name{$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_enum'";
die $@ if $@;
# And note the abbreviations that need explanation
if ($need_explanation{$enum}) {
eval "\$${type}_abbreviations{$short_enum} = '$enum'";
die $@ if $@;
}
}
# Each unused enum has the same value. They all are collapsed
# into one row and one column, named $unused_table_hdr.
if (@unused_enums) {
eval "\$${type}_short_enums['$unused_enum_value'] = '$unused_table_hdr'";
die $@ if $@;
foreach my $enum (@unused_enums) {
eval "\$${type}_enums{$enum} = $unused_enum_value";
die $@ if $@;
}
}
}
}
# The short property 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 $name = $enum_list[$i];
push @enum_definition, "\t${name_prefix}$name = $i";
}
if (@unused_enums) {
foreach my $unused (@unused_enums) {
push @enum_definition,
",\n\t${name_prefix}$unused = $unused_enum_value";
}
}
# 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 caselessly @$element;
}
my $already_found = exists $multiples{$joined};
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";
}
}
}
$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';
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);
# The inversion lists here have to be UV because inversion lists are
# capable of storing any code point, and even though the the ones here
# are only Unicode ones, which need just 21 bits, they are linked to
# directly, rather than copied. The inversion map and aux tables also
# only need be 21 bits, and so we can get away with declaring them
# 32-bits to save a little space and memory (on some 64-bit
# platforms), as they are copied.
$invmap_declaration_type = ($input_format =~ /s/)
? $enum_declaration_type
: "I32";
$aux_declaration_type = ($input_format =~ /s/)
? $enum_declaration_type
: "U32";
$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};
output_table_header($out_fh,
$aux_declaration_type,
"$name_prefix$aux_table_prefix$table_number");
# 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";
output_table_trailer();
}
# Output the table that is indexed by the absolute value of the
# aux table enum and contains pointers to the tables output just
# above
output_table_header($out_fh, "$aux_declaration_type *",
"${name_prefix}${aux_table_prefix}ptrs");
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";
output_table_trailer();
print $out_fh
"\n/* Parallel table to the above, giving the number of elements"
. " in each table\n * pointed to */\n";
output_table_header($out_fh, "U8",
"${name_prefix}${aux_table_prefix}lengths");
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";
output_table_trailer();
} # 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";
output_table_header($out_fh, "UV", "script_zeros");
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";
}
output_table_trailer();
} # End of special handling of scx
}
else {
die "'$input_format' invmap() format for '$prop_name' unimplemented";
}
die "No inversion map for $prop_name" unless defined $invmap
&& ref $invmap eq 'ARRAY'
&& $count;
# Now output the inversion map proper
$charset = "for $charset" if $charset;
output_table_header($out_fh, $invmap_declaration_type,
"${name}_invmap",
$charset);
# The main body are the scalars passed in to this routine.
for my $i (0 .. $count - 1) {
my $element = $invmap->[$i];
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";
}
output_table_trailer();
}
sub mk_invlist_from_sorted_cp_list {
# Returns an inversion list constructed from the sorted input array of
# code points
my $list_ref = shift;
return unless @$list_ref;
# Initialize to just the first element
my @invlist = ( $list_ref->[0], $list_ref->[0] + 1);
# For each succeeding element, if it extends the previous range, adjust
# up, otherwise add it.
for my $i (1 .. @$list_ref - 1) {
if ($invlist[-1] == $list_ref->[$i]) {
$invlist[-1]++;
}
else {
push @invlist, $list_ref->[$i], $list_ref->[$i] + 1;
}
}
return @invlist;
}
# Read in the Case Folding rules, and construct arrays of code points for the
# properties we need.
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'
|| $format eq 'a';
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.
# First find the maximum number of code points that fold to the same one.
foreach my $fold_to (keys %new) {
if (ref $new{$fold_to}) {
my $folders_count = scalar @{$new{$fold_to}};
$max_fold_froms = $folders_count if $folders_count > $max_fold_froms;
}
}
# Then convert the hash 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;
push @invlist, 0x110000;
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
my $name = shift;
# Returns the input lowercased, with non-alphas removed, as well as
# everything starting with a comma
$name =~ s/,.*//;
$name =~ s/[[:^alpha:]]//g;
return lc $name;
}
sub UpperLatin1 {
my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
return \@return;
}
sub _Perl_CCC_non0_non230 {
# Create an inversion list of code points with non-zero canonical
# combining class that also don't have 230 as the class number. This is
# part of a Unicode Standard rule
my @nonzeros = prop_invlist("ccc=0");
shift @nonzeros; # Invert so is "ccc != 0"
my @return;
# Expand into list of code points, while excluding those with ccc == 230
for (my $i = 0; $i < @nonzeros; $i += 2) {
my $upper = ($i + 1) < @nonzeros
? $nonzeros[$i+1] - 1 # In range
: $Unicode::UCD::MAX_CP; # To infinity.
for my $j ($nonzeros[$i] .. $upper) {
my @ccc_names = prop_value_aliases("ccc", charprop($j, "ccc"));
# Final element in @ccc_names will be all numeric
push @return, $j if $ccc_names[-1] != 230;
}
}
@return = sort { $a <=> $b } @return;
@return = mk_invlist_from_sorted_cp_list(\@return);
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
# Being above a U8 is not currently handled
my $table_type = '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;
# Is there a row and column for unused values in this release?
my $has_unused = $names_ref->[$size-1] eq $unused_table_hdr;
for my $i (0 .. $size - 1) {
no warnings 'numeric';
$spacers[$i] = " " x (length($names_ref->[$i]) - $column_width);
}
output_table_header($out_fh, $table_type, "${property}_table", undef,
$size, $size);
# 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_unused || scalar %$abbreviations_ref) {
my $text = "";
foreach my $abbr (sort caselessly keys %$abbreviations_ref) {
$text .= "; " if $text;
$text .= "'$abbr' stands for '$abbreviations_ref->{$abbr}'";
}
if ($has_unused) {
$text .= "; $unused_table_hdr stands for 'unused in this Unicode"
. " release (and the data in its row and column are garbage)"
}
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";
}
output_table_trailer();
}
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
GCB_Maybe_Emoji_NonBreak => 4,
);
# 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};
# Post 11.0: GB11 \p{Extended_Pictographic} Extend* ZWJ
# × \p{Extended_Pictographic}
$gcb_table[$gcb_enums{'ZWJ'}][$gcb_enums{'ExtPict_XX'}] =
$gcb_actions{GCB_Maybe_Emoji_NonBreak};
# This and the rule GB10 obsolete starting with Unicode 11.0, can be left
# in as there are no code points that match, so the code won't ever get
# executed.
# Do not break within emoji modifier sequences or emoji zwj sequences.
# Pre 11.0: 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
# non-East-Asian opening punctuation nor non-East-Asian closing
# parentheses.
# (AL | HL | NU) × [OP-[\p{ea=F}\p{ea=W}\p{ea=H}]]
$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-[\p{ea=F}\p{ea=W}\p{ea=H}]] × (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{'Prefix_Numeric'}][$lb_enums{'East_Asian_OP'}]
+= $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{'East_Asian_OP'}][$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'};
$lb_table[$lb_enums{'Numeric'}][$lb_enums{'East_Asian_CP'}]
= $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{'Break_Symbols'}][$lb_enums{'East_Asian_CP'}]
+= $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'};
$lb_table[$lb_enums{'Infix_Numeric'}][$lb_enums{'East_Asian_CP'}]
+= $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{'East_Asian_CP'}][$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{'East_Asian_CP'}][$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 before ellipses
for my $i (0 .. @lb_table - 1) {
$lb_table[$i][$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'};
$lb_table[$lb_enums{'East_Asian_CP'}][$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'};
$lb_table[$lb_enums{'Quotation'}][$lb_enums{'East_Asian_OP'}]
= $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'};
$lb_table[$lb_enums{'East_Asian_OP'}][$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{'East_Asian_CP'}]
= $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 after a zero width joiner
# ZWJ ×
for my $i (0 .. @lb_table - 1) {
$lb_table[$lb_enums{'ZWJ'}][$i] = $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;
# 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{'ExtPict_LE'}]
= $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{'ExtPict_LE'}][$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{'ExtPict_LE'}]
= $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{'ExtPict_LE'}][$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{'ExtPict_LE'}]
+= $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{'ExtPict_LE'}]
+= $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{'ExtPict_LE'}]
+= $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{'ExtPict_LE'}][$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{'ExtPict_LE'}][$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{'ExtPict_LE'}][$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{'ExtPict_LE'}][$wb_enums{'ALetter'}]
= $wb_actions{'WB_NOBREAK'};
$wb_table[$wb_enums{'ALetter'}][$wb_enums{'Hebrew_Letter'}]
= $wb_actions{'WB_NOBREAK'};
$wb_table[$wb_enums{'ExtPict_LE'}][$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{'ExtPict_LE'}]
= $wb_actions{'WB_NOBREAK'};
$wb_table[$wb_enums{'Hebrew_Letter'}][$wb_enums{'Hebrew_Letter'}]
= $wb_actions{'WB_NOBREAK'};
$wb_table[$wb_enums{'ExtPict_LE'}][$wb_enums{'ExtPict_LE'}]
= $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'};
}
# Keep horizontal whitespace together
# Use perl's tailoring instead
# WB3d WSegSpace × WSegSpace
#$wb_table[$wb_enums{'WSegSpace'}][$wb_enums{'WSegSpace'}]
# = $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'};
$wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_XX'}]
= $wb_actions{'WB_NOBREAK'};
$wb_table[$wb_enums{'ZWJ'}][$wb_enums{'ExtPict_LE'}]
= $wb_actions{'WB_NOBREAK'};
# Break before and after newlines
# 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_REGCOMP_C');
output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);
if ($num_anyof_code_points == 256) { # Same as Latin1
print $out_fh
"\nstatic const UV * const InBitmap_invlist = Latin1_invlist;\n";
}
else {
output_invlist("InBitmap", [ 0, $num_anyof_code_points ]);
}
end_file_pound_if;
# We construct lists for all the POSIX and backslash sequence character
# classes in two forms:
# 1) ones which match only in the ASCII range
# 2) ones which match either in the Latin1 range, or the entire Unicode range
#
# These get compiled in, and hence affect the memory footprint of every Perl
# program, even those not using Unicode. To minimize the size, currently
# the Latin1 version is generated for the beyond ASCII range except for those
# lists that are quite small for the entire range, such as for \s, which is 22
# UVs long plus 4 UVs (currently) for the header.
#
# To save even more memory, the ASCII versions could be derived from the
# larger ones at runtime, saving some memory (minus the expense of the machine
# instructions to do so), but these are all small anyway, so their total is
# about 100 UVs.
#
# In the list of properties below that get generated, the L1 prefix is a fake
# property that means just the Latin1 range of the full property (whose name
# has an X prefix instead of L1).
#
# An initial & means to use the subroutine from this file instead of an
# official inversion list.
# 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(
&UpperLatin1
_Perl_GCB,EDGE,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,ExtPict_XX
_Perl_LB,EDGE,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,East_Asian_CP,East_Asian_OP
_Perl_SB,EDGE,SContinue,CR,Extend,LF
_Perl_WB,Perl_Tailored_HSpace,EDGE,UNKNOWN,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,ExtPict_XX,ExtPict_LE
_Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
Lowercase_Mapping
Titlecase_Mapping
Uppercase_Mapping
Simple_Case_Folding
Case_Folding
&_Perl_IVCF
&_Perl_CCC_non0_non230
);
# 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 (with some exceptions)
# containing at least 4 all-uppercase characters.
# Some of the enums are current official property values that
# are needed for the rules in constructing certain tables in
# this file, and perhaps in regexec.c as well. They are here
# so that things don't crash when compiled on earlier Unicode
# releases where they don't exist. Thus the rules that use
# them still get compiled, but no code point actually uses
# them, hence they won't get exercized on such Unicode
# versions, but the code will still compile and run, though
# may not give the precise results that those versions would
# expect, but reasonable results nonetheless.
#
# Other enums are due to the fact that Unicode has in more
# recent versions added criteria to the rules in these extra
# tables that are based on factors outside the property
# values. And those have to be accounted for, essentially by
# here splitting certain enum equivalence classes based on
# those extra rules.
#
# EDGE is supposed to be a boundary between some types of
# enums, but khw thinks that isn't valid any more.
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 %Unicode::UCD::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 %Unicode::UCD::nv_floating_to_rational) {
my $value = $Unicode::UCD::nv_floating_to_rational{$key};
$floating_to_file_of{$key} = $Unicode::UCD::stricter_to_file_of{"nv=$value"};
}
# Properties that are specified with a prop=value syntax
my @equals_properties;
# 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 %Unicode::UCD::loose_to_file_of,
keys %Unicode::UCD::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 = $Unicode::UCD::loose_to_file_of{$property};
$tag = $Unicode::UCD::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.
my $prop_value = $rhs =~ s/ ^ = //rx;
push @equals_properties, $lhs if $prop_value ne "";
# 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 %Unicode::UCD::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 $Unicode::UCD::why_deprecated{$tag}) {
$deprecated_tags{$enums{$tag}} = scalar @deprecated_messages;
push @deprecated_messages, $Unicode::UCD::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;
my $map_format = 0;;
my $map_default;
my $maps_to_code_point = 0;
my $to_adjust = 0;
my $same_in_all_code_pages;
if ($is_local_sub) {
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) {
# 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');
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;
}
}
}
if ($map_format) {
$maps_to_code_point = $map_format =~ / a ($ | [^r] ) /x;
$to_adjust = $map_format =~ /a/;
}
# Re-order the Unicode code points to native ones for this platform.
# This is only needed for code points below 256, because native code
# points are only in that range. For inversion maps of properties
# where the mappings are adjusted (format =~ /a/), this reordering
# could mess up the adjustment pattern that was in the input, so that
# has to be dealt with.
#
# And inversion maps that map to code points need to eventually have
# all those code points remapped to native, and it's better to do that
# here, going through the whole list not just those below 256. This
# is because some inversion maps have adjustments (format =~ /a/)
# which may be affected by the reordering. This code needs to be done
# both for when we are translating the inversion lists for < 256, and
# for the inversion maps for everything. By doing both in this loop,
# we can share that code.
#
# So, we go through everything for an inversion map to code points;
# otherwise, we can skip any remapping at all if we are going to
# output only the above-Latin1 values, or if the range spans the whole
# 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)
|| ( @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.
: 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
}
# 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
# This is a similar procedure as plain inversion list, but has
# multiple buckets. A plain inversion list just has two
# buckets, 1) 'in' the list; and 2) 'not' in the list, and we
# pretty much can ignore the 2nd bucket, as it is completely
# defined by the 1st. But here, what we do is create buckets
# which contain the code points that map to each, translated
# to native and turned into an inversion list. Thus each
# bucket is an inversion list of native code points that map
# to it or don't map to it. We use these to create an
# inversion map for the whole property.
# As mentioned earlier, we use this procedure to not just
# remap the inversion list to native values, but also the maps
# of code points to native ones. In the latter case we have
# 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)
? 256
: (Unicode::UCD::UnicodeVersion() eq '1.1.5')
? 0xFFFF
: 0x10FFFF;
my %mapped_lists; # A hash whose keys are the buckets.
while (@invlist) {
last if $invlist[0] > $upper_limit;
# This shouldn't actually happen, as prop_invmap() returns
# an extra element at the end that is beyond $upper_limit
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).
if (ref $invmap[0]) {
$bucket = join "\cK", map { a2n($_) } @{$invmap[0]};
}
elsif ( $maps_to_code_point
&& $invmap[0] =~ $integer_or_float_re)
{
# Do convert to native for maps to single code points.
# There are some properties that have a few outlier
# maps that aren't code points, so the above test
# skips those. 0 is never remapped.
$bucket = $invmap[0] == 0 ? 0 : a2n($invmap[0]);
} else {
$bucket = $invmap[0];
}
# We now have the bucket that all code points in the range
# map to, though possibly they need to be adjusted. Go
# through the range and put each translated code point in
# it into its bucket.
my $base_map = $invmap[0];
for my $j ($invlist[0] .. $invlist[1] - 1) {
if ($to_adjust
# The 1st code point doesn't need adjusting
&& $j > $invlist[0]
# Skip any non-numeric maps: these are outliers
# that aren't code points.
&& $base_map =~ $integer_or_float_re
# 'ne' because the default can be a string
&& $base_map ne $map_default)
{
# We adjust, by incrementing each the bucket and
# the map. For code point maps, translate to
# native
$base_map++;
$bucket = ($maps_to_code_point)
? a2n($base_map)
: $base_map;
}
# Add the native code point to the bucket for the
# current map
push @{$mapped_lists{$bucket}}, a2n($j);
} # End of loop through all code points in the range
# Get ready for the next range
shift @invlist;
shift @invmap;
} # End of loop through all ranges in the map.
# Here, @invlist and @invmap retain all the ranges from the
# 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, 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.
my %xlated;
foreach my $bucket (keys %mapped_lists) {
# Sort and convert this bucket to an inversion list. The
# result will be that ranges that start with even-numbered
# indexes will be for code points that map to this bucket;
# odd ones map to some other bucket, and are discarded
# below.
@{$mapped_lists{$bucket}}
= sort{ $a <=> $b} @{$mapped_lists{$bucket}};
@{$mapped_lists{$bucket}}
= mk_invlist_from_sorted_cp_list(
\@{$mapped_lists{$bucket}});
# Add each even-numbered range in the bucket to %xlated;
# so that the keys of %xlated become the range start code
# points, and the values are their corresponding maps.
while (@{$mapped_lists{$bucket}}) {
my $range_start = $mapped_lists{$bucket}->[0];
if ($bucket =~ /\cK/) {
@{$xlated{$range_start}} = split /\cK/, $bucket;
}
else {
# 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
# iteration
}
} # End of loop through all the buckets.
# Here %xlated's keys are the range starts of all the code
# points in the inversion map. Construct an inversion list
# from them.
my @new_invlist = sort { $a <=> $b } keys %xlated;
# If the list is adjusted, we want to munge this list so that
# we only have one entry for where consecutive code points map
# to consecutive values. We just skip the subsequent entries
# where this is the case.
if ($to_adjust) {
my @temp;
for my $i (0 .. @new_invlist - 1) {
next if $i > 0
&& $new_invlist[$i-1] + 1 == $new_invlist[$i]
&& $xlated{$new_invlist[$i-1]}
=~ $integer_or_float_re
&& $xlated{$new_invlist[$i]}
=~ $integer_or_float_re
&& $xlated{$new_invlist[$i-1]} + 1
== $xlated{$new_invlist[$i]};
push @temp, $new_invlist[$i];
}
@new_invlist = @temp;
}
# The inversion map comes from %xlated's values. We can
# unshift each onto the front of the untouched portion, in
# reverse order of the portion we did process.
foreach my $start (reverse @new_invlist) {
unshift @invmap, $xlated{$start};
}
# Finally prepend the inversion list we have just constructed
# to the one that contains anything we didn't process.
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.
if (@invmap) {
pop @invlist;
pop @invmap;
}
if ($l1_only) {
die "Unimplemented to do a Latin-1 only inversion map" if @invmap;
for my $i (0 .. @invlist - 1 - 1) {
if ($invlist[$i] > 255) {
# In an inversion list, even-numbered elements give the code
# points that begin ranges that match the property;
# odd-numbered give ones that begin ranges that don't match.
# If $i is odd, we are at the first code point above 255 that
# doesn't match, which means the range it is ending does
# match, and crosses the 255/256 boundary. We want to
# include this ending point, so increment $i, so the
# splice below includes it. Conversely, if $i is even, it
# is the first code point above 255 that matches, which
# means there was no matching range that crossed the
# boundary, and we don't want to include this code point,
# so splice before it.
$i++ if $i % 2 != 0;
# Remove everything past this.
splice @invlist, $i;
splice @invmap, $i if @invmap;
last;
}
}
}
elsif ($nonl1_only) {
my $found_nonl1 = 0;
for my $i (0 .. @invlist - 1 - 1) {
next if $invlist[$i] < 256;
# Here, we have the first element in the array that indicates an
# element above Latin1. Get rid of all previous ones.
splice @invlist, 0, $i;
splice @invmap, 0, $i if @invmap;
# If this one's index is not divisible by 2, it means that this
# element is inverting away from being in the list, which means
# all code points from 256 to this one are in this list (or
# map to the default for inversion maps)
if ($i % 2 != 0) {
unshift @invlist, 256;
unshift @invmap, $map_default if @invmap;
}
$found_nonl1 = 1;
last;
}
if (! $found_nonl1) {
warn "No non-Latin1 code points in $prop_name";
output_invlist($prop_name, []);
last;
}
}
switch_pound_if ($prop_name, 'PERL_IN_REGCOMP_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);
}
last if $same_in_all_code_pages;
end_charset_pound_if;
}
}
print $out_fh "\nconst char * const deprecated_property_msgs[] = {\n\t";
print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages;
print $out_fh "\n};\n";
switch_pound_if ('binary_invlist_enum', 'PERL_IN_REGCOMP_C');
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,",
" /* So no real value is zero */\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";
switch_pound_if ('binary_property_tables', 'PERL_IN_REGCOMP_C');
output_table_header($out_fh, "UV *", "uni_prop_ptrs");
print $out_fh "\tNULL,\t/* Placeholder */\n";
print $out_fh "\t";
print $out_fh join ",\n\t", @invlist_names;
print $out_fh "\n";
output_table_trailer();
switch_pound_if ('synonym defines', 'PERL_IN_REGCOMP_C');
print $out_fh join "\n", "\n",
#'# ifdef DOINIT',
#"\n",
"/* Synonyms for perl properties */",
@perl_prop_synonyms,
#"\n",
#"# endif /* DOINIT */",
"\n";
switch_pound_if ('Valid property_values', 'PERL_IN_REGCOMP_C');
# Each entry is a pointer to a table of property values for some property.
# (Other properties may share this table. The next two data structures allow
# this sharing to be implemented.)
my @values_tables = "NULL /* Placeholder so zero index is an error */";
# Keys are all the values of a property, strung together. The value of each
# key is its index in @values_tables. This is because many properties have
# the same values, and this allows the data to appear just once.
my %joined_values;
# #defines for indices into @values_tables, so can have synonyms resolved by
# the C compiler.
my @values_indices;
# Go through each property which is specifiable by \p{prop=value}, and create
# a hash with the keys being the canonicalized short property names, and the
# values for each property being all possible values that it can take on.
# Both the full value and its short, canonicalized into lc, sans punctuation
# version are included.
my %all_values;
for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) }
uniques @equals_properties)
{
# Get and canonicalize the short name for this property.
my ($short_name) = prop_aliases($property);
$short_name = lc $short_name;
$short_name =~ s/[ _-]//g;
# Now look at each value this property can take on
foreach my $value (prop_values($short_name)) {
# And for each value, look at each synonym for it
foreach my $alias (prop_value_aliases($short_name, $value)) {
# Add each synonym
push @{$all_values{$short_name}}, $alias;
# As well as its canonicalized name. khw made the decision to not
# support the grandfathered L_ Gc property value
$alias = lc $alias;
$alias =~ s/[ _-]//g unless $alias =~ $numeric_re;
push @{$all_values{$short_name}}, $alias;
}
}
}
# Also include the old style block names, using the recipe given in
# Unicode::UCD
foreach my $block (prop_values('block')) {
push @{$all_values{'blk'}}, charblock((prop_invlist("block=$block"))[0]);
}
# Now create output tables for each property in @equals_properties (the keys
# in %all_values) each containing that property's possible values as computed
# just above.
PROPERTY:
for my $property (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
or $a cmp $b } keys %all_values)
{
@{$all_values{$property}} = uniques(@{$all_values{$property}});
# String together the values for this property, sorted. This string forms
# a list definition, with each value as an entry in it, indented on a new
# line. The sorting is used to find properties that take on the exact
# same values to share this string.
my $joined = "\t\"";
$joined .= join "\",\n\t\"",
sort { ($a =~ $numeric_re && $b =~ $numeric_re)
? eval $a <=> eval $b
: prop_name_for_cmp($a) cmp prop_name_for_cmp($b)
or $a cmp $b
} @{$all_values{$property}};
# And add a trailing marker
$joined .= "\",\n\tNULL\n";
my $table_name = $table_name_prefix . $property . "_values";
my $index_name = "${table_name}_index";
# Add a rule for the parser that is just an empty value. It will need to
# know to look up empty things in the prop_value_ptrs[] table.
$keywords{"$property="} = $index_name;
if (exists $prop_name_aliases{$property}) {
foreach my $alias (@{$prop_name_aliases{$property}}) {
$keywords{"$alias="} = $index_name;
}
}
# Also create rules for the synonyms of this property to point to the same
# thing
# If this property's values are the same as one we've already computed,
# use that instead of creating a duplicate. But we add a #define to point
# to the proper one.
if (exists $joined_values{$joined}) {
push @values_indices, "#define $index_name $joined_values{$joined}\n";
next PROPERTY;
}
# And this property, now known to have unique values from any other seen
# so far is about to be pushed onto @values_tables. Its index is the
# current count.
push @values_indices, "#define $index_name "
. scalar @values_tables . "\n";
$joined_values{$joined} = $index_name;
push @values_tables, $table_name;
# Create the table for this set of values.
output_table_header($out_fh, "char *", $table_name);
print $out_fh $joined;
output_table_trailer();
} # End of loop through the properties, and their values
# We have completely determined the table of the unique property values
output_table_header($out_fh, "char * const *",
"${table_name_prefix}prop_value_ptrs");
print $out_fh join ",\n", @values_tables;
print $out_fh "\n";
output_table_trailer();
# And the #defines for the indices in it
print $out_fh "\n\n", join "", @values_indices;
switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C');
output_GCB_table();
output_LB_table();
output_WB_table();
end_file_pound_if;
print $out_fh <<"EOF";
/* More than one code point may have the same code point as their fold. This
* gives the maximum number in the current Unicode release. (The folded-to
* code point is not included in this count.) For example, both 'S' and
* \\x{17F} fold to 's', so the number for that fold is 2. Another way to
* look at it is the maximum length of all the IVCF_AUX_TABLE's */
#define MAX_FOLD_FROMS $max_fold_froms
EOF
my $sources_list = "lib/unicore/mktables.lst";
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) {
# This should force a rebuild once $sources_list exists
push @sources, $sources_list;
}
else {
while(<$mktables_list>) {
last if /===/;
chomp;
push @sources, "lib/unicore/$_" if /^[^#]/;
}
}
}
read_only_bottom_close_and_rename($out_fh, \@sources);
my %name_to_index;
for my $i (0 .. @enums - 1) {
my $loose_name = $enums[$i] =~ s/^$table_name_prefix//r;
$loose_name = lc $loose_name;
$loose_name =~ s/__/=/;
$loose_name =~ s/_dot_/./;
$loose_name =~ s/_slash_/\//g;
$name_to_index{$loose_name} = $i + 1;
}
# unsanitize, exclude &, maybe add these before sanitize
for my $i (0 .. @perl_prop_synonyms - 1) {
my $loose_name_pair = $perl_prop_synonyms[$i] =~ s/#\s*define\s*//r;
$loose_name_pair =~ s/\b$table_name_prefix//g;
$loose_name_pair = lc $loose_name_pair;
$loose_name_pair =~ s/__/=/g;
$loose_name_pair =~ s/_dot_/./g;
$loose_name_pair =~ s/_slash_/\//g;
my ($synonym, $primary) = split / +/, $loose_name_pair;
$name_to_index{$synonym} = $name_to_index{$primary};
}
my $uni_pl = open_new('lib/unicore/uni_keywords.pl', '>',
{style => '*', by => 'regen/mk_invlists.pl',
from => "Unicode::UCD"});
{
print $uni_pl "\%Unicode::UCD::uni_prop_ptrs_indices = (\n";
for my $name (sort keys %name_to_index) {
print $uni_pl " '$name' => $name_to_index{$name},\n";
}
print $uni_pl ");\n\n1;\n";
}
read_only_bottom_close_and_rename($uni_pl, \@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"});
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);
