Merge pull request #3873 from rakudo/introducing-allomorph-class

Introducing the Allomorph class
rakudo · Sep 1, 2020 · 122ed08 · 122ed08
2 parents 09e4f23 + 1b16da1
commit 122ed08
Show file tree

Hide file tree

Showing 9 changed files with 146 additions and 197 deletions.
diff --git a/src/core.c/Order.pm6 b/src/core.c/Order.pm6
@@ -28,12 +28,16 @@ multi sub infix:<cmp>(\a, Real:D \b) {
 }
 
 multi sub infix:<cmp>(Real:D \a, Real:D \b) {
-       (nqp::istype(a, Rational) && nqp::isfalse(a.denominator))
-    || (nqp::istype(b, Rational) && nqp::isfalse(b.denominator))
-    ?? a.Bridge cmp b.Bridge
-    !! a === -Inf || b === Inf
-        ?? Less
-        !! a === Inf || b === -Inf
+    nqp::istype(a,Rational) && nqp::istype(b,Rational)
+      ?? a.isNaN || b.isNaN
+        ?? a.Num cmp b.Num
+        !! a <=> b
+      !! (nqp::istype(a, Rational) && nqp::isfalse(a.denominator))
+           || (nqp::istype(b, Rational) && nqp::isfalse(b.denominator))
+        ?? a.Bridge cmp b.Bridge
+        !! a === -Inf || b === Inf
+          ?? Less
+          !! a === Inf || b === -Inf
             ?? More
             !! a.Bridge cmp b.Bridge
 }

