infix:</>(Int, Int) creates a Rat, infix:<div>(Int, Int) an Int, as p…

…er latest S03 Also fix depending code, namely Temporal.pm Fix Rat.perl to return "N/M" rather than "Rat.new(N,M)". Switch GCD routine to use % instead of -, for a vast performance increase on widely mismatched numbers. Add Rat * Int, Int * Rat, Rat / Int, and Int / Rat overloads. Patch mostly by colomon++, with some minor contributions and cleanups by moritz See RT #68898 for discussion.
rakudo · Sep 1, 2009 · 39c3f4b · 39c3f4b
1 parent 4c08564
commit 39c3f4b
Show file tree

Hide file tree

Showing 5 changed files with 58 additions and 35 deletions.
diff --git a/CREDITS b/CREDITS
@@ -296,6 +296,10 @@ N: Simon Cozens
 U: simon
 E: simon@simon-cozens.org
 
+N: Solomon Foster
+U: colomon
+E: colomon@gmail.com
+
 N: Stéphane Payrard
 D: Various code fixes and improvements
 

diff --git a/build/gen_metaop_pir.pl b/build/gen_metaop_pir.pl
@@ -9,6 +9,8 @@
   **        1           op
   *         1           op
   /         'fail'      op
+  div       'fail'      op
+  mod       'fail'      op
   %         'fail'      op
   x         'fail'      op
   xx        'fail'      op

diff --git a/src/setting/Int.pm b/src/setting/Int.pm
@@ -49,21 +49,14 @@ multi sub infix:<*>(Int $a, Int $b) {
     }
 }
 
-multi sub infix:</>(Int $a, Int $b) {
+multi sub infix:<div>(Int $a, Int $b) {
     Q:PIR {
         $P0 = find_lex '$a'
-        $N0 = $P0
+        $I0 = $P0
         $P1 = find_lex '$b'
-        $N1 = $P1
-        $N2 = $N0 / $N1
-        $I2 = floor $N2
-        $N3 = $N2 - $I2
-      if $N3 != 0 goto notint
-        %r = '!upgrade_to_num_if_needed'($N2)
-        goto done
-      notint:
-        %r = box $N2
-      done:
+        $I1 = $P1
+        $I2 = $I0 / $I1
+        %r = box $I2
     }
 }
 

diff --git a/src/setting/Rat.pm b/src/setting/Rat.pm
@@ -9,7 +9,7 @@ class Rat {
         while $a > 0 && $b > 0
         {
             ($a, $b) = ($b, $a) if ($b > $a);
-            $a -= $b;
+            $a %= $b;
         }
         return $a + $b;
     }
@@ -20,10 +20,12 @@ class Rat {
             $denominator = -$denominator;
         }
         my $gcd = gcd($numerator, $denominator);
-        $numerator /= $gcd;
-        $denominator /= $gcd;
+        $numerator = $numerator div $gcd;
+        $denominator = $denominator div $gcd;
         self.bless(*, :$numerator, :$denominator);
     }
+
+    multi method perl() { "$!numerator/$!denominator"; }
 
     multi method Str() { "$!numerator/$!denominator"; }
 
@@ -52,15 +54,35 @@ multi sub infix:<->(Rat $a, Int $b) {
     Rat.new($a.numerator - $b * $a.denominator, $a.denominator);
 }
 
+multi sub infix:<->(Int $a, Rat $b) {
+    Rat.new($a * $b.denominator - $b.numerator, $b.denominator);
+}
+
 multi sub infix:<*>(Rat $a, Rat $b) {
     Rat.new($a.numerator * $b.numerator, $a.denominator * $b.denominator);
 }
 
+multi sub infix:<*>(Rat $a, Int $b) {
+    Rat.new($a.numerator * $b, $a.denominator);
+}
+
+multi sub infix:<*>(Int $a, Rat $b) {
+    Rat.new($a * $b.numerator, $b.denominator);
+}
+
 multi sub infix:</>(Rat $a, Rat $b) {
     Rat.new($a.numerator * $b.denominator, $a.denominator * $b.numerator);
 }
 
