if/unless-conditions ok

rakudo · Mar 21, 2013 · 2db8483 · 2db8483
1 parent 7fdfc62
commit 2db8483
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 25 deletions.
diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -314,6 +314,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
         %*LANG<Q-actions>       := Perl6::QActions;
         %*LANG<MAIN>            := Perl6::Grammar;
         %*LANG<MAIN-actions>    := Perl6::Actions;
+        %*LANG<Perl5>           := Perl6::P5Grammar;
+        %*LANG<Perl5-actions>   := Perl6::P5Actions;
 
         # Package declarator to meta-package mapping. Starts pretty much empty;
         # we get the mappings either imported or supplied by the setting. One
@@ -1162,14 +1164,16 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
                     say("P6 use v5");
                     %*LANG<MAIN>         := Perl6::P5Grammar;
                     %*LANG<MAIN-actions> := Perl6::P5Actions;
+                    %*LANG<Perl5>         := Perl6::P5Grammar;
+                    %*LANG<Perl5-actions> := Perl6::P5Actions;
                     %*LANG<Q>            := Perl6::P5QGrammar;
                     %*LANG<Q-actions>    := Perl6::P5QActions;
                     $*ACTIONS            := %*LANG<MAIN-actions>;
                     nqp::rebless($/.CURSOR, %*LANG<MAIN>);
                 }
                 <.ws> ';'
-                [ <statementlist> || <.panic: "Bad P5 code"> ]
-                #[ <statementlist=.LANG('MAIN','statementlist')> || <.panic: "Bad P5 code"> ]
+                #[ <statementlist> || <.panic: "Bad P5 code"> ]
+                [ <statementlist=.LANG('Perl5','statementlist')> || <.panic: "Bad P5 code"> ]
             ]
         || <version>
         || <module_name>

diff --git a/src/Perl6/P5Actions.pm b/src/Perl6/P5Actions.pm
@@ -684,10 +684,10 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
     }
 
     method xblock($/) {
-        make QAST::Op.new( $<EXPR>.ast, $<pblock>.ast, :op('if'), :node($/) );
+        make QAST::Op.new( $<EXPR>.ast, $<sblock>.ast, :op('if'), :node($/) );
     }
 
-    method pblock($/) {
+    method sblock($/) {
         if $<blockoid><you_are_here> {
             make $<blockoid>.ast;
         }
@@ -864,7 +864,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
             $past.op($op);
         }
         else {
-            $past := QAST::Op.new( $<EXPR>.ast, pblock_immediate( $<pblock>.ast ),
+            $past := QAST::Op.new( $<EXPR>.ast, pblock_immediate( $<sblock>.ast ),
                                    :op($op), :node($/) );
         }
         make tweak_loop($past);
@@ -3408,7 +3408,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         %arg{~$<identifier>} := ($*W.add_constant('Int', 'int', 1)).compile_time_value;
         make -> $declarand {
             $*W.apply_trait($/, '&trait_mod:<will>', $declarand,
-                ($<pblock>.ast)<code_object>, |%arg);
+                ($<sblock>.ast)<code_object>, |%arg);
         };
     }
 
