core: proper uuid support — fix random-uuid, add parse-uuid, real uuid values

uuid support was broken end to end (jolt-6s2): random-uuid built malformed
strings ((string/format "%x") with no zero-padding, so hex groups came out
short, and no variant bits), uuid? was hardcoded false, the #uuid data reader
was identity (bare string), and parse-uuid didn't exist. Nothing tested it.

A UUID is now an immutable tagged struct {:jolt/type :jolt/uuid :str <lower>}
(make-uuid, types.janet) — struct value equality gives case-insensitive = and
map-key/set hashing for free, and the evaluator treats it as self-evaluating
(like chars). random-uuid emits a correct RFC 4122 v4 (zero-padded 8-4-4-4-12,
version nibble 4, variant 8-b). parse-uuid validates the canonical shape,
returns nil on a bad string, throws on a non-string (Clojure 1.11). uuid? is
an overlay tag predicate. str renders the bare string; pr-str renders
#uuid "..." and round-trips.

Tests: uuid-spec (30 cases: format, parse edge cases from the suite, value
semantics, reader literal), 6 conformance cases x3 modes. The suite's
parse_uuid/random_uuid/uuid_qmark files now contribute: 4049 -> 4074 pass,
71 clean files; baselines raised.

jolt-core/clojure/core/20-coll.clj

@@ -286,6 +286,7 @@
 (defn reader-conditional? [x] (= (get x :jolt/type) :jolt/reader-conditional))
 (defn tagged-literal? [x]     (= (get x :jolt/type) :jolt/tagged-literal))
 (defn record? [x]             (some? (get x :jolt/deftype)))
+(defn uuid? [x]               (= (get x :jolt/type) :jolt/uuid))
 ;; Jolt has no chunked seqs (Phase 5 territory), so this is always false.
 (defn chunked-seq? [x] false)
 

src/jolt/core.janet

@@ -1497,7 +1497,7 @@
 (defn core-inst? [x] false)
 (defn core-inst-ms [x] (error "Not an instant (no inst type in Jolt)"))
 (defn core-uri? [x] false)
-(defn core-uuid? [x] false)
+# uuid? now lives in the Clojure collection tier (tagged-value predicate).
 (defn core-bytes? [x] (buffer? x))
 # tagged-literal? now lives in the Clojure collection tier (tagged-value predicate).
 
@@ -1649,6 +1649,9 @@
       (number? v) (buffer/push-string buf (fmt-number v))
       (and (struct? v) (= :symbol (v :jolt/type)))
         (buffer/push-string buf (if (v :ns) (string (v :ns) "/" (v :name)) (v :name)))
+      (and (struct? v) (= :jolt/uuid (v :jolt/type)))
+        (do (buffer/push-string buf "#uuid \"") (buffer/push-string buf (v :str))
+            (buffer/push-string buf "\""))
       (and (table? v) (= :jolt/var (get v :jolt/type))) (buffer/push-string buf (var-display v))
       (core-sorted-map? v) (pr-render-pairs buf (sorted-map-entries v))
       (core-sorted-set? v) (pr-render-seq buf (v :items) "#{" "}")
@@ -1679,6 +1682,7 @@
     (keyword? v) (string ":" (string v))
     (and (struct? v) (= :symbol (v :jolt/type)))
       (if (v :ns) (string (v :ns) "/" (v :name)) (v :name))
+    (and (struct? v) (= :jolt/uuid (v :jolt/type))) (v :str)
     (and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v)
     (number? v) (fmt-number v)
     (= true v) "true"
@@ -2749,10 +2753,38 @@
 
 (defn core-prefers [mm-var] (or (get mm-var :jolt/prefers) {}))
 
