eliminate X::Base

It is replaced by Exception as a base class, and by X::AdHoc for die with non-Exception arguments
rakudo · Feb 8, 2012 · 15dc125 · 15dc125
1 parent 0a3ee96
commit 15dc125
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 27 deletions.
diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -1,14 +1,16 @@
+my role X::Comp { ... }
+
 my class Exception {
     has $!ex;
 
     method backtrace() { Backtrace.new(self) }
 
-    method Str() {
-        nqp::p6box_s(nqp::atkey($!ex, 'message'))
-    }
 
-    multi method Numeric(Exception:D:) {
-        self.Str.Numeric()
+    multi method Str(Exception:D:) {
+        self.?message.Str // 'Something went wrong'
+    }
+    multi method gist(Exception:D:) {
+        self.?message ~ "\n" ~ $.backtrace;
     }
 
     method throw() is hidden_from_backtrace {
@@ -27,22 +29,31 @@ my class Exception {
     method Bool() { False }
 }
 
+my class X::AdHoc is Exception {
+    method message() {
+        nqp::p6box_s(
+            pir::getattribute__PPs(
+                nqp::getattr(self, Exception, '$!ex'),
+                'message'
+            )
+        );
+    }
+}
+
 sub EXCEPTION(|$) {
     my Mu $parrot_ex := nqp::shift(pir::perl6_current_args_rpa__P());
     my Mu $payload   := nqp::atkey($parrot_ex, 'payload');
     if nqp::p6bool(pir::type_check__IPP($payload, Exception)) {
         nqp::bindattr($payload, Exception, '$!ex', $parrot_ex);
         $payload;
     } else {
-        my $ex := nqp::create(Exception);
+        my $ex := nqp::create(X::AdHoc);
         nqp::bindattr($ex, Exception, '$!ex', $parrot_ex);
         $ex;
     }
 }
 
 
-my class X::Base { ... }
-
 do {
     sub is_runtime($bt) {
         for $bt.keys {
@@ -62,13 +73,14 @@ do {
         return False;
     }
 
+
     sub print_exception(|$) is hidden_from_backtrace {
         my Mu $ex := nqp::atpos(pir::perl6_current_args_rpa__P(), 0);
         try {
             my $e := EXCEPTION($ex);
             my Mu $err := pir::getstderr__P();
 
-            if X::Base.ACCEPTS($e) {
+            if X::Comp.ACCEPTS($e) {
                 $err.print: $e.gist;
                 $err.print: "\n";
             }

diff --git a/src/core/Exceptions.pm b/src/core/Exceptions.pm
@@ -1,36 +1,24 @@
-# XXX should really be my X::Base eventually
-my class X::Base is Exception {
-    has $.message;
-
-    multi method Str(X::Base:D:) {
-        $.message.Str // 'Something went wrong'
-    }
-    method ID() { ... }
-    multi method gist(X::Base:D:) {
-        $.message ~ "\n" ~ $.backtrace;
-    }
-}
 my role X::OS {
     has $.os-error;
 }
 
-my class X::IO::Rename does X::OS is X::Base {
+my class X::IO::Rename does X::OS is Exception {
     has $.from;
     has $.to;
     method message() {
         "Failed to rename '$.from' to '$.to': $.os-error"
     }
 }
 
-my class X::IO::Copy does X::OS is X::Base {
+my class X::IO::Copy does X::OS is Exception {
     has $.from;
     has $.to;
     method message() {
         "Failed to copy '$.from' to '$.to': $.os-error"
     }
 }
 
-my role X::Comp is X::Base {
+my role X::Comp is Exception {
     has $.filename;
     has $.line;
     has $.column;
@@ -42,12 +30,12 @@ my role X::Comp is X::Base {
 my role X::Syntax does X::Comp { }
 my role X::Pod                 { }
 
-my class X::NYI is X::Base {
+my class X::NYI is Exception {
     has $.feature;
     method message() { "$.feature not yet implemented. Sorry. " }
 }
 
-my class X::OutOfRange is X::Base {
+my class X::OutOfRange is Exception {
     has $.what = 'Argument';
     has $.got = '<unknown>';
     has $.range = '<unknown>';
@@ -56,7 +44,7 @@ my class X::OutOfRange is X::Base {
     }
 }
 
-my class X::Buf::AsStr is X::Base {
+my class X::Buf::AsStr is Exception {
     has $.method;
     method message() {
         "Cannot use a Buf as a string, but you called the $.method method on it";