1. my class Failure is Nil {
  2. has $.exception;
  3. has $.backtrace;
  4. has int $!handled;
  5. method !SET-SELF($!exception) {
  6. $!backtrace = $!exception.backtrace || Backtrace.new(5);
  7. $!exception.reset-backtrace;
  8. self
  9. }
  10. multi method new() {
  11. my $stash := CALLER::;
  12. my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Failed";
  13. nqp::create(self)!SET-SELF(
  14. $payload ~~ Exception ?? $payload !! X::AdHoc.new(:$payload)
  15. )
  16. }
  17. multi method new(Exception:D \exception) {
  18. nqp::create(self)!SET-SELF(exception)
  19. }
  20. multi method new($payload) {
  21. nqp::create(self)!SET-SELF(X::AdHoc.new(:$payload))
  22. }
  23. multi method new(|cap (*@msg)) {
  24. nqp::create(self)!SET-SELF(X::AdHoc.from-slurpy(|cap))
  25. }
  26. submethod DESTROY () {
  27. note "WARNING: unhandled Failure detected in DESTROY. If you meant "
  28. ~ "to ignore it, you can mark it as handled by calling .Bool, "
  29. ~ ".so, .not, or .defined methods. The Failure was:\n" ~ self.mess
  30. unless $!handled;
  31. }
  32. # Marks the Failure has handled (since we're now fatalizing it) and throws.
  33. method !throw(Failure:D:) {
  34. $!handled = 1;
  35. $!exception.throw($!backtrace);
  36. }
  37. # Turns out multidimensional lookups are one way to leak unhandled failures, so
  38. # we'll just propagate the initial failure much as we propagate Nil on methods.
  39. method AT-POS(|) { self }
  40. method AT-KEY(|) { self }
  41. # TODO: should be Failure:D: multi just like method Bool,
  42. # but obscure problems prevent us from making Mu.defined
  43. # a multi. See http://irclog.perlgeek.de/perl6/2011-06-28#i_4016747
  44. method defined() {
  45. $!handled = 1 if nqp::isconcrete(self);
  46. Bool::False;
  47. }
  48. multi method Bool(Failure:D:) { $!handled = 1; Bool::False; }
  49. method handled() {
  50. Proxy.new(
  51. FETCH => {
  52. nqp::p6bool($!handled)
  53. },
  54. STORE => -> $, $value { $!handled = $value.Bool.Numeric }
  55. )
  56. }
  57. method Int(Failure:D:) { $!handled ?? Int !! self!throw(); }
  58. method Num(Failure:D:) { $!handled ?? NaN !! self!throw(); }
  59. method Numeric(Failure:D:) { $!handled ?? NaN !! self!throw(); }
  60. multi method Str(Failure:D:) { $!handled ?? $.mess !! self!throw(); }
  61. multi method gist(Failure:D:) { $!handled ?? $.mess !! self!throw(); }
  62. multi method gist(Failure:U:) { '(' ~ self.^name ~ ')' }
  63. multi method perl(Failure:D:) { self.Mu::perl() }
  64. multi method perl(Failure:U:) { self.^name }
  65. method mess (Failure:D:) {
  66. "(HANDLED) " x $!handled ~ self.exception.message ~ "\n" ~ self.backtrace;
  67. }
  68. method sink(Failure:D:) {
  69. self!throw() unless $!handled
  70. }
  71. method CALL-ME(Failure:D: |) {
  72. self!throw()
  73. }
  74. method FALLBACK(Failure:D: *@) {
  75. self!throw()
  76. }
  77. method STORE(Failure:D: *@) {
  78. self!throw()
  79. }
  80. }
  81. proto sub fail(|) {*};
  82. multi sub fail(--> Nil) {
  83. my $stash := CALLER::;
  84. my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Failed";
  85. my $fail := Failure.new( $payload ~~ Exception
  86. ?? $payload !! X::AdHoc.new(:$payload));
  87. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  88. CATCH { $fail.exception.throw }
  89. }
  90. multi sub fail(Exception:U $e --> Nil) {
  91. my $fail := Failure.new(
  92. X::AdHoc.new(:payload("Failed with undefined " ~ $e.^name))
  93. );
  94. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  95. CATCH { $fail.exception.throw }
  96. }
  97. multi sub fail($payload --> Nil) {
  98. my $fail := Failure.new( $payload ~~ Exception
  99. ?? $payload
  100. !! X::AdHoc.new(:$payload)
  101. );
  102. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  103. CATCH { $fail.exception.throw }
  104. }
  105. multi sub fail(|cap (*@msg) --> Nil) {
  106. my $fail := Failure.new(X::AdHoc.from-slurpy(|cap));
  107. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  108. CATCH { $fail.exception.throw }
  109. }
  110. multi sub fail(Failure:U $f --> Nil) {
  111. my $fail := Failure.new(
  112. X::AdHoc.new(:payload("Failed with undefined " ~ $f.^name))
  113. );
  114. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  115. CATCH { $fail.exception.throw }
  116. }
  117. multi sub fail(Failure:D $fail --> Nil) {
  118. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  119. CATCH { $fail.exception.throw }
  120. }
  121. multi sub die(Failure:D $f --> Nil) {
  122. $f.exception.throw
  123. }
  124. multi sub die(Failure:U $f --> Nil) {
  125. X::AdHoc.new(:payload("Died with undefined " ~ $f.^name)).throw;
  126. }