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