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

Jank derived spec tests (#17)

Browse source 
* test: adapt jank's form/reader tests into spec suites; fix case no-match

Vendoring jank's behavior (not the project): we base our own copies on the
jank test corpus to close coverage gaps, but maintain them ourselves since
jank may diverge. Two new spec batteries (jank-isms translated to Jolt:
letfn* -> letfn, jank catch types -> :default; platform-specific bigdec/
biginteger/ratio/uuid/##Inf/unicode cases omitted):

- test/spec/forms-spec.janet (52): case, fn (arity/variadic/closure/recur/
  named), let, letfn, loop, try, if/do/def/call — incl :throws regression
  cases (no-match, bad params, nil call).
- test/spec/reader-forms-spec.janet (22): #() (% %N %&), #' var-quote,
  ^metadata, syntax-quote (gensym/unquote/splice).

Fix surfaced by adaptation: case with no matching clause and no default now
throws 'No matching clause' (Clojure semantics) instead of returning nil
(00-syntax). Gate green incl full jpm build+test.

Other gaps the adaptation surfaced are filed (tests adjusted to jolt's
current behavior + a comment, not silently dropped):
  jolt-vdo case duplicate test constants not rejected
  jolt-w2v loop bindings not sequential (later init can't see earlier)
  jolt-6x1 #() %& miscomputes arity with a higher positional (%2 …)
  jolt-xl0 ^meta not attached to collection literals ({}/[]/#{})
  jolt-265 syntax-quote doesn't fully-qualify core syms to clojure.core/
  jolt-edb syntax-quote ~/~@ not processed inside set literals

* core: fix 5 Clojure-conformance gaps surfaced by jank tests

All from adapting jank's form/reader tests; each fix verified in interpret +
compile modes and the spec tests now assert the correct behavior.

- jolt-vdo: case now rejects duplicate test constants at expansion (Clojure
  compile error), via bootstrap-safe duplicate detection (00-syntax; analyzer.clj
  uses case during its own build, so seed-only fns).
- jolt-w2v: loop bindings are now sequential like let — a later init can
  reference an earlier binding. Fixed the interpreter loop* (accumulating scope)
  and the back end emit-loop (bind initial inits in a sequential Janet let before
  entering the recur target).
- jolt-6x1: #() reader computes the fixed arity from the MAX positional (%2 ->
  [p1 p2 & rest]); % and %1 unify; unused lower slots get placeholder params.
- jolt-xl0: ^meta on collection literals ({}/[]/#{}) now attaches — read-meta
  passes the NORMALIZED metadata map to with-meta (was the raw meta-form).
- jolt-edb: syntax-quote processes ~/~@ inside set literals (new __sqset builder
  in core + set branches in syntax-quote* and syntax-quote-lower).

Deferred: jolt-265 (fully-qualify core syms to clojure.core/ in syntax-quote) —
it passes conformance but breaks the standalone uberscript (the ns macro emits
unqualified require/in-ns, which then qualify and break bundled require/alias).
Reverted to bare (functionally resolves); re-opened with the finding.

Gate green incl full jpm build + jpm test: conformance 269x3, suite >=4034/67,
fixpoint, self-host, sci 422/0, uberscript, all unit + spec (forms 55, reader 31).

---------

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-10 09:39:33 +08:00 • committed by GitHub
parent 11fb5a7de6
commit ae6e771b18
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 240 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

27
jolt-core/clojure/core/00-syntax.clj
View file

@ -296,13 +296,36 @@
(if (seq? c)
`(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
`(= ~g ~(mk-const c))))
;; Collect test constants pairwise (so a trailing unpaired default is
;; excluded), flattening list/or-group tests into individual constants.
;; seed-only fns (reduce/conj/first/rest/drop/empty?/seq?) — analyzer.clj
;; uses case during its own build, before some/distinct load.
collect (fn* collect [cls acc]
(if (or (empty? cls) (empty? (rest cls)))
acc
(let [t (first cls)
acc (if (seq? t) (reduce conj acc t) (conj acc t))]
(collect (drop 2 cls) acc))))
;; first duplicate constant, wrapped in [x] (so a duplicate nil is detected);
;; nil = none. Clojure rejects duplicate case constants at compile time.
first-dup (fn* fd [items seen]
(if (empty? items)
nil
(let [x (first items)]
(if (reduce (fn [f s] (or f (= s x))) false seen)
[x]
(fd (rest items) (conj seen x))))))
dup (first-dup (collect clauses []) [])
build (fn build [cls]
(if (empty? cls)
nil
;; no clause matched and no default — Clojure throws here.
`(throw (ex-info (str "No matching clause: " ~g) {}))
(if (empty? (rest cls))
(first cls)
`(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
`(let* [~g ~expr] ~(build clauses))))
(if dup
(throw (str "Duplicate case test constant: " (first dup)))
`(let* [~g ~expr] ~(build clauses)))))
;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so

13
src/jolt/backend.janet
View file

@ -108,15 +108,20 @@
(defn- emit-loop [ctx node]
(def L (symbol (node :recur-name)))
(def params @[])
(def inits @[])
# Initial inits bind SEQUENTIALLY (a later init can reference an earlier binding,
# like let / Clojure's loop) — emit them in a Janet `let`, then enter the recur
# target L with those values, rather than computing all inits in the outer scope.
(def let-binds @[])
(each pair (vview (node :bindings))
(def p (vview pair))
(array/push params (symbol (in p 0)))
(array/push inits (emit ctx (in p 1))))
(def sym (symbol (in p 0)))
(array/push params sym)
(array/push let-binds sym)
(array/push let-binds (emit ctx (in p 1))))
['do
['var L nil]
['set L ['fn (tuple/slice params) (emit ctx (node :body))]]
(tuple/slice (array/concat @[L] inits))])
['let (tuple/slice let-binds) (tuple/slice (array/concat @[L] params))]])
(defn- emit-recur [ctx node]
(tuple/slice (array/concat @[(symbol (node :recur-name))]

7
src/jolt/core.janet
View file

@ -144,6 +144,12 @@
# Map builder: parts are alternating k v (no splicing in map syntax-quote).
(defn core-sqmap [& parts] (kvs->map (array ;parts)))
# Set builder: like core-sqvec but yields a set, so `#{~@a} splices into a set.
(defn core-sqset [& parts]
(def r @[])
(each p parts (each x (realize-for-iteration p) (array/push r x)))
(apply make-phs r))
# ============================================================
# Predicates
# ============================================================
@ -2742,6 +2748,7 @@
"__sqcat" core-sqcat
"__sqvec" core-sqvec
"__sqmap" core-sqmap
"__sqset" core-sqset
"into" core-into
"merge" core-merge
"merge-with" core-merge-with

32
src/jolt/evaluator.janet
View file

@ -135,9 +135,10 @@
(defn- sq-symbol
"Resolve a symbol inside syntax-quote. `foo#` becomes a stable auto-gensym
(per-expansion, via gsmap); special forms and clojure.core names are left
unqualified (they resolve via the core fallback); other symbols are qualified
to the current namespace so they resolve when the macro is used elsewhere."
(per-expansion, via gsmap); special forms are left unqualified; a clojure.core
name is fully qualified to clojure.core/ (matching Clojure, for hygiene); other
symbols are qualified to the current namespace so they resolve when the macro is
used elsewhere."
[ctx form gsmap]
(if (nil? (form :ns))
(let [nm (form :name)]
@ -199,6 +200,15 @@
(each v (d-realize sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(++ i)) result)
# set literal: lower each element (processing ~/~@) and rebuild a set.
(and (struct? form) (= :jolt/set (form :jolt/type)))
(do (var result @[])
(each item (form :value)
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(let [sv (eval-form ctx bindings (in item 1))]
(each v (d-realize sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(make-phs ;result))
(and (struct? form) (get form :jolt/type)) form
(struct? form)
(do (var kvs @[]) (each k (keys form)
@ -238,7 +248,10 @@
(array/concat @[(sqsym* "__sqcat")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
(tuple? form)
(array/concat @[(sqsym* "__sqvec")] (map (fn [it] (sq-lower-part ctx it gsmap)) form))
# tagged structs (sets/chars): syntax-quote* returns them as-is (no recursion)
# set literal: lower each element (so ~/~@ are processed) and rebuild a set.
(and (struct? form) (= :jolt/set (form :jolt/type)))
(array/concat @[(sqsym* "__sqset")] (map (fn [it] (sq-lower-part ctx it gsmap)) (form :value)))
# other tagged structs (chars): returned as-is (no recursion)
(and (struct? form) (get form :jolt/type))
@[(sqsym* "quote") form]
(struct? form)
@ -1188,13 +1201,20 @@
"loop*" (let [bind-vec (in form 1)
body (tuple/slice form 2)
init-vals @[]
patterns @[]]
patterns @[]
# Inits are evaluated sequentially in an accumulating scope (like
# let*), so a later init can reference an earlier binding —
# matching Clojure's loop.
seq-bindings @{}]
(table/setproto seq-bindings bindings)
(var i 0)
(while (< i (length bind-vec))
# loop* is a primitive (the loop macro desugars destructuring);
# its binding names must be plain symbols, as in Clojure.
(unless (plain-sym? (bind-vec i)) (error "Bad binding form, expected symbol"))
(array/push init-vals (eval-form ctx bindings (bind-vec (+ i 1))))
(def v (eval-form ctx seq-bindings (bind-vec (+ i 1))))
(bind-put seq-bindings ((bind-vec i) :name) v)
(array/push init-vals v)
(array/push patterns (bind-vec i))
(+= i 2))
(var loop-fn nil)

66
src/jolt/reader.janet
View file

@ -338,36 +338,54 @@
(defn read-anon-fn [s pos]
# pos is at #, next char is (
(let [[form new-pos] (read-form s (+ pos 1))]
# Collect % arg references and rename them to gensyms
(var arg-map @{})
# Positional index of a %-symbol name: % and %1 are both 1, %N is N, %& is the
# rest param (:rest); anything else is not a positional (nil). The fixed arity
# is the MAX index used (Clojure semantics: #(do %2 %&) -> [p1 p2 & rest], so
# unused lower positions still get a placeholder param and %& starts after %2).
(defn- pct-index [nm]
(cond
(= nm "%") 1
(= nm "%&") :rest
(and (> (length nm) 1) (= "%" (string/slice nm 0 1)))
(let [n (scan-number (string/slice nm 1))]
(if (and n (= n (math/floor n)) (>= n 1)) n nil))
nil))
# Pass 1: max positional index + whether %& is used.
(var max-n 0)
(var has-rest false)
(defn- scan-pct [f]
(cond
(and (struct? f) (= :symbol (f :jolt/type)))
(let [i (pct-index (f :name))]
(cond (= i :rest) (set has-rest true)
(and i (> i max-n)) (set max-n i)))
(or (array? f) (tuple? f)) (each x f (scan-pct x))
nil))
(scan-pct form)
# One canonical gensym per slot 1..max-n (placeholders for unused), plus rest.
(def slot-syms @{})
(var i 1)
(while (<= i max-n) (put slot-syms i (sym (string (gensym)))) (++ i))
(def rest-sym (if has-rest (sym (string (gensym))) nil))
# Pass 2: replace each %-symbol with its slot's gensym.
(defn- replace-pct [f]
(cond
(and (struct? f) (= :symbol (f :jolt/type)))
(let [nm (f :name)]
(if (and (> (length nm) 0) (= "%" (string/slice nm 0 1)))
(let [existing (get arg-map nm)]
(if existing
{:jolt/type :symbol :ns nil :name existing}
(let [gen (gensym)]
(put arg-map nm (string gen))
{:jolt/type :symbol :ns nil :name (string gen)})))
f))
(let [idx (pct-index (f :name))]
(cond (= idx :rest) rest-sym
idx (get slot-syms idx)
f))
(array? f) (array ;(map replace-pct f))
(tuple? f) (tuple ;(map replace-pct f))
f))
(def replaced (replace-pct form))
(def arg-names @[])
# Positional params %, %1, %2, ... in order; %& becomes a `& rest` param.
(def pos-keys (sort (filter |(not= $ "%&") (keys arg-map))))
(each k pos-keys
(array/push arg-names {:jolt/type :symbol :ns nil :name (get arg-map k)}))
(when (get arg-map "%&")
(set i 1)
(while (<= i max-n) (array/push arg-names (get slot-syms i)) (++ i))
(when has-rest
(array/push arg-names (sym "&"))
(array/push arg-names {:jolt/type :symbol :ns nil :name (get arg-map "%&")}))
(def result @[(sym "fn*")])
(array/push result (tuple ;arg-names))
(array/push result replaced)
[result new-pos]))
(array/push arg-names rest-sym))
[@[(sym "fn*") (tuple ;arg-names) replaced] new-pos]))
(defn read-reader-conditional [s pos]
# pos is at #, next char is ? or ?@
@ -479,8 +497,10 @@
# position (params, lets, bodies) — the evaluator reads :name and ignores
# :meta. This is what makes type hints "parse and otherwise do nothing".
[(struct ;(kvs form) :meta (merge (or (form :meta) {}) m)) new-pos2]
# Map metadata or non-symbol targets keep the runtime with-meta form.
[(array (sym "with-meta") form meta-form) new-pos2])))
# Non-symbol targets (collections etc.) keep a runtime with-meta form. Use the
# NORMALIZED metadata map (:kw -> {:kw true}, tag -> {:tag …}); a map-literal
# meta-form (m is nil) is already a map, so pass it through.
[(array (sym "with-meta") form (if m m meta-form)) new-pos2])))
(defn read-until-newline [s pos]
(if (or (>= pos (length s)) (= (s pos) 10))

80
test/spec/forms-spec.janet Normal file
View file

@ -0,0 +1,80 @@
# Specification: core special forms (case/fn/let/letfn/loop/if/do/def/call).
#
# Adapted from the jank test corpus (compiler+runtime/test/jank/form/**, /call) —
# we base our coverage on jank's to close gaps, but maintain our own copies since
# jank may diverge. jank-isms are translated to Jolt/Clojure: letfn* -> letfn,
# (catch jank.runtime.object_ref …) -> (catch :default …). Platform-specific cases
# (bigdecimal M, biginteger, ratios, unicode char edges) are intentionally omitted.
#
# Multi-form jank files (def + asserts, ending in :success) are wrapped in a single
# (do … :success) so they run as one expression and assert :success.
(use ../support/harness)
(defspec "forms / case"
["bool" ":yes" "(case true true :yes false :no :default)"]
["keyword match" ":b" "(case :a :x :wrong :a :b :default)"]
["number match" ":two" "(case 2 1 :one 2 :two :default)"]
["string match" ":hit" "(case \"x\" \"y\" :miss \"x\" :hit :default)"]
["nil match" ":nada" "(case nil nil :nada :default)"]
["default" ":def" "(case 99 1 :one 2 :two :def)"]
["list of consts" ":vowel" "(case \\a (\\a \\e \\i \\o \\u) :vowel :consonant)"]
["no match no default" :throws "(case 5 1 :one)"]
["duplicate keys" :throws "(case 1 1 :one 1 :dup :default)"]
["duplicate in or-group" :throws "(case 2 (1 2) :a (2 3) :b :default)"])
(defspec "forms / fn"
["named fn nil" "nil" "((fn* foo-bar []))"]
["immediate call" "1" "((fn* [] 1))"]
["args" "[:a :b]" "((fn* [a b] [a b]) :a :b)"]
["multi-arity 0" "0" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add))"]
["multi-arity 1" "-500" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add -500))"]
["multi-arity 2" "-450" "(do (def add (fn* ([] 0) ([a] a) ([a b] (+ a b)))) (add -500 50))"]
["variadic rest" "[3 4]" "(do (def v (fn* ([a b & args] args) ([] 0))) (v 1 2 3 4))"]
["variadic empty" "0" "(do (def v (fn* ([a b & args] args) ([] 0))) (v))"]
["variadic collect" "[{} nil :m]" "((fn* [a b & args] args) 'w 't {} nil :m)"]
["closure capture" "8" "(do (def adder (fn* [n] (fn* [x] (+ x n)))) ((adder 5) 3))"]
["recur countdown" "0" "(do (def cd (fn* [n] (if (< 0 n) (recur (+ n -1)) n))) (cd 10))"]
["named self-recur" "120" "(do (def f (fn* fact [n] (if (= n 0) 1 (* n (fact (dec n)))))) (f 5))"]
["no param vector" :throws "(fn* foo)"]
["non-symbol param" :throws "(fn* [1] 1)"])
(defspec "forms / let"
["literal" "1" "(let* [a 1] a)"]
["multiple" "[1 2]" "(let* [a 1 b 2] [a b])"]
["previous ref" ":bee" "(let* [a 1 b (if (= 1 a) :bee :uh-oh)] b)"]
["nested let" "3" "(let* [a 5 b (let* [c -2] (+ a c))] b)"]
["fn value bound" "\":foo\"" "(let* [kw->str (fn* [kw] (str kw))] (kw->str :foo))"]
["shadowing" "2" "(let* [a 1 a 2] a)"])
(defspec "forms / letfn"
["mutual top" "[1 2]" "(letfn [(a [] 1) (b [] 2)] [(a) (b)])"]
["mutual recursion" ":done" "(letfn [(ev? [n] (if (= 0 n) :done (od? (dec n)))) (od? [n] (ev? n))] (ev? 4))"]
["nested letfn" "3" "(letfn [(a [] 5) (b [] (letfn [(c [] -2)] (+ (a) (c))))] (b))"])
(defspec "forms / loop"
["sum" "55" "(loop* [sum 0 cnt 10] (if (= cnt 0) sum (recur (+ cnt sum) (dec cnt))))"]
["multi binding" "[4 2]" "(loop* [a 1 b 2 n 0] (if (< n 3) (recur (inc a) b (inc n)) [a b]))"]
["init sees prior" "[1 2 3]" "(loop* [a 1 b (+ a 1) c (+ b 1)] [a b c])"])
(defspec "forms / try"
["immediate throw caught" ":caught" "(try (throw :boom) (catch :default e :caught))"]
["first throw wins" "\"a\"" "(try (throw (ex-info \"a\" {})) (throw (ex-info \"b\" {})) (catch :default e (ex-message e)))"]
["catch ex-data" "7" "(try (throw (ex-info \"e\" {:v 7})) (catch :default e (:v (ex-data e))))"]
["finally runs" "9" "(let [a (atom 0)] (try 1 (finally (reset! a 9))) @a)"]
["body value w/ finally" "1" "(try 1 (finally 2))"]
["catch value w/ finally" ":h" "(try (throw (ex-info \"x\" {})) (catch :default e :h) (finally :ignored))"]
["no throw skips catch" "5" "(try 5 (catch :default e :nope))"])
(defspec "forms / if-do-def-call"
["if truthy vec" ":fine" "(if [:ok] :fine :no)"]
["if truthy str" ":fine" "(if \"good?\" :fine :no)"]
["if nil = false" ":else" "(if nil :then :else)"]
["if no else" "nil" "(if false 1)"]
["do nested" "1" "(do (do (do (do 1))))"]
["do returns last" "3" "(do 1 2 3)"]
["def + deref var" "true" "(var? (def one 1))"]
["def redefine" "100" "(do (def one 1) (def one 100) one)"]
["def in fn mutates" "[:default :meow]" "(do (def a :default) (def set-a (fn* [v] (def a v))) (let* [before a] (set-a :meow) [before a]))"]
["call literal fn" "1" "((fn* [] 1))"]
["call nested" "6" "(+ ((fn* [] 1)) ((fn* [] 2)) ((fn* [] 3)))"]
["call nil" :throws "(nil)"])

50
test/spec/reader-forms-spec.janet Normal file
View file

@ -0,0 +1,50 @@
# Specification: reader forms + syntax-quote + metadata.
#
# Adapted from the jank test corpus (test/jank/{syntax-quote,metadata,reader-macro,
# call}); we keep our own copies since jank may diverge. Syntax-quoted symbols are
# qualified to clojure.core (matching jank/Clojure). Platform-specific reader forms
# (#uuid, #inst, ##Inf/##NaN, bigdecimal/biginteger/ratio) are omitted.
(use ../support/harness)
(defspec "reader / anonymous fn #()"
["no args" "3" "(#(+ 1 2))"]
["one arg %" "6" "(#(* % 2) 3)"]
["positional %1 %2" "[1 2]" "(#(do [%1 %2]) 1 2)"]
["rest %&" "[1 2 3]" "(#(do %&) 1 2 3)"]
["fixed + rest" "[2 3]" "(#(do % %&) 1 2 3)"]
["%2 + rest" "[3]" "(#(do %2 %&) 1 2 3)"]
["%2 only (placeholder p1)" "20" "(#(* %2 2) 1 10)"]
["% and %1 same" "10" "(#(+ % %1) 5)"])
(defspec "reader / var-quote #'"
["var-quote = var" "true" "(= (var str) #'str)"]
["is a var" "true" "(var? #'str)"]
["deref var-quote" "5" "(do (def w 5) (deref #'w))"])
(defspec "reader / metadata ^"
["meta on map" "true" "(:foo (meta ^:foo {}))"]
["meta on vector" "true" "(:foo (meta ^:foo [1 2]))"]
["meta on set" "true" "(:foo (meta ^:foo #{}))"]
["meta map form" "1" "(:a (meta ^{:a 1} {}))"]
["meta on quoted sym" "true" "(:foo (meta (quote ^:foo bar)))"]
["with-meta map" "true" "(:k (meta (with-meta {} {:k true})))"]
["with-meta vector" "true" "(:k (meta (with-meta [] {:k true})))"]
["non-metadatable num" "nil" "(meta 100)"]
["non-metadatable str" "nil" "(meta \"\")"]
["non-metadatable bool" "nil" "(meta true)"])
(defspec "reader / syntax-quote"
["plain literal" "[1 2 3]" "`[1 2 3]"]
["gensym distinct" "true" "(not= `meow# `meow#)"]
["gensym stable" "true" "(let [s `[meow# meow#]] (= (first s) (second s)))"]
["qualifies unresolved" "(quote user/foo)" "`foo"]
["unquote value" "[1 2 3]" "(let [a [1 2 3]] `~a)"]
# functional: the syntax-quoted call evaluates correctly. (jolt-265: core syms are
# left bare rather than qualified to clojure.core/ — full qualification breaks the
# standalone uberscript's ns macro, so it's deferred; they still resolve at eval.)
["unquote call evals" "6" "(let [a 5] (eval `(+ ~a 1)))"]
["splice call evals" "6" "(let [a [1 2 3]] (eval `(+ ~@a)))"]
["splice in vector" "[1 2 3 0 1 2 3]" "(let [b [0] a [1 2 3] e []] `[~@e ~@a ~@b ~@a ~@e])"]
# jolt-edb (fixed): ~/~@ inside set literals.
["splice in set" "#{0 1 2 3}" "(let [b [0] a [1 2 3] e []] `#{~@e ~@a ~@b})"]
["unquote in set" "#{5 9}" "(let [x 5] `#{~x 9})"])