Complex <=>, plus $*SIGNIFICANCE

We now can do <=> on Complex, which fails with a slightly less LTA
message if either .im.abs exceeds 1e-15 (by default).  We also add an
approximately-equal operator, infix:<≅> (Texas version =~=), to do
approximate numerical equal with the same threshold.  A dynamic scope may
override the default by setting $*SIGNIFICANCE.  Coercion from complex
to real now pays attention to this also, so Num(i ** 2) returns -1.

src/Perl6/Grammar.nqp

@@ -4097,6 +4097,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
     token prefix:sym<let>  { <sym><.kok> <O('%named_unary')> { $*W.give_cur_block_let($/) } }
     token prefix:sym<temp> { <sym><.kok> <O('%named_unary')> { $*W.give_cur_block_temp($/) } }
 
+    token infix:sym«=~=»  { <sym>  <O('%chaining')> }
+    token infix:sym«≅»    { <sym>  <O('%chaining')> }
     token infix:sym«==»   { <sym>  <O('%chaining')> }
     token infix:sym«!=»   { <sym> <?before \s|']'> <O('%chaining')> }
     token infix:sym«<=»   { <sym>  <O('%chaining')> }

src/core/Complex.pm

@@ -32,7 +32,8 @@ my class Complex is Cool does Numeric {
     }
 
     method coerce-to-real(Complex:D: $exception-target) {
-        unless $!im == 0e0 { fail X::Numeric::Real.new(target => $exception-target, reason => "imaginary part not zero", source => self);}
+        fail X::Numeric::Real.new(target => $exception-target, reason => "imaginary part not zero", source => self)
+            unless $!im.abs < $*SIGNIFICANCE;
         $!re;
     }
     multi method Real(Complex:D:) { self.coerce-to-real(Real); }
@@ -434,12 +435,25 @@ multi sub infix:<===>(Complex:D \a, Complex:D \b) returns Bool:D {
     a.WHAT =:= b.WHAT && a == b
 }
 
+multi sub infix:<≅>(Complex:D \a, Complex:D \b) returns Bool:D { .not with a <=> b }
+multi sub infix:<≅>(Complex:D \a, Num(Real) \b) returns Bool:D { .not with a <=> b }
+multi sub infix:<≅>(Num(Real) \a, Complex:D \b) returns Bool:D { .not with a <=> b }
+
 # Meaningful only for sorting purposes, of course.
 # We delegate to Real::cmp rather than <=> because parts might be NaN.
 multi sub infix:<cmp>(Complex:D \a, Complex:D \b) returns Order:D { a.re cmp b.re || a.im cmp b.im }
 multi sub infix:<cmp>(Num(Real) \a, Complex:D \b) returns Order:D { a cmp b.re || 0 cmp b.im }
 multi sub infix:<cmp>(Complex:D \a, Num(Real) \b) returns Order:D { a.re cmp b || a.im cmp 0 }
 
+multi sub infix:«<=>»(Complex:D \a, Complex:D \b) returns Order:D {
+    my $signif = $*SIGNIFICANCE;
+    fail X::Numeric::Real.new(target => Real, reason => "Complex is not numerically orderable", source => "Complex")
+        unless a.im.abs < $signif && b.im.abs < $signif;  # c.f. coerce-to-real above
+    a.re <=> b.re;
+}
+multi sub infix:«<=>»(Num(Real) \a, Complex:D \b) returns Order:D { a.Complex <=> b }
+multi sub infix:«<=>»(Complex:D \a, Num(Real) \b) returns Order:D { a <=> b.Complex }
+
 proto sub postfix:<i>(\a) returns Complex:D is pure { * }
 multi sub postfix:<i>(Real      \a) returns Complex:D { Complex.new(0e0, a);     }
 multi sub postfix:<i>(Complex:D \a) returns Complex:D { Complex.new(-a.im, a.re) }

src/core/Num.pm

@@ -354,20 +354,24 @@ multi sub infix:<**>(num $a, num $b) {
     nqp::pow_n($a, $b)
 }
 
-
+# Here we sort NaN in with string "NaN"
 multi sub infix:<cmp>(Num:D \a, Num:D \b) {
      ORDER(nqp::cmp_n(nqp::unbox_n(a), nqp::unbox_n(b))) or
-         a === b ?? Same !! a.Stringy cmp b.Stringy; # treat NaN like "NaN"
+         a === b ?? Same !! a.Stringy cmp b.Stringy;
 }
 multi sub infix:<cmp>(num $a, num $b) {
-    ORDER(nqp::cmp_n($a, $b))
+    ORDER(nqp::cmp_n($a, $b)) or
+         $a === $b ?? Same !! $a.Stringy cmp $b.Stringy;
 }
 
+# Here we treat NaN as undefined
 multi sub infix:«<=>»(Num:D \a, Num:D \b) {
-    ORDER(nqp::cmp_n(nqp::unbox_n(a), nqp::unbox_n(b)))
+    ORDER(nqp::cmp_n(nqp::unbox_n(a), nqp::unbox_n(b))) or
+         a == b ?? Same !! Nil;
 }
 multi sub infix:«<=>»(num $a, num $b) {
-    ORDER(nqp::cmp_n($a, $b))
+    ORDER(nqp::cmp_n($a, $b)) or
+         $a == $b ?? Same !! Nil;
 }
 
 multi sub infix:<===>(Num:D \a, Num:D \b) {

src/core/Numeric.pm

@@ -232,13 +232,18 @@ multi sub postfix:<ⁿ>(\a, \b)  { a ** b }
 
 ## relational operators
 
-proto sub infix:«<=>»(Mu $, Mu $?) is pure       { * }
+proto sub infix:«<=>»(Mu $, Mu $?) is pure { * }
 multi sub infix:«<=>»(\a, \b)  { a.Real <=> b.Real }
 
-proto sub infix:<==>(Mu $?, Mu $?) is pure  { * }
+proto sub infix:<==>(Mu $?, Mu $?) is pure { * }
 multi sub infix:<==>($?)        { Bool::True }
 multi sub infix:<==>(\a, \b)   { a.Numeric == b.Numeric }
 
+proto sub infix:<≅>(Mu $?, Mu $?) { * }  # note, can't be pure due to dynvar
+multi sub infix:<≅>($?)        { Bool::True }
+multi sub infix:<≅>(\a, \b)    { abs(a.Num - b.Num) < $*SIGNIFICANCE }
+sub infix:<=~=>(\a, Mu \b) { a ≅ b  }
+
 proto sub infix:<!=>(Mu $?, Mu $?) is pure  { * }
 multi sub infix:<!=>($?)        { Bool::True }
 multi sub infix:<!=>(Mu \a, Mu \b)   { not a == b }

src/core/Process.pm

@@ -42,6 +42,10 @@ multi sub INITIALIZE_DYNAMIC('$*TMPDIR') {
     PROCESS::<$TMPDIR> := $*SPEC.tmpdir;
 }
 
+multi sub INITIALIZE_DYNAMIC('$*SIGNIFICANCE') {
+    PROCESS::<$SIGNIFICANCE> := item 1e-15;
+}
+
 multi sub INITIALIZE_DYNAMIC('$*HOME') {
     my $HOME;