From da714e3cca2344ca407e57d7bb2133b4e19b8241 Mon Sep 17 00:00:00 2001
From: Jeff Ober <jober@ziprecruiter.com>
Date: Fri, 17 Jan 2020 13:45:12 -0500
Subject: [PATCH] Significant speedup by breaking apart primary regex into
 individual rules

---
 lib/TOML/Tiny/Grammar.pm   | 294 ++++++++++++++++++-------------------
 lib/TOML/Tiny/Parser.pm    |   6 +-
 lib/TOML/Tiny/Tokenizer.pm |  47 ++----
 lib/TOML/Tiny/Util.pm      |   8 +-
 lib/TOML/Tiny/Writer.pm    |   2 +-
 5 files changed, 171 insertions(+), 186 deletions(-)

diff --git a/lib/TOML/Tiny/Grammar.pm b/lib/TOML/Tiny/Grammar.pm
index a1966e9..24fb1a9 100644
--- a/lib/TOML/Tiny/Grammar.pm
+++ b/lib/TOML/Tiny/Grammar.pm
@@ -8,178 +8,178 @@ use v5.18;
 use parent 'Exporter';
 
 our @EXPORT = qw(
-  $TOML
+  $WS
+  $CRLF
+  $EOL
+  $Comment
+
+  $BareKey
+  $QuotedKey
+  $SimpleKey
+  $DottedKey
+  $Key
+
+  $Boolean
+
+  $Escape
+  $StringLiteral
+  $MultiLineStringLiteral
+  $BasicString
+  $MultiLineString
+  $String
+
+  $Date
+  $Time
+  $DateTime
+
+  $Hex
+  $Oct
+  $Bin
+  $Dec
+  $Integer
+
+  $Float
 );
 
