Changeset 22891 for src

Timestamp:

11/06/08 04:36:43 (2 months ago)

Author:

lwall

Message:

[gimme5] more lexer call refactoring to avoid duplication

Location:

src/perl6

Files:

• Cursor.pmc (modified) (3 diffs)
• gimme5 (modified) (4 diffs)

src/perl6/Cursor.pmc

@@ -577 +577 @@
     my $tag;
     my $try;
-    my $relex;
     
     my $lexer = $self->lexers->{$name} // do {
@@ -600 +599 @@
     my $ch2 = $1;
 
-    $relex = $lexer->{$ch2} //= do {
+    return $lexer->{$ch2} //= do {
         my @pats;
         my $file = $lexer->{FILE} . '__' . ::mangle($ch2);
@@ -831 +830 @@
     };
 
-    if (my $fate = $relex->($self,$_[0])) {
-        $self->deb("FATE OF ${pkg}::$name: $$fate[3]") if $DEBUG & DEBUG::fates;
-        ($tag, $try, $fate) = @$fate;
-        $self->{_fate} = $fate;
-    }
-    else {
-        $self->deb("NO FATE FOR ${pkg}::$name (will probe)") if $DEBUG & DEBUG::fates;
-        $tag = '';
-    }
-    return $tag, $try, $relex;
 }
 

src/perl6/gimme5

@@ -331 +331 @@
     my \@result = eval {
         my \$trystate;
-        my (\$tag, \$try, \$relex);
+        my (\$tag, \$try);
         my \@try;
+        my \$relex;
         if (my \$fate = \$C->{_fate}) {
             if (\$fate->[0] eq '$name') {
@@ -341 +342 @@
             }
         }
-        else {
-            (\$tag, \$try, \$relex) = \$C->cursor_fate('$PKG', '$name:*', \$retree, \$trystate);
-            \@try = (\$try,\$relex) if \$tag;
-        }
 
         my \@gather = ();
-        while (\@try) {
-            my \$try = shift(\@try) // next;
+        for (;;) {
+            if (not \@try) {
+                \$relex //= \$C->cursor_fate('$PKG', '$name:*', \$retree);
+                \@try = \$relex->(\$C, \$trystate);
+            }
+            last unless \@try;
+            \$try = shift(\@try) // next;
     
-            # if first try failed, interrogate lexer for shorter answers
-            if (ref \$try) {
-                if (ref \$try eq 'ARRAY') {
-                    (\$tag, \$try, \$C->{_fate}) = \@\$try;     # next candidate fate
-                    \$C->deb("Retrying with \$tag \$try") if \$::DEBUG & DEBUG::try_processing;
-                }
-                elsif (ref \$try eq 'CODE') {
-                    my \@more = \$relex->(\$C, \$trystate);
-                    if (\@more) {
-                        unshift \@try, \@more, \$relex;   # ask relex for more
-                    }
-                    next;
-                }
-            }
+            if (ref \$try eq 'ARRAY') {
+                (\$tag, \$try, \$C->{_fate}) = \@\$try; # next candidate fate
+            }
     
             \$C->deb("$name trying \$tag \$try") if \$::DEBUG & DEBUG::try_processing;
@@ -2490 +2481 @@
   my \@result = eval {
     my \$trystate;
-    my (\$tag, \$try, \$relex);
+    my (\$tag, \$try);
     my \@try;
+    my \$relex;
+
     my \$fate;
     if (\$fate = \$C->{_fate} and \$fate->[0] eq '$altname') {
@@ -2499 +2492 @@
         \@try = (\$try);
     }
-    else {
-        (\$tag, \$try, \$relex) = \$C->cursor_fate('${PKG}', '$altname', \$retree, \$trystate);
-$policy
-    }
-END
-
-            $result .= <<'END';
-    my @gather = ();
-    while (@try) {
-        my $try = shift(@try) // next;
-
-        # if first try failed, interrogate lexer for shorter answers
-        if (ref $try) {
-            if (ref $try eq 'ARRAY') {
-                ($tag, $try, $C->{_fate}) = @$try;      # next candidate fate
-                $C->deb("Retrying with $tag $try") if $::DEBUG & DEBUG::try_processing;
-            }
-            elsif (ref $try eq 'CODE') {
-                my @more = $relex->($C, $trystate);
-                if (@more) {
-                    unshift @try, @more, $relex;   # ask relex for more
-                }
-                next;
-            }
-        }
-
-END
-
-            $result .= <<"END";
+
+    my \@gather = ();
+    for (;;) {
+        if (not \@try) {
+            \$relex //= \$C->cursor_fate('$PKG', '$altname', \$retree);
+            \@try = \$relex->(\$C, \$trystate);
+        }
+        last unless \@try;
+        \$try = shift(\@try) // next;
+
+        if (ref \$try eq 'ARRAY') {
+            (\$tag, \$try, \$C->{_fate}) = \@\$try;     # next candidate fate
+        }
+
         \$C->deb("$altname trying \$tag \$try") if \$::DEBUG & DEBUG::try_processing;
         push \@gather, ((