Skip to content

Commit

Permalink
[GGE::Match] replaced .{} with hash-access
Browse files Browse the repository at this point in the history 
There are still some minor things to iron out, as not all the tests pass yet.
Committing this partial, almost-finished change.
  • Loading branch information
Carl Masak committed Nov 29, 2009
1 parent 3c2f61b commit 9256ca6
Show file tree
Hide file tree
Showing 6 changed files with 40 additions and 35 deletions.
12 changes: 6 additions & 6 deletions lib/GGE/Cursor.pm
View file
Expand Up @@ -59,22 +59,22 @@ class GGE::Exp::Quant is also {
has &.backtrack = { False };

method matches($string, $pos is rw) {
for ^self<min> {
for ^self.hash-access('min') {
return False if !self[0].matches($string, $pos);
}
my $n = self<min>;
if self<backtrack> == EAGER {
my $n = self.hash-access('min');
if self.hash-access('backtrack') == EAGER {
&!backtrack = {
$n++ < self<max> && self[0].matches($string, $pos)
$n++ < self.hash-access('min') && self[0].matches($string, $pos)
};
}
else {
my @positions;
while $n++ < self<max> {
while $n++ < self.hash-access('min') {
push @positions, $pos;
last if !self[0].matches($string, $pos);
}
if self<backtrack> == GREEDY {
if self.hash-access('min') == GREEDY {
&!backtrack = {
@positions && $pos = pop @positions
};
Expand Down
7 changes: 6 additions & 1 deletion lib/GGE/Match.pm
View file
Expand Up @@ -50,7 +50,12 @@ class GGE::Match {
# RAKUDO: There's a bug preventing me from using hash lookup in a
# postcircumfix:<{ }> method. This workaround uses the above
# class to put the problematic hash lookup out of reach.
method postcircumfix:<{ }>($key) { $!store.hash-access($key) }
# RAKUDO: Now there's also a bug which spews out false warnings due to
# postcircumfix:<{ }> declarations. Will have to do without
# this declaration until that is resolved, in order to be able
# to build GGE. [perl #70922]
# method postcircumfix:<{ }>($key) { $!store.hash-access($key) }
method hash-access($key) { $!store.hash-access($key) }
method postcircumfix:<[ ]>($index) { $!store.array-access($index) }

method set($index, $value) { $!store.array-setelem($index, $value) }
Expand Down
12 changes: 7 additions & 5 deletions lib/GGE/OPTable.pm
View file
Expand Up @@ -136,7 +136,9 @@ class GGE::OPTable {
for reverse ^$arity {
$oper.push( @temp[$_] );
}
if $top<assoc> eq 'list' && $oper<type> eq @temp[1]<type> {
if $top<assoc> eq 'list'
&& $oper.hash-access('type')
eq @temp[1].hash-access('type') {
@temp[1].push($oper.llist[1]);
$oper = @temp[1];
}
Expand Down Expand Up @@ -182,15 +184,15 @@ class GGE::OPTable {
my $oper = $matchclass.new(:from($pos),
:to($pos + $key.chars),
:target($text));
$oper<type> = $name;
$oper.hash-access('type') = $name;
if $token.exists('parsed') {
my $routine = $token<parsed>;
if $routine ~~ Sub|Method {
$m<KEY> = $key;
$m.hash-access('KEY') = $key;
$m.to = $pos;
$oper = $routine($m);
$m.delete('KEY');
$oper<type> = $name;
$oper.hash-access('type') = $name;
if $oper.to > $pos {
$pos = $oper.to;
$found_oper = True;
Expand Down Expand Up @@ -342,7 +344,7 @@ class GGE::OPTable {
}
}
if @termstack && ?@termstack[0] {
$m<expr> = @termstack[0];
$m.hash-access('expr') = @termstack[0];
if $pos <= 0 {
$m.to = @termstack[0].to;
}
Expand Down
28 changes: 14 additions & 14 deletions lib/GGE/Perl6Regex.pm
View file
Expand Up @@ -62,7 +62,7 @@ class GGE::Perl6Regex {
my $match = $optable.parse($pattern);
die 'Regex parse error'
if $match.to < $pattern.chars;
my $expr = $match<expr>;
my $expr = $match.hash-access('expr');
return self.bless(*, :regex(perl6exp($expr, {})));
}

Expand Down Expand Up @@ -173,35 +173,35 @@ class GGE::Perl6Regex {
my $m = GGE::Exp::Quant.new($mob);
$m.from = $mob.to;

my $key = $mob<KEY>;
my $key = $mob.hash-access('KEY');
$m.to = $m.from + $key.chars;
my ($mod2, $mod1);
given $m.target {
$mod2 = .substr($m.to, 2);
$mod1 = .substr($m.to, 1);
}

$m<min> = $key eq '+' ?? 1 !! 0;
$m<max> = $key eq '?' ?? 1 !! Inf;;
$m.hash-access('min') = $key eq '+' ?? 1 !! 0;
$m.hash-access('max') = $key eq '?' ?? 1 !! Inf;;

if $mod2 eq ':?' {
$m<backtrack> = EAGER;
$m.hash-access('backtrack') = EAGER;
$m.to += 2;
}
elsif $mod2 eq ':!' {
$m<backtrack> = GREEDY;
$m.hash-access('backtrack') = GREEDY;
$m.to += 2;
}
elsif $mod1 eq '?' {
$m<backtrack> = EAGER;
$m.hash-access('backtrack') = EAGER;
++$m.to;
}
elsif $mod1 eq '!' {
$m<backtrack> = GREEDY;
$m.hash-access('backtrack') = GREEDY;
++$m.to;
}
elsif $mod1 eq ':' {
$m<backtrack> = NONE;
$m.hash-access('backtrack') = NONE;
++$m.to;
}

Expand All @@ -212,11 +212,11 @@ class GGE::Perl6Regex {
++$m.to;
}
# XXX: Need to generalize this into parsing several digits
$m<min> = $m<max> = $m.target.substr($m.to, 1);
$m.hash-access('min') = $m.hash-access('max') = $m.target.substr($m.to, 1);
++$m.to;
if $m.target.substr($m.to, 2) eq '..' {
$m.to += 2;
$m<max> = $m.target.substr($m.to, 1);
$m.hash-access('max') = $m.target.substr($m.to, 1);
++$m.to;
}
if $brackets {
Expand All @@ -237,7 +237,7 @@ class GGE::Perl6Regex {
my $wordchars = ($target.substr($m.to) ~~ /^\w+/).Str.chars;
my $word = $target.substr($m.to, $wordchars);
$m.to += $wordchars;
$m<key> = $word;
$m.hash-access('key') = $word;
$m;
}

Expand All @@ -246,7 +246,7 @@ class GGE::Perl6Regex {
}

multi sub perl6exp(GGE::Exp::Modifier $exp is rw, %pad) {
my $key = $exp<key>;
my $key = $exp.hash-access('key');
my $temp = %pad{$key};
%pad{$key} = 1; # XXX
$exp[0] = perl6exp($exp[0], %pad);
Expand All @@ -267,7 +267,7 @@ class GGE::Perl6Regex {

multi sub perl6exp(GGE::Exp::Quant $exp is rw, %pad) {
$exp[0] = perl6exp($exp[0], %pad);
$exp<backtrack> //= %pad<ratchet> ?? NONE !! GREEDY;
$exp.hash-access('backtrack') //= %pad<ratchet> ?? NONE !! GREEDY;
return $exp;
}
}
12 changes: 5 additions & 7 deletions t/03-optable.t
View file
Expand Up @@ -3,7 +3,6 @@ use Test;

use GGE::OPTable;
use GGE::Match;
use GGE::Perl6Regex;

my GGE::OPTable $optable .= new;

Expand Down Expand Up @@ -143,7 +142,7 @@ optable_output_is( '^ abc', 'infix:(term:^(), term:abc)',
sub optable_output_is($test, $expected, $msg) {
my $output;
if $optable.parse($test, :stop(' ;')) -> $match {
$output = tree($match<expr>);
$output = tree($match.hash-access('expr'));
if $match.to != $test.chars {
$output ~= " (pos={$match.to})";
}
Expand All @@ -157,11 +156,10 @@ sub optable_output_is($test, $expected, $msg) {

sub tree($match) {
return 'null' if !$match;
my $r = $match<type>;
given $match<type> {
# RAKUDO: Removing the semicolon below causes a runtime error
when 'term:' { ; $r ~= $match };
when 'term->:' { ; $r ~= $match<ident> };
my $r = $match.hash-access('type');
given $match.hash-access('type') {
when 'term:' { $r ~= $match }
when 'term->:' { $r ~= $match.hash-access('ident') }
$r ~= '(' ~ (join ', ', map { tree($_) }, $match.llist) ~ ')';
}
return $r;
Expand Down
4 changes: 2 additions & 2 deletions t/perl6regex/01-regex.t
View file
Expand Up @@ -31,10 +31,10 @@ for @test-files -> $test-file {
my $full-description = "[$test-file:$i] $description";
my $match;
my $failed = 1; # RAKUDO: Manual CATCH workaround
try {
# try {
$match = match_perl6regex($pattern, $target);
$failed = 0;
}
# }
if $failed {
if $result eq 'y'|'n' {
nok 1, $full-description;
Expand Down

0 comments on commit 9256ca6

Please sign in to comment.