;;;; srfi-19-tm.scm  -*- Scheme -*-
;;;; Chicken port, Kon Lovett, Dec '05

;; SRFI-19: Time Data Types and Procedures.
;;
;; Copyright (C) I/NET, Inc. (2000, 2002, 2003). All Rights Reserved.
;; Copyright (C) Neodesic Corporation (2000). All Rights Reserved.
;;
;; This document and translations of it may be copied and furnished to others,
;; and derivative works that comment on or otherwise explain it or assist in its
;; implementation may be prepared, copied, published and distributed, in whole or
;; in part, without restriction of any kind, provided that the above copyright
;; notice and this paragraph are included on all such copies and derivative works.
;; However, this document itself may not be modified in any way, such as by
;; removing the copyright notice or references to the Scheme Request For
;; Implementation process or editors, except as needed for the purpose of
;; developing SRFIs in which case the procedures for copyrights defined in the SRFI
;; process must be followed, or as required to translate it into languages other
;; than English.
;;
;; The limited permissions granted above are perpetual and will not be revoked
;; by the authors or their successors or assigns.
;;
;; This document and the information contained herein is provided on an "AS IS"
;; basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE
;; INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF
;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.

;; Issues
;;
;; - Gregorian calendar only.
;;
;; - Initialization is scattered throughout the code, so converting to a module will
;; involve some search.
;;
;; - Some errors have incorrect procedure labels (not the top-level loc)
;;
;; - The Private API but must be visible because of exported syntax
;;
;; - Forces module component of global time/date struct identifiers
;;
;; - Use of modulo vs remainder - differing sign problem

;; Bugs
;;
;; - The 'date-dst?' field is problimatic. It is only valid on certain
;; platforms & only when current. A past or future date will not have this
;; field correct!
;;
;; - Time -> Date conversion takes account of the CURRENT daylight saving time state,
;; NOT the state of the converted date.

;; Notes
;;
;; - There is no year zero. So when converting from a BCE year on the sign of the year
;; needs to be changed, do not subtract one. i.e. 4714 BCE is -4714, not -4713!
;;
;; - Uses ISO 8601 timezone offset interpretation! So an added offset is "away" from
;; UTC & a subtracted offset is "towards" UTC.
;;
;; - Monotonic Time (almost) same as TAI. To redefine Monotonic Time must visit every
;; conversion procedure.