-(defn core-random-uuid []
-  (defn hx [n] (string/format "%x" (math/floor (* (math/random) n))))
-  (string (hx 0x10000) (hx 0x10000) "-" (hx 0x10000) "-4" (hx 0x1000)
-          "-" (hx 0x1000) "-" (hx 0x10000) (hx 0x10000) (hx 0x10000)))
+(defn core-random-uuid
+  "A random version-4 UUID value: zero-padded hex groups (8-4-4-4-12), version
+  nibble 4, variant nibble 8-b (RFC 4122)."
+  []
+  (defn hx4 [] (string/format "%04x" (math/floor (* (math/random) 0x10000))))
+  (defn hx3 [] (string/format "%03x" (math/floor (* (math/random) 0x1000))))
+  (def variant (string/format "%x" (+ 8 (math/floor (* (math/random) 4)))))
+  (make-uuid (string (hx4) (hx4) "-" (hx4) "-4" (hx3)
+                     "-" variant (hx3) "-" (hx4) (hx4) (hx4))))
+
+(defn- hex-digit? [c]
+  (or (and (>= c 48) (<= c 57))      # 0-9
+      (and (>= c 97) (<= c 102))     # a-f
+      (and (>= c 65) (<= c 70))))    # A-F
+
+(defn core-parse-uuid
+  "(parse-uuid s) -> the UUID, or nil when s is not a canonical 8-4-4-4-12 hex
+  UUID string. Throws when s is not a string (Clojure 1.11)."
+  [s]
+  (when (not (or (string? s) (buffer? s)))
+    (error (string "parse-uuid requires a string, got " (type s))))
+  (def dash-at {8 true 13 true 18 true 23 true})
+  (if (and (= 36 (length s))
+           (do
+             (var ok true)
+             (for i 0 36
+               (if (get dash-at i)
+                 (when (not= 45 (in s i)) (set ok false))    # 45 = "-"
+                 (when (not (hex-digit? (in s i))) (set ok false))))
+             ok))
+    (make-uuid s)
+    nil))
 
 (def- core-bindings
   "Map of symbol name → function for all core functions."
@@ -2894,6 +2926,7 @@
     "hash-unordered-coll" core-hash-unordered-coll
     "prefers" core-prefers
     "random-uuid" core-random-uuid
+    "parse-uuid" core-parse-uuid
     "interpose" core-interpose
     "mapcat" core-mapcat
     "find" core-find
@@ -3133,7 +3166,6 @@
     "inst?" core-inst?
     "inst-ms" core-inst-ms
     "uri?" core-uri?
-    "uuid?" core-uuid?
     "bytes?" core-bytes?
     "meta" core-meta
     "var-get" core-var-get

src/jolt/evaluator.janet

@@ -1619,6 +1619,10 @@
       (resolve-sym ctx bindings form)
       (if (= :jolt/char (form :jolt/type))
         form
+      # a UUID value flowing back through eval (macro expansion, eval of a read
+      # form) is a self-evaluating literal, like chars.
+      (if (= :jolt/uuid (form :jolt/type))
+        form
       (if (= :jolt/set (form :jolt/type))
         # evaluate each element (set literals like #{(inc 1)} must compute)
         (apply make-phs (map |(eval-form ctx bindings $) (form :value)))
@@ -1638,7 +1642,7 @@
           (each k (keys form)
             (array/push kvs (eval-form ctx bindings k))
             (array/push kvs (eval-form ctx bindings (get form k))))
-          (build-eval-map kvs)))))))
+          (build-eval-map kvs))))))))
     # A phm map-literal FORM (reader emits one for {:a nil} etc., which a struct
     # would have dropped): evaluate its key/value forms and rebuild, preserving nil.
     (phm? form)

src/jolt/types.janet

@@ -371,6 +371,12 @@
           (put namespaces ns-sym ns)
           ns))))
 
+# UUID value: an immutable tagged struct. Lowercased at construction so
+# equality and map-key hashing are case-insensitive by value (struct equality),
+# matching Clojure (java.util.UUID equality / cljs UUID).
+(defn make-uuid [s]
+  {:jolt/type :jolt/uuid :str (string/ascii-lower s)})
+
 (defn make-ctx
   "Create a new evaluation context.
   (make-ctx)       — empty context with 'user namespace
@@ -401,7 +407,7 @@
               :type-registry @{}
               :data-readers (let [dr @{}]
                               (put dr (keyword "#inst") (fn [s] s))
-                              (put dr (keyword "#uuid") (fn [s] s))
+                              (put dr (keyword "#uuid") (fn [s] (make-uuid s)))
                               dr)}
         # create the user namespace via a partial context
         _ (ctx-find-ns {:env env} "user")]

test/integration/clojure-test-suite-test.janet

@@ -43,9 +43,9 @@
 # Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the
 # overlay, which required fixing two leniencies (a char is not callable; take
 # validates its count) — correct beyond those fns, so the suite rose broadly.
-(def baseline-pass 4034)
+(def baseline-pass 4074)
 # A file is "clean" when it ran with zero failures AND zero errors.
-(def baseline-clean-files 67)
+(def baseline-clean-files 71)
 # Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
 # this normally only fires on genuinely-infinite-sequence hangs. It's an env var
 # (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can

test/integration/conformance-test.janet

@@ -169,6 +169,14 @@
    ["locking evals monitor" "[3 1]" "(let [a (atom 0)] [(locking (swap! a inc) 3) @a])"]
    ["defonce keeps first" "5"    "(do (defonce d6o 5) (defonce d6o 9) d6o)"]
    ["read-string + eval" "3"     "(eval (read-string \"(+ 1 2)\"))"]
