#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;
my $jp = do {
    use Regexp::Grammars;
qr{
# Keep the big stick handy, just in case...
#~ <debug:on>
 
# Match this...
^ <object> | <array> $


<token: JSON_text>
  <object> | <array>

<token: begin_array>
  (?: <ws>\x5B<ws> )

<token: begin_object>
  (?: <ws>\x7B<ws> )

<token: end_array>
  (?: <ws>\x5D<ws> )

<token: end_object>
  (?: <ws>\x7D<ws> )

<token: name_separator>
  (?: <ws>\x3A<ws> )

<token: value_separator>
  (?: <ws>\x2C<ws> )

<token: ws>
   (?: \x20 | \x09 | \x0A | \x0D )* 

<token: value>
  <false> | <null> | <true> | <object> | <array> | <number> | <string>

<token: false>
  \x66\x61\x6c\x73\x65

<token: null>
  \x6e\x75\x6c\x6c

<token: true>
  \x74\x72\x75\x65

<token: object>
  (?: <begin_object> (?: (?: <member> (?: (?: <value_separator><member> ) )*  ) )? <end_object> )

<token: member>
  (?: <string><name_separator><value> )

<token: array>
  (?: <begin_array> (?: (?: <value> (?: (?: <value_separator><value> ) )*  ) )? <end_array> )

<token: number>
  (?:  (?: <minus> )? <int> (?: <frac> )?  (?: <exp> )?  )

<token: decimal_point>
  \x2E

<token: digit1_9>
  [\x{31}-\x{39}]

<token: e>
  \x65 | \x45

<token: exp>
  (?: <e> (?: <minus> | <plus> )?  (?: <DIGIT> )+  )

<token: frac>
  (?: <decimal_point> (?: <DIGIT> )+  )

<token: int>
  <zero> | (?: <digit1_9> (?: <DIGIT> )*  )

<token: minus>
  \x2D

<token: plus>
  \x2B

<token: zero>
  \x30

<token: string>
  (?: <quotation_mark> (?: <char> )* <quotation_mark> )

<token: char>
  <unescaped> | (?: <escape>\x22 | \x5C | \x2F | \x62 | \x66 | \x6E | \x72 | \x74 | (?: \x75 (?: <HEXDIG> ){4}  ) )

<token: escape>
  \x5C

<token: quotation_mark>
  \x22

<token: unescaped>
  [\x{20}-\x{21}] | [\x{23}-\x{5B}] | [\x{5D}-\x{10FFFF}]

<token: HEXDIG>
  <DIGIT> | A | B | C | D | E | F

<token: DIGIT>
  [\x{30}-\x{39}]

}ixs};
for my $str( q/[false,true,null]/ , ){
    print "#<<@{[time-$^T]}#  $str  \n";
    if( $str =~ $jp ){
        dd(\%/) ; #/
    } else {
        print "## fail to match \n";
    }
    print "#>>@{[time-$^T]}#\n";
}

##</code><code>##

