Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

rolled back a number of workarounds

Things are starting to work almost as well as, sometimes better than, alpha.
This makes me very happy. :>
  • Loading branch information...
commit 7a46c16f9ea71d235358daf042546912818d607f 1 parent 8677a65
Carl Mäsak authored May 31, 2010
27  lib/GGE/Exp.pm
@@ -172,17 +172,14 @@ class GGE::Exp is GGE::Match {
172 172
 
173 173
     # RAKUDO: [perl #74454]
174 174
     method getargs($label, $next, %hash is copy) {
175  
-        # RAKUDO: Still waiting for hash slices to be brought back
176  
-        # %hash<L S> = $label, $next;
177  
-        %hash<L> = $label;
178  
-        %hash<S> = $next;
  175
+        %hash<L S> = $label, $next;
179 176
         if %hash.exists('quant') {
180 177
             my $quant = %hash<quant>;
181 178
             %hash<m> = $quant<min>;
182 179
             %hash<M> = %hash<m> == 0   ?? '### ' !! '';
183 180
             %hash<n> = $quant<max>;
184 181
             %hash<N> = %hash<n> == Inf ?? '### ' !! '';
185  
-            # RAKUDO: Waiting for named enums for this one
  182
+            # RAKUDO: Waiting for proper named enums for this one
186 183
             # my $bt = ($quant<backtrack>
187 184
             #           // GGE::Exp::Backtracking::GREEDY).name.lc;
188 185
             my $bt = 'no idea';
@@ -226,8 +223,7 @@ class GGE::Exp is GGE::Match {
226 223
                 }
227 224
             }
228 225
         }
229  
-        # RAKUDO: Cannot do multiple returns yet.
230  
-        return ($captgen, $captsave, $captback);
  226
+        return $captgen, $captsave, $captback;
231 227
     }
232 228
 }
233 229
 
@@ -261,7 +257,7 @@ class GGE::Exp::Quant is GGE::Exp {
261 257
         my ($min, $max, $bt) = map { self{$_} },
262 258
                                    <min max backtrack>;
263 259
         $bt //= GGE::Exp::Backtracking::GREEDY;
264  
-        # RAKUDO: Named enums
  260
+        # RAKUDO: Proper named enums
265 261
         # "{$bt.name.lc} $min..$max"
266 262
         "no idea $min..$max"
267 263
     }
@@ -276,10 +272,7 @@ class GGE::Exp::Quant is GGE::Exp {
276 272
             $seplabel = $code.unique('R');
277 273
             $nextlabel = $label ~ '_sep';
278 274
         }
279  
-        # RAKUDO: Hash slices not implemented yet
280  
-        # %args<c C> = 0, '### ';
281  
-        %args<c> = 0;
282  
-        %args<C> = '### ';
  275
