Generate Perl 6 grammars too

lib/Grammar/BNF.pm

@@ -1,3 +1,5 @@
+my class Actions { ... }
+
 grammar Grammar::BNF {
     token TOP {
         \s* <rule>+ \s*
@@ -11,6 +13,10 @@ grammar Grammar::BNF {
         \h*
     }
 
+    token rule-name {
+        <-[>]>+
+    }
+
     token expression {
         <list> +% [\s* '|' <opt-ws>]
     }
@@ -31,7 +37,46 @@ grammar Grammar::BNF {
         '"' <-["]>* '"' | "'" <-[']>* "'"
     }
 
-    token rule-name {
-        <-[>]>+
+    method generate($source, :$name = 'BNFGrammar') {
+        my $actions = Actions.new(:$name);
+        my $ret = self.new.parse($source, :$actions).ast;
+        return $ret.WHAT;
+    }
+}
+
+my class Actions {
+    has $.name = 'BNFGrammar';
+    method TOP($/) {
+        my $grmr := Metamodel::GrammarHOW.new_type(:$.name);
+        $grmr.^add_method('TOP', EVAL 'token { <' ~ $<rule>[0].ast.key ~ '> }');
+        for $<rule>.map(*.ast) -> $rule {
+            $grmr.^add_method($rule.key, nqp::decont($rule.value));
+        }
+        $grmr.^compose;
+        make $grmr;
+    }
+
+    method rule($/) {
+        make $<rule-name>.ast => $<expression>.ast;
+    }
+
+    method rule-name($/) {
+        make ~$/;
+    }
+
+    method expression($/) {
+        make EVAL 'token { [ ' ~ $<list>.map(*.ast).join(' | ') ~ ' ] }';
+    }
+
+    method list($/) {
+        make $<term>.map(*.ast).join(' ');
+    }
+
+    method term($/) {
+        make ~$/;
+    }
+
+    method literal($/) {
+        make ~$/;
     }
 }

t/generate.t

@@ -0,0 +1,35 @@
+#!/usr/bin/env perl6
+use Grammar::BNF;
+use Test;
+
+my ($t, $p);
+
+$t = q[
+<foo> ::= "bar"
+];
+ok Grammar::BNF.generate($t, name => 'test1').new.parse('bar');
+
+$t = q[
+<foo> ::= <bar>
+<bar> ::= "baz"
+];
+ok Grammar::BNF.generate($t, name => 'test2').new.parse('baz');
+
+
+$t = q[
+<foo> ::= <bar> | <baz>
+<bar> ::= "bar" | <baz>
+<baz> ::= "buzz"
+];
+ok Grammar::BNF.generate($t).new.parse('buzz');
+
+$t = q[
+<foo> ::= <bar> <baz>
+<bar> ::= 'foo'
+<baz> ::= 'bar'
+];
+ok Grammar::BNF.generate($t).new.parse('foobar');
+
+# TODO: Tests for other things in parse.t
+
+done;