Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[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 November 30, 2009
12  lib/GGE/Cursor.pm
@@ -59,22 +59,22 @@ class GGE::Exp::Quant is also {
59 59
     has &.backtrack = { False };
60 60
 
61 61
     method matches($string, $pos is rw) {
62  
-        for ^self<min> {
  62
+        for ^self.hash-access('min') {
63 63
             return False if !self[0].matches($string, $pos);
64 64
         }
65  
-        my $n = self<min>;
66  
-        if self<backtrack> == EAGER {
  65
+        my $n = self.hash-access('min');
  66
+        if self.hash-access('backtrack') == EAGER {
67 67
             &!backtrack = {
68  
-                $n++ < self<max> && self[0].matches($string, $pos)
  68
+                $n++ < self.hash-access('min') && self[0].matches($string, $pos)
69 69
             };
70 70
         }
71 71
         else {
72 72
             my @positions;
73  
-            while $n++ < self<max> {
  73
+            while $n++ < self.hash-access('min') {
74 74
                 push @positions, $pos;
75 75
                 last if !self[0].matches($string, $pos);
76 76
             }
77  
-            if self<backtrack> == GREEDY {
  77
+            if self.hash-access('min') == GREEDY {
78 78
                 &!backtrack = {
79 79
                     @positions && $pos = pop @positions
80 80
                 };
7  lib/GGE/Match.pm
@@ -50,7 +50,12 @@ class GGE::Match {
50 50
     # RAKUDO: There's a bug preventing me from using hash lookup in a
51 51
     #         postcircumfix:<{ }> method. This workaround uses the above
52 52
     #         class to put the problematic hash lookup out of reach.
53  
-    method postcircumfix:<{ }>($key) { $!store.hash-access($key) }
  53
+    # RAKUDO: Now there's also a bug which spews out false warnings due to
  54
+    #         postcircumfix:<{ }> declarations. Will have to do without
  55
+    #         this declaration until that is resolved, in order to be able
  56
+    #         to build GGE. [perl #70922]
  57
+  #  method postcircumfix:<{ }>($key) { $!store.hash-access($key) }
  58
+    method hash-access($key) { $!store.hash-access($key) }
54 59
     method postcircumfix:<[ ]>($index) { $!store.array-access($index) }
55 60
 
56 61
     method set($index, $value) { $!store.array-setelem($index, $value) }
12  lib/GGE/OPTable.pm
@@ -136,7 +136,9 @@ class GGE::OPTable {
136 136
                     for reverse ^$arity {
137 137
                         $oper.push( @temp[$_] );
138 138
                     }
139  
-                    if $top<assoc> eq 'list' && $oper<type> eq @temp[1]<type> {
  139
+                    if $top<assoc> eq 'list'
  140
+                       && $oper.hash-access('type')
  141
+                          eq @temp[1].hash-access('type') {
140 142
                         @temp[1].push($oper.llist[1]);
141 143
                         $oper = @temp[1];
142 144
                     }
@@ -182,15 +184,15 @@ class GGE::OPTable {
182 184
                     my $oper = $matchclass.new(:from($pos),
183 185
                                                :to($pos + $key.chars),
184 186
                                                :target($text));
185  
-                    $oper<type> = $name;
  187
+                    $oper.hash-access('type') = $name;
186 188
                     if $token.exists('parsed') {
187 189
                         my $routine = $token<parsed>;
188 190
                         if $routine ~~ Sub|Method {
189  
-                            $m<KEY> = $key;
  191
+                            $m.hash-access('KEY') = $key;
190 192
                             $m.to = $pos;
191 193
                             $oper = $routine($m);
192 194
                             $m.delete('KEY');
193  
-                            $oper<type> = $name;
  195
+                            $oper.hash-access('type') = $name;
194 196
                             if $oper.to > $pos {
195 197
                                 $pos = $oper.to;
196 198
                                 $found_oper = True;
@@ -342,7 +344,7 @@ class GGE::OPTable {
342 344
             }
343 345
         }
344 346
         if @termstack && ?@termstack[0] {
345  
-            $m<expr> = @termstack[0];
  347
+            $m.hash-access('expr') = @termstack[0];
346 348
             if $pos <= 0 {
347 349
                 $m.to = @termstack[0].to;
348 350
             }
28  lib/GGE/Perl6Regex.pm
@@ -62,7 +62,7 @@ class GGE::Perl6Regex {
62 62
         my $match = $optable.parse($pattern);
63 63
         die 'Regex parse error'
64 64
             if $match.to < $pattern.chars;
65  
-        my $expr = $match<expr>;
  65
+        my $expr = $match.hash-access('expr');
66 66
         return self.bless(*, :regex(perl6exp($expr, {})));
67 67
     }
68 68
 
@@ -173,7 +173,7 @@ class GGE::Perl6Regex {
173 173
         my $m = GGE::Exp::Quant.new($mob);
174 174
         $m.from = $mob.to;
175 175
 
176  
-        my $key = $mob<KEY>;
  176
+        my $key = $mob.hash-access('KEY');
177 177
         $m.to = $m.from + $key.chars;
178 178
         my ($mod2, $mod1);
179 179
         given $m.target {
@@ -181,27 +181,27 @@ class GGE::Perl6Regex {
181 181
             $mod1   = .substr($m.to, 1);
182 182
         }
183 183
 
184  
-        $m<min> = $key eq '+' ?? 1 !! 0;
185  
-        $m<max> = $key eq '?' ?? 1 !! Inf;;
  184
+        $m.hash-access('min') = $key eq '+' ?? 1 !! 0;
  185
+        $m.hash-access('max') = $key eq '?' ?? 1 !! Inf;;
186 186
 
187 187
         if $mod2 eq ':?' {
188  
-            $m<backtrack> = EAGER;
  188
+            $m.hash-access('backtrack') = EAGER;
189 189
             $m.to += 2;
190 190
         }
191 191
         elsif $mod2 eq ':!' {
192  
-            $m<backtrack> = GREEDY;
  192
+            $m.hash-access('backtrack') = GREEDY;
193 193
             $m.to += 2;
194 194
         }
195 195
         elsif $mod1 eq '?' {
196  
-            $m<backtrack> = EAGER;
  196
+            $m.hash-access('backtrack') = EAGER;
197 197
             ++$m.to;
198 198
         }
199 199
         elsif $mod1 eq '!' {
200  
-            $m<backtrack> = GREEDY;
  200
+            $m.hash-access('backtrack') = GREEDY;
201 201
             ++$m.to;
202 202
         }
203 203
         elsif $mod1 eq ':' {
204  
-            $m<backtrack> = NONE;
  204
+            $m.hash-access('backtrack') = NONE;
205 205
             ++$m.to;
206 206
         }
207 207
 
@@ -212,11 +212,11 @@ class GGE::Perl6Regex {
212 212
                 ++$m.to;
213 213
             }
214 214
             # XXX: Need to generalize this into parsing several digits
215  
-            $m<min> = $m<max> = $m.target.substr($m.to, 1);
  215
+            $m.hash-access('min') = $m.hash-access('max') = $m.target.substr($m.to, 1);
216 216
             ++$m.to;
217 217
             if $m.target.substr($m.to, 2) eq '..' {
218 218
                 $m.to += 2;
219  
-                $m<max> = $m.target.substr($m.to, 1);
  219
+                $m.hash-access('max') = $m.target.substr($m.to, 1);
220 220
                 ++$m.to;
221 221
             }
222 222
             if $brackets {
@@ -237,7 +237,7 @@ class GGE::Perl6Regex {
237 237
         my $wordchars = ($target.substr($m.to) ~~ /^\w+/).Str.chars;
238 238
         my $word = $target.substr($m.to, $wordchars);
239 239
         $m.to += $wordchars;
240  
-        $m<key> = $word;
  240
+        $m.hash-access('key') = $word;
241 241
         $m;
242 242
     }
243 243
 
@@ -246,7 +246,7 @@ class GGE::Perl6Regex {
246 246
     }
247 247
 
248 248
     multi sub perl6exp(GGE::Exp::Modifier $exp is rw, %pad) {
249  
-        my $key = $exp<key>;
  249
+        my $key = $exp.hash-access('key');
250 250
         my $temp = %pad{$key};
251 251
         %pad{$key} = 1; # XXX
252 252
         $exp[0] = perl6exp($exp[0], %pad);
@@ -267,7 +267,7 @@ class GGE::Perl6Regex {
267 267
 
268 268
     multi sub perl6exp(GGE::Exp::Quant $exp is rw, %pad) {
269 269
         $exp[0] = perl6exp($exp[0], %pad);
270  
-        $exp<backtrack> //= %pad<ratchet> ?? NONE !! GREEDY;
  270
+        $exp.hash-access('backtrack') //= %pad<ratchet> ?? NONE !! GREEDY;
271 271
         return $exp;
272 272
     }
273 273
 }
12  t/03-optable.t
@@ -3,7 +3,6 @@ use Test;
3 3
 
4 4
 use GGE::OPTable;
5 5
 use GGE::Match;
6  
-use GGE::Perl6Regex;
7 6
 
8 7
 my GGE::OPTable $optable .= new;
9 8
 
@@ -143,7 +142,7 @@ optable_output_is( '^ abc', 'infix:(term:^(), term:abc)',
143 142
 sub optable_output_is($test, $expected, $msg) {
144 143
     my $output;
145 144
     if $optable.parse($test, :stop(' ;')) -> $match {
146  
-        $output = tree($match<expr>);
  145
+        $output = tree($match.hash-access('expr'));
147 146
         if $match.to != $test.chars {
148 147
             $output ~= " (pos={$match.to})";
149 148
         }
@@ -157,11 +156,10 @@ sub optable_output_is($test, $expected, $msg) {
157 156
 
158 157
 sub tree($match) {
159 158
     return 'null' if !$match;
160  
-    my $r = $match<type>;
161  
-    given $match<type> {
162  
-        # RAKUDO: Removing the semicolon below causes a runtime error
163  
-        when 'term:'   { ; $r ~= $match };
164  
-        when 'term->:' { ; $r ~= $match<ident> };
  159
+    my $r = $match.hash-access('type');
  160
+    given $match.hash-access('type') {
  161
+        when 'term:'   { $r ~= $match }
  162
+        when 'term->:' { $r ~= $match.hash-access('ident') }
165 163
         $r ~= '(' ~ (join ', ', map { tree($_) }, $match.llist) ~ ')';
166 164
     }
167 165
     return $r;
4  t/perl6regex/01-regex.t
@@ -31,10 +31,10 @@ for @test-files -> $test-file {
31 31
         my $full-description = "[$test-file:$i] $description";
32 32
         my $match;
33 33
         my $failed = 1; # RAKUDO: Manual CATCH workaround
34  
-        try {
  34
+#        try {
35 35
             $match = match_perl6regex($pattern, $target);
36 36
             $failed = 0;
37  
-        }
  37
+#        }
38 38
         if $failed {
39 39
             if $result eq 'y'|'n' {
40 40
                 nok 1, $full-description;

0 notes on commit 9256ca6

Please sign in to comment.
Something went wrong with that request. Please try again.