[svn:parrot] r35168 - branches/rvar2/languages/perl6/src/parser

[jonathan]

Author: jonathan
Date: Wed Jan  7 11:16:41 2009
New Revision: 35168

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

Log:
[rakudo] First cut at getting constraint types working in signatures again. 
Still much to do, but and probably some cleanups of the sub that I have brought 
back into use again too.

Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm        (original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm        Wed Jan  7 
11:16:41 2009
@@ -1002,6 +1002,15 @@
     if $<fulltypename> {
         $past := $( $<fulltypename> );
     }
+    else {
+        $past := make_subset_type($( $<EXPR> ));
+    }
+    make $past;
+}
+
+
+method post_constraint($/) {
+    my $past := make_anon_subtype($( $<EXPR> ));
     make $past;
 }
 
@@ -1061,6 +1070,11 @@
             }
         }
     }
+    if $<post_constraint> {
+        for @($<post_constraint>) {
+            $typelist.push($( $_ ));
+        }
+    }
 
     if $<trait> {
         my $traitlist := PAST::Op.new( :name('infix:,'), :pasttype('call') );
@@ -2527,10 +2541,9 @@
 }
 
 # Creates an anonymous subset type.
-sub make_anon_subset($past, $parameter) {
+sub make_anon_subtype($past) {
     # We need a block containing the constraint condition.
     if !$past.isa(PAST::Block) {
-        # Make block with the expression as its contents.
         $past := PAST::Block.new(
             PAST::Stmts.new(),
             PAST::Stmts.new( $past )
@@ -2553,31 +2566,16 @@
     unless $param {
         if $dollar_underscore {
             $dollar_underscore.scope('parameter');
-            $param := $dollar_underscore;
         }
         else {
-            $param := PAST::Var.new(
+            $past[0].push(PAST::Var.new(
                 :name('$_'),
                 :scope('parameter')
-            );
-            $past[0].push($param);
+            ));
         }
     }
 
-    # Now we'll just pass this block to the type checker,
-    # since smart-matching a block invokes it.
-    return PAST::Op.new(
-        :pasttype('call'),
-        :name('!TYPECHECKPARAM'),
-        PAST::Op.new(
-            :pirop('newclosure'),
-            $past
-        ),
-        PAST::Var.new(
-            :name($parameter.name()),
-            :scope('lexical')
-        )
-    );
+    return $past;
 }
 
 

Modified: branches/rvar2/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/grammar.pg        (original)
+++ branches/rvar2/languages/perl6/src/parser/grammar.pg        Wed Jan  7 
11:16:41 2009
@@ -465,7 +465,7 @@
 }
 
 rule post_constraint {
-    where <EXPR: 'm='>                 # XXX <EXPR(item %chaining)>
+    where <EXPR: 'm='> {*}             # XXX <EXPR(item %chaining)>
 }
 
 token param_var {