From: Mark Wooding <mdw@distorted.org.uk>
Date: Sun, 5 May 2024 01:48:34 +0000 (+0100)
Subject: zone.lisp (timespec-seconds): Rewrite using a table of units.
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/commitdiff_plain/bb94753b6d10c0d54cba7f6ae387f63d1b0546ff?ds=sidebyside

zone.lisp (timespec-seconds): Rewrite using a table of units.
---

diff --git a/zone.lisp b/zone.lisp
index f50c6d7..d5d2072 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -68,31 +68,42 @@ (defun to-mixed-base (base val)
 	(push r a)
 	(setf val q)))))
 
-(export 'timespec-seconds)
-(defun timespec-seconds (ts)
-  "Convert a timespec TS to seconds.
-
-   A timespec may be a real count of seconds, or a list (COUNT UNIT).  UNIT
-   may be any of a number of obvious time units."
-  (cond ((null ts) 0)
-	((realp ts) (floor ts))
-	((atom ts)
-	 (error "Unknown timespec format ~A" ts))
-	((null (cdr ts))
-	 (timespec-seconds (car ts)))
-	(t (+ (to-integer (* (car ts)
-			     (case (intern (string-upcase
-					    (stringify (cadr ts)))
-					   '#:zone)
-			       ((s sec secs second seconds) 1)
-			       ((m min mins minute minutes) 60)
-			       ((h hr hrs hour hours) #.(* 60 60))
-			       ((d dy dys day days) #.(* 24 60 60))
-			       ((w wk wks week weeks) #.(* 7 24 60 60))
-			       ((y yr yrs year years) #.(* 365 24 60 60))
-			       (t (error "Unknown time unit ~A"
-					 (cadr ts))))))
-	      (timespec-seconds (cddr ts))))))
+(let ((unit-scale (make-hash-table)))
+
+  (dolist (item `(((:second :seconds :sec :secs :s) ,1)
+		  ((:minute :minutes :min :mins :m) ,60)
+		  ((:hour :hours :hr :hrs :h) ,(* 60 60))
+		  ((:day :days :dy :dys :d) ,(* 24 60 60))
+		  ((:week :weeks :wk :wks :w) ,(* 7 24 60 60))))
+    (destructuring-bind (units scale) item
+      (dolist (unit units) (setf (gethash unit unit-scale) scale))))
+
+  (export 'timespec-seconds)
+  (defun timespec-seconds (ts)
+    "Convert a timespec TS to seconds.
+
+     A timespec may be a real count of seconds, or a list ({COUNT UNIT}*).
+     UNIT may be any of a number of obvious time units."
+    (labels ((convert (acc ts)
+	       (cond ((null ts) acc)
+		     ((realp ts) (+ acc (floor ts)))
+		     ((atom ts) (error "Unknown timespec format ~A" ts))
+		     (t
+		      (destructuring-bind
+			  (count &optional unit &rest tail) ts
+			(let ((scale
+				(acond ((null unit) 1)
+				       ((gethash (intern (string-upcase
+							  (stringify unit))
+							 :keyword)
+						 unit-scale)
+					it)
+				       (t
+					(error "Unknown time unit ~S"
+					       unit)))))
+			  (convert (+ acc (to-integer (* count scale)))
+				   tail)))))))
+      (convert 0 ts))))
 
 (defun hash-table-keys (ht)
   "Return a list of the keys in hashtable HT."