Changeset 22532 for src/perl6

Timestamp:

10/08/08 08:49:33 (6 weeks ago)

Author:

lwall

Message:

[STD] switch to '(' ~ ')' <foo> format for readability and better errors
[gimme5] support for ~ construct and :dba<>

Location:

src/perl6

Files:

• STD.pm (modified) (31 diffs)
• gimme5 (modified) (11 diffs)

src/perl6/STD.pm

@@ -453 +453 @@
     :my $startpos = self.pos;
 
+    :dba<simple whitespace>
     [
         | \h+ <![#\s\\]> { $¢.<_>[$¢.pos]<ws> = $startpos; }    # common case
@@ -460 +461 @@
     ]
     ||
+    :dba<complicated whitespace>
     [
     | <.unsp>
@@ -585 +587 @@
 
 token block {
-    '{' <in: '}', 'statementlist', 'block'>
+    '{' ~ '}' <statementlist>
 
     [
@@ -593 +595 @@
     | <.unv>? $$ <.ws>
         { $¢.<_>[$¢.pos]<endstmt> = 2; } {*}                    #= endstmt complex
-    | {*} { $¢.<_>[$¢.pos]<endargs> = 1; }                      #= endargs
+    | { $¢.<_>[$¢.pos]<endargs> = 1; } <.ws> {*}                #= endargs
     ]
 }
@@ -619 +621 @@
     | <.unv>? $$ <.ws>
         { $¢.<_>[$¢.pos]<endstmt> = 2; } {*}                    #= endstmt complex
-    | {*} { $¢.<_>[$¢.pos]<endargs> = 1; }                      #= endargs
+    | { $¢.<_>[$¢.pos]<endargs> = 1; } <.ws>  {*}               #= endargs
     ]
 }
@@ -667 +669 @@
     | <statement_control>                        {*}            #= control
     | <EXPR> {*}                                                #= expr
