Permalink
Browse files

Merge remote-tracking branch 'origin/trait-exceptions' into nom

This enables throwing of X::Comp derived exceptions in traits,
and Perl6::World.rethrow adds file name and line number
  • Loading branch information...
2 parents 705fabb + fe675c9 commit e99dd90c74d49dfaef141895e1221f1f56b8ccdc @moritz moritz committed Jul 30, 2012
Showing with 57 additions and 42 deletions.
  1. +27 −26 src/Perl6/Actions.pm
  2. +2 −2 src/Perl6/Pod.pm
  3. +21 −9 src/Perl6/World.pm
  4. +7 −5 src/core/Exception.pm
View
@@ -1323,7 +1323,7 @@ class Perl6::Actions is HLL::Actions {
method package_declarator:sym<native>($/) { make $<package_def>.ast; }
method package_declarator:sym<trusts>($/) {
- $*W.apply_trait('&trait_mod:<trusts>', $*PACKAGE, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<trusts>', $*PACKAGE, $<typename>.ast);
}
method package_declarator:sym<also>($/) {
@@ -1431,7 +1431,7 @@ class Perl6::Actions is HLL::Actions {
}
# Document
- Perl6::Pod::document($*PACKAGE, $*DOC);
+ Perl6::Pod::document($/, $*PACKAGE, $*DOC);
make QAST::Stmts.new(
$block, QAST::WVal.new( :value($*PACKAGE) )
@@ -1455,7 +1455,8 @@ class Perl6::Actions is HLL::Actions {
my $orig_past := $past;
if $*SCOPE eq 'has' {
if $<initializer>[0]<sym> eq '=' {
- self.install_attr_init($past<metaattr>, $<initializer>[0].ast, $*ATTR_INIT_BLOCK);
+ self.install_attr_init($<initializer>[0], $past<metaattr>,
+ $<initializer>[0].ast, $*ATTR_INIT_BLOCK);
}
else {
$/.CURSOR.panic("Cannot use " ~ $<initializer>[0]<sym> ~
@@ -1585,7 +1586,7 @@ class Perl6::Actions is HLL::Actions {
%cont_info, $descriptor);
# Document it
- # Perl6::Pod::document($attr, $*DOC); #XXX var traits NYI
+ # Perl6::Pod::document($/, $attr, $*DOC); #XXX var traits NYI
# If no twigil, note $foo is an alias to $!foo.
if $twigil eq '' {
@@ -1761,7 +1762,7 @@ class Perl6::Actions is HLL::Actions {
$*W.finish_code_object($code, $block, $*MULTINESS eq 'proto', :yada(is_yada($/)));
# Document it
- Perl6::Pod::document($code, $*DOC);
+ Perl6::Pod::document($/, $code, $*DOC);
# Install PAST block so that it gets capture_lex'd correctly and also
# install it in the lexpad.
@@ -1858,13 +1859,13 @@ class Perl6::Actions is HLL::Actions {
}
# Apply traits.
- for $<trait> {
- if $_.ast { ($_.ast)($code) }
+ for $<trait> -> $t {
+ if $t.ast { $*W.ex-handle($t, { ($t.ast)($code) }) }
}
# Add inlining information if it's inlinable.
if $<deflongname> {
- self.add_inlining_info_if_possible($code, $block, @params);
+ self.add_inlining_info_if_possible($/, $code, $block, @params);
}
my $closure := block_closure(reference_to_code_object($code, $past));
@@ -1884,7 +1885,7 @@ class Perl6::Actions is HLL::Actions {
$*W.create_code_object($p_past, 'Sub', $p_sig, 1);
}
- method add_inlining_info_if_possible($code, $past, @params) {
+ method add_inlining_info_if_possible($/, $code, $past, @params) {
# Only consider things with single statements.
unless +$past[1].list == 1 {
return 0;
@@ -1964,7 +1965,7 @@ class Perl6::Actions is HLL::Actions {
}
# Attach inlining information.
- $*W.apply_trait('&trait_mod:<is>', $code,
+ $*W.apply_trait($/, '&trait_mod:<is>', $code,
inlinable => ($*W.add_string_constant($inline_info)).compile_time_value)
}
@@ -2007,7 +2008,7 @@ class Perl6::Actions is HLL::Actions {
my $code := methodize_block($/, $*DECLARAND, $past, %sig_info, $inv_type, :yada(is_yada($/)));
# Document it
- Perl6::Pod::document($code, $*DOC);
+ Perl6::Pod::document($/, $code, $*DOC);
# Install &?ROUTINE.
$*W.install_lexical_symbol($past, '&?ROUTINE', $code);
@@ -2078,7 +2079,7 @@ class Perl6::Actions is HLL::Actions {
$*MULTINESS eq 'proto');
# Document it
- Perl6::Pod::document($code, $*DOC);
+ Perl6::Pod::document($/, $code, $*DOC);
# Install PAST block so that it gets capture_lex'd correctly and also
# install it in the lexpad.
@@ -2371,12 +2372,12 @@ class Perl6::Actions is HLL::Actions {
my sub make_type_obj($base_type) {
$type_obj := $*W.pkg_create_mo($/, %*HOW<enum>, :$name, :$base_type);
# Add roles (which will provide the enum-related methods).
- $*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['Enumeration']));
+ $*W.apply_trait($/, '&trait_mod:<does>', $type_obj, $*W.find_symbol(['Enumeration']));
if istype($type_obj, $*W.find_symbol(['Numeric'])) {
- $*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['NumericEnumeration']));
+ $*W.apply_trait($/, '&trait_mod:<does>', $type_obj, $*W.find_symbol(['NumericEnumeration']));
}
if istype($type_obj, $*W.find_symbol(['Stringy'])) {
- $*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['StringyEnumeration']));
+ $*W.apply_trait($/, '&trait_mod:<does>', $type_obj, $*W.find_symbol(['StringyEnumeration']));
}
# Apply traits, compose and install package.
for $<trait> {
@@ -2985,56 +2986,56 @@ class Perl6::Actions is HLL::Actions {
if $*W.is_name(@name) {
my $trait := $*W.find_symbol(@name);
make -> $declarand {
- $*W.apply_trait('&trait_mod:<is>', $declarand, $trait, |@trait_arg);
+ $*W.apply_trait($/, '&trait_mod:<is>', $declarand, $trait, |@trait_arg);
};
}
else {
my %arg;
%arg{~$<longname>} := @trait_arg ?? @trait_arg[0] !!
$*W.find_symbol(['Bool', 'True']);
make -> $declarand {
- $*W.apply_trait('&trait_mod:<is>', $declarand, |%arg);
+ $*W.apply_trait($/, '&trait_mod:<is>', $declarand, |%arg);
};
}
}
}
method trait_mod:sym<hides>($/) {
make -> $declarand {
- $*W.apply_trait('&trait_mod:<hides>', $declarand, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<hides>', $declarand, $<typename>.ast);
};
}
method trait_mod:sym<does>($/) {
make -> $declarand {
- $*W.apply_trait('&trait_mod:<does>', $declarand, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<does>', $declarand, $<typename>.ast);
};
}
method trait_mod:sym<will>($/) {
my %arg;
%arg{~$<identifier>} := ($*W.add_constant('Int', 'int', 1)).compile_time_value;
make -> $declarand {
- $*W.apply_trait('&trait_mod:<will>', $declarand,
+ $*W.apply_trait($/, '&trait_mod:<will>', $declarand,
($<pblock>.ast)<code_object>, |%arg);
};
}
method trait_mod:sym<of>($/) {
make -> $declarand {
- $*W.apply_trait('&trait_mod:<of>', $declarand, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<of>', $declarand, $<typename>.ast);
};
}
method trait_mod:sym<as>($/) {
make -> $declarand {
- $*W.apply_trait('&trait_mod:<as>', $declarand, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<as>', $declarand, $<typename>.ast);
};
}
method trait_mod:sym<returns>($/) {
make -> $declarand {
- $*W.apply_trait('&trait_mod:<returns>', $declarand, $<typename>.ast);
+ $*W.apply_trait($/, '&trait_mod:<returns>', $declarand, $<typename>.ast);
};
}
@@ -3044,7 +3045,7 @@ class Perl6::Actions is HLL::Actions {
# it.
my $thunk := $*W.create_thunk($/, $<term>.ast);
make -> $declarand {
- $*W.apply_trait('&trait_mod:<handles>', $declarand, $thunk);
+ $*W.apply_trait($/, '&trait_mod:<handles>', $declarand, $thunk);
};
}
@@ -5042,7 +5043,7 @@ class Perl6::Actions is HLL::Actions {
# Handles the case where we have a default value closure for an
# attribute.
- method install_attr_init($attr, $initializer, $block) {
+ method install_attr_init($/, $attr, $initializer, $block) {
# Construct signature and anonymous method.
my @params := [
hash( is_invocant => 1, nominal_type => $*PACKAGE),
@@ -5064,7 +5065,7 @@ class Perl6::Actions is HLL::Actions {
# Dispatch trait. XXX Should really be Bool::True, not Int here...
my $true := ($*W.add_constant('Int', 'int', 1)).compile_time_value;
- $*W.apply_trait('&trait_mod:<will>', $attr, :build($code));
+ $*W.apply_trait($/, '&trait_mod:<will>', $attr, :build($code));
}
# This is the hook where, in the future, we'll use this as the hook to check
View
@@ -1,8 +1,8 @@
# various helper methods for Pod parsing and processing
class Perl6::Pod {
- our sub document($what, $with) {
+ our sub document($/, $what, $with) {
if ~$with ne '' {
- $*W.apply_trait('&trait_mod:<is>', $what, :docs($*DOCEE));
+ $*W.apply_trait($/, '&trait_mod:<is>', $what, :docs($*DOCEE));
# don't reset it if it already holds docs for another element
if $*DECLARATOR_DOCS && $*DOC.to == $*DECLARATOR_DOCS.to {
$*DECLARATOR_DOCS := '';
View
@@ -1296,9 +1296,9 @@ class Perl6::World is HLL::World {
}
# Applies a trait.
- method apply_trait($trait_sub_name, *@pos_args, *%named_args) {
+ method apply_trait($/, $trait_sub_name, *@pos_args, *%named_args) {
my $trait_sub := $*W.find_symbol([$trait_sub_name]);
- $trait_sub(|@pos_args, |%named_args);
+ self.ex-handle($/, { $trait_sub(|@pos_args, |%named_args) });
}
# Some things get cloned many times with a lexical scope that
@@ -1964,16 +1964,28 @@ class Perl6::World is HLL::World {
my $success := 0;
my $ex_t;
my $coercer;
- try { $ex_t := self.find_symbol(['X', 'Comp', 'AdHoc']); $success := 1 };
try { $coercer := self.find_symbol(['&COMP_EXCEPTION']); ++$success; };
- $err.rethrow unless $success == 2;
- my $p6ex := $coercer($err);
- nqp::bindattr($p6ex, $ex_t, '$!filename',
+ nqp::rethrow($err) unless $success;
+ my $p6ex := $coercer($err);
+ try {
+ $ex_t := self.find_symbol(['X', 'Comp']);
+ if nqp::istype($p6ex, $err) {
+ $p6ex.SET_FILE_LINE(
+ nqp::box_s(pir::find_caller_lex__ps('$?FILES'),
+ self.find_symbol(['Str'])),
+ nqp::box_i(HLL::Compiler.lineof($/.orig, $/.from),
+ self.find_symbol(['Int'])),
+ );
+ $success++;
+ }
+ }
+ $p6ex.rethrow if $success == 2;
+ $p6ex.SET_FILE_LINE(
nqp::box_s(pir::find_caller_lex__ps('$?FILES'),
- self.find_symbol(['Str'])));
- nqp::bindattr($p6ex, $ex_t, '$!line',
+ self.find_symbol(['Str'])),
nqp::box_i(HLL::Compiler.lineof($/.orig, $/.from),
- self.find_symbol(['Int'])));
+ self.find_symbol(['Int'])),
+ );
$p6ex.rethrow();
}
}
View
@@ -313,6 +313,10 @@ my role X::Comp is Exception {
}
$r;
}
+ method SET_FILE_LINE($file, $line) {
+ $!filename = $file;
+ $!line = $line;
+ }
}
# XXX a hack for getting line numbers from exceptions from the metamodel
@@ -759,7 +763,7 @@ my class X::ControlFlow::Return is X::ControlFlow {
method message() { 'Attempt to return outside of any Routine' }
}
-my class X::Composition::NotComposable is Exception {
+my class X::Composition::NotComposable does X::Comp {
has $.target-name;
has $.composer;
method message() {
@@ -824,9 +828,7 @@ my class X::Mixin::NonComposable is Exception {
}
}
-# XXX should probably be X::Comp, but we don't get
-# the line number etc. in traits.pm
-my class X::Inheritance::Unsupported is Exception {
+my class X::Inheritance::Unsupported does X::Comp {
# note that this exception is thrown before the child type object
# has been composed, so it's useless to carry it around. Use the
# name instead.
@@ -838,7 +840,7 @@ my class X::Inheritance::Unsupported is Exception {
}
}
-my class X::Export::NameClash is Exception {
+my class X::Export::NameClash does X::Comp {
has $.symbol;
method message() {
"A symbol '$.symbol' has already been exported";

0 comments on commit e99dd90

Please sign in to comment.