From f12c011824bed682b979bcf53cf4106b7e4d7f31 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Sun, 11 May 2014 17:41:48 -0600
Subject: regcomp.c: Skip work that is a no-op

There are a few characters in the Latin1 range that can be folded to by
above-Latin1 characters.  Some of these are folded to as part of a
single character fold, like KELVIN SIGN folds to 'k'.  More are folded
to as part of a multi-character fold.  Until this commit, there wasn't a
quick way to distinguish between the two classes.  A couple of places
only want the single-character ones.  It is more efficient to look for
just those than to include the multi-char ones which end up not doing
anything.  This uses a bit in l1_char_class_tab.h to indicate those
characters that are in the desired class.
---
 regen/mk_PL_charclass.pl | 41 ++++++++++++++++++++++++++++++++++++-----
 1 file changed, 36 insertions(+), 5 deletions(-)

(limited to 'regen/mk_PL_charclass.pl')

diff --git a/regen/mk_PL_charclass.pl b/regen/mk_PL_charclass.pl
index 1ec8509efb..d23970d221 100644
--- a/regen/mk_PL_charclass.pl
+++ b/regen/mk_PL_charclass.pl
@@ -23,6 +23,7 @@ require 'regen/charset_translations.pl';
 # new Unicode release, to make sure things haven't been changed by it.
 
 my @properties = qw(
+    NONLATIN1_SIMPLE_FOLD
     NONLATIN1_FOLD
     ALPHANUMERIC
     ALPHA
@@ -52,6 +53,7 @@ my @properties = qw(
 # Read in the case fold mappings.
 my %folded_closure;
 my @hex_non_final_folds;
+my @non_latin1_simple_folds;
 my @folds;
 use Unicode::UCD;
 
@@ -108,8 +110,8 @@ BEGIN { # Have to do this at compile time because using user-defined \p{property
 
         my $from = hex $hex_from;
 
-        # Perl only deals with C and F folds
-        next if $fold_type ne 'C' and $fold_type ne 'F';
+        # Perl only deals with S, C, and F folds
+        next if $fold_type ne 'C' and $fold_type ne 'F' and $fold_type ne 'S';
 
         # Get each code point in the range that participates in this line's fold.
         # The hash has keys of each code point in the range, and values of what it
@@ -120,9 +122,20 @@ BEGIN { # Have to do this at compile time because using user-defined \p{property
             push @{$folded_closure{$fold}}, $from if $fold < 256;
             push @{$folded_closure{$from}}, $fold if $from < 256;
 
-            if ($i < @folded-1
-                && $fold < 256
-                && ! grep { $_ eq $hex_fold } @hex_non_final_folds)
+            if (($fold_type eq 'C' || $fold_type eq 'S')
+                && ($fold < 256 != $from < 256))
+            {
+                # Fold is simple (hence can't be a non-final fold, so the 'if'
+                # above is mutualy exclusive from the 'if below) and crosses
+                # 255/256 boundary.  We keep track of the Latin1 code points
+                # in such folds.
+                push @non_latin1_simple_folds, ($fold < 256)
+                                                ? $fold
+                                                : $from;
+            }
+            elsif ($i < @folded-1
+                   && $fold < 256
+                   && ! grep { $_ eq $hex_fold } @hex_non_final_folds)
             {
                 push @hex_non_final_folds, $hex_fold;
 
@@ -141,6 +154,16 @@ BEGIN { # Have to do this at compile time because using user-defined \p{property
             push @{$folded_closure{$from}}, @{$folded_closure{$folded}};
         }
     }
+
+    # We have the single-character folds that cross the 255/256, like KELVIN
+    # SIGN => 'k', but we need the closure, so add like 'K' to it
+    foreach my $folded (@non_latin1_simple_folds) {
+        foreach my $fold (@{$folded_closure{$folded}}) {
+            if ($fold < 256 && ! grep { $fold == $_ } @non_latin1_simple_folds) {
+                push @non_latin1_simple_folds, $fold;
+            }
+        }
+    }
 }
 
 sub Is_Non_Latin1_Fold {
@@ -153,6 +176,12 @@ sub Is_Non_Latin1_Fold {
     return join("\n", @return) . "\n";
 }
 
+sub Is_Non_Latin1_Simple_Fold { # Latin1 code points that are folded to by
+                                # non-Latin1 code points as single character
+                                # folds
+    return join("\n", map { sprintf "%X", $_ } @non_latin1_simple_folds) . "\n";
+}
+
 sub Is_Non_Final_Fold {
     return join("\n", @hex_non_final_folds) . "\n";
 }
@@ -201,6 +230,8 @@ for my $ord (0..255) {
             $re = qr/\p{_Perl_Quotemeta}/;
         } elsif ($name eq 'NONLATIN1_FOLD') {
             $re = qr/\p{Is_Non_Latin1_Fold}/;
+        } elsif ($name eq 'NONLATIN1_SIMPLE_FOLD') {
+            $re = qr/\p{Is_Non_Latin1_Simple_Fold}/;
         } elsif ($name eq 'NON_FINAL_FOLD') {
             $re = qr/\p{Is_Non_Final_Fold}/;
         } elsif ($name eq 'IS_IN_SOME_FOLD') {
-- 
cgit v1.2.1