-multi sub infix:<div>(Int $a, Int $b) {
+multi sub infix:</>(Rat $a, Int $b) {
+    Rat.new($a.numerator, $a.denominator * $b);
+}
+
+multi sub infix:</>(Int $a, Rat $b) {
+    Rat.new($b.denominator, $a * $b.numerator);
+}
+
+multi sub infix:</>(Int $a, Int $b) {
     Rat.new($a, $b);
 }
 

diff --git a/src/setting/Temporal.pm b/src/setting/Temporal.pm
@@ -17,11 +17,11 @@ role Temporal::Date {
 
     method day-of-week { # returns DayOfWeek {
         my ( $a, $y, $m, $jd );         # algorithm from Claus Tøndering
-        $a = floor((14 - $.month) / 12 );
+        $a = (14 - $.month) div 12;
         $y = $.year + 4800 - $a;
         $m = $.month + 12 * $a - 3;
-        $jd = $.day + floor((153 * $m + 2) / 5) + 365 * $y + floor( $y / 4 )
-              - floor( $y / 100 ) + floor( $y / 400 ) - 32045;
+        $jd = $.day + (153 * $m + 2) div 5 + 365 * $y + $y div 4
+              - $y div 100 +$y div 400 - 32045;
         return ($jd + 1) % 7 + 1;
     }
 
@@ -90,8 +90,8 @@ role Temporal::TimeZone::Observance {
     # The ISO8601 standard does not allow for offsets with sub-minute
     # resolutions. In real-world practice, this is not an issue.
     our Str method iso8601 {
-        sprintf "%+03d%02d", self.offset / 3600,
-            floor( abs(self.offset) / 60 ) % 60;
+        sprintf "%+03d%02d", self.offset div 3600,
+                (abs(self.offset) div 60 ) % 60;
     }
 
     method Str { self.iso8601 }
@@ -117,11 +117,13 @@ role Temporal::DateTime {
     # This involves a whole bunch of code - see Perl 5's Time::Local
     our Num method epoch {
         my ( $a, $y, $m, $jd );         # algorithm from Claus Tøndering
-        $a = floor((14 - $.date.month) / 12 );
-        $y = $.date.year + 4800 - $a;
-        $m = $.date.month + 12 * $a - 3;
         $jd = $.date.day + floor((153 * $m + 2) / 5) + 365 * $y
             + floor( $y / 4 ) - floor( $y / 100 ) + floor( $y / 400 ) - 32045;
+        $a = (14 - $.date.month) div 12;
+        $y = $.date.year + 4800 - $a;
+        $m = $.date.month + 12 * $a - 3;
+        $jd = $.date.day + (153 * $m + 2) div 5 + 365 * $y
+            + $y div 4 - $y div 100 + $y div 400  - 32045;
         return ($jd - 2440588) * 24 * 60 * 60
                + ($.time.hour*60 + $.time.minute)*60 + $.time.second;
     }
@@ -136,21 +138,21 @@ class Time {
     our method gmtime( Num $epoch = time ) {
         my ( $time, $second, $minute, $hour, $day, $month, $year );
         $time = floor( $epoch );
-        $second  = $time % 60; $time = floor($time/60);
-        $minute  = $time % 60; $time = floor($time/60);
-        $hour    = $time % 24; $time = floor($time/24);
+        $second  = $time % 60; $time = $time div 60;
+        $minute  = $time % 60; $time = $time div 60;
+        $hour    = $time % 24; $time = $time div 24;
         # Day month and leap year arithmetic, based on Gregorian day #.
         # 2000-01-01 noon UTC == 2451558.0 Julian == 2451545.0 Gregorian
         $time += 2440588;   # because 2000-01-01 == Unix epoch day 10957
         my $a = $time + 32044;     # date algorithm from Claus Tøndering
-        my $b = floor((4 * $a + 3) / 146097); # 146097=days in 400 years
-        my $c = $a - floor(( 146097 * $b ) / 4);
-        my $d = floor((4 * $c + 3) / 1461);       # 1461=days in 4 years
-        my $e = $c - floor(($d * 1461) / 4);
-        my $m = floor((5 * $e + 2) / 153); # 153=days in Mar-Jul Aug-Dec
-        $day   = $e - floor((153 * $m + 2) / 5 ) + 1;
-        $month = $m + 3 - 12 * floor( $m / 10 );
-        $year  = $b * 100 + $d - 4800 + floor( $m / 10 );
+        my $b = (4 * $a + 3) div 146097; # 146097 = days in 400 years
+        my $c = $a - ( 146097 * $b ) div 4;
+        my $d = (4 * $c + 3) div 1461;       # 1461 = days in 4 years
+        my $e = $c - ($d * 1461) div 4;
+        my $m = (5 * $e + 2) div 153; # 153 = days in Mar-Jul Aug-Dec
+        $day   = $e - (153 * $m + 2) div 5 + 1;
+        $month = $m + 3 - 12 * ( $m div 10 );
+        $year  = $b * 100 + $d - 4800 + $m div 10;
         Temporal::DateTime.new(
             date => Temporal::Date.new(:$year, :$month, :$day),
             time => Temporal::Time.new(:$hour, :$minute, :$second),