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

Chez Phase 2 (inc U): list? + map-entry-as-vector + clojure.walk (jolt-75sv)

Browse source 
list? was nil on Chez because one cseq record backs both lists and lazy/
realized seqs. Add a list? marker field (cseq v2) set only on the HEAD cell
of a list -- (list ...), quoted list literals, cons, reverse, conj onto a
list. rest/next/seq/map therefore yield unmarked seq cells, so they are
seqs and not list?, matching the seed (where rest-of-a-list is a non-list
seq). Empty () is treated as a list.

vector?: drop the map-entry exclusion. Clojure's MapEntry implements
IPersistentVector and the seed agrees -- (vector? (first {:a 1})) is true.
Only dot-forms' coll dispatch read jolt-vector?, where a 2-vector entry is
correct.

clojure.walk + clojure.template join the prelude stdlib tier. The driver
now evals each stdlib ns's requires -- and the ns form's (:require ...)
clause -- so an aliased ref (template's walk/postwalk-replace) resolves at
emit time instead of lowering to an Unknown class host-static. ns forms are
evaled for that side effect but not emitted, so the runtime *ns* doesn't
leak to the last stdlib ns.

Parity 2163 -> 2176, 0 new divergences. New test/chez/_walk.janet 39/39.
This commit is contained in:
Yogthos 2026-06-19 09:30:18 -04:00
parent 3319684a38
commit 77026fa9ec
7 changed files with 162 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

8
host/chez/collections.ss
View file

@ -203,9 +203,11 @@
(define (jolt-conj1 coll x)
(cond ((pvec? coll) (pvec-conj coll x)) ; nil is a valid vector/set element
((pset? coll) (pset-conj coll x))
;; a list/seq conjs by PREPENDING (seq.ss: cseq / empty-list)
((cseq? coll) (cseq-realized x coll))
((empty-list-t? coll) (cseq-realized x jolt-nil))
;; a list/seq conjs by PREPENDING (seq.ss: cseq / empty-list). conj onto a
;; list stays a list, conj onto a lazy/realized seq yields a seq cell (a
;; Cons) — list?-preserving, matching the seed.
((cseq? coll) (if (cseq-list? coll) (cseq-list x coll) (cseq-realized x coll)))
((empty-list-t? coll) (cseq-list x jolt-nil))
((pmap? coll)
(cond ((jolt-nil? x) coll) ; (conj m nil) = m
((pmap? x) (pmap-fold x (lambda (k v m) (pmap-assoc m k v)) coll)) ; merge

48
host/chez/driver.janet
View file

@ -107,7 +107,11 @@
# same analyze->emit pipeline lowers it; an aliased ref resolves via var-deref at
# runtime once the alias is registered (the driver pre-evals requires). jolt-nfca.
(def stdlib-ns-files
[["clojure.string" "src/jolt/clojure/string.clj"]])
[["clojure.string" "src/jolt/clojure/string.clj"]
["clojure.walk" "src/jolt/clojure/walk.clj"]
# clojure.template requires clojure.walk (apply-template over postwalk-replace)
# — must follow it so the alias resolves at emit time.
["clojure.template" "src/jolt/clojure/template.clj"]])
(defn- sym-name [x]
(when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name)))
@ -121,6 +125,21 @@
(let [h (or (sym-name (in f 0)) "?") n (sym-name (in f 1))] (if n (string h " " n) h))
"?"))
(defn- require-head? [f]
(and (indexed? f) (> (length f) 0)
(let [h (sym-name (in f 0))] (and h (or (= h "require") (= h "use"))))))
(defn- scan-eval-requires! [ctx form]
"Recursively eval any (require ...)/(use ...) sub-form against the ctx so the
alias registers + the aliased ns loads BEFORE the AOT analyzer resolves its
qualified refs — the whole user form is analyzed up front, before any require
would run at eval time (jolt-nfca). Failures are swallowed (the ref then stays
an emit-err, the prior behavior)."
(when (indexed? form)
(if (require-head? form)
(protect (api/eval-one ctx form))
(each sub form (scan-eval-requires! ctx sub)))))
(defn emit-core-prelude
"Assemble the clojure.core prelude as a Scheme string. `ctx` must be a
compile-mode ctx; its current ns is set to clojure.core for the duration.
@ -138,7 +157,17 @@
(tctx/create-ns ctx ns-name)
(tctx/ctx-set-current-ns ctx ns-name)
(each f (parse-all src)
(unless (macro-form? f)
# Register any aliases this ns depends on before analyzing its forms, so an
# aliased ref (e.g. clojure.template's walk/postwalk-replace) resolves at emit
# time instead of lowering to an "Unknown class walk" host-static. The ns
# form's :require is a keyword-headed clause that scan-eval-requires! (matching
# the `require`/`use` symbol heads) doesn't catch, so eval the ns form whole.
(def ns-form? (and (indexed? f) (> (length f) 0) (= "ns" (sym-name (in f 0)))))
(if ns-form? (protect (api/eval-one ctx f)) (scan-eval-requires! ctx f))
# Skip emitting ns forms: their only role here is alias registration, and a
# runtime ns-switch would leak into the prelude's trailing *ns* (the def-var!s
# already carry explicit ns names). Macros have no runtime value either.
(unless (or ns-form? (macro-form? f))
(++ total)
(def res (protect (emit/emit (backend/analyze-form ctx f))))
(when (res 0)
@ -179,21 +208,6 @@
"(set-chez-ns! \"user\")\n"
"(printf \"~a\\n\" (jolt-final-str " final-scm "))\n"))
(defn- require-head? [f]
(and (indexed? f) (> (length f) 0)
(let [h (sym-name (in f 0))] (and h (or (= h "require") (= h "use"))))))
(defn- scan-eval-requires! [ctx form]
"Recursively eval any (require ...)/(use ...) sub-form against the ctx so the
alias registers + the aliased ns loads BEFORE the AOT analyzer resolves its
qualified refs — the whole user form is analyzed up front, before any require
would run at eval time (jolt-nfca). Failures are swallowed (the ref then stays
an emit-err, the prior behavior)."
(when (indexed? form)
(if (require-head? form)
(protect (api/eval-one ctx form))
(each sub form (scan-eval-requires! ctx sub)))))
(defn eval-e-with-prelude
"Run a single user expression `src` on Chez with the full clojure.core prelude
(loaded from `prelude-path`). Emits `src` in prelude mode so any core ref

3
host/chez/jolt-chez.janet
View file

@ -24,7 +24,8 @@
"host/chez/natives-str.ss" "host/chez/records.ss"
"host/chez/host-class.ss"
"host/chez/host-static.ss" "host/chez/dot-forms.ss"
"src/jolt/clojure/string.clj"]
"src/jolt/clojure/string.clj" "src/jolt/clojure/walk.clj"
"src/jolt/clojure/template.clj"]
(array/push parts (slurp f)))
(string/slice (string (hash (string/join parts))) 0))

11
host/chez/predicates.ss
View file

@ -8,11 +8,15 @@
;; seed predicates are simply absent here for now.
(define (jolt-map? x) (pmap? x))
;; a map entry is a pvec under the hood but is NOT vector? (matches Clojure's
;; MapEntry — jolt-agw6); the public vector? predicate excludes it.
(define (jolt-vector? x) (and (pvec? x) (not (pvec-ent x))))
;; a map entry is a pvec under the hood AND is vector? — Clojure's MapEntry
;; implements IPersistentVector, so (vector? (first {:a 1})) is true (the seed
;; agrees; jolt-75sv corrected the earlier exclusion).
(define (jolt-vector? x) (pvec? x))
(define (jolt-set? x) (pset? x))
(define (jolt-seq? x) (or (cseq? x) (empty-list-t? x)))
;; (list? x): a list-marked cseq node or the empty list (). A lazy/vector-backed
;; seq, (rest list), (seq coll), (map …) are seqs but not lists (jolt-75sv).
(define (jolt-list-pred? x) (or (and (cseq? x) (cseq-list? x)) (empty-list-t? x)))
(define (jolt-coll-pred? x)
(or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x)))
(define (jolt-number? x) (number? x))
@ -52,6 +56,7 @@
(def-var! "clojure.core" "vector?" jolt-vector?)
(def-var! "clojure.core" "set?" jolt-set?)
(def-var! "clojure.core" "seq?" jolt-seq?)
(def-var! "clojure.core" "list?" jolt-list-pred?)
(def-var! "clojure.core" "coll?" jolt-coll-pred?)
(def-var! "clojure.core" "fn?" jolt-fn?)
(def-var! "clojure.core" "boolean?" jolt-boolean-pred?)

