fun with imperative sentences

gistfile1.txt

#use Grammar::Tracer;


grammar IF::Grammar {
    my @adjectives = <small tiny big huge large shiny dull black white red blue yellow green orange purple>;
    my @prepositions = <for in under over from to on off at by between below across through into behind beside with towards>, 'away \s+ from', 'next \s+ to', 'out \s+ of';
    my @objPronouns = <me you him her it us them>;
    my @posPronouns = <my your his her its our their>;
    my @articles = <a an the some several>, 'a few', <one two three four five>, '\d+';
    my @adverbs = <quickly slowly>;
    my @directions = <n north ne northeast e east se southeast s south sw southwest w west nw northwest up down out in>;

    # rakudo It seems that LTM is broken when using <{ ... }> [perl #107306]
    # So sort alternatives by longest-first to work around it
    sub lsort (@a) { @a.sort({ $^b.chars cmp $^a.chars }) }

    rule TOP { ^ <imperative> [ <conjunction> <imperative> ]* $ }

    rule imperative { <verb> <nounPhrase>* <adverbialPhrase>* }

    token verb { \w+ }

    token conjunction { and|or|but };

    rule nounPhrase { <nuclearNounPhrase> [ 'and' <nuclearNounPhrase> ]* }

    # Seems like a rule should work here, but multiple adjectives fail to parse
    regex nuclearNounPhrase { <article> <.ws> [ <adjective> <.ws> ]* <noun> | <objPronoun> }
    # rakudo @variable interpolation is broken, but <{ ... }> works
    token objPronoun { <{ join '|', lsort(@objPronouns) }> }
    # Let "the dog" or "her dog" both work
    token article { <{ join '|', lsort((@articles, @posPronouns)) }> }
    token adjective { <{ join '|', lsort(@adjectives) }> }
    token noun { \w+ }

    rule adverbialPhrase { <prepositionalPhrase> | <adverb> }
    rule prepositionalPhrase { <preposition> <nounPhrase> }
    token preposition { <{ join '|', lsort(@prepositions) }> }
    token adverb { <{ join '|', lsort(@adverbs) }> | <direction> }
    token direction { <{ join '|', lsort(@directions) }> }
}

class IF::Grammar::Actions {
    method TOP($/) { make($<imperative>».ast); }
    method imperative($/) { make([~$<verb>, $<nounPhrase>».ast, $<adverbialPhrase>».ast]); }
    method nounPhrase($/) {
        make $<nuclearNounPhrase>».ast;
    }
    method nuclearNounPhrase($/) { make(~($<noun> // $<objPronoun>) => $<adjective>.map(~*)); }
    method adverbialPhrase($/) { make($<prepositionalPhrase>.ast // ~$<adverb>); }
    method prepositionalPhrase($/) { make({ prep => ~$<preposition>, noun => $<nounPhrase>.ast }); }
}

my $failures = 0;
my @begYourPardon =
    "Sorry, I didn't catch that.",
    "Come again, please?",
    "Hmmm, I seem to be having a hard time getting that.",
    "How's that again?",
    "Mmmmmh, sorry, I didn't get that."
    ;

my IF::Grammar::Actions $actions .= new;

loop {
    say "Gosh, I just can't get it. Sorry, I give up!" if $failures > 6;

    print "> ";
    my $line = get;
    last unless $line.defined;
    next unless $line ~~ /\S/;
    # rakudo $/ isn't set properly after .parse(); and niecza doesn't let me assign to $/
    my $match = IF::Grammar.parse($line, :$actions);
    if $match {
        $failures = 0;
        my $gist = $match.can('gist') ?? 'gist' !! 'perl';
        #say $match."$gist"();

        given $match<imperative>[0]<verb> {
            when 'quit' { say "Bye!"; exit 0; }
            when /help|\?/ { say "Examples: quit, e, out, look, take the book"; }
            #default { say "[{$match<verb>}], [{$match<nounPhrase>}], [{$match<adverbialPhrase>}]"; }
            default { say $match.ast.perl; }

            #say "GO $<direction>!" if $<direction>;
        }
    }
    else {
        ++$failures;
        say @begYourPardon.pick;
    }
}

# vim:ft=perl6 et sw=4 ts=4: