Holding Pattern Continued

Well, a week has gone by, and Rakudo's ng branch is definitely not ready for prime time yet. It's completely understandable, but it does put a bit of a kink in my plan to start working on getting actions attached to the Perl 6 ABC grammar using ng.

Okay, then, I guess the thing to do is to find a goal for the project that can be done now. And hey, there it is! I will attempt to get my hands on some examples of Irish traditional music (again, as colomon suggested) and make sure they work in our current parser. In turn, that will require a decent way of checking whether an entire tune has been read into the grammar or not. That sounds like a solid goal for the next week...

Holding Pattern

Well, I meant to get to adding actions to my grammar. But I have a great excuse for not making progress. At the moment, there is a big push underway in Rakudo development to replace the current master branch with the ng branch. As I understand it, ng implements actions a bit differently than master -- it is more true to the Perl 6 spec. But right now, ng isn't ready to use, and there's not much point in targeting an out-of-date implementation that is going to go away in the next couple of weeks. So I'm putting this on hold until ng is in place.

If you're following along at home, I did go ahead and add grace notes, chords, nth endings, and rolls and staccato markings. It's so straightforward it's not really describing how I did it, but it is uploaded to github if you'd like to try it. I don't know if it will properly support Irish music yet, as a commenter requested last time, but it ought to be closer, anyway.

Putting it together

Just to get more dramatic results, here's script to check if an ABC tune can be played on a one-row button accordion in G. It's pretty easy to put together given what we've got so far:

use v6;

BEGIN { push @*INC, "lib" }
use ABC;

my @matches = $*IN.slurp.comb(m/ <ABC::tune> /, :match);

my %dg_notes = {
    'g' => 1,
    'a' => 1,
    'b' => 1,
    'c' => 1,
    'd' => 1,
    'e' => 1,
    '^f' => 1
}

for @matches {
    my %header = header_hash(.<ABC::tune><header>);
    say %header<T> ~ ":";

    my @notes = gather for .<ABC::tune><music><line_of_music> -> $line
    {
        for $line<bar> -> $bar
        {
            for $bar<element>
            {
                when .<broken_rhythm> { take .<broken_rhythm><note>[0]; take .<broken_rhythm><note>[1]; }
                when .<note>          { take .<note>; }
            }
        }
    }

    my %key_signature = key_signature(%header<K>);

    my @trouble = @notes.map({apply_key_signature(%key_signature, .<pitch>)}).grep({!%dg_notes.exists(lc($_))});
    say @trouble.perl;
}

