
(define-library (chibi time)
  (export current-seconds get-time-of-day time
          seconds->time seconds->string time->seconds time->string
          make-timeval make-tm timeval-seconds timeval-microseconds
          timezone-offset timezone-dst-time
          time-second time-minute time-hour time-day time-month time-year
          time-day-of-week time-day-of-year time-dst?
          tm? timeval? timezone?)
  (cond-expand
   (solaris)
   (else
    (export time-offset time-timezone-name)))
  (cond-expand
   (emscripten)
   (else
    (export set-time-of-day!)))
  (cond-expand
   ((or bsd linux)
    (export rusage? resource-usage-time resource-usage-system-time
            resource-usage-max-rss resource-usage/self
            resource-usage/children get-resource-usage))
   (else))
  (cond-expand
   (chibi
    (import (chibi))
    (include-shared "time"))
   (else
    (import (scheme base) (scheme write) (scheme time)
            (rename (srfi 19) (time-second srfi-19:time-second)))
    (begin
      ;; a SRFI-19 `date' is a datetime, which in C is a tm (time) struct
      (define tm? date?)
      (define time-second date-second)
      (define time-minute date-minute)
      (define time-hour date-hour)
      (define time-day date-day)
      (define time-month date-month)
      (define (time-year x) (- (date-year x) 1900))
      (define time-day-of-week date-week-day)
      (define time-day-of-year date-year-day)
      (define (seconds->time seconds)
        (time-tai->date (make-time time-tai 0 (exact (round seconds)))))
      (define current-seconds current-second)
      (define (get-time-of-day)
        (list (current-time) time-utc))
      (define (timeval-seconds tv) (srfi-19:time-second tv))
      (define (timeval-microseconds tv) (/ (time-nanosecond tv) 1000)))))
  (begin
    (define (timeval->milliseconds tv)
      (quotient (+ (* 1000000 (timeval-seconds tv))
                   (timeval-microseconds tv))
                1000))
    (define (time* name thunk)
      (let* ((start (car (get-time-of-day)))
             (result (thunk))
             (end (car (get-time-of-day)))
             (msecs (- (timeval->milliseconds end)
                       (timeval->milliseconds start))))
        (display name (current-error-port))
        (display ": " (current-error-port))
        (display msecs (current-error-port))
        (display " ms\n" (current-error-port))
        result))
    (define-syntax time
      (syntax-rules ()
        ((time expr)
         (let ((out (open-output-string)))
           (write 'expr out)
           (time (get-output-string out) expr)))
        ((time name expr)
         (time* name (lambda () expr)))))))
