From 77026fa9ecf38467cf70de5f20ae8f9ef91e311d Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 19 Jun 2026 09:30:18 -0400 Subject: [PATCH] Chez Phase 2 (inc U): list? + map-entry-as-vector + clojure.walk (jolt-75sv) 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. --- host/chez/collections.ss | 8 +-- host/chez/driver.janet | 48 +++++++++++------- host/chez/jolt-chez.janet | 3 +- host/chez/predicates.ss | 11 ++-- host/chez/seq.ss | 38 +++++++++++--- test/chez/_walk.janet | 80 ++++++++++++++++++++++++++++++ test/chez/run-corpus-prelude.janet | 7 ++- 7 files changed, 162 insertions(+), 33 deletions(-) create mode 100644 test/chez/_walk.janet diff --git a/host/chez/collections.ss b/host/chez/collections.ss index 44014c6..8da85ad 100644 --- a/host/chez/collections.ss +++ b/host/chez/collections.ss @@ -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 diff --git a/host/chez/driver.janet b/host/chez/driver.janet index f6c23c4..56c2347 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -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 diff --git a/host/chez/jolt-chez.janet b/host/chez/jolt-chez.janet index 9be9f1b..bbc24e3 100644 --- a/host/chez/jolt-chez.janet +++ b/host/chez/jolt-chez.janet @@ -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)) diff --git a/host/chez/predicates.ss b/host/chez/predicates.ss index 31e40b6..3e3699d 100644 --- a/host/chez/predicates.ss +++ b/host/chez/predicates.ss @@ -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?) diff --git a/host/chez/seq.ss b/host/chez/seq.ss index 1122604..e5e7533 100644 --- a/host/chez/seq.ss +++ b/host/chez/seq.ss @@ -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. diff --git a/test/chez/_walk.janet b/test/chez/_walk.janet new file mode 100644 index 0000000..c50eb6a --- /dev/null +++ b/test/chez/_walk.janet @@ -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)) diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index d67d1d8..7c39dba 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -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)))