Basically, we set up @matches with all the tunes in the file, and %dg_notes with all the notes that can be played (though it's actually just the key of G for now). Then for each tune, we loop through and collect all the notes, factored into the appropriate key signature. Then we just grep against the notes that are allowed to make a list of the notes not present on a G accordion. Here are the results on my sample file:

Cuckold Come Out o' the Amrey:
["^c", "^c", "^c", "^c", "^c", "^c", "^c", "^c", "=f", "^c", "^c", "^c", "^c"]
Elsie Marley:
["=F", "=f"]
Peacock Followed the Hen. JWDM.07:
[]

So in this case, "Cuckold" has a bunch of c-sharps and an f-natural, "Elsie Marley" has a couple of f-naturals, and "Peacock" is solidly playable on a G accordion.

While this approach has been fun, I think it's time to dig in use Perl 6 grammar actions to build a smarter data structure for ABC tunes. Should be exciting...

Extracting the Tunes from a File

Just a quick post today. While reworking my test script for the DG accordion testing program, I decided it would be better if the script could accept an ABC file with multiple tunes in it. After about ten minutes of fiddling around, I came up with this:

my @matches = $*IN.slurp.comb(m/ <ABC::tune> /, :match);

Actually, that's a lie. I just came up with that a second ago, when I said to myself, "Wait a minute, maybe slurp works on $*IN?" Previously I was using lines and join to get the same effect.

The scary thing is, that's just the cleanest way I've been able to find to do it in Rakudo. In ideal Perl 6, I believe you could just say

my @matches = slurp.comb(m/ <ABC::tune> /, :match);

I believe in ideal Perl 6 that would be lazy, too, using the Cat class internally to get a lazy string.

Anyway, that gives you an array of Match objects, one for each ABC tune in the file. But there is one big gotcha with this formulation: if something happens to abort parsing the ABC::tune early (say it hits an ABC directive we haven't implemented yet), comb will merrily skip the rest of the tune without any warning. So this is probably a less than ideal approach in the long run. But my attempts to make a regex for the entire file have failed so far, and this works quite nicely on my sample data.

Key signatures

After making my last post, I was brimming over with confidence. Obviously I'd done all the hard bits, and it was just a matter of putting the pieces together, right?

Wrong. Perl 6 makes parsing the ABC data so darned easy that the next bit seems completely unreasonable. At least, I haven't figured out a way to make it elegant yet. Figuring out which sharps or flats are in a key signature is tricky stuff, and as far as I can figure, Perl 6 doesn't really have any clever tools to make it easier.

sub key_signature($key_signature_name)
{
    my %keys = (
        'C' => 0,
        'G' => 1,
        'D' => 2,
        'A' => 3,
        'E' => 4,
        'B' => 5,
        'F#' => 6,
        'C#' => 7,
        'F' => -1,
        'Bb' => -2,
        'Eb' => -3,
        'Ab' => -4,
        'Db' => -5,
        'Gb' => -6,
        'Cb' => -7
    );
    
    my $match = $key_signature_name ~~ m/ <ABC::basenote> ('#' | 'b')? \h* (\w*) /;
    die "Illegal key signature\n" unless $match ~~ Match;
    my $lookup = [~] $match<ABC::basenote>.uc, $match[0];
    my $sharps = %keys{$lookup};
    
    if ($match[1].defined) {
        given ~($match[1]) {
            when ""     { }
            when /^maj/ { }
            when /^ion/ { }
            when /^mix/ { $sharps -= 1; }
            when /^dor/ { $sharps -= 2; }
            when /^m/   { $sharps -= 3; }
            when /^aeo/ { $sharps -= 3; }
            when /^phr/ { $sharps -= 4; }
            when /^loc/ { $sharps -= 5; }
            when /^lyd/ { $sharps += 1; }
            default     { die "Unknown mode {$match[1]} requested"; }
        }
    }
    
    my @sharp_notes = <F C G D A E B>;
    my %hash;
    
    given $sharps {
        when 1..7   { for ^$sharps -> $i { %hash{@sharp_notes[$i]} = "^"; } }
        when -7..-1 { for ^(-$sharps) -> $i { %hash{@sharp_notes[6-$i]} = "_"; } }
    }

    return %hash;
}

Basically, we do a match to rip the key signature name into its component pieces. The classic Highland piping key of "Amix", for instance, needs to be recognized as "A", no sharp or flat, "mix"olydian. We use the first two bits to lookup the corresponding major key signature, then use the last bit as a modifier. When we're done, we have the number of sharps or (if negative) flats. We then use that count to figure out which notes need to be sharp or flat.

It doesn't sound that bad, but it was pretty tricky to implement. It also (likely) has some holes in it. For example, the ugly key signture of C-flat minor (4 flats and 3 double flats!) will fail. Of course, any sane person would write that as B minor (two sharps). Also, the ABC spec allows you to explicitly specify exceptions to the normal key signature rules. I haven't even tried to implement that yet.

This is definitely one of those cases were any suggested improvements will be very welcome.

Getting all the notes

I hope everyone had lovely holidays! I've spent a bit of time while away fiddling with my idea for a script to determine if a given tune can be played on a D/G button accordion. I've hit on a bit of a snag, as the code to determine what sharps or flats are in a given key signature is more complicated than I was thinking. It will probably take me a few more days to sort that out, but in the meantime, here is my first stab at extracting all the pitches from an ABC tune:

my $match = $abc ~~ m/ <ABC::tune> /;

die "Tune not matched\n" unless $match ~~ Match;

my @notes = gather for $match<ABC::tune><music><line_of_music> -> $line
{
    for $line<bar> -> $bar
    {
        for $bar<element>
        {
            when .<broken_rhythm> { take .<broken_rhythm><note>[0]; take .<broken_rhythm><note>[1]; }
            when .<note>          { take .<note>; }
        }
    }
}

@notes.map({.<pitch>.say});

I'm suspecting there is a lovely Perl 6 idiom I don't quite have yet to squish all the for statements into a series of maps, but this works fine for the time being.

Got It!

I've now got a simple working ABC tune parser. (Well, working in at least so far as it passed all the tests I've thought up so far.) Once I cracked the whitespace issue, the remaining piece fell into shape quickly. Figuring out that \h and \v were useful for horizontal and vertical whitepsace also helped. Here's the grammar I'm using now:

use v6;

grammar ABC
{
    regex header_field_name { \w }
    regex header_field_data { \N* }
    regex header_field { ^^ <header_field_name> ':' \s* <header_field_data> $$ }
    regex header { [<header_field> \v]+ }

    regex basenote { <[a..g]+[A..G]> }
    regex octave { \'+ | \,+ }
    regex accidental { '^' | '^^' | '_' | '__' | '=' }
    regex pitch { <accidental>? <basenote> <octave>? }

    regex tie { '-' }
    regex note_length { [\d* ['/' \d*]? ] | '/' }
    regex note { <pitch> <note_length>? <tie>? }
    
    regex rest_type { <[x..z]> }
    regex rest { <rest_type> <note_length>? }
    
    regex gracing { '+' <alpha>+ '+' }
    
    regex spacing { \h+ }
    
    regex broken_rhythm_bracket { ['<'+ | '>'+] }
    regex broken_rhythm { <note> <g1=gracing>* <broken_rhythm_bracket> <g2=gracing>* <note> }
    
    regex element { <broken_rhythm> | <note> | <rest> | <gracing> | <spacing> }
    
    regex barline { ':|:' | '|:' | '|' | ':|' | '::' }
    
    regex bar { <element>+ <barline>? }
        
    regex line_of_music { <barline>? <bar>+ }
    
    regex music { [<line_of_music> \s*\v?]+ }
    
    regex tune { <header> <music> }
}

This will successfully parse the sample ABC I gave in my first post on this topic.

Where to go from here? 1) I'd like to write a simple script that can put the grammar to work as is. I'm thinking maybe a script which can test if a tune is playable on a D/G accordion. 2) So far, the grammar only supports a subset of ABC. Off the top of my head, it doesn't support chords (either as labels above the music or as more than one notehead at once) and it doesn't support in-line key changes or time changes. I'm guessing these will be fairly easy to add. 3) I'd like to be able to map the parse to actual Perl 6 classes to make the ABCs easier to manipulate. 4) I'd like to be able to use those classes to write out ABCs.

