use 5.015;
use strict;
use warnings;
-use Unicode::UCD qw(prop_invlist prop_invmap);
+use Unicode::UCD qw(prop_aliases
+ prop_values
+ prop_value_aliases
+ prop_invlist
+ prop_invmap search_invlist
+ );
require 'regen/regen_lib.pl';
+require 'regen/charset_translations.pl';
# 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.
# 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 = 290655244;
+
+# charclass_invlists.h now also has a partial implementation of inversion
+# maps; enough to generate tables for the line break properties, such as GCB
+
+my $VERSION_DATA_STRUCTURE_TYPE = 148565664;
+
+# integer or float
+my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /ax;
+
+# Matches valid C language enum names: begins with ASCII alphabetic, then any
+# ASCII \w
+my $enum_name_re = qr / ^ [[:alpha:]] \w* $ /ax;
my $out_fh = open_new('charclass_invlists.h', '>',
{style => '*', by => $0,
from => "Unicode::UCD"});
+my $in_file_pound_if = 0;
+
print $out_fh "/* See the generating file for comments */\n\n";
-sub output_invlist ($$) {
+# The symbols generated by this program are all currently defined only in a
+# single dot c each. The code knows where most of them go, but this hash
+# gives overrides for the exceptions to the typical place
+my %exceptions_to_where_to_define =
+ ( NonL1_Perl_Non_Final_Folds => 'PERL_IN_REGCOMP_C',
+ AboveLatin1 => 'PERL_IN_REGCOMP_C',
+ Latin1 => 'PERL_IN_REGCOMP_C',
+ UpperLatin1 => 'PERL_IN_REGCOMP_C',
+ _Perl_Any_Folds => 'PERL_IN_REGCOMP_C',
+ _Perl_Folds_To_Multi_Char => 'PERL_IN_REGCOMP_C',
+ _Perl_IDCont => 'PERL_IN_UTF8_C',
+ _Perl_IDStart => 'PERL_IN_UTF8_C',
+ );
+
+# This hash contains the properties with enums that have hard-coded references
+# to them in C code. Its only use is to make sure that if perl is compiled
+# with an older Unicode data set, that all the enum values the code is
+# expecting will still be in the enum typedef. Thus the code doesn't have to
+# change. The Unicode version won't have any code points that have these enum
+# values, so the code that handles them will not get exercised. This is far
+# better than having to #ifdef things.
+my %hard_coded_enums =
+ ( gcb => [
+ 'Control',
+ 'CR',
+ 'Extend',
+ 'L',
+ 'LF',
+ 'LV',
+ 'LVT',
+ 'Other',
+ 'Prepend',
+ 'Regional_Indicator',
+ 'SpacingMark',
+ 'T',
+ 'V',
+ ],
+ sb => [
+ 'ATerm',
+ 'Close',
+ 'CR',
+ 'Extend',
+ 'Format',
+ 'LF',
+ 'Lower',
+ 'Numeric',
+ 'OLetter',
+ 'Other',
+ 'SContinue',
+ 'Sep',
+ 'Sp',
+ 'STerm',
+ 'Upper',
+ ],
+ wb => [
+ 'ALetter',
+ 'CR',
+ 'Double_Quote',
+ 'Extend',
+ 'ExtendNumLet',
+ 'Format',
+ 'Hebrew_Letter',
+ 'Katakana',
+ 'LF',
+ 'MidLetter',
+ 'MidNum',
+ 'MidNumLet',
+ 'Newline',
+ 'Numeric',
+ 'Other',
+ 'Regional_Indicator',
+ 'Single_Quote',
+ 'UNKNOWN',
+ ],
+);
+
+my @a2n;
+
+sub uniques {
+ # Returns non-duplicated input values. From "Perl Best Practices:
+ # Encapsulated Cleverness". p. 455 in first edition.
+
+ my %seen;
+ return grep { ! $seen{$_}++ } @_;
+}
+
+sub a2n($) {
+ my $cp = shift;
+
+ # Returns the input Unicode code point translated to native.
+
+ return $cp if $cp !~ $numeric_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 = 0;
+ }
+}
+
+sub switch_pound_if ($$) {
+ my $name = shift;
+ my $new_pound_if = shift;
+
+ # Switch to new #if given by the 2nd argument. If there is an override
+ # for this, it instead switches to that. The 1st argument is the
+ # static's name, used to look up the overrides
+
+ if (exists $exceptions_to_where_to_define{$name}) {
+ $new_pound_if = $exceptions_to_where_to_define{$name};
+ }
+
+ # Exit current #if if the new one is different from the old
+ if ($in_file_pound_if
+ && $in_file_pound_if !~ /$new_pound_if/)
+ {
+ end_file_pound_if;
+ }
+
+ # Enter new #if, if not already in it.
+ if (! $in_file_pound_if) {
+ $in_file_pound_if = "defined($new_pound_if)";
+ print $out_fh "\n#if $in_file_pound_if\n";
+ }
+}
+
+sub output_invlist ($$;$) {
my $name = shift;
my $invlist = shift; # Reference to inversion list array
+ my $charset = shift // ""; # name of character set for comment
die "No inversion list for $name" unless defined $invlist
- && ref $invlist eq 'ARRAY'
- && @$invlist;
+ && ref $invlist eq 'ARRAY';
# Output the inversion list $invlist using the name $name for it.
# It is output in the exact internal form for inversion lists.
- my $zero_or_one; # Is the last element of the header 0, or 1 ?
-
- # If the first element is 0, it goes in the header, instead of the body
- if ($invlist->[0] == 0) {
- shift @$invlist;
-
- $zero_or_one = 0;
-
- # Add a dummy 0 at the end so that the length is constant. inversion
- # lists are always stored with enough room so that if they change from
- # beginning with 0, they don't have to grow.
- push @$invlist, 0;
- }
- else {
+ # 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;
}
+ my $count = @$invlist;
+
+ switch_pound_if ($name, 'PERL_IN_PERL_C');
- print $out_fh "\nUV ${name}_invlist[] = {\n";
+ print $out_fh "\nstatic const UV ${name}_invlist[] = {";
+ print $out_fh " /* for $charset */" if $charset;
+ print $out_fh "\n";
- print $out_fh "\t", scalar @$invlist, ",\t/* Number of elements */\n";
- print $out_fh "\t0,\t/* Current iteration position */\n";
- print $out_fh "\t0,\t/* Cache of previous search index result */\n";
+ print $out_fh "\t$count,\t/* Number of elements */\n";
print $out_fh "\t$VERSION_DATA_STRUCTURE_TYPE, /* Version and data structure type */\n";
print $out_fh "\t", $zero_or_one,
- ",\t/* 0 if this is the first element of the list proper;",
- "\n\t\t 1 if the next element is the first */\n";
+ ",\t/* 0 if the list starts at 0;",
+ "\n\t\t 1 if it starts at the element beyond 0 */\n";
# The main body are the UVs passed in to this routine. Do the final
# element separately
- for my $i (0 .. @$invlist - 1 - 1) {
- print $out_fh "\t$invlist->[$i],\n";
+ for my $i (0 .. @$invlist - 1) {
+ printf $out_fh "\t0x%X", $invlist->[$i];
+ print $out_fh "," if $i < @$invlist - 1;
+ print $out_fh "\n";
}
- # The final element does not have a trailing comma, as C can't handle it.
- print $out_fh "\t$invlist->[-1]\n";
+ print $out_fh "};\n";
+}
+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 $declaration_type;
+ my %enums;
+ my $name_prefix;
+
+ if ($input_format eq 's') {
+ $prop_name = (prop_aliases($prop_name))[1]; # Get full name
+ my $short_name = (prop_aliases($prop_name))[0];
+ my @enums = prop_values($prop_name);
+ if (! @enums) {
+ die "Only enum properties are currently handled; '$prop_name' isn't one";
+ }
+ else {
+
+ # Convert short names to long
+ @enums = map { (prop_value_aliases($prop_name, $_))[1] } @enums;
+
+ my @expected_enums = @{$hard_coded_enums{lc $short_name}};
+ die 'You need to update %hard_coded_enums to reflect new entries in this Unicode version'
+ if @expected_enums < @enums;
+
+ # Remove the enums found in the input from the ones we expect
+ for (my $i = @expected_enums - 1; $i >= 0; $i--) {
+ splice(@expected_enums, $i, 1)
+ if grep { $expected_enums[$i] eq $_ } @enums;
+ }
+
+ # The ones remaining must be because we're using an older
+ # Unicode version. Add them to the list.
+ push @enums, @expected_enums;
+
+ # Add in the extra values coded into this program, and sort.
+ push @enums, split /,/, $extra_enums if $extra_enums ne "";
+ @enums = sort @enums;
+
+ # Assign a value to each element of the enum. The default
+ # value always gets 0; the others are arbitrarily assigned.
+ my $enum_val = 0;
+ $default = prop_value_aliases($prop_name, $default);
+ $enums{$default} = $enum_val++;
+ for my $enum (@enums) {
+ $enums{$enum} = $enum_val++ unless exists $enums{$enum};
+ }
+ }
+
+ # Inversion map stuff is currently used only by regexec
+ switch_pound_if($name, 'PERL_IN_REGEXEC_C');
+ {
+
+ # The short names tend to be two lower case letters, but it looks
+ # better for those if they are upper. XXX
+ $short_name = uc($short_name) if length($short_name) < 3
+ || substr($short_name, 0, 1) =~ /[[:lower:]]/;
+ $name_prefix = "${short_name}_";
+ my $enum_count = keys %enums;
+ print $out_fh "\n#define ${name_prefix}ENUM_COUNT ", scalar keys %enums, "\n";
+
+ print $out_fh "\ntypedef enum {\n";
+ print $out_fh "\t${name_prefix}$default = $enums{$default},\n";
+ delete $enums{$default};
+ foreach my $enum (sort { $a cmp $b } keys %enums) {
+ print $out_fh "\t${name_prefix}$enum = $enums{$enum}";
+ print $out_fh "," if $enums{$enum} < $enum_count - 1;
+ print $out_fh "\n";
+ }
+ $declaration_type = "${name_prefix}enum";
+ print $out_fh "} $declaration_type;\n";
+
+ $output_format = "${name_prefix}%s";
+ }
+ }
+ 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;
+
+ print $out_fh "\nstatic const $declaration_type ${name}_invmap[] = {";
+ print $out_fh " /* for $charset */" if $charset;
+ print $out_fh "\n";
+
+ # The main body are the scalars passed in to this routine.
+ for my $i (0 .. $count - 1) {
+ my $element = $invmap->[$i];
+ $element = $name_prefix . prop_value_aliases($prop_name, $element);
+ print $out_fh "\t$element";
+ print $out_fh "," if $i < $count - 1;
+ print $out_fh "\n";
+ }
print $out_fh "};\n";
}
-sub mk_invlist_from_cp_list {
+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);
next unless ref $folds_ref->[$i]; # Skip single-char folds
push @has_multi_char_fold, $cp_ref->[$i];
- # Add to the the non-finals list each code point that is in a non-final
+ # Add to the non-finals list each code point that is in a non-final
# position
for my $j (0 .. @{$folds_ref->[$i]} - 2) {
push @is_non_final_fold, $folds_ref->[$i][$j]
}
}
-sub _Perl_Multi_Char_Folds {
- @has_multi_char_fold = sort { $a <=> $b } @has_multi_char_fold;
- return mk_invlist_from_cp_list(\@has_multi_char_fold);
-}
-
sub _Perl_Non_Final_Folds {
@is_non_final_fold = sort { $a <=> $b } @is_non_final_fold;
- return mk_invlist_from_cp_list(\@is_non_final_fold);
+ return mk_invlist_from_sorted_cp_list(\@is_non_final_fold);
+}
+
+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 {
+ return mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
}
output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);
+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
# An initial & means to use the subroutine from this file instead of an
# official inversion list.
-for my $prop (qw(
- ASCII
- L1Cased
- VertSpace
- PerlSpace
- XPerlSpace
- PosixAlnum
- L1PosixAlnum
- PosixAlpha
- L1PosixAlpha
- PosixBlank
- XPosixBlank
- PosixCntrl
- XPosixCntrl
- PosixDigit
- PosixGraph
- L1PosixGraph
- PosixLower
- L1PosixLower
- PosixPrint
- L1PosixPrint
- PosixPunct
- L1PosixPunct
- PosixSpace
- XPosixSpace
- PosixUpper
- L1PosixUpper
- PosixWord
- L1PosixWord
- PosixXDigit
- XPosixXDigit
- &NonL1_Perl_Non_Final_Folds
- &_Perl_Multi_Char_Folds
- )
-) {
-
- # 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
- # artifically 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 $lookup_prop = $prop_name;
- my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/ or $lookup_prop =~ s/^L1//);
- my $nonl1_only = 0;
- $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
-
- my @invlist;
- if ($is_local_sub) {
- @invlist = eval $lookup_prop;
- }
- else {
- @invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok');
- }
- die "Could not find inversion list for '$lookup_prop'" unless @invlist;
-
- if ($l1_only) {
- 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;
+for my $charset (get_supported_code_pages()) {
+ print $out_fh "\n" . get_conditional_compile_line_start($charset);
+
+ @a2n = @{get_a2n($charset)};
+ no warnings 'qw';
+ # Ignore non-alpha in sort
+ for my $prop (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
+ ASCII
+ Cased
+ VertSpace
+ XPerlSpace
+ XPosixAlnum
+ XPosixAlpha
+ XPosixBlank
+ XPosixCntrl
+ XPosixDigit
+ XPosixGraph
+ XPosixLower
+ XPosixPrint
+ XPosixPunct
+ XPosixSpace
+ XPosixUpper
+ XPosixWord
+ XPosixXDigit
+ _Perl_Any_Folds
+ &NonL1_Perl_Non_Final_Folds
+ _Perl_Folds_To_Multi_Char
+ &UpperLatin1
+ _Perl_IDStart
+ _Perl_IDCont
+ Grapheme_Cluster_Break,EDGE
+ Word_Break,EDGE,UNKNOWN
+ Sentence_Break,EDGE
+ )
+ ) {
+
+ # For the Latin1 properties, we change to use the eXtended version of the
+ # base property, then go through the result and get rid of everything not
+ # in Latin1 (above 255). Actually, we retain the element for the range
+ # that crosses the 255/256 boundary if it is one that matches the
+ # property. For example, in the Word property, there is a range of code
+ # points that start at U+00F8 and goes through U+02C1. Instead of
+ # artificially cutting that off at 256 because 256 is the first code point
+ # above Latin1, we let the range go to its natural ending. That gives us
+ # extra information with no added space taken. But if the range that
+ # crosses the boundary is one that doesn't match the property, we don't
+ # start a new range above 255, as that could be construed as going to
+ # infinity. For example, the Upper property doesn't include the character
+ # at 255, but does include the one at 256. We don't include the 256 one.
+ my $prop_name = $prop;
+ my $is_local_sub = $prop_name =~ s/^&//;
+ my $extra_enums = "";
+ $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
+ my $lookup_prop = $prop_name;
+ my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
+ or $lookup_prop =~ s/^L1//);
+ my $nonl1_only = 0;
+ $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
+ ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;
+
+ my @invlist;
+ my @invmap;
+ my $map_format;
+ my $map_default;
+ my $maps_to_code_point;
+ my $to_adjust;
+ if ($is_local_sub) {
+ @invlist = eval $lookup_prop;
+ }
+ 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');
+ die "Could not find inversion list for '$lookup_prop'"
+ unless defined $count;
+ }
+ else {
+ @invlist = @$list_ref;
+ @invmap = @$map_ref;
+ $map_format = $format;
+ $map_default = $default;
+ $maps_to_code_point = $map_format =~ /x/;
+ $to_adjust = $map_format =~ /a/;
+ }
+ }
+ }
+
+
+ # Short-circuit an empty inversion list.
+ if (! @invlist) {
+ output_invlist($prop_name, \@invlist, $charset);
+ next;
+ }
+
+ # 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)
+ || (! $nonl1_only || ($invlist[0] < 256
+ && ! ($invlist[0] == 0 && $invlist[1] > 256))))
+ {
+
+ if (! @invmap) { # Straight inversion list
+ # Look at all the ranges that start before 257.
+ my @latin1_list;
+ while (@invlist) {
+ last if $invlist[0] > 256;
+ my $upper = @invlist > 1
+ ? $invlist[1] - 1 # In range
+
+ # To infinity. You may want to stop much much
+ # earlier; going this high may expose perl
+ # deficiencies with very large numbers.
+ : $Unicode::UCD::MAX_CP;
+ for my $j ($invlist[0] .. $upper) {
+ push @latin1_list, a2n($j);
+ }
+
+ 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) ? 0x10FFFF : 256;
+
+ 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 that extends to infinity is unimplemented" unless @invlist > 1;
+
+ my $bucket;
+
+ # A hash key can't be a ref (we are only expecting arrays
+ # of scalars here), so convert any such to a string that
+ # will be converted back later (using a vertical tab as
+ # the separator). Even if the mapping is to code points,
+ # we don't translate to native here because the code
+ # output_map() calls to output these arrays assumes the
+ # input is Unicode, not native.
+ if (ref $invmap[0]) {
+ $bucket = join "\cK", @{$invmap[0]};
+ }
+ elsif ($maps_to_code_point && $invmap[0] =~ $numeric_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.
+ $bucket = 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 =~ $numeric_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 is 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 {
+ $xlated{$range_start} = $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]} =~ $numeric_re
+ && $xlated{$new_invlist[$i]} =~ $numeric_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;
+ }
+ }
+
+ # 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;
}
+ die "No non-Latin1 code points in $lookup_prop" unless $found_nonl1;
}
+
+ output_invlist($prop_name, \@invlist, $charset);
+ output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, $map_default, $extra_enums, $charset) if @invmap;
+ }
+ end_file_pound_if;
+ print $out_fh "\n" . get_conditional_compile_line_end();
+}
+
+my $sources_list = "lib/unicore/mktables.lst";
+my @sources = ($0, qw(lib/unicore/mktables
+ lib/Unicode/UCD.pm
+ regen/charset_translations.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;
}
- 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;
-
- # 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.
- unshift @invlist, 256 if $i % 2 != 0;
- $found_nonl1 = 1;
- last;
+ else {
+ while(<$mktables_list>) {
+ last if /===/;
+ chomp;
+ push @sources, "lib/unicore/$_" if /^[^#]/;
}
- die "No non-Latin1 code points in $lookup_prop" unless $found_nonl1;
}
-
- output_invlist($prop_name, \@invlist);
}
-
-read_only_bottom_close_and_rename($out_fh)
+read_only_bottom_close_and_rename($out_fh, \@sources)