Stage1 analyzer parity (#11)

* compiler: self-hosted analyzer compiles set literals (#{…})

Stage 1 Task 1. analyzer.clj punted set literals to the interpreter
((form-set? form) (uncompilable "set literal")); now it builds the set-node IR
(already defined in ir.clj) from (form-set-items form), and backend.janet emits
(make-phs e1 e2 …) — each element evaluated then the persistent set built,
mirroring compiler.janet's emit-set-expr and the interpreter's :jolt/set path.

Closes a self-hosted-analyzer vs bootstrap-compiler parity gap: #{…} no longer
forces interpreter fallback on the compile path.

Gate: conformance 262x3 (+4 set-literal cases incl computed elements / empty /
in-let), fixpoint, self-host, sci, suite 3981/66, specs+unit green; core-bench
neutral (A/B). set?/disj-as-fns remain deliberately interpreted (in-sync across
all three lists) — adjudicated in Task 2.

* test: fallback-zero harness — assert non-stateful forms compile (not interpret)

Stage 1 Task 3. self-host-test checks results but not which path ran. This runs
the portable analyzer (backend/analyze-form) on a corpus of non-stateful forms
and asserts NONE raise :jolt/uncompilable — i.e. the self-hosted analyzer
compiled them, not the interpreter fallback. Inverse sanity list confirms a few
intentional-interpret forms (ns/defmacro/require/set?/letfn) still punt, so the
harness can't pass by compiling everything.

29 must-compile (incl set literals from Task 1) + 5 must-punt, 0 failures. As
Stage 1 parity grows, forms move from the punt list into must-compile; when the
fallback set equals the frozen intentional stateful set, the bootstrap is
retireable.

* core: migrate 7 lazy seq fns from the Janet seed to the Clojure overlay (40-lazy)

Finishes a port the prior team started and reverted (bb4a3e0): the 40-lazy.clj
tier moved lazy seq fns Janet→Clojure but regressed the suite to 849 because
lazy-seq's expansion leaked as data in compile mode — that was jolt-r81, since
root-fixed (lazy-seq/lazy-cat moved to 00-syntax). With the wall gone, the port
works. This shrinks the Janet seed toward the north star (self-hosted
clojure-in-clojure on a minimal host bootstrap).

Moved to core/40-lazy.clj (wired as a loaded tier after 30-macros):
  distinct keep keep-indexed map-indexed cycle repeat iterate
40-lazy.clj completed to full parity: distinct gains its transducer arity;
keep/keep-indexed/map-indexed already had both arities.

Removed from the Janet seed (core.janet): the 7 core-* fns + their core-bindings
entries, the now-dead td-keep/td-map-indexed transducer helpers (the CLJ versions
carry their own), and the already-dead core-partition-by/core-xml-seq (shadowed by
10-seq/20-coll). Net: core.janet −131 lines.

Deferred (kept in Janet, separate follow-ups): partition-all (a CLJ port via
take/drop realizes a non-minimal element count, tripping the §6.3 laziness
counters + a suite file) and repeatedly (canonical CLJ doesn't validate args, so
the repeatedly.cljc throw cases regress). Both need behavior-matching first.

Gate: conformance 262x3, lazy-infinite 44/44, clojure-test-suite 4004/66 (UP from
3981 — the CLJ versions add coverage, e.g. distinct value-equality), fixpoint,
self-host, sci 422/0, fallback-zero, specs+unit, core-bench all green.

* test: raise clojure-test-suite baseline 3981 -> 4004 (lazy-fn migration coverage)

* core: migrate partition-all to the Clojure overlay (minimal realization)

Resolves the deferred partition-all port (jolt-yo3). The earlier CLJ attempt via
lazy take/drop over-realized vs the Janet pstep, tripping the §6.3 laziness
counter. The collection arities now realize EXACTLY n per chunk with a first/rest
loop and continue from the advanced cursor (no re-drop), so (take 3 (partition-all
2 (map counting (range)))) realizes exactly 6 — matching minimal realization in
both interpret and compile modes. Keeps transducer + [n coll] + [n step coll]
arities. letfn-bound recursion sidesteps the compile-mode multi-arity closure bug
(jolt-zxw), like keep-indexed/map-indexed.

Removed from the Janet seed: core-partition-all + its binding + the now-dead
td-partition-all helper (the CLJ version carries its own transducer arity).

Gate: conformance 262x3, lazy-infinite 44/44 (incl the §6.3 partition-all
counter), clojure-test-suite 4004/66, fixpoint, self-host, specs+unit green.

* core: migrate repeatedly to Clojure + fix char-not-callable / take count validation

Resolves the deferred repeatedly port (jolt-8qx). The blockers were two jolt
leniencies vs Clojure, now fixed (and correct beyond repeatedly):

- A char (a :jolt/type-tagged struct) fell into the struct-as-map branch of both
  jolt-call (compile path) and the interpreter's apply dispatch, so (\a) returned
  nil instead of throwing. Now only an UNtagged struct (a map literal) — or a
  record — is callable as a key lookup; tagged structs fall through to "Cannot
  call … as a function". Symbols are still handled (keyword-style get).
- core-take didn't validate its count, letting Janet's >= silently compare an int
  to a char/string. It now rejects a non-number n like Clojure.

With those, the canonical CLJ repeatedly matches: (first (repeatedly non-fn)) and
(repeatedly non-number f) throw. Moved repeatedly to core/40-lazy.clj; removed
core-repeatedly + its binding from the seed.

These correctness fixes help broadly: repeatedly.cljc goes clean (19/10 -> 29/0),
and the suite rises 4004 -> 4034 pass / 66 -> 67 clean. Baseline raised.

Gate: conformance 262x3, lazy-infinite 44/44, clojure-test-suite 4034/67,
fixpoint, self-host, sci, fallback-zero, specs+unit green.

* test: document the 4004 -> 4034 baseline raise (partition-all/repeatedly + char/take fixes)

* docs: partition-all letfn is for minimal realization, not jolt-zxw

jolt-zxw (multi-arity arity-param mis-capture in a nested lazy-seq under :compile?)
is no longer reproducible: an arity-direct partition-all now compiles correctly in
the overlay. The original failure was an artifact of the CLJ multi-arity version
coexisting with the Janet core-partition-all ([n & rest]) during migration — the
shadowing confused multi-arity dispatch; removing the Janet version resolved it.
The letfn in partition-all stays purely for minimal realization (jolt-yo3).

* compiler: compile set?/disj as plain fns (close the last Stage-1 fallback gap)

Stage 1 jolt-g3h. set? and disj were special-cased in all three "can't compile"
lists (host_iface special-names, compiler.janet uncompilable-heads, evaluator
special-symbol? + handlers) — but they're pure value-production with callable
core vars (core-set?/core-disj), and those vars are byte-for-byte equivalent to
the evaluator handlers. Removed them from all three lists + dropped the now-dead
evaluator handler arms, so they're ordinary clojure.core fns everywhere: the
analyzer compiles (set? x)/(disj s x) as normal var calls instead of punting to
the interpreter.

Verified identical results in default AND JOLT_MUTABLE builds (no representation
sensitivity — sets are phs in both, unlike vector?/list? which collapse).

With this, the self-hosted analyzer's compile-path fallback set equals the frozen
intentional stateful set (Task 2) — it's now a strict superset of the bootstrap
compiler's compilable surface, so the Janet bootstrap is retireable (Stage 2).

fallback-zero: set?/disj moved to must-compile (31 now), set! into must-punt.
Gate: conformance 267x3 (+5 set?/disj cases), lazy-infinite 44/44, suite 4034/67,
fixpoint, self-host, sci, specs+unit green.
This commit is contained in:
Dmitri Sotnikov 2026-06-09 12:24:37 +08:00 committed by GitHub
parent fdf2c742c4
commit 1ded89b47b
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
11 changed files with 179 additions and 200 deletions

View file

@ -3,8 +3,17 @@
;; ;;
;; Each fn ported from CLJS core.cljs, stripped of chunked-seq branches. ;; Each fn ported from CLJS core.cljs, stripped of chunked-seq branches.
;; --- distinct --- ;; --- distinct --- (transducer + lazy collection arity; value-based dedup)
(defn distinct [coll] (defn distinct
([]
(fn [rf]
(let [seen (volatile! #{})]
(fn ([] (rf)) ([result] (rf result))
([result input]
(if (contains? @seen input)
result
(do (vswap! seen conj input) (rf result input))))))))
([coll]
(let [step (fn step [xs seen] (let [step (fn step [xs seen]
(lazy-seq (lazy-seq
((fn [[f :as xs] seen] ((fn [[f :as xs] seen]
@ -13,7 +22,7 @@
(recur (rest s) seen) (recur (rest s) seen)
(cons f (step (rest s) (conj seen f)))))) (cons f (step (rest s) (conj seen f))))))
xs seen)))] xs seen)))]
(step coll #{}))) (step coll #{}))))
;; --- keep --- ;; --- keep ---
@ -76,7 +85,9 @@
(cstep 0))) (cstep 0)))
())) ()))
;; --- repeatedly --- ;; --- repeatedly --- ((f) throws on a non-fn; (take n …) throws on a non-number
;; count — both now enforced in the seed (jolt-call / core-take), so the canonical
;; CLJ form matches the repeatedly.cljc exception cases.)
(defn repeatedly (defn repeatedly
([f] (lazy-seq (cons (f) (repeatedly f)))) ([f] (lazy-seq (cons (f) (repeatedly f))))
([n f] (take n (repeatedly f)))) ([n f] (take n (repeatedly f))))
@ -91,10 +102,39 @@
(lazy-seq (cons x (iterate f (f x))))) (lazy-seq (cons x (iterate f (f x)))))
;; --- partition-all --- ;; --- partition-all --- (transducer + [n coll] + [n step coll])
;; The collection arities realize EXACTLY n per chunk via a first/rest loop and
;; continue from the advanced cursor (not a re-drop / nthrest), so they realize
;; minimally — matching the Janet pstep the §6.3 laziness counters were written
;; against. (A take/nthrest form is correct but over-realizes.)
(defn partition-all (defn partition-all
([n coll] (partition-all n n coll)) ([n]
([n step coll] (fn [rf]
(let [a (volatile! [])]
(fn
([] (rf))
([result]
(let [result (if (zero? (count @a))
result
(let [v @a] (vreset! a []) (unreduced (rf result v))))]
(rf result)))
([result input]
(vswap! a conj input)
(if (= n (count @a))
(let [v @a] (vreset! a []) (rf result v))
result))))))
([n coll]
(letfn [(go [s]
(lazy-seq (lazy-seq
(when-let [s (seq coll)] (when (seq s)
(cons (take n s) (partition-all n step (nthrest coll step))))))) (loop [i 0 chunk [] cur s]
(if (and (< i n) (seq cur))
(recur (inc i) (conj chunk (first cur)) (rest cur))
(cons chunk (go cur)))))))]
(go coll)))
([n step coll]
(letfn [(go [s]
(lazy-seq
(when (seq s)
(cons (take n s) (go (nthrest s step))))))]
(go coll))))

