Changeset 21799 for src/perl6

Timestamp:

08/06/08 09:20:46 (4 months ago)

Author:

lwall

Message:

[STD vs t] now passes 99.22%
For parsing sanity, :: is no longer officially a sigil

Location:

src/perl6

Files:

• Cursor.pmc (modified) (1 diff)
• LazyMap.pm (modified) (2 diffs)
• STD.pm (modified) (18 diffs)
• gimme5 (modified) (1 diff)
• teststd (modified) (1 diff)

src/perl6/Cursor.pmc

@@ -2 +2 @@
 use strict;
 use warnings;
+no warnings 'recursion';
 use utf8;
 

src/perl6/LazyMap.pm

@@ -2 +2 @@
 use strict;
 use warnings;
+no warnings 'recursion';
 
 use Exporter;
@@ -47 +48 @@
 
 sub iter {
-    no warnings 'recursion';
     my $self = shift;
     my $lazies = $self->{L};

src/perl6/STD.pm

@@ -410 +410 @@
    | \h* '#' :: [
          |  <?opener> ::
-            [
-               <?after ^^ . > <.panic: "Can't use embedded comments in column 1">
-            || <.quibble($¢.cursor_fresh( ::STD::Q ))>   {*}                               #= embedded
-            ]
+            [ <!after ^^ . > || <.panic: "Can't use embedded comments in column 1"> ]
+            <.quibble($¢.cursor_fresh( ::STD::Q ))>   {*}                               #= embedded
          | :: \N*            {*}                                 #= end
          ]
@@ -735 +733 @@
     { $+prevop = $<O> }
     <.ws>
+}
+
+# (for when you want to tell EXPR that infix already parsed the term)
+token nullterm {
+    <?>
 }
 
@@ -1453 +1456 @@
     [
     || '&' <twigil>?  <sublongname> {*}                                   #= subnoun
+    || <?before '$::('> '$' <name>?
     || '$::' <name>? # XXX
     || '$:' <name>? # XXX
@@ -1476 +1480 @@
 token sigil:sym<%>  { <sym> }
 token sigil:sym<&>  { <sym> }
-token sigil:sym<::> { <sym> }
 
 token twigil:sym<.> { <sym> }
@@ -1488 +1491 @@
 
 token deflongname {
-    <name> <colonpair>*
-    {{
-        if $<colonpair> {
-            $¢ = $¢.add_macro($<name>);
-        }
-    }}
+    <name>
+    [ <colonpair>+ { $¢ = $¢.add_macro($<name>); } ]?
 }
 
@@ -1555 +1554 @@
     <longname>
     <?{
-        $¢.is_type($<longname>.text)
+        my $longname = $<longname>.text;
+        substr($longname, 0, 2) eq '::' or $¢.is_type($longname)
     }>
     # parametric type?
@@ -1730 +1730 @@
     [ <?{ $start ne $stop }> ::
         { $lang = $lang.balanced($start,$stop); }
-        $start <left=nibble($lang)> $stop '=' <right=EXPR(item %item_assignment)>
+        $start <left=nibble($lang)> $stop <.ws> '='<.ws> <right=EXPR(item %item_assignment)>
     || { $lang = $lang.unbalanced($stop); }
         $start <left=nibble($lang)> $stop
@@ -1845 +1845 @@
 token quote:sym</ />   {
     '/' <nibble( $¢.cursor_fresh( ::Regex ).unbalanced("/") )> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ]
-    <old_rx_mods>?
+    <.old_rx_mods>?
 }
 
@@ -1889 +1889 @@
     <sym> » <!before '('>
     <quibble( $¢.cursor_fresh( ::Regex ) )>
-    <old_rx_mods>?
+    <!old_rx_mods>
 }
 
@@ -1895 +1895 @@
     <sym> » <!before '('>
     <quibble( $¢.cursor_fresh( ::Regex ) )>
-    <old_rx_mods>?
+    <!old_rx_mods>
 }
 
@@ -1901 +1901 @@
     <sym> » <!before '('>
     <quibble( $¢.cursor_fresh( ::Regex ).tweak(:s))>
-    <old_rx_mods>?
+    <!old_rx_mods>
 }
 
@@ -1907 +1907 @@
     <sym> » <!before '('>
     <pat=sibble( $¢.cursor_fresh( ::Regex ), $¢.cursor_fresh( ::STD::Q ).tweak(:qq))>
-    <old_rx_mods>?
+    <!old_rx_mods>
 }
 
@@ -1913 +1913 @@
     <sym> » <!before '('>
     <pat=sibble( $¢.cursor_fresh( ::Regex ).tweak(:s), $¢.cursor_fresh( ::STD::Q ).tweak(:qq))>
-    <old_rx_mods>?
+    <!old_rx_mods>
 }
 token quote:tr {
     <sym> » <!before '('> <pat=tribble( $¢.cursor_fresh( ::STD::Q ).tweak(:q))>
-    <old_tr_mods>?
+    <!old_tr_mods>
 }
 
@@ -2582 +2582 @@
 
 ## term
+
+token term:sym<::?IDENT> ( --> Term) {
+    $<sym> = [ '::?' <ident> ] »
+}
+
 token term:sym<undef> ( --> Term) {
     <sym> »
@@ -3764 +3769 @@
 
 method panic (Str $s) {
-    my $m = "############# PARSE FAILED #############";
+    my $m;
     my $here = self;
 
@@ -3790 +3795 @@
     if $highvalid {
         $m ~= $*HIGHMESS if $*HIGHMESS;
+        $*HIGHMESS = $m;
     }
     else {
@@ -3813 +3819 @@
     }
 
-    die $m ~ "\n";
+    die "############# PARSE FAILED #############" ~ $m ~ "\n";
 }
 
@@ -3842 +3848 @@
     my $orig = self.orig;
     my $text = $$orig;
-    while $text ne '' {
+    while $text ne '' { # XXX needs to recognize #line?
         $posprops.[$pos++]<line> = $line;
         $line++ if substr($text,0,1,'') eq "\n";

src/perl6/gimme5

@@ -243 +243 @@
 use strict;
 use warnings;
-no warnings 'qw';
+no warnings 'qw', 'recursion';
 use $extends; # for base class as well as DEBUG constants
 use Moose ':all' => { -prefix => "moose_" };

src/perl6/teststd

@@ -24 +24 @@
 }
 
-print "Passed $success/$total, ", int $success/$total * 100, "%\n";
+printf "Passed $success/$total, %6.2f%%\n", $success/$total * 100;
 print "Failed tests:\n";
 for my $file (@failed) {