38
host/chez/seq.ss
View file

@ -18,9 +18,16 @@
;; head : the realized first element. tail : EITHER a realized seq (cseq |
;; jolt-nil) when forced? is #t, OR a 0-arg thunk producing one when forced? is
;; #f. Forcing memoizes (set the tail to the produced seq, flip forced?).
(define-record-type cseq (fields head (mutable tail) (mutable forced?)) (nongenerative chez-cseq-v1))
(define (cseq-realized head tail) (make-cseq head tail #t)) ; tail already a seq
(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f))
;; list? : #t when this cell is a PersistentList node (list literal / (list ...)
;; / cons / reverse / conj-onto-list) vs a lazy or vector-backed seq cell — the
;; only thing that distinguishes a list from any other realized seq on this host,
;; since one record type backs both (clojure.core/list? — jolt-75sv). The marker
;; lives on the cell, so (rest a-list) / (seq a-vector) / (map …) yield plain seq
;; cells and are not list?, matching the seed.
(define-record-type cseq (fields head (mutable tail) (mutable forced?) list?) (nongenerative chez-cseq-v2))
(define (cseq-realized head tail) (make-cseq head tail #t #f)) ; tail already a seq
(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f #f))
(define (cseq-list head tail) (make-cseq head tail #t #t)) ; a PersistentList node
(define (seq-first s) (cseq-head s))
(define (seq-more s) ; force the tail; returns a seq (cseq | jolt-nil)
(if (cseq-forced? s) (cseq-tail s)
@ -72,11 +79,26 @@
(let ((m (seq-more s))) (if (jolt-nil? m) jolt-empty-list m)))))
(define (jolt-next x) ; nil when the rest is empty
(let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (seq-more s))))
(define (jolt-cons x coll) (cseq-realized x (jolt-seq coll)))
(define (jolt-list . xs) (if (null? xs) jolt-empty-list (list->cseq xs)))
(define (jolt-reverse coll) (let loop ((s (jolt-seq coll)) (acc jolt-empty-list))
(if (jolt-nil? s) acc
(loop (jolt-seq (seq-more s)) (cseq-realized (seq-first s) (if (empty-list-t? acc) jolt-nil acc))))))
;; Only the HEAD cell carries the list marker — (rest a-list)/(next a-list) return
;; the unmarked tail, so they are seqs and not list?, matching the seed (which
;; makes rest-of-a-list a non-list seq). cons/list/reverse/conj therefore mark
;; just the cell they create.
;;
;; cons always yields a list — (list? (cons x anything)) is true on the seed (cons
;; onto a vector/seq/nil all report list?).
(define (jolt-cons x coll) (cseq-list x (jolt-seq coll)))
;; Scheme list -> a jolt PersistentList: head is a list cell, the tail chain is
;; plain seq cells. For (list …) and quoted list literals (the emitter lowers
;; '(a b) to (jolt-list a b)).
(define (jolt-list . xs)
(if (null? xs) jolt-empty-list (cseq-list (car xs) (list->cseq (cdr xs)))))
;; reverse yields a list (seed: (list? (reverse coll)) is always true). Build a
;; plain seq chain, then mark its head as a list cell.
(define (jolt-reverse coll)
(let loop ((s (jolt-seq coll)) (acc jolt-empty-list))
(if (jolt-nil? s)
(if (empty-list-t? acc) acc (cseq-list (seq-first acc) (seq-more acc)))
(loop (jolt-seq (seq-more s)) (cseq-realized (seq-first s) (if (empty-list-t? acc) jolt-nil acc))))))
(define (jolt-last coll) (let loop ((s (jolt-seq coll)) (last jolt-nil))
(if (jolt-nil? s) last (loop (jolt-seq (seq-more s)) (seq-first s)))))
;; nth over a seq (walks; forces lazily). default? selects the 3-arg behavior.

80
test/chez/_walk.janet Normal file
View file

@ -0,0 +1,80 @@
# jolt-75sv — list? (a list marker on cseq, since cseq backs both lists and
# realized/lazy seqs) + map-entry-as-vector + clojure.walk. Oracle = build/jolt.
#
# janet test/chez/_walk.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
# -e reads only the FIRST form — wrap require + use in a single (do ...).
(defn w [body] (string "(do (require (quote [clojure.walk :as w])) " body ")"))
(def cases
[# --- list? : true for lists, cons/reverse/conj-on-list; false for seqs ---
["(list? (list 1 2))" "true"]
["(list? (list 1))" "true"]
["(list? '(1 2))" "true"]
["(list? '())" "true"]
["(list? (list))" "true"]
["(list? (cons 1 nil))" "true"]
["(list? (cons 1 [2]))" "true"]
["(list? (cons 1 '(2)))" "true"]
["(list? (conj (list 1) 0))" "true"]
["(list? (conj '() 1))" "true"]
["(list? (reverse [1 2]))" "true"]
["(list? (reverse '(1 2)))" "true"]
["(list? [1 2])" "false"]
["(list? {:a 1})" "false"]
["(list? (map inc [1 2]))" "false"]
["(list? (filter odd? [1 2 3]))" "false"]
["(list? (seq [1 2]))" "false"]
["(list? (rest (list 1 2)))" "false"]
["(list? (next (list 1 2)))" "false"]
["(list? (take 2 (list 1 2 3)))" "false"]
["(list? (concat '(1) '(2)))" "false"]
["(list? (rest [1 2]))" "false"]
["(list? 5)" "false"]
["(list? nil)" "false"]
# --- map-entry IS a vector (Clojure MapEntry; seed agrees) ---
["(vector? (first {:a 1}))" "true"]
["(vector? (first (seq {:a 1})))" "true"]
["(map-entry? (first {:a 1}))" "true"]
["(= (first {:a 1}) [:a 1])" "true"]
["(vector? [1 2])" "true"]
["(vector? (rest [1 2 3]))" "false"]
# --- clojure.walk ---
[(w "(w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1})") "{:a 2}"]
[(w "(w/keywordize-keys {\"a\" 1})") "{:a 1}"]
[(w "(= {\"a\" 1} (w/stringify-keys {:a 1}))") "true"]
[(w "(w/postwalk-replace {'x 2} '(+ x x))") "(+ 2 2)"]
[(w "(w/postwalk (fn [n] (if (symbol? n) :a n)) '(x y))") "(:a :a)"]
[(w "(w/prewalk-replace {'* '* 'y 3} '(* y y))") "(* 3 3)"]
[(w "(w/postwalk-replace {:a 1 :b 2} '(:a [:b :a]))") "(1 [2 1])"]
[(w "(w/postwalk-replace {1 :one} [1 2 1])") "[:one 2 :one]"]
["(do (require (quote [clojure.template :as t])) (t/apply-template '[x y] '(+ x y) '(1 2)))" "(+ 1 2)"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [ocode oracle _] (run-capture "build/jolt" expr))
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)])
(not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")])
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_walk parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

7
test/chez/run-corpus-prelude.janet
View file

@ -248,8 +248,13 @@
# strings + (class x) scalar arms, host-class.ss; the analyzer already resolves
# these names to clojure.core vars so it's a runtime def-var! only, no analyzer
# change) 2163.
# jolt-75sv (list? via a list marker on the cseq record — only list/quote/cons/
# reverse/conj-on-list mark the head cell, so rest/seq/map stay non-list seqs;
# map-entry is now vector? matching Clojure's MapEntry; clojure.walk + clojure.
# template added to the prelude stdlib tier, the driver evals each ns's requires
# to register aliases at emit time) 2176.
# Strided runs scale down.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2163")))
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2176")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))