[svn:parrot] r24510 - trunk/languages/perl6/src/parser

[particle]

Author: particle
Date: Thu Jan  3 14:51:41 2008
New Revision: 24510

Modified:
   trunk/languages/perl6/src/parser/actions.pm
   trunk/languages/perl6/src/parser/grammar.pg

Log:
[perl6]: add slurpy, named, optional parameters

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Thu Jan  3 14:51:41 2008
@@ -323,9 +323,9 @@
     my $params := PAST::Stmts.new( :node($/) );
     my $past := PAST::Block.new( $params, :blocktype('declaration') );
     for $/[0] {
-        my $param_var := $($_<param_var>);
-        $past.symbol($param_var.name(), :scope('lexical'));
-        $params.push($param_var);
+        my $parameter := $($_<parameter>);
+        $past.symbol($parameter.name(), :scope('lexical'));
+        $params.push($parameter);
     }
     $past.arity( +$/[0] );
     our $?BLOCK_SIGNATURED := $past;
@@ -333,6 +333,30 @@
 }
 
 
+method parameter($/, $key) {
+    my $past := $( $<param_var> );
+    my $sigil := $<param_var><sigil>;
+    if $key eq 'slurp' {              # slurpy
+        $past.slurpy( $sigil eq '@' || $sigil eq '%' );
+        $past.named( $sigil eq '%' );
+    }
+    else {
+        if $<named> eq ':' {          # named
+            $past.named(~$<param_var><ident>);
+            if $<quant> ne '!' {      #  required (optional is default)
+                $past.viviself('Undef');
+            }
+        }
+        else {                        # positional
+            if $<quant> eq '?' {      #  optional (required is default)
+                $past.viviself('Undef');
+            }
+        }
+    }
+    make $past;
+}
+
+
 method param_var($/) {
     make PAST::Var.new( :name(~$/),
                         :scope('parameter'),

Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg (original)
+++ trunk/languages/perl6/src/parser/grammar.pg Thu Jan  3 14:51:41 2008
@@ -304,10 +304,19 @@
 }
 
 rule signature {
-    ( <param_var> ( ',' | <?before ')' | '{'> ) )*
+    ( <parameter> ( ',' | <?before ')' | '{'> ) )*
     {*}
 }
 
+token parameter {
+    | [
+        $<named>=[':'?]
+        <param_var>
+        $<quant>=[ <[ ? ! ]>? ]
+      ] {*}                                                #= non-slurp
+    | $<quant>=['*'?] <param_var> {*}                      #= slurp
+}
+
 token param_var {
     <sigil> <ident>
     {*}