+
+   ### ---- uuid (jolt-6s2) ----
+   ["random-uuid is uuid" "true"  "(uuid? (random-uuid))"]
+   ["uuid str 36"         "36"    "(count (str (random-uuid)))"]
+   ["parse-uuid round"    "\"b6883c0a-0342-4007-9966-bc2dfa6b109e\"" "(str (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
+   ["parse-uuid case ="   "true"  "(= (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") (parse-uuid \"B6883C0A-0342-4007-9966-BC2DFA6B109E\"))"]
+   ["parse-uuid bad nil"  "nil"   "(parse-uuid \"df0993\")"]
+   ["uuid as map key"     ":v"    "(get {(parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") :v} (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
    ["macroexpand-1 when" "2"     "(count (rest (macroexpand-1 (quote (when true 1)))))"]
 
    ### ---- HIGH: aliased namespace calls ----

test/spec/uuid-spec.janet

@@ -0,0 +1,51 @@
+# Specification: UUID support — random-uuid, parse-uuid, uuid?, #uuid literal.
+# UUIDs are immutable tagged structs {:jolt/type :jolt/uuid :str "<lowercase>"}:
+# value equality, usable as map keys, case-normalized at construction.
+(use ../support/harness)
+
+(defspec "uuid / random-uuid"
+  ["returns a uuid"      "true"  "(uuid? (random-uuid))"]
+  ["str is 36 chars"     "36"    "(count (str (random-uuid)))"]
+  ["8-4-4-4-12 shape"    "[8 4 4 4 12]" "(do (require (quote [clojure.string :as s])) (mapv count (s/split (str (random-uuid)) #\"-\")))"]
+  ["version nibble is 4" "\\4"   "(nth (str (random-uuid)) 14)"]
+  ["variant nibble 8-b"  "true"  "(contains? #{\\8 \\9 \\a \\b} (nth (seq (str (random-uuid))) 19))"]
+  ["distinct"            "10"    "(count (set (repeatedly 10 random-uuid)))"]
+  ["all hex digits"      "true"  "(every? (fn [c] (contains? (set (seq \"0123456789abcdef-\")) c)) (seq (str (random-uuid))))"])
+
+(defspec "uuid / parse-uuid"
+  ["valid round-trips"   "\"b6883c0a-0342-4007-9966-bc2dfa6b109e\""
+   "(str (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
+  ["parses to uuid"      "true"  "(uuid? (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
+  ["case-insensitive ="  "true"
+   "(= (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") (parse-uuid \"B6883C0A-0342-4007-9966-BC2DFA6B109E\"))"]
+  ["empty -> nil"        "nil"   "(parse-uuid \"\")"]
+  ["short -> nil"        "nil"   "(parse-uuid \"0\")"]
+  ["garbage -> nil"      "nil"   "(parse-uuid \"df0993\")"]
+  ["too long -> nil"     "nil"   "(parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109eb\")"]
+  ["leading extra -> nil" "nil"  "(parse-uuid \"ab6883c0a-0342-4007-9966-bc2dfa6b109e\")"]
+  ["non-hex -> nil"      "nil"   "(parse-uuid \"g6883c0a-0342-4007-9966-bc2dfa6b109e\")"]
+  ["bad dashes -> nil"   "nil"   "(parse-uuid \"b6883c0a00342-4007-9966-bc2dfa6b109e\")"]
+  ["non-string throws"   :throws "(parse-uuid 1000)"]
+  ["keyword throws"      :throws "(parse-uuid :key)"]
+  ["map throws"          :throws "(parse-uuid {})"])
+
+(defspec "uuid / value semantics"
+  ["equal by value"      "true"
+   "(= (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
+  ["unequal differs"     "false"
+   "(= (random-uuid) (random-uuid))"]
+  ["works as map key"    ":v"
+   "(let [u (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")] (get {u :v} (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")))"]
+  ["works in a set"      "true"
+   "(contains? #{(parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")} (parse-uuid \"B6883C0A-0342-4007-9966-BC2DFA6B109E\"))"]
+  ["uuid? false on string" "false" "(uuid? \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")"]
+  ["uuid? false on nil"  "false" "(uuid? nil)"])
+
+(defspec "uuid / #uuid reader literal"
+  ["reads to uuid"       "true"  "(uuid? #uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")"]
+  ["= parse-uuid"        "true"
+   "(= #uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\" (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
+  ["str of literal"      "\"b6883c0a-0342-4007-9966-bc2dfa6b109e\""
+   "(str #uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")"]
+  ["pr-str round-trips"  "\"#uuid \\\"b6883c0a-0342-4007-9966-bc2dfa6b109e\\\"\""
+   "(pr-str #uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\")"])