Introducing the allomorph class

- a subclass of Str - IntStr/NumStr/RatStr/ComplexStr are now subclasses of allomorph - replaced several nqp::ifs by ternaries - streamlined many coercions, specifically RatStr.Numeric - simplified 16 infix:<eqv> candidates into a single one - need further research to do same for infix:<cmp> and infix:<===> - make test and make spectest clean The reason for this is to make it easier and more extendable to handle allomorphs. Having an allomorph class should allow custom numeric objects to also include their allomorphic version. And having an allomorphic class should make typechecking for allomorphs more centralized as is proven by the infix:<eqv> simplification.
rakudo · Aug 24, 2020 · 716cacd · 716cacd
1 parent b005230
commit 716cacd
Show file tree

Hide file tree

Showing 7 changed files with 145 additions and 152 deletions.
diff --git a/src/core.c/allomorphs.pm6 b/src/core.c/allomorphs.pm6
@@ -1,11 +1,39 @@
+my class allomorph is Str {
+    multi method Bool(::?CLASS:D:) { self.Numeric.Bool }
+
+    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 WHICH(allomorph:D:) {
+        nqp::box_s(
+          nqp::join('|',nqp::list_s(
+            self.^name,
+            self.Numeric.WHICH,
+            self.Str.WHICH
+          )),
+          ValueObjAt
+        )
+    }
+
+    multi method raku(allomorph:D:) {
+        nqp::join("",nqp::list_s(
+          self.^name,'.new(',self.Numeric.raku,', ',self.Str.raku,')'
+        ))
+    }
+}
+
 # the uses of add_I in this class are a trick to make bigints work right
-my class IntStr is Int is Str {
+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;
+        SELF
     }
-    multi method ACCEPTS(IntStr:D: Any:D \a) {
+    multi method ACCEPTS(IntStr:D: Any:D \a) is default {
         nqp::if(
           nqp::istype(a, Numeric),
             self.Int.ACCEPTS(a),
@@ -14,157 +42,131 @@ my class IntStr is Int is 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
-    }
-    multi method Real(IntStr:D:) { self.Int }
-    multi method Real(IntStr:U:) {
-        self.Mu::Real; # issue warning;
-        0
-    }
-    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 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 NumStr is Num is Str {
-    method new(Num $n, Str $s) {
-        my \SELF = nqp::create(self);
-        nqp::bindattr_n(SELF, Num, '$!value', $n);
-        nqp::bindattr_s(SELF, Str, '$!value', $s);
-        SELF;
+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
     }
-    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,')'
-        )))))
+
+    multi method ACCEPTS(NumStr:D: Any:D \a) is default {
+        nqp::istype(a,Numeric)
+          ?? self.Num.ACCEPTS(a)
+          !! nqp::istype(a,Str)
+            ?? self.Str.ACCEPTS(a)
+            !! self.Str.ACCEPTS(a) && self.Num.ACCEPTS(a)
     }
+    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 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 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 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 ACCEPTS(RatStr:D: Any:D \a) is default {
+        nqp::istype(a,Numeric)
+          ?? self.Rat.ACCEPTS(a)
+          !! nqp::istype(a,Str)
+            ?? self.Str.ACCEPTS(a)
+            !! self.Str.ACCEPTS(a) && self.Rat.ACCEPTS(a)
     }
+
     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;
+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
     }
-    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)))
+
+    multi method ACCEPTS(ComplexStr:D: Any:D \a) is default {
+        nqp::istype(a,Numeric)
+          ?? self.Complex.ACCEPTS(a)
+          !! nqp::istype(a,Str)
+            ?? self.Str.ACCEPTS(a)
+            !! self.Str.ACCEPTS(a) && self.Complex.ACCEPTS(a)
     }
+
     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 Real(ComplexStr:D:) { self.Complex.Real }
-    multi method Real(ComplexStr:U:) {
-        self.Mu::Real; # issue warning;
-        <0+0i>.Real
+
+    multi method Int(ComplexStr:D:) {
+      nqp::getattr_n(self,Complex,'$!im')
+        ?? self!has-imaginary(Int)
+        !! nqp::getattr_n(self,Complex,'$!re')
     }
-    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 ~ ')' }
+    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
+    }
 }
 
 # we define cmp ops for these allomorphic types as numeric first, then Str. If
@@ -189,26 +191,11 @@ multi sub infix:<cmp>(ComplexStr:D $a, RatStr:D     $b) { $a.Complex cmp $b.Rat
 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/t/02-rakudo/03-corekeys-6c.t b/t/02-rakudo/03-corekeys-6c.t
@@ -726,6 +726,7 @@ my @expected = (
   Q{WhateverCode},
   Q{WrapDispatcher},
   Q{X},
+  Q{allomorph},
   Q{array},
   Q{atomicint},
   Q{blob16},

diff --git a/t/02-rakudo/03-corekeys-6d.t b/t/02-rakudo/03-corekeys-6d.t
@@ -726,6 +726,7 @@ my @expected = (
     Q{WhateverCode},
     Q{WrapDispatcher},
     Q{X},
+    Q{allomorph},
     Q{array},
     Q{atomicint},
     Q{blob16},

diff --git a/t/02-rakudo/03-corekeys-6e.t b/t/02-rakudo/03-corekeys-6e.t
@@ -728,6 +728,7 @@ my @expected = (
     Q{WhateverCode},
     Q{WrapDispatcher},
     Q{X},
+    Q{allomorph},
     Q{array},
     Q{atomicint},
     Q{blob16},

diff --git a/t/02-rakudo/03-corekeys.t b/t/02-rakudo/03-corekeys.t
@@ -729,6 +729,7 @@ my @allowed =
       Q{WhateverCode},
       Q{WrapDispatcher},
       Q{X},
+      Q{allomorph},
       Q{array},
       Q{atomicint},
       Q{blob16},

diff --git a/t/02-rakudo/04-settingkeys-6c.t b/t/02-rakudo/04-settingkeys-6c.t
@@ -726,6 +726,7 @@ my %allowed = (
     Q{WhateverCode},
     Q{WrapDispatcher},
     Q{X},
+    Q{allomorph},
     Q{array},
     Q{atomicint},
     Q{blob16},

diff --git a/t/02-rakudo/04-settingkeys-6e.t b/t/02-rakudo/04-settingkeys-6e.t
@@ -726,6 +726,7 @@ my %allowed = (
     Q{WhateverCode},
     Q{WrapDispatcher},
     Q{X},
+    Q{allomorph},
     Q{array},
     Q{atomicint},
     Q{blob16},