regen/regcharclass_multi_char_folds.pl

   1 package regcharclass_multi_char_folds;
   2 use 5.015;
   3 use strict;
   4 use warnings;
   5 use Unicode::UCD "prop_invmap";
   6
   7 # This returns an array of strings of the form
   8 #   "\x{foo}\x{bar}\x{baz}"
   9 # of the sequences of code points that are multi-character folds in the
  10 # current Unicode version.  If the parameter is 1, all such folds are
  11 # returned.  If the parameters is 0, only the ones containing exclusively
  12 # Latin1 characters are returned.  In the latter case all combinations of
  13 # Latin1 characters that can fold to the base one are returned.  Thus for
  14 # 'ss', it would return in addition, 'Ss', 'sS', and 'SS'.  This is because
  15 # this code is designed to help regcomp.c, and EXACTFish regnodes.  For
  16 # non-UTF-8 patterns, the strings are not necessarily folded, so we need to
  17 # check for the upper and lower case versions.  For UTF-8 patterns, the
  18 # strings are folded, except in EXACTFL nodes) so we only need to worry about
  19 # the fold version.  All folded-to characters in non-UTF-8 (Latin1) are
  20 # members of fold-pairs, at least within Latin1, 'k', and 'K', for example.
  21 # So there aren't complications with dealing with unfolded input.  That's not
  22 # true of UTF-8 patterns, where things can get tricky.  Thus for EXACTFL nodes
  23 # where things aren't all folded, code has to be written specially to handle
  24 # this, instead of the macros here being extended to try to handle it.
  25 #
  26 # There are no non-ASCII Latin1 multi-char folds currently, and none likely to
  27 # be ever added.  Thus the output is the same as if it were just asking for
  28 # ASCII characters, not full Latin1.  Hence, it is suitable for generating
  29 # things that match EXACTFAA.  It does check for and croak if there ever were
  30 # to be an upper Latin1 range multi-character fold.
  31 #
  32 # This is designed for input to regen/regcharlass.pl.
  33
  34 sub gen_combinations ($;) {
  35     # Generate all combinations for the first parameter which is an array of
  36     # arrays.
  37
  38     my ($fold_ref, $string, $i) = @_;
  39     $string = "" unless $string;
  40     $i = 0 unless $i;
  41
  42     my @ret;
  43
  44     # Look at each element in this level's array.
  45     foreach my $j (0 .. @{$fold_ref->[$i]} - 1) {
  46
  47         # Append its representation to what we have currently
  48         my $new_string = $fold_ref->[$i][$j] =~ /[[:print:]]/
  49                          ? ($string . chr $fold_ref->[$i][$j])
  50                          : sprintf "$string\\x{%X}", $fold_ref->[$i][$j];
  51
  52         if ($i >=  @$fold_ref - 1) {    # Final level: just return it
  53             push @ret, "\"$new_string\"";
  54         }
  55         else {  # Generate the combinations for the next level with this one's
  56             push @ret, &gen_combinations($fold_ref, $new_string, $i + 1);
  57         }
  58     }
  59
  60     return @ret;
  61 }
  62
  63 sub multi_char_folds ($) {
  64     my $all_folds = shift;  # The single parameter is true if wants all
  65                             # multi-char folds; false if just the ones that
  66                             # are all ascii
  67
  68     return () if pack("C*", split /\./, Unicode::UCD::UnicodeVersion()) lt v3.0.1;
  69
  70     my ($cp_ref, $folds_ref, $format) = prop_invmap("Case_Folding");
  71     die "Could not find inversion map for Case_Folding" unless defined $format;
  72     die "Incorrect format '$format' for Case_Folding inversion map"
  73                                                         unless $format eq 'al';
  74
  75     my @folds;
  76     my @output_folds;
  77
  78     for my $i (0 .. @$folds_ref - 1) {
  79         next unless ref $folds_ref->[$i];   # Skip single-char folds
  80
  81         # The code in regcomp.c currently assumes that no multi-char fold
  82         # folds to the upper Latin1 range.  It's not a big deal to add; we
  83         # just have to forbid such a fold in EXACTFL nodes, like we do already
  84         # for ascii chars in EXACTFA (and EXACTFL) nodes.  But I (khw) doubt
  85         # that there will ever be such a fold created by Unicode, so the code
  86         # isn't there to occupy space and time; instead there is this check.
  87         die sprintf("regcomp.c can't cope with a latin1 multi-char fold (found in the fold of 0x%X", $cp_ref->[$i]) if grep { $_ < 256 && chr($_) !~ /[[:ascii:]]/ } @{$folds_ref->[$i]};
  88
  89         @folds = @{$folds_ref->[$i]};
  90
  91         # Create a line that looks like "\x{foo}\x{bar}\x{baz}" of the code
  92         # points that make up the fold (use the actual character if
  93         # printable).
  94         my $fold = join "", map { chr $_ =~ /[[:print:]]/a
  95                                             ? chr $_
  96                                             : sprintf "\\x{%X}", $_
  97                                 } @folds;
  98         $fold = "\"$fold\"";
  99
 100         # Skip if something else already has this fold
 101         next if grep { $_ eq $fold } @output_folds;
 102
 103         if ($all_folds) {
 104             push @output_folds, $fold;
 105         }   # Skip if wants only all-ascii folds, and there is a non-ascii
 106         elsif (! grep { chr($_) =~ /[^[:ascii:]]/ } @folds) {
 107
 108             # If the fold is to a cased letter, replace the entry with an
 109             # array which also includes its upper case.
 110             my $this_fold_ref = \@folds;
 111             for my $j (0 .. @$this_fold_ref - 1) {
 112                 my $this_ord = $this_fold_ref->[$j];
 113                 if (chr($this_ord) =~ /\p{Cased}/) {
 114                     my $uc = ord(uc(chr($this_ord)));
 115                     undef $this_fold_ref->[$j];
 116                     @{$this_fold_ref->[$j]} = ( $this_ord, $uc);
 117                 }
 118             }
 119
 120             # Then generate all combinations of upper/lower case of the fold.
 121             push @output_folds, gen_combinations($this_fold_ref);
 122
 123         }
 124     }
 125
 126     # \x17F is the small LONG S, which folds to 's'.  Both Capital and small
 127     # LATIN SHARP S fold to 'ss'.  Therefore, they should also match two 17F's
 128     # in a row under regex /i matching.  But under /iaa regex matching, all
 129     # three folds to 's' are prohibited, but the sharp S's should still match
 130     # two 17F's.  This prohibition causes our regular regex algorithm that
 131     # would ordinarily allow this match to fail.  This is the only instance in
 132     # all Unicode of this kind of issue.  By adding a special case here, we
 133     # can use the regular algorithm (with some other changes elsewhere as
 134     # well).
 135     #
 136     # It would be possible to re-write the above code to automatically detect
 137     # and handle this case, and any others that might eventually get added to
 138     # the Unicode standard, but I (khw) don't think it's worth it.  I believe
 139     # that it's extremely unlikely that more folds to ASCII characters are
 140     # going to be added, and if I'm wrong, fold_grind.t has the intelligence
 141     # to detect them, and test that they work, at which point another special
 142     # case could be added here if necessary.
 143     #
 144     # No combinations of this with 's' need be added, as any of these
 145     # containing 's' are prohibited under /iaa.
 146     push @output_folds, '"\x{17F}\x{17F}"' if $all_folds;
 147
 148     return @output_folds;
 149 }
 150
 151 1