-our $TOML = qr{
-
-(?(DEFINE)
-  #-----------------------------------------------------------------------------
-  # Misc
-  #-----------------------------------------------------------------------------
-  (?<WS>   [ \x20 \x09 ]*)         # space, tab
-  (?<CRLF> \x0D? \x0A)             # cr? lf
-  (?<EOL>  (?: \x23 .*)? (?&CRLF)) # crlf or comment -> crlf
-
-  #-----------------------------------------------------------------------------
-  # Key
-  #-----------------------------------------------------------------------------
-  (?<BareKey>   (?> [-_a-zA-Z0-9]+ ))
-  (?<QuotedKey> (?> (?&BasicString) | (?&StringLiteral)))
-  (?<SimpleKey> (?> (?&BareKey) | (?&QuotedKey)))
-  (?<DottedKey> (?> (?&SimpleKey) (?: \x2E (?&SimpleKey) )+))
-  (?<Key>       (?&BareKey) | (?&QuotedKey) | (?&DottedKey))
-
-  #-----------------------------------------------------------------------------
-  # Boolean
-  #-----------------------------------------------------------------------------
-  (?<Boolean> (?: \b (?:true) | (?:false) \b ))
-
-  #-----------------------------------------------------------------------------
-  # Integer
-  #-----------------------------------------------------------------------------
-  (?<DecFirstChar>  [1-9])
-  (?<DecChar>       [0-9])
-  (?<HexChar>       [0-9 a-f A-F])
-  (?<OctChar>       [0-7])
-  (?<BinChar>       [01])
-
-  (?<Zero> [-+]? 0)
-  (?<Hex> 0x (?&HexChar) (?> _? (?&HexChar) )*)
-  (?<Oct> 0o (?&OctChar) (?> _? (?&OctChar) )*)
-  (?<Bin> 0b (?&BinChar) (?> _? (?&BinChar) )*)
-  (?<Dec>
-      (?&Zero)
-    | (?> [-+]? (?&DecFirstChar) (?> _?  (?&DecChar) )* )
-  )
-
-  (?<Integer>
-    (?>
-        (?&Hex)
-      | (?&Oct)
-      | (?&Bin)
-      | (?&Dec)
-    )
-  )
-
-  #-----------------------------------------------------------------------------
-  # Float
-  #-----------------------------------------------------------------------------
-  (?<Exponent>      [eE] (?&Dec))
-  (?<SpecialFloat>  [-+]? (?> (?:inf) | (?:nan)))
-  (?<Fraction>      [.] (?&DecChar) (?> _? (?&DecChar) )* )
-
-  (?<Float>
-    (?>
-      (?&Dec)
-
-      (?>
-          (?> (?&Fraction) (?&Exponent)? )
-        | (?&Exponent)
-      )
-    )
-    | (?&SpecialFloat)
-  )
-
-  #-----------------------------------------------------------------------------
-  # String
-  #-----------------------------------------------------------------------------
-  (?<EscapeChar>
-    \x5C                        # leading \
-    (?>
-        [\x5C"btnfr]            # escapes: \\ \" \b \t \n \f \r
-      | (?> u [_0-9a-fA-F]{4} ) # unicode (4 bytes)
-      | (?> U [_0-9a-fA-F]{8} ) # unicode (8 bytes)
-    )
-  )
-
-  (?<StringLiteral>
-    (?> ' [^']* ')            # single quoted string (no escaped chars allowed)
+our $WS      = qr/[\x20\x09]/;     # space, tab
+our $CRLF    = qr/\x0D?\x0A/;      # cr? lf
+our $Comment = qr/\x23.*/;         # #comment
+our $EOL     = qr/$Comment?$CRLF/; # crlf or comment + crlf
+
+our $Escape = qr{
+  \x5C                       # leading \
+  (?>
+      [\x5C"btnfr]           # escapes: \\ \" \b \t \n \f \r
+    | (?> u [_0-9a-fA-F]{4}) # unicode (4 bytes)
+    | (?> U [_0-9a-fA-F]{8}) # unicode (8 bytes)
   )
+}x;
 
-  (?<MultiLineStringLiteral>
-    (?>
-      '''                     # opening triple-quote
-      (?>
-          [^']
-        | '{1,2}
-      )*?
-      '''                     # closing triple-quote
-    )
-  )
+our $StringLiteral = qr/'[^']*'/; # single quoted string (no escaped chars allowed)
 
-  (?<BasicString>
-    (?>
-      "                       # opening quote
-      (?>                     # escape sequences or any char except " or \
-          [^"\\]
-        | (?&EscapeChar)
-      )*
-      "                       # closing quote
-    )
-  )
+our $MultiLineStringLiteral = qr{
+  '''                     # opening triple-quote
+  (?> [^'] | '{1,2} )*?
+  '''                     # closing triple-quote
+}x;
 
-  (?<MultiLineString>
-    """                       # opening triple-quote
-    (?>
+our $BasicString = qr{
+    "                       # opening quote
+    (?>                     # escape sequences or any char except " or \
         [^"\\]
-      | "{1,2}                # 1-2 quotation marks
-      | (?&EscapeChar)        # escape
-      | (?: \\ (?&CRLF))     # backslash-terminated line
-    )*?
-    """                       # closing triple-quote
-  )
-
-  (?<String>
-      (?&MultiLineString)     # multi-line first or first two chars match empty basic string
-    | (?&BasicString)
-    | (?&MultiLineStringLiteral) 
-    | (?&StringLiteral)
-  )
+      | $Escape
+    )*
+    "                       # closing quote
+}x;
 
-  #-----------------------------------------------------------------------------
-  # Dates (RFC 3339)
-  #   1985-04-12T23:20:50.52Z
-  #-----------------------------------------------------------------------------
-  (?<Date>        \d{4}-\d{2}-\d{2} )
-  (?<Offset>      (?: [-+] \d{2}:\d{2} ) | Z )
-  (?<SimpleTime>  \d{2}:\d{2}:\d{2} (?: \. \d+ )? )
-  (?<Time>        (?&SimpleTime) (?&Offset)? )
-  (?<DateTime>    (?> (?&Date) (?> [T ] (?&Time) )? ) | (?&Time) )
-)
+our $MultiLineString = qr{
+  """                       # opening triple-quote
+  (?>
+      [^"\\]
+    | "{1,2}                # 1-2 quotation marks
+    | $Escape               # escape
+    | (?: \\ $CRLF)         # backslash-terminated line
+  )*?
+  """                       # closing triple-quote
+}x;
 
+our $String = qr/$MultiLineString | $BasicString | $MultiLineStringLiteral | $StringLiteral/x;
+
+our $BareKey   = qr/[-_a-zA-Z0-9]+/;
+our $QuotedKey = qr/$BasicString|$StringLiteral/;
+our $SimpleKey = qr/$BareKey|$QuotedKey/;
+our $DottedKey = qr/$SimpleKey(?:\.$SimpleKey)+/;
+our $Key       = qr/$BareKey|$QuotedKey|$DottedKey/;
+
+our $Boolean   = qr/\b(?:true)|(?:false)\b/;
+
+#-----------------------------------------------------------------------------
+# Dates (RFC 3339)
+#   1985-04-12T23:20:50.52Z
+#-----------------------------------------------------------------------------
+our $Date     = qr/\d{4}-\d{2}-\d{2}/;
+our $Offset   = qr/(?: [-+] \d{2}:\d{2} ) | Z/x;
+our $Time     = qr/\d{2}:\d{2}:\d{2} (?: \. \d+)? $Offset?/x;
+our $DateTime = qr/(?> $Date (?> [T ] $Time )?) | $Time/x;
+
+#-----------------------------------------------------------------------------
+# Integer
+#-----------------------------------------------------------------------------
+our $DecFirstChar = qr/[1-9]/;
+our $DecChar      = qr/[0-9]/;
+our $HexChar      = qr/[0-9 a-f A-F]/;
+our $OctChar      = qr/[0-7]/;
+our $BinChar      = qr/[01]/;
+
+our $Zero         = qr/[-+]? 0/x;
+our $Hex          = qr/0x $HexChar (?> _? $HexChar )*/x;
+our $Oct          = qr/0o $OctChar (?> _? $OctChar )*/x;
+our $Bin          = qr/0b $BinChar (?> _? $BinChar )*/x;
+our $Dec          = qr/$Zero | (?> [-+]? $DecFirstChar (?> _?  $DecChar )* )/x;
+our $Integer      = qr/$Hex | $Oct | $Bin | $Dec/x;
+
+#-----------------------------------------------------------------------------
+# Float
+#-----------------------------------------------------------------------------
+our $Exponent     = qr/[eE] $Dec/x;
+our $SpecialFloat = qr/[-+]? (?:inf) | (?:nan)/x;
+our $Fraction     = qr/\. $DecChar (?> _? $DecChar)*/x;
+
+our $Float = qr{
+    (?> $Dec (?> (?> $Fraction $Exponent?) | $Exponent ) )
+  | $SpecialFloat
 }x;
 
+
 1;
 
 =head1 SYNOPSIS
 
   use TOML::Tiny::Grammar;
 
-  if ($src =~ /(?&MultiLineString) $TOML/x) {
+  if ($src =~ /($MultiLineString)/) {
     ...
   }
 
 =head1 DESCRIPTION
 
-Exports C<$TOML>, a regex grammar for parsing TOML source.
+Exports various regexex for parsing TOML source.
+
+=head1 PATTERNS
 
-=head1 RULES
+=head2 White space and ignorables
+=head3 $WS
+=head3 $CRLF
+=head3 $EOL
+=head3 $Comment
 
-=head2 White space
-=head3 (?&WS)
-=head3 (?&EOL)
+=head2 Keys
+=head3 $BareKey
+=head3 $QuotedKey
+=head3 $SimpleKey
+=head3 $DottedKey
+=head3 $Key
 
 =head2 Values
-=head3 (?&Boolean)
-=head3 (?&DateTime)
-=head3 (?&Float)
-=head3 (?&Integer)
-=head3 (?&String)
-
-=head2 (?&Key)
-=head3 (?&BareKey)
-=head3 (?&QuotedKey)
-=head3 (?&DottedKey)
+=head3 $Boolean
+
+=head3 $Escape
+=head3 $StringLiteral
+=head3 $MultiLineStringLiteral
+=head3 $BasicString
+=head3 $MultiLineString
+=head3 $String
+
+=head3 $Date
+=head3 $Time
+=head3 $DateTime
+
+=head3 $Hex
+=head3 $Oct
+=head3 $Bin
+=head3 $Dec
+=head3 $Integer
+
+=head3 $Float
 
 =cut
diff --git a/lib/TOML/Tiny/Parser.pm b/lib/TOML/Tiny/Parser.pm
index 2e8ffb0..a15ac5e 100644
--- a/lib/TOML/Tiny/Parser.pm
+++ b/lib/TOML/Tiny/Parser.pm
@@ -269,16 +269,16 @@ sub parse_value {
       for (my $n = $token->{value}) {
         use bigint;
 
-        when (/(?&Oct) $TOML/x) {
+        when ($Oct) {
           $n =~ s/^0o/0/; # convert to perl's octal format
           return oct $n;
         }
 
-        when (/(?&Bin) $TOML/x) {
+        when ($Bin) {
           return oct $n;
         }
 
-        when (/(?&Hex) $TOML/x) {
+        when ($Hex) {
           return hex $n;
         }
 
diff --git a/lib/TOML/Tiny/Tokenizer.pm b/lib/TOML/Tiny/Tokenizer.pm
index 25013dc..8911c21 100644
--- a/lib/TOML/Tiny/Tokenizer.pm
+++ b/lib/TOML/Tiny/Tokenizer.pm
@@ -53,14 +53,9 @@ sub next_token {
   my $type;
   my $value;
 
-  state $key         = qr/(?&Key) $TOML/x;
-  state $key_set     = qr/\G ($key) [\x20 \x09]* (?= =)/x;
-  state $table       = qr/\G \[ [\x20 \x09]* ($key) [\x20 \x09]* \] [\x20 \x09]* (?= (:? \x23 .* )? (?: \x0D? \x0A) | $ )/x;
-  state $array_table = qr/\G \[\[ [\x20 \x09]* ($key) [\x20 \x09]* \]\] [\x20 \x09]* (?= (:? \x23 .* )? (?: \x0D? \x0A) | $ )/x;
-  state $string      = qr/\G ((?&String)) $TOML/x;
-  state $datetime    = qr/\G ((?&DateTime)) $TOML/x;
-  state $float       = qr/\G ((?&Float)) $TOML/x;
-  state $integer     = qr/\G ((?&Integer)) $TOML/x;
+  state $key_set     = qr/\G ($Key) $WS* (?= =)/x;
+  state $table       = qr/\G \[ $WS* ($Key) $WS* \] $WS* (?:$EOL | $)/x;
+  state $array_table = qr/\G \[\[ $WS* ($Key) $WS* \]\] $WS* (?:$EOL | $)/x;
 
   state $simple = {
     '['     => 'inline_array',
@@ -79,12 +74,12 @@ sub next_token {
     my $newline = !!($prev eq 'EOL' || $prev eq 'table' || $prev eq 'array_table');
 
     for ($self->{source}) {
-      /\G[\x20\x09]+/gc;      # ignore whitespace
-      /\G\x23.*$/mgc && next; # ignore comments
+      /\G$WS+/gc;               # ignore whitespace
+      /\G$Comment$/mgc && next;  # ignore comments
 
-      last when /\G $/xgc;
+      last when /\G$/gc;
 
-      when (/\G \x0D? \x0A/xgc) {
+      when (/\G$EOL/gc) {
         ++$self->{line};
         $type = 'EOL';
       }
@@ -111,22 +106,22 @@ sub next_token {
         $value = $1;
       }
 
-      when (/$string/xgc) {
+      when (/\G($String)/gc) {
         $type = 'string';
         $value = $1;
       }
 
-      when (/$datetime/xgc) {
+      when (/\G($DateTime)/gc) {
         $type = 'datetime';
         $value = $1;
       }
 
-      when (/$float/xgc) {
+      when (/\G($Float)/gc) {
         $type = 'float';
         $value = $1;
       }
 
-      when (/$integer/xgc) {
+      when (/\G($Integer)/gc) {
         $type = 'integer';
         $value = $1;
       }
@@ -164,16 +159,6 @@ sub pop_token {
   pop @{$self->{tokens}};
 }
 
-sub _make_token {
-  my ($self, $type, $value) = @_;
-  return {
-    type  => $type,
-    line  => $self->{line},
-    pos   => $self->{position},
-    value => $self->can("tokenize_$type") ?  $self->can("tokenize_$type")->($self, $value) : $value,
-  };
-}
-
 sub current_line {
   my $self = shift;
   my $rest = substr $self->{source}, $self->{position};
@@ -199,7 +184,7 @@ sub tokenize_key {
   my $toml = shift;
   my @keys;
 
-  while ($toml =~ s/^ ((?&SimpleKey)) [.]? $TOML//x) {
+  while ($toml =~ s/^ ($SimpleKey) [.]?//x) {
     push @keys, $1;
   }
 
@@ -230,10 +215,10 @@ sub tokenize_string {
 
   if ($ml) {
     $str = substr $toml, 3, length($toml) - 6;
-    my @newlines = $str =~ /(\x0D?\x0A)/g;
+    my @newlines = $str =~ /($CRLF)/g;
     $self->{line} += scalar @newlines;
-    $str =~ s/^[\x20 \x09]* (?&EOL) $TOML//x; # trim leading whitespace
-    $str =~ s/\\(?&EOL)\s* $TOML//xgs;        # trim newlines from lines ending in backslash
+    $str =~ s/^$WS* $EOL//x;  # trim leading whitespace
+    $str =~ s/\\$EOL\s*//xgs; # trim newlines from lines ending in backslash
   } else {
     $str = substr($toml, 1, length($toml) - 2);
   }
@@ -271,7 +256,7 @@ sub unescape_chars {
 }
 
 sub unescape_str {
-  state $re = qr/((?&EscapeChar)) $TOML/x;
+  state $re = qr/($Escape)/;
   $_[1] =~ s|$re|unescape_chars($1) // $_[0]->error(undef, "invalid unicode escape: $1")|xge;
   $_[1];
 }
diff --git a/lib/TOML/Tiny/Util.pm b/lib/TOML/Tiny/Util.pm
index 6e0627a..344b1b6 100644
--- a/lib/TOML/Tiny/Util.pm
+++ b/lib/TOML/Tiny/Util.pm
@@ -30,10 +30,10 @@ sub is_strict_array {
 
       when ('') {
         for ($value) {
-          $type = 'bool'      when /(?&Boolean)  $TOML/x;
-          $type = 'float'     when /(?&Float)    $TOML/x;
-          $type = 'integer'   when /(?&Integer)  $TOML/x;
-          $type = 'datetime'  when /(?&DateTime) $TOML/x;
+          $type = 'bool'      when /$Boolean/;
+          $type = 'float'     when /$Float/;
+          $type = 'integer'   when /$Integer/;
+          $type = 'datetime'  when /$DateTime/;
           default{ $type = 'string' };
         }
       }
diff --git a/lib/TOML/Tiny/Writer.pm b/lib/TOML/Tiny/Writer.pm
index cab70ff..12178b7 100644
--- a/lib/TOML/Tiny/Writer.pm
+++ b/lib/TOML/Tiny/Writer.pm
@@ -127,7 +127,7 @@ sub to_toml {
           return $data;
         }
 
-        when (/(?&DateTime) $TOML/x) {
+        when (/$DateTime/) {
           return $data;
         }
 
-- 
2.30.2