Implement :lang

lib/Cursor.cs

@@ -260,6 +260,10 @@ public sealed class RxFrame {
 
     public DynMetaObject GetClass() { return st.ns.klass; }
 
+    public void SetClass(DynMetaObject dm) {
+        st.ns.klass = dm;
+    }
+
     public Cursor MakeCursor() {
         return new Cursor(st.ns.klass, st.ns, bt, orig_s, orig, st.pos);
     }

src/CLRTypes.pm

@@ -64,6 +64,7 @@ my %typedata = (
         { Exact        => [m => 'Boolean'],
           Exact1       => [m => 'Boolean'],
           GetClass     => [m => 'DynMetaObject'],
+          SetClass     => [m => 'Void'],
           IncQuant     => [m => 'Void'],
           GetQuant     => [m => 'Int32'],
           OpenQuant    => [m => 'Void'],

src/CgOp.pm

@@ -294,6 +294,7 @@ use warnings;
     sub rxopenquant   { rxcall('OpenQuant') }
     sub rxclosequant  { rxcall('CloseQuant') }
     sub rxincquant    { rxcall('IncQuant') }
+    sub rxsetclass    { rxcall('SetClass', $_[0]) }
     sub rxsetpos      { rxcall('SetPos', $_[0]) }
     sub rxcommitgroup { rxcall('CommitGroup', $_[0]) }
 

src/Optimizer/RxSimple.pm

@@ -147,6 +147,7 @@ sub RxOp::None::mayback { 0 }
 sub RxOp::CClassElem::mayback { 0 }
 sub RxOp::CutLTM::mayback { 0 }
 sub RxOp::CutRule::mayback { 0 }
+sub RxOp::SetLang::mayback { 0 }
 sub RxOp::ZeroWidth::mayback { 0 }
 sub RxOp::Statement::rxsimp { RxOp::Sequence->new(zyg => []) }
 sub RxOp::BeforeString::mayback { 0 }

src/RxOp.pm

@@ -210,7 +210,7 @@ use CgOp;
     use Moose;
     extends 'RxOp';
 
-    # TODO once :lang is implemented, this will be a bit more complicated
+    # Note that BRACK automatically confines the language change
     sub code {
         my ($self, $body) = @_;
         my @code;
@@ -503,6 +503,29 @@ use CgOp;
     no Moose;
 }
 
+{
+    package RxOp::SetLang;
+    use Moose;
+    extends 'RxOp';
+
+    has expr => (isa => 'Op', is => 'ro', required => 1);
+    sub opzyg { $_[0]->expr }
+
+    sub code {
+        my ($self, $body) = @_;
+        CgOp::rxsetclass(CgOp::obj_llhow(CgOp::fetch(
+                    $self->expr->cgop($body))));
+    }
+
+    sub lad {
+        my ($self) = @_;
+        [ 'Null' ];
+    }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
 {
     package RxOp::Alt;
     use Moose;

test.pl

@@ -2,7 +2,7 @@
 
 use Test;
 
-plan 533;
+plan 535;
 
 ok 1, "one is true";
 ok 2, "two is also true";
@@ -1084,3 +1084,22 @@
     is (Bar but Quux).rquux, "quux", "can bind roles to classes";
     is (Bar but OUR::Foo6596["hi"]).rfoo, "hi", "can bind parametric roles to classes";
 }
+
+ok "abc" ~~ / :dba("foo") abc /, ":dba doesn't affect parsing";
+
+{
+    my $log = '';
+    my grammar B {
+        token a { { $log ~= 'A' } }
+        token b { { $log ~= 'B' } }
+        token c { { $log ~= 'C' } }
+    }
+    my grammar A {
+        token a { { $log ~= 'a' } }
+        token b { { $log ~= 'b' } }
+        token c { { $log ~= 'c' } }
+        token TOP { x <.a> [ :lang(B) <.b> ] <.c> x }
+    }
+    A.parse("xx");
+    is $log, 'aBc', ':lang has the expected effect';
+}

test2.pl

@@ -1,8 +1,6 @@
 # vim: ft=perl6
 use Test;
 
-ok "abc" ~~ / :dba("foo") abc /, ":dba doesn't affect parsing";
-
 #is $?FILE, 'test.pl', '$?FILE works';
 #is $?ORIG.substr(0,5), '# vim', '$?ORIG works';