#<<1#  [false,true,null]  
{
  "" => "[false,true,null]",
  "array" => {
    "" => "[false,true,null]",
    "begin_array" => { "" => "[", "ws" => "" },
    "end_array" => { "" => "]", "ws" => "" },
    "value" => { "" => "null", "null" => "null" },
    "value_separator" => { "" => ",", "ws" => "" },
  },
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -49,3 +49,3 @@
 <token: object>
-  (?: <begin_object> (?: (?: <member> (?: (?: <value_separator><member> ) )*  ) )? <end_object> )
+  (?: <.begin_object> (?: (?: <member> (?: (?: <.value_separator><member> ) )*  ) )? <.end_object> )
 
@@ -55,3 +55,3 @@
 <token: array>
-  (?: <begin_array> (?: (?: <value> (?: (?: <value_separator><value> ) )*  ) )? <end_array> )
+  (?: <.begin_array> (?: (?: <value> (?: (?: <.value_separator><value> ) )*  ) )? <.end_array> )
 
@@ -88,3 +88,3 @@
 <token: string>
-  (?: <quotation_mark> (?: <char> )* <quotation_mark> )
+  (?: <.quotation_mark> (?: <char> )* <.quotation_mark> )
 

##</code><code>##

#<<0#  [false,true,null]  
{
  "" => "[false,true,null]",
  "array" => {
    "" => "[false,true,null]",
    "value" => { "" => "null", "null" => "null" },
  },
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -55,3 +55,3 @@
 <token: array>
-  (?: <.begin_array> (?: (?: <value> (?: (?: <.value_separator><value> ) )*  ) )? <.end_array> )
+  (?: <.begin_array> (?: (?: <[value]> (?: (?: <.value_separator><[value]> ) )*  ) )? <.end_array> )
 

##</code><code>##

#<<0#  [false,true,null]  
{
  "" => "[false,true,null]",
  "array" => {
    "" => "[false,true,null]",
    "value" => [
      { "" => "false", "false" => "false" },
      { "" => "true", "true" => "true" },
      { "" => "null", "null" => "null" },
    ],
  },
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -7,2 +7,3 @@
 #~ <debug:on>
+<nocontext: >  # Switch off context substring retention 
  

##</code><code>##

#<<0#  [false,true,null]  
{
  array => {
    value => [{ false => "false" }, { true => "true" }, { null => "null" }],
  },
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -40,12 +40,15 @@
 
 <token: false>
   \x66\x61\x6c\x73\x65
+  (?{ $MATCH = ::FALSE(); })
 
 <token: null>
   \x6e\x75\x6c\x6c
+  (?{ $MATCH = undef; })
 
 <token: true>
   \x74\x72\x75\x65
+  (?{ $MATCH = ::TRUE(); })
 
 <token: object>
   (?: <.begin_object> (?: (?: <member> (?: (?: <.value_separator><member> ) )*  ) )? <.end_object> )
@@ -117,3 +120,6 @@
     }
     print "#>>@{[time-$^T]}#\n";
 }
+sub TRUE { bless \(my$s=!!1), 'TRUE' }
+sub FALSE { bless \(my$s=!!0), 'FALSE' }
+

##</code><code>##

#<<1#  [false,true,null]  
{
  array => {
    value => [
      { false => bless(do{\(my $o = "")}, "FALSE") },
      { true => bless(do{\(my $o = 1)}, "TRUE") },
      { null => undef },
    ],
  },
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -38,3 +38,3 @@
 <token: value>
-  <false> | <null> | <true> | <object> | <array> | <number> | <string>
+  <MATCH=false> | <MATCH=null> | <MATCH=true> | <MATCH=object> | <MATCH=array> | <MATCH=number> | <MATCH=string>
 

##</code><code>##

#<<0#  [false,true,null]  
{
  array => {
    value => [
      bless(do{\(my $o = "")}, "FALSE"),
      bless(do{\(my $o = 1)}, "TRUE"),
      undef,
    ],
  },
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -58,6 +58,9 @@
 
 <token: array>
   (?: <.begin_array> (?: (?: <[value]> (?: (?: <.value_separator><[value]> ) )*  ) )? <.end_array> )
+    (?{
+    $MATCH = $MATCH{value} ;
+    })
 
 <token: number>
   (?:  (?: <minus> )? <int> (?: <frac> )?  (?: <exp> )?  )

##</code><code>##

#<<1#  [false,true,null]  
{
  array => [
    bless(do{\(my $o = "")}, "FALSE"),
    bless(do{\(my $o = 1)}, "TRUE"),
    undef,
  ],
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -8 +8 @@
-<nocontext: >  # Switch off context substring retention 
+#~ <nocontext: >  # Switch off context substring retention 
@@ -117 +117 @@
-for my $str( q/[false,true,null]/ , ){
+for my $str( q/[ -2.0, 4.333e333, 600 ]/ , ){

##</code><code>##

#<<0#  [ -2.0, 4.333e333, 600 ]  
{
  "" => "[ -2.0, 4.333e333, 600 ]",
  "array" => [
    {
      "" => "-2.0",
      "frac" => { "" => ".0", "decimal_point" => ".", "DIGIT" => 0 },
      "int" => { "" => 2, "digit1_9" => 2 },
      "minus" => "-",
    },
    {
      "" => "4.333e333",
      "exp" => { "" => "e333", "DIGIT" => 3, "e" => "e" },
      "frac" => { "" => ".333", "decimal_point" => ".", "DIGIT" => 3 },
      "int" => { "" => 4, "digit1_9" => 4 },
    },
    { "" => 600, "int" => { "" => 600, "DIGIT" => 0, "digit1_9" => 6 } },
  ],
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -7,3 +7,3 @@
 #~ <debug:on>
-#~ <nocontext: >  # Switch off context substring retention 
+<nocontext: >  # Switch off context substring retention 
 
@@ -77,9 +77,9 @@
 <token: exp>
-  (?: <e> (?: <minus> | <plus> )?  (?: <DIGIT> )+  )
+  (?: <e> (?: <minus> | <plus> )?  (?: <[DIGIT]> )+  )
 
 <token: frac>
-  (?: <decimal_point> (?: <DIGIT> )+  )
+  (?: <decimal_point> (?: <[DIGIT]> )+  )
 
 <token: int>
-  <zero> | (?: <digit1_9> (?: <DIGIT> )*  )
+  <zero> | (?: <digit1_9> (?: <[DIGIT]> )*  )
 

##</code><code>##

#<<1#  [ -2.0, 4.333e333, 600 ]  
{
  array => [
    {
      frac  => { decimal_point => ".", DIGIT => [0] },
      int   => { digit1_9 => 2 },
      minus => "-",
    },
    {
      exp  => { DIGIT => [3, 3, 3], e => "e" },
      frac => { decimal_point => ".", DIGIT => [3, 3, 3] },
      int  => { digit1_9 => 4 },
    },
    { int => { DIGIT => [0, 0], digit1_9 => 6 } },
  ],
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -76,12 +76,21 @@
 
 <token: exp>
   (?: <e> (?: <minus> | <plus> )?  (?: <[DIGIT]> )+  )
+  (?{
+    $MATCH = join '', grep defined, $MATCH{e}, $MATCH{minus}, $MATCH{plus}, @{$MATCH{DIGIT}};
+  })
 
 <token: frac>
   (?: <decimal_point> (?: <[DIGIT]> )+  )
+  (?{
+    $MATCH = join '', grep defined, $MATCH{decimal_point}, @{$MATCH{DIGIT}};
+  })
 
 <token: int>
-  <zero> | (?: <digit1_9> (?: <[DIGIT]> )*  )
+  <MATCH=zero> | (?: <digit1_9> (?: <[DIGIT]> )*  )
+  (?{
+    $MATCH = join '', grep defined, $MATCH{digit1_9}, @{$MATCH{DIGIT}};
+  })
 
 <token: minus>
   \x2D
@@ -114,7 +123,7 @@
   [\x{30}-\x{39}]
 
 }ixs};
-for my $str( q/[ -2.0, 4.333e333, 600 ]/ , ){
+for my $str( q/[ -2.0, 4.333e333, 600, 0, 9 ]/ , ){
     print "#<<@{[time-$^T]}#  $str  \n";
     if( $str =~ $jp ){
         dd(\%/) ; #/

##</code><code>##

#<<0#  [ -2.0, 4.333e333, 600, 0, 9 ]  
{
  array => [
    { frac => ".0", int => 2, minus => "-" },
    { exp => "e333", frac => ".333", int => 4 },
    { int => 600 },
    { int => 0 },
    { int => 9 },
  ],
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -65,4 +65,7 @@
 <token: number>
   (?:  (?: <minus> )? <int> (?: <frac> )?  (?: <exp> )?  )
+  (?{
+    $MATCH = join'', grep defined, map{$MATCH{$_}} qw{ minus int frac exp };
+  })
 
 <token: decimal_point>

##</code><code>##

#<<1#  [ -2.0, 4.333e333, 600, 0, 9 ]  
{ array => ["-2.0", "4.333e333", 600, 0, 9] }
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -8 +8 @@
-<nocontext: >  # Switch off context substring retention 
+#~ <nocontext: >  # Switch off context substring retention 
@@ -129 +129 @@
-for my $str( q/[ -2.0, 4.333e333, 600, 0, 9 ]/ , ){
+for my $str( q{[ "\\" quote \\t tab" ]} , ){

##</code><code>##

#<<0#  [ "\" quote \t tab" ]  
{
  "" => "[ \"\\\" quote \\t tab\" ]",
  "array" => [
    {
      "" => "\"\\\" quote \\t tab\"",
      "char" => { "" => "b", "unescaped" => "b" },
    },
  ],
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -7,3 +7,3 @@
 #~ <debug:on>
-#~ <nocontext: >  # Switch off context substring retention 
+<nocontext: >  # Switch off context substring retention 
 
@@ -107,3 +107,3 @@
 <token: string>
-  (?: <.quotation_mark> (?: <char> )* <.quotation_mark> )
+  (?: <.quotation_mark> (?: <[char]> )* <.quotation_mark> )
 

##</code><code>##

#<<0#  [ "\" quote \t tab" ]  
{
  array => [
    {
      char => [
        { escape => "\\" },
        { unescaped => " " },
        { unescaped => "q" },
        { unescaped => "u" },
        { unescaped => "o" },
        { unescaped => "t" },
        { unescaped => "e" },
        { unescaped => " " },
        "\\",
        { unescaped => "t" },
        { unescaped => " " },
        { unescaped => "t" },
        { unescaped => "a" },
        { unescaped => "b" },
      ],
    },
  ],
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -108,0 +109,3 @@
+  (?{
+    $MATCH = token_string( @{ $MATCH{char} } );
+  })
@@ -111 +114,4 @@
-  <unescaped> | (?: <escape>\x22 | \x5C | \x2F | \x62 | \x66 | \x6E | \x72 | \x74 | (?: \x75 (?: <HEXDIG> ){4}  ) )
+  <MATCH=unescaped> | (?: <.escape> <escaped> )
+
+<token: escaped>
+  \x22 | \x5C | \x2F | \x62 | \x66 | \x6E | \x72 | \x74 | \x75[1-9A-F]{4}
@@ -129 +135 @@
-for my $str( q{[ "\\" quote \\t tab" ]} , ){
+for my $str( q{[ "\\" quote \\t tab \\uD83D\\uDC2A U+1F42A DROMEDARY CAMEL" ]}, ){
@@ -140,0 +147,23 @@
+BEGIN {
+    my %rep  =  (
+       "\"" => '"',
+       "/"  => '/',
+       "\\" => '\\',
+       b    => "\b",
+       f    => "\f",
+       n    => "\n",
+       r    => "\r",
+       t    => "\t"
+    );
+    sub token_string {        
+        return join '',
+            map {
+                my $ret = $_;
+                if( ref $_ ){
+                    $ret = $rep{ $_->{escaped} };
+                    $ret ||= pack('U', hex substr $_->{escaped}, 1, 4 );
+                }
+                $ret;
+            } @_;
+    }
+}

##</code><code>##

#<<0#  [ "\" quote \t tab \uD83D\uDC2A U+1F42A DROMEDARY CAMEL" ]  
{
  array => ["\" quote \t tab \x{D83D}\x{DC2A} U+1F42A DROMEDARY CAMEL"],
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -135 +135 @@
-for my $str( q{[ "\\" quote \\t tab \\uD83D\\uDC2A U+1F42A DROMEDARY CAMEL" ]}, ){
+for my $str( q{[ -90.0, [" \\t tab",[7,11]],3e9,"\\r return", null ]}, ){

##</code><code>##

#<<1#  [ -90.0, [" \t tab",[7,11]],3e9,"\r return", null ]  
{
  array => ["-90.0", [" \t tab", [7, 11]], "3e9", "\r return", undef],
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -8 +8 @@
-<nocontext: >  # Switch off context substring retention 
+#~ <nocontext: >  # Switch off context substring retention 
@@ -135 +135 @@
-for my $str( q{[ -90.0, [" \\t tab",[7,11]],3e9,"\\r return", null ]}, ){
+for my $str( q{{ "key" : "lime", "blue": "berry" }}, ){

##</code><code>##

#<<0#  { "key" : "lime", "blue": "berry" }  
{
  "" => "{ \"key\" : \"lime\", \"blue\": \"berry\" }",
  "object" => {
    "" => "{ \"key\" : \"lime\", \"blue\": \"berry\" }",
    "member" => {
      "" => "\"blue\": \"berry\"",
      "name_separator" => { "" => ": ", "ws" => " " },
      "string" => "blue",
      "value" => "berry",
    },
  },
}
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -7,3 +7,3 @@
 #~ <debug:on>
-#~ <nocontext: >  # Switch off context substring retention 
+<nocontext: >  # Switch off context substring retention 
 
@@ -53,6 +53,9 @@
 <token: object>
-  (?: <.begin_object> (?: (?: <member> (?: (?: <.value_separator><member> ) )*  ) )? <.end_object> )
+  (?: <.begin_object> (?: (?: <[member]> (?: (?: <.value_separator><[member]> ) )*  ) )? <.end_object> )
 
 <token: member>
-  (?: <string><name_separator><value> )
+  (?: <string><.name_separator><value> )
+  (?{
+    $MATCH = [ $MATCH{string}, $MATCH{value} ];
+  })
 

##</code><code>##

#<<0#  { "key" : "lime", "blue": "berry" }  
{ object => { member => [["key", "lime"], ["blue", "berry"]] } }
#>>0#

##</code><code>##

--- reg
+++ reg
@@ -53,4 +53,7 @@
 <token: object>
   (?: <.begin_object> (?: (?: <[member]> (?: (?: <.value_separator><[member]> ) )*  ) )? <.end_object> )
+  (?{
+    $MATCH = { map { @$_ } @{$MATCH{member}} };
+  })
 
 <token: member>

##</code><code>##

#<<1#  { "key" : "lime", "blue": "berry" }  
{ object => { blue => "berry", key => "lime" } }
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -141 +141 @@
-for my $str( q{{ "key" : "lime", "blue": "berry" }}, ){
+for my $str( q{[{"k":"v"},{"v":"k"}] }, q{{"ro":["sham","bo"],"t":{"i":{"c":{"t":{"o":"c"}}}}}}){

##</code><code>##

#<<1#  [{"k":"v"},{"v":"k"}]   
{ array => [{ k => "v" }, { v => "k" }] }
#>>1#
#<<1#  {"ro":["sham","bo"],"t":{"i":{"c":{"t":{"o":"c"}}}}}  
{
  object => { ro => ["sham", "bo"], t => { i => { c => { t => { o => "c" } } } } },
}
#>>1#

##</code><code>##

--- reg
+++ reg
@@ -141 +141 @@
-for my $str( q{[{"k":"v"},{"v":"k"}] }, q{{"ro":["sham","bo"],"t":{"i":{"c":{"t":{"o":"c"}}}}}}){
+for my $str( q{[1,[2,[3],[]]]}, q{["double extra comma",,]} , ){

##</code><code>##

#<<0#  [1,[2,[3],[]]]  
{ array => [1, [2, [3], undef]] }
#>>0#
#<<0#  ["double extra comma",,]  
## fail to match 
#>>43#