Add json.nqp, an example of a JSON compiler written entirely in NQP.

examples/json.nqp

@@ -0,0 +1,106 @@
+#! nqp
+
+# A JSON compiler written in NQP.  To use this compiler, first
+# precompile the code to PIR, then run that:
+#
+#   $ nqp --target=pir json.nqp >json.pir
+#   $ parrot json.pir
+#
+# It can then be turned into a .pbc to be available as load_language:
+#
+#   $ parrot -o json.pbc json.pir
+#   $ cp json.pbc <installroot>/lib/<version>/languages
+#
+
+INIT {
+    pir::load_bytecode('P6Regex.pbc');
+    pir::load_bytecode('dumper.pbc');
+}
+
+grammar JSON::Grammar is HLL::Grammar {
+    rule TOP { <value> }
+
+    proto token value { <...> }
+
+    token value:sym<string> { <string> }
+
+    token value:sym<number> {
+        '-'?
+        [ <[1..9]> <[0..9]>+ | <[0..9]> ]
+        [ '.' <[0..9]>+ ]?
+        [ <[Ee]> <[+\-]>? <[0..9]>+ ]?
+    }
+
+    rule value:sym<array> {
+        '[' [ <value> ** ',' ]? ']'
+    }
+
+    rule value:sym<object> {
+        '{'
+        [ [ <string> ':' <value> ] ** ',' ]?
+        '}'
+    }
+
+    token string {
+        <?["]> <quote_EXPR: ':qq'> 
+    }
+}
+
+
+class JSON::Actions is HLL::Actions {
+    method TOP($/) { 
+        make PAST::Block.new($<value>.ast, :node($/)); 
+    };
+
+    method value:sym<string>($/) { make $<string>.ast; }
+
+    method value:sym<number>($/) { make +$/; }
+
+    method value:sym<array>($/) {
+        my $past := PAST::Op.new(:pasttype<list>, :node($/));
+        if $<value> {
+            for $<value> { $past.push($_.ast); }
+        }
+        make $past;
+    }
+
+    method value:sym<object>($/) {
+        my $past := PAST::Stmts.new( :node($/) );
+        my $hashname := PAST::Compiler.unique('hash');
+        my $hash := PAST::Var.new( :scope<register>, :name($hashname), 
+                                   :viviself('Hash'), :isdecl );
+        my $hashreg := PAST::Var.new( :scope<register>, :name($hashname) );
+        $past.'push'($hash);
+        # loop through all string/value pairs, add set opcodes for each pair.
+        my $n := 0;
+        while $n < +$<string> {
+            $past.'push'(PAST::Op.new( :pirop<set__vQ~*>, $hashreg, 
+                                       $<string>[$n].ast, $<value>[$n].ast ) );
+            $n++;
+        }
+        # return the Hash as the result of this node
+        $past.'push'($hashreg);
+        make $past;
+    }
+
+    method string($/) { make $<quote_EXPR>.ast; }
+}
+
+
+class JSON::Compiler is HLL::Compiler {
+    INIT {
+        JSON::Compiler.language('json');
+        JSON::Compiler.parsegrammar(JSON::Grammar);
+        JSON::Compiler.parseactions(JSON::Actions);
+    }
+
+    method autoprint($value) {
+        _dumper($value, 'JSON')
+            unless (pir::getinterp__P()).stdhandle(1).tell > $*AUTOPRINTPOS;
+    }
+
+    our sub MAIN(@ARGS) is pirflags<:main> {
+        JSON::Compiler.command_line(@ARGS);
+    }
+}
+