prop_invlist
prop_invmap search_invlist
charprop
+ num
);
require './regen/regen_lib.pl';
require './regen/charset_translations.pl';
+require './lib/unicore/Heavy.pl';
+use re "/aa";
# This program outputs charclass_invlists.h, which contains various inversion
# lists in the form of C arrays that are to be used as-is for inversion lists.
# out-of-sync, or the wrong data structure being passed. Currently that
# random number is:
-# charclass_invlists.h now also has a partial implementation of inversion
-# maps; enough to generate tables for the line break properties, such as GCB
+# charclass_invlists.h now also contains inversion maps and enum definitions
+# for those maps that have a finite number of possible values
my $VERSION_DATA_STRUCTURE_TYPE = 148565664;
# integer or float
-my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /ax;
+my $numeric_re = qr/ ^ -? \d+ (:? \. \d+ )? $ /x;
+
+my %keywords;
+my $table_name_prefix = "PL_";
# Matches valid C language enum names: begins with ASCII alphabetic, then any
# ASCII \w
{style => '*', by => 'regen/mk_invlists.pl',
from => "Unicode::UCD"});
-my $in_file_pound_if = 0;
+my $in_file_pound_if = "";
my $max_hdr_len = 3; # In headings, how wide a name is allowed?
# enums that should be made public
my %public_enums = (
- #_Perl_SCX => 1
+ _Perl_SCX => 1
);
# The symbols generated by this program are all currently defined only in a
# single dot c each. The code knows where most of them go, but this hash
# gives overrides for the exceptions to the typical place
my %exceptions_to_where_to_define =
- ( NonL1_Perl_Non_Final_Folds => 'PERL_IN_REGCOMP_C',
- AboveLatin1 => 'PERL_IN_REGCOMP_C',
- Latin1 => 'PERL_IN_REGCOMP_C',
- UpperLatin1 => 'PERL_IN_REGCOMP_C',
- _Perl_Any_Folds => 'PERL_IN_REGCOMP_C',
- _Perl_Folds_To_Multi_Char => 'PERL_IN_REGCOMP_C',
- _Perl_IDCont => 'PERL_IN_UTF8_C',
- _Perl_IDStart => 'PERL_IN_UTF8_C',
+ (
+ #_Perl_IVCF => 'PERL_IN_REGCOMP_C',
);
+
my %where_to_define_enums = ();
+my $applies_to_all_charsets_text = "all charsets";
+
my %gcb_enums;
my @gcb_short_enums;
my %gcb_abbreviations;
my @a2n;
+my %prop_name_aliases;
+# Invert this hash so that for each canonical name, we get a list of things
+# that map to it (excluding itself)
+foreach my $name (sort keys %utf8::loose_property_name_of) {
+ my $canonical = $utf8::loose_property_name_of{$name};
+ push @{$prop_name_aliases{$canonical}}, $name if $canonical ne $name;
+}
+
+# Output these tables in the same vicinity as each other, so that will get
+# paged in at about the same time. These are also assumed to be the exact
+# same list as those properties used internally by perl.
+my %keep_together = (
+ assigned => 1,
+ ascii => 1,
+ upper => 1,
+ lower => 1,
+ title => 1,
+ cased => 1,
+ uppercaseletter => 1,
+ lowercaseletter => 1,
+ titlecaseletter => 1,
+ casedletter => 1,
+ vertspace => 1,
+ xposixalnum => 1,
+ xposixalpha => 1,
+ xposixblank => 1,
+ xposixcntrl => 1,
+ xposixdigit => 1,
+ xposixgraph => 1,
+ xposixlower => 1,
+ xposixprint => 1,
+ xposixpunct => 1,
+ xposixspace => 1,
+ xposixupper => 1,
+ xposixword => 1,
+ xposixxdigit => 1,
+ posixalnum => 1,
+ posixalpha => 1,
+ posixblank => 1,
+ posixcntrl => 1,
+ posixdigit => 1,
+ posixgraph => 1,
+ posixlower => 1,
+ posixprint => 1,
+ posixpunct => 1,
+ posixspace => 1,
+ posixupper => 1,
+ posixword => 1,
+ posixxdigit => 1,
+ _perl_any_folds => 1,
+ _perl_folds_to_multi_char => 1,
+ _perl_idstart => 1,
+ _perl_idcont => 1,
+ _perl_charname_begin => 1,
+ _perl_charname_continue => 1,
+ _perl_problematic_locale_foldeds_start => 1,
+ _perl_problematic_locale_folds => 1,
+ _perl_quotemeta => 1,
+ );
+my %perl_tags; # So can find synonyms of the above properties
+
sub uniques {
# Returns non-duplicated input values. From "Perl Best Practices:
# Encapsulated Cleverness". p. 455 in first edition.
sub end_file_pound_if {
if ($in_file_pound_if) {
print $out_fh "\n#endif\t/* $in_file_pound_if */\n";
- $in_file_pound_if = 0;
+ $in_file_pound_if = "";
}
}
-sub switch_pound_if ($$) {
+sub end_charset_pound_if {
+ print $out_fh "\n" . get_conditional_compile_line_end();
+}
+
+sub switch_pound_if ($$;$) {
my $name = shift;
my $new_pound_if = shift;
+ my $charset = shift;
+
my @new_pound_if = ref ($new_pound_if)
- ? @$new_pound_if
+ ? sort @$new_pound_if
: $new_pound_if;
# Switch to new #if given by the 2nd argument. If there is an override
# for this, it instead switches to that. The 1st argument is the
- # static's name, used to look up the overrides
+ # static's name, used only to check if there is an override for this
+ #
+ # The 'charset' parmameter, if present, is used to first end the charset
+ # #if if we actually do a switch, and then restart it afterwards. This
+ # code, then assumes that the charset #if's are enclosed in the file ones.
if (exists $exceptions_to_where_to_define{$name}) {
@new_pound_if = $exceptions_to_where_to_define{$name};
}
- $new_pound_if = join "", @new_pound_if;
- # Exit current #if if the new one is different from the old
- if ( $in_file_pound_if
- && $in_file_pound_if !~ /$new_pound_if/)
- {
- end_file_pound_if;
+ foreach my $element (@new_pound_if) {
+ $element = "defined($element)";
}
+ $new_pound_if = join " || ", @new_pound_if;
+
+ # Change to the new one if different from old
+ if ($in_file_pound_if ne $new_pound_if) {
- # Enter new #if, if not already in it.
- if (! $in_file_pound_if) {
- foreach my $element (@new_pound_if) {
- $element = "defined($element)";
+ end_charset_pound_if() if defined $charset;
+
+ # Exit any current #if
+ if ($in_file_pound_if) {
+ end_file_pound_if;
}
- $in_file_pound_if = join " || ", @new_pound_if;
+
+ $in_file_pound_if = $new_pound_if;
print $out_fh "\n#if $in_file_pound_if\n";
+
+ start_charset_pound_if ($charset, 1) if defined $charset;
}
}
+sub start_charset_pound_if ($;$) {
+ print $out_fh "\n" . get_conditional_compile_line_start(shift, shift);
+}
+
sub output_invlist ($$;$) {
my $name = shift;
my $invlist = shift; # Reference to inversion list array
}
my $count = @$invlist;
- switch_pound_if ($name, 'PERL_IN_PERL_C');
-
print $out_fh "\nstatic const UV ${name}_invlist[] = {";
print $out_fh " /* for $charset */" if $charset;
print $out_fh "\n";
}
}
- # 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';
-
- my $is_public_enum = exists $public_enums{$name};
- if ($is_public_enum) {
- end_file_pound_if;
- }
- else {
- switch_pound_if($name, $where);
- }
-
# 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
$enum_declaration_type = "${name_prefix}enum";
- # Finished with the enum definition. If it only contains one element,
- # that is a dummy, default one
+ # 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 "} $enum_declaration_type;\n";
}
- switch_pound_if($name, $where) if $is_public_enum;
+ switch_pound_if($name, $where, $charset);
$invmap_declaration_type = ($input_format =~ /s/)
? $enum_declaration_type
- : "IV";
+ : "int";
$aux_declaration_type = ($input_format =~ /s/)
? $enum_declaration_type
- : "int";
+ : "unsigned int";
$output_format = "${name_prefix}%s";
# that.
for (my $i = 0; $i < @decimals_invlist; $i += 2) {
my $code_point = $decimals_invlist[$i];
- next if chr($code_point) !~ /\p{Nv=0}/;
+ next if num(chr($code_point)) ne '0';
# Turn the scripts this zero is in into a list.
my @scripts = split ",",
# Read in the Case Folding rules, and construct arrays of code points for the
# properties we need.
-my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding");
+my ($cp_ref, $folds_ref, $format, $default) = prop_invmap("Case_Folding");
die "Could not find inversion map for Case_Folding" unless defined $format;
die "Incorrect format '$format' for Case_Folding inversion map"
unless $format eq 'al'
# Add to the non-finals list each code point that is in a non-final
# position
for my $j (0 .. @{$folds_ref->[$i]} - 2) {
- push @is_non_final_fold, $folds_ref->[$i][$j]
- unless grep { $folds_ref->[$i][$j] == $_ } @is_non_final_fold;
+ push @is_non_final_fold, $folds_ref->[$i][$j];
}
+ @is_non_final_fold = uniques @is_non_final_fold;
}
sub _Perl_Non_Final_Folds {
@is_non_final_fold = sort { $a <=> $b } @is_non_final_fold;
- return mk_invlist_from_sorted_cp_list(\@is_non_final_fold);
+ my @return = mk_invlist_from_sorted_cp_list(\@is_non_final_fold);
+ return \@return;
+}
+
+sub _Perl_IVCF {
+
+ # This creates a map of the inversion of case folding. i.e., given a
+ # character, it gives all the other characters that fold to it.
+ #
+ # Inversion maps function kind of like a hash, with the inversion list
+ # specifying the buckets (keys) and the inversion maps specifying the
+ # contents of the corresponding bucket. Effectively this function just
+ # swaps the keys and values of the case fold hash. But there are
+ # complications. Most importantly, More than one character can each have
+ # the same fold. This is solved by having a list of characters that fold
+ # to a given one.
+
+ my %new;
+
+ # Go through the inversion list.
+ for (my $i = 0; $i < @$cp_ref; $i++) {
+
+ # Skip if nothing folds to this
+ next if $folds_ref->[$i] == 0;
+
+ # This entry which is valid from here to up (but not including) the
+ # next entry is for the next $count characters, so that, for example,
+ # A-Z is represented by one entry.
+ my $cur_list = $cp_ref->[$i];
+ my $count = $cp_ref->[$i+1] - $cur_list;
+
+ # The fold of [$i] can be not just a single character, but a sequence
+ # of multiple ones. We deal with those here by just creating a string
+ # consisting of them. Otherwise, we use the single code point [$i]
+ # folds to.
+ my $cur_map = (ref $folds_ref->[$i])
+ ? join "", map { chr } $folds_ref->[$i]->@*
+ : $folds_ref->[$i];
+
+ # Expand out this range
+ while ($count > 0) {
+ push @{$new{$cur_map}}, $cur_list;
+
+ # A multiple-character fold is a string, and shouldn't need
+ # incrementing anyway
+ if (ref $folds_ref->[$i]) {
+ die sprintf("Case fold for %x is multiple chars; should have"
+ . " a count of 1, but instead it was $count", $count)
+ unless $count == 1;
+ }
+ else {
+ $cur_map++;
+ $cur_list++;
+ }
+ $count--;
+ }
+ }
+
+ # Now go through and make some adjustments. We add synthetic entries for
+ # two cases.
+ # 1) Two or more code points can fold to the same multiple character,
+ # sequence, as U+FB05 and U+FB06 both fold to 'st'. This code is only
+ # for single character folds, but FB05 and FB06 are single characters
+ # that are equivalent folded, so we add entries so that they are
+ # considered to fold to each other
+ # 2) If two or more above-Latin1 code points fold to the same Latin1 range
+ # one, we also add entries so that they are considered to fold to each
+ # other. This is so that under /aa or /l matching, where folding to
+ # their Latin1 range code point is illegal, they still can fold to each
+ # other. This situation happens in Unicode 3.0.1, but probably no
+ # other version.
+ foreach my $fold (keys %new) {
+ my $folds_to_string = $fold =~ /\D/;
+
+ # If the bucket contains only one element, convert from an array to a
+ # scalar
+ if (scalar $new{$fold}->@* == 1) {
+ $new{$fold} = $new{$fold}[0];
+ }
+ else {
+
+ # Otherwise, sort numerically. This places the highest code point
+ # in the list at the tail end. This is because Unicode keeps the
+ # lowercase code points as higher ordinals than the uppercase, at
+ # least for the ones that matter so far. These are synthetic
+ # entries, and we want to predictably have the lowercase (which is
+ # more likely to be what gets folded to) in the same corresponding
+ # position, so that other code can rely on that. If some new
+ # version of Unicode came along that violated this, we might have
+ # to change so that the sort is based on upper vs lower instead.
+ # (The lower-comes-after isn't true of native EBCDIC, but here we
+ # are dealing strictly with Unicode values).
+ @{$new{$fold}} = sort { $a <=> $b } $new{$fold}->@*
+ unless $folds_to_string;
+ # We will be working with a copy of this sorted entry.
+ my @source_list = $new{$fold}->@*;
+ if (! $folds_to_string) {
+
+ # This handles situation 2) listed above, which only arises if
+ # what is being folded-to (the fold) is in the Latin1 range.
+ if ($fold > 255 ) {
+ undef @source_list;
+ }
+ else {
+ # And it only arises if there are two or more folders that
+ # fold to it above Latin1. We look at just those.
+ @source_list = grep { $_ > 255 } @source_list;
+ undef @source_list if @source_list == 1;
+ }
+ }
+
+ # Here, we've found the items we want to set up synthetic folds
+ # for. Add entries so that each folds to each other.
+ foreach my $cp (@source_list) {
+ my @rest = grep { $cp != $_ } @source_list;
+ if (@rest == 1) {
+ $new{$cp} = $rest[0];
+ }
+ else {
+ push @{$new{$cp}}, @rest;
+ }
+ }
+ }
+
+ # We don't otherwise deal with multiple-character folds
+ delete $new{$fold} if $folds_to_string;
+ }
+
+
+ # Now we have a hash that is the inversion of the case fold property.
+ # Convert it to an inversion map.
+
+ my @sorted_folds = sort { $a <=> $b } keys %new;
+ my (@invlist, @invmap);
+
+ # We know that nothing folds to the controls (whose ordinals start at 0).
+ # And the first real entries are the lowest in the hash.
+ push @invlist, 0, $sorted_folds[0];
+ push @invmap, 0, $new{$sorted_folds[0]};
+
+ # Go through the remainder of the hash keys (which are the folded code
+ # points)
+ for (my $i = 1; $i < @sorted_folds; $i++) {
+
+ # Get the current one, and the one prior to it.
+ my $fold = $sorted_folds[$i];
+ my $prev_fold = $sorted_folds[$i-1];
+
+ # If the current one is not just 1 away from the prior one, we close
+ # out the range containing the previous fold, and know that the gap
+ # doesn't have anything that folds.
+ if ($fold - 1 != $prev_fold) {
+ push @invlist, $prev_fold + 1;
+ push @invmap, 0;
+
+ # And start a new range
+ push @invlist, $fold;
+ push @invmap, $new{$fold};
+ }
+ elsif ($new{$fold} - 1 != $new{$prev_fold}) {
+
+ # Here the current fold is just 1 greater than the previous, but
+ # the new map isn't correspondingly 1 greater than the previous,
+ # the old range is ended, but since there is no gap, we don't have
+ # to insert anything else.
+ push @invlist, $fold;
+ push @invmap, $new{$fold};
+
+ } # else { Otherwise, this new entry just extends the previous }
+
+ die "In IVCF: $invlist[-1] <= $invlist[-2]"
+ if $invlist[-1] <= $invlist[-2];
+ }
+
+ # And add an entry that indicates that everything above this, to infinity,
+ # does not have a case fold.
+ push @invlist, $sorted_folds[-1] + 1;
+ push @invmap, 0;
+
+ # All Unicode versions have some places where multiple code points map to
+ # the same one, so the format always has an 'l'
+ return \@invlist, \@invmap, 'al', $default;
}
sub prop_name_for_cmp ($) { # Sort helper
}
sub UpperLatin1 {
- return mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
+ my @return = mk_invlist_from_sorted_cp_list([ 128 .. 255 ]);
+ return \@return;
}
sub output_table_common {
for my $i (0 .. $size - 1) {
no warnings 'numeric';
- $has_placeholder = 1 if $names_ref->[$i] =~ / ^ [[:lower:]] $ /ax;
+ $has_placeholder = 1 if $names_ref->[$i] =~ / ^ [[:lower:]] $ /x;
$spacers[$i] = " " x (length($names_ref->[$i]) - $column_width);
}
\@wb_table, \@wb_short_enums, \%wb_abbreviations);
}
+sub sanitize_name ($) {
+ # Change the non-word characters in the input string to standardized word
+ # equivalents
+ #
+ my $sanitized = shift;
+ $sanitized =~ s/=/__/;
+ $sanitized =~ s/&/_AMP_/;
+ $sanitized =~ s/\./_DOT_/;
+ $sanitized =~ s/-/_MINUS_/;
+ $sanitized =~ s!/!_SLASH_!;
+
+ return $sanitized;
+}
+
+switch_pound_if ('ALL', 'PERL_IN_UTF8_C');
+
output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);
# An initial & means to use the subroutine from this file instead of an
# official inversion list.
-for my $charset (get_supported_code_pages()) {
- print $out_fh "\n" . get_conditional_compile_line_start($charset);
-
- @a2n = @{get_a2n($charset)};
- # 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
- for my $prop (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
- Assigned
- 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
- _Perl_GCB,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,EDGE
- _Perl_LB,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,EDGE,
- _Perl_SB,SContinue,CR,Extend,LF,EDGE
- _Perl_WB,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,EDGE,UNKNOWN
- _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
- )
- # NOTE that the convention is that extra enum
- # values come after the property name, separated by
- # commas, with the enums that aren't ever defined
- # by Unicode coming last, at least 4 all-uppercase
- # characters. The others are enum names that are
- # needed by perl, but aren't in all Unicode
- # releases.
- ) {
-
- # For the Latin1 properties, we change to use the eXtended version of the
- # base property, then go through the result and get rid of everything not
- # in Latin1 (above 255). Actually, we retain the element for the range
- # that crosses the 255/256 boundary if it is one that matches the
- # property. For example, in the Word property, there is a range of code
- # points that start at U+00F8 and goes through U+02C1. Instead of
- # artificially cutting that off at 256 because 256 is the first code point
- # above Latin1, we let the range go to its natural ending. That gives us
- # extra information with no added space taken. But if the range that
- # crosses the boundary is one that doesn't match the property, we don't
- # start a new range above 255, as that could be construed as going to
- # infinity. For example, the Upper property doesn't include the character
- # at 255, but does include the one at 256. We don't include the 256 one.
- my $prop_name = $prop;
- my $is_local_sub = $prop_name =~ s/^&//;
- my $extra_enums = "";
- $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
- my $lookup_prop = $prop_name;
- my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
- or $lookup_prop =~ s/^L1//);
- my $nonl1_only = 0;
- $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
- ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;
+# Below is the list of property names to generate. '&' means to use the
+# subroutine to generate the inversion list instead of the generic code
+# below. Some properties have a comma-separated list after the name,
+# These are extra enums to add to those found in the Unicode tables.
+no warnings 'qw';
+ # Ignore non-alpha in sort
+my @props;
+push @props, sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw(
+ &NonL1_Perl_Non_Final_Folds
+ &UpperLatin1
+ _Perl_GCB,E_Base,E_Base_GAZ,E_Modifier,Glue_After_Zwj,LV,Prepend,Regional_Indicator,SpacingMark,ZWJ,EDGE
+ _Perl_LB,Close_Parenthesis,Hebrew_Letter,Next_Line,Regional_Indicator,ZWJ,Contingent_Break,E_Base,E_Modifier,H2,H3,JL,JT,JV,Word_Joiner,EDGE,
+ _Perl_SB,SContinue,CR,Extend,LF,EDGE
+ _Perl_WB,CR,Double_Quote,E_Base,E_Base_GAZ,E_Modifier,Extend,Glue_After_Zwj,Hebrew_Letter,LF,MidNumLet,Newline,Regional_Indicator,Single_Quote,ZWJ,EDGE,UNKNOWN
+ _Perl_SCX,Latin,Inherited,Unknown,Kore,Jpan,Hanb,INVALID
+ Lowercase_Mapping
+ Titlecase_Mapping
+ Uppercase_Mapping
+ Simple_Case_Folding
+ Case_Folding
+ &_Perl_IVCF
+ );
+ # NOTE that the convention is that extra enum values come
+ # after the property name, separated by commas, with the enums
+ # that aren't ever defined by Unicode coming last, at least 4
+ # all-uppercase characters. The others are enum names that
+ # are needed by perl, but aren't in all Unicode releases.
+
+my @bin_props;
+my @perl_prop_synonyms;
+my %enums;
+my @deprecated_messages = ""; # Element [0] is a placeholder
+my %deprecated_tags;
+
+my $float_e_format = qr/ ^ -? \d \. \d+ e [-+] \d+ $ /x;
+
+# Create another hash that maps floating point x.yyEzz representation to what
+# %stricter_to_file_of does for the equivalent rational. A typical entry in
+# the latter hash is
+#
+# 'nv=1/2' => 'Nv/1_2',
+#
+# From that, this loop creates an entry
+#
+# 'nv=5.00e-01' => 'Nv/1_2',
+#
+# %stricter_to_file_of contains far more than just the rationals. Instead we
+# use %utf8::nv_floating_to_rational which should have an entry for each
+# nv in the former hash.
+my %floating_to_file_of;
+foreach my $key (keys %utf8::nv_floating_to_rational) {
+ my $value = $utf8::nv_floating_to_rational{$key};
+ $floating_to_file_of{$key} = $utf8::stricter_to_file_of{"nv=$value"};
+}
+
+# Collect all the binary properties from data in lib/unicore
+# Sort so that complements come after the main table, and the shortest
+# names first, finally alphabetically. Also, sort together the tables we want
+# to be kept together, and prefer those with 'posix' in their names, which is
+# what the C code is expecting their names to be.
+foreach my $property (sort
+ { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
+ or $b =~ /posix/i <=> $a =~ /posix/i
+ or $b =~ /perl/i <=> $a =~ /perl/i
+ or $a =~ $float_e_format <=> $b =~ $float_e_format
+ or $a =~ /!/ <=> $b =~ /!/
+ or length $a <=> length $b
+ or $a cmp $b
+ } keys %utf8::loose_to_file_of,
+ keys %utf8::stricter_to_file_of,
+ keys %floating_to_file_of
+) {
+
+ # These two hashes map properties to values that can be considered to
+ # be checksums. If two properties have the same checksum, they have
+ # identical entries. Otherwise they differ in some way.
+ my $tag = $utf8::loose_to_file_of{$property};
+ $tag = $utf8::stricter_to_file_of{$property} unless defined $tag;
+ $tag = $floating_to_file_of{$property} unless defined $tag;
+
+ # The tag may contain an '!' meaning it is identical to the one formed
+ # by removing the !, except that it is inverted.
+ my $inverted = $tag =~ s/!//;
+
+ # This hash is lacking the property name
+ $property = "nv=$property" if $property =~ $float_e_format;
+
+ # The list of 'prop=value' entries that this single entry expands to
+ my @this_entries;
+
+ # Split 'property=value' on the equals sign, with $lhs being the whole
+ # thing if there is no '='
+ my ($lhs, $rhs) = $property =~ / ( [^=]* ) ( =? .*) /x;
+
+ # $lhs then becomes the property name. See if there are any synonyms
+ # for this property.
+ if (exists $prop_name_aliases{$lhs}) {
+
+ # If so, do the combinatorics so that a new entry is added for
+ # each legal property combined with the property value (which is
+ # $rhs)
+ foreach my $alias (@{$prop_name_aliases{$lhs}}) {
+
+ # But, there are some ambiguities, like 'script' is a synonym
+ # for 'sc', and 'sc' can stand alone, meaning something
+ # entirely different than 'script'. 'script' cannot stand
+ # alone. Don't add if the potential new lhs is in the hash of
+ # stand-alone properties.
+ no warnings 'once';
+ next if $rhs eq "" && grep { $alias eq $_ }
+ keys %utf8::loose_property_to_file_of;
+
+ my $new_entry = $alias . $rhs;
+ push @this_entries, $new_entry;
+ }
+ }
+
+ # Above, we added the synonyms for the base entry we're now
+ # processing. But we haven't dealt with it yet. If we already have a
+ # property with the identical characteristics, this becomes just a
+ # synonym for it.
+ if (exists $enums{$tag}) {
+ push @this_entries, $property;
+ }
+ else { # Otherwise, create a new entry.
+
+ # Add to the list of properties to generate inversion lists for.
+ push @bin_props, uc $property;
+
+ # Create a rule for the parser
+ if (! exists $keywords{$property}) {
+ $keywords{$property} = token_name($property);
+ }
+
+ # And create an enum for it.
+ $enums{$tag} = $table_name_prefix . uc sanitize_name($property);
+
+ $perl_tags{$tag} = 1 if exists $keep_together{lc $property};
+
+ # Some properties are deprecated. This hash tells us so, and the
+ # warning message to raise if they are used.
+ if (exists $utf8::why_deprecated{$tag}) {
+ $deprecated_tags{$enums{$tag}} = scalar @deprecated_messages;
+ push @deprecated_messages, $utf8::why_deprecated{$tag};
+ }
+
+ # Our sort above should have made sure that we see the
+ # non-inverted version first, but this makes sure.
+ warn "$property is inverted!!!" if $inverted;
+ }
+
+ # Everything else is #defined to be the base enum, inversion is
+ # indicated by negating the value.
+ my $defined_to = "";
+ $defined_to .= "-" if $inverted;
+ $defined_to .= $enums{$tag};
+
+ # Go through the entries that evaluate to this.
+ @this_entries = uniques @this_entries;
+ foreach my $define (@this_entries) {
+
+ # There is a rule for the parser for each.
+ $keywords{$define} = $defined_to;
+
+ # And a #define for all simple names equivalent to a perl property,
+ # except those that begin with 'is' or 'in';
+ if (exists $perl_tags{$tag} && $property !~ / ^ i[ns] | = /x) {
+ push @perl_prop_synonyms, "#define "
+ . $table_name_prefix
+ . uc(sanitize_name($define))
+ . " $defined_to";
+ }
+ }
+}
+
+@bin_props = sort { exists $keep_together{lc $b} <=> exists $keep_together{lc $a}
+ or $a cmp $b
+ } @bin_props;
+@perl_prop_synonyms = sort(uniques(@perl_prop_synonyms));
+push @props, @bin_props;
+
+foreach my $prop (@props) {
+
+ # For the Latin1 properties, we change to use the eXtended version of the
+ # base property, then go through the result and get rid of everything not
+ # in Latin1 (above 255). Actually, we retain the element for the range
+ # that crosses the 255/256 boundary if it is one that matches the
+ # property. For example, in the Word property, there is a range of code
+ # points that start at U+00F8 and goes through U+02C1. Instead of
+ # artificially cutting that off at 256 because 256 is the first code point
+ # above Latin1, we let the range go to its natural ending. That gives us
+ # extra information with no added space taken. But if the range that
+ # crosses the boundary is one that doesn't match the property, we don't
+ # start a new range above 255, as that could be construed as going to
+ # infinity. For example, the Upper property doesn't include the character
+ # at 255, but does include the one at 256. We don't include the 256 one.
+ my $prop_name = $prop;
+ my $is_local_sub = $prop_name =~ s/^&//;
+ my $extra_enums = "";
+ $extra_enums = $1 if $prop_name =~ s/, ( .* ) //x;
+ my $lookup_prop = $prop_name;
+ $prop_name = sanitize_name($prop_name);
+ $prop_name = $table_name_prefix . $prop_name if grep { lc $lookup_prop eq lc $_ } @bin_props;
+ my $l1_only = ($lookup_prop =~ s/^L1Posix/XPosix/
+ or $lookup_prop =~ s/^L1//);
+ my $nonl1_only = 0;
+ $nonl1_only = $lookup_prop =~ s/^NonL1// unless $l1_only;
+ ($lookup_prop, my $has_suffixes) = $lookup_prop =~ / (.*) ( , .* )? /x;
+
+ for my $charset (get_supported_code_pages()) {
+ @a2n = @{get_a2n($charset)};
my @invlist;
my @invmap;
my $map_default;
my $maps_to_code_point;
my $to_adjust;
+ my $same_in_all_code_pages;
if ($is_local_sub) {
- @invlist = eval $lookup_prop;
+ my @return = eval $lookup_prop;
die $@ if $@;
+ my $invlist_ref = shift @return;
+ @invlist = @$invlist_ref;
+ if (@return) { # If has other values returned , must be an
+ # inversion map
+ my $invmap_ref = shift @return;
+ @invmap = @$invmap_ref;
+ $map_format = shift @return;
+ $map_default = shift @return;
+ }
}
else {
@invlist = prop_invlist($lookup_prop, '_perl_core_internal_ok');
# 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'"
- unless defined $count;
}
else {
@invlist = @$list_ref;
}
}
-
- # 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
# of 0..256, as the remap will also include all of 0..256 (256 not
# 255 because a re-ordering could cause 256 to need to be in the same
# range as 255.)
- if ( (@invmap && $maps_to_code_point)
- || ( ! $nonl1_only
- || ( $invlist[0] < 256
- && ! ($invlist[0] == 0 && $invlist[1] > 256))))
+ if ( (@invmap && $maps_to_code_point)
+ || ( @invlist
+ && $invlist[0] < 256
+ && ( $invlist[0] != 0
+ || (scalar @invlist != 1 && $invlist[1] < 256))))
{
+ $same_in_all_code_pages = 0;
if (! @invmap) { # Straight inversion list
# Look at all the ranges that start before 257.
my @latin1_list;
# 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;
+ : 256;
for my $j ($invlist[0] .. $upper) {
push @latin1_list, a2n($j);
}
# to look at the whole of the inversion map (or at least to
# above Unicode; as the maps of code points above that should
# all be to the default).
- my $upper_limit = ($maps_to_code_point) ? 0x10FFFF : 256;
+ my $upper_limit = (! $maps_to_code_point)
+ ? 256
+ : (Unicode::UCD::UnicodeVersion() eq '1.1.5')
+ ? 0xFFFF
+ : 0x10FFFF;
my %mapped_lists; # A hash whose keys are the buckets.
while (@invlist) {
# This shouldn't actually happen, as prop_invmap() returns
# an extra element at the end that is beyond $upper_limit
- die "inversion map that extends to infinity is unimplemented" unless @invlist > 1;
+ die "inversion map (for $prop_name) that extends to infinity is unimplemented" unless @invlist > 1;
my $bucket;
# originals that start with code points above $upper_limit.
# Each bucket in %mapped_lists contains all the code points
# that map to that bucket. If the bucket is for a map to a
- # single code point is a single code point, the bucket has
- # been converted to native. If something else (including
- # multiple code points), no conversion is done.
+ # single code point, the bucket has been converted to native.
+ # If something else (including multiple code points), no
+ # conversion is done.
#
# Now we recreate the inversion map into %xlated, but this
# time for the native character set.
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.
$found_nonl1 = 1;
last;
}
- die "No non-Latin1 code points in $lookup_prop" unless $found_nonl1;
+ if (! $found_nonl1) {
+ warn "No non-Latin1 code points in $prop_name";
+ output_invlist($prop_name, []);
+ last;
+ }
}
- output_invlist($prop_name, \@invlist, $charset);
- output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, $map_default, $extra_enums, $charset) if @invmap;
+ switch_pound_if ($prop_name, 'PERL_IN_UTF8_C');
+ start_charset_pound_if($charset, 1) unless $same_in_all_code_pages;
+
+ output_invlist($prop_name, \@invlist, ($same_in_all_code_pages)
+ ? $applies_to_all_charsets_text
+ : $charset);
+
+ if (@invmap) {
+ output_invmap($prop_name, \@invmap, $lookup_prop, $map_format,
+ $map_default, $extra_enums, $charset);
+ }
+
+ last if $same_in_all_code_pages;
+ end_charset_pound_if;
+ }
+}
+
+switch_pound_if ('binary_property_tables', 'PERL_IN_UTF8_C');
+
+print $out_fh "\nconst char * deprecated_property_msgs[] = {\n\t";
+print $out_fh join ",\n\t", map { "\"$_\"" } @deprecated_messages;
+print $out_fh "\n};\n";
+
+my @enums = sort values %enums;
+
+# Save a copy of these before modification
+my @invlist_names = map { "${_}_invlist" } @enums;
+
+# Post-process the enums for deprecated properties.
+if (scalar keys %deprecated_tags) {
+ my $seen_deprecated = 0;
+ foreach my $enum (@enums) {
+ if (grep { $_ eq $enum } keys %deprecated_tags) {
+
+ # Change the enum name for this deprecated property to a
+ # munged one to act as a placeholder in the typedef. Then
+ # make the real name be a #define whose value is such that
+ # its modulus with the number of enums yields the index into
+ # the table occupied by the placeholder. And so that dividing
+ # the #define value by the table length gives an index into
+ # the table of deprecation messages for the corresponding
+ # warning.
+ my $revised_enum = "${enum}_perl_aux";
+ if (! $seen_deprecated) {
+ $seen_deprecated = 1;
+ print $out_fh "\n";
+ }
+ print $out_fh "#define $enum ($revised_enum + (MAX_UNI_KEYWORD_INDEX * $deprecated_tags{$enum}))\n";
+ $enum = $revised_enum;
+ }
}
- end_file_pound_if;
- print $out_fh "\n" . get_conditional_compile_line_end();
}
+print $out_fh "\ntypedef enum {\n\tPERL_BIN_PLACEHOLDER = 0,\n\t";
+print $out_fh join ",\n\t", @enums;
+print $out_fh "\n";
+print $out_fh "} binary_invlist_enum;\n";
+print $out_fh "\n#define MAX_UNI_KEYWORD_INDEX $enums[-1]\n";
+
+print $out_fh "\n/* Synonyms for perl properties */\n";
+print $out_fh join "\n", @perl_prop_synonyms, "\n";
+
+print $out_fh "\nstatic const UV * const PL_uni_prop_ptrs\[] = {\n";
+print $out_fh "\tNULL,\t/* Placeholder */\n\t";
+print $out_fh join ",\n\t", @invlist_names;
+print $out_fh "\n";
+print $out_fh "};\n";
+
switch_pound_if('Boundary_pair_tables', 'PERL_IN_REGEXEC_C');
output_GCB_table();
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
}
read_only_bottom_close_and_rename($out_fh, \@sources);
+
+require './regen/mph.pl';
+
+sub token_name
+{
+ my $name = sanitize_name(shift);
+ warn "$name contains non-word" if $name =~ /\W/;
+
+ return "$table_name_prefix\U$name"
+}
+
+my $keywords_fh = open_new('uni_keywords.h', '>',
+ {style => '*', by => 'regen/mk_invlists.pl',
+ from => "mph.pl"});
+
+no warnings 'once';
+print $keywords_fh <<"EOF";
+/* The precisionn to use in "%.*e" formats */
+#define PL_E_FORMAT_PRECISION $utf8::e_precision
+
+EOF
+
+my ($second_level, $seed1, $length_all_keys, $smart_blob, $rows) = MinimalPerfectHash::make_mph_from_hash(\%keywords);
+print $keywords_fh MinimalPerfectHash::make_algo($second_level, $seed1, $length_all_keys, $smart_blob, $rows, undef, undef, undef, 'match_uniprop' );
+
+push @sources, 'regen/mph.pl';
+read_only_bottom_close_and_rename($keywords_fh, \@sources);
https://perl5.git.perl.org / perl5.git / blobdiff