Add initial implementation for version 7 UUIDs (based on IETF draft)

README.org

@@ -120,10 +120,7 @@ The above system is provided to conveniently setup the following:
 
 - Use Ironclad PRNG to generate [[https://github.com/ak-coram/cl-frugal-uuid/blob/main/non-frugal/strong-random.lisp][strong random numbers]].
 - Use [[https://github.com/ak-coram/cl-trivial-clock][cl-trivial-clock]] to generate more accurate timestamps by relying
-  on platform-specific functionality (warning: the default
-  implementation has better uniqueness properties by simply using the
-  subsecond bits of the timestamp as a counter and sleeping when the
-  possible ten million values are exhausted).
+  on platform-specific functionality.
 - Automatically use a new PRNG and randomize node ID & clock sequence
   for generating version 1 UUIDs for each new thread (via
   [[https://github.com/ak-coram/cl-frugal-uuid/blob/main/non-frugal/thread-safe.lisp][bordeaux-threads]]).
@@ -206,6 +203,11 @@ functions instead:
 - V6-TIME-MID
 - V6-TIME-HIGH
 
+*** Version 7 (based on IETF draft)
+
+A 48 bit unix timestamp (milliseconds), a 18 bit counter and 56 bits
+of random data are used for generating version 7 UUID values.
+
 ** Randomness
 
 If you have an alternative source of random numbers, you can use it

frugal-uuid-clock.lisp

@@ -2,7 +2,9 @@
 
 (in-package #:frugal-uuid)
 
+(defconstant +millis-per-second+ 1000)
 (defconstant +nanos-per-second+ 1000000000)
+(defconstant +nanos-per-milli+ 1000000)
 (defconstant +100nanos-per-second+ (/ +nanos-per-second+ 100))
 
 (defconstant +unix-time-uuid-epoch-offset-seconds+ 12219292800)

frugal-uuid-v6.lisp

@@ -3,7 +3,7 @@
 (in-package #:frugal-uuid)
 
 ;; Based on IETF draft:
-;; https://www.ietf.org/archive/id/draft-peabody-dispatch-new-uuid-format-01.html
+;; https://www.ietf.org/archive/id/draft-peabody-dispatch-new-uuid-format-04.html
 
 (declaim (ftype (function (uuid) (values uuid &optional))
                 make-v6-from-v1))

frugal-uuid-v7.lisp

@@ -0,0 +1,83 @@
+;;;; frugal-uuid-v7.lisp
+
+(in-package #:frugal-uuid)
+
+;; Based on IETF draft:
+;; https://www.ietf.org/archive/id/draft-peabody-dispatch-new-uuid-format-04.html
+
+;; Work with a 18 bit counter, which should allow for 262,143,000
+;; unique values per second without considering the random bits:
+(defconstant +v7-clock-seq-max+ #b111111111111111111)
+
+(defclass v7-generator ()
+  ((clock-seq :initarg :v7-clock-seq
+              :accessor v7-clock-seq
+              :type (unsigned-byte 18))
+   (timestamp-generator :initarg :v7-timestamp-generator
+                        :accessor v7-timestamp-generator)))
+
+(defun make-v7-generator (&key clock-seq timestamp-generator)
+  (make-instance 'v7-generator
+                 :v7-clock-seq (or clock-seq
+                                   (random-integer +v7-clock-seq-max+))
+                 :v7-timestamp-generator (or timestamp-generator
+                                             (make-timestamp-generator
+                                              :uuid-epoch nil
+                                              :low-resolution nil))))
+
+(defvar *v7-generator* nil)
+(defvar *v7-generator-init-function* #'make-v7-generator)
+
+(defun initialize-v7-generator (&optional v7-generator)
+  (setf *v7-generator* (or v7-generator
+                           (funcall *v7-generator-init-function*)))
+  nil)
+
+(defmacro with-v7-generator (v7-generator &body body)
+  "Dynamically bind generator for creating version 7 uuid values."
+  `(let ((*v7-generator* ,v7-generator))
+     ,@body))
+
+(declaim (ftype (function (integer integer) (values uuid &optional))
+                make-v7-from-timestamp))
+(defun make-v7-from-timestamp (timestamp random)
+  (let ((clock-seq (v7-clock-seq *v7-generator*))
+        (clock-seq-high #xFF)
+        (time-high-and-version #xFFFF))
+    (setf (ldb (byte 4 12) time-high-and-version) #x7 ; Set version to 7
+          (ldb (byte 12 0) time-high-and-version) (ldb (byte 12 6) clock-seq)
+          (ldb (byte 2 6) clock-seq-high) #b10 ; Set variant to IETF
+          (ldb (byte 6 0) clock-seq-high) (ldb (byte 6 0) clock-seq))
+    (make-instance 'uuid
+                   ;; Set the timestamp
+                   :time-low (ldb (byte 32 16) timestamp)
+                   :time-mid (ldb (byte 16 0) timestamp)
+                   ;; Contains version and high 12 bits from clock-seq
+                   :time-hi-and-version time-high-and-version
+                   ;; Contains variant, low 6 bits of clock-seq
+                   :clock-seq-hi-and-res clock-seq-high
+                   :clock-seq-low (ldb (byte 8 48) random)
+                   :node (ldb (byte 48 0) random))))
+
+(declaim (ftype (function () (values uuid &optional)) make-v7))
+(defun make-v7 ()
+  "Generate uuid value (version 7)."
+  (unless *v7-generator* (initialize-v7-generator))
+  (multiple-value-bind (base fraction repetitions)
+      (funcall (v7-timestamp-generator *v7-generator*))
+    ;; Change clock-seq when necessary
+    (when (or
+           ;; Time went backwards
+           (null repetitions)
+           ;; Ran out of unique values
+           (and (plusp repetitions)
+                (or fraction
+                    (zerop (mod repetitions +millis-per-second+)))))
+      (setf (v7-clock-seq *v7-generator*)
+            (mod (1+ (v7-clock-seq *v7-generator*)) +v7-clock-seq-max+)))
+    (make-v7-from-timestamp
+     (+ (* base +millis-per-second+)
+        (if fraction
+            (floor fraction +nanos-per-milli+)
+            (mod repetitions +millis-per-second+)))
+     (random-integer #xFFFFFFFFFFFFFF))))

frugal-uuid.asd

@@ -16,7 +16,8 @@
                (:file "frugal-uuid-v3")
                (:file "frugal-uuid-v4")
                (:file "frugal-uuid-v5")
-               (:file "frugal-uuid-v6"))
+               (:file "frugal-uuid-v6")
+               (:file "frugal-uuid-v7"))
   :in-order-to ((test-op (test-op "frugal-uuid/test"))))
 
 (asdf:defsystem #:frugal-uuid/test

non-frugal/accurate-clock.lisp

@@ -3,4 +3,5 @@
 (in-package #:frugal-uuid)
 
 (setf *unix-timestamp-function* #'trivial-clock:now
-      *v1-generator* nil)
+      *v1-generator* nil
+      *v7-generator* nil)

non-frugal/thread-safe.lisp

@@ -16,3 +16,8 @@
          bt2:*default-special-bindings*
          :test #'equal)
 
+;; Setup new version 7 generator for each new thread
+#+thread-support
+(pushnew '(*v7-generator* . (make-v7-generator))
+         bt2:*default-special-bindings*
+         :test #'equal)

package.lisp

@@ -52,7 +52,6 @@
            #:*v1-generator*
            #:*v1-generator-init-function*
            #:make-v1-generator
-           #:make-accurate-v1-generator
            #:initialize-v1-generator
            #:with-v1-generator
            #:make-v1-from-timestamp
@@ -79,4 +78,13 @@
            #:v6-time-mid
            #:v6-time-low-and-version
            #:make-v6-from-v1
-           #:make-v6))
+           #:make-v6
+
+           ;; Version 7 (IETF draft)
+           #:*v7-generator*
+           #:*v7-generator-init-function*
+           #:make-v7-generator
+           #:initialize-v7-generator
+           #:with-v7-generator
+           #:make-v7-from-timestamp
+           #:make-v7))