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).
This commit is contained in:
Yogthos
parent
3c1e0214dd
commit
e859d3e8e7
7 changed files with 128 additions and 49 deletions
|
|
@ -296,6 +296,26 @@
|
|||
(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)
|
||||
;; no clause matched and no default — Clojure throws here.
|
||||
|
|
@ -303,7 +323,9 @@
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -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))]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -18,8 +18,9 @@
|
|||
["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)"])
|
||||
# gap (jolt-vdo): case allows duplicate test constants — Clojure compile-errors.
|
||||
["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 []))"]
|
||||
|
|
@ -52,9 +53,8 @@
|
|||
|
||||
(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]))"])
|
||||
# gap (jolt-w2v): loop bindings aren't sequential — a later init can't reference an
|
||||
# earlier binding (Clojure's loop is like let). (loop* [a 1 b (+ a 1)] …) errors.
|
||||
["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))"]
|
||||
|
|
|
|||
|
|
@ -11,9 +11,10 @@
|
|||
["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)"])
|
||||
# gap (jolt-6x1): %& with a higher positional (e.g. #(do %2 %&)) miscomputes the
|
||||
# fixed arity — (#(do %2 %&) 1 2 3) yields (2 3), should be [3] (rest after %2).
|
||||
["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)"]
|
||||
|
|
@ -21,14 +22,16 @@
|
|||
["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)"])
|
||||
# gap (jolt-xl0): ^meta on collection literals ({}/[]/#{}) isn't attached —
|
||||
# (meta ^:foo {}) is nil; symbol meta + (with-meta …) work.
|
||||
|
||||
(defspec "reader / syntax-quote"
|
||||
["plain literal" "[1 2 3]" "`[1 2 3]"]
|
||||
|
|
@ -36,10 +39,12 @@
|
|||
["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/, but still resolve at eval).
|
||||
# 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])"])
|
||||
# gap (jolt-edb): ~/~@ aren't processed inside set literals (`#{~@a} keeps the
|
||||
# unquote-splicing form literal).
|
||||
["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})"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue