diff --git a/lib/Cursor.cs b/lib/Cursor.cs index 31e71eee..5a94deb6 100644 --- a/lib/Cursor.cs +++ b/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); } diff --git a/src/CLRTypes.pm b/src/CLRTypes.pm index f3972a7b..32e3a6cf 100644 --- a/src/CLRTypes.pm +++ b/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'], diff --git a/src/CgOp.pm b/src/CgOp.pm index 19a9dfdc..83d270dd 100644 --- a/src/CgOp.pm +++ b/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]) } diff --git a/src/Optimizer/RxSimple.pm b/src/Optimizer/RxSimple.pm index 305eaeb2..636467fe 100644 --- a/src/Optimizer/RxSimple.pm +++ b/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 } diff --git a/src/RxOp.pm b/src/RxOp.pm index 15765ab4..8a1cce5a 100644 --- a/src/RxOp.pm +++ b/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; diff --git a/test.pl b/test.pl index 8ae0d6ee..72b43150 100644 --- a/test.pl +++ b/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'; +} diff --git a/test2.pl b/test2.pl index 91ec93aa..29650c39 100644 --- a/test2.pl +++ b/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';