Changeset 23018 for src

Timestamp:

11/15/08 04:11:54 (8 weeks ago)

Author:

lwall

Message:

[Cursor] more duplicate rule linking
save STD.pm snapshot via storable for booting all other parses faster

Files:

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

src/perl6/Cursor.pmc

@@ -16 +16 @@
 our $DEPTH = 0;
 our %LEXERS;       # per language, the cache of lexers, keyed by rule name
-
-my %HIST;
+our %FATECACHE; # fates we've already turned into linked lists
+our %ANON;      # knowledge about what can be borrowed from supergrammar
+
+#my %HIST;
 
 sub ::init_globals {
@@ -154 +156 @@
         close FILE;
     }
-    $class->new($text)->$rule();
+
+    my $result;
+    if ($STORABLE) {
+        my $store = "lex/STD.pm.store";
+        if (-f $store and -M $file > -M $store) {
+            *::LEXERS = retrieve($store);
+        }
+        $result = $class->new($text)->$rule();
+        if (defined $result and $file eq 'STD.pm') {
+            store(\%::LEXERS, $store);
+        }
+    }
+    else {
+        $result = $class->new($text)->$rule();
+    }
+
 #    for my $key (sort {$HIST{$a} <=> $HIST{$b}} keys(%HIST)) {
 #       warn "$HIST{$key}\t$key\n";
 #    }
+    $result;
 }
 
@@ -256 +274 @@
 }
 
-our %FATECACHE;
-
 sub _AUTOLEXgen { my $self = shift;
     my $key = shift;
@@ -263 +279 @@
 
     my $lang = ref $self;
+    if ($lang =~ /^ANON/) {
+        my $anon = $ANON{$lang};
+        my $super = $anon->{SUP};
+        my $category = $anon->{CAT};
+        print STDERR "AUTOLEXgen $key in $lang from $super without $category\n" if $DEBUG & DEBUG::mixins;
+        my $superlexer = $self->cursor_fresh($super)->_AUTOLEXpeek($key,$retree);
+        my $same = 1;
+        for my $pat (@{$superlexer->{PATS}}) {
+            if ($pat =~ / $category /) {
+                print STDERR "\tNope: $pat\n" if $DEBUG & DEBUG::mixins;
+                $same = 0;
+                last;
+            }
+        }
+        # no need to regen a sublexer that will turn out the same
+        return $superlexer if $same;
+    }
     $self->deb("AUTOLEXgen $key in $lang") if $DEBUG & DEBUG::autolexer;
     my $lexer = {};
@@ -491 +524 @@
                 system "cp $dir/termish.store $dir/EXPR.store";
             }
-            return $lexer;
         }
 
@@ -497 +529 @@
         print $cache $name,"\n";
         print $cache join("\n",@pat),"\n\n" or die "Can't print: $!";
-        print $cache Dump($T) if $T;
+        print $cache Dump($T) if $T and not $STORABLE;
         close($cache) or die "Can't close: $!";
         $self->deb("regenerated $dir/$file") if $DEBUG & DEBUG::autolexer;
@@ -790 +822 @@
         for (;;) {
             if ($state->{'~~'}) {
-                if (not $state->{''}++) {
-                    for (@{$state->{'~~'}}) {
-                        next if /^\d/;
-                        next unless $_;
-                        next if ref $_ eq 'CODE';
-                        our %RXCACHE;
-                        $_ = $RXCACHE{$_} //= eval "sub { \$::ORIG =~ /\\G$_/xsgc }";
-                    }
-                }
+                our %RXCACHE;
                 my @x = @{$state->{'~~'}};
                 while (my ($final,$fnum) = splice(@x,0,2)) {
@@ -805 +829 @@
                         print STDERR $p,"     probing $fnum\n" if $DEBUG & DEBUG::autolexer;
                         pos($::ORIG) = $p;
-                        next unless &$final;
+                        next unless &{$RXCACHE{$final} //= eval "sub { \$::ORIG =~ /\\G$final/xsgc }"};
                         $pend = pos($::ORIG);
                     }
@@ -1057 +1081 @@
     if ($name =~ s/^(\w+):(?=[«<({[])/$1:sym/) {
         my ($sym) = $name =~ /:sym(.*)/;
+
+        # unfortunately p5 doesn't understand q«...»
         if ($sym =~ s/^«(.*)»$/$1/) {
             my $ok = "'";
@@ -1067 +1093 @@
         my $rule = "token $name { <sym> }";
 
+        # produce p5 method name
         my $mangle = $name;
         $mangle =~ s/^(\w*):(sym)?//;
@@ -1086 +1113 @@
         $mangle = $category . '__S_' . sprintf("%03d",$GEN++) . $mangle;
 
-        # XXX assuming no equiv
+        # XXX assuming no equiv specified
         my $coercion = 'Additive';
         if ($name =~ /^prefix:/) {
@@ -1144 +1171 @@
         eval $e or die "Can't create $name: $@\n";
         $::PARSER = $lang->cursor_fresh($genpkg);
+        my $oldlexer = $::LEXERS{$WHAT};
+        my $newlexer = $::LEXERS{$genpkg} //= {};
+        $ANON{$genpkg}{SUP} = $WHAT;
+        $ANON{$genpkg}{CAT} = $category;
+        print STDERR "=====================================\nADD $rule => $mangle\n" if $DEBUG & DEBUG::mixins;;
+        for my $name (sort keys %{$oldlexer}) {
+            print STDERR "  $name:\n" if $DEBUG & DEBUG::mixins;
+            my $same = 1;
+            for my $pat (@{$oldlexer->{$name}->{PATS}}) {
+                if ($pat =~ / $category /) {
+                    print STDERR "\t$pat\n" if $DEBUG & DEBUG::mixins;
+                    $same = 0;
+                    last;
+                }
+            }
+            # no need to regen a sublexer that will turn out the same
+            $newlexer->{$name} = $oldlexer->{$name} if $same;
+        }
     }
     $lang;