in reply to Perl6: Dynamic Grammars

What's that old adage...? "Ask and ye shall figure it out yourself." :-D

#!/usr/bin/env perl6
use Test;

our %sigils = (
    bang   => '!', at      => '@', hash  => '#',
    dollar => '$', percent => '%', caret => '^',
    and    => '&', star    => '*', zero  => '0',
);

our grammar DynGrammar {
    my $sigil;
    regex TOP {
      ^^ (\w+) <?{ $sigil=%sigils{$0} if %sigils{$0}:exists }>
         \s+ $sigil (.*?) $sigil \n?  $$ }
}

our class DynActions {
    method TOP($/) { make $1 }
}

sub dyn(Str $str) {
    DynGrammar.parse($str, :actions(DynActions)).made
}

is   dyn('bang    !one!' ), 'one',  'parse bang!one ok';
is   dyn('zero    0one0' ), 'one',  'parse zero0one ok';
isnt dyn('bang    @one@' ), 'one',  'isnt  bang@one ok';
isnt dyn('BONK    !one!' ), 'one',  'isnt  BONK!one ok';
nok  DynGrammar.parse('bang @one@', :actions(DynActions)), 'nok';
nok  DynGrammar.parse('BONK !one!', :actions(DynActions)), 'unk';

[download]

The missing piece was to use a Block (in this case, a <?{condition}> assertion) to save off the capture. (I had initially broken out the assignment from the condition, just in case the expression looked Falsey, but thanks to Perl 6, "0" is True! Hallelujah!)

It still might not be the most idiomatic, I don't know; I'm always open to suggestions...

Replies are listed 'Best First'.
Re^2: Perl6: Dynamic Grammars
by stevieb (Canon) on Jun 01, 2016 at 18:51 UTC
[reply]
      Another option would be to use meta programming, e.g. starting with 
      grammar g {
    rule TOP { <bang> | <at> }
    rule bang { 'bang' '!' [<-[!]>*] '!' }
}

g.^add_method('at', rx { 'at' [\s*]  '@' [<-[@]>*] '@' } );
# ... then do the above for each of the sigils
g.^compose;

say g.parse('bang !some text!');
say g.parse('at @some text@');

      [download]
[reply]
[d/l]
Re^2: Perl6: Dynamic Grammars
by Anonymous Monk on Jun 07, 2016 at 13:01 UTC
    A tweaked and simplified version: 
    my %sigils =
    bang   => '!', at      => '@', hash  => '#',
    dollar => '$', percent => '%', caret => '^',
    and    => '&', star    => '*', zero  => '0';

my regex line {
    ^^ :my $s; (\w+) <?{ $s = %sigils{$0} }> \h+ $s (\N*) $s $$
}

.say for "star *foo*\nat @bar\nat @baz@" ~~ m:g/<line>/;

    [download]
[reply]
[d/l]
      my regex line {
    ^^ :my $s; (\w+) <?{ $s = %sigils{$0} }> \h+ $s (\N*) $s $$
}

.say for "star *foo*\nat @bar\nat @baz@" ~~ m:g/<line>/;

      That's HOT! :-D

      But how would I rewrite my tests, then — which actually want to operate on the captured value?

      This seems clunky and naïve: (Not unlike myself... «grin»)

      #!/usr/bin/env perl6
use Test;

my %sigils =
    bang   => '!', at      => '@', hash  => '#',
    dollar => '$', percent => '%', caret => '^',
    and    => '&', star    => '*', zero  => '0';

my regex line {
    ^^ :my $s; (\w+) <?{ $s = %sigils{$0} }> \h+ $s (\N*) $s $$
}

is  ('bang !one!' ~~ m/<line>/)<line>[1],     'one', 'is   bang!one';
is  ('zero 0one0' ~~ m/<line>/)<line>[1],     'one', 'is   zero0one';
isnt 'bang @one@' ~~ m/<line>/ && $<line>[1], 'one', 'isnt bang@one';
isnt 'BONK !one!' ~~ m/<line>/ && $<line>[1], 'one', 'isnt BONK!one';
nok  'bang @one@' ~~ m/<line>/, 'mismatch fails';
nok  'BONK !one!' ~~ m/<line>/, 'unknown fails';

      [download]
[reply]
[d/l]
        But how would I rewrite my tests, then — which actually want to operate on the captured value?
        This is Perl, so there's more than one way to do it, eg 
        my %sigils =
    bang   => '!', at      => '@', hash  => '#',
    dollar => '$', percent => '%', caret => '^',
    and    => '&', star    => '*', zero  => '0';

my regex line {
    ^^ :my $s; (\w+) <?{ $s = %sigils{$0} }> \h+ $s (\N*) $s $$
    { make ~$0 => ~$1 }
}

sub parse($_) { map *.<line>.made, m:g/<line>/ }

say parse "star *foo*\nat @bar\nat @baz@";

        [download]
        will generate a sequence of pairs with the key being the name of the sigil and the value the enclosed text.
[reply]
[d/l]
        You can name a capture if you think that's an improvement over numbered captures (see the two lines with comments): 

        my regex line {
    ^^
    (\w+) :my $s; <?{ $s = %sigils{$0} }>
    \h+
    $s $<foo>=\N* $s # Note the foo bit here ...
    $$
}

is  ('bang !one!' ~~ m/<line>/)<line><foo>, 'one', 'is   bang!one'; # 
+... and here

        [download]

        Another tweak is to drop one level of hash keys by using a grammar (again, see the two lines with comments): 

        grammar g {
    regex TOP { # drop 'my'; name 'TOP' to simplify .parse call in `is
+` test
    ^^
    (\w+) :my $s;  <?{ $s = %sigils{$0} }>
    \h+
    $s $<foo>=\N* $s
    $$
    }
}

is  g.parse('bang !one!')<foo>,     'one', 'is   bang!one'; # calling 
+.parse method on grammar defaults to starting with rule (regex) named
+ 'TOP'

        [download]

        perl6.party (not mine)
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom