From c06af7c9f4a935cd75e08bc214a7130a3aecd578 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 10 Jun 2026 21:03:14 -0400 Subject: [PATCH] =?UTF-8?q?core:=20three=20bug=20fixes=20=E2=80=94=20ifn?= =?UTF-8?q?=3F,=20prefer-method=20dispatch,=20reader=20comments=20in=20map?= =?UTF-8?q?=20values?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ifn? (jolt-1vx) is the canonical IFn set in the overlay: fns, keywords, symbols, maps (sorted included), sets, vectors, and vars — NOT lists. The seed version said true for lists and false for struct maps and vars. Mutable-mode caveat documented (vectors and lists share the array repr there). 13 predicate rows. Multimethod dispatch (jolt-heo) now collects EVERY isa-matching method key and picks the dominant one — x dominates y when prefer-method'd over it or (isa? x y) — and two matches with no dominant is an ambiguity ERROR, as in Clojure. It used to take whichever key the table yielded first, silently ignoring prefer-method. The prefers store upgrades to Clojure's {x -> set-of-dominated} shape, shared between the dispatch closure and prefer-method-setup via the var; prefers becomes a macro over a setup fn (the store lives on the VAR — the multifn value can't carry it, so the old fn read {} forever). 6 multimethod rows + the conformance row updated to the canonical shape (335x3). The reader (jolt-ou8) kept the pending KEY when a comment or #_ sits in a map's VALUE slot: the old code dropped both, desyncing kv pairing — the real value became the next key and the closing brace landed in value position ('Unmatched closing brace'). Selmer's deps.edn (a '; for development (REPL, etc)' comment between key and value) now parses; 6 reader rows incl. nested commented maps. Gate: jpm exit 0, conformance 335x3, all tests passed. --- jolt-core/clojure/core/20-coll.clj | 7 ++++ jolt-core/clojure/core/30-macros.clj | 5 +++ src/jolt/core.janet | 9 ++-- src/jolt/evaluator.janet | 56 +++++++++++++++++++++---- src/jolt/reader.janet | 24 ++++++++--- test/integration/conformance-test.janet | 9 +++- test/spec/multimethods-spec.janet | 16 +++++++ test/spec/predicates-spec.janet | 16 +++++++ test/spec/reader-syntax-spec.janet | 12 ++++++ 9 files changed, 133 insertions(+), 21 deletions(-) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index d92bfc4..4916706 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -838,3 +838,10 @@ ([x y z] (f (g x y z))) ([x y z & args] (f (apply g x y z args))))) ([f g & fs] (reduce comp (comp f g) fs))) + +;; Canonical IFn set (jolt-1vx): fns, keywords, symbols, maps (sorted incl.), +;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure). +;; Mutable-mode caveat: vectors and lists share the array representation +;; there, so vector? can't separate them and lists read as ifn?. +(defn ifn? [x] + (or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x))) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 635ac01..9a3c501 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -45,6 +45,11 @@ (defmacro methods [mm] `(methods-setup (quote ~mm))) +;; prefers reads the store off the VAR (the multifn value can't carry it) — +;; same symbol-passing shape as the other multimethod table ops. +(defmacro prefers [mm] + `(prefers-setup (quote ~mm))) + ;; instance?: class names don't evaluate to values on jolt, so the type arg is ;; passed quoted to the ctx-capturing checker; the value evaluates normally. (defmacro instance? [t x] diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 5a3cd6b..d1b9fdc 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -2379,9 +2379,8 @@ # Associative = maps and (real) vectors only. pvec is a literal/built vector; # tuples and lists are seq results, not associative. -(defn core-ifn? [x] - (or (function? x) (cfunction? x) (keyword? x) (phm? x) (set? x) (tuple? x) (array? x) (pvec? x) - (and (struct? x) (= :symbol (x :jolt/type))))) +# ifn? now lives in the Clojure collection tier — canonical IFn set (fns, +# keywords, symbols, maps, sets, vectors, vars); lists are NOT IFn. # With a single item, Clojure returns it WITHOUT calling f. On ties, the last # extremal item wins (>=/<= update), matching Clojure. # Clojure's min-key/max-key: the 2-arg base compares with strict < / > (so the @@ -2644,7 +2643,7 @@ (defn core-hash-unordered-coll [coll] (var h 0) (each x (realize-for-iteration coll) (set h (band (+ h (h24 x)) 0xffffff))) h) -(defn core-prefers [mm-var] (or (get mm-var :jolt/prefers) {})) +# prefers is a macro over prefers-setup now (the store lives on the VAR). @@ -2778,7 +2777,6 @@ "hash-combine" core-hash-combine "hash-ordered-coll" core-hash-ordered-coll "hash-unordered-coll" core-hash-unordered-coll - "prefers" core-prefers "gensym" gensym "int?" core-integer? "compare" core-compare @@ -2807,7 +2805,6 @@ "reduced" core-reduced "reduced?" core-reduced? "rseq" core-rseq - "ifn?" core-ifn? "ex-info" core-ex-info "__with-out-str" core-with-out-str "delay?" core-delay? diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index a43a8e1..e4740f7 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -887,6 +887,8 @@ (def methods @{}) (def isa-cache @[nil]) (def dispatch-cache @{}) + # the prefers table, shared with the var (prefer-method-setup mutates it) + (def v-box @[nil]) (def mm-fn (fn [& args] (let [dv (apply dispatch-fn args) @@ -909,13 +911,39 @@ (hierarchy :value) hierarchy) nil) - found (do (var f nil) (var i 0) - (let [ks (keys methods)] - (while (and (nil? f) (< i (length ks))) - (if (if h (isa-fn h dv (in ks i)) (isa-fn dv (in ks i))) - (set f (get methods (in ks i)))) - (++ i))) - f)] + # Collect EVERY isa-matching method key, then pick the + # dominant one: x dominates y when x is prefer-method'd + # over y (direct preference) or (isa? x y). Two matches + # with no dominant is an ambiguity ERROR, as in Clojure — + # this used to silently take whichever key the table + # yielded first, ignoring prefer-method (jolt-heo). + found (do + (def matches @[]) + (each k (keys methods) + (when (if h (isa-fn h dv k) (isa-fn dv k)) + (array/push matches k))) + (defn pref? [x y] + (def px (get (or (get v-box 0) @{}) x)) + (and px (not (nil? (get px y))))) + (defn dom? [x y] + (or (pref? x y) (if h (isa-fn h x y) (isa-fn x y)))) + (case (length matches) + 0 nil + 1 (get methods (in matches 0)) + (do + (var best (in matches 0)) + (var i 1) + (while (< i (length matches)) + (when (dom? (in matches i) best) (set best (in matches i))) + (++ i)) + (var amb nil) + (each k matches + (when (and (nil? amb) (not (deep= k best)) (not (dom? best k))) + (set amb k))) + (when amb + (error (string "Multiple methods in multimethod '" (name-sym :name) + "' match dispatch value — neither is preferred"))) + (get methods best))))] (if found (do (put dispatch-cache dv found) (apply found args)) (let [dm (get methods default-key)] @@ -923,6 +951,11 @@ (error (string "No method in multimethod " (name-sym :name) " for dispatch value: " dv)))))))))))) (def v (ns-intern ns (name-sym :name) mm-fn)) + # pre-create the prefers store so the dispatch closure and + # prefer-method-setup share one table + (def prefs-tbl (or (get v :jolt/prefers) + (do (put v :jolt/prefers @{}) (get v :jolt/prefers)))) + (put v-box 0 prefs-tbl) (put v :jolt/methods methods) (put v :jolt/dispatch-cache dispatch-cache) (put v :jolt/default default-key) @@ -1090,7 +1123,10 @@ (def mm-var (mm-var-of mm-sym true)) (def prefs (or (get mm-var :jolt/prefers) (do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers)))) - (put prefs dval-a dval-b) + # {x -> {y true ...}}: x is preferred over each y (Clojure's {x #{y}}) + (def sub (or (get prefs dval-a) + (do (put prefs dval-a @{}) (get prefs dval-a)))) + (put sub dval-b true) (clear-dispatch-cache! mm-var) mm-var)) (ns-intern core "remove-method-setup" @@ -1108,6 +1144,10 @@ (put mm-var :jolt/methods @{}) (clear-dispatch-cache! mm-var)) mm-var)) + (ns-intern core "prefers-setup" + (fn [mm-sym] + (def mm-var (mm-var-of mm-sym false)) + (or (and mm-var (get mm-var :jolt/prefers)) {}))) (ns-intern core "get-method-setup" (fn [mm-sym dval] (def mm-var (mm-var-of mm-sym false)) diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index 4a6abd5..3bf04fa 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -291,15 +291,29 @@ (if (and (struct? key) (= :jolt/splice (key :jolt/type))) (read-kvs s new-pos (array/concat kvs (key :items))) (let [pos (skip-whitespace s new-pos) - [val new-pos2] (read-form s pos)] - (if (and (struct? val) (= :jolt/skip (val :jolt/type))) - (read-kvs s new-pos2 kvs) - (if (and (struct? val) (= :jolt/splice (val :jolt/type))) + # The VALUE slot must skip comments/#_ while KEEPING the + # pending key: dropping both (the old behavior) desynced + # the kv pairing — {:a ; comment\n 1} read 1 as the next + # KEY and the closing } landed in value position + # ("Unmatched closing brace", jolt-ou8 / Selmer deps.edn). + [val new-pos2] + (do + (var vp pos) + (var v nil) + (var looking true) + (while looking + (def [f np] (read-form s vp)) + (set vp np) + (if (and (struct? f) (= :jolt/skip (f :jolt/type))) + (set vp (skip-whitespace s np)) + (do (set v f) (set looking false)))) + [v vp])] + (if (and (struct? val) (= :jolt/splice (val :jolt/type))) # Only push key if splice contributes items (if (> (length (val :items)) 0) (do (array/push kvs key) (read-kvs s new-pos2 (array/concat kvs (val :items)))) (read-kvs s new-pos2 kvs)) - (read-kvs s new-pos2 (-> kvs (array/push key) (array/push val)))))))))))) + (read-kvs s new-pos2 (-> kvs (array/push key) (array/push val))))))))))) (read-kvs s (+ pos 1) @[])) (defn read-set [s pos] diff --git a/test/integration/conformance-test.janet b/test/integration/conformance-test.janet index a9507a6..c5fbb7d 100644 --- a/test/integration/conformance-test.janet +++ b/test/integration/conformance-test.janet @@ -129,6 +129,10 @@ ["native bit-not" "-6" "(bit-not 5)"] ["native shifts" "[16 2]" "[(bit-shift-left 4 2) (bit-shift-right 8 2)]"] + ### ---- multimethod preferences (jolt-heo) ---- + ["prefer-method breaks tie" ":rect" + "(do (derive :cm/sq :cm/rect) (derive :cm/sq :cm/shape) (defmulti cmf identity) (defmethod cmf :cm/rect [x] :rect) (defmethod cmf :cm/shape [x] :shape) (prefer-method cmf :cm/rect :cm/shape) (cmf :cm/sq))"] + ### ---- HIGH: str semantics ---- ["str nil empty" "\"\"" "(str nil)"] ["str concat nil" "\"a1\"" "(str \"a\" 1 nil)"] @@ -171,8 +175,9 @@ ["remove-method" "nil" "(do (defmulti t6g :k) (defmethod t6g :b [x] 2) (remove-method t6g :b) (get (methods t6g) :b))"] ["remove-all-methods" "nil" "(do (defmulti t6h :k) (defmethod t6h :c [x] 3) (remove-all-methods t6h) (get (methods t6h) :c))"] # NOTE: dispatch does not yet CONSULT prefers in ambiguous isa dispatch - # (jolt-bug filed) — this asserts prefer-method records the preference. - ["prefer-method records" ":shape" "(do (defmulti t6p identity) (prefer-method t6p :rect :shape) (get (get (var t6p) :jolt/prefers) :rect))"] + # prefer-method records {x -> set-of-dominated} (Clojure's {x #{y}} shape; + # jolt-heo upgraded the store from single-value and dispatch consults it). + ["prefer-method records" "true" "(do (defmulti t6p identity) (prefer-method t6p :rect :shape) (contains? (get (prefers t6p) :rect) :shape))"] ["instance? deftype" "true" "(do (deftype T6i [a]) (instance? T6i (->T6i 1)))"] ["instance? String" "true" "(instance? String \"s\")"] ["locking evals body" "3" "(locking :anything (+ 1 2))"] diff --git a/test/spec/multimethods-spec.janet b/test/spec/multimethods-spec.janet index 845141f..45c7db3 100644 --- a/test/spec/multimethods-spec.janet +++ b/test/spec/multimethods-spec.janet @@ -30,3 +30,19 @@ "(do (defmulti classify :type :default :other) (defmethod classify :a [_] :alpha) (defmethod classify :other [_] :unknown) (classify {:type :zzz}))"] ["explicit :hierarchy" "\"a\"" "(do (def h (derive (make-hierarchy) ::dog ::animal)) (defmulti snd identity :hierarchy h) (defmethod snd ::animal [_] \"a\") (snd ::dog))"]) + +# prefer-method breaks isa-dispatch ties; ambiguity without a preference is +# an ERROR (jolt-heo — this used to silently take an arbitrary method). +(defspec "multimethods / prefer-method" + ["preference picks the winner" ":rect" + "(do (derive :p/sq :p/rect) (derive :p/sq :p/shape) (defmulti pm1 identity) (defmethod pm1 :p/rect [x] :rect) (defmethod pm1 :p/shape [x] :shape) (prefer-method pm1 :p/rect :p/shape) (pm1 :p/sq))"] + ["reverse preference" ":shape" + "(do (derive :q/sq :q/rect) (derive :q/sq :q/shape) (defmulti pm2 identity) (defmethod pm2 :q/rect [x] :rect) (defmethod pm2 :q/shape [x] :shape) (prefer-method pm2 :q/shape :q/rect) (pm2 :q/sq))"] + ["ambiguity throws" :throws + "(do (derive :r/sq :r/rect) (derive :r/sq :r/shape) (defmulti pm3 identity) (defmethod pm3 :r/rect [x] :rect) (defmethod pm3 :r/shape [x] :shape) (pm3 :r/sq))"] + ["isa dominance needs no preference" ":child" + "(do (derive :s/c :s/p) (defmulti pm4 identity) (defmethod pm4 :s/c [x] :child) (defmethod pm4 :s/p [x] :parent) (pm4 :s/c))"] + ["prefers map shape" "true" + "(do (defmulti pm5 identity) (defmethod pm5 :a [x] 1) (defmethod pm5 :b [x] 2) (prefer-method pm5 :a :b) (contains? (get (prefers pm5) :a) :b))"] + ["exact match needs no preference" ":exact" + "(do (derive :t/sq :t/rect) (defmulti pm6 identity) (defmethod pm6 :t/sq [x] :exact) (defmethod pm6 :t/rect [x] :parent) (pm6 :t/sq))"]) diff --git a/test/spec/predicates-spec.janet b/test/spec/predicates-spec.janet index c8bcbc1..bb9b96d 100644 --- a/test/spec/predicates-spec.janet +++ b/test/spec/predicates-spec.janet @@ -184,3 +184,19 @@ ["int? Inf false" "false" "(int? ##Inf)"] ["integer? Inf false" "false" "(integer? ##Inf)"] ["integer? NaN false" "false" "(integer? ##NaN)"]) + +# ifn? is the canonical IFn set (jolt-1vx): lists are NOT IFn. +(defspec "predicates / ifn?" + ["fn" "true" "(ifn? inc)"] + ["keyword" "true" "(ifn? :k)"] + ["symbol" "true" "(ifn? (quote s))"] + ["map" "true" "(ifn? {})"] + ["sorted map" "true" "(ifn? (sorted-map))"] + ["set" "true" "(ifn? #{1})"] + ["vector" "true" "(ifn? [1])"] + ["var" "true" "(ifn? (var first))"] + ["list NOT" "false" "(ifn? (list 1 2))"] + ["lazy NOT" "false" "(ifn? (map inc [1]))"] + ["string NOT" "false" "(ifn? \"s\")"] + ["number NOT" "false" "(ifn? 5)"] + ["nil NOT" "false" "(ifn? nil)"]) diff --git a/test/spec/reader-syntax-spec.janet b/test/spec/reader-syntax-spec.janet index 82c5956..7e39eae 100644 --- a/test/spec/reader-syntax-spec.janet +++ b/test/spec/reader-syntax-spec.janet @@ -58,3 +58,15 @@ ["tagged literal var" "true" "(var? #'+)"] ["deref sugar" "5" "(let [a (atom 5)] @a)"] ["meta sugar" "{:t 1}" "(meta ^{:t 1} [])"]) + +# Comments and #_ discards in a map's VALUE slot keep the pending key +# (jolt-ou8: dropping both desynced kv pairing — Selmer's deps.edn, with a +# "; for development (REPL, etc)" comment between key and value, read its +# closing brace in value position: 'Unmatched closing brace'). +(defspec "reader / comments inside maps" + ["comment in value slot" "{:a 1}" "{:a ; note\n 1}"] + ["comment before key" "{:a 1}" "{; lead\n :a 1}"] + ["comment between entries" "{:a 1 :b 2}" "{:a 1 ; mid\n :b 2}"] + ["discard in value slot" "{:a 1}" "{:a #_9 1}"] + ["comment with parens" "{:a {:b 1}}" "{:a ; dev (REPL, etc)\n {:b 1}}"] + ["nested with comments" "{:x {:y 2}}" "{:x ; outer\n {:y ; inner\n 2}}"])