From 5734b0bdf8ebc2da1f9bd6ee1707b709851cd284 Mon Sep 17 00:00:00 2001 From: Solomon Foster Date: Mon, 31 Aug 2009 19:02:28 -0400 Subject: [PATCH] Changes needed to swap the meanings of div and /, as per latest S03. Please note that the div command in Int.pm almost certainly needs some tweaking to meet the spec, I have just given it the meaning of the old /, but there are subtle differences. Also we have one failing test in Temporal.t, leading me to suspect I messed something up in the Temporal.pm patch. --- CREDITS | 4 ++++ build/gen_metaop_pir.pl | 2 ++ src/setting/Int.pm | 2 +- src/setting/Rat.pm | 12 +++++++++--- src/setting/Temporal.pm | 38 +++++++++++++++++++------------------- 5 files changed, 35 insertions(+), 23 deletions(-) diff --git a/CREDITS b/CREDITS index 3a4858a..97a5c54 100644 --- 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 index dc47087..92bf23d 100644 --- a/build/gen_metaop_pir.pl +++ b/build/gen_metaop_pir.pl @@ -9,6 +9,8 @@ my @ops = qw( ** 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 index 27bbcd7..864e551 100644 --- a/src/setting/Int.pm +++ b/src/setting/Int.pm @@ -49,7 +49,7 @@ multi sub infix:<*>(Int $a, Int $b) { } } -multi sub infix:(Int $a, Int $b) { +multi sub infix:
(Int $a, Int $b) { Q:PIR { $P0 = find_lex '$a' $N0 = $P0 diff --git a/src/setting/Rat.pm b/src/setting/Rat.pm index 9f34f9d..ba73dac 100644 --- a/src/setting/Rat.pm +++ b/src/setting/Rat.pm @@ -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() { "Rat.new($!numerator, $!denominator)"; } multi method Str() { "$!numerator/$!denominator"; } @@ -52,6 +54,10 @@ 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); } @@ -60,7 +66,7 @@ multi sub infix:(Rat $a, Rat $b) { Rat.new($a.numerator * $b.denominator, $a.denominator * $b.numerator); } -multi sub infix:
(Int $a, Int $b) { +multi sub infix:(Int $a, Int $b) { Rat.new($a, $b); } diff --git a/src/setting/Temporal.pm b/src/setting/Temporal.pm index c7fd3df..294c194 100644 --- 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 = int((14 - $.month) / 12 ); + $a = int((14 - $.month) div 12 ); $y = $.year + 4800 - $a; $m = $.month + 12 * $a - 3; - $jd = $.day + int((153 * $m + 2) / 5) + 365 * $y + int( $y / 4 ) - - int( $y / 100 ) + int( $y / 400 ) - 32045; + $jd = $.day + int((153 * $m + 2) div 5) + 365 * $y + int( $y div 4 ) + - int( $y div 100 ) + int( $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, - int( abs(self.offset) / 60 ) % 60; + sprintf "%+03d%02d", self.offset div 3600, + int( abs(self.offset) div 60 ) % 60; } method Str { self.iso8601 } @@ -117,11 +117,11 @@ 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 = int((14 - $.date.month) / 12 ); + $a = int((14 - $.date.month) div 12 ); $y = $.date.year + 4800 - $a; $m = $.date.month + 12 * $a - 3; - $jd = $.date.day + int((153 * $m + 2) / 5) + 365 * $y - + int( $y / 4 ) - int( $y / 100 ) + int( $y / 400 ) - 32045; + $jd = $.date.day + int((153 * $m + 2) div 5) + 365 * $y + + int( $y div 4 ) - int( $y div 100 ) + int( $y div 400 ) - 32045; return ($jd - 2440588) * 24 * 60 * 60 + ($.time.hour*60 + $.time.minute)*60 + $.time.second; } @@ -136,21 +136,21 @@ class Time { our method gmtime( Num $epoch = time ) { my ( $time, $second, $minute, $hour, $day, $month, $year ); $time = int( $epoch ); - $second = $time % 60; $time = int($time/60); - $minute = $time % 60; $time = int($time/60); - $hour = $time % 24; $time = int($time/24); + $second = $time % 60; $time = int($time div 60); + $minute = $time % 60; $time = int($time div 60); + $hour = $time % 24; $time = int($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 = int((4 * $a + 3) / 146097); # 146097 = days in 400 years - my $c = $a - int(( 146097 * $b ) / 4); - my $d = int((4 * $c + 3) / 1461); # 1461 = days in 4 years - my $e = $c - int(($d * 1461) / 4); - my $m = int((5 * $e + 2) / 153); # 153 = days in Mar-Jul Aug-Dec - $day = $e - int((153 * $m + 2) / 5 ) + 1; - $month = $m + 3 - 12 * int( $m / 10 ); - $year = $b * 100 + $d - 4800 + int( $m / 10 ); + my $b = int((4 * $a + 3) div 146097); # 146097 = days in 400 years + my $c = $a - int(( 146097 * $b ) div 4); + my $d = int((4 * $c + 3) div 1461); # 1461 = days in 4 years + my $e = $c - int(($d * 1461) div 4); + my $m = int((5 * $e + 2) div 153); # 153 = days in Mar-Jul Aug-Dec + $day = $e - int((153 * $m + 2) div 5 ) + 1; + $month = $m + 3 - 12 * int( $m div 10 ); + $year = $b * 100 + $d - 4800 + int( $m div 10 ); Temporal::DateTime.new( date => Temporal::Date.new(:$year, :$month, :$day), time => Temporal::Time.new(:$hour, :$minute, :$second), -- 1.6.0.5