#lang scheme/base (require srfi/19) (define nps 10000) (define (current) (encode-time (current-time))) (define (encode d) (encode-time (date->time-utc d))) (define (encode-time t) (floor (* nps (+ (/ (time-nanosecond t) 10000000) ; nanosecond? <.< (time-second t))))) (define (decode n) (define-values (q r) (quotient/remainder n nps)) (let ((t (make-time 'time-utc (* (/ r nps) 10000000) q))) (time-utc->date t 0))) (provide current encode decode nps)