View file

@ -15,12 +15,12 @@
declared the bootstrap compiles forward refs through var cells, but keeping declared the bootstrap compiles forward refs through var cells, but keeping
them to one keeps the compiled namespace simple." them to one keeps the compiled namespace simple."
(:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke (:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke
def-node let-node fn-node vector-node map-node def-node let-node fn-node vector-node map-node set-node
quote-node throw-node]] quote-node throw-node]]
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list? [jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list?
form-vec? form-map? form-set? form-char? form-vec? form-map? form-set? form-char?
form-literal? form-elements form-vec-items form-literal? form-elements form-vec-items
form-map-pairs form-special? compile-ns form-map-pairs form-set-items form-special? compile-ns
form-macro? form-expand-1 resolve-global form-macro? form-expand-1 resolve-global
form-sym-meta host-intern! form-syntax-quote-lower]])) form-sym-meta host-intern! form-syntax-quote-lower]]))
@ -207,6 +207,6 @@
(form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env) (form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env)
(analyze ctx (second p) env)]) (analyze ctx (second p) env)])
(form-map-pairs form))) (form-map-pairs form)))
(form-set? form) (uncompilable "set literal") (form-set? form) (set-node (mapv #(analyze ctx % env) (form-set-items form)))
(form-list? form) (analyze-list ctx form env) (form-list? form) (analyze-list ctx form env)
:else (uncompilable "unsupported form")))) :else (uncompilable "unsupported form"))))

