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 Capture() {
  58. self.DEFINITE.not || $!handled
  59. ?? X::Cannot::Capture.new(what => self).throw
  60. !! self!throw
  61. }
  62. method Int(Failure:D:) { $!handled ?? Int !! self!throw(); }
  63. method Num(Failure:D:) { $!handled ?? NaN !! self!throw(); }
  64. method Numeric(Failure:D:) { $!handled ?? NaN !! self!throw(); }
  65. method Set(Failure:D:) { $!handled ?? Set.new(self) !! self!throw }
  66. method SetHash(Failure:D:) { $!handled ?? SetHash.new(self) !! self!throw }
  67. method Bag(Failure:D:) { $!handled ?? Bag.new(self) !! self!throw }
  68. method BagHash(Failure:D:) { $!handled ?? BagHash.new(self) !! self!throw }
  69. method Mix(Failure:D:) { $!handled ?? Mix.new(self) !! self!throw }
  70. method MixHash(Failure:D:) { $!handled ?? MixHash.new(self) !! self!throw }
  71. multi method Str(Failure:D:) { $!handled ?? $.mess !! self!throw(); }
  72. multi method gist(Failure:D:) { $!handled ?? $.mess !! self!throw(); }
  73. multi method gist(Failure:U:) { '(' ~ self.^name ~ ')' }
  74. multi method perl(Failure:D:) {
  75. $!handled ?? '&CORE::infix:<orelse>(' ~ self.Mu::perl ~ ', *.self)'
  76. !! self.Mu::perl
  77. }
  78. multi method perl(Failure:U:) { self.^name }
  79. method mess (Failure:D:) {
  80. "(HANDLED) " x $!handled ~ self.exception.message ~ "\n" ~ self.backtrace;
  81. }
  82. method sink(Failure:D:) {
  83. self!throw() unless $!handled
  84. }
  85. method self(Failure:D:) {
  86. self!throw() unless $!handled;
  87. self
  88. }
  89. method CALL-ME(Failure:D: |) {
  90. self!throw()
  91. }
  92. method FALLBACK(Failure:D: *@) {
  93. self!throw()
  94. }
  95. method STORE(Failure:D: *@) {
  96. self!throw()
  97. }
  98. }
  99. proto sub fail(|) {*};
  100. multi sub fail(--> Nil) {
  101. my $stash := CALLER::;
  102. my $payload = $stash<$!>.DEFINITE ?? $stash<$!> !! "Failed";
  103. my $fail := Failure.new( $payload ~~ Exception
  104. ?? $payload !! X::AdHoc.new(:$payload));
  105. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  106. CATCH { $fail.exception.throw }
  107. }
  108. multi sub fail(Exception:U $e --> Nil) {
  109. my $fail := Failure.new(
  110. X::AdHoc.new(:payload("Failed with undefined " ~ $e.^name))
  111. );
  112. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  113. CATCH { $fail.exception.throw }
  114. }
  115. multi sub fail($payload --> Nil) {
  116. my $fail := Failure.new( $payload ~~ Exception
  117. ?? $payload
  118. !! X::AdHoc.new(:$payload)
  119. );
  120. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  121. CATCH { $fail.exception.throw }
  122. }
  123. multi sub fail(|cap (*@msg) --> Nil) {
  124. my $fail := Failure.new(X::AdHoc.from-slurpy(|cap));
  125. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  126. CATCH { $fail.exception.throw }
  127. }
  128. multi sub fail(Failure:U $f --> Nil) {
  129. my $fail := Failure.new(
  130. X::AdHoc.new(:payload("Failed with undefined " ~ $f.^name))
  131. );
  132. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  133. CATCH { $fail.exception.throw }
  134. }
  135. multi sub fail(Failure:D $fail --> Nil) {
  136. $fail.handled = 0;
  137. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  138. CATCH { $fail.exception.throw }
  139. }
  140. multi sub die(Failure:D $f --> Nil) {
  141. $f.exception.throw
  142. }
  143. multi sub die(Failure:U $f --> Nil) {
  144. X::AdHoc.new(:payload("Died with undefined " ~ $f.^name)).throw;
  145. }