This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/mk_invlists.pl: Add capability for line break props
authorKarl Williamson <khw@cpan.org>
Wed, 18 Feb 2015 22:29:09 +0000 (15:29 -0700)
committerKarl Williamson <khw@cpan.org>
Fri, 20 Feb 2015 05:55:01 +0000 (22:55 -0700)
This is a partial implementation of a full inversion map generation
capability, which is why some code is indented more than necessary --
in the future there will be things that use that.  But this is
sufficient for 5.22.

This allows for the generation of tables to handle the Unicode line
breaking properties, like GCB and WB.  Future commits will actually use
this capability.

charclass_invlists.h
regen/mk_invlists.pl

index 0100dc8..4b950a9 100644 (file)
@@ -50142,5 +50142,5 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */
  * a17a0330e57d774343a53c019f1bc69827c2676982a1bf48e0898a76710e8877 lib/unicore/extracted/DNumType.txt
  * c2cb810a67cc5fb4a8d236b6c1bc6dd4d89733d8603881997e8aae2c816a3db1 lib/unicore/extracted/DNumValues.txt
  * 746472de66b936ac885ca6d6e68058242b4e909e3260c6317f3ec719f78f76cc lib/unicore/version
- * abd67fc74314be8951561a7f96909e428e77107873621cd4bf5c471c4c0e73da regen/mk_invlists.pl
+ * 7e16ea29ac35eda35bb9d7d5e4259f3f966a8c6018abe130125a14b665637eb2 regen/mk_invlists.pl
  * ex: set ro: */
index a659f73..69027d4 100644 (file)
@@ -2,7 +2,12 @@
 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';
 
@@ -16,8 +21,19 @@ require 'regen/charset_translations.pl';
 # 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:
+
+# 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"});
@@ -28,6 +44,25 @@ print $out_fh "/* See the generating file for comments */\n\n";
 
 my %include_in_ext_re = ( NonL1_Perl_Non_Final_Folds => 1 );
 
+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_ifndef_ext_re {
     if ($is_in_ifndef_ext_re) {
         print $out_fh "\n#endif\t/* #ifndef PERL_IN_XSUB_RE */\n";
@@ -86,6 +121,105 @@ sub output_invlist ($$;$) {
     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 @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, add in the extras, and sort.
+                @enums = map { (prop_value_aliases($prop_name, $_))[1] } @enums;
+                push @enums, split /,/, $extra_enums if $extra_enums ne "";
+                @enums = sort @enums;
+
+                # Assign a value to each element of the enum.  The default
+                # value always gets 0; the others are arbitrarily assigned.
+                my $enum_val = 0;
+                $default = prop_value_aliases($prop_name, $default);
+                $enums{$default} = $enum_val++;
+                for my $enum (@enums) {
+                    $enums{$enum} = $enum_val++ unless exists $enums{$enum};
+                }
+            }
+
+        end_ifndef_ext_re;
+        {
+
+            my $short_name = (prop_aliases($prop_name))[0];
+
+            # 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 = "PL_${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";
+
+    unless ($is_in_ifndef_ext_re) {
+        print $out_fh "\n#ifndef PERL_IN_XSUB_RE\n";
+        $is_in_ifndef_ext_re = 1;
+    }
+}
+
 sub mk_invlist_from_sorted_cp_list {
 
     # Returns an inversion list constructed from the sorted input array of
@@ -93,6 +227,8 @@ sub mk_invlist_from_sorted_cp_list {
 
     my $list_ref = shift;
 
+    return unless @$list_ref;
+
     # Initialize to just the first element
     my @invlist = ( $list_ref->[0], $list_ref->[0] + 1);
 
@@ -135,6 +271,17 @@ sub _Perl_Non_Final_Folds {
     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 ]);
 }
@@ -170,11 +317,10 @@ end_ifndef_ext_re;
 for my $charset (get_supported_code_pages()) {
     print $out_fh "\n" . get_conditional_compile_line_start($charset);
 
-    my @a2n = @{get_a2n($charset)};
-                             # Ignore non-alpha in sort
-    for my $prop (sort {     lc ($a =~ s/[[:^alpha:]]//gr)
-                         cmp lc ($b =~ s/[[:^alpha:]]//gr)
-                       } qw(
+    @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
@@ -216,29 +362,70 @@ for my $charset (get_supported_code_pages()) {
         # 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) {
+                my ($list_ref, $map_ref, $format, $default);
+
+                ($list_ref, $map_ref, $format, $default)
+                          = prop_invmap($lookup_prop, '_perl_core_internal_ok');
+                die "Could not find inversion list for '$lookup_prop'" unless $list_ref;
+                @invlist = @$list_ref;
+                @invmap = @$map_ref;
+                $map_format = $format;
+                $map_default = $default;
+                $maps_to_code_point = $map_format =~ /x/;
+                $to_adjust = $map_format =~ /a/;
+            }
         }
         die "Could not find inversion list for '$lookup_prop'" unless @invlist;
 
-        # Re-order the Unicode code points to native ones for this platform;
-        # only needed for code points below 256, and only if the first range
-        # doesn't span the whole of 0..256 (256 not 255 because a re-ordering
-        # could cause 256 to need to be in the same range as 255.)
-        if (! $nonl1_only || ($invlist[0] < 256
-                              && ! ($invlist[0] == 0 && $invlist[1] > 256)))
+        # 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) {
@@ -251,12 +438,7 @@ for my $charset (get_supported_code_pages()) {
                               # deficiencies with very large numbers.
                             : $Unicode::UCD::MAX_CP;
                 for my $j ($invlist[0] .. $upper) {
-                    if ($j < 256) {
-                        push @latin1_list, $a2n[$j];
-                    }
-                    else {
-                        push @latin1_list, $j;
-                    }
+                    push @latin1_list, a2n($j);
                 }
 
                 shift @invlist; # Shift off the range that's in the list
@@ -272,9 +454,179 @@ for my $charset (get_supported_code_pages()) {
             @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) {
 
@@ -293,6 +645,7 @@ for my $charset (get_supported_code_pages()) {
 
                     # Remove everything past this.
                     splice @invlist, $i;
+                    splice @invmap, $i if @invmap;
                     last;
                 }
             }
@@ -305,11 +658,16 @@ for my $charset (get_supported_code_pages()) {
                 # 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.
-                unshift @invlist, 256 if $i % 2 != 0;
+                # 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;
             }
@@ -317,6 +675,7 @@ for my $charset (get_supported_code_pages()) {
         }
 
         output_invlist($prop_name, \@invlist, $charset);
+        output_invmap($prop_name, \@invmap, $lookup_prop, $map_format, $map_default, $extra_enums, $charset) if @invmap;
     }
     end_ifndef_ext_re;
     print $out_fh "\n" . get_conditional_compile_line_end();