Add parse-json test for NQP and Perl 6

raku-community-modules · Jun 7, 2013 · 142e5d2 · 142e5d2
1 parent 5bb409d
commit 142e5d2
Show file tree

Hide file tree

Showing 3 changed files with 312 additions and 0 deletions.
diff --git a/minibenchmarks.pl b/minibenchmarks.pl
@@ -1,4 +1,12 @@
 [
+ {
+  name  => 'parse-json',
+  skip  => [qw( )],
+  scale => 1 << 3,
+  perl5 => undef,
+  perl6 => [qw( BENCH/perl6/parse-json DATA/panda-projects.json SCALE )],
+  nqp   => [qw( BENCH/nqp/parse-json   DATA/panda-projects.json SCALE )],
+ },
  {
   name  => 'rc-forest-fire',
   skip  => [qw( niecza.nqp nqp-moarvm p6.pl p6.js_v8 )],

diff --git a/nqp/parse-json b/nqp/parse-json
@@ -0,0 +1,168 @@
+# JSON parsing copied from JSON::Tiny with changes to work in NQP
+# and other very minor changes
+
+grammar JSON::Tiny::Grammar {
+    token TOP       { ^ \s* [ <object> | <array> ] \s* $ }
+    rule object     { '{' ~ '}' <pairlist>     }
+    rule pairlist   { <?> <pair> * % \,             }
+    rule pair       { <?> <string> ':' <value>     }
+    rule array      { '[' ~ ']' <arraylist>    }
+    rule arraylist  { <?> <value>* % [ \, ]        }
+
+    proto token value {*}
+    token value:sym<number> {
+        '-'?
+        [ 0 | <[1..9]> <[0..9]>* ]
+        [ \. <[0..9]>+ ]?
+        [ <[eE]> [\+|\-]? <[0..9]>+ ]?
+    }
+    token value:sym<true>    { <sym>    }
+    token value:sym<false>   { <sym>    }
+    token value:sym<null>    { <sym>    }
+    token value:sym<object>  { <object> }
+    token value:sym<array>   { <array>  }
+    token value:sym<string>  { <string> }
+
+    token string {
+        \" ~ \" ( <str> | \\ <str_escape> )*
+    }
+
+    token str {
+        <-["\\\t\n]>+
+    }
+
+    token str_escape {
+        <["\\/bfnrt]> | u <xdigit>**4
+    }
+}
+
+class JSON::Tiny::Actions {
+    method TOP($/) {
+        make ($<object> || $<array>).ast;
+    }
+
+    method object($/) {
+        my %object := nqp::hash();
+	%object{$_[0]} := $_[1] for $<pairlist>.ast;
+        make %object;
+    }
+
+    method pairlist($/) {
+        my @flattened;
+        @flattened.push($_.ast) for $<pair>;
+        make @flattened;
+    }
+
+    method pair($/) {
+        make [$<string>.ast, $<value>.ast];
+    }
+
+    method array($/) {
+        make $<arraylist>.ast;
+    }
+
+    method arraylist($/) {
+        my @values;
+        @values.push($_.ast) for $<value>;
+        make @values;
+    }
+
+    method string($/) {
+        if nqp::elems($/[0]) == 1 {
+            make ($/[0][0]<str> || $/[0][0]<str_escape>).ast
+        }
+        else {
+            my @mapped;
+            for $/[0] {
+                my $str := $_<str> || $_<str_escape>;
+                @mapped.push($str.ast);
+            }
+            make join('', @mapped);
+        }
+    }
+
+    method value:sym<number>($/) { make +(~$/) }
+    method value:sym<string>($/) { make $<string>.ast }
+    method value:sym<true>($/)   { make 1  }
+    method value:sym<false>($/)  { make 0 }
+    method value:sym<null>($/)   { make NQPMu }
+    method value:sym<object>($/) { make $<object>.ast }
+    method value:sym<array>($/)  { make $<array>.ast }
+
+    method str($/)               { make ~$/ }
+
+    method str_escape($/) {
+        if $<xdigit> {
+            # make chr(:16($<xdigit>.join));  # preferred version of next line, but it doesn't work on Niecza yet
+            make chr(eval("0x" ~ join('', $<xdigit>)));
+        } else {
+            my %h := nqp::hash('\\', "\\",
+                               '/',  "/",
+                               'b',  "\b",
+                               'n',  "\n",
+                               't',  "\t",
+                               'f',  "\f",
+                               'r',  "\r",
+                               '"',  "\"");
+            make %h{~$/};
+        }
+    }
+}
+
+sub from-json($text) {
+    my $a := JSON::Tiny::Actions.new();
+    my $o := JSON::Tiny::Grammar.parse($text, :actions($a));
+    $o.ast;
+}
+
+sub to-json($d) {
+    my @mapped;
+    if   !nqp::isconcrete($d) {
+        'null'
+    }
+    elsif nqp::islist($d) {
+        @mapped.push(to-json($_)) for $d;
+        '[ '
+        ~ join(', ', @mapped)
+        ~ ' ]';
+    }
+    elsif nqp::ishash($d) {
+        @mapped.push(to-json($_.key) ~ ' : ' ~ to-json($_.value)) for $d;
+        '{ '
+        ~ join(', ', @mapped)
+        ~ ' }';
+    }
+    elsif nqp::isnum($d) {
+        ~$d;
+    }
+    elsif nqp::isint($d) {
+        ~$d;
+    }
+    elsif nqp::isstr($d) {
+        '"'
+    	# ~ $d.trans(['"',  '\\',   "\b", "\f", "\n", "\r", "\t"],
+    	#            ['\"', '\\\\', '\b', '\f', '\n', '\r', '\t'])\
+    	#         .subst(/<-[\c32..\c126]>/, { ord(~$_).fmt('\u%04x') }, :g)
+        ~ $d
+        ~ '"';
+    }
+    else {
+        die("Can't serialize an object of type " ~ $d.WHAT.perl);
+    }
+}
+
+sub main($json-file, $count) {
+    my $json := slurp($json-file);
+
+    my int $i := 0;
+    while $i < $count {
+        my $data := from-json($json);
+        $i := $i + 1;
+    }
+}
+
+# XXXX: Perl 6/NQP incompatibility: whether MAIN's args include the program name
+sub MAIN (*@args) {
+    @args.shift if @args == 3;
+    main(|@args);
+}
diff --git a/perl6/parse-json b/perl6/parse-json
@@ -0,0 +1,136 @@
+# JSON parsing copied from JSON::Tiny with very minor changes
+
+grammar JSON::Tiny::Grammar {
+    token TOP       { ^ \s* [ <object> | <array> ] \s* $ }
+    rule object     { '{' ~ '}' <pairlist>     }
+    rule pairlist   { <?> <pair> * % \,             }
+    rule pair       { <?> <string> ':' <value>     }
+    rule array      { '[' ~ ']' <arraylist>    }
+    rule arraylist  { <?> <value>* % [ \, ]        }
+
+    proto token value {*}
+    token value:sym<number> {
+        '-'?
+        [ 0 | <[1..9]> <[0..9]>* ]
+        [ \. <[0..9]>+ ]?
+        [ <[eE]> [\+|\-]? <[0..9]>+ ]?
+    }
+    token value:sym<true>    { <sym>    }
+    token value:sym<false>   { <sym>    }
+    token value:sym<null>    { <sym>    }
+    token value:sym<object>  { <object> }
+    token value:sym<array>   { <array>  }
+    token value:sym<string>  { <string> }
+
+    token string {
+        \" ~ \" ( <str> | \\ <str_escape> )*
+    }
+
+    token str {
+        <-["\\\t\n]>+
+    }
+
+    token str_escape {
+        <["\\/bfnrt]> | u <xdigit>**4
+    }
+}
+
+class JSON::Tiny::Actions {
+    method TOP($/) {
+        make $/.values.[0].ast;
+    }
+
+    method object($/) {
+        make $<pairlist>.ast.hash;
+    }
+
+    method pairlist($/) {
+        make $<pair>>>.ast.flat;
+    }
+
+    method pair($/) {
+        make $<string>.ast => $<value>.ast;
+    }
+
+    method array($/) {
+        make $<arraylist>.ast;
+    }
+
+    method arraylist($/) {
+        make [$<value>>>.ast];
+    }
+
+    method string($/) {
+        make $0.elems == 1
+            ?? ($0[0].<str> || $0[0].<str_escape>).ast
+            !! join '', $0.list.map({ (.<str> || .<str_escape>).ast });
+    }
+
+    method value:sym<number>($/) { make +$/.Str }
+    method value:sym<string>($/) { make $<string>.ast }
+    method value:sym<true>($/)   { make Bool::True  }
+    method value:sym<false>($/)  { make Bool::False }
+    method value:sym<null>($/)   { make Any }
+    method value:sym<object>($/) { make $<object>.ast }
+    method value:sym<array>($/)  { make $<array>.ast }
+
+    method str($/)               { make ~$/ }
+
+    method str_escape($/) {
+        if $<xdigit> {
+            # make chr(:16($<xdigit>.join));  # preferred version of next line, but it doesn't work on Niecza yet
+            make chr(eval "0x" ~ $<xdigit>.join);
+        } else {
+            my %h = '\\' => "\\",
+                    '/'  => "/",
+                    'b'  => "\b",
+                    'n'  => "\n",
+                    't'  => "\t",
+                    'f'  => "\f",
+                    'r'  => "\r",
+                    '"'  => "\"";
+            make %h{~$/};
+        }
+    }
+}
+
+sub from-json($text) {
+    my $a := JSON::Tiny::Actions.new();
+    my $o := JSON::Tiny::Grammar.parse($text, :actions($a));
+    $o.ast;
+}
+
+proto to-json($) {*}
+
+multi to-json(Real:D $d) { ~$d }
+multi to-json(Bool:D $d) { $d ?? 'true' !! 'false'; }
+multi to-json(Str:D  $d) {
+    '"'
+    ~ $d.trans(['"',  '\\',   "\b", "\f", "\n", "\r", "\t"]
+            => ['\"', '\\\\', '\b', '\f', '\n', '\r', '\t'])\
+            .subst(/<-[\c32..\c126]>/, { ord(~$_).fmt('\u%04x') }, :g)
+    ~ '"'
+}
+multi to-json(Positional:D $d) {
+    return  '[ '
+            ~ $d.map(&to-json).join(', ')
+            ~ ' ]';
+}
+multi to-json(Associative:D  $d) {
+    return '{ '
+            ~ $d.map({ to-json(.key) ~ ' : ' ~ to-json(.value) }).join(', ')
+            ~ ' }';
+}
+
+multi to-json(Mu:U $) { 'null' }
+multi to-json(Mu:D $s) {
+    die "Can't serialize an object of type " ~ $s.WHAT.perl
+}
+
+sub MAIN($json-file, $count) {
+    my $json := slurp($json-file);
+
+    for ^$count {
+        my $data := from-json($json);  #OK
+    }
+}