(module srfi-19-tm

(;export
  date-timezone-info date time
  tm:read-tai-utc-data
  tm:calc-second-before-leap-second-table
  tm:read-leap-second-table
  tm:any-time
  tm:some-time
  tm:as-some-time
  tm:time-type
  tm:time-nanosecond
  tm:time-second
  tm:time-type-set!
  tm:time-nanosecond-set!
  tm:time-second-set!
  tm:time?
  tm:make-time
  tm:copy-time
  tm:time-has-type?
  tm:nanoseconds->time-values
  tm:time->nanoseconds
  tm:time->milliseconds
  tm:nanoseconds->seconds
  tm:milliseconds->seconds
  tm:time->seconds
  tm:duration-elements->time-values
  tm:milliseconds->time-values
  tm:seconds->time-values
  tm:seconds->time
  tm:current-time-utc
  tm:current-time-tai
  tm:current-time-monotonic
  tm:current-time-thread
  tm:current-time-process
  tm:current-time-gc
  tm:time-resolution
  tm:time-compare
  tm:time=?
  tm:time<?
  tm:time<=?
  tm:time>?
  tm:time>=?
  tm:time-max
  tm:time-min
  tm:time-difference
  tm:add-duration
  tm:subtract-duration
  tm:divide-duration
  tm:multiply-duration
  tm:time-abs
  tm:time-negate
  tm:time-zero? tm:time-positive? tm:time-negative?
  tm:time-tai->time-utc
  tm:time-tai->time-monotonic
  tm:time-utc->time-tai
  tm:time-utc->time-monotonic
  tm:time-monotonic->time-tai
  tm:time-monotonic->time-utc
  tm:leap-year?
  tm:leap-day?
  tm:days-in-month
  tm:date-nanosecond
  tm:date-second
  tm:date-minute
  tm:date-hour
  tm:date-day
  tm:date-month
  tm:date-year
  tm:date-zone-offset
  tm:date-zone-name
  tm:date-dst?
  tm:date-wday
  tm:date-yday
  tm:date-jday
  tm:date-timezone-info?
  tm:date-timezone-info
  tm:date-nanosecond-set!
  tm:date-second-set!
  tm:date-minute-set!
  tm:date-hour-set!
  tm:date-day-set!
  tm:date-month-set!
  tm:date-year-set!
  tm:date-zone-offset-set!
  tm:make-incomplete-date
  tm:date?
  tm:make-date
  tm:copy-date
  tm:date-complete?
  tm:seconds->date/type
  tm:current-date
  tm:date-compare
  tm:decode-julian-day-number
  tm:seconds->julian-day-number
  tm:tai-before-leap-second?
  tm:time-utc->date
  tm:time-tai->date
  tm:time->date
  tm:encode-julian-day-number
  tm:date->time-utc
  tm:date->time-tai
  tm:date->time-monotonic
  tm:date->time
  tm:natural-year
  tm:year-day
  tm:date-year-day
  tm:week-day
  tm:days-before-first-week
  tm:date-week-day
  tm:date-week-number
  tm:julian-day->modified-julian-day
  tm:julian-day
  tm:date->julian-day
  tm:seconds->julian-day
  tm:time-utc->julian-day
  tm:time-tai->julian-day
  tm:time-monotonic->julian-day
  tm:time->julian-day
  tm:time-utc->modified-julian-day
  tm:time-tai->modified-julian-day
  tm:time-monotonic->modified-julian-day
  tm:time->modified-julian-day
  tm:julian-day->nanoseconds
  tm:julian-day->time-values
  tm:modified-julian-day->julian-day
  tm:julian-day->time-utc
  tm:modified-julian-day->time-utc
  tm:default-date-adjust-integer)

(import scheme
  (chicken base)
  (chicken type)
  (only (chicken io) read-line)
  (only (chicken gc) current-gc-milliseconds)
  (only (chicken format) format)
  (only (chicken time) cpu-time current-seconds)
  (only (chicken time posix) seconds->utc-time)
  (only (chicken port) with-input-from-port with-input-from-string)
  (only locale timezone-components?)
  (only record-variants define-record-type-variant)
  (only srfi-19-timezone
    timezone-locale-offset timezone-locale-name timezone-locale-dst?))

;;;

(include-relative "srfi-19-common")

(include-relative "srfi-19-common.types")

;-> integer, exact!
(define-syntax number->exact-integer
  (syntax-rules ()
    ((number->exact-integer ?x)
      (let ((_x ?x))
        (if (fixnum? _x) _x
          (inexact->exact (floor _x)) ) ) ) ) )

;-> integer, inexact or exact!
(define-syntax number->integer
  (syntax-rules ()
    ((number->integer ?x)
      (let ((_x ?x))
        (if (integer? _x) _x
          (inexact->exact (floor _x)) ) ) ) ) )

;;; Timing Routines

;; Provide system timing reporting procedures

(define total-gc-milliseconds
  (let ((accum-ms 0))
    (lambda ()
      (set! accum-ms (+ accum-ms (current-gc-milliseconds)))
      accum-ms ) ) )

(define (total-cpu-milliseconds)
  (apply + (receive (cpu-time))) )

;FIXME needs a srfi-18 extension
(define current-thread-milliseconds total-cpu-milliseconds)

;;; Date TZ information extract

(: %make-date-timezone-info (timezone-name fixnum boolean --> date-timezone-info))
(: %date-timezone-info? (* -> boolean : date-timezone-info))
(: %date-timezone-info-name (date-timezone-info --> timezone-name))
(: %date-timezone-info-offset (date-timezone-info --> fixnum))
(: %date-timezone-info-dst? (date-timezone-info --> boolean))

(define date-timezone-info 'date-timezone-info)
(define-record-type-variant date-timezone-info (unchecked inline unsafe)
  (%make-date-timezone-info n o d)
  %date-timezone-info?
  (n %date-timezone-info-name)
  (o %date-timezone-info-offset)
  (d %date-timezone-info-dst?) )

;;; Constants

;; TAI-EPOCH: 1 January 1970 CE at 00:00:00 UTC

(define-constant TAI-EPOCH-YEAR 1970)

;; Used in julian calculation

(define-constant ONE-HALF 1/2)

;; Julian Day 0 = 1 January 4713 BCE at 12:00:00 UTC (Julian proleptic calendar)
;; Julian Day 0 = 24 November 4714 BCE at 12:00:00 UTC (Gregorian proleptic calendar)

(define-constant TAI-EPOCH-IN-JD 4881175/2)

;; Modified Julian Day 0 = 17 Nov 1858 CE at 00:00:00 UTC
;; Number of days less than a julian day.

(define-constant TAI-EPOCH-IN-MODIFIED-JD 4800001/2)

;; Julian conversion base century

(define-constant JDYR 4800)

;;; Leap Seconds

;; First leap year after epoch

(define-constant FIRST-LEAP-YEAR 1972)

;; Number of seconds after epoch of first leap year

(define-constant LEAP-START (* (- FIRST-LEAP-YEAR TAI-EPOCH-YEAR) SEC/YR))

;; A table of leap seconds
;; See "ftp://maia.usno.navy.mil/ser7/tai-utc.dat" and update as necessary.
;; See "https://www.ietf.org/timezones/data/leap-seconds.list"
;; seconds since 1900 - seconds since 1972 = 2208988800
;; Each entry is (utc seconds since epoch . # seconds to add for tai)
;; Note they go higher (2009) to lower (1972).

(define tm:leap-second-table
  '((1483228800 . 37)
    (1435708800 . 36)
    (1341100800 . 35)
    (1230768000 . 34)
    (1136073600 . 33)
    (915148800 . 32)
    (867715200 . 31)
    (820454400 . 30)
    (773020800 . 29)
    (741484800 . 28)
    (709948800 . 27)
    (662688000 . 26)
    (631152000 . 25)
    (567993600 . 24)
    (489024000 . 23)
    (425865600 . 22)
    (394329600 . 21)
    (362793600 . 20)
    (315532800 . 19)
    (283996800 . 18)
    (252460800 . 17)
    (220924800 . 16)
    (189302400 . 15)
    (157766400 . 14)
    (126230400 . 13)
    (94694400 . 12)
    (78796800 . 11)
    (63072000 . 10)
    ;Before 1972
    ;(-60480000 . 4.21317)
    ;(-126230400 . 4.31317)
    ;(-136771200 . 3.84013)
    ;(-142128000 . 3.74013)
    ;(-152668800 . 3.64013)
    ;(-157766400 . 3.54013)
    ;(-168307200 . 3.44013)
    ;(-181526400 . 3.34013)
    ;(-189388800 . 3.24013)
    ;(-194659200 . 1.945858)
    ;(-252460800 . 1.845858)
    ;(-265680000 . 1.372818)
    ;(-283996800 . 1.422818)
) )

;; This procedure reads the file in the
;; ftp://maia.usno.navy.mil/ser7/tai-utc.dat format and
;; creates a leap second table

(define (tm:read-tai-utc-data flnm)
  ;
  (define (convert-jd jd)
    (* (- (inexact->exact jd) TAI-EPOCH-IN-JD) SEC/DY))
  ;
  (define (convert-sec sec)
    (inexact->exact sec))
  ;
  (define (read-data)
    (let loop ((ls '()))
      (let ((line (read-line)))
        (if (eof-object? line) ls
          (let ((data (with-input-from-string (string-append "(" line ")") read)))
            (let ((year (car data))
                  (jd   (cadddr (cdr data)))
                  (secs (cadddr (cdddr data))) )
              (loop
                (if (< year FIRST-LEAP-YEAR) ls
                  (cons (cons (convert-jd jd) (convert-sec secs)) ls))) ) ) ) ) ) )
  ;
  (with-input-from-port (open-input-file flnm) read-data) )

;; Table of cummulative seconds, one second before the leap second.

(define (tm:calc-second-before-leap-second-table table)
  (let loop ((inlst table) (outlst '()))
    (if (null? inlst)
      (reverse outlst) ;keep input order anyway
      (let ((itm (car inlst)))
        (loop (cdr inlst) (cons (- (+ (car itm) (cdr itm)) 1) outlst)))) ) )

(define tm:second-before-leap-second-table
  (tm:calc-second-before-leap-second-table tm:leap-second-table))

;; Read a leap second table file in U.S. Naval Observatory format

(define (tm:read-leap-second-table flnm)
  (set! tm:leap-second-table (tm:read-tai-utc-data flnm))
  (set!
    tm:second-before-leap-second-table
    (tm:calc-second-before-leap-second-table tm:leap-second-table)) )

;; leap-second-delta algorithm

; 'leap-second-item' is like the 'it' in the anaphoric 'if'
;
(define-syntax find-leap-second-delta*
  (er-macro-transformer
    (lambda (form r c)
      (let ((_let (r 'let))
            (_if (r 'if))
            (_null? (r 'null?))
            (_car (r 'car))
            (_cdr (r 'cdr))
            (_leap-second-item (r 'leap-second-item)) )
        (let ((?secs (cadr form))
              (?ls (caddr form))
              (?tst (cadddr form)) )
          `(,_let loop ((lsvar ,?ls))
              (,_if (,_null? lsvar)
                0
                (,_let ((leap-second-item (,_car lsvar)))
                    (,_if ,?tst
                      (,_cdr leap-second-item)
                      (loop (,_cdr lsvar)) ) ) ) ) ) ) ) ) )

(define-syntax leap-second-delta*
  (er-macro-transformer
    (lambda (form r c)
      (let ((_let (r 'let))
            (_if (r 'if))
            (_< (r '<))
            (_tm:leap-second-table (r 'tm:leap-second-table))
            (_LEAP-START (r 'LEAP-START))
            (_find-leap-second-delta* (r 'find-leap-second-delta*)) )
        (let ((?secs (cadr form))
              (?tst (caddr form)) )
          `(,_if (,_< ,?secs ,_LEAP-START)
            0
            (,_find-leap-second-delta* ,?secs ,_tm:leap-second-table ,?tst) ) ) ) ) ) )

;; Going from utc seconds ...

(define (leap-second-delta utc-seconds)
  (leap-second-delta*
    utc-seconds
    (<= (car leap-second-item) utc-seconds)) )

;; Going from tai seconds to utc seconds ...

(define (leap-second-neg-delta tai-seconds)
  (leap-second-delta*
    tai-seconds
    (<= (cdr leap-second-item) (- tai-seconds (car leap-second-item)))) )

;;; Time Object (Public Mutable)

;; There are 3 kinds of time record procedures:
;; *...   - generated
;; tm:... - argument processing then *...
;; ...    - argument checking then tm:...

(: %make-time ((or false symbol) (or false fixnum) (or false integer) --> time))
(: %time? (* -> boolean : time))
(: %time-type (time --> (or false symbol)))
(: %time-type-set! (time (or false symbol) -> void))
(: %time-nanosecond (time --> (or false fixnum)))
(: %time-nanosecond-set! (time (or false fixnum) -> void))
(: %time-second (time --> (or false integer)))
(: %time-second-set! (time (or false integer) -> void))

(define time 'time)
(define-record-type-variant time (unchecked inline unsafe)
  (%make-time tt ns sec)
  %time?
  (tt   %time-type        %time-type-set!)
  (ns   %time-nanosecond  %time-nanosecond-set!)
  (sec  %time-second      %time-second-set!) )

;; Time to Date

(define ONE-SECOND-DURATION (%make-time 'duration 0 1))

;;

;; <time-unit-value> -> <ns sec>

(define-inline (normalize-timeval t per)
  (quotient&remainder t per) )

(define-inline (normalize-nanoseconds ns)
  (normalize-timeval ns NS/S) )

; <ns sec min hr> -> <ns sec min hr dy>
;
#; ;UNUSED
(define (normalize-time ns sec min hr)
  (let*-values (((ns-sec ns) (normalize-nanoseconds ns))
                ((sec-min sec) (normalize-timeval (+ sec ns-sec) SEC/MIN))
                ((min-hr min) (normalize-timeval (+ min sec-min) MIN/HR))
                ((hr-dy hr) (normalize-timeval (+ hr min-hr) HR/DY)) )
    (values ns sec min hr (+ dy hr-dy)) ) )

;; Output Argument CTORs

;Used to create an output time record where all fields will be set later
;
(define (tm:any-time)
  (%make-time #f #f #f) )

;Used to create a time record where ns & sec fields will be set later
;
(define (tm:some-time tt)
  (%make-time tt #f #f) )

;Used to create a time record where ns & sec fields will be set later
;
(define (tm:as-some-time tim)
  (%make-time (%time-type tim) #f #f) )

;;

(define (tm:time-type tim)
  (%time-type tim) )

(define (tm:time-second tim)
  (%time-second tim) )

(define (tm:time-nanosecond tim)
  (%time-nanosecond tim) )

(define (tm:time-type-set! tim typ)
  (%time-type-set! tim typ) )

(define (tm:time-nanosecond-set! tim ns)
  (%time-nanosecond-set! tim (number->integer ns)) )

(define (tm:time-second-set! tim sec)
  (%time-second-set! tim (number->integer sec)) )

(define (tm:time? obj)
  (%time? obj) )

(define (tm:make-time tt ns sec)
  (let-values (
    ((ns-sec ns) (normalize-nanoseconds ns)) )
    (%make-time tt (number->integer ns) (number->integer (+ sec ns-sec))) ) )

(define (tm:copy-time tim)
  (%make-time (%time-type tim) (%time-nanosecond tim) (%time-second tim)) )

(define (tm:time-has-type? tim tt)
  (eq? tt (%time-type tim)) )

;; Rem & Quo of nanoseconds per second

(define (tm:nanoseconds->time-values nanos)
  (quotient&remainder nanos NS/S) )

;; Seconds Conversion

;;

(define (tm:time->nanoseconds tim)
  (+ (%time-nanosecond tim) (* (%time-second tim) NS/S)) )

(define (tm:time->milliseconds tim)
  (+ (/ (%time-nanosecond tim) MS/NS) (* (%time-second tim) MS/S)) )

(define (tm:nanoseconds->seconds ns)
  (/ ns NS/S) )

(define (tm:milliseconds->seconds ms)
  (/ ms MS/S) )

(define-syntax tm:time->seconds
  (syntax-rules ()
    ((tm:time->seconds ?tim)
      (tm:nanoseconds->seconds (tm:time->nanoseconds ?tim)) ) ) )

(define (tm:duration-elements->time-values
          days
          hours minutes seconds
          milliseconds microseconds nanoseconds)
  (let ((nanos (+ (* milliseconds MS/NS) (* microseconds MuS/NS) nanoseconds))
        (secs (+ (* days SEC/DY) (* hours SEC/HR) (* minutes SEC/MIN) seconds)) )
    (let-values (((ns-secs ns-ns)
                    (normalize-nanoseconds (+ nanos (* (- secs (floor secs)) NS/S)))) )
      (values ns-ns (+ (floor secs) ns-secs)) ) ) )

(define (tm:seconds->time-values sec)
  (let* ((isec (number->integer sec))
         (ns (number->integer (round (* (- sec isec) NS/S)))) )
    (values ns isec) ) )

(define (tm:milliseconds->time-values ms)
  (let-values (((sec ms-sec) (quotient&remainder ms MS/S)) )
    (let ((ns (* (number->integer ms-sec) MS/NS)))
      (values ns sec) ) ) )

(define-syntax tm:milliseconds->time
  (syntax-rules ()
    ((tm:milliseconds->time ?ms ?tt)
      (let-values (((ns sec) (tm:milliseconds->time-values ?ms)))
        (tm:make-time ?tt ns sec) ) ) ) )

(define-syntax tm:seconds->time
  (syntax-rules ()
    ((tm:seconds->time ?sec ?tt)
      (let-values (((ns sec) (tm:seconds->time-values ?sec)))
        (tm:make-time ?tt ns sec) ) ) ) )

;; Current time routines

(cond-expand
  (chicken-5.3
    ;add back C_startup_time_seconds
    (define tm:current-time-values
      (let ((t0 (current-seconds)))
        (lambda ()
          (import (only (chicken time) current-process-milliseconds))
          (let-values (((s ms) (quotient&remainder (current-process-milliseconds) MS/S)))
            (values (* ms MS/NS) (+ t0 s)) ) ) ) ) )
  (unix
    ;add back C_startup_time_seconds
    (define tm:current-time-values
      (let ((t0 (current-seconds)))
        (lambda ()
          (import (only (chicken time) current-milliseconds))
          (let-values (((s ms) (quotient&remainder (current-milliseconds) MS/S)))
            (values (* ms MS/NS) (+ t0 s)) ) ) ) ) )
  (else
    (define (tm:current-time-values)
      (values 0 (current-seconds)) ) ) )

(define (tm:current-time-utc)
  (let-values (((ns sec) (tm:current-time-values)))
    (tm:make-time 'utc ns sec) ) )

(define (tm:current-time-tai)
  (let-values (((ns sec) (tm:current-time-values)))
    (tm:make-time 'tai ns (+ sec (leap-second-delta sec))) ) )

(define (tm:current-time-monotonic)
  (let ((tim (tm:current-time-tai)))
    ;time-monotonic is time-tai
    (%time-type-set! tim 'monotonic)
    tim ) )

(define (tm:current-time-thread)
  (tm:milliseconds->time (current-thread-milliseconds) 'thread) )

(define (tm:current-time-process)
  (tm:milliseconds->time (total-cpu-milliseconds) 'process) )

(define (tm:current-time-gc)
  (tm:milliseconds->time (total-gc-milliseconds) 'gc) )

;; -- Time Resolution
;; This is the resolution of the clock in nanoseconds.
;; This will be implementation specific.

(define (tm:time-resolution tt)
  MS/NS )

;; Time Comparison

(define (tm:time-compare tim1 tim2)
  (let ((dif (- (%time-second tim1) (%time-second tim2))))
    (if (not (zero? dif))
      dif
      (- (%time-nanosecond tim1) (%time-nanosecond tim2)) ) ) )

(define (tm:time=? tim1 tim2)
  (and (= (%time-second tim1) (%time-second tim2))
       (= (%time-nanosecond tim1) (%time-nanosecond tim2))) )

(define (tm:time<? tim1 tim2)
  (or (< (%time-second tim1) (%time-second tim2))
      (and (= (%time-second tim1) (%time-second tim2))
           (< (%time-nanosecond tim1) (%time-nanosecond tim2)))) )

(define (tm:time<=? tim1 tim2)
  (or (< (%time-second tim1) (%time-second tim2))
      (and (= (%time-second tim1) (%time-second tim2))
           (<= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )

(define (tm:time>? tim1 tim2)
  (or (> (%time-second tim1) (%time-second tim2))
      (and (= (%time-second tim1) (%time-second tim2))
           (> (%time-nanosecond tim1) (%time-nanosecond tim2)))) )

(define (tm:time>=? tim1 tim2)
  (or (> (%time-second tim1) (%time-second tim2))
      (and (= (%time-second tim1) (%time-second tim2))
           (>= (%time-nanosecond tim1) (%time-nanosecond tim2)))) )

(define-syntax tm:time-max
  (syntax-rules ()
    ((tm:time-max ?tim1 ?tim2)
      (let ((tim1 ?tim1) (tim2 ?tim2))
        (if (tm:time>? tim1 tim2) tim1 tim2) ) ) ) )

(define-syntax tm:time-min
  (syntax-rules ()
    ((tm:time-min ?tim1 ?tim2)
      (let ((tim1 ?tim1) (tim2 ?tim2))
        (if (tm:time<? tim1 tim2) tim1 tim2) ) ) ) )

;; Time Arithmetic

(define (tm:add-duration tim1 dur timout)
  (let-values (((sec ns)
                  (tm:nanoseconds->time-values
                    (+ (%time-nanosecond tim1) (%time-nanosecond dur)))) )
    (let ((secs (+ (%time-second tim1) (%time-second dur) sec)))
      (cond
        ((negative? ns) ;Borrow
          ;Should never happen
          (tm:time-second-set! timout (+ secs -1))
          (tm:time-nanosecond-set! timout (+ ns NS/S)) )
        (else
          (tm:time-second-set! timout secs)
          (tm:time-nanosecond-set! timout ns) ) )
      timout ) ) )

(define (tm:subtract-duration tim1 dur timout)
  (let-values (((sec ns)
                  (tm:nanoseconds->time-values
                    (- (%time-nanosecond tim1) (%time-nanosecond dur)))) )
    #;(assert (zero? sec)) ;Since ns >= 0 the `sec' should be zero!
    (let ((secs (- (%time-second tim1) (%time-second dur) sec)))
      (cond
        ((negative? ns) ;Borrow
          (tm:time-second-set! timout (- secs 1))
          (tm:time-nanosecond-set! timout (+ ns NS/S)) )
        (else
          (tm:time-second-set! timout secs)
          (tm:time-nanosecond-set! timout ns) ) )
      timout ) ) )

(define (tm:divide-duration dur1 num durout)
  (let-values (((sec ns)
                  (tm:nanoseconds->time-values (/ (tm:time->nanoseconds dur1) num))))
    (tm:time-nanosecond-set! durout ns)
    (tm:time-second-set! durout sec)
    durout ) )

(define (tm:multiply-duration dur1 num durout)
  (let-values (((sec ns)
                  (tm:nanoseconds->time-values (* (tm:time->nanoseconds dur1) num))))
    (tm:time-nanosecond-set! durout ns)
    (tm:time-second-set! durout sec)
    durout ) )

(define (tm:time-difference tim1 tim2 timout)
  (let-values (((sec ns)
                  (tm:nanoseconds->time-values
                    (- (tm:time->nanoseconds tim1) (tm:time->nanoseconds tim2)))) )
    (tm:time-second-set! timout sec)
    (tm:time-nanosecond-set! timout ns)
    timout ) )

(define (tm:time-abs tim1 timout)
  (tm:time-nanosecond-set! timout (abs (%time-nanosecond tim1)))
  (tm:time-second-set! timout (abs (%time-second tim1)))
  timout )

(define (tm:time-negate tim1 timout )
  (tm:time-nanosecond-set! timout (- (%time-nanosecond tim1)))
  (tm:time-second-set! timout (- (%time-second tim1)))
  timout )

(define (tm:time-negative? tim)
  ;nanoseconds irrelevant
  (negative? (tm:time-second tim)) )

(define (tm:time-positive? tim)
  ;nanoseconds irrelevant
  (positive? (tm:time-second tim)) )

(define (tm:time-zero? tim)
  (and (zero? (tm:time-second tim))) (zero? (tm:time-nanosecond tim)) )

;; Time Type Converters

(define (tm:time-tai->time-utc timin timout)
  (%time-type-set! timout 'utc)
  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
  (tm:time-second-set! timout
    (- (%time-second timin) (leap-second-neg-delta (%time-second timin))))
  timout )

(define (tm:time-tai->time-monotonic timin timout)
  (%time-type-set! timout 'monotonic)
  (unless (eq? timin timout)
    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    (tm:time-second-set! timout (%time-second timin)))
  timout )

(define (tm:time-utc->time-tai timin timout)
  (%time-type-set! timout 'tai)
  (tm:time-nanosecond-set! timout (%time-nanosecond timin))
  (tm:time-second-set! timout
    (+ (%time-second timin) (leap-second-delta (%time-second timin))))
  timout )

(define (tm:time-utc->time-monotonic timin timout)
  (let ((ntim (tm:time-utc->time-tai timin timout)))
    (%time-type-set! ntim 'monotonic)
    ntim ) )

(define (tm:time-monotonic->time-tai timin timout)
  (%time-type-set! timout 'tai)
  (unless (eq? timin timout)
    (tm:time-nanosecond-set! timout (%time-nanosecond timin))
    (tm:time-second-set! timout (%time-second timin)))
  timout )

(define (tm:time-monotonic->time-utc timin timout)
  #;(%time-type-set! timin 'tai) ;fool converter (unnecessary)
  (tm:time-tai->time-utc timin timout) )

;;; Date Object (Public Immutable)

;; Leap Year Test

;; E.R. Hope. "Further adjustment of the Gregorian calendar year."
;; The Journal of the Royal Astronomical Society of Canada.
;; Part I, volume 58, number 1, pages 3-9 (February, 1964).
;; Part II, volume 58, number 2, pages 79-87 (April 1964).

(define (tm:leap-year? yr)
  (and
    #; ;!NOT Officially Adopted!
    (not (zero? (modulo yr 4000)))
    (or
      (zero? (modulo yr 400))
      (and
        (zero? (modulo yr 4))
        (not (zero? (modulo yr 100)))))) )

;; Days per Month

;Month range 1..12 so dys/mn range 0..12
(define      +year-dys/mn+ #(0 31 28 31 30 31 30 31 31 30 31 30 31))
(define +leap-year-dys/mn+ #(0 31 29 31 30 31 30 31 31 30 31 30 31))

(define-inline (days/month yr)
  (if (tm:leap-year? yr) +leap-year-dys/mn+ +year-dys/mn+) )

(define (tm:leap-day? dy mn)
  (= dy (vector-ref +leap-year-dys/mn+ mn)) )

(define (tm:days-in-month yr mn)
  (vector-ref (days/month yr) mn) )

;;; Date Object (Public Mutable)

(: %make-date (fixnum fixnum fixnum fixnum (or false fixnum) (or false fixnum) (or false fixnum) fixnum timezone-name boolean (or false fixnum) (or false fixnum) (or false real) --> date))
(: %date? (* -> boolean : date))
(: %date-nanosecond (date --> fixnum))
(: %date-nanosecond-set! (date fixnum -> void))
(: %date-second (date --> fixnum))
(: %date-second-set! (date fixnum -> void))
(: %date-minute (date --> fixnum))
(: %date-minute-set! (date fixnum -> void))
(: %date-hour (date --> fixnum))
(: %date-hour-set! (date fixnum -> void))
(: %date-day (date --> (or false fixnum)))
(: %date-day-set! (date (or false fixnum) -> void))
(: %date-month (date --> (or false fixnum)))
(: %date-month-set! (date (or false fixnum) -> void))
(: %date-year (date --> (or false fixnum)))
(: %date-year-set! (date (or false fixnum) -> void))
(: %date-zone-offset (date --> fixnum))
(: %date-zone-offset-set! (date fixnum -> void))
(: %date-zone-name (date --> timezone-name))
(: %date-zone-name-set! (date timezone-name -> void))
(: %date-dst? (date --> boolean))
(: %date-dst-set! (date boolean -> void))
(: %date-wday (date --> (or false fixnum)))
(: %date-wday-set! (date (or false fixnum) -> void))
(: %date-yday (date --> (or false fixnum)))
(: %date-yday-set! (date (or false fixnum) -> void))
(: %date-jday (date --> (or false real)))
(: %date-jday-set! (date (or false real) -> void))

(define date 'date)
(define-record-type-variant date (unchecked inline unsafe)
  (%make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
  %date?
  (ns     %date-nanosecond  %date-nanosecond-set!)
  (sec    %date-second      %date-second-set!)
  (min    %date-minute      %date-minute-set!)
  (hr     %date-hour        %date-hour-set!)
  (dy     %date-day         %date-day-set!)
  (mn     %date-month       %date-month-set!)
  (yr     %date-year        %date-year-set!)
  (tzo    %date-zone-offset %date-zone-offset-set!)
  ;; non-srfi extn
  (tzn    %date-zone-name   %date-zone-name-set!)
  (dstf   %date-dst?        %date-dst-set!)
  (wdy    %date-wday        %date-wday-set!)
  (ydy    %date-yday        %date-yday-set!)
  (jdy    %date-jday        %date-jday-set!) )

;;

;;; Getters

(define (tm:date-nanosecond dat)
  (%date-nanosecond dat) )

(define (tm:date-second dat)
  (%date-second dat) )

(define (tm:date-minute dat)
  (%date-minute dat) )

(define (tm:date-hour dat)
  (%date-hour dat) )

(define (tm:date-day dat)
  (%date-day dat) )

(define (tm:date-month dat)
  (%date-month dat) )

(define (tm:date-year dat)
  (%date-year dat) )

(define (tm:date-zone-offset dat)
  (%date-zone-offset dat) )

(define (tm:date-zone-name dat)
  (%date-zone-name dat) )

(define (tm:date-dst? dat)
  (%date-dst? dat) )

(define (tm:date-wday dat)
  (%date-wday dat) )

(define (tm:date-yday dat)
  (%date-yday dat) )

(define (tm:date-jday dat)
  (%date-jday dat) )

;;; Setters

(define (tm:date-nanosecond-set! dat x)
  (%date-nanosecond-set! dat (number->integer x)) )

(define (tm:date-second-set! dat x)
  (%date-second-set! dat (number->integer x)) )

(define (tm:date-minute-set! dat x)
  (%date-minute-set! dat (number->integer x)) )

(define (tm:date-hour-set! dat x)
  (%date-hour-set! dat (number->integer x)) )

(define (tm:date-day-set! dat x)
  (%date-day-set! dat (number->integer x)) )

(define (tm:date-month-set! dat x)
  (%date-month-set! dat (number->integer x)) )

(define (tm:date-year-set! dat x)
  (%date-year-set! dat (number->integer x)) )

(define (tm:date-zone-offset-set! dat x)
  (%date-zone-offset-set! dat (number->integer x)) )

;; Date TZ information extract

(define (tm:date-timezone-info? obj)
  (%date-timezone-info? obj) )

(define (tm:date-timezone-info dat)
  (%make-date-timezone-info
    (%date-zone-name dat) (%date-zone-offset dat) (%date-dst? dat)) )

(define (tm:date? obj)
  (%date? obj) )

;; Returns an invalid date record (for use by 'scan-date')

(define (tm:make-incomplete-date)
  (%make-date
    0
    0 0 0
    #f #f #f
    (timezone-locale-offset) (timezone-locale-name) (timezone-locale-dst?)
    #f #f #f) )

;; Internal Date CTOR

(define (tm:make-date ns sec min hr dy mn yr tzo tzn dstf wdy ydy jdy)
  (%make-date
    (number->integer ns)
    (number->integer sec) (number->integer min) (number->integer hr)
    (number->integer dy) (number->integer mn) (number->integer yr)
    (number->integer tzo) tzn dstf
    wdy ydy jdy) )

(define (tm:copy-date dat)
  (%make-date
    (%date-nanosecond dat)
    (%date-second dat) (%date-minute dat) (%date-hour dat)
    (%date-day dat) (%date-month dat) (%date-year dat)
    (%date-zone-offset dat)
    (%date-zone-name dat) (%date-dst? dat)
    (%date-wday dat) (%date-yday dat) (%date-jday dat)) )

(define (tm:date-complete? dat)
  (and
    (%date-nanosecond dat)
    (%date-second dat) (%date-minute dat) (%date-hour dat)
    (%date-day dat) (%date-month dat) (%date-year dat)
    (%date-zone-offset dat)) )

(define (tm:seconds->date/type sec tzc)
  ;seconds->utc-time cannot accept inexact-integer!
  (let* ((isec (number->exact-integer sec))
         (tzo (timezone-locale-offset tzc))
         (tv (seconds->utc-time (+ isec tzo))) )
    (tm:make-date
      (round (* (- sec isec) NS/S))
      (vector-ref tv 0) (vector-ref tv 1) (vector-ref tv 2)
      (vector-ref tv 3) (+ 1 (vector-ref tv 4)) (+ 1900 (vector-ref tv 5))
      tzo (timezone-locale-name tzc) (timezone-locale-dst? tzc)
      (vector-ref tv 6) (+ 1 (vector-ref tv 7)) #f) ) )

(define (tm:current-date tzi)
  (tm:time-utc->date (tm:current-time-utc) tzi) )

;; Date Comparison

(define (tm:date-compare dat1 dat2)
  (let ((dif (- (%date-year dat1) (%date-year dat2))))
    (if (not (zero? dif))
      dif
      (let ((dif (- (%date-month dat1) (%date-month dat2))))
        (if (not (zero? dif))
          dif
          (let ((dif (- (%date-day dat1) (%date-day dat2))))
            (if (not (zero? dif))
              dif
              (let ((dif (- (%date-hour dat1) (%date-hour dat2))))
                (if (not (zero? dif))
                  dif
                  (let ((dif (- (%date-minute dat1) (%date-minute dat2))))
                    (if (not (zero? dif))
                      dif
                      (let ((dif (- (%date-second dat1) (%date-second dat2))))
                        (if (not (zero? dif))
                          dif
                          (- (%date-nanosecond dat1) (%date-nanosecond dat2)) ) ) ) ) ) ) ) ) ) ) ) ) )

;; Gives the seconds/day/month/year

(define (tm:decode-julian-day-number jdn)
  (let* ((days (floor jdn))
         (a (+ days 32044))
         (b (quotient (+ (* 4 a) 3) 146097))
         (c (- a (quotient (* 146097 b) 4)))
         (d (quotient (+ (* 4 c) 3) 1461))
         (e (- c (quotient (* 1461 d) 4)))
         (m (quotient (+ (* 5 e) 2) 153))
         (y (+ (* 100 b) d (- JDYR) (quotient m 10))) )
    (values ;seconds date month year
     (* (- jdn days) SEC/DY)
     (+ e (- (quotient (+ (* 153 m) 2) 5)) 1)
     (+ m 3 (* (- MN/YR) (quotient m 10)))
     (if (>= 0 y) (- y 1) y)) ) )

;; Gives the Julian day number - rounds up to the nearest day

(define (tm:seconds->julian-day-number sec tzo)
  (+ TAI-EPOCH-IN-JD (/ (+ sec tzo SEC/DY/2) SEC/DY)) )

;; Is the time object one second before a leap second?

(define (tm:tai-before-leap-second? tim)
  (let ((sec (%time-second tim)))
    (let loop ((ls tm:second-before-leap-second-table))
      (and (not (null? ls))
           (or (= sec (car ls))
               (loop (cdr ls)) ) ) ) ) )

(define (optional-tzinfo tzi)
  (cond
    ((%date-timezone-info? tzi)
      (values
        (%date-timezone-info-offset tzi)
        (%date-timezone-info-name tzi)
        (%date-timezone-info-dst? tzi)) )
    ((timezone-components? tzi)
      (values
        (timezone-locale-offset tzi)
        (timezone-locale-name tzi)
        (timezone-locale-dst? tzi)) )
    (else
      ;assume an offset
      (values tzi #f #f) ) ) )

(define (tm:time-utc->date tim tzi)
  (let-values (((tzo tzn dstf) (optional-tzinfo tzi)))
    (let*-values (((secs dy mn yr)
                    (tm:decode-julian-day-number
                      (tm:seconds->julian-day-number (%time-second tim) tzo)))
                  ((hr rem)
                    (quotient&remainder secs SEC/HR))
                  ((min sec)
                    (quotient&remainder rem SEC/MIN)) )
      (tm:make-date
        (%time-nanosecond tim)
        sec min hr
        dy mn yr
        tzo tzn dstf
        #f #f #f) ) ) )

(define (tm:time-tai->date tim tzi)
  (let ((tm-utc (tm:time-tai->time-utc tim (tm:any-time))))
    (if (not (tm:tai-before-leap-second? tim))
      (tm:time-utc->date tm-utc tzi)
      ;else time is *right* before the leap,
      ;we need to pretend to subtract a second ...
      (let ((dat
              (tm:time-utc->date
                (tm:subtract-duration tm-utc ONE-SECOND-DURATION tm-utc) tzi)) )
        (%date-second-set! dat SEC/MIN) ;Note full minute!
        dat ) ) ) )

(define (tm:time->date tim tzi)
  (case (%time-type tim)
    ((utc)
      (tm:time-utc->date tim tzi))
    ((tai)
      (tm:time-tai->date tim tzi))
    ((monotonic)
      (tm:time-utc->date tim tzi))
    (else
      #f)) )

;; Date to Time

;; Gives the Julian day number - Gregorian proleptic calendar

(define (tm:encode-julian-day-number dy mn yr)
  (let* ((a (quotient (- 14 mn) MN/YR))
         (b (+ yr JDYR (- a)))
         (y (if (negative? yr) (+ 1 b) b)) ;BCE?
         (m (+ mn (* a MN/YR) -3)))
    (+ dy
      (quotient (+ (* 153 m) 2) 5)
      (* y DY/YR)
      (quotient y 4)
      (quotient y -100)
      (quotient y 400)
      -32045) ) )

(define (tm:date->time-utc dat)
  (let ((ns (%date-nanosecond dat))
        (sec (%date-second dat))
        (min (%date-minute dat))
        (hr (%date-hour dat))
        (dy (%date-day dat))
        (mn (%date-month dat))
        (yr (%date-year dat))
        (tzo (%date-zone-offset dat)) )
    (let ((jdys
            (- (tm:encode-julian-day-number dy mn yr) TAI-EPOCH-IN-JD))
          (secs
            (+ (* hr SEC/HR) (* min SEC/MIN) sec (- tzo))) )
      (tm:make-time 'utc ns (+ (* (- jdys ONE-HALF) SEC/DY) secs)) ) ) )

(define (tm:date->time-tai dat)
  (let* ((tm-utc (tm:date->time-utc dat))
         (tm-tai (tm:time-utc->time-tai tm-utc tm-utc)))
    (if (not (= SEC/MIN (%date-second dat)))
      tm-tai
      (tm:subtract-duration tm-tai ONE-SECOND-DURATION tm-tai) ) ) )

(define (tm:date->time-monotonic dat)
  (let ((tim-utc (tm:date->time-utc dat)))
    (tm:time-utc->time-monotonic tim-utc tim-utc) ) )

(define (tm:date->time dat tt)
  (case tt
    ((utc)
      (tm:date->time-utc dat))
    ((tai)
      (tm:date->time-tai dat))
    ((monotonic)
      (tm:date->time-monotonic dat))
    (else
      #f) ) )

;; Given a 'two digit' number, find the year within 50 years +/-

(define (tm:natural-year n tzi)
  ;propagate the error
  (if (or (< n 0) (>= n 100))
    n
    (let* ((current-year (%date-year (tm:current-date tzi)) )
           (current-century (* (quotient current-year 100) 100) )
           (X (+ current-century n (- current-year)) ) )
      (if (<= X 50)
        (+ current-century n)
        (+ (- current-century 100) n) ) ) ) )

;; Day of Year

(define +cumulative-month-days+ #(0 0 31 59 90 120 151 181 212 243 273 304 334))

(define (tm:year-day dy mn yr)
  (let ((yrdy (+ dy (vector-ref +cumulative-month-days+ mn))))
    (if (and (tm:leap-year? yr) (< 2 mn))
      (+ yrdy 1)
      yrdy ) ) )

(define (tm:cache-date-year-day dat)
  (let ((yrdy (tm:year-day (%date-day dat) (%date-month dat) (%date-year dat))))
    (%date-yday-set! dat yrdy)
    yrdy ) )

(define (tm:date-year-day dat)
  (or (%date-yday dat)
      (tm:cache-date-year-day dat) ) )

;; Week Day

;; Using Gregorian Calendar (from Calendar FAQ)

(: tm:week-day (fixnum fixnum fixnum --> fixnum))

;Tomohiko Sakamoto algorithm
;Determination of the day of the week
;
;Jan 1st 1 AD is a Monday in Gregorian calendar.
;So Jan 0th 1 AD is a Sunday [It does not exist technically].
;
;Every 4 years we have a leap year. But xy00 cannot be a leap unless xy divides 4 with remainder 0.
;y/4 - y/100 + y/400 : this gives the number of leap years from 1AD to the
;given year. As each year has 365 days (divides 7 with remainder 1), unless it
;is a leap year or the date is in Jan or Feb, the day of a given date changes
;by 1 each year. In other cases it increases by 2.
;y -= m<3 : If the month is not Jan or Feb, we do not count the 29th Feb (if
;it exists) of the given year.
;So y + y/4 - y/100 + y/400  gives the day of Jan 0th (Dec 31st of prev year)
;of the year. (This gives the remainder with 7 of  the number of days passed
;before the given year began.)
;
;Array t:  Number of days passed before the month 'm+1' begins.
;
;So t[m-1]+d is the number of days passed in year 'y' up to the given date.
;(y + y/4 - y/100 + y/400 + t[m-1] + d) % 7 is remainder of the number of days
;from Jan 0 1AD to the given date which will be the day (0=Sunday,6=Saturday).
;
;Description credits: Sai Teja Pratap (quora.com/How-does-Tomohiko-Sakamotos-Algorithm-work)
#; ;???
(define tm:week-day
  (let ((t #(0 3 2 5 0 3 5 1 4 6 2 4)))
    (lambda (dy mn yr)
      (let ((yr (if (< mn 3) (- yr 1) yr)))
        (modulo (+ yr (/ yr 4) (/ yr -100) (vector-ref t (- mn 1)) dy) DY/WK) ) ) ) )

(define (tm:week-day dy mn yr)
  (let* ((a (quotient (- 14 mn) MN/YR))
         (y (- yr a))
         (m (- (+ mn (* a MN/YR)) 2)) )
    (modulo
      (+ dy y
         (- (quotient y 4) (quotient y 100))
         (quotient y 400)
         (quotient (* m DY/MN) MN/YR))
      DY/WK) ) )

(define (tm:cache-date-week-day dat)
  (let ((wdy (tm:week-day (%date-day dat) (%date-month dat) (%date-year dat))))
    (%date-wday-set! dat wdy)
    wdy ) )

(define (tm:date-week-day dat)
  (or (%date-wday dat)
      (tm:cache-date-week-day dat) ) )

(define (tm:days-before-first-week dat 1st-weekday)
  (modulo
    (- 1st-weekday (tm:week-day 1 1 (%date-year dat)))
    DY/WK) )

(define (tm:date-week-number dat 1st-weekday)
  (quotient
    (- (tm:date-year-day dat) (tm:days-before-first-week dat 1st-weekday))
    DY/WK) )

;; Julian-day Operations

(define (tm:julian-day->modified-julian-day mjdn)
  (- mjdn TAI-EPOCH-IN-MODIFIED-JD) )

;; Date to Julian-day

(define (tm:jd-time->seconds ns sec min hr tzo)
  (+ (* hr SEC/HR) (* min SEC/MIN) sec (- tzo) (/ ns NS/S)) )

; Does the nanoseconds value contribute anything to the julian day?
; The range is < 1 second here (but not in the reference).

(define (tm:julian-day ns sec min hr dy mn yr tzo)
  (let ((jdn
          (tm:encode-julian-day-number dy mn yr))
        (timsecs
          (tm:jd-time->seconds ns sec min hr tzo)) )
    (+ (- jdn ONE-HALF) (/ timsecs SEC/DY)) ) )

(define (tm:date->julian-day dat)
  (or (%date-jday dat)
      (let ((jdn
              (tm:julian-day
                (%date-nanosecond dat)
                (%date-second dat) (%date-minute dat) (%date-hour dat)
                (%date-day dat) (%date-month dat) (%date-year dat)
                (%date-zone-offset dat))) )
        (%date-jday-set! dat jdn)
        jdn ) ) )

;; Time to Julian-day

(define (tm:seconds->julian-day ns sec)
  (+ TAI-EPOCH-IN-JD (/ (+ sec (/ ns NS/S)) SEC/DY)) )

(define (tm:time-utc->julian-day tim)
  (tm:seconds->julian-day (%time-nanosecond tim) (%time-second tim)) )

(define (tm:time-tai->julian-day tim)
  (let ((sec (%time-second tim)))
    (tm:seconds->julian-day
      (%time-nanosecond tim)
      (- sec (leap-second-delta sec))) ) )

(define tm:time-monotonic->julian-day tm:time-tai->julian-day)

(define (tm:time->julian-day tim)
  (case (%time-type tim)
    ((utc)
      (tm:time-utc->julian-day tim))
    ((tai)
      (tm:time-tai->julian-day tim))
    ((monotonic)
      (tm:time-monotonic->julian-day tim))
    (else
      #f)) )

(define (tm:time-utc->modified-julian-day tim)
  (tm:julian-day->modified-julian-day (tm:time-utc->julian-day tim)) )

(define (tm:time-tai->modified-julian-day tim)
  (tm:julian-day->modified-julian-day (tm:time-tai->julian-day tim)) )

(define (tm:time-monotonic->modified-julian-day tim)
  (tm:julian-day->modified-julian-day (tm:time-monotonic->julian-day tim)) )

(define (tm:time->modified-julian-day tim)
  (case (%time-type tim)
    ((utc)
      (tm:time-utc->modified-julian-day tim))
    ((tai)
      (tm:time-tai->modified-julian-day tim))
    ((monotonic)
      (tm:time-monotonic->modified-julian-day tim))
    (else
      #f)) )

;; Julian-day to Time

(define (tm:julian-day->nanoseconds jdn)
  (* (- jdn TAI-EPOCH-IN-JD) SEC/DY NS/S) )

(define (tm:julian-day->time-values jdn)
  (tm:nanoseconds->time-values (tm:julian-day->nanoseconds jdn)) )

(define (tm:modified-julian-day->julian-day mjdn)
  (+ mjdn TAI-EPOCH-IN-MODIFIED-JD) )

(define (tm:julian-day->time-utc jdn)
  (let-values (((sec ns) (tm:julian-day->time-values jdn)))
    (tm:make-time 'time-utc ns sec) ) )

(define (tm:modified-julian-day->time-utc mjdn)
  (tm:julian-day->time-utc (tm:modified-julian-day->julian-day mjdn)) )

(define (tm:default-date-adjust-integer amt)
  (round amt) )

) ;module srfi-19-tm