Enable pointy blocks.

perl6 · Nov 8, 2009 · 992b220 · 992b220
1 parent 457fa04
commit 992b220
Show file tree

Hide file tree

Showing 3 changed files with 35 additions and 5 deletions.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -179,6 +179,7 @@ method term:sym<scope_declarator>($/)   { make $<scope_declarator>.ast; }
 method term:sym<routine_declarator>($/) { make $<routine_declarator>.ast; }
 method term:sym<regex_declarator>($/)   { make $<regex_declarator>.ast; }
 method term:sym<statement_prefix>($/)   { make $<statement_prefix>.ast; }
+method term:sym<lambda>($/)             { make $<pblock>.ast; }
 
 method colonpair($/) {
     my $past := $<circumfix> 
@@ -347,7 +348,7 @@ method parameter($/) {
         }
         $past.viviself( $<default_value>[0]<EXPR>.ast ); 
     }
-    if $past.viviself { @BLOCK[0].arity( +@BLOCK[0].arity + 1 ); }
+    unless $past.viviself { @BLOCK[0].arity( +@BLOCK[0].arity + 1 ); }
     make $past; 
 }
 

diff --git a/src/NQP/Grammar.pm b/src/NQP/Grammar.pm
@@ -94,11 +94,18 @@ token xblock {
 }
 
 token pblock {
-    [ <?[{]> || <.panic: 'Missing block'> ]
-    <.newpad>
-    <blockoid>
+    | <.lambda>
+        <.newpad>
+        <signature>
+        <blockoid>
+    | <?[{]> 
+        <.newpad>
+        <blockoid>
+    | <.panic: 'Missing block'>
 }
 
+token lambda { '->' | '<->' }
+
 token block {
     [ <?[{]> || <.panic: 'Missing block'> ]
     <.newpad>
@@ -180,6 +187,7 @@ token term:sym<scope_declarator>   { <scope_declarator> }
 token term:sym<routine_declarator> { <routine_declarator> }
 token term:sym<regex_declarator>   { <regex_declarator> }
 token term:sym<statement_prefix>   { <statement_prefix> }
+token term:sym<lambda>             { <?lambda> <pblock> }
 
 token colonpair {
     ':' 
@@ -368,6 +376,9 @@ token nulltermish {
     | <?>
 }
 
+token infixish { <!infixstopper> <OPER=infix=infix> }
+token infixstopper { <?lambda> }
+
 token postcircumfix:sym<[ ]> { 
     '[' <.ws> <EXPR> ']' 
     <O('%methodop')>
@@ -401,7 +412,7 @@ token infix:sym<**>   { <sym>  <O('%exponentiation, :pirop<pow>')> }
 
 token prefix:sym<+>   { <sym>  <O('%symbolic_unary, :pirop<set N*>')> }
 token prefix:sym<~>   { <sym>  <O('%symbolic_unary, :pirop<set S*>')> }
-token prefix:sym<->   { <sym>  <O('%symbolic_unary, :pirop<neg>')> }
+token prefix:sym<->   { <sym>  <![>]> <O('%symbolic_unary, :pirop<neg>')> }
 token prefix:sym<?>   { <sym>  <O('%symbolic_unary, :pirop<istrue>')> }
 token prefix:sym<!>   { <sym>  <O('%symbolic_unary, :pirop<isfalse>')> }
 

diff --git a/t/nqp/39-pointy.t b/t/nqp/39-pointy.t
@@ -0,0 +1,18 @@
+#! nqp
+
+plan(6);
+
+my $count := 1;
+
+my $x := -> $a, $b { ok($a == $count++, $b); }
+
+$x(1, 'basic pointy block');
+
+my $y := -> $a, $b = 2 { ok($b == $count++, $a); }
+
+$y('pointy block with optional');
+
+$y('pointy block with optional + arg', 3);
+
+for <4 pointy4 5 pointy5 6 pointy6> -> $a, $b { ok($a == $count++, $b); }
+