Typed exceptions for multi-dispatch failure.

rakudo · Mar 14, 2013 · cf49051 · cf49051
1 parent e3db648
commit cf49051
Show file tree

Hide file tree

Showing 3 changed files with 47 additions and 31 deletions.
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.pm b/src/Perl6/Metamodel/BOOTSTRAP.pm
@@ -1187,39 +1187,27 @@ BEGIN {
                 $junctional_res;
             }
             elsif nqp::elems(@possibles) == 0 {
-                # Get signatures of all possible candidates. We dump them in the
-                # order in which we search for them.
-                nqp::die("Bad dispatch reporting NYI");
-                #STRING *signatures = Parrot_str_new(interp, "", 0);
-                #cur_candidate = candidates;
-                #while (1) {
-                #    if (!cur_candidate[0] && !cur_candidate[1])
-                #        break;
-                #    if (cur_candidate[0])
-                #        signatures = dump_signature(interp, signatures, (*cur_candidate)->sub);
-                #    cur_candidate++;
-                #}
-                #
-                #mem_sys_free(possibles);
-                #Parrot_ex_throw_from_c_args(interp, next, 1,
-                #    "Cannot call '%Ss'; none of these signatures match:\n%Ss",
-                #        (candidates[0] ? VTABLE_get_string(interp, candidates[0]->sub) : STRINGNULL),
-                #        signatures);
-                #return PMCNULL;
+                my %ex := nqp::gethllsym('perl6', 'P6EX');
+                if nqp::isnull(%ex) || !nqp::existskey(%ex, 'X::Multi::NoMatch') {
+                    nqp::die("Cannot call " ~ $self.name() ~
+                        "; no signatures match");
+                }
+                else {
+                    nqp::atkey(%ex, 'X::Multi::NoMatch')($self)
+                }
             }
             else {
-                nqp::die("Ambiguous dispatch reporting NYI");
-                #/* Get signatures of ambiguous candidates. */
-                #STRING *signatures = Parrot_str_new(interp, "", 0);
-                #INTVAL i;
-                #for (i = 0; i < possibles_count; i++)
-                #    signatures = dump_signature(interp, signatures, possibles[i]->sub);
-                #
-                #mem_sys_free(possibles);
-                #Parrot_ex_throw_from_c_args(interp, next, 1,
-                #    "Ambiguous call to '%Ss'; these signatures all match:\n%Ss",
-                #        VTABLE_get_string(interp, candidates[0]->sub), signatures);
-                #return PMCNULL;
+                my %ex := nqp::gethllsym('perl6', 'P6EX');
+                if nqp::isnull(%ex) || !nqp::existskey(%ex, 'X::Multi::Ambiguous') {
+                    nqp::die("Ambiguous call to " ~ $self.name());
+                }
+                else {
+                    my @ambig;
+                    for @possibles {
+                        nqp::push(@ambig, $_<sub>);
+                    }
+                    nqp::atkey(%ex, 'X::Multi::Ambiguous')($self, @ambig)
+                }
             }
         }));
     Routine.HOW.add_method(Routine, 'set_rw', static(sub ($self) {

diff --git a/src/core/Backtrace.pm b/src/core/Backtrace.pm
@@ -49,6 +49,8 @@ my class Backtrace is List {
             my $file     = $bt[$_]<annotations><file>;
             next unless $line && $file;
             # now *that's* an evil hack
+            next if $file eq 'src/gen/BOOTSTRAP.pm' ||
+                    $file eq 'src\\gen\\BOOTSTRAP.pm';
             last if $file eq 'src/stage2/gen/NQPHLL.pm' ||
                     $file eq 'src\\stage2\\gen\\NQPHLL.pm';
             my $subname  = nqp::p6box_s($bt[$_]<sub>);

diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -1194,6 +1194,25 @@ my class X::Item is Exception {
     method message { "Cannot index {$.aggregate.^name} with $.index" }
 }
 
+my class X::Multi::Ambiguous is Exception {
+    has $.dispatcher;
+    has @.ambiguous;
+    method message {
+        join "\n",
+            "Ambiguous call to '$.dispatcher.name()'; these signatures all match:",
+            @.ambiguous.map(*.signature.perl)
+    }
+}
+
+my class X::Multi::NoMatch is Exception {
+    has $.dispatcher;
+    method message {
+        join "\n",
+            "Cannot call '$.dispatcher.name()'; none of these signatures match:",
+            $.dispatcher.dispatchees.map(*.signature.perl)
+    }
+}
+
 {
     my %c_ex;
     %c_ex{'X::TypeCheck::Binding'} := sub ($got, $expected) is hidden_from_backtrace {
@@ -1214,8 +1233,15 @@ my class X::Item is Exception {
     %c_ex{'X::NoDispatcher'} := sub ($redispatcher) is hidden_from_backtrace {
             X::NoDispatcher.new(:$redispatcher).throw;
         };
+    %c_ex{'X::Multi::Ambiguous'} := sub ($dispatcher, @ambiguous) is hidden_from_backtrace {
+            X::Multi::Ambiguous.new(:$dispatcher, :@ambiguous).throw
+        };
+    %c_ex{'X::Multi::NoMatch'} := sub ($dispatcher) is hidden_from_backtrace {
+            X::Multi::NoMatch.new(:$dispatcher).throw
+        };
     my Mu $parrot_c_ex := nqp::getattr(%c_ex, EnumMap, '$!storage');
     nqp::bindcurhllsym('P6EX', $parrot_c_ex);
+
     0;
 }