Skip to content

Commit

Permalink
Initial commit of modules, a README and META.info.
Browse files Browse the repository at this point in the history
  • Loading branch information
@jnthn
jnthn committed Aug 17, 2011
0 parents commit 4689eef
Show file tree
Hide file tree
Showing 4 changed files with 223 additions and 0 deletions.
7 changes: 7 additions & 0 deletions META.info
@@ -0,0 +1,7 @@
{
"name" : "Grammar::Debugger",
"version" : "*",
"description" : "Simple tracing and debugging support for Perl 6 grammars",
"depends" : [ "Term::ANSIColor" ],
"source-url" : "git://github.com/jnthn/grammar-debugger.git"
}
1 change: 1 addition & 0 deletions README.markdown
@@ -0,0 +1 @@
# Grammar::DebuggerThis module provides a simple debugger for grammars. Just use it: use Grammar::Debugger;And any grammar in the lexical scope of the use satement willautomatically have debugging enabled. The debugger will breakexecution when you first enter the grammar, and provide a prompt.Type "h" for a list of commands.If you are debugging a grammar and want to set up breakpoints incode rather than entering them manually at the debug prompt, youcan apply the breakpoint trait to any rule: token name is breakpoint { \w+ [\h+ \w+]* }If you want to conditionally break, you can also do something like: token name will break { $^m eq 'Russia' } { \w+ [\h+ \w+]* }Which will only break after the name rule has matched "Russia". # Grammar::TracerThis gives similar output to Grammar::Debugger, but just runs throughthe whole grammar without stopping until it is successful or fails.Once again, after a use: use Grammar::Tracer;It will apply to any grammars in the lexical scope of the use statement.# Bugs? Ideas?Please file them in GitHub issues.
Expand Down
171 changes: 171 additions & 0 deletions lib/Grammar/Debugger.pm
@@ -0,0 +1,171 @@
use Term::ANSIColor;

my enum InterventionPoint <EnterRule ExitRule>;

multi trait_mod:<is>(Method $m, :$breakpoint!) is export {
$m does role { method breakpoint { True } }
}
multi trait_mod:<will>(Method $m, $cond, :$break!) is export {
$m does role {
has $.breakpoint-condition is rw;
method breakpoint { True }
}
$m.breakpoint-condition = $cond;
}

my class DebuggedGrammarHOW is Metamodel::GrammarHOW is Mu {
has $!indent = 0;
has $!auto-continue = False;
has $!stop-at-fail = False;
has $!stop-at-name = '';
has @!breakpoints;
has %!cond-breakpoints;

method add_method(Mu $obj, $name, $code) {
if $code.?breakpoint {
if $code.?breakpoint-condition {
%!cond-breakpoints{$code.name} = $code.breakpoint-condition;
}
else {
@!breakpoints.push($code.name);
}
}
nextsame;
}

method find_method($obj, $name) {
my $meth := callsame;
substr($name, 0, 1) eq '!' || $name eq any(<parse CREATE Bool defined MATCH>) ??
$meth !!
-> $c, |$args {
# Method name.
say ('| ' x $!indent) ~ BOLD() ~ $name ~ RESET();

# Call rule.
self.intervene(EnterRule, $name);
$!indent++;
my $result := $meth($obj, |$args);
$!indent--;

# Dump result.
my $match := $result.MATCH;
say ('| ' x $!indent) ~ '* ' ~
($result.MATCH ??
colored('MATCH', 'white on_green') ~ self.summary($match) !!
colored('FAIL', 'white on_red'));
self.intervene(ExitRule, $name, :$match);
$result
}
}

method intervene(InterventionPoint $point, $name, :$match) {
# Any reason to stop?
my $stop =
!$!auto-continue ||
$point == EnterRule && $name eq $!stop-at-name ||
$point == ExitRule && !$match && $!stop-at-fail ||
$point == EnterRule && $name eq any(@!breakpoints) ||
$point == ExitRule && $name eq any(%!cond-breakpoints.keys)
&& %!cond-breakpoints{$name}.ACCEPTS($match);
if $stop {
my $done;
repeat {
my @parts = split /\s+/, prompt("> ");
$done = True;
given @parts[0] {
when '' {
$!auto-continue = False;
$!stop-at-fail = False;
$!stop-at-name = '';
}
when 'r' {
given +@parts {
when 1 {
$!auto-continue = True;
$!stop-at-fail = False;
$!stop-at-name = '';
}
when 2 {
$!auto-continue = True;
$!stop-at-fail = False;
$!stop-at-name = @parts[1];
}
default {
usage();
$done = False;
}
}
}
when 'rf' {
$!auto-continue = True;
$!stop-at-fail = True;
$!stop-at-name = '';
}
when 'bp' {
if +@parts == 2 && @parts[1] eq 'list' {
say "Current Breakpoints:\n" ~
@!breakpoints.map({ " $_" }).join("\n");
}
elsif +@parts == 3 && @parts[1] eq 'add' {
unless @!breakpoints.grep({ $_ eq @parts[2] }) {
@!breakpoints.push(@parts[2]);
}
}
elsif +@parts == 3 && @parts[1] eq 'rm' {
my @rm'd = @!breakpoints.grep({ $_ ne @parts[2] });
if +@rm'd == +@!breakpoints {
say "No breakpoint '@parts[2]'";
}
else {
@!breakpoints = @rm'd;
}
}
elsif +@parts == 2 && @parts[1] eq 'rm' {
@!breakpoints = [];
}
else {
usage();
}
$done = False;
}
when 'q' {
exit(0);
}
default {
usage();
$done = False;
}
}
} until $done;
}
}

