[210_13] srfi-19 time-difference实现

goldfish/srfi/srfi-19.scm

@@ -66,6 +66,7 @@
     copy-time
     ;; Time comparison procedures
     ;; Time arithmetic procedures
+    time-difference
     ;; Current time and clock resolution
     current-date current-julian-day current-time time-resolution
     ;; Date object and accessors
@@ -155,7 +156,35 @@
     ;; Time arithmetic procedures
     ;; ====================
 
-    ;; TODO
+    (define (priv:time->nanoseconds time)
+      (+ (* (time-second time) priv:NANO)
+         (time-nanosecond time)))
+
+    (define (priv:nanoseconds->values nanoseconds)
+      (receive (sec ns) (floor/ nanoseconds priv:NANO)
+        (values ns sec)))
+
+    (define (priv:time-difference time1 time2 time3)
+      (unless (and (time? time1) (time? time2))
+        (error 'wrong-type-arg "time-difference: time1 and time2 must be time objects" (list time1 time2)))
+      (unless (eq? (time-type time1) (time-type time2))
+        (error 'wrong-type-arg "time-difference: time types must match"
+               (list (time-type time1) (time-type time2))))
+      (set-time-type! time3 TIME-DURATION)
+      (if (and (= (time-second time1) (time-second time2))
+               (= (time-nanosecond time1) (time-nanosecond time2)))
+        (begin
+          (set-time-second! time3 0)
+          (set-time-nanosecond! time3 0))
+        (receive (nanos secs)
+                 (priv:nanoseconds->values (- (priv:time->nanoseconds time1)
+                                              (priv:time->nanoseconds time2)))
+          (set-time-second! time3 secs)
+          (set-time-nanosecond! time3 nanos)))
+      time3)
+
+    (define (time-difference time1 time2)
+      (priv:time-difference time1 time2 (%make-time TIME-DURATION 0 0)))
 
     ;; ====================
     ;; Current time and clock resolution

tests/goldfish/liii/time-test.scm

@@ -339,6 +339,59 @@ wrong-type-arg
   (check (time-nanosecond t3) => 0)
   (check (time-second t3) => -1234567890))
 
+#|
+time-difference
+计算两个时间对象的差值。
+
+语法
+----
+(time-difference time1 time2)
+
+参数
+----
+time1 : time?
+time2 : time?
+两个时间对象，类型必须相同。
+
+返回值
+-----
+time?
+返回一个 TIME-DURATION 类型的时间对象。
+
+错误处理
+--------
+wrong-type-arg
+当参数不是时间对象或类型不匹配时抛出错误。
+|#
+
+;; Test time-difference
+(let* ((t1 (make-time TIME-UTC 100 5))
+       (t2 (make-time TIME-UTC 900000000 3))
+       (d  (time-difference t1 t2)))
+  (check (time-type d) => TIME-DURATION)
+  (check (time-second d) => 1)
+  (check (time-nanosecond d) => 100000100))
+
+;; Test negative duration normalization
+(let* ((t1 (make-time TIME-UTC 100 5))
+       (t2 (make-time TIME-UTC 900000000 5))
+       (d  (time-difference t1 t2)))
+  (check (time-second d) => -1)
+  (check (time-nanosecond d) => 100000100))
+
+;; Test zero difference
+(let* ((t1 (make-time TIME-UTC 123456789 42))
+       (d  (time-difference t1 t1)))
+  (check (time-second d) => 0)
+  (check (time-nanosecond d) => 0))
+
+;; Test error conditions
+(check-catch 'wrong-type-arg
+  (time-difference (make-time TIME-UTC 0 0)
+                   (make-time TIME-TAI 0 0)))
+(check-catch 'wrong-type-arg
+  (time-difference "not-time" (make-time TIME-UTC 0 0)))
+
 ;; Test error conditions
 (check-catch 'wrong-type-arg (time-type "not-a-time"))
 (check-catch 'wrong-type-arg (time-nanosecond 123))