View file

@ -53,7 +53,8 @@
{:ns "clojure.core.00-kernel" :kernel true} {:ns "clojure.core.00-kernel" :kernel true}
{:ns "clojure.core.10-seq" :kernel false} {:ns "clojure.core.10-seq" :kernel false}
{:ns "clojure.core.20-coll" :kernel false} {:ns "clojure.core.20-coll" :kernel false}
{:ns "clojure.core.30-macros" :kernel false}]) {:ns "clojure.core.30-macros" :kernel false}
{:ns "clojure.core.40-lazy" :kernel false}])
(defn- eval-overlay-source [ctx src] (defn- eval-overlay-source [ctx src]
(var s src) (var s src)

View file

@ -230,6 +230,12 @@
(array/push args (emit ctx (in p 1)))) (array/push args (emit ctx (in p 1))))
(tuple/slice args)) (tuple/slice args))
# A set literal: build (make-phs e1 e2 …) so each element is evaluated at runtime
# then the persistent set is constructed — mirrors compiler.janet's emit-set-expr.
(defn- emit-set [ctx node]
(def items (map |(emit ctx $) (vview (node :items))))
(tuple/slice (array/concat @[phm/make-phs] items)))
(set emit (set emit
(fn emit [ctx raw] (fn emit [ctx raw]
(def node (norm-node raw)) (def node (norm-node raw))
@ -259,6 +265,7 @@
:invoke (emit-invoke ctx node) :invoke (emit-invoke ctx node)
:vector (emit-vector ctx node) :vector (emit-vector ctx node)
:map (emit-map ctx node) :map (emit-map ctx node)
:set (emit-set ctx node)
:quote ['quote (node :form)] :quote ['quote (node :form)]
(error (string "backend: unhandled op " (node :op)))))) (error (string "backend: unhandled op " (node :op))))))