method summary($match) {
my $snippet = $match.Str;
my $sniplen = 60 - (3 * $!indent);
$sniplen > 0 ??
colored(' ' ~ $snippet.substr(0, $sniplen).perl, 'white') !!
''
}

sub usage() {
say
" r run (until breakpoint, if any)\n" ~
" <enter> single step\n" ~
" rf run until a match fails\n" ~
" r <name> run until rule <name> is reached\n" ~
" bp add <name> add a rule name breakpoint\n" ~
" bp list list all active rule name breakpoints\n" ~
" bp rm <name> remove a rule name breakpoint\n" ~
" bp rm removes all breakpoints\n" ~
" q quit"
}

method publish_method_cache($obj) {
# Suppress this, so we always hit find_method.
}
}

# Export this as the meta-class for the "grammar" package declarator.
my module EXPORTHOW { }
EXPORTHOW.WHO.<grammar> = DebuggedGrammarHOW;
44 changes: 44 additions & 0 deletions lib/Grammar/Tracer.pm
@@ -0,0 +1,44 @@
use Term::ANSIColor;

my class TracedGrammarHOW is Metamodel::GrammarHOW is Mu {
my $indent = 0;

method find_method($obj, $name) {
my $meth := callsame;
substr($name, 0, 1) eq '!' || $name eq any(<parse CREATE Bool defined MATCH>) ??
$meth !!
-> $c, |$args {
# Method name.
say ('| ' x $indent) ~ BOLD() ~ $name ~ RESET();

# Call rule.
$indent++;
my $result := $meth($obj, |$args);
$indent--;

# Dump result.
my $match := $result.MATCH;
say ('| ' x $indent) ~ '* ' ~
($result.MATCH ??
colored('MATCH', 'white on_green') ~ summary($match) !!
colored('FAIL', 'white on_red'));
$result
}
}

sub summary($match) {
my $snippet = $match.Str;
my $sniplen = 60 - (3 * $indent);
$sniplen > 0 ??
colored(' ' ~ $snippet.substr(0, $sniplen).perl, 'white') !!
''
}

method publish_method_cache($obj) {
# Suppress this, so we always hit find_method.
}
}

# Export this as the meta-class for the "grammar" package declarator.
my module EXPORTHOW { }
EXPORTHOW.WHO.<grammar> = TracedGrammarHOW;

0 comments on commit 4689eef

Please sign in to comment.