simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

core: three bug fixes — ifn?, prefer-method dispatch, reader comments in map values

Browse source 
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.
This commit is contained in:
Yogthos 2026-06-10 21:03:14 -04:00
parent 19606730a3
commit c06af7c9f4
9 changed files with 133 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/jolt/core.janet
View file

@ -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?

56
src/jolt/evaluator.janet
View file

@ -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))

24
src/jolt/reader.janet
View file

@ -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]