From e44a7a982092ac267e55cc40eced396bc466b614 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 10 Jun 2026 10:27:24 -0400 Subject: [PATCH] =?UTF-8?q?core:=20proper=20uuid=20support=20=E2=80=94=20f?= =?UTF-8?q?ix=20random-uuid,=20add=20parse-uuid,=20real=20uuid=20values?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 } (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 | 1 + src/jolt/core.janet | 44 +++++++++++++--- src/jolt/evaluator.janet | 6 ++- src/jolt/types.janet | 8 ++- .../integration/clojure-test-suite-test.janet | 4 +- test/integration/conformance-test.janet | 8 +++ test/spec/uuid-spec.janet | 51 +++++++++++++++++++ 7 files changed, 112 insertions(+), 10 deletions(-) create mode 100644 test/spec/uuid-spec.janet diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index ace99b4..88698ab 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/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) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 39937ae..6762732 100644 --- a/src/jolt/core.janet +++ b/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 diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index f949450..147c8b9 100644 --- a/src/jolt/evaluator.janet +++ b/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) diff --git a/src/jolt/types.janet b/src/jolt/types.janet index 11746b6..67df2bb 100644 --- a/src/jolt/types.janet +++ b/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")] diff --git a/test/integration/clojure-test-suite-test.janet b/test/integration/clojure-test-suite-test.janet index 813deb7..bba8c09 100644 --- a/test/integration/clojure-test-suite-test.janet +++ b/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 diff --git a/test/integration/conformance-test.janet b/test/integration/conformance-test.janet index a94fcc1..c573795 100644 --- a/test/integration/conformance-test.janet +++ b/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 ---- diff --git a/test/spec/uuid-spec.janet b/test/spec/uuid-spec.janet new file mode 100644 index 0000000..a9c8e7f --- /dev/null +++ b/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 ""}: +# 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\")"])