@@ -4082,7 +4082,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
 
     method circumfix:sym<{ }>($/) {
         # If it was {YOU_ARE_HERE}, nothing to do here.
-        my $past := $<pblock>.ast;
+        my $past := $<sblock>.ast;
         if ~$/ eq '{YOU_ARE_HERE}' {
             make $past;
             return 1;
@@ -4093,8 +4093,8 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         # Note that if it declares any symbols it is also not one.
         my $Pair := $*W.find_symbol(['Pair']);
         my int $is_hash := 0;
-        my $stmts := +$<pblock><blockoid><statementlist><statement>;
-        my $bast  := $<pblock><blockoid>.ast;
+        my $stmts := +$<sblock><blockoid><statementlist><statement>;
+        my $bast  := $<sblock><blockoid>.ast;
         if $bast.symbol('$_')<used> || $bast<also_uses> && $bast<also_uses><$_> {
             # Uses $_, so not a hash.
         }

diff --git a/src/Perl6/P5Grammar.pm b/src/Perl6/P5Grammar.pm
@@ -951,21 +951,28 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD {
     }
 
     # Look for an expression followed by a required lambda.
-    token xblock {
+    #token xblock {
+    #    :my $*GOAL := '{';
+    #    :dba('block expression') '(' ~ ')' <EXPR>
+    #    <.ws>
+    #    <sblock>
+    #}
+    rule xblock($*IMPLICIT = 0) {
         :my $*GOAL := '{';
-        :dba('block expression') '(' ~ ')' <EXPR>
-        <.ws>
-        <sblock>
+        :dba('block expression')
+        '(' ~ ')' <EXPR>
+        <.ws> <sblock($*IMPLICIT)>
     }
 
-    token sblock {
-        :my $*CURLEX;
+    token sblock($*IMPLICIT = 0) {
+        :my $*DECLARAND := $*W.stub_code_object('Block');
+#        :my $*CURLEX;
         :dba('statement block')
         [ <?before '{' > || <.panic: "Missing block"> ]
         <.newlex>
         <blockoid>
-        { @*MEMOS[self.pos]<endstmt> := 2; }
-        <.ws>
+        #{ @*MEMOS[self.pos]<endstmt> := 2; }
+        #<.ws>
     }
 
     token block {
@@ -987,10 +994,12 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD {
         :my %*HANDLERS;
         <.finishlex>
         [
+        | '{YOU_ARE_HERE}' <you_are_here>
         | :dba('block') '{' ~ '}' <statementlist>
-        | <?terminator> <.panic: 'Missing block'>
+        | <?terminator> { $*W.throw($/, 'X::Syntax::Missing', what =>'block') }
         | <?> <.panic: "Malformed block">
         ]
+        { $*CURPAD := $*W.pop_lexpad() }
     }
 
     # statement semantics
@@ -1157,16 +1166,34 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD {
     }
 
 
+    #rule statement_control:sym<if> {
+    #    $<sym>=['if'|'unless']
+    #    <xblock>
+    #    [
+    #        [ <!before 'else'\s*'if'> || <.panic: "Please use 'elsif'"> ]
+    #        'elsif'<?spacey> <elsif=xblock>
+    #    ]*
+    #    [
+    #        'else'<?spacey> <else=sblock>
+    #    ]?
+    #}
     rule statement_control:sym<if> {
-        $<sym>=['if'|'unless']
+        <sym>
         <xblock>
         [
-            [ <!before 'else'\s*'if'> || <.panic: "Please use 'elsif'"> ]
-            'elsif'<?spacey> <elsif=xblock>
+            [
+            | 'else'\h*'if' <.typed_panic: 'X::Syntax::Malformed::Elsif'>
+            | 'elif' { $/.CURSOR.typed_panic('X::Syntax::Malformed::Elsif', what => "elif") }
+            | 'elsif'\s <xblock>
+            ]
         ]*
-        [
-            'else'<?spacey> <else=sblock>
-        ]?
+        [ 'else'\s <else=.pblock> ]?
+    }
+
+    rule statement_control:sym<unless> {
+        <sym>
+        <xblock>
+        [ <!before 'else'> || <.typed_panic: 'X::Syntax::UnlessElse'> ]
     }
 
     rule statement_control:sym<while> {
@@ -1772,8 +1799,20 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD {
         ]
     }
 
+    #token morename {
+    #    '::' <identifier>?
+    #}
     token morename {
-        '::' <identifier>?
+        :my $*QSIGIL := '';
+        '::'
+        [
+        ||  <?before '(' | <alpha> >
+            [
+            | <identifier>
+            | :dba('indirect name') '(' ~ ')' <EXPR>
+            ]
+        || <?before '::'> <.typed_panic: "X::Syntax::Name::Null">
+        ]?
     }
 
     token subname {