Merge pull request #248 from jolt-lang/conformance/reitit-aero-honeysql

Conformance: reitit 327/0/0, aero 59/0/0, honeysql 638/6

host/chez/java/host-static-methods.ss

@@ -149,6 +149,15 @@
         (cons "parseShort" (lambda (x . r) (parse-int-or-throw x (if (null? r) 10 (jnum->exact (car r))) "parseShort")))
         (cons "toString" (lambda (x . r) (number->string (jnum->exact x))))))
 
+;; java.util.Locale — jolt's case ops are codepoint-based (locale-independent), so
+;; the default locale is a no-op token. Libraries set/restore it around formatting
+;; to prove output is locale-stable (honeysql's Turkish-İ regression guard).
+(register-class-statics! "Locale"
+  (list (cons "getDefault" (lambda () "und"))
+        (cons "setDefault" (lambda (x) jolt-nil))
+        (cons "forLanguageTag" (lambda (tag) (if (string? tag) tag (jolt-str-render-one tag))))
+        (cons "ROOT" "und") (cons "US" "en-US") (cons "ENGLISH" "en")))
+
 (register-class-statics! "Boolean"
   (list (cons "parseBoolean" (lambda (s) (string=? "true" (ascii-string-down (if (string? s) s (jolt-str-render-one s))))))
         (cons "TRUE" #t) (cons "FALSE" #f)))

host/chez/natives-meta.ss

@@ -40,7 +40,15 @@
     ((jreify? x) (make-jreify (jreify-methods x) (jreify-protos x)))
     ;; () is a shared singleton — a fresh instance keeps meta off every other ().
     ((empty-list-t? x) (fresh-empty-list))
-    (else x)))                          ; cseq / procedure
+    ;; a list/seq node gets a fresh identity too (Clojure's PersistentList is
+    ;; immutable — (with-meta a-list m) returns a NEW list). Keying meta on the
+    ;; original mutated it, so (with-meta xs {:k xs}) built a self-referential
+    ;; cycle that loops *print-meta* printing.
+    ((cseq? x) (make-cseq (cseq-head x) (cseq-tail x) (cseq-forced? x)
+                          (cseq-list? x) (cseq-cvec x) (cseq-ci x)))
+    ((jolt-lazyseq? x) (make-jolt-lazyseq (jolt-lazyseq-thunk x) (jolt-lazyseq-val x)
+                                          (jolt-lazyseq-realized? x)))
+    (else x)))                          ; procedure
 
 (define (jolt-with-meta x m)
   (cond

host/chez/ns.ss

@@ -128,17 +128,23 @@
     (list->cseq (map intern-ns! (vector->list (hashtable-keys seen))))))
 
 ;; ns-publics / ns-map / ns-interns: a {sym -> var-cell} jolt map built by scanning