diff --git a/src/core.c/allomorphs.pm6 b/src/core.c/allomorphs.pm6
@@ -1,214 +1,160 @@
-# the uses of add_I in this class are a trick to make bigints work right
-my class IntStr is Int is Str {
-    method new(Int:D $i, Str:D $s) {
-        my \SELF = nqp::add_I($i, 0, self);
-        nqp::bindattr_s(SELF, Str, '$!value', $s);
-        SELF;
+my class Allomorph is Str {
+    multi method Bool(::?CLASS:D:) { self.Numeric.Bool }
+
+    multi method ACCEPTS(Allomorph:D: Any:D \a) is default {
+        nqp::istype(a, Numeric)
+          ?? self.Numeric.ACCEPTS(a)
+          !! nqp::istype(a, Str)
+            ?? self.Str.ACCEPTS(a)
+            !! self.Str.ACCEPTS(a) && self.Numeric.ACCEPTS(a)
     }
-    multi method ACCEPTS(IntStr:D: Any:D \a) {
-        nqp::if(
-          nqp::istype(a, Numeric),
-            self.Int.ACCEPTS(a),
-          nqp::if(
-            nqp::istype(a, Str),
-            self.Str.ACCEPTS(a),
-            self.Str.ACCEPTS(a) && self.Int.ACCEPTS(a)))
-    }
-    multi method Numeric(IntStr:D:) { self.Int }
-    multi method Numeric(IntStr:U:) {
-        self.Mu::Numeric; # issue warning;
-        0
+
+    method succ(Allomorph:D:) { self.Numeric.succ }
+    method pred(Allomorph:D:) { self.Numeric.pred }
+
+    multi method Str(Allomorph:D:) {
+        nqp::getattr_s(self,Str,'$!value')
     }
-    multi method Real(IntStr:D:) { self.Int }
-    multi method Real(IntStr:U:) {
-        self.Mu::Real; # issue warning;
-        0
+
+    multi method WHICH(Allomorph:D:) {
+        nqp::box_s(
+          nqp::join('|',nqp::list_s(
+            self.^name,
+            self.Numeric.WHICH,
+            self.Str.WHICH
+          )),
+          ValueObjAt
+        )
     }
-    method Int(IntStr:D:) { nqp::add_I(self, 0, Int) }
-    multi method Str(IntStr:D:) { nqp::getattr_s(self, Str, '$!value') }
-
-    multi method raku(IntStr:D:) {
-        nqp::concat(self.^name,
-          nqp::concat('.new(',
-            nqp::concat(nqp::tostr_I(self),
-              nqp::concat(', ',
-                nqp::concat(nqp::getattr_s(self,Str,'$!value').raku,')'
-        )))))
+
+    multi method raku(Allomorph:D:) {
+        nqp::join("",nqp::list_s(
+          self.^name,'.new(',self.Numeric.raku,', ',self.Str.raku,')'
+        ))
     }
 }
 
-my class NumStr is Num is Str {
-    method new(Num $n, Str $s) {
-        my \SELF = nqp::create(self);
-        nqp::bindattr_n(SELF, Num, '$!value', $n);
+# the uses of add_I in this class are a trick to make bigints work right
+my class IntStr is Allomorph is Int {
+    method new(Int:D $i, Str:D $s) {
+        my \SELF = nqp::add_I($i, 0, self);
         nqp::bindattr_s(SELF, Str, '$!value', $s);
-        SELF;
-    }
-    multi method ACCEPTS(NumStr:D: Any:D \a) {
-        nqp::if(
-          nqp::istype(a, Numeric),
-          self.Num.ACCEPTS(a),
-          nqp::if(
-            nqp::istype(a, Str),
-            self.Str.ACCEPTS(a),
-            self.Str.ACCEPTS(a) && self.Num.ACCEPTS(a)))
-    }
-    multi method Numeric(NumStr:D:) { self.Num }
-    multi method Numeric(NumStr:U:) {
-        self.Mu::Numeric; # issue warning;
-        0e0
-    }
-    multi method Real(NumStr:D:) { self.Num }
-    multi method Real(NumStr:U:) {
-        self.Mu::Real; # issue warning;
-        0e0
-    }
-    method Num(NumStr:D:) { nqp::getattr_n(self, Num, '$!value') }
-    multi method Str(NumStr:D:) { nqp::getattr_s(self, Str, '$!value') }
-
-    multi method raku(NumStr:D:) {
-        nqp::concat(self.^name,
-          nqp::concat('.new(',
-            nqp::concat(nqp::getattr_n(self,Num,'$!value').raku,
-              nqp::concat(', ',
-                nqp::concat(nqp::getattr_s(self,Str,'$!value').raku,')'
-        )))))
+        SELF
     }
+
+    multi method Numeric(IntStr:U:) { self.Mu::Numeric }
+    multi method Numeric(IntStr:D:) { nqp::add_I(self,0,Int) }
+
+    multi method Real(IntStr:U:) { self.Mu::Real }
+    multi method Real(IntStr:D:) { nqp::add_I(self,0,Int) }
+
+    multi method Int(IntStr:D:) { nqp::add_I(self,0,Int) }
 }
 
-my class RatStr is Rat is Str {
-    method new(Rat $r, Str $s) {
-        my \SELF = nqp::create(self);
-        nqp::bindattr(SELF, Rat, '$!numerator', $r.numerator);
-        nqp::bindattr(SELF, Rat, '$!denominator', $r.denominator);
-        nqp::bindattr_s(SELF, Str, '$!value', $s);
-        SELF;
-    }
-    multi method ACCEPTS(RatStr:D: Any:D \a) {
-        nqp::if(
-          nqp::istype(a, Numeric),
-          self.Rat.ACCEPTS(a),
-          nqp::if(
-            nqp::istype(a, Str),
-            self.Str.ACCEPTS(a),
-            self.Str.ACCEPTS(a) && self.Rat.ACCEPTS(a)))
-    }
-    method succ(RatStr:D: --> Rat:D) {
-        my \denominator := nqp::getattr(self,Rat,'$!denominator');
-        nqp::p6bindattrinvres(
-          nqp::p6bindattrinvres(nqp::create(Rat),Rat,'$!numerator',
-            nqp::add_I(nqp::getattr(self,Rat,'$!numerator'),denominator,Int)
-          ),
-          Rat, '$!denominator', denominator
-        )
+my class NumStr is Allomorph is Num {
+    method new(Num:D $n, Str:D $s) {
+        my \new = nqp::create(self);
+        nqp::bindattr_n(new,Num,'$!value',$n);
+        nqp::bindattr_s(new,Str,'$!value',$s);
+        new
     }
-    method pred(RatStr:D: --> Rat:D) {
-        my \denominator := nqp::getattr(self,Rat,'$!denominator');
-        nqp::p6bindattrinvres(
-          nqp::p6bindattrinvres(nqp::create(Rat), Rat, '$!numerator',
-            nqp::sub_I(nqp::getattr(self,Rat,'$!numerator'),denominator,Int)
-          ),
-          Rat, '$!denominator', denominator
-        )
+
+    multi method Numeric(NumStr:U: --> 0e0) { self.Mu::Numeric }
+    multi method Numeric(NumStr:D:) { nqp::getattr_n(self,Num,'$!value') }
+
+    multi method Real(NumStr:U: --> 0e0) { self.Mu::Real }
+    multi method Real(NumStr:D:) { nqp::getattr_n(self,Num,'$!value') }
+
+    multi method Int(NumStr:D:)     { nqp::getattr_n(self,Num,'$!value').Int }
+}
+
+my class RatStr is Allomorph is Rat {
+    method new(Rat:D $r, Str:D $s) {
+        my \new = nqp::create(self);  # no need to normalize, so don't call .new
+        nqp::bindattr(new,Rat,'$!numerator',
+          nqp::getattr($r,Rat,'$!numerator'));
+        nqp::bindattr(new,Rat,'$!denominator',
+          nqp::getattr($r,Rat,'$!denominator'));
+        nqp::bindattr_s(new,Str,'$!value',$s);
+        new
     }
+
     method Capture(RatStr:D:) { self.Mu::Capture }
+
+    multi method Numeric(RatStr:U: --> 0.0) { self.Mu::Numeric }
     multi method Numeric(RatStr:D:) { self.Rat }
-    multi method Numeric(RatStr:U:) {
-        self.Mu::Numeric; # issue warning;
-        0.0
-    }
+
+    multi method Real(RatStr:U: --> 0.0) { self.Mu::Real }
     multi method Real(RatStr:D:) { self.Rat }
-    multi method Real(RatStr:U:) {
-        self.Mu::Real; # issue warning;
-        0.0
-    }
+
+    multi method Int(RatStr:D:) { self.Rat.Int }
+
     method Rat(RatStr:D:) {
-        Rat.new(
-          nqp::getattr(self, Rat, '$!numerator'),
-          nqp::getattr(self, Rat, '$!denominator')
-        )
+        my \new := nqp::create(Rat);  # no need to normalize, so don't call .new
+        nqp::bindattr(new,Rat,'$!numerator',
+          nqp::getattr(self,Rat,'$!numerator'));
+        nqp::bindattr(new,Rat,'$!denominator',
+          nqp::getattr(self,Rat,'$!denominator'));
+        new
     }
-    multi method Str(RatStr:D:) { nqp::getattr_s(self, Str, '$!value') }
-
-    multi method raku(RatStr:D:) { self.^name ~ '.new(' ~ self.Rat.raku ~ ', ' ~ self.Str.raku ~ ')' }
 }
 
-my class ComplexStr is Complex is Str {
-    method new(Complex $c, Str $s) {
-        my \SELF = nqp::create(self);
-        nqp::bindattr_n(SELF, Complex, '$!re', $c.re);
-        nqp::bindattr_n(SELF, Complex, '$!im', $c.im);
-        nqp::bindattr_s(SELF, Str, '$!value', $s);
-        SELF;
-    }
-    multi method ACCEPTS(ComplexStr:D: Any:D \a) {
-        nqp::if(
-          nqp::istype(a, Numeric),
-          self.Complex.ACCEPTS(a),
-          nqp::if(
-            nqp::istype(a, Str),
-            self.Str.ACCEPTS(a),
-            self.Str.ACCEPTS(a) && self.Complex.ACCEPTS(a)))
+my class ComplexStr is Allomorph is Complex {
+    method new(Complex:D $c, Str $s) {
+        my \new = nqp::create(self);
+        nqp::bindattr_n(new,Complex,'$!re',
+          nqp::getattr_n($c,Complex,'$!re'));
+        nqp::bindattr_n(new,Complex,'$!im',
+          nqp::getattr_n($c,Complex,'$!im'));
+        nqp::bindattr_s(new,Str,'$!value',$s);
+        new
     }
+
     method Capture(ComplexStr:D:) { self.Mu::Capture }
+
+    multi method Numeric(ComplexStr:U:) { self.Mu::Numeric; 0i }
     multi method Numeric(ComplexStr:D:) { self.Complex }
-    multi method Numeric(ComplexStr:U:) {
-        self.Mu::Numeric; # issue warning;
-        <0+0i>
+
+    method !has-imaginary($target) is hidden-from-backtrace {
+        X::Numeric::Real.new(
+          target => $target,
+          source => self,
+          reason => "imaginary part not zero"
+        ).throw
+    }
+
+    multi method Real(ComplexStr:U: --> 0e0) { self.Mu::Real }
+    multi method Real(ComplexStr:D:) {
+      nqp::getattr_n(self,Complex,'$!im')
+        ?? self!has-imaginary(Real)
+        !! nqp::getattr_n(self,Complex,'$!re')
+    }
+
+    multi method Int(ComplexStr:D:) {
+      nqp::getattr_n(self,Complex,'$!im')
+        ?? self!has-imaginary(Int)
+        !! nqp::getattr_n(self,Complex,'$!re')
     }
-    multi method Real(ComplexStr:D:) { self.Complex.Real }
-    multi method Real(ComplexStr:U:) {
-        self.Mu::Real; # issue warning;
-        <0+0i>.Real
+
+    method Complex(ComplexStr:D:) {
+        my \new = nqp::create(Complex);
+        nqp::bindattr_n(new,Complex,'$!re',
+          nqp::getattr_n(self,Complex,'$!re'));
+        nqp::bindattr_n(new,Complex,'$!im',
+          nqp::getattr_n(self,Complex,'$!im'));
+        new
     }
-    method Complex(ComplexStr:D:) { Complex.new(nqp::getattr_n(self, Complex, '$!re'), nqp::getattr_n(self, Complex, '$!im')) }
-    multi method Str(ComplexStr:D:) { nqp::getattr_s(self, Str, '$!value') }
+}
 
-    multi method raku(ComplexStr:D:) { self.^name ~ '.new(' ~ self.Complex.raku ~ ', ' ~ self.Str.raku ~ ')' }
+multi sub infix:<cmp>(Allomorph:D $a, Allomorph:D $b) is default {
+    $a.Numeric cmp $b.Numeric || $a.Str cmp $b.Str
 }
 
-# we define cmp ops for these allomorphic types as numeric first, then Str. If
-# you want just one half of the cmp, you'll need to coerce the args
-multi sub infix:<cmp>(IntStr:D     $a, IntStr:D     $b) { $a.Int     cmp $b.Int     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(IntStr:D     $a, RatStr:D     $b) { $a.Int     cmp $b.Rat     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(IntStr:D     $a, NumStr:D     $b) { $a.Int     cmp $b.Num     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(IntStr:D     $a, ComplexStr:D $b) { $a.Int     cmp $b.Complex || $a.Str cmp $b.Str }
-
-multi sub infix:<cmp>(RatStr:D     $a, IntStr:D     $b) { $a.Rat     cmp $b.Int     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(RatStr:D     $a, RatStr:D     $b) { $a.Rat     cmp $b.Rat     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(RatStr:D     $a, NumStr:D     $b) { $a.Rat     cmp $b.Num     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(RatStr:D     $a, ComplexStr:D $b) { $a.Rat     cmp $b.Complex || $a.Str cmp $b.Str }
-
-multi sub infix:<cmp>(NumStr:D     $a, IntStr:D     $b) { $a.Num     cmp $b.Int     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(NumStr:D     $a, RatStr:D     $b) { $a.Num     cmp $b.Rat     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(NumStr:D     $a, NumStr:D     $b) { $a.Num     cmp $b.Num     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(NumStr:D     $a, ComplexStr:D $b) { $a.Num     cmp $b.Complex || $a.Str cmp $b.Str }
-
-multi sub infix:<cmp>(ComplexStr:D $a, IntStr:D     $b) { $a.Complex cmp $b.Int     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(ComplexStr:D $a, RatStr:D     $b) { $a.Complex cmp $b.Rat     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(ComplexStr:D $a, NumStr:D     $b) { $a.Complex cmp $b.Num     || $a.Str cmp $b.Str }
-multi sub infix:<cmp>(ComplexStr:D $a, ComplexStr:D $b) { $a.Complex cmp $b.Complex || $a.Str cmp $b.Str }
-
-
-multi sub infix:<eqv>(IntStr:D     $a, IntStr:D     $b) { $a.Int     eqv $b.Int     && $a.Str eqv $b.Str }
-multi sub infix:<eqv>(IntStr:D     $a, RatStr:D     $b --> False) {}
-multi sub infix:<eqv>(IntStr:D     $a, NumStr:D     $b --> False) {}
-multi sub infix:<eqv>(IntStr:D     $a, ComplexStr:D $b --> False) {}
-
-multi sub infix:<eqv>(RatStr:D     $a, IntStr:D     $b --> False) {}
-multi sub infix:<eqv>(RatStr:D     $a, RatStr:D     $b) { $a.Rat     eqv $b.Rat     && $a.Str eqv $b.Str }
-multi sub infix:<eqv>(RatStr:D     $a, NumStr:D     $b --> False) {}
-multi sub infix:<eqv>(RatStr:D     $a, ComplexStr:D $b --> False) {}
-
-multi sub infix:<eqv>(NumStr:D     $a, IntStr:D     $b --> False) {}
-multi sub infix:<eqv>(NumStr:D     $a, RatStr:D     $b --> False) {}
-multi sub infix:<eqv>(NumStr:D     $a, NumStr:D     $b) { $a.Num     eqv $b.Num     && $a.Str eqv $b.Str }
-multi sub infix:<eqv>(NumStr:D     $a, ComplexStr:D $b --> False) {}
-
-multi sub infix:<eqv>(ComplexStr:D $a, IntStr:D     $b --> False) {}
-multi sub infix:<eqv>(ComplexStr:D $a, RatStr:D     $b --> False) {}
-multi sub infix:<eqv>(ComplexStr:D $a, NumStr:D     $b --> False) {}
-multi sub infix:<eqv>(ComplexStr:D $a, ComplexStr:D $b) { $a.Complex eqv $b.Complex && $a.Str eqv $b.Str }
+multi sub infix:<eqv>(Allomorph:D $a, Allomorph:D $b --> Bool:D) is default {
+    nqp::eqaddr($a.WHAT,$b.WHAT)
+      ?? $a.Numeric eqv $b.Numeric && $a.Str eqv $b.Str
+      !! False
+}
 
 multi sub infix:<===>(IntStr:D $a, IntStr:D $b) {
     $a.Int === $b.Int && $a.Str === $b.Str

diff --git a/src/core.c/operators.pm6 b/src/core.c/operators.pm6
@@ -55,13 +55,6 @@ multi sub infix:<does>(Mu:U \obj, **@roles) is raw {
     X::Does::TypeObject.new(type => obj).throw
 }
 
-# we need this candidate tighter than infix:<cmp>(Real:D, Real:D)
-# but can't yet use `is default` at the place where that candidate
-# is defined because it uses `infix:<does>`
-multi sub infix:<cmp>(Rational:D \a, Rational:D \b) is default {
-    a.isNaN || b.isNaN ?? a.Num cmp b.Num !! a <=> b
-}
-
 proto sub infix:<but>(Mu, |) is pure {*}
 multi sub infix:<but>(Mu:D \obj, Mu:U \rolish) {
     my $role := rolish.HOW.archetypes.composable() ?? rolish !!

diff --git a/t/02-rakudo/03-corekeys-6c.t b/t/02-rakudo/03-corekeys-6c.t
@@ -486,6 +486,7 @@ my @expected = (
   Q{&words},
   Q{&zip},
   Q{AST},
+  Q{Allomorph},
   Q{Any},
   Q{Array},
   Q{Associative},

diff --git a/t/02-rakudo/03-corekeys-6d.t b/t/02-rakudo/03-corekeys-6d.t
@@ -486,6 +486,7 @@ my @expected = (
     Q{&words},
     Q{&zip},
     Q{AST},
+    Q{Allomorph},
     Q{Any},
     Q{Array},
     Q{Associative},