Changeset 22986 for src

Timestamp:

11/12/08 03:17:12 (8 weeks ago)

Author:

lwall

Message:

[Cursor] factor out fate linked list generation from "ch2" code so we can

refer to fates by number later when we are more dfa-ish.

Files:

• src/perl6/Cursor.pmc (modified) (8 diffs)

src/perl6/Cursor.pmc

@@ -266 +266 @@
         $self->deb("using cached $dir/$file") if $DEBUG & DEBUG::autolexer;
 
-        my @pat = <LEX>;
-        chomp(@pat);
-        $name = shift @pat;
+        chomp($name = <LEX>);
+        local $/ = "";
+        my @para = <LEX>;
         close LEX;
         my %lexer;
@@ -274 +274 @@
         $lexer{DBA} = $dba;
         $lexer{FILE} = "$dir/$file";
+        my @pat = split(/\n/, $para[0]);
         $lexer{PATS} = \@pat;
+        my $fates;
+        my $i = 0;
+        for (@pat) {
+            s/\(\?#FATE\d* +(.*?)\)/(?#FATE$i $1)/;
+            my $fstr = $1;
+            my $fate = $fates->[$i] = [0,0,0,$fstr];
+            while ($fstr =~ s/(\S+)\s+(\S+)\s*//) {
+                $fate->[0] = $1;
+                $fate->[1] = $2;
+                $fate = $fate->[2] = [0,0,0,$fstr] if $fstr ne '';
+            }
+            $i++;
+        }
+        $lexer{FATES} = $fates;
+
+#       if (@para > 0 and $para[1]) {
+#           for (split(/\n/, $para[1])) {}
+#       }
 
         return \%lexer;
@@ -304 +323 @@
                                 for my $alt (@alts) {
                                     $alt .= "\t(?#FATE)" unless $alt =~ /FATE/;
-                                    $alt =~ s/\(\?#FATE/(?#FATE $proto ${class}::$method/;
+                                    $alt =~ s/\(\?#FATE\d*/(?#FATE $proto ${class}::$method/;
                                     $altnum++;
                                 }
@@ -321 +340 @@
             s/(\(\?#::\))+/(?#::)/;
         }
+        my $fates;
+        my $i = 0;
+        for (@pat) {
+            my $fstr;
+            if ( s/\(\?#FATE\d* +(.*?)\)/(?#FATE$i $1)/) {
+                $fstr = $1;
+            }
+            else {
+                $_ .= "\t(?#FATE$i )";
+                $fstr = "";
+            }
+            my $fate = $fates->[$i] = [0,0,0,$fstr];
+            while ($fstr =~ s/(\S+)\s+(\S+)\s*//) {
+                $fate->[0] = $1;
+                $fate->[1] = $2;
+                $fate = $fate->[2] = [0,0,0,$fstr] if $fstr ne '';
+            }
+            $i++;
+        }
         warn "(null pattern for $key)" unless @pat;
         my $pat = join("\n", @pat);
@@ -326 +364 @@
         $AUTOLEXED{$key} = $oldfakepos;
 
-        $lexer = { "NAME" => $name, "FILE" => "$dir/$file", "PATS" => [@pat], "DBA" => $dba};
+        $lexer = { "NAME" => $name, "FILE" => "$dir/$file", "PATS" => [@pat], "FATES" => $fates, "DBA" => $dba};
 
         return $lexer if $lang =~ /ANON/;
@@ -685 +723 @@
             my $i = 0;
             my $fates = [];
-            if (@pats > 500) {
-                print "Too many patterns for $ch2 file $file\n";
-            }
-            for (@pats) {
-                s/\(\?#FATE +(.*?)\)/(?#$i FATE $1)/;
-                my $fstr = $1;
-                my $fate = $fates->[$i] = [0,0,0,$fstr];
-                while ($fstr =~ s/(\S+)\s+(\S+)\s*//) {
-                    $fate->[0] = $1;
-                    $fate->[1] = $2;
-                    $fate = $fate->[2] = [0,0,0,$fstr] if $fstr ne '';
-                }
-                $i++;
-            }
+            my $FATES = $lexer->{FATES};
 
             for my $pat (@pats) {
-                $pat =~ s/\(\?#.*?\)//g;
-                $pat =~ s/\s+//g;
-                $pat =~ s/:://g;
+                $pat =~ s/\t\(\?#FATE(\d+).*?\)// or die "Malformed fate";
+                $fates->[$i++] = $FATES->[$1];
             }
 
@@ -2151 +2175 @@
             if ($PREFIX) {
                 for (@pat) {
-                    s/(\t\(\?#FATE) *(.*?\))(.*)/$3$1$PREFIX $2/g;
+                    s/(\t\(\?#FATE)\d* *(.*?\))(.*)/$3$1$PREFIX $2/g;
                 }
             }
@@ -2316 +2340 @@
                         my $newold = $oldalt;
                         my $newnew = $newalt;
-                        $newnew =~ s/\t\(\?#FATE *(.*?)\)//;
+                        $newnew =~ s/\t\(\?#FATE\d* *(.*?)\)//;
                         my $morefate = $1;
                         $newold =~ s/(FATE.*?)\)/$1 $morefate)/;