Introduce $*WARNINGS and ENV<RAKU_WARNINGS>

- Introduces 4 new classes that provide different behaviours for warnings
-  CX::Warn::Quietly - do *not* show warnings, similar to quietly
-  CX::Warn::Fatal   - immediately throw a warning as an exception
-  CX::Warn::Verbose - immediately show warnings with complete backtrace
-  CX::Warn::Collect - collect warnings until END, then show with frequencies

The behaviour can be set by setting the new dynamic variable $*WARNINGS
to any of these classes (CX::Warn for normal behaviour).

The default behaviour of a process can be set with the RAKU_WARNINGS
environment variable, which should have any of "quietly", "fatal",
"verbose", or "collect" specified.  No specification defaults to the
current behaviour.

Custom behaviour can also be made by creating one's own CX::Warn::Foo
class, which should have a WARN method taking the warning message.
That method is then expected to do the right thing, and return Nil.
Such custom classes can also be activated with RAKU_WARNINGS=foo.

Sadly this does *not* cover warnings that are not generated with the
"warn" command.  This would require some additional work, pointers
and suggestions welcome.

I also tried making this a v6.e feature only, but that ran into all
sorts of scoping issues.  So until these are better understood, this
is now implemented as a 6.c feature.

src/core.c/Exception.pm6

@@ -428,28 +428,72 @@ my class CX::Last does X::Control {
 my class CX::Take does X::Control {
     method message() { "<take control exception>" }
 }
+my class CX::Return does X::Control {
+    method message() { "<return control exception>" }
+}
+my class CX::Emit does X::Control {
+    method message() { "<emit control exception>" }
+}
+my class CX::Done does X::Control {
+    method message() { "<done control exception>" }
+}
+my class CX::Succeed does X::Control {
+    method message() { "<succeed control exception>" }
+}
+my class CX::Proceed does X::Control {
+    method message() { "<proceed control exception>" }
+}
+
 my class CX::Warn does X::Control {
     has $.message;
 
     method UPGRADE-RAT(Int $nu, Int $de) is raw {
         warn "Downgrading Rat $nu / $de to Num";
         nqp::p6box_n(nqp::div_In($nu,$de))
     }
+
+    method WARN(str $message --> Nil) is hidden-from-backtrace {
+        my $ex := nqp::newexception();
+        nqp::setmessage($ex,$message);
+        nqp::setextype($ex,nqp::const::CONTROL_WARN);
+        nqp::throw($ex);
+    }
 }
-my class CX::Succeed does X::Control {
-    method message() { "<succeed control exception>" }
-}
-my class CX::Proceed does X::Control {
-    method message() { "<proceed control exception>" }
+my class CX::Warn::Quietly {
+    method WARN($ --> Nil) is hidden-from-backtrace { }
 }
-my class CX::Return does X::Control {
-    method message() { "<return control exception>" }
+my class CX::Warn::Fatal {
+    method WARN(str $message --> Nil) is hidden-from-backtrace {
+        X::AdHoc.new(payload => $message).throw;
+    }
 }
-my class CX::Emit does X::Control {
-    method message() { "<emit control exception>" }
+my class CX::Warn::Verbose {
+    method WARN(str $message --> Nil) is hidden-from-backtrace {
+        my $bt := Backtrace.new;
+        note $message ~ "\n" ~ Backtrace.new.Str;
+    }
 }
-my class CX::Done does X::Control {
-    method message() { "<done control exception>" }
+my class CX::Warn::Collect {
+    my $lock     := Lock.new;
+    my $messages := nqp::hash;
+
+    method WARN(str $message --> Nil) is hidden-from-backtrace {
+        my str $key = $message ~ "\n" ~ Backtrace.new.Str;
+        $lock.protect: {
+            nqp::bindkey($messages,$key,
+              nqp::add_i(nqp::ifnull(nqp::atkey($messages,$key),0),1)
+            );
+        }
+    }
+
+    END {
+        if nqp::elems($messages) {
+            my %messages := nqp::create(Map);
+            nqp::bindattr(%messages,Map,'$!storage',$messages);
+
+            note .value ~ 'x: ' ~ .key for %messages.sort(-*.value);
+        }
+    }
 }
 
 sub EXCEPTION(|) is implementation-detail {
@@ -3023,7 +3067,7 @@ my class X::Numeric::Underflow is Exception {
 
 my class X::Numeric::Uninitialized is Exception {
     has Numeric $.type;
-    method message() { "Use of uninitialized value of type " ~ $!type.^name ~ " in numeric context" }
+    method message() { nqp::say("here"); put Backtrace.new; "Use of uninitialized value of type " ~ $!type.^name ~ " in numeric context" }
 }
 
 my class X::Numeric::Confused is Exception {

src/core.c/Process.pm6

@@ -93,6 +93,14 @@ Rakudo::Internals.REGISTER-DYNAMIC: '$*HOME', {
     PROCESS::<$HOME> := $HOME # bind container so Nil default is kept
 }
 
+Rakudo::Internals.REGISTER-DYNAMIC: '$*WARNINGS', {
+    PROCESS::<$WARNINGS> := (my $what := %*ENV<RAKU_WARNINGS>)
+      ?? nqp::istype((my $lookup := ::("CX::Warn::$what.tc()")),Failure)
+        ?? $lookup.throw
+        !! $lookup
+      !! CX::Warn;
+}
+
 {
     sub fetch($what) {
         once if !Rakudo::Internals.IS-WIN && try { qx/LC_MESSAGES=POSIX id/ } -> $id {

src/core.c/control.pm6

@@ -4,6 +4,7 @@ my class X::Multi::NoMatch { ... }
 my class X::NYI { ... }
 my class PseudoStash { ... }
 my class Label { ... }
+my class CX::Warn { ... }
 class CompUnit::DependencySpecification { ... }
 
 sub THROW(int $type, Mu \arg) is raw {  # is implementation-detail
@@ -261,13 +262,11 @@ multi sub die(|cap ( *@msg ) --> Nil) {
 }
 
 proto sub warn(|) {*}
-multi sub warn(*@msg) {
-    my $msg := @msg.join || "Warning: something's wrong";
-    my $ex := nqp::newexception();
-    nqp::setmessage($ex, nqp::unbox_s($msg));
-    nqp::setextype($ex, nqp::const::CONTROL_WARN);
-    nqp::throw($ex);
-    0;
+multi sub warn(*@msg --> 0) {
+    (nqp::istype((my $class := $*WARNINGS),Failure)
+      ?? CX::Warn
+      !! $class
+    ).WARN(@msg.join || "Warning: something's wrong")
 }
 multi sub warn(Junction:D $j) { $j.THREAD: &warn }