From 38d43daebcc4e56bf70e6c8ff3e5b0b9f92a90bb Mon Sep 17 00:00:00 2001
From: Kodi Arfer <hippo@Thoth.(none)>
Date: Fri, 27 Aug 2010 16:09:54 -0400
Subject: [PATCH] Implemented Instants and Durations.

---
 build/Makefile.in    |    2 +
 docs/ChangeLog       |    3 +
 src/core/Duration.pm |   75 ++++++++++++++++++++++++++++++++++
 src/core/Instant.pm  |  108 ++++++++++++++++++++++++++++++++++++++++++++++++++
 src/core/Temporal.pm |   14 +++++--
 src/core/tai-utc.pm  |   86 +++++++++++++++++++++++++++------------
 6 files changed, 257 insertions(+), 31 deletions(-)
 create mode 100644 src/core/Duration.pm
 create mode 100644 src/core/Instant.pm

diff --git a/build/Makefile.in b/build/Makefile.in
index 3c00d7f..04a2f85 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -227,6 +227,8 @@ CORE_SOURCES = \
   src/core/system.pm \
   src/cheats/process.pm \
   src/core/tai-utc.pm \
+  src/core/Duration.pm \
+  src/core/Instant.pm \
   src/core/Temporal.pm \
   src/core/Match.pm \
   src/core/Attribute.pm \
diff --git a/docs/ChangeLog b/docs/ChangeLog
index f0239ec..d015223 100644
--- a/docs/ChangeLog
+++ b/docs/ChangeLog
@@ -1,3 +1,6 @@
++ S32::Temporal now completely implemented
++ Instants and Durations
+
 New in 2010.08 release
 + syntactic adverbs on substitutions, rx quotes and m//, e.g. '$x ~~ s:2nd/a/b/'
 + updated ROADMAP
