Mercurial > hg > Others > Rakudo
diff src/core.c/Failure.pm6 @ 0:c341f82e7ad7 default tip
Rakudo branch in cr.ie.u-ryukyu.ac.jp
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 26 Dec 2019 16:50:27 +0900 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/core.c/Failure.pm6 Thu Dec 26 16:50:27 2019 +0900 @@ -0,0 +1,172 @@ +my class Failure is Nil { + has $.exception; + has $.backtrace; +#?if !jvm + has int $!handled; +#?endif +#?if jvm + has Int $!handled; # alas, native int breaks on the JVM +#?endif + + method !SET-SELF($!exception) { + $!backtrace = $!exception.backtrace || Backtrace.new(3); + $!exception.reset-backtrace; + self + } + + multi method new(Failure:D:) { self!throw } + multi method new(Failure:U:) { + my $stash := CALLER::LEXICAL::; + my $payload = ($stash<$!>:exists && $stash<$!>.DEFINITE) ?? $stash<$!> !! "Failed"; + nqp::create(self)!SET-SELF( + $payload ~~ Exception ?? $payload !! X::AdHoc.new(:$payload) + ) + } + multi method new(Failure:U: Exception:D \exception) { + nqp::create(self)!SET-SELF(exception) + } + multi method new(Failure:U: $payload) { + nqp::create(self)!SET-SELF(X::AdHoc.new(:$payload)) + } + multi method new(Failure:U: |cap (*@msg)) { + nqp::create(self)!SET-SELF(X::AdHoc.from-slurpy(|cap)) + } + + submethod DESTROY () { + note "WARNING: unhandled Failure detected in DESTROY. If you meant " + ~ "to ignore it, you can mark it as handled by calling .Bool, " + ~ ".so, .not, or .defined methods. The Failure was:\n" ~ self.mess + unless $!handled; + } + + # allow Failures to throw when they replace an Iterable + multi method iterator(Failure:D:) { self!throw } + multi method list(Failure:D:) { self!throw } + + # Marks the Failure has handled (since we're now fatalizing it) and throws. + method !throw(Failure:D:) { + $!handled = 1; + $!exception.throw($!backtrace); + } + + # Turns out multidimensional lookups are one way to leak unhandled failures, so + # we'll just propagate the initial failure much as we propagate Nil on methods. + method AT-POS(|) { self } + method AT-KEY(|) { self } + + multi method defined(Failure:D: --> False) { $!handled = 1 } + + multi method Bool(Failure:D: --> False) { $!handled = 1 } + method handled() is rw { + Proxy.new( + FETCH => { +#?if !jvm + nqp::hllbool($!handled) +#?endif +#?if jvm + $!handled.Bool +#?endif + }, + STORE => -> $, $value { $!handled = $value.Bool.Numeric } + ) + } + + method Capture() { + self.DEFINITE.not || $!handled + ?? X::Cannot::Capture.new(what => self).throw + !! self!throw + } + method Int(Failure:D:) { $!handled ?? Int !! self!throw(); } + method Num(Failure:D:) { $!handled ?? NaN !! self!throw(); } + method Numeric(Failure:D:) { $!handled ?? NaN !! self!throw(); } + + method Set(Failure:D:) { $!handled ?? Set.new(self) !! self!throw } + method SetHash(Failure:D:) { $!handled ?? SetHash.new(self) !! self!throw } + method Bag(Failure:D:) { $!handled ?? Bag.new(self) !! self!throw } + method BagHash(Failure:D:) { $!handled ?? BagHash.new(self) !! self!throw } + method Mix(Failure:D:) { $!handled ?? Mix.new(self) !! self!throw } + method MixHash(Failure:D:) { $!handled ?? MixHash.new(self) !! self!throw } + + multi method Str(Failure:D:) { $!handled ?? $.mess !! self!throw(); } + multi method gist(Failure:D:) { $!handled ?? $.mess !! self!throw(); } + multi method gist(Failure:U:) { '(' ~ self.^name ~ ')' } + multi method perl(Failure:D:) { + $!handled ?? '&CORE::infix:<orelse>(' ~ self.Mu::perl ~ ', *.self)' + !! self.Mu::perl + } + multi method perl(Failure:U:) { self.^name } + method mess (Failure:D:) { + my $message = (try self.exception.message) // self.exception.^name ~ ' with no message'; + "(HANDLED) " x $!handled ~ "$message\n" ~ self.backtrace; + } + + method sink(Failure:D:) { + self!throw() unless $!handled + } + method self(Failure:D:) { + self!throw() unless $!handled; + self + } + method CALL-ME(Failure:D: |) { + self!throw() + } + method FALLBACK(Failure:D: *@) { + self!throw() + } + method STORE(Failure:D: *@) { + self!throw() + } +} + +proto sub fail(|) {*}; +multi sub fail(--> Nil) { + my $stash := CALLER::LEXICAL::; + my $payload = ($stash<$!>:exists && $stash<$!>.DEFINITE) ?? $stash<$!> !! "Failed"; + + my $fail := Failure.new( $payload ~~ Exception + ?? $payload !! X::AdHoc.new(:$payload)); + + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} +multi sub fail(Exception:U $e --> Nil) { + my $fail := Failure.new( + X::AdHoc.new(:payload("Failed with undefined " ~ $e.^name)) + ); + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} +multi sub fail($payload --> Nil) { + my $fail := Failure.new( $payload ~~ Exception + ?? $payload + !! X::AdHoc.new(:$payload) + ); + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} +multi sub fail(|cap (*@msg) --> Nil) { + my $fail := Failure.new(X::AdHoc.from-slurpy(|cap)); + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} +multi sub fail(Failure:U $f --> Nil) { + my $fail := Failure.new( + X::AdHoc.new(:payload("Failed with undefined " ~ $f.^name)) + ); + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} +multi sub fail(Failure:D $fail --> Nil) { + $fail.handled = 0; + nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail); + CATCH { $fail.exception.throw } +} + +multi sub die(Failure:D $f --> Nil) { + $f.exception.throw +} +multi sub die(Failure:U $f --> Nil) { + X::AdHoc.new(:payload("Died with undefined " ~ $f.^name)).throw; +} + +# vim: ft=perl6 expandtab sw=4