Author: jonathan
Date: Tue Aug 12 08:05:21 2008
New Revision: 30183
Modified:
trunk/languages/perl6/src/parser/actions.pm
trunk/languages/perl6/src/parser/grammar.pg
Log:
[rakudo] Fix type constraints declared with where that access lexicals in outer
scopes, and make post constraints parse and work.
Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm (original)
+++ trunk/languages/perl6/src/parser/actions.pm Tue Aug 12 08:05:21 2008
@@ -1003,54 +1003,7 @@
);
}
else {
- # We need a block containing the constraint condition.
- my $past := $( $_<EXPR> );
- if $past.WHAT() ne 'Block' {
- # Make block with the expression as its contents.
- $past := PAST::Block.new(
- PAST::Stmts.new(),
- PAST::Stmts.new( $past )
- );
- }
-
- # Make sure it has a parameter.
- my $param;
- my $dollar_underscore;
- for @($past[0]) {
- if $_.WHAT() eq 'Var' {
- if $_.scope() eq 'parameter' {
- $param := $_;
- }
- elsif $_.name() eq '$_' {
- $dollar_underscore := $_;
- }
- }
- }
- unless $param {
- if $dollar_underscore {
- $dollar_underscore.scope('parameter');
- $param := $dollar_underscore;
- }
- else {
- $param := 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.
- $type_obj := PAST::Op.new(
- :pasttype('call'),
- :name('!TYPECHECKPARAM'),
- $past,
- PAST::Var.new(
- :name($parameter.name()),
- :scope('lexical')
- )
- );
+ $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
}
# Add it to the types list.
@@ -1058,6 +1011,12 @@
}
}
+ # Add any post-constraints too.
+ for $_<parameter><post_constraint> {
+ my $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
+ $cur_param_types.push($type_obj);
+ }
+
# For blocks, we just collect the check into the list of all checks.
unless $?SIG_BLOCK_NOT_NEEDED {
$type_check.push($cur_param_types);
@@ -3050,7 +3009,7 @@
$past.blocktype('declaration');
set_block_proto($past, 'Sub');
if $<routine_def><multisig> {
- set_block_sig($past, $( $<routine_def><multisig>[0]<signature> ));
+ #set_block_sig($past, $( $<routine_def><multisig>[0]<signature> ));
}
}
@@ -3235,6 +3194,60 @@
}
}
+# Creates an anonymous subset type.
+sub make_anon_subset($past, $parameter) {
+ # We need a block containing the constraint condition.
+ if $past.WHAT() ne 'Block' {
+ # Make block with the expression as its contents.
+ $past := PAST::Block.new(
+ PAST::Stmts.new(),
+ PAST::Stmts.new( $past )
+ );
+ }
+
+ # Make sure it has a parameter.
+ my $param;
+ my $dollar_underscore;
+ for @($past[0]) {
+ if $_.WHAT() eq 'Var' {
+ if $_.scope() eq 'parameter' {
+ $param := $_;
+ }
+ elsif $_.name() eq '$_' {
+ $dollar_underscore := $_;
+ }
+ }
+ }
+ unless $param {
+ if $dollar_underscore {
+ $dollar_underscore.scope('parameter');
+ $param := $dollar_underscore;
+ }
+ else {
+ $param := 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(
+ :inline(" %r = newclosure %0\n"),
+ $past
+ ),
+ PAST::Var.new(
+ :name($parameter.name()),
+ :scope('lexical')
+ )
+ );
+}
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: trunk/languages/perl6/src/parser/grammar.pg
==============================================================================
--- trunk/languages/perl6/src/parser/grammar.pg (original)
+++ trunk/languages/perl6/src/parser/grammar.pg Tue Aug 12 08:05:21 2008
@@ -415,10 +415,14 @@
rule type_constraint {
[
| <typename>
- | where <EXPR> # XXX <EXPR(%chaining)>
+ | where <EXPR: 'm='> # XXX <EXPR(%chaining)>
]
}
+rule post_constraint {
+ where <EXPR: 'm='> # XXX <EXPR(%chaining)>
+}
+
# XXX This rule doesn't appear in STD.pm; we use this to parse things like
# sub foo(::T $x) { ... }, since it appears STD.pm doesn't cover that yet.
rule generic_binder {
@@ -435,6 +439,7 @@
$<quant>=[ <[ ? ! ]>? ]
]
<trait>*
+ <post_constraint>*
<default_value>?
{*}
}