So much to do!

Infinite Loops

Well, I tried reformulating the line of music regex, and have what I think is a nice version, with one major catch. Here's the new regexes:

    regex element { <broken_rhythm> | <note> | <rest> | <gracing> }
    
    regex barline { ':|:' | '|:' | '|' | ':|' | '::' }
    
    regex bar { <element>+ <barline>? }
        
    regex line_of_music { <barline> $$ | <barline>? <element>+ $$ }

As is, this passes without issues:

{
    my $match = "g>ecgece/f/g/e/|" ~~ m/ <ABC::bar> /;
    isa_ok $match, Match, 'bar recognized';
    is $match<ABC::bar>, "g>ecgece/f/g/e/|", "Entire bar was matched";
    is $match<ABC::bar><element>.map(~*), "g>e c g e c e/ f/ g/ e/", "Each element was matched";
    is $match<ABC::bar><barline>, "|", "Barline was matched";
}

I think that's a suitably elegant test.

There's only one problem here. Real ABC allows for spaces between elements, which makes the ABC format much more legible. (I would like this code in the long run to be able to take an ABC tune, process it, and write it back out again, so ideally the code needs to carefully note the whitespace so it can be output again later.) But when I try to add <ws>+ alternative to the element regex, and try to parse a bar of music with a space or two in it, it appears to just hang.

This one has me utterly stumped; do any of the Perl 6 regex experts out there have a clue what could be going on?

Update: Still unable to make <ws> work for me, but had great luck with just using good old \s. So the code works now, but I'd still love an explanation...

Update to the Update: Argh, bar works but line_of_music still hangs. Dang it, I feel like I'm sooooooo close to getting this thing working....

Update^3: Ah, I simply had a completely broken line_of_music. I've got a simpler one working now.

Moritz++

Going over the #perl6 backlog today, I noticed that Moritz had two suggestions for me based on my last post. The first was a nice suggestions to use given in my tests:

{
    my $match = "d'+p+<<<+accent+_B" ~~ m/ <ABC::broken_rhythm> /;
    isa_ok $match, Match, '"d+p+<<<+accent+_B" is a broken rhythm';
    given $match<ABC::broken_rhythm>
    {
        is .<note>[0]<pitch><basenote>, "d", 'first note is d';
        is .<note>[0]<pitch><octave>, "'", 'first note has an octave tick';
        is .<note>[0]<pitch><accidental>, "", 'first note has no accidental';
        is .<note>[0]<note_length>, "", 'first note has no length';
        is .<g1>[0], "+p+", 'first gracing is +p+';
        is .<broken_rhythm_bracket>, "<<<", 'angle is <<<';
        is .<g2>[0], "+accent+", 'second gracing is +accent+';
        is .<note>[1]<pitch><basenote>, "B", 'second note is B';
        is .<note>[1]<pitch><octave>, "", 'second note has no octave';
        is .<note>[1]<pitch><accidental>, "_", 'second note is flat';
        is .<note>[1]<note_length>, "", 'second note has no length';
    }
}

This is far from the amazing new testing form I was hoping to find, but it sure is a big improvement over what I had. If I don't think of something else better, I will go back and redo all of the longer test cases this way.

He also said about the barline regex, "Looks like it would need LTM to work." I believe he's talking about longest-token matching, but I don't fully understand the issues, I fear. I did finally write tests for this case:

for ':|:', '|:', '|', ':|', '::'  
{
    my $match = $_ ~~ m/ <ABC::barline> /;
    isa_ok $match, Match, "barline $_ recognized";
    is $match<ABC::barline>, $_, "barline $_ is correct";

And they didn't work -- sometimes it would match the first barline it recognized rather than the longest. Moritz also suggested, "Reordering the longest alternatives to the front would help," so I did, and then all the tests passed. I hope that means the problems are actually gone, and not just that I've managed to hide them for the moment.

Anyway, big kudos for Moritz! Thanks to him, it definitely feels like I am getting closer here. Now if I can just figure out the proper way to ask for an entire line of ABC music in Perl 6, I will be there!