From 0f7d2753a892ebdc78fbd3decbb7df4443d5baa5 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 17 Jun 2026 18:27:34 -0400 Subject: [PATCH] Chez Phase 1 (increment 3g): letfn + declare/def-no-init MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Closes the last two non-host-interop prelude emit gaps. letfn now analyzes to a :let node flagged :letrec — the binding fns are bound into the env together before any spec is analyzed, so siblings and self resolve. The Chez back end lowers it to letrec*; the Janet back end punts it at emit (its sequential let* can't express the mutual recursion — same interpreter fallback as before, just decided at emit-ir instead of analyze). (def x) with no init (declare) analyzes to a :def with :no-init instead of punting. Chez reserves the var cell via declare-var! (which doesn't clobber an existing root — (do (def x 7) (def x) x) => 7); the Janet back end still punts to the interpreter, which interns a genuinely-unbound var. fallback-zero-test now checks emit-ir too, not just analyze-form, so the real compile-vs-interpret decision is what it asserts (letfn/def-no-init analyze but the Janet back end punts them). letfn stays in must-punt with an updated note. Prelude emit reach 342 -> 348/355 (40-lazy now 13/13); Chez subset 664 -> 672, 0 divergences; emit-test 110 -> 117. Full gate green. --- host/chez/emit.janet | 15 ++++-- host/chez/rt.ss | 11 +++++ jolt-core/jolt/analyzer.clj | 57 +++++++++++++++++------ src/jolt/backend.janet | 14 +++++- test/chez/README.md | 13 +++--- test/chez/core-prelude-probe.janet | 2 +- test/chez/emit-test.janet | 22 +++++++++ test/integration/fallback-zero-test.janet | 16 +++++-- 8 files changed, 119 insertions(+), 31 deletions(-) diff --git a/host/chez/emit.janet b/host/chez/emit.janet index 1d71517..f0e37ea 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -171,8 +171,12 @@ (def b (vv b)) (string "(" (munge (get b 0)) " " (emit (get b 1)) ")")) +# letfn lowers to a :let flagged :letrec (mutually-recursive named local fns): +# Scheme `letrec*` binds them so each sees its siblings (and itself), which a +# sequential let* can't. A plain let uses let* (Clojure let binds sequentially). (defn- emit-let [node] - (string "(let* (" (string/join (map emit-binding (vv (get node :bindings))) " ") ") " + (def kw (if (get node :letrec) "letrec*" "let*")) + (string "(" kw " (" (string/join (map emit-binding (vv (get node :bindings))) " ") ") " (emit (get node :body)) ")")) (defn- emit-loop [node] @@ -362,8 +366,13 @@ :try (emit-try node) :quote (emit-quoted (get node :form)) :fn (emit-fn node) - :def (string "(def-var! " (string/format "%j" (get node :ns)) " " - (string/format "%j" (get node :name)) " " (emit (get node :init)) ")") + # (def name) with no init (declare): reserve the var cell (declare-var! + # doesn't clobber an existing root) so a forward reference resolves. + :def (if (get node :no-init) + (string "(declare-var! " (string/format "%j" (get node :ns)) " " + (string/format "%j" (get node :name)) ")") + (string "(def-var! " (string/format "%j" (get node :ns)) " " + (string/format "%j" (get node :name)) " " (emit (get node :init)) ")")) (errorf "emit: unhandled op %p" (get node :op))))) # Wrap emitted top-level forms into a runnable Chez program: load the RT, then diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 086a53e..a54f889 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -43,6 +43,10 @@ ;; A var is a mutable cell keyed by "ns/name". A `:def` sets the root; a `:var` ;; reference reads it at use time (late binding), so a forward/mutually-recursive ;; reference resolves to whatever the cell holds when the call actually runs. +;; declare / (def name) with no init reserves a cell holding this placeholder +;; until the real def overwrites it (a forward reference resolves to the cell, and +;; correct code never reads it before the binding def runs). +(define jolt-unbound (string->symbol "#")) (define-record-type var-cell (fields ns name (mutable root)) (nongenerative var-cell-v1)) (define var-table (make-hashtable string-hash string=?)) (define (jolt-var ns name) @@ -53,6 +57,13 @@ c)))) (define (var-deref ns name) (var-cell-root (jolt-var ns name))) (define (def-var! ns name v) (var-cell-root-set! (jolt-var ns name) v) v) +;; declare / (def name) with no init: reserve the cell ONLY if absent. An +;; existing root is left intact — Clojure's (def x) with no init does not clobber +;; a prior binding (do (def x 7) (def x) x) => 7. +(define (declare-var! ns name) + (let ((k (string-append ns "/" name))) + (unless (hashtable-ref var-table k #f) + (hashtable-set! var-table k (make-var-cell ns name jolt-unbound))))) ;; --- jolt number printing ---------------------------------------------------- ;; jolt models every number as a Clojure double: integer-valued values print diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 430bd39..37d87c1 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -29,7 +29,7 @@ (def ^:private handled #{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try" - "syntax-quote" "var"}) + "syntax-quote" "var" "letfn"}) (defn- uncompilable [why] (throw (str "jolt/uncompilable: " why))) @@ -190,6 +190,27 @@ n)] n))) +;; letfn: (letfn [(name [params] body*)...] body*). The named local fns are +;; MUTUALLY recursive, so bind every name into the env BEFORE analyzing any spec +;; — each spec then resolves its siblings (and itself) as locals. Emitted as a +;; :let flagged :letrec so the back ends know the bindings forward-reference each +;; other: Chez lowers it to `letrec*`; the Janet back end punts to the +;; interpreter (its shared mutable env already gives the letrec semantics that a +;; compiled sequential let* lacks — the reason letfn was uncompilable before). +(defn- analyze-letfn [ctx items env] + (let [specs (vec (form-vec-items (nth items 1))) + names (mapv #(form-sym-name (first (vec (form-elements %)))) specs) + env* (add-locals env names) + binds (mapv (fn [spec] + (let [cl (vec (form-elements spec))] + ;; analyze as a named fn (items[1] = the name): self- and + ;; sibling-calls resolve, the fn carries its own name. + [(form-sym-name (first cl)) + (analyze-fn ctx (vec (cons (first cl) cl)) env*)])) + specs)] + {:op :let :letrec true :bindings binds + :body (analyze-seq ctx (drop 2 items) env*)})) + (defn- analyze-special [ctx op items env] (case op "quote" (quote-node (second items)) @@ -210,20 +231,25 @@ ;; the whole def (it unwraps the name and merges the meta). (when-not (form-sym? name-sym) (uncompilable "def name with map metadata")) - ;; (def name) with no init (declare) just interns — interpreter's job - (when (< (count items) 3) - (uncompilable "def with no init")) - (let [nm (form-sym-name name-sym) - cur (compile-ns ctx) - ;; (def name docstring value): docstring is form 2, value form 3. - ;; Matches the interpreter; without this the docstring was taken - ;; as the value and the real init dropped (jolt-6ym). - has-doc (and (> (count items) 3) (string? (nth items 2))) - val-form (nth items (if has-doc 3 2)) - base-meta (or (form-sym-meta name-sym) {}) - node-meta (if has-doc (assoc base-meta :doc (nth items 2)) base-meta)] - (host-intern! ctx cur nm) - (def-node cur nm (analyze ctx val-form env) node-meta))) + (if (< (count items) 3) + ;; (def name) with no init (declare): intern + reserve the cell so a + ;; forward reference resolves. The back ends key on :no-init — Chez + ;; def-var!s an unbound placeholder; the Janet back end punts to the + ;; interpreter, which interns a genuinely-unbound var. + (let [nm (form-sym-name name-sym) cur (compile-ns ctx)] + (host-intern! ctx cur nm) + {:op :def :ns cur :name nm :no-init true}) + (let [nm (form-sym-name name-sym) + cur (compile-ns ctx) + ;; (def name docstring value): docstring is form 2, value form 3. + ;; Matches the interpreter; without this the docstring was taken + ;; as the value and the real init dropped (jolt-6ym). + has-doc (and (> (count items) 3) (string? (nth items 2))) + val-form (nth items (if has-doc 3 2)) + base-meta (or (form-sym-meta name-sym) {}) + node-meta (if has-doc (assoc base-meta :doc (nth items 2)) base-meta)] + (host-intern! ctx cur nm) + (def-node cur nm (analyze ctx val-form env) node-meta)))) "let*" (let [bvec (vec (form-vec-items (nth items 1))) r (analyze-bindings ctx bvec env)] (let-node (first r) (analyze-seq ctx (drop 2 items) (second r)))) @@ -238,6 +264,7 @@ {:op :recur :recur-name rt :args (mapv #(analyze ctx % env) (rest items))}) "try" (analyze-try ctx items env) + "letfn" (analyze-letfn ctx items env) "fn*" (analyze-fn ctx items env) ;; Lower the backtick to construction code (zero runtime cost), then analyze ;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile. diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index 5ed8c52..cf97407 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -179,6 +179,11 @@ (tuple/slice out)) (defn- emit-let [ctx node] + # letfn lowers to a :let flagged :letrec (mutually-recursive bindings). A + # compiled sequential Janet let can't forward-ref a sibling, so punt to the + # interpreter (the deliberate uncompilable channel) — its shared mutable env + # gives the letrec semantics. The Chez back end compiles it directly (letrec*). + (when (node :letrec) (error "jolt/uncompilable: letfn")) (def binds @[]) (each pair (vview (node :bindings)) (def p (vview pair)) @@ -740,7 +745,12 @@ :recur (emit-recur ctx node) :try (emit-try ctx node) :throw ['error (emit ctx (node :expr))] - :def (let [cell (cell-for ctx (node :ns) (node :name)) + :def (do + # (def name) with no init (declare): no compiled value to install — + # punt to the interpreter, which interns a genuinely-unbound var + # (compiling it to nil would diverge: reading an unbound var throws). + (when (node :no-init) (error "jolt/uncompilable: def with no init")) + (let [cell (cell-for ctx (node :ns) (node :name)) meta (node :meta) setter (if (and meta (not (empty? meta))) (var-setter-meta cell meta) (var-setter cell)) _ (cgen-collect! ctx node) @@ -759,7 +769,7 @@ # redefined (jolt-wf4). (let [init-form (emit ctx (node :init))] (when-let [ud (get (ctx :env) :unit-defs)] (put ud cell true)) - (tuple setter init-form))))) + (tuple setter init-form)))))) :let (emit-let ctx node) :fn (emit-fn ctx node) :invoke (emit-invoke ctx node) diff --git a/test/chez/README.md b/test/chez/README.md index f635012..7d77b89 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -48,13 +48,14 @@ compile-time signal) and are counted "out of subset", not as divergences. JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet -Baseline after inc 3f (quoted literals): **664/664 compiled cases pass**, 0 -divergences; 1994/2658 out of subset (await clojure.core on Chez). Inc 3e +Baseline after inc 3g (letfn + declare): **672/672 compiled cases pass**, 0 +divergences; 1986/2658 out of subset (await clojure.core on Chez). Inc 3e (throw/try + ex-info) was 632/632; inc 3f's quote support + a seq.ss fix (empty -`map`/`filter` results are `()` not nil, matching Clojure) pulled 32 more corpus -cases into the subset. `emit-fn` lowers multi-arity fns to a Scheme `case-lambda` -and variadic fns to a rest-arg lambda (rest list coerced to a jolt seq, nil when -empty). +`map`/`filter` results are `()` not nil, matching Clojure) reached 664/664; inc 3g +(letfn -> Scheme `letrec*`, declare/def-no-init -> a reserved var cell) pulled 8 +more corpus cases into the subset. `emit-fn` lowers multi-arity fns to a Scheme +`case-lambda` and variadic fns to a rest-arg lambda (rest list coerced to a jolt +seq, nil when empty). ## Phase 1 — clojure.core prelude emission (inc 3d, jolt-ocvi) The `-e`-capable jolt-chez path: emit the clojure.core tiers diff --git a/test/chez/core-prelude-probe.janet b/test/chez/core-prelude-probe.janet index 6baa673..914a98a 100644 --- a/test/chez/core-prelude-probe.janet +++ b/test/chez/core-prelude-probe.janet @@ -98,7 +98,7 @@ # Regression floor (raise it as new IR ops / RT shims land, like the suite # baseline). Fails if prelude emit reach drops below the recorded baseline. -(def reach-floor 342) +(def reach-floor 348) (when (< compiled reach-floor) (printf "REGRESSION: prelude emit reach %d < floor %d" compiled reach-floor) (os/exit 1)) diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet index 31deb21..0312788 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -259,6 +259,28 @@ (ok (string "quote: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3k) letfn + declare/def-no-init (inc 3g). letfn lowers to a Scheme `letrec*` +# (mutual recursion between the named local fns — a plain let* can't forward- +# ref a sibling). declare/(def x) with no init pre-creates the var cell so a +# forward reference resolves; the real def runs before any call. +(each src [# single local fn + "(letfn [(twice [x] (* x 2))] (twice 5))" + # self-recursion within a local fn + "(letfn [(fact [n] (if (zero? n) 1 (* n (fact (dec n)))))] (fact 5))" + # MUTUAL recursion — the letrec semantics a sequential let* lacks + "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 10))" + "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (od? 7))" + # local fn passed to a higher-order fn + "(letfn [(sq [x] (* x x))] (map sq [1 2 3]))" + # declare + forward reference (the canonical mutually-recursive top-level use) + "(declare is-ev) (defn is-od [n] (if (zero? n) false (is-ev (dec n)))) (defn is-ev [n] (if (zero? n) true (is-od (dec n)))) (is-ev 10)" + # declare then redefine: the real def overwrites the reserved cell + "(declare foo) (def foo 10) foo"] + (let [[code out err] (d/run-on-chez ctx src) + want (cli-oracle src)] + (ok (string "letfn/declare: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) + # 3h) prelude mode (inc 3d): emitting clojure.core ITSELF, a core->core ref must # lower to a runtime var-deref instead of being rejected as "out of subset". # `frequencies` is a core fn but not a native-op, so it exercises the switch. diff --git a/test/integration/fallback-zero-test.janet b/test/integration/fallback-zero-test.janet index 862833f..410aaa1 100644 --- a/test/integration/fallback-zero-test.janet +++ b/test/integration/fallback-zero-test.janet @@ -21,8 +21,13 @@ (def ctx (init-cached)) (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)))) + # true if the form COMPILES end to end (analyzer IR + back end emit), false if + # it punts to the interpreter. Checks emit-ir too, not just analyze-form: letfn + # and (def x) with no init now ANALYZE to IR, but the Janet back end punts them + # at emit time (sequential let* can't express mutual recursion; an unbound var + # is not a compiled value) — so analyze-form alone would miss the real + # compile-vs-interpret decision that compile-and-eval makes. + (def r (protect (backend/emit-ir ctx (backend/analyze-form ctx (parse-string s))))) (and (r 0) true)) # --- Must compile: pure, non-stateful value production. NONE may punt. --- @@ -80,8 +85,11 @@ # defmacro — definitional host seam (the EXPANDERS are compiled; # see backend/recompile-macros!) # set! — host var-cell mutation special -# letfn — needs letrec IR (sequential let* can't express mutual -# recursion); permanent-interpret unless the IR gains it +# letfn — analyzes to a :letrec IR node now (inc 3g), but the Janet +# back end still punts it at emit: its sequential let* can't +# express the mutual recursion. The Chez back end DOES +# compile it (letrec*). Janet stays interpret until emit-let +# gains a letrec lowering. # eval — compile-and-run entry (also loader stateful-head?) # . / new / Foo. / — thin host-interop heads the back end doesn't model # .method