-;; the var-table for defined cells in the namespace. (Private vars are not tracked
+;; the var-table for defined cells in the namespace. ns-interns/ns-map keep every
-;; yet, so ns-publics == ns-interns.) ns-aliases is an empty map (map? is true).
+;; var; ns-publics drops the ones marked ^:private (defn-/def ^:private), like the
-(define (ns-vars-pmap nm)
+;; JVM. ns-aliases is an empty map (map? is true).
+(define (var-private? c)
+  (let ((m (hashtable-ref var-meta-table c #f)))
+    (and m (jolt-truthy? (jolt-get m (keyword #f "private"))))))
+(define (ns-vars-pmap-when nm keep?)
   (let ((m (jolt-hash-map)))
     (vector-for-each
       (lambda (c)
-        (when (and (string=? (var-cell-ns c) nm) (var-cell-defined? c))
+        (when (and (string=? (var-cell-ns c) nm) (var-cell-defined? c) (keep? c))
           (set! m (jolt-assoc m (jolt-symbol #f (var-cell-name c)) c))))
       (hashtable-values var-table))
     m))
-(define (jolt-ns-publics desig) (ns-vars-pmap (ns-desig->name desig)))
+(define (ns-vars-pmap nm) (ns-vars-pmap-when nm (lambda (c) #t)))
+(define (jolt-ns-publics desig) (ns-vars-pmap-when (ns-desig->name desig) (lambda (c) (not (var-private? c)))))
+(define (jolt-ns-interns desig) (ns-vars-pmap (ns-desig->name desig)))
 
 ;; ns-aliases: the {alias-sym -> ns-value} registered under `desig`
 ;; (default the current ns) via require :as / alias. Reads ns-alias-table.
@@ -322,8 +328,8 @@
 (def-var! "clojure.core" "in-ns" jolt-in-ns)
 (def-var! "clojure.core" "all-ns" jolt-all-ns)
 (def-var! "clojure.core" "ns-publics" jolt-ns-publics)
-(def-var! "clojure.core" "ns-map" jolt-ns-publics)
+(def-var! "clojure.core" "ns-map" jolt-ns-interns)
-(def-var! "clojure.core" "ns-interns" jolt-ns-publics)
+(def-var! "clojure.core" "ns-interns" jolt-ns-interns)
 (def-var! "clojure.core" "ns-aliases" jolt-ns-aliases)
 (def-var! "clojure.core" "ns-refers" jolt-ns-refers)
 (def-var! "clojure.core" "ns-imports" jolt-ns-imports)

host/chez/reader.ss

@@ -307,7 +307,6 @@
     ((symbol-t? target)
      (make-symbol-t (symbol-t-ns target) (symbol-t-name target)
                     (rdr-merge-meta (symbol-t-meta target) meta)))
-    ((empty-list-t? target) target)
     ;; Lists/vectors/maps/sets attach metadata to the value itself, as Clojure's
     ;; reader does. Reading DATA (read-string, edn) then preserves it. A list form
     ;; is code: ^Type (expr) is a compile-time hint on the FORM, read off the form
@@ -607,8 +606,11 @@
         (let ((c (rdr-form->data (car xs))))
           (loop (cdr xs) (cons c acc) (or changed (not (eq? c (car xs)))))))))
 
+;; carry the reader metadata, converting its nested forms too — a set/tagged
+;; literal inside a ^{…} map (^{:k #{…}}) must become a value like the rest of
+;; the data, not stay the tagged set-form.
 (define (rdr-carry-meta src dst)
-  (let ((m (jolt-meta src))) (if (jolt-nil? m) dst (jolt-with-meta dst m))))
+  (let ((m (jolt-meta src))) (if (jolt-nil? m) dst (jolt-with-meta dst (rdr-form->data m)))))
 
 ;; tag keyword (:#time/date) -> its *data-readers* reader fn, or #f. The fn's
 ;; namespace must already be loaded (the loader requires them when a project's
@@ -664,33 +666,39 @@
                   (if dfn (jolt-invoke dfn (rdr-tag->symbol tag) inner)
                       (rdr-make-tagged tag inner))))))))
 
-(define (rdr-form->data x)
+;; rdr-form->data*: convert the VALUE structure (set/tagged/nested forms). The
+;; wrapper below adds the metadata, so the unchanged branches return x bare.
+(define (rdr-form->data* x)
   (cond
     ((and (pmap? x) (eq? (jolt-get x rdr-kw-jolt-type) rdr-kw-jolt-tagged))
      (rdr-construct-tag (jolt-get x rdr-kw-tag) (rdr-form->data (jolt-get x rdr-kw-form))))
     ((rdr-set-form? x)
      (let ((items (jolt-get x rdr-kw-value)))
-       (rdr-carry-meta x
+       (let loop ((i 0) (s empty-pset))
-         (let loop ((i 0) (s empty-pset))
+         (if (fx>=? i (pvec-count items)) s
-           (if (fx>=? i (pvec-count items)) s
+             (loop (fx+ i 1) (pset-conj s (rdr-form->data (pvec-nth-d items i jolt-nil))))))))
-               (loop (fx+ i 1) (pset-conj s (rdr-form->data (pvec-nth-d items i jolt-nil)))))))))
     ((pvec? x)
      (let-values (((items changed) (rdr-conv-each (vector->list (pvec-v x)))))
-       (if changed (rdr-carry-meta x (apply jolt-vector items)) x)))
+       (if changed (apply jolt-vector items) x)))
     ((pmap? x)
      (let ((order (hashtable-ref rdr-map-order x #f)))
        (if order
            (let-values (((kvs changed) (rdr-conv-each order)))
-             (if changed
+             (if changed (rdr-make-map kvs) x))
-                 (let ((m (rdr-make-map kvs))) (rdr-carry-meta x m))
-                 x))
            (let-values (((kvs changed)
                          (rdr-conv-each (pmap-fold x (lambda (k v a) (cons k (cons v a))) '()))))
-             (if changed (rdr-carry-meta x (apply jolt-hash-map kvs)) x)))))
+             (if changed (apply jolt-hash-map kvs) x)))))
     ((cseq? x)
      (let-values (((items changed) (rdr-conv-each (seq->list x))))
-       (if changed (rdr-carry-meta x (apply jolt-list items)) x)))
+       (if changed (apply jolt-list items) x)))
     (else x)))
+;; Read DATA always carries metadata, converting its nested forms too — Clojure's
+;; reader reads a ^{…} map with the same read() as any value, so a set/tagged
+;; literal in metadata is a value, not a form. Carry it whether or not the value
+;; itself changed (a set-form in the metadata of an otherwise-unchanged value).
+(define (rdr-form->data x)
+  (let ((v (rdr-form->data* x)) (m (jolt-meta x)))
+    (if (jolt-nil? m) v (jolt-with-meta v (rdr-form->data m)))))
 
 ;; --- the two host seams -----------------------------------------------------
 ;; clojure.core/read-string: first form, or nil for blank / comment-only input
@@ -731,3 +739,8 @@
 (def-var! "clojure.core" "read-string" jolt-read-string)
 (def-var! "clojure.core" "__parse-next" jolt-parse-next)
 (def-var! "clojure.core" "__read-tagged" jolt-read-tagged)
+;; __read-form-raw: the read form WITHOUT building values — set/tagged literals
+;; stay FORMS. clojure.edn reads this so it applies a #tag through its :readers/
+;; :default (a #inst can be overridden to defer), rather than read-string building
+;; the built-in #inst eagerly (which fails on a non-string like #inst ^:ref […]).
+(def-var! "clojure.core" "__read-form-raw" jolt-read-form-raw)

host/chez/records.ss

@@ -450,6 +450,9 @@
                        "Map" "java.util.Map" "Iterable" "java.lang.Iterable" "Object"))
         ((pset? obj) '("PersistentHashSet" "APersistentSet" "IPersistentSet" "Set" "java.util.Set" "Collection" "Iterable" "java.lang.Iterable" "Object"))
         ((or (cseq? obj) (empty-list-t? obj)) '("ASeq" "ISeq" "IPersistentCollection" "Sequential" "Collection" "Iterable" "java.lang.Iterable" "Object"))
+        ;; a var is clojure.lang.Var (also IDeref / IFn) — reitit's Expand protocol
+        ;; extends to Var so a #'handler route dispatches.
+        ((var-cell? obj) '("Var" "clojure.lang.Var" "IDeref" "IFn" "Object"))
         ;; java.net.URI jhost — extend-protocol java.net.URI (hiccup ToURI/ToStr).
         ((and (jhost? obj) (string=? (jhost-tag obj) "uri")) '("URI" "java.net.URI" "Object"))
         ;; a ByteBuffer — extend-protocol java.nio.ByteBuffer (aws-api util).
@@ -560,7 +563,7 @@
               '("Long" "Integer" "Number" "Double" "Ratio" "BigInt" "BigInteger"
                 "String" "CharSequence" "Boolean" "Character"
                 "Keyword" "Symbol" "Named" "Object" "nil"
-                "Fn" "IFn" "AFn" "URI"
+                "Fn" "IFn" "AFn" "URI" "Var" "IDeref"
                 "PersistentVector" "APersistentVector" "IPersistentVector"
                 "PersistentArrayMap" "APersistentMap" "IPersistentMap"
                 "PersistentHashSet" "APersistentSet" "IPersistentSet"

jolt-core/clojure/core/00-syntax.clj

@@ -403,9 +403,11 @@
       `(def ~(with-meta fn-only-name meta-map) (fn ~(with-meta fn-only-name nil) ~@body))
       `(def ~fn-only-name (fn ~fn-only-name ~@body)))))
 
-;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
+;; defn- marks the var :private (like Clojure). Jolt doesn't restrict access, but
-;; defn- delegates to defn with :private metadata).
+;; ns-publics filters private vars out — a lib that introspects ns-publics (e.g.
-(defmacro defn- [fn-name & body] `(defn ~fn-name ~@body))
+;; honeysql's "all helpers have docstrings") sees only the public ones.
+(defmacro defn- [fn-name & body]
+  `(defn ~(with-meta fn-name (assoc (if (meta fn-name) (meta fn-name) {}) :private true)) ~@body))
 
 ;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a host symbol
 ;; the destructurer rejects). This defn compiles fine: by the time a tier triggers

jolt-core/clojure/core/30-macros.clj

@@ -377,7 +377,9 @@
         ;; The clause is DATA, not a syntax-quote: a body that is itself a syntax-
         ;; quote would have its ~unquotes consumed a level early if re-spliced.
         mk-clause (fn [spec]
-                    (let [argv (nth spec 1)
+                    ;; fresh-name each _ param so two _ params don't collide on the
+                    ;; field binds / live-read instance (see defrecord's mk-clause).
+                    (let [argv (mapv (fn [p] (if (= p (quote _)) (gensym "_p") p)) (nth spec 1))
                           inst (first argv)
                           ;; let-bind only immutable fields; mutable ones are read live
                           ;; via rewrite-body so a set! within the method is observed.
@@ -597,7 +599,11 @@
         ;; one clause from a spec; `this` is hinted with the record type so the
         ;; inference reads its fields bare-index. Clause as DATA (see deftype).
         mk-clause (fn [spec]
-                    (let [argv (nth spec 1)
+                    ;; rename each _ parameter to a fresh symbol so two _ params
+                    ;; (the common (m [_ _] …) on a 1-arg protocol method) don't
+                    ;; collide — the field binds read (get this :field) off the
+                    ;; FIRST param, which an ignored second _ would otherwise shadow.
+                    (let [argv (mapv (fn [p] (if (= p (quote _)) (gensym "_p") p)) (nth spec 1))
                           inst (first argv)
                           hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym)))
                           binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]

stdlib/clojure/edn.clj

@@ -16,7 +16,7 @@
     ;; Reader FORMS are detected by :jolt/type tag, never by map? — strict map?
     ;; (correctly) excludes tagged structs, so the old (and (map? x) ...) guard
     ;; would skip them.
-    (= :jolt/set (get x :jolt/type)) (with-meta (set (map (fn [v] (edn->value opts v)) (get x :value))) (meta x))
+    (= :jolt/set (get x :jolt/type)) (with-meta (set (map (fn [v] (edn->value opts v)) (get x :value))) (edn->value opts (meta x)))
     ;; Tagged elements: a reader from the :readers opt wins, then the built-in
     ;; data readers (#uuid/#inst + registered); an unknown tag falls to the
     ;; :default opt fn (called with tag and value, as in Clojure) or throws.
@@ -34,9 +34,12 @@
           (get opts :default) ((get opts :default) tag-sym v)
           :else (__read-tagged tag v)))
     (map? x)
-      (with-meta (into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x)) (meta x))
+      (with-meta (into {} (map (fn [e] [(edn->value opts (key e)) (edn->value opts (val e))]) x)) (edn->value opts (meta x)))
-    (vector? x) (with-meta (mapv (fn [v] (edn->value opts v)) x) (meta x))
+    (vector? x) (with-meta (mapv (fn [v] (edn->value opts v)) x) (edn->value opts (meta x)))
-    (seq? x) (with-meta (map (fn [v] (edn->value opts v)) x) (meta x))
+    ;; a constructed set: recurse into its elements too, so a tagged literal
+    ;; inside #{…} gets the :readers/:default treatment (aero's #ref in a set).
+    (set? x) (with-meta (set (map (fn [v] (edn->value opts v)) x)) (edn->value opts (meta x)))
+    (seq? x) (with-meta (map (fn [v] (edn->value opts v)) x) (edn->value opts (meta x)))
     :else x))
 
 ;; Private helper, NOT named read-string: an unqualified (read-string …) call
@@ -45,7 +48,10 @@
 (defn- read-edn [opts s]
   (if (or (nil? s) (cstr/blank? s))
     (get opts :eof nil)
-    (edn->value opts (clojure.core/read-string s))))
+    ;; read the RAW form (tagged/set literals stay forms) so edn->value applies
+    ;; every #tag through :readers/:default — read-string would build the built-in
+    ;; #inst/#uuid eagerly, ignoring an override and failing on a non-string form.
+    (edn->value opts (__read-form-raw s))))
 
 (defn read-string
   "Reads one object from the string s. Returns the :eof option value (default

test/chez/corpus.edn

@@ -3302,4 +3302,18 @@
   {:suite "defn / attr-map" :label "attr-map values are evaluated" :expected "true" :actual "(do (defn m {:val (+ 1 2)} [] 1) (= 3 (:val (meta (var m)))))"}
   {:suite "records / clojure.lang interop" :label "a record's Associative/ILookup methods delegate to the map fns" :expected "[1 9 true true 2]" :actual "(do (defrecord M [a b]) (let [m (->M 1 2)] [(.valAt m :a) (.valAt m :z 9) (= {:a 1 :b 2 :c 3} (into {} (.assoc m :c 3))) (.containsKey m :a) (.count m)]))"}
   {:suite "interop / number classes" :label "Byte/Short bounds + class tokens" :expected "[127 -128 32767 -32768 true]" :actual "[Byte/MAX_VALUE Byte/MIN_VALUE Short/MAX_VALUE Short/MIN_VALUE (= java.lang.Byte java.lang.Byte)]"}
+  {:suite "reader / metadata" :label "a set in metadata is read as a value, not a tagged form" :expected "true" :actual "(= #{:a :b} (:foo (meta (read-string (binding [*print-meta* true] (pr-str (with-meta [1] {:foo #{:a :b}})))))))"}
+  {:suite "reader / metadata" :label "metadata on an empty list is preserved" :expected "true" :actual "(= {:foo 1} (meta (read-string \"^{:foo 1} ()\")))"}
+  {:suite "reader / metadata" :label "a vector in metadata reads as a value" :expected "true" :actual "(= [1 2] (:v (meta (read-string \"^{:v [1 2]} {:a 1}\"))))"}
+  {:suite "reader / metadata" :label "an empty list in metadata reads as a value" :expected "true" :actual "(= () (:e (meta (read-string \"^{:e ()} [1]\"))))"}
+  {:suite "edn / readers in collections" :label "a :default tag reader applies inside a set" :expected "true" :actual "(= #{[:t 1]} (clojure.edn/read-string {:default (fn [t v] [:t v])} \"#{#foo 1}\"))"}
+  {:suite "edn / readers in collections" :label "a registered reader applies inside a set" :expected "true" :actual "(= #{6} (clojure.edn/read-string {:readers {(quote x) (fn [v] (* v 2))}} \"#{#x 3}\"))"}
+  {:suite "metadata / immutability" :label "with-meta on a list does not mutate the original" :expected "true" :actual "(let [ds (list 1 2)] (with-meta ds {:k 1}) (nil? (meta ds)))"}
+  {:suite "metadata / immutability" :label "with-meta on a list carries the metadata" :expected "true" :actual "(= {:k 1} (meta (with-meta (list 1) {:k 1})))"}
+  {:suite "metadata / immutability" :label "a meta-bearing list still equals the bare list" :expected "true" :actual "(let [ds (list 1)] (= ds (with-meta ds {:k 9})))"}
+  {:suite "metadata / immutability" :label "with-meta on a lazy seq carries metadata" :expected "true" :actual "(= {:k 5} (meta (with-meta (lazy-seq (list 1)) {:k 5})))"}
+  {:suite "edn / deferred tags" :label "a :readers override wins over the built-in #inst (not eagerly built)" :expected "true" :actual "(= [:I \"x\"] (clojure.edn/read-string {:readers {(quote inst) (fn [v] [:I v])}} \"#inst \\\"x\\\"\"))"}
+  {:suite "edn / deferred tags" :label "a normal #inst still constructs without an override" :expected "true" :actual "(= #inst \"2020-01-01T00:00:00.000-00:00\" (clojure.edn/read-string \"#inst \\\"2020-01-01T00:00:00.000-00:00\\\"\"))"}
+  {:suite "vars / privacy" :label "defn- marks the var :private" :expected "true" :actual "(do (defn- p [] 1) (true? (:private (meta (var p)))))"}
+  {:suite "vars / privacy" :label "ns-publics drops private vars; ns-interns keeps them" :expected "[true false true]" :actual "(do (defn pub [] 1) (defn- priv [] 2) [(contains? (ns-publics (quote user)) (quote pub)) (contains? (ns-publics (quote user)) (quote priv)) (contains? (ns-interns (quote user)) (quote priv))])"}
 ]

test/chez/unit.edn

@@ -570,4 +570,7 @@
   {:suite "macro-args" :expr "(do (defmacro sm [x] [(set? x) (map? x)]) (sm #{1 2}))" :expected "[true false]"}
   {:suite "macro-args" :expr "(do (defmacro ws [x] (conj x :z)) (= #{1 :z} (ws #{1})))" :expected "true"}
   {:suite "macro-args" :expr "(do (defmacro vm [x] (vector? x)) (vm [1 2]))" :expected "true"}
+  {:suite "deftype-method" :expr "(do (defprotocol P (m [_ o])) (defrecord R [n] P (m [_ _] n)) (m (->R 5) :x))" :expected "5"}
+  {:suite "deftype-method" :expr "(do (defprotocol P2 (m2 [_ o])) (deftype T [n] P2 (m2 [_ _] n)) (m2 (->T 7) :x))" :expected "7"}
+  {:suite "protocol-host" :expr "(do (defprotocol Q (e [_])) (extend-protocol Q clojure.lang.Var (e [_] :var)) [(satisfies? Q (var map)) (e (var map))])" :expected "[true :var]"}
 ]