Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[GGE::Match] replaced .{} with hash-access

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...
commit 9256ca6e8193ac51979cd5e844637fbb4a12b291 1 parent 3c2f61b
Carl Mäsak authored
12 lib/GGE/Cursor.pm
View
@@ -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
};
7 lib/GGE/Match.pm
View
@@ -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) }
12 lib/GGE/OPTable.pm
View
@@ -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];
}
@@ -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;
@@ -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;
}
28 lib/GGE/Perl6Regex.pm
View
@@ -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, {})));
}
@@ -173,7 +173,7 @@ 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 {
@@ -181,27 +181,27 @@ class GGE::Perl6Regex {
$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;
}
@@ -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 {
@@ -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;
}
@@ -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);
@@ -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 t/03-optable.t
View
@@ -3,7 +3,6 @@ use Test;
use GGE::OPTable;
use GGE::Match;
-use GGE::Perl6Regex;
my GGE::OPTable $optable .= new;
@@ -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})";
}
@@ -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;
4 t/perl6regex/01-regex.t
View
@@ -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;
Please sign in to comment.
Something went wrong with that request. Please try again.