Permalink
Browse files

[GGE::Perl6Regex] 'demoted' WS to <ws> method

This means that we lose the pretty backtracking (and a few tests).
Will bring it all back when we do backtracking of subrules properly.
  • Loading branch information...
1 parent 6a3be28 commit d7dffe3f56b61b3e1e891668b0086700526f9405 @masak committed Jan 26, 2010
Showing with 21 additions and 50 deletions.
  1. +18 −0 lib/GGE/Match.pm
  2. +3 −50 lib/GGE/Perl6Regex.pm
View
@@ -201,4 +201,22 @@ class GGE::Match {
method cntrl() { self.cclass: /<cntrl>/ }
method punct() { self.cclass: /<punct>/ }
method alnum() { self.cclass: /<alnum>/ }
+
+ method ws() {
+ my $target = self.target;
+ my $pos = self.to;
+ my $mob = self.new(self);
+ if $pos >= $target.chars {
+ $mob.to = $pos;
+ }
+ elsif $pos == 0
+ || $target.substr($pos, 1) ~~ /\W/
+ || $target.substr($pos - 1, 1) ~~ /\W/ {
+ while $target.substr($pos, 1) ~~ /\s/ {
+ ++$pos;
+ }
+ $mob.to = $pos;
+ }
+ return $mob;
+ }
}
View
@@ -4,55 +4,7 @@ use GGE::Exp;
use GGE::OPTable;
class GGE::Exp::WS is GGE::Exp::Subrule {
- # The below code is a working implementation of <.ws>, but it shouldn't
- # be defined here. It should be defined in a method called 'ws' in the
- # GGE::Match class. However, before we start calling other rules, this
- # will do.
- method p6($code, $label, $next) {
- my %args = self.getargs($label, $next);
- my $replabel = $label ~ '_repeat';
- $code.emit( q[[
- when '%L' { # ws
- if $pos >= $lastpos {
- goto('%S');
- }
- elsif $pos == 0 || $target.substr($pos, 1) ~~ /\W/
- || $target.substr($pos - 1, 1) ~~ /\W/ {
- push @gpad, 0;
- local-branch('%0');
- }
- else {
- goto('fail');
- }
- }
- when '%L_cont' {
- pop @gpad;
- goto('fail');
- }
- when '%0' {
- $rep = @gpad[*-1];
- ++$rep;
- if $target.substr($pos, 1) ~~ /\s/ {
- ++$pos;
- goto('%0');
- break;
- }
- if $cutmark != 0 { goto('fail'); break; }
- --$rep;
- goto('%L_1')
- }
- when '%L_1' {
- pop @gpad;
- push @ustack, $rep;
- local-branch('%S');
- }
- when '%L_1_cont' {
- $rep = pop @ustack;
- push @gpad, $rep;
- if $cutmark != 0 { goto('fail'); break; }
- goto('fail');
- } ]], $replabel, |%args);
- }
+ method contents() { undef }
}
class GGE::Perl6Regex {
@@ -725,7 +677,8 @@ class GGE::Perl6Regex {
multi sub perl6exp(GGE::Exp::WS $exp is rw, %pad) {
if %pad<sigspace> {
- # XXX: Should do stuff here. See PGE.
+ $exp.hash-access('subname') = 'ws';
+ $exp.hash-access('iscapture') = False;
return $exp;
}
else {

0 comments on commit d7dffe3

Please sign in to comment.