Initial commit

.gitignore

@@ -0,0 +1,2 @@
+*.fasl
+*.fas

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2023 Ákos Kiss
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.org

@@ -0,0 +1,43 @@
+* cl-frugal-uuid (WiP)
+
+Common Lisp [[https://en.wikipedia.org/wiki/Universally_unique_identifier][UUID]] library with zero dependencies
+
+** Rationale
+
+- Permissive license (MIT)
+- Small (e.g. doesn't rely on [[https://github.com/sharplispers/ironclad][Ironclad]])
+
+** Limitations
+
+Currently only generating random UUIDs (Version 4) is supported.
+
+** Installation
+
+cl-frugal-uuid can be installed via [[https://www.quicklisp.org/][Quicklisp]] from the [[https://ultralisp.org/][Ultralisp]]
+distribution:
+
+#+begin_src lisp
+  (ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil)
+  (ql:quickload :frugal-uuid)
+#+end_src
+
+** Running tests
+
+- Load the tests via Quicklisp:
+
+#+begin_src lisp
+  (ql:quickload :frugal-uuid/test)
+#+end_src
+
+- Use [[https://asdf.common-lisp.dev/][ASDF]] or [[https://fiveam.common-lisp.dev/][FiveAM]] to run the tests:
+
+#+begin_src lisp
+  ;; Using ASDF:
+  (asdf:test-system :frugal-uuid)
+  ;; Using FiveAM directly:
+  (fiveam:run! :frugal-uuid)
+#+end_src
+
+** Legal
+
+- Released under the MIT License.

frugal-uuid-test.lisp

@@ -0,0 +1,59 @@
+;;;; frugal-uuid-test.lisp
+
+(defpackage #:frugal-uuid-test
+  (:use #:cl #:fiveam))
+
+(in-package #:frugal-uuid-test)
+
+(def-suite :frugal-uuid)
+(in-suite :frugal-uuid)
+
+(test integer-conversion
+  (is (fuuid:uuid= (fuuid:make-nil) (fuuid:from-integer 0)))
+  (is (eql 0 (fuuid:to-integer (fuuid:make-nil))))
+  (dotimes (_ 20)
+    (let* ((uuid (fuuid:make-v4))
+           (i (fuuid:to-integer uuid)))
+      (is (integerp i))
+      (is (fuuid:uuid= uuid (fuuid:from-integer i))))))
+
+(test string-conversion
+  (is (string= "00000000-0000-0000-0000-000000000000"
+               (fuuid:to-string (fuuid:make-nil))))
+  (is (fuuid:uuid= (fuuid:make-nil)
+                   (fuuid:from-string "00000000-0000-0000-0000-000000000000")))
+  (dotimes (_ 20)
+    (let* ((uuid (fuuid:make-v4))
+           (s (fuuid:to-string uuid)))
+      (is (stringp s))
+      (is (fuuid:uuid= uuid (fuuid:from-string s))))))
+
+(test equality
+  (is (fuuid:uuid= (fuuid:make-nil) (fuuid:make-nil)))
+  (is (fuuid:uuid-equal-p nil nil))
+  (is (not (fuuid:uuid-equal-p nil (fuuid:make-nil))))
+  (dotimes (_ 10)
+    (let* ((uuid (fuuid:make-v4))
+           (s (fuuid:to-string uuid)))
+      (is (fuuid:uuid-equal-p uuid s))
+      (is (fuuid:uuid-equal-p s uuid))
+      (is (fuuid:uuid-equal-p uuid uuid))
+      (is (fuuid:uuid-equal-p s (fuuid:to-string uuid)))))
+  (is (loop :with uuids := '("00000000-0000-0000-0000-000000000000"
+                             "ef4c23eb-1fc0-4216-981d-9e24d512d9f4"
+                             "3dbbd860-a35c-47df-8952-7604398ad84c"
+                             "9215d239-4d04-4e1b-8dda-61e647bc2fc7"
+                             "a4cb7801-d568-47b6-a2bf-e3b7e0770e76"
+                             "0b817bd9-58e1-4352-93ca-549e0c91024f"
+                             "f9e035f7-d2ea-46a4-827f-7cd19961fa3c"
+                             "0ce58808-9db1-447a-a2ac-241b413ad409"
+                             "dce81bfb-b6ce-4982-9ed3-e0010c21a8b9"
+                             "67e64cf2-ad4a-4661-9b5d-e8c51d54c913"
+                             "023b9bc2-3c24-4b8d-8294-2ac0858dff71")
+            :for a :in uuids
+            :count (loop :for b :in uuids
+                         :count (or (fuuid:uuid-equal-p a b)
+                                    (fuuid:uuid= (fuuid:from-string a)
+                                                 (fuuid:from-string b))))
+              :into n
+            :finally (return (eql (length uuids) n)))))

frugal-uuid-v4.lisp

@@ -0,0 +1,17 @@
+;;;; frugal-uuid-v4.lisp
+
+(in-package #:frugal-uuid)
+
+(defvar *random* nil)
+
+(defun make-v4 (&optional random-state)
+  (unless *random* (setf *random* (make-random-state t)))
+  ;; Generate 128-bit random value
+  (let ((base (random #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+                      (or random-state *random*))))
+    ;; Set version to random
+    (setf (ldb (byte 4 76) base) #x4)
+    ;; Set variant to IETF
+    (setf (ldb (byte 2 62) base) 2)
+    (from-integer base)))
+

frugal-uuid.asd

@@ -0,0 +1,21 @@
+;;;; frugal-uuid.asd
+
+(asdf:defsystem #:frugal-uuid
+  :description "Common Lisp UUID library with zero dependencies"
+  :author "Ákos Kiss <[email protected]>"
+  :license  "MIT License"
+  :serial t
+  :components ((:file "package")
+               (:file "frugal-uuid")
+               (:file "frugal-uuid-v4"))
+  :in-order-to ((test-op (test-op "frugal-uuid/test"))))
+
+(asdf:defsystem #:frugal-uuid/test
+  :depends-on (#:frugal-uuid
+               #:fiveam)
+  :components ((:file "frugal-uuid-test"))
+  :perform (test-op (o c) (symbol-call :fiveam '#:run! :frugal-uuid)))
+
+(asdf:defsystem #:frugal-uuid/*
+  :depends-on (#:frugal-uuid
+               #:frugal-uuid/test))

frugal-uuid.lisp

@@ -0,0 +1,95 @@
+;;;; frugal-uuid.lisp
+
+(in-package #:frugal-uuid)
+
+(defclass uuid ()
+  ((time-low :initarg :time-low
+             :accessor time-low
+             :type (unsigned-byte 32))
+   (time-mid :initarg :time-mid
+             :accessor time-mid
+             :type (unsigned-byte 16))
+   (time-hi-and-version :initarg :time-hi-and-version
+                        :accessor time-hi-and-version
+                        :type (unsigned-byte 16))
+   (clock-seq-hi-and-res :initarg :clock-seq-hi-and-res
+                         :accessor clock-seq-hi-and-res
+                         :type (unsigned-byte 8))
+   (clock-seq-low :initarg :clock-seq-low
+                  :accessor clock-seq-low
+                  :type (unsigned-byte 8))
+   (node :initarg :node
+         :accessor node
+         :type (unsigned-byte 48))))
+
+(defun from-integer (i)
+  (make-instance 'uuid
+                 :time-low (ldb (byte 32 96) i)
+                 :time-mid (ldb (byte 16 80) i)
+                 :time-hi-and-version (ldb (byte 16 64) i)
+                 :clock-seq-hi-and-res (ldb (byte 8 56) i)
+                 :clock-seq-low (ldb (byte 8 48) i)
+                 :node (ldb (byte 48 0) i)))
+
+(defun to-integer (uuid)
+  (let ((i 0))
+    (setf (ldb (byte 32 96) i) (time-low uuid)
+          (ldb (byte 16 80) i) (time-mid uuid)
+          (ldb (byte 16 64) i) (time-hi-and-version uuid)
+          (ldb (byte 8 56) i) (clock-seq-hi-and-res uuid)
+          (ldb (byte 8 48) i) (clock-seq-low uuid)
+          (ldb (byte 48 0) i) (node uuid))
+    i))
+
+(defun from-string (s)
+  (unless (eql (length s) 36)
+    (error "UUID parse error: expected input string of length 36."))
+  (loop
+    :for i :in '(8 13 18 23)
+    :for c := (aref s i)
+    :unless (eql c #\-)
+      :do (error "UUID parse error: expected - at index ~a, found ~a instead." i c))
+  (from-integer (parse-integer (remove #\- s) :radix 16)))
+
+(defun to-string (uuid)
+  (format nil "~(~8,'0x-~4,'0x-~4,'0x-~2,'0x~2,'0x-~12,'0x~)"
+          (time-low uuid)
+          (time-mid uuid)
+          (time-hi-and-version uuid)
+          (clock-seq-hi-and-res uuid)
+          (clock-seq-low uuid)
+          (node uuid)))
+
+(defmethod print-object ((uuid uuid) stream)
+  (print-unreadable-object (uuid stream :type t)
+    (format stream (to-string uuid))))
+
+(defun make-nil ()
+  (make-instance 'uuid
+                 :time-low 0
+                 :time-mid 0
+                 :time-hi-and-version 0
+                 :clock-seq-hi-and-res 0
+                 :clock-seq-low 0
+                 :node 0))
+
+(declaim (ftype (function (uuid uuid) boolean) uuid=))
+(defun uuid= (x y)
+  (or (eq x y)
+      (and (eql (time-low x) (time-low y))
+           (eql (time-mid x) (time-mid y))
+           (eql (time-hi-and-version x) (time-hi-and-version y))
+           (eql (clock-seq-hi-and-res x) (clock-seq-hi-and-res y))
+           (eql (clock-seq-low x) (clock-seq-low y))
+           (eql (node x) (node y)))))
+
+(defun uuid-equal-p (x y)
+  (or (eq x y)
+      (and x y
+           (let ((x (if (stringp x)
+                        (from-string x)
+                        x))
+                 (y (if (stringp y)
+                        (from-string y)
+                        y)))
+             (uuid= x y)))))

package.lisp

@@ -0,0 +1,16 @@
+;;;; package.lisp
+
+(defpackage #:frugal-uuid
+  (:nicknames #:fuuid)
+  (:use #:cl)
+  (:export #:uuid
+           #:from-integer
+           #:to-integer
+           #:from-string
+           #:to-string
+           #:make-nil
+           #:uuid=
+           #:uuid-equal-p
+
+           ;; Version 4
+           #:make-v4))