+        %args<c C> = 0, '### ';
283 276
         given self<backtrack> {
284 277
             when GGE::Exp::Backtracking::EAGER() {
285 278
                 $code.emit( q[[
@@ -313,10 +306,7 @@ class GGE::Exp::Quant is GGE::Exp {
313 306
             } ]], $replabel, $nextlabel, |%args);
314 307
             }
315 308
             when GGE::Exp::Backtracking::NONE() {
316  
-                # RAKUDO: Hash slices not implemented yet
317  
-                # %args<c C> = $code.unique(), '';
318  
-                %args<c> = $code.unique();
319  
-                %args<C> = '';
  309
+                %args<c C> = $code.unique(), '';
320 310
                 if self<min> != 0
321 311
                    || self<max> != Inf {
322 312
                     proceed;
@@ -665,10 +655,7 @@ class GGE::Exp::CGroup is GGE::Exp::Group {
665 655
         # RAKUDO: [perl #74454]
666 656
         my %args = self.getargs($label, $next, {});
667 657
         my ($captgen, $captsave, $captback) = self.gencapture($label);
668  
-        # RAKUDO: Hash slices not implemented yet
669  
-        # %args<c C> = self<cutmark>, '### ';
670  
-        %args<c> = self<cutmark>;
671  
-        %args<C> = '### ';
  658
+        %args<c C> = self<cutmark>, '### ';
672 659
         %args<X> = self<isscope> ?? '' !! '### ';
673 660
         $code.emit( q[[
674 661
             when '%L' { # capture
8  lib/GGE/Match.pm
@@ -80,14 +80,13 @@ class GGE::Match is Cool {
80 80
     }
81 81
 
82 82
     method Str() {
83  
-        # RAKUDO: Stringification needed due to [perl #73462]
84  
-        (~$!target).substr($!from, $!to - $!from)
  83
+        $!target.substr($!from, $!to - $!from)
85 84
     }
86 85
 
87 86
     method postcircumfix:<{ }>($key) { %!properties{$key} }
88 87
 
89 88
     # RAKUDO: All these can be shortened down to a 'handles' declaration,
90  
-    #         once Rakudo implements 'handles' again.
  89
+    #         once Rakudo implements 'handles' again. [perl #75386]
91 90
     method exists($key) { %!properties.exists($key) }
92 91
     method delete($key) { %!properties.delete($key) }
93 92
     method keys() { %!properties.keys() }
@@ -117,8 +116,7 @@ class GGE::Match is Cool {
117 116
                          && $target.substr($pos, 1) ~~ /\w/;
118 117
             $mob.to = $pos;
119 118
         }
120  
-        # RAKUDO: Putting 'return' here makes Rakudo blow up.
121  
-        $mob;
  119
+        return $mob;
122 120
     }
123 121
 
124 122
     method name() {
14  lib/GGE/OPTable.pm
@@ -3,7 +3,6 @@ use v6;
3 3
 use GGE::Match;
4 4
 
5 5
 class GGE::OPTable {
6  
-    # RAKUDO: Must define these within the class for them to be visible.
7 6
     # RAKUDO: Constants-in-classes broke after a merge. Working around.
8 7
     ##constant GGE_OPTABLE_EXPECT_TERM   = 0x01;
9 8
     ##constant GGE_OPTABLE_EXPECT_OPER   = 0x02;
@@ -78,22 +77,16 @@ class GGE::OPTable {
78 77
 
79 78
         my $keylen = $key.chars;
80 79
         my $key_firstchar = $key.substr(0, 1);
81  
-        # RAKUDO: max=
82  
-        if $key_firstchar && (!%!klen.exists($key_firstchar)
83  
-                              || %!klen{$key_firstchar} < $keylen) {
84  
-            %!klen{$key_firstchar} = $keylen;
85  
-        }
  80
+        %!klen{$key_firstchar} max= $keylen;
86 81
 
87  
-        # RAKUDO: Comma after %opts shouldn't be necessary
88  
-        (%!keys{$key} //= []).push({%opts,});
  82
+        (%!keys{$key} //= []).push({%opts});
89 83
     }
90 84
 
91 85
     method parse($mob, *%opts) {
92 86
         my $m = $mob ~~ GGE::Match ?? GGE::Match.new($mob)
93 87
                                    !! GGE::Match.new(:target($mob), :from(0), :to(0));
94 88
         my $target = $mob ~~ GGE::Match ?? $mob.target !! $mob;
95  
-        # RAKUDO: Stringification needed due to [perl #73462]
96  
-        $target = ~$target;
  89
+        $target = $target;
97 90
         my $pos = $mob ~~ GGE::Match ?? $mob.to !! 0;
98 91
         $m.from = $pos;
99 92
         my $tighter = defined %opts<tighter> && %!tokens.exists(%opts<tighter>)
@@ -106,6 +99,7 @@ class GGE::OPTable {
106 99
         }
107 100
         my $circumnest = 0;
108 101
         my $expect = GGE_OPTABLE_EXPECT_TERM;
  102
+        # RAKUDO: Need to manually clone the closure [perl #73034]
109 103
         my &shift_oper = pir::clone(-> $oper, $token {
110 104
             push @tokenstack, $token;
111 105
             push @operstack, $oper;
38  lib/GGE/Perl6Regex.pm
@@ -118,7 +118,7 @@ class GGE::Perl6Regex {
118 118
                     :parsed(&GGE::Perl6Regex::parse_modifier));
119 119
 
120 120
     method new($pattern, :$debug) {
121  
-        # RAKUDO: Cannot call a sub named 'regex' without the '&'
  121
+        # RAKUDO: Cannot call a sub named 'regex' without the '&' [perl #72438]
122 122
         my $match = &regex($pattern);
123 123
         die 'Perl6Regex rule error: can not parse expression'
124 124
             if $match.to < $pattern.chars;
@@ -139,14 +139,12 @@ class GGE::Perl6Regex {
139 139
     }
140 140
 
141 141
     our sub parse_term($mob) {
142  
-        # RAKUDO: Stringification needed due to [perl #73462]
143  
-        if (~$mob.target).substr($mob.to, 1) ~~ /\s/ {
  142
+        if $mob.target.substr($mob.to, 1) ~~ /\s/ {
144 143
             return parse_term_ws($mob);
145 144
         }
146 145
         my $m = GGE::Exp::Literal.new($mob);
147 146
         my $pos = $mob.to;
148  
-        # RAKUDO: Stringification needed due to [perl #73462]
149  
-        my $target = ~$m.target;
  147
+        my $target = $m.target;
150 148
         while $target.substr($pos, 1) ~~ /\w/ {
151 149
             ++$pos;
152 150
         }
@@ -163,8 +161,7 @@ class GGE::Perl6Regex {
163 161
     our sub parse_term_ws($mob) {
164 162
         my $m = GGE::Exp::WS.new($mob);
165 163
         $m.to = $mob.to;
166  
-        # RAKUDO: Stringification needed due to [perl #73462]
167  
-        $m.to++ while (~$m.target).substr($m.to, 1) ~~ /\s/;
  164
+        $m.to++ while $m.target.substr($m.to, 1) ~~ /\s/;
168 165
         if (~$m.target).substr($m.to, 1) eq '#' {
169 166
             my $delim = "\n";
170 167
             $m.to = defined (~$m.target).index($delim, $m.to)
@@ -265,8 +262,7 @@ class GGE::Perl6Regex {
265 262
 
266 263
     our sub parse_subrule($mob) {
267 264
         my $m = GGE::Exp::Subrule.new($mob);
268  
-        # RAKUDO: Regex::Match doesn't support .substr
269  
-        my $target = ~$mob.target;
  265
+        my $target = $mob.target;
270 266
         my $key = $mob<KEY>;
271 267
         if $key eq '<!' {
272 268
             $m<isnegated> = True;
@@ -278,7 +274,8 @@ class GGE::Perl6Regex {
278 274
         my $cname = $subname;
279 275
         if $target.substr($pos, 1) eq ' ' {
280 276
             $m.to = ++$pos;
281  
-            # RAKUDO: Cannot call a sub named 'regex' without the '&'
  277
+            # RAKUDO: Cannot call a sub named 'regex'
  278
+            #         without the '&' [perl #72438]
282 279
             my $arg = &regex($m, :stop('>'));
283 280
             return $m unless $arg;
284 281
             $m<arg> = ~$arg;
@@ -446,10 +443,9 @@ class GGE::Perl6Regex {
446 443
 
447 444
         my $key = $mob<KEY>;
448 445
         my ($mod2, $mod1);
449  
-        # RAKUDO: Stringification needed due to [perl #73462]
450  
-        given ~$m.target {
451  
-            $mod2   = .substr($mob.to, 2);
452  
-            $mod1   = .substr($mob.to, 1);
  446
+        given $m.target {
  447
+            $mod2 = .substr($mob.to, 2);
  448
+            $mod1 = .substr($mob.to, 1);
453 449
         }
454 450
 
455 451
         $m<min> = 1;
@@ -493,17 +489,17 @@ class GGE::Perl6Regex {
493 489
 
494 490
         if $key eq '**' {
495 491
             # XXX: Should also count ws before quant modifiers -- with tests
496  
-            # RAKUDO: Stringification needed due to [perl #73462]
497  
-            my $sepws = ?((~$m.target).substr($m.to, 1) ~~ /\s/);
498  
-            ++$m.to while (~$m.target).substr($m.to, 1) ~~ /\s/;
499  
-            my $isconst = (~$m.target).substr($m.to, 1) ~~ /\d/;
  492
+            my $sepws = ?($m.target.substr($m.to, 1) ~~ /\s/);
  493
+            ++$m.to while $m.target.substr($m.to, 1) ~~ /\s/;
  494
+            my $isconst = $m.target.substr($m.to, 1) ~~ /\d/;
500 495
             my $sep = !$isconst;
501 496
             if (~$m.target).substr($m.to, 1) eq '{' {
502 497
                 $sep = False;
503 498
                 ++$m.to;
504 499
             }
505 500
             if $sep {
506  
-                # RAKUDO: Cannot call a sub named 'regex' without the '&'
  501
+                # RAKUDO: Cannot call a sub named 'regex'
  502
+                #         without the '&' [perl #72438]
507 503
                 my $repetition_controller = &regex($m, :tighter<infix:>);
508 504
                 die 'perl6regex parse error: Error in repetition controller'
509 505
                     unless $repetition_controller;
@@ -529,9 +525,7 @@ class GGE::Perl6Regex {
529 525
             else {
530 526
                 # XXX: Add test against non-digits inside braces .**{x..z}
531 527
                 # XXX: Need to generalize this into parsing several digits
532  
-                $m<min> = $m<max>
533  
-                # RAKUDO: Stringification needed due to [perl #73462]
534  
-                                      = (~$m.target).substr($m.to, 1);
  528
+                $m<min> = $m<max> = $m.target.substr($m.to, 1);
535 529
                 ++$m.to;
536 530
                 if (~$m.target).substr($m.to, 2) eq '..' {
537 531
                     $m.to += 2;

0 notes on commit 7a46c16

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