+        :dba<statement end>
         [
         || <?{ ($¢.<_>[$¢.pos]<endstmt> // 0) == 2 }>   # no mod after end-line curly
         ||
+            :dba<statement modifier>
             [
             | <statement_mod_loop> {*}                              #= mod loop
             | <statement_mod_cond> {*}                              #= mod cond
+                :dba<statement modifier loop>
                 [
                 || <?{ ($¢.<_>[$¢.pos]<endstmt> // 0) == 2 }>
@@ -696 +701 @@
 }
 
-rule statement_control:use {\
-    <sym>
+token statement_control:use {
+    <sym> :s
     [
     | <version>
@@ -709 +714 @@
 
 
-rule statement_control:no {\
-    <sym>
+token statement_control:no {
+    <sym> :s
     <module_name><arglist>?
 }
 
 
-rule statement_control:if {\
-    <sym>
+token statement_control:if {
+    <sym> :s
     <xblock>
     $<elsif> = (
@@ -727 +732 @@
 
 
-rule statement_control:unless {\
-    <sym> 
+token statement_control:unless {
+    <sym> :s
     <xblock>
     [ <!before 'else'> || <.panic: "unless does not take \"else\" in Perl 6; please rewrite using \"if\""> ]
@@ -734 +739 @@
 
 
-rule statement_control:while {\
-    <sym>
+token statement_control:while {
+    <sym> :s
     [ <?before '(' ['my'? '$'\w+ '=']? '<' '$'?\w+ '>' ')'>   #'
         <.panic: "This appears to be Perl 5 code"> ]?
@@ -742 +747 @@
 
 
-rule statement_control:until {\
-    <sym>
+token statement_control:until {
+    <sym> :s
     <xblock>
 }
 
 
-rule statement_control:repeat {\
-    <sym>
+token statement_control:repeat {
+    <sym> :s
     [
         | ('while'|'until')
@@ -759 +764 @@
 
 
-rule statement_control:loop {\
-    <sym>
+token statement_control:loop {
+    <sym> :s
     $<eee> = (
         '('
@@ -772 +777 @@
 
 
-rule statement_control:for {\
-    <sym>
+token statement_control:for {
+    <sym> :s
     [ <?before 'my'? '$'\w+ '(' >
         <.panic: "This appears to be Perl 5 code"> ]?
@@ -779 +784 @@
 }
 
-rule statement_control:given {\
-    <sym>
+token statement_control:given {
+    <sym> :s
     <xblock>
 }
-rule statement_control:when {\
-    <sym>
+token statement_control:when {
+    <sym> :s
     <xblock>
 }
@@ -936 +941 @@
         ]
         {*}                                                     #= value
-    | '(' <in: ')', 'signature'>
+    | :dba<signature> '(' ~ ')' <signature>
     | <postcircumfix>
         { $key = ""; $value = $<postcircumfix>; }
@@ -1109 +1114 @@
 
 token postcircumfix:sym<( )> ( --> Methodcall)
-    { '(' <in: ')', 'semilist', 'argument list'> }
+    { :dba<argument list> '(' ~ ')' <semilist> }
 
 token postcircumfix:sym<[ ]> ( --> Methodcall)
-    { '[' <in: ']', 'semilist', 'subscript'> }
+    { :dba<subscript> '[' ~ ']' <semilist> }
 
 token postcircumfix:sym<{ }> ( --> Methodcall)
-    { '{' <in: '}', 'semilist', 'subscript'> }
+    { :dba<subscript> '{' ~ '}' <semilist> }
 
 token postcircumfix:sym«< >» ( --> Methodcall)
@@ -1140 +1145 @@
 
     [
-    | '.'? <.unsp>? '(' <in: ')', 'semilist', 'argument list'>
+    | '.'? <.unsp>? '(' ~ ')' <semilist>
     | ':' <?before \s> <!{ $+inquote }> <arglist>
     ]?
@@ -1166 +1171 @@
         <.unsp>?
         [
-        | '(' <in: ')', 'signature'>
-        | '[' <in: ']', 'semilist', 'shape definition'>
-        | '{' <in: '}', 'semilist', 'shape definition'>
+        | '(' ~ ')' <signature>
+        | :dba<shape definition> '[' ~ ']' <semilist>
+        | :dba<shape definition> '{' ~ '}' <semilist>
         | <?before '<'> <postcircumfix>
         ]*
@@ -1289 +1294 @@
     [
     | <variable_declarator>
-    | '(' <in: ')', 'signature'> <trait>*
+    | '(' ~ ')' <signature> <trait>*
     | <routine_declarator>
     | <regex_declarator>
@@ -1648 +1653 @@
         [
         | <identifier>
-        | '(' <in: ')', 'EXPR', 'indirect name'>
+        | :dba<indirect name> '(' ~ ')' <EXPR>
         ]
     ]?
@@ -1667 +1672 @@
 #token subcall {
 #    # XXX should this be sublongname?
-#    <subshortname> <.unsp>? '.'? '(' <in: ')', 'semilist'>
+#    <subshortname> <.unsp>? '.'? '(' ~ ')' <semilist>
 #    {*}
 #}
@@ -2460 +2465 @@
 rule multisig {
     [
-        ':'?'(' <in: ')', 'signature'>
+        ':'?'(' ~ ')' <signature>
     ]
     ** '|'
@@ -2480 +2485 @@
     | <sigil> '.'
         [
-        | '(' <in: ')', 'signature'>
-        | '[' <in: ']', 'signature'>
-        | '{' <in: '}', 'signature'>
+        | '(' ~ ')' <signature>
+        | '[' ~ ']' <signature>
+        | '{' ~ '}' <signature>
         | <?before '<'> <postcircumfix>
         ]
@@ -2545 +2550 @@
 
 token sigterm {
-    ':(' <in: ')', 'signature'>
+    ':(' ~ ')' <signature>
 }
 
@@ -2564 +2569 @@
 }
 
-rule type_declarator:subset {\
-    <sym>
+token type_declarator:subset {
+    <sym> :s
     <longname> { $¢.add_type($<longname>); }
     [ of <fulltypename> ]?
@@ -2772 +2777 @@
 
 token circumfix:sigil ( --> Term)
-    { <sigil> '(' <in: ')', 'semilist', 'contextualizer'> }
+    { :dba<contextualizer> <sigil> '(' ~ ')' <semilist> }
 
 #token circumfix:typecast ( --> Term)
-#    { <typename> '(' <in: ')', 'semilist'> }
+#    { <typename> '(' ~ ')' <semilist> }
 
 token circumfix:sym<( )> ( --> Term)
-    { '(' <in: ')', 'semilist', 'parenthesized expression'> }
+    { :dba<parenthesized expression> '(' ~ ')' <semilist> }
 
 token circumfix:sym<[ ]> ( --> Term)
-    { '[' <in: ']', 'semilist', 'array composer'> }
+    { :dba<array composer> '[' ~ ']' <semilist> }
 
 ## methodcall
@@ -3168 +3173 @@
     { <sym> }
 
+token infix:sym<...> ( --> List_infix)
+    { <sym> }
+
 token term:sym<...> ( --> List_prefix)
     { <sym> <args>? }
@@ -3202 +3210 @@
     :my $listopish = 0;
     [
-    | '.(' <in: ')', 'semilist', 'argument list'> {*}             #= func args
-    | '(' <in: ')', 'semilist', 'argument list'> {*}              #= func args
-    | <.unsp> '.'? '(' <in: ')', 'semilist', 'argument list'> {*} #= func args
+    | :dba<argument list> '.(' ~ ')' <semilist> {*}             #= func args
+    | :dba<argument list> '(' ~ ')' <semilist> {*}              #= func args
+    | :dba<argument list> <.unsp> '.'? '(' ~ ')' <semilist> {*} #= func args
     | {} [<?before \s> <!{ $istype }> <.ws> <!infixstopper> <arglist> { $listopish = 1 }]?
     ]
@@ -3742 +3750 @@
         <!before '$$'>
         <?before <sigil>>
-        [:lang($¢.cursor_fresh($+LANG)) <variable>]
-        <.ws>
-        $<binding> = ( '=' <.ws> <quantified_atom> )?
+        [:lang($¢.cursor_fresh($+LANG)) <variable> <.ws> ]
+        $<binding> = ( <.ws> '=' <.ws> <quantified_atom> )?
         { $<sym> = $<variable>.item; }
+    }
+
+    token metachar:sym<~> {
+        <sym>
     }
 
@@ -3846 +3857 @@
     }
 
-    token mod_arg { '(' <in: ')', 'semilist', 'modifier argument'> }
+    token mod_arg { :dba<modifier argument> '(' ~ ')' <semilist> }
 
     token mod_internal:sym<:my>    { ':' <?before 'my' \s > [:lang($¢.cursor_fresh($+LANG)) <statement> <eat_terminator> ] }
@@ -4163 +4174 @@
 }
 
-# not quite a "between" combinator...
-token in (Str $stop, Str $insides, Str $name = $insides) {
-    :my $GOAL is context = $stop;
-    <x=$insides> $stop {{ $/.{$insides} = $<x>; $/.:delete<x> }} || <.panic: "Unable to parse $name; couldn't find final '$stop'">
+method SETGOAL { }
+method FAILGOAL (Str $stop, Str $name) {
+    self.panic("Unable to parse $name; couldn't find final '$stop'");
 }
 

src/perl6/gimme5

@@ -39 +39 @@
 our $PURE;
 our $MAYBACKTRACK;
+our @STUFFED;
 our @DECL;
 our $SYM;
@@ -460 +461 @@
 
             local $MAYBACKTRACK = 1;
+            $adverbs{r} = 0;
+            $adverbs{s} = 0;
+            $adverbs{dba} = $NAME;
             if ($KIND eq 'token' or $KIND eq 'rule') {
                 $MAYBACKTRACK = 0;
+                $adverbs{r} = 1;
+                if ($KIND eq 'rule') {
+                    $adverbs{s} = 1;
+                }
             }
 
@@ -924 +932 @@
 
 sub ws {
-    return if $KIND eq 'rule';  # meta whitespace parsed in atom
+    return if $adverbs{s};  # meta whitespace parsed in atom
     for (;;) {
 #       next if s/^(?!=[\0-~])\s+//;
@@ -954 +962 @@
     ws();
     local $STOP = shift;
+    local %adverbs = %adverbs;
 
     my @decl;
@@ -1103 +1112 @@
         my $min = 0;
         if (not $m) {
-            if ($KIND eq 'rule' or $KIND eq 'token') {
+            if ($adverbs{r}) {
                 $m = ':';
             }
@@ -1141 +1150 @@
 sub atom {
     here();
+    if (@STUFFED) {
+        return shift @STUFFED;
+    }
+    # unspace
     if (s/^\\\s/ /) {
-        wsany();
-    }
-    if (/^[\s\#]/ and $KIND eq 'rule') {
+        panic("Attempt to quote whitespace");
+    }
+    # sigspace
+    if (/^[\s\#]/ and $adverbs{s}) {
         wsany();
         return bless { name => 'ws', nobind => 1, noquant => 1, min => 0, rest => '' },
@@ -1159 +1173 @@
     if (/^[*+?]/) { panic "quantifier quantifies nothing"; }
 
+    if (s/^~//) {
+        wsany();
+        my $beg = length($all) - length($_);
+        my $goal = quantified_atom();
+        my $end = length($all) - length($_);
+        my $goaltext = substr($all, $beg, $end - $beg);
+
+        my $dba = $adverbs{dba} // $NAME;
+        $dba =~ s/'/\\\'/g;
+        my $failgoal = bless { name => 'FAILGOAL', rest => "($goaltext, '$dba')", min => 0, nobind => 1 }, "RE_method";
+        my $check = bless { zyg => [$goal, $failgoal], min => 1, %adverbs}, "RE_first";
+        my $checkbrack = bless({ decl => [], re => $check, min => 1 }, "RE_bracket");
+
+        wsany();
+
+        my $nest = quantified_atom();
+
+        @STUFFED = ($nest, $checkbrack);
+        return bless { text => '::', min => 0, extra => "local \$::GOAL = $goaltext", %adverbs }, "RE_meta";
+    }
     if (s/^ (\w+) (?! \s* [*+?]) //x) {
         my $word = $1;
@@ -1211 +1245 @@
         my $not = $1 ne '';
         my $adverb = $2;
-        local %adverbs = %adverbs;
+        $adverb =~ s/^sigspace/s/;
+        $adverb =~ s/^ratchet/r/;
         
         if (m/^\(/) {
@@ -1224 +1259 @@
             }
         }
+        elsif (s/^<(.*?)>//) {
+            $adverbs{$adverb} = $1;
+        }
         else {
             $adverbs{$adverb} = 0+!$not;
@@ -1784 +1822 @@
         elsif ($text eq '::') {
             $PURE = 0;
-            $code = "\$C->_COMMITBRANCH$REV()";
+            my $extra = $self->{extra} || '';
+            $code = "\$C->_COMMITBRANCH$REV($extra)";
             $MAYBACKTRACK = 1;
         }
@@ -1876 +1915 @@
         my $rest = ::un6($$self{rest}) // '';
         my $name = $$self{name};
+        warn ::Dump(%adverbs) if $REV;
         ::panic("Can't reverse $name") if $REV;
         $PURE = 0 if $impure{$name};