Skip to content

Commit

Permalink
[GGE] grammars now work
Browse files Browse the repository at this point in the history
See examples/mygrammar for a working example.
  • Loading branch information
Carl Masak committed Apr 25, 2010
1 parent c4fb5b3 commit c4696f5
Show file tree
Hide file tree
Showing 6 changed files with 66 additions and 14 deletions.
15 changes: 15 additions & 0 deletions examples/mygrammar
@@ -0,0 +1,15 @@
use v6;

use GGE;

my $debug = False;

class MyGrammar is GGE::Grammar {
GGE::Perl6Regex.new("<bar>", :$debug, :grammar<MyGrammar>, :name<TOP>);
GGE::Perl6Regex.new("'OH HAI'", :$debug, :grammar<MyGrammar>, :name<bar>);
}

my GGE::Match $match
= MyGrammar.parse('this string contains "OH HAI" as a substring', :$debug);

say $match ?? $match.dump_str('mob', ' ', '') !! "No match\n";
1 change: 1 addition & 0 deletions lib/GGE.pm
@@ -1,2 +1,3 @@
use v6;
use GGE::Perl6Regex;
use GGE::Grammar;
41 changes: 31 additions & 10 deletions lib/GGE/Exp.pm
Expand Up @@ -66,26 +66,44 @@ class GGE::Exp is GGE::Match {
' ' x $indent ~ self.WHAT.perl.subst(/^.*':'/, '') ~ $contents;
}

method compile(:$debug) {
my $source = self.root-p6(:$debug);
method compile(:$debug, :$grammar, :$name, :$target = 'routine') {
my $source = self.root-p6(:$debug, :$grammar, :$name);
if $debug {
say $source;
say '';
}
my $binary = eval $source
or die ~$!;
return $binary;
if $target eq 'P6' {
return $source;
}
else {
my $binary = eval $source
or die ~$!;
return $binary;
}
}

method reduce() {
self;
}

method root-p6(:$debug) {
method root-p6(:$debug, :$grammar, :$name = '') {
my $code = CodeString.new();
$code.unique(); # XXX: Remove this one when we do other real calls
$code.emit( q[[sub ($m, :$debug) {
my $mob = GGE::Match.new($m);
my $MATCH = 'GGE::Match';
if $grammar {
$code.emit( q[[class %0 is also { ]], $grammar );
$MATCH = $grammar;
}
if $name {
$code.emit( q[[ method %0(:$debug) {
my $m = self;
]], $name );
}
else {
$code.emit( q[[ sub ($m, :$debug) { ]] );
}
$code.emit( q[[
my $mob = %1.new($m);
my $target = $mob.target;
my $iscont = $mob.iscont;
my $mfrom;
Expand Down Expand Up @@ -135,7 +153,7 @@ class GGE::Exp is GGE::Match {
}
when 'fail' {
local-return();
} ]], CUT_RULE);
} ]], CUT_RULE, $MATCH);
my $explabel = 'R';
$GGE::Exp::group = self;
my $exp = self.reduce;
Expand All @@ -150,7 +168,10 @@ class GGE::Exp is GGE::Match {
}
}
}
} ]]);
} ]], $name);
if $grammar {
$code.emit( q[[ } ]] ); # close off the grammar class
}
~$code;
}

Expand Down
12 changes: 12 additions & 0 deletions lib/GGE/Grammar.pm
@@ -0,0 +1,12 @@
use v6;

use GGE::Match;

class GGE::Grammar is GGE::Match {
method parse($target, :$debug) {
die "Cannot call .parse on a grammar with no TOP rule"
unless self.can('TOP');
my $m = self.new($target);
$m.TOP(:$debug);
}
}
7 changes: 5 additions & 2 deletions lib/GGE/Match.pm
Expand Up @@ -27,6 +27,8 @@ class GGE::Match {
has $.from is rw = 0;
has $.to is rw = 0;
has $.iscont = False;
# XXX: This is *so* a hack. Can't think of anything better now. Sorry.
has $.iscont2 = False;
has $.startpos = 0;
has $!store = Store.new;
has $!ast;
Expand All @@ -37,12 +39,13 @@ class GGE::Match {
}

multi method new(Str $target) {
self.new(:$target, :from(0), :to(-1), :iscont(True));
self.new(:$target, :from(0), :to(-1), :iscont(True), :iscont2(True));
}

multi method new(GGE::Match $match) {
defined $match ?? self.new(:target($match.target), :from($match.from),
:to(-1), :iscont(False),
:to(-1),
:iscont2(False), :iscont($match.iscont2),
:startpos($match.to))
!! self.new();
}
Expand Down
4 changes: 2 additions & 2 deletions lib/GGE/Perl6Regex.pm
Expand Up @@ -120,12 +120,12 @@ class GGE::Perl6Regex is also {
$optable.newtok('prefix::', :looser<infix:|>,
:parsed(&GGE::Perl6Regex::parse_modifier));

method new($pattern, :$debug) {
method new($pattern, :$grammar, :$name, :$debug) {
my $match = parse_regex($pattern);
die 'Perl6Regex rule error: can not parse expression'
if $match.to < $pattern.chars;
my $exp = perl6exp($match.hash-access('expr'), { lexscope => {} });
my $binary = $exp.compile(:$debug);
my $binary = $exp.compile(:$debug, :$grammar, :$name);
return self.bless(*, :$exp, :$binary);
}

Expand Down

0 comments on commit c4696f5

Please sign in to comment.