View file

@ -163,7 +163,6 @@
"find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve" "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve"
"ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns"
"alter-var-root" "alter-meta!" "reset-meta!" "locking" "new" "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new"
"disj" "set?"
# Definitional/host macros that mutate context or build runtime # Definitional/host macros that mutate context or build runtime
# values the emitter doesn't model. # values the emitter doesn't model.
"defrecord" "defprotocol" "definterface" "reify" "proxy" "defrecord" "defprotocol" "definterface" "reify" "proxy"

View file

@ -508,7 +508,10 @@
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f))) (if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f)))
(in f k) (in f k)
(error (string "Index " k " out of bounds for vector of length " (length f))))) (error (string "Index " k " out of bounds for vector of length " (length f)))))
(or (struct? f) (and (table? f) (get f :jolt/deftype))) # Map literal (struct with no :jolt/type marker) or a record: callable as a
# key lookup. A TAGGED struct (char/etc.) is NOT a fn — symbols are handled
# above; everything else with a :jolt/type falls through to the error.
(or (and (struct? f) (nil? (get f :jolt/type))) (and (table? f) (get f :jolt/deftype)))
(let [v (get f (get args 0) :jolt/not-found)] (let [v (get f (get args 0) :jolt/not-found)]
(if (= v :jolt/not-found) (get args 1) v)) (if (= v :jolt/not-found) (get args 1) v))
(error (string "Cannot call " (type f) " as a function")))) (error (string "Cannot call " (type f) " as a function"))))
@ -804,9 +807,7 @@
(fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0))
(if (truthy? (pred (a 1))) (rf (a 0) (a 1)) (a 0)))))) (if (truthy? (pred (a 1))) (rf (a 0) (a 1)) (a 0))))))
(defn td-remove [pred] (td-filter (fn [x] (not (pred x))))) (defn td-remove [pred] (td-filter (fn [x] (not (pred x)))))
(defn td-keep [f] # td-keep removed: keep (incl its transducer arity) lives in core/40-lazy.clj.
(fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0))
(let [v (f (a 1))] (if (nil? v) (a 0) (rf (a 0) v)))))))
(defn td-take [n] (defn td-take [n]
(fn [rf] (fn [rf]
(var left n) (var left n)
@ -829,31 +830,11 @@
(fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0))
(do (when (and dropping (not (truthy? (pred (a 1))))) (set dropping false)) (do (when (and dropping (not (truthy? (pred (a 1))))) (set dropping false))
(if dropping (a 0) (rf (a 0) (a 1)))))))) (if dropping (a 0) (rf (a 0) (a 1))))))))
(defn td-map-indexed [f] # td-map-indexed removed: map-indexed (incl transducer arity) lives in core/40-lazy.clj.
(fn [rf]
(var i -1)
(fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (do (++ i) (rf (a 0) (f i (a 1))))))))
# Stateful windowing transducers. The 1-arg (completion) arity flushes a partial # Stateful windowing transducers. The 1-arg (completion) arity flushes a partial
# trailing window before delegating to rf's completion; matches Clojure. # trailing window before delegating to rf's completion; matches Clojure.
(defn td-partition-all [n] # td-partition-all removed: partition-all (incl transducer arity) lives in core/40-lazy.clj.
(fn [rf]
(var buf @[])
(fn [& a]
(case (length a)
0 (rf)
1 (let [result (if (= 0 (length buf)) (a 0)
(let [v (tuple/slice (tuple ;buf))]
(set buf @[])
(core-unreduced (rf (a 0) v))))]
(rf result))
(do
(array/push buf (a 1))
(if (= n (length buf))
(let [v (tuple/slice (tuple ;buf))]
(set buf @[])
(rf (a 0) v))
(a 0)))))))
# partition-by's transducer arity lives with its (lazy) collection arity in the # partition-by's transducer arity lives with its (lazy) collection arity in the
# overlay (10-seq tier), written in Clojure with volatiles. # overlay (10-seq tier), written in Clojure with volatiles.
@ -1113,6 +1094,9 @@
(error "Wrong number of args passed to: reduce")))) (error "Wrong number of args passed to: reduce"))))
(defn core-take [n & rest] (defn core-take [n & rest]
# n is a count — reject non-numbers (e.g. a char/string) like Clojure, rather
# than letting Janet's >= silently compare mixed types.
(unless (number? n) (error (string "take: n must be a number, got " (type n))))
(if (= 0 (length rest)) (td-take n) (if (= 0 (length rest)) (td-take n)
(let [coll (in rest 0)] (let [coll (in rest 0)]
# Option A: lazy take (returns a seq, not a vector, even over a vector). # Option A: lazy take (returns a seq, not a vector, even over a vector).
@ -1342,22 +1326,7 @@
(sort-by keyfn arr)) (sort-by keyfn arr))
(tuple/slice (tuple ;arr)))))) (tuple/slice (tuple ;arr))))))
(defn core-distinct [coll] # distinct now lives in the Clojure lazy tier (core/40-lazy.clj).
# Option A: always lazy. seen-set is captured once and shared across the chain.
(let [seen @{}]
(defn dstep [c]
(fn []
(var cur c) (var found false) (var result nil)
(while (and (not found) (not (seq-done? cur)))
(let [x (core-first cur)]
(set cur (core-rest cur))
(when (nil? (seen x))
(put seen x true)
(set found true)
(set result x))))
(if found @[result (dstep cur)] nil)))
(make-lazy-seq (dstep (lazy-from coll)))))
# group-by / frequencies now live in the Clojure collection tier # group-by / frequencies now live in the Clojure collection tier
# (core/20-coll.clj). # (core/20-coll.clj).
@ -1384,72 +1353,13 @@
nil))))) nil)))))
(make-lazy-seq (pstep (lazy-from coll))))) (make-lazy-seq (pstep (lazy-from coll)))))
(defn core-partition-by [f coll] # partition-by now lives in the Clojure seq tier (core/10-seq.clj).
(def f (as-fn f))
(var result @[])
(var part @[])
(var last-k nil)
(each x (realize-for-iteration coll)
(let [k (f x)]
(if (and last-k (deep= k last-k))
(array/push part x)
(do
(if (> (length part) 0) (array/push result (tuple/slice (tuple ;part))))
(set part @[x])
(set last-k k)))))
(if (> (length part) 0) (array/push result (tuple/slice (tuple ;part))))
result)
(defn core-partition-all [n & rest] # partition-all now lives in the Clojure lazy tier (core/40-lazy.clj).
(if (= 0 (length rest)) (td-partition-all n)
(let [coll (in rest 0)]
# Option A: always lazy.
(defn pstep [c]
(fn []
(if (seq-done? c) nil
(do
(var part @[]) (var cur c) (var i 0)
(while (and (< i n) (not (seq-done? cur)))
(array/push part (core-first cur))
(set cur (core-rest cur))
(++ i))
@[(tuple/slice (tuple ;part)) (pstep cur)]))))
(make-lazy-seq (pstep (lazy-from coll))))))
(defn core-keep-indexed [f coll] # keep-indexed / map-indexed / cycle now live in the Clojure lazy tier
(def f (as-fn f)) # (core/40-lazy.clj).
# Option A: always lazy.
(defn kstep [c i]
(fn []
(var cur c) (var idx i) (var found false) (var result nil)
(while (and (not found) (not (seq-done? cur)))
(let [v (f idx (core-first cur))]
(++ idx)
(set cur (core-rest cur))
(when (not (nil? v))
(set found true)
(set result v))))
(if found @[result (kstep cur idx)] nil)))
(make-lazy-seq (kstep (lazy-from coll) 0)))
(defn core-map-indexed [f & rest]
(if (= 0 (length rest)) (td-map-indexed f)
(let [coll (in rest 0)]
# Option A: always lazy.
(defn mstep [c i]
(fn []
(if (seq-done? c) nil
@[(f i (core-first c)) (mstep (core-rest c) (+ i 1))])))
(make-lazy-seq (mstep (lazy-from coll) 0)))))
(defn core-cycle [coll]
(let [c (realize-for-iteration coll)]
(if (= 0 (length c))
(make-lazy-seq (fn [] nil))
(do
(defn cstep [i] (fn [] @[(in c (% i (length c))) (cstep (+ i 1))]))
(make-lazy-seq (cstep 0))))))
# reduce-kv now lives in the Clojure collection tier (core/20-coll.clj). # reduce-kv now lives in the Clojure collection tier (core/20-coll.clj).
@ -1495,30 +1405,9 @@
(+= i step)) (+= i step))
(tuple/slice (tuple ;result)))))) (tuple/slice (tuple ;result))))))
(defn core-repeat # repeat / iterate now live in the Clojure lazy tier (core/40-lazy.clj).
"(repeat x) -> infinite lazy seq of x; (repeat n x) -> n copies of x."
[a & rest]
(if (= 0 (length rest))
(do (defn rstep [] (fn [] @[a (rstep)])) (make-lazy-seq (rstep)))
(let [n a x (in rest 0)]
(var result @[]) (var i 0)
(while (< i n) (array/push result x) (++ i))
result)))
(defn core-iterate [f x] # repeatedly now lives in the Clojure lazy tier (core/40-lazy.clj).
"Lazy infinite sequence x, (f x), (f (f x)), ..."
(defn istep [v] (fn [] @[v (istep (f v))]))
(make-lazy-seq (istep x)))
(defn core-repeatedly
"(repeatedly f) -> infinite lazy seq of (f) calls; (repeatedly n f) -> n calls."
[a & rest]
(if (= 0 (length rest))
(do (defn rstep [] (fn [] @[(a) (rstep)])) (make-lazy-seq (rstep)))
(let [n a f (in rest 0)]
(var result @[]) (var i 0)
(while (< i n) (array/push result (f)) (++ i))
result)))
# ============================================================ # ============================================================
# Higher-order functions # Higher-order functions
@ -2408,26 +2297,7 @@
@[(core-first c) (istep (core-rest c) true)])))) @[(core-first c) (istep (core-rest c) true)]))))
(make-lazy-seq (istep (lazy-from coll) false))))) (make-lazy-seq (istep (lazy-from coll) false)))))
(defn core-keep # keep now lives in the Clojure lazy tier (core/40-lazy.clj).
"(keep f coll) — (f x) for each x, dropping nils. (keep f) is a transducer."
[f & rest]
(def f (as-fn f))
(if (= 0 (length rest))
(td-keep f)
(let [coll (in rest 0)]
# Option A: always lazy.
(defn kstep [c]
(fn []
(var cur c) (var found false) (var result nil)
(while (and (not found) (not (seq-done? cur)))
(let [v (f (core-first cur))]
(set cur (core-rest cur))
(when (not (nil? v))
(set found true)
(set result v))))
(if found @[result (kstep cur)] nil)))
(make-lazy-seq (kstep (lazy-from coll))))))
(defn core-empty [coll] (defn core-empty [coll]
(cond (cond
@ -2517,14 +2387,7 @@
# Iterator/enumeration seqs — Jolt has no Java iterators, so adapt to plain seq. # Iterator/enumeration seqs — Jolt has no Java iterators, so adapt to plain seq.
(defn core-enumeration-seq [x] (core-seq x)) (defn core-enumeration-seq [x] (core-seq x))
(defn core-iterator-seq [x] (core-seq x)) (defn core-iterator-seq [x] (core-seq x))
(defn core-xml-seq [root] # xml-seq now lives in the Clojure collection tier (core/20-coll.clj).
(def out @[])
(defn walk [n]
(array/push out n)
(when (and (core-map? n) (core-contains? n :content))
(each c (realize-for-iteration (core-get n :content)) (walk c))))
(walk root)
(tuple ;out))
(defn core-line-seq [rdr] (defn core-line-seq [rdr]
(if (string? rdr) (core-seq (string/split "\n" rdr)) nil)) (if (string? rdr) (core-seq (string/split "\n" rdr)) nil))
(defn core-re-matcher [re s] @{:jolt/type :jolt/matcher :re re :s s :pos 0}) (defn core-re-matcher [re s] @{:jolt/type :jolt/matcher :re re :s s :pos 0})
@ -2866,10 +2729,6 @@
"get-in" core-get-in "get-in" core-get-in
"contains?" core-contains? "contains?" core-contains?
"count" core-count "count" core-count
"partition-all" core-partition-all
"keep-indexed" core-keep-indexed
"map-indexed" core-map-indexed
"cycle" core-cycle
"pop" core-pop "pop" core-pop
"trampoline" core-trampoline "trampoline" core-trampoline
"format" core-format "format" core-format
@ -2952,7 +2811,6 @@
"random-uuid" core-random-uuid "random-uuid" core-random-uuid
"interpose" core-interpose "interpose" core-interpose
"mapcat" core-mapcat "mapcat" core-mapcat
"keep" core-keep
"find" core-find "find" core-find
"transduce" core-transduce "transduce" core-transduce
"sequence" core-sequence "sequence" core-sequence
@ -2990,13 +2848,8 @@
"nth" core-nth "nth" core-nth
"sort" core-sort "sort" core-sort
"sort-by" core-sort-by "sort-by" core-sort-by
"distinct" core-distinct
"partition" core-partition "partition" core-partition
"partition-by" core-partition-by
"range" core-range "range" core-range
"repeat" core-repeat
"iterate" core-iterate
"repeatedly" core-repeatedly
"identity" core-identity "identity" core-identity
"constantly" core-constantly "constantly" core-constantly
"complement" core-complement "complement" core-complement
@ -3103,7 +2956,6 @@
"test" core-test "test" core-test
"enumeration-seq" core-enumeration-seq "enumeration-seq" core-enumeration-seq
"iterator-seq" core-iterator-seq "iterator-seq" core-iterator-seq
"xml-seq" core-xml-seq
"line-seq" core-line-seq "line-seq" core-line-seq
"re-matcher" core-re-matcher "re-matcher" core-re-matcher
"bean" core-bean "bean" core-bean

View file

@ -26,7 +26,6 @@
(= name "var-get") (= name "var-set") (= name "var?") (= name "var-get") (= name "var-set") (= name "var?")
(= name "alter-var-root") (= name "find-var") (= name "intern") (= name "alter-var-root") (= name "find-var") (= name "intern")
(= name "alter-meta!") (= name "reset-meta!") (= name "alter-meta!") (= name "reset-meta!")
(= name "disj") (= name "set?")
(= name "satisfies?") (= name "satisfies?")
(= name "protocol-dispatch") (= name "register-method") (= name "make-reified") (= name "protocol-dispatch") (= name "register-method") (= name "make-reified")
(= name "prefer-method") (= name "remove-method") (= name "remove-all-methods") (= name "prefer-method") (= name "remove-method") (= name "remove-all-methods")
@ -116,7 +115,9 @@
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f))) (if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f)))
(in f k) (in f k)
(error (string "Index " k " out of bounds for vector of length " (length f))))) (error (string "Index " k " out of bounds for vector of length " (length f)))))
(struct? f) # Map literal only (struct with no :jolt/type). A tagged struct (char/etc.)
# is not callable — symbols are handled above; chars fall through to the error.
(and (struct? f) (nil? (get f :jolt/type)))
(let [v (get f (get args 0) :jolt/not-found)] (let [v (get f (get args 0) :jolt/not-found)]
(if (= v :jolt/not-found) (get args 1) v)) (if (= v :jolt/not-found) (get args 1) v))
(and (table? f) (get f :jolt/deftype)) (and (table? f) (get f :jolt/deftype))
@ -1140,12 +1141,8 @@
val (eval-form ctx bindings (in form 3)) val (eval-form ctx bindings (in form 3))
ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))] ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))]
(ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val)) (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val))
"disj" (let [s (eval-form ctx bindings (in form 1)) # set?/disj are plain clojure.core fns now (core-set?/core-disj) — no longer
ks (map |(eval-form ctx bindings $) (tuple/slice form 2))] # special-cased here, the analyzer, or compiler.janet (jolt-g3h).
(if (set? s)
(apply phs-disj s ks)
(error "disj expects a set")))
"set?" (set? (eval-form ctx bindings (in form 1)))
"protocol-dispatch" (let [proto-sym (in form 1) "protocol-dispatch" (let [proto-sym (in form 1)
method-sym (in form 2) method-sym (in form 2)
obj (eval-form ctx bindings (in form 3)) obj (eval-form ctx bindings (in form 3))

View file

@ -74,7 +74,7 @@
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "var" "defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "var"
"locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new" "locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new"
"." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern" "." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern"
"alter-meta!" "reset-meta!" "disj" "set?" "satisfies?" "alter-meta!" "reset-meta!" "satisfies?"
"protocol-dispatch" "register-method" "make-reified" "prefer-method" "protocol-dispatch" "register-method" "make-reified" "prefer-method"
"remove-method" "remove-all-methods" "get-method" "methods" "remove-method" "remove-all-methods" "get-method" "methods"
# ns-management forms dispatched by the interpreter (not core vars) # ns-management forms dispatched by the interpreter (not core vars)

View file

@ -38,9 +38,14 @@
# lazy-from throws on non-seqable like Clojure) recovered + extended the suite. # lazy-from throws on non-seqable like Clojure) recovered + extended the suite.
# clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across # clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across
# many cross-dialect files). Stable across runs. # many cross-dialect files). Stable across runs.
(def baseline-pass 3981) # Raised 3981 -> 4004 migrating 7 lazy seq fns to the Clojure overlay (40-lazy
# tier): the canonical CLJ versions add coverage (e.g. distinct value-equality).
# Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the
# overlay, which required fixing two leniencies (a char is not callable; take
# validates its count) — correct beyond those fns, so the suite rose broadly.
(def baseline-pass 4034)
# A file is "clean" when it ran with zero failures AND zero errors. # A file is "clean" when it ran with zero failures AND zero errors.
(def baseline-clean-files 66) (def baseline-clean-files 67)
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so # Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
# this normally only fires on genuinely-infinite-sequence hangs. It's an env var # this normally only fires on genuinely-infinite-sequence hangs. It's an env var
# (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can # (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can

View file

@ -50,6 +50,18 @@
["map as fn default" "99" "({:a 1} :z 99)"] ["map as fn default" "99" "({:a 1} :z 99)"]
["set as fn" "2" "(#{1 2 3} 2)"] ["set as fn" "2" "(#{1 2 3} 2)"]
["set as fn miss" "nil" "(#{1 2 3} 9)"] ["set as fn miss" "nil" "(#{1 2 3} 9)"]
# set literals compile (Stage 1 Task 1): computed elements are each evaluated
# then the persistent set is built, matching the interpreter.
["set literal computed" "true" "(= #{1 2} #{(inc 0) 2})"]
["empty set literal" "true" "(empty? #{})"]
["set literal count" "3" "(count #{1 2 3})"]
["set literal in let" "true" "(let [x 5] (= #{5 6} #{x (inc x)}))"]
# set?/disj compile as plain fns now (jolt-g3h), not special forms
["set? true" "true" "(set? #{1 2 3})"]
["set? false" "false" "(set? [1 2])"]
["disj one" "#{1 3}" "(disj #{1 2 3} 2)"]
["disj many" "#{1}" "(disj #{1 2 3} 2 3)"]
["disj absent" "#{1 2}" "(disj #{1 2} 5)"]
["keyword as fn" "1" "(:a {:a 1})"] ["keyword as fn" "1" "(:a {:a 1})"]
["map fn over coll" "(quote (1 3))" "(map {:a 1 :b 3} [:a :b])"] ["map fn over coll" "(quote (1 3))" "(map {:a 1 :b 3} [:a :b])"]

View file

@ -0,0 +1,66 @@
# Fallback-zero verification (Stage 1 Task 3).
#
# self-host-test.janet checks observable RESULTS but not WHICH path ran — a form
# that silently fell back to the interpreter still "passes" there. This harness
# checks the path: it runs the portable analyzer (jolt.analyzer/analyze, via
# backend/analyze-form) on a corpus of NON-STATEFUL forms and asserts NONE raise
# :jolt/uncompilable — i.e. the self-hosted analyzer actually COMPILED them.
#
# As analyzer↔compiler.janet parity grows (Stage 1), move forms from the
# "intentional fallback" sanity list into the must-compile corpus. The day the
# fallback set equals the frozen intentional stateful set, the Janet bootstrap
# compiler is retireable.
#
# Mechanism: backend/analyze-form throws (a "jolt/uncompilable: …" string) for a
# punted form; (protect …) turns that into [false msg]. [true ir] == compiled.
(import ../../src/jolt/backend :as backend)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(def ctx (init))
(defn- analyzes? [s]
# true if the analyzer produced IR (compiled), false if it punted/uncompilable.
(def r (protect (backend/analyze-form ctx (parse-string s))))
(and (r 0) true))
# --- Must compile: pure, non-stateful value production. NONE may punt. ---
(def must-compile
[# set literals (Task 1)
"#{1 2 3}" "#{}" "#{:a :b :c}" "#{(inc 0) 2}" "(conj #{1 2} 3)"
"[#{1 2} {:s #{3}}]" "(let [x 5] #{x (inc x)})"
# other literals
"[1 2 3]" "{:a 1 :b 2}" "{:k (inc 0)}" "[[1] [2 3]]" "42" ":kw" "\"str\""
# control flow + binding
"(+ 1 2)" "(if true 1 2)" "(do 1 2 3)" "(let [a 1 b 2] (+ a b))"
"(fn [x] (* x x))" "(fn ([a] a) ([a b] (+ a b)))"
"(loop [i 0] (if (< i 3) (recur (inc i)) i))"
"(quote (a b c))" "(throw (ex-info \"x\" {}))"
"(try (inc 1) (catch :default e e))"
# def + calls into core
"(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])"
"(get {:a 1} :a)" "(vec (range 5))"
# set?/disj are plain fns now, not special forms (jolt-g3h)
"(set? #{1 2})" "(disj #{1 2 3} 2)"])
# --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter.
# Not the frozen set (that's Task 2) — just a few to confirm the boundary holds
# in the punt direction so the harness can't pass by compiling everything.
(def must-punt
["(ns foo.bar)" "(defmacro m [x] x)" "(require (quote [clojure.string]))"
"(set! *warn-on-reflection* true)" "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"])
(var fails @[])
(each s must-compile
(unless (analyzes? s) (array/push fails (string "FALLBACK (should compile): " s))))
(each s must-punt
(when (analyzes? s) (array/push fails (string "COMPILED (should punt): " s))))
(printf "fallback-zero: %d must-compile + %d must-punt — %d failures"
(length must-compile) (length must-punt) (length fails))
(when (> (length fails) 0)
(print "\nFailures:")
(each f fails (printf " %s" f))
(os/exit 1))
(print "fallback-zero: OK (analyzer compiled the full non-stateful corpus)")