diff --git a/src/core/Duration.pm b/src/core/Duration.pm
new file mode 100644
index 0000000..97effe2
--- /dev/null
+++ b/src/core/Duration.pm
@@ -0,0 +1,75 @@
+use v6;
+
+class Duration does Real {
+    has Rat $.x = 0;
+      # A linear count of seconds.
+
+    method new($x) { self.bless: *, x => $x.Rat }
+
+    method Bridge() { $.x }
+
+    method Str() { ~$.x }
+
+    method perl() { "Duration.new({$.x.perl})" }
+}
+
+our multi sub prefix:<->(Duration $a) {
+    Duration.new: -$a.x;
+}
+
+our multi sub infix:<+>(Duration $a, Real $b) {
+    Duration.new: $a.x + $b;
+}
+our multi sub infix:<+>(Real $a, Duration $b) {
+    Duration.new: $a + $b.x;
+}
+our multi sub infix:<+>(Duration $a, Duration $b) {
+    Duration.new: $a.x + $b.x;
+}
+
+our multi sub infix:<->(Duration $a, Real $b) {
+    Duration.new: $a.x - $b;
+}
+our multi sub infix:<->(Real $a, Duration $b) {
+    Duration.new: $a - $b.x;
+}
+our multi sub infix:<->(Duration $a, Duration $b) {
+    Duration.new: $a.x - $b.x;
+}
+
+our multi sub infix:<*>(Duration $a, Real $b) {
+    Duration.new: $a.x * $b
+}
+our multi sub infix:<*>(Real $a, Duration $b) {
+    Duration.new: $a * $b.x
+}
+our multi sub infix:<*>(Duration $a, Duration $b) {
+    die "Can't multiply Durations together"
+}
+
+our multi sub infix:</>(Duration $a, Real $b) {
+    Duration.new: $a.x / $b
+}
+our multi sub infix:</>(Real $a, Duration $b) {
+    Duration.new: $b / $a.x
+}
+our multi sub infix:</>(Duration $a, Duration $b) {
+    die "Can't divide a Duration by a Duration"
+}
+
+our multi sub infix:<%>(Duration $a, Real $b) {
+    Duration.new: $a.x % $b
+}
+our multi sub infix:<%>(Real $a, Duration $b) {
+    Duration.new: $b % $a.x
+}
+our multi sub infix:<%>(Duration $a, Duration $b) {
+    die "Can't take remainder after division of a Duration by a Duration"
+}
+
+our multi sub infix:<**>(Duration $a, Real $b) {
+    die "Can't exponentiate a Duration"
+}
+our multi sub infix:<**>(Real $a, Duration $b) {
+    die "Can't use a Duration as an exponent"
+}
diff --git a/src/core/Instant.pm b/src/core/Instant.pm
new file mode 100644
index 0000000..d438b84
--- /dev/null
+++ b/src/core/Instant.pm
@@ -0,0 +1,108 @@
+use v6;
+
+class Instant {
+    has Rat $.x;
+      # A linear count of seconds since 1970-01-01T00:00:00Z, plus
+      # tai-utc::initial-offset. Thus, $.x matches TAI from 1970
+      # to the present.
+
+    method new($x) { self.bless: *, x => $x.Rat }
+
+    method from-posix($posix, Bool $prefer-leap-second = False) {
+    # $posix is in general not expected to be an integer.
+    # If $prefer-leap-second is true, 915148800 is interpreted to
+    # mean 1998-12-31T23:59:60Z rather than 1999-01-01T00:00:00Z.
+        my $p = floor $posix;
+        my $offset = tai-utc::initial-offset;
+        for tai-utc::leap-second-posix() {
+            if $_ < $p {
+                ++$offset;
+            } else {
+                return self.new: $posix + $offset + do
+                    $_ == $p && !$prefer-leap-second 
+            }
+        }
+        self.new: $posix + $offset;
+    }
+
+    method to-posix() {
+    # The inverse of .from-posix, except that the second return
+    # value is true if *and only if* this Instant is in a leap
+    # second.
+        my $n = floor $.x;
+        my $offset = tai-utc::initial-offset;
+        for tai-utc::leap-second-posix() {
+            if $_ < $n - $offset {
+                ++$offset;
+            } else {
+                return ($.x - $offset, $n - $offset == $_)
+            }
+        }
+        ($.x - $offset, False)
+    }
+
+    method Str() { self.perl }
+
+    method perl() {
+        sprintf '(DateTime.new(year => 1970).Instant + %s)',
+            ($.x - tai-utc::initial-offset).perl
+    }
+}
+
+our multi sub infix:«cmp»(Instant $a, Instant $b) {
+    $a.x <=> $b.x
+}
+
+our multi sub infix:«<=>»(Instant $a, Instant $b) {
+    $a.x <=> $b.x
+}
+
+our multi sub infix:«==»(Instant $a, Instant $b) {
+    $a.x == $b.x
+}
+
+our multi sub infix:«!=»(Instant $a, Instant $b) {
+    $a.x != $b.x
+}
+
+our multi sub infix:«<»(Instant $a, Instant $b) {
+    $a.x < $b.x
+}
+
+our multi sub infix:«>»(Instant $a, Instant $b) {
+    $a.x > $b.x
+}
+
+our multi sub infix:«<=»(Instant $a, Instant $b) {
+    $a.x <= $b.x
+}
+
+our multi sub infix:«>=»(Instant $a, Instant $b) {
+    $a.x >= $b.x
+}
+
+our multi sub infix:<+>(Instant $a, Real $b) {
+    Instant.new: $a.x + $b;
+}
+our multi sub infix:<+>(Real $a, Instant $b) {
+    Instant.new: $a + $b.x;
+}
+our multi sub infix:<+>(Instant $a, Duration $b) {
+    Instant.new: $a.x + $b.x;
+}
+our multi sub infix:<+>(Duration $a, Instant $b) {
+    Instant.new: $a.x + $b.x;
+}
+
+our multi sub infix:<->(Instant $a, Instant $b) {
+    Duration.new: $a.x - $b.x;
+}
+our multi sub infix:<->(Instant $a, Real $b) {
+    Instant.new: $a.x - $b;
+}
+
+our sub now {
+    # FIXME: During a leap second, the returned value is one
+    # second greater than it should be.
+    Instant.from-posix: pir::time__n
+}
diff --git a/src/core/Temporal.pm b/src/core/Temporal.pm
index ba79e29..028af25 100644
--- a/src/core/Temporal.pm
+++ b/src/core/Temporal.pm
@@ -175,7 +175,12 @@ class DateTime is Dateish {
             day => $date.day, |%_)
     }
 
