Author: pmichaud
Date: Sun Dec 28 14:21:48 2008
New Revision: 34523
Modified:
branches/rvar/languages/perl6/src/classes/Signature.pir
branches/rvar/languages/perl6/src/parser/actions.pm
branches/rvar/languages/perl6/src/parser/grammar.pg
Log:
[rakudo]: Add type checking to scalar parameters.
Modified: branches/rvar/languages/perl6/src/classes/Signature.pir
==============================================================================
--- branches/rvar/languages/perl6/src/classes/Signature.pir (original)
+++ branches/rvar/languages/perl6/src/classes/Signature.pir Sun Dec 28
14:21:48 2008
@@ -179,7 +179,6 @@
.namespace []
.sub '!SIGNATURE_BIND'
- .include 'interpinfo.pasm'
.local pmc callersub, callerlex, callersig
$P0 = getinterp
callersub = $P0['sub';1]
@@ -197,18 +196,35 @@
.local string name, sigil
name = param['name']
sigil = substr name, 0, 1
- .local pmc var
+ .local pmc type, var
+ type = param['type']
var = callerlex[name]
if sigil == '@' goto param_array
var = 'Scalar'(var)
- callerlex[name] = var
- goto param_loop
+ ## typecheck the argument
+ if null type goto param_val_done
+ .lex '$/', $P99
+ $P0 = type.'ACCEPTS'(var)
+ unless $P0 goto err_param_type
+ goto param_val_done
param_array:
var = 'Array'(var)
+ goto param_val_done
+ param_val_done:
+ ## place the updated variable back into lex
callerlex[name] = var
+ ## set any type properties
+ setprop var, 'type', type
goto param_loop
param_done:
end:
+ .return ()
+ err_param_type:
+ $S0 = callersub
+ if $S0 goto have_callersub_name
+ $S0 = '<anon>'
+ have_callersub_name:
+ 'die'('Parameter type check failed in call to ', $S0)
.end
@@ -217,7 +233,6 @@
=cut
-
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/rvar/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar/languages/perl6/src/parser/actions.pm (original)
+++ branches/rvar/languages/perl6/src/parser/actions.pm Sun Dec 28 14:21:48 2008
@@ -892,32 +892,43 @@
else {
my $loadinit := $?SIGNATURE_BLOCK.loadinit();
my $sigobj := PAST::Var.new( :scope('register') );
+
+ ## create a Signature object and attach to the block
$loadinit.push(
- PAST::Op.new( :inline(' %0 = new "Signature"'), $sigobj)
+ PAST::Op.new( :inline(' %0 = new "Signature"',
+ ' setprop block, "$!signature", %0'),
+ $sigobj)
);
+ ## loop through parameters of signature
my $i := 0;
my $n := $<parameter> ?? +@($<parameter>) !! 0;
while $i < $n {
my $param_past := $( $<parameter>[$i] );
my $name := $param_past.name();
my $symbol := $?SIGNATURE_BLOCK.symbol($name);
+
+ ## set the default value of the param and add var node to block
$param_past.viviself( $symbol<viviself> );
$?SIGNATURE.push( $param_past );
+ ## add parameter to the signature object
my $sigparam := PAST::Op.new( :pasttype('callmethod'),
:name('!add_param'), $sigobj, $name );
+
+ ## add any typechecks
+ if +$symbol<type> == 1 {
+ my $type := $symbol<type>[0];
+ $type.named('type');
+ $sigparam.push($type);
+ }
+
$loadinit.push($sigparam);
$i++;
}
- $loadinit.push(
- PAST::Op.new(
- :inline(' setprop block, "$!signature", %0'),
- $sigobj
- )
- );
+
+ ## restore block stack and return signature ast
@?BLOCK.shift();
- ## return signature ast node
make $?SIGNATURE;
}
@@ -925,6 +936,15 @@
}
+method type_constraint($/) {
+ my $past;
+ if $<fulltypename> {
+ $past := $( $<fulltypename> );
+ }
+ make $past;
+}
+
+
method parameter($/) {
our $?SIGNATURE_BLOCK;
my $past := $( $<param_var> );
@@ -958,6 +978,12 @@
$symbol<viviself> := $( $<default_value>[0]<EXPR> );
}
+ my $type := List.new();
+ $symbol<type> := $type;
+ if $<type_constraint> {
+ for @($<type_constraint>) { $type.push( $( $_ ) ); }
+ }
+
make $past;
}
Modified: branches/rvar/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/rvar/languages/perl6/src/parser/grammar.pg (original)
+++ branches/rvar/languages/perl6/src/parser/grammar.pg Sun Dec 28 14:21:48 2008
@@ -451,6 +451,7 @@
| <fulltypename>
| where <EXPR: 'm='> # XXX <EXPR(item %chaining)>
]
+ {*}
}
rule post_constraint {