-    # TODO: multi method new(Instant $i, ...) { ... }
+    multi method new(Instant $i, :$timezone=0, :&formatter=&default-formatter) {
+        my ($p, $leap-second) = $i.to-posix;
+        my $dt = self.new: floor($p - $leap-second), :&formatter;
+        $dt.clone(second => $dt.second + $p % 1 + $leap-second
+            ).in-timezone($timezone);
+    }
 
     multi method new(Int $time is copy, :$timezone=0, :&formatter=&default-formatter) {
     # Interpret $time as a POSIX time.
@@ -225,8 +230,7 @@ class DateTime is Dateish {
 
     multi method now(:$timezone=0, :&formatter=&default-formatter) {
     # FIXME: Default to the user's time zone instead of UTC.
-    # FIXME: Include fractional seconds.
-        self.new(time, :$timezone, :&formatter)
+        self.new(now, :$timezone, :&formatter)
     }
 
     multi method clone(*%_) {
@@ -245,7 +249,9 @@ class DateTime is Dateish {
             |%_)
     }
 
-    # TODO: multi method Instant() { ... }
+    multi method Instant() {
+        Instant.from-posix: self.posix + $.second % 1, $.second >= 60;
+    }
 
     multi method posix() {
         self.offset and return self.utc.posix;
diff --git a/src/core/tai-utc.pm b/src/core/tai-utc.pm
index a5c123d..179afac 100644
--- a/src/core/tai-utc.pm
+++ b/src/core/tai-utc.pm
@@ -9,39 +9,71 @@ use v6;
 
 module tai-utc {
 
+    #our $initial-offset = 10;
+    our sub initial-offset() { 10 }
+      # TAI - UTC at the Unix epoch (1970-01-01T00:00:00Z).
+
     # our @leap-second-dates = <
-    our sub leap-second-dates { <
-        2008-12-31
-        2005-12-31
-        1998-12-31
-        1997-06-30
-        1995-12-31
-        1994-06-30
-        1993-06-30
-        1992-06-30
-        1990-12-31
-        1989-12-31
-        1987-12-31
-        1985-06-30
-        1983-06-30
-        1982-06-30
-        1981-06-30
-        1979-12-31
-        1978-12-31
-        1977-12-31
-        1976-12-31
-        1975-12-31
-        1974-12-31
-        1973-12-31
-        1972-12-31
+    our sub leap-second-dates() { <
         1972-06-30
-        1971-12-31
+        1972-12-31
+        1973-12-31
+        1974-12-31
+        1975-12-31
+        1976-12-31
+        1977-12-31
+        1978-12-31
+        1979-12-31
+        1981-06-30
+        1982-06-30
+        1983-06-30
+        1985-06-30
+        1987-12-31
+        1989-12-31
+        1990-12-31
+        1992-06-30
+        1993-06-30
+        1994-06-30
+        1995-12-31
+        1997-06-30
+        1998-12-31
+        2005-12-31
+        2008-12-31
     > };
 
-    # our %leap-seconds = reverse(@leap-second-dates) Z=> 10 .. *;
+    # our %leap-seconds =
+    #     @leap-second-dates Z=> $initial-offset + 1 .. *;
 
     # So for any date $d in @leap-second-dates, $d 23:59:00 UTC
     # is the leap second that made (or will make) UTC
     # %leap-seconds{$d} seconds behind TAI.
-    
+
+    # Ambiguous POSIX times.
+    our sub leap-second-posix() { <
+          78796800
+          94694400 
+         126230400 
+         157766400 
+         189302400 
+         220924800 
+         252460800 
+         283996800 
+         315532800 
+         362793600 
+         394329600 
+         425865600 
+         489024000 
+         567993600 
+         631152000 
+         662688000 
+         709948800 
+         741484800 
+         773020800 
+         820454400 
+         867715200 
+         915148800 
+        1136073600 
+        1230768000 
+    > };
+
 };
-- 
1.7.0.4