From 45208afff14566205771d5c92c59f0009a5f7a86 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Wed, 17 Jun 2026 16:08:27 -0400 Subject: [PATCH] Chez Phase 1 (increment 3c): multi-arity + variadic fn emission emit-fn lowered multi-arity fns to a Scheme case-lambda and variadic fns to a rest-arg lambda; the Scheme rest list is coerced to a jolt seq (nil when empty, via list->cseq), and the named-let wrapper runs that coercion only on first entry so recur carries the seq directly. Single fixed arity keeps the plain-lambda fast path (fib untouched). Also fixes a latent leak in the module-global known-procs: a throw mid-emit (uncompilable body) left the fn's name registered, so a later corpus case binding the same name to a keyword emitted a direct call to a non-procedure. The cleanup now runs on the error path too. Only surfaced once the new arity support let +24 cases compile further before hitting an uncompilable fn. Gate: emit-test 81/81, subset probe 619/619 compiled (was 595), 0 divergences, 2036/2655 out of subset; full run-tests green (125 files). --- host/chez/emit.janet | 56 ++++++++++++++++++++++++++++++--------- test/chez/README.md | 20 +++++++++----- test/chez/emit-test.janet | 22 +++++++++++++++ 3 files changed, 78 insertions(+), 20 deletions(-) diff --git a/host/chez/emit.janet b/host/chez/emit.janet index 8b0c88b..77cf2c4 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -152,28 +152,58 @@ (unless recur-target (error "emit: recur outside a loop/fn target")) (string "(" recur-target " " (string/join (map emit (vv (get node :args))) " ") ")")) -(defn- emit-fn [node] - (def arities (map nn (vv (get node :arities)))) - (when (not= 1 (length arities)) (error "emit: multi-arity fn not in this increment")) - (def a (first arities)) - (when (get a :rest) (error "emit: variadic fn not in this increment")) +# One arity -> a Scheme lambda param-list + a named-let-wrapped body. The named +# let lets fn-level `recur` rebind this arity's params. A variadic arity takes a +# Scheme rest arg (proper list) and the let binding coerces it to a jolt seq +# (nil when empty — Clojure's rest semantics; list->cseq already does this); recur +# carries the rest seq directly, and the named let's init only runs on first +# entry, so the coercion isn't re-applied on a recur. +(defn- emit-arity-clause [a] (def params (map munge (vv (get a :params)))) - # wrap the body in a named let so fn-level `recur` rebinds the params + (def restp (when-let [r (get a :rest)] (munge r))) (def label (fresh-label "fnrec")) (def prev recur-target) (set recur-target label) - # a named fn binds its own name as a known-procedure local in the body, so - # self-calls emit directly rather than via the jolt-invoke fallback. + (def body (emit (get a :body))) + (set recur-target prev) + (def paramlist + (cond + # only a rest param: Scheme formals are the bare symbol, not `( . xs)` + (and restp (empty? params)) restp + restp (string "(" (string/join params " ") " . " restp ")") + (string "(" (string/join params " ") ")"))) + (def binds + (if restp + [;(map (fn [p] (string "(" p " " p ")")) params) + (string "(" restp " (list->cseq " restp "))")] + (map (fn [p] (string "(" p " " p ")")) params))) + [paramlist (string "(let " label " (" (string/join binds " ") ") " body ")")]) + +(defn- emit-fn [node] + (def arities (map nn (vv (get node :arities)))) + # a named fn binds its own name as a known-procedure local across ALL arities, + # so self-calls (to any arity) emit directly rather than via jolt-invoke; the + # case-lambda value dispatches on argument count. (def self (when-let [nm (get node :name)] (munge nm))) (def had-self (and self (get known-procs self))) (when self (put known-procs self true)) - (def body (emit (get a :body))) + # Restore known-procs even when a body is uncompilable: a throw mid-emit must + # not leak this fn's name into the module global, or a LATER case binding the + # same name to a keyword/coll would emit a direct call to a non-procedure + # (runtime crash). The corpus probe shares one emit state across all cases, so + # this leak is order-dependent and otherwise invisible in single-case tests. + (def clauses + (try (map emit-arity-clause arities) + ([err fib] + (unless had-self (when self (put known-procs self nil))) + (propagate err fib)))) (unless had-self (when self (put known-procs self nil))) - (set recur-target prev) (def lambda - (string "(lambda (" (string/join params " ") ") " - "(let " label " (" (string/join (map (fn [p] (string "(" p " " p ")")) params) " ") ") " - body "))")) + (if (= 1 (length clauses)) + (let [[pl body] (first clauses)] (string "(lambda " pl " " body ")")) + (string "(case-lambda " + (string/join (map (fn [c] (string "(" (get c 0) " " (get c 1) ")")) clauses) " ") + ")"))) # A named fn (defn / (fn self [..])) references itself by name — the analyzer # binds that name as a :local in the body. letrec makes the name visible to the # lambda so self-calls resolve (recur stays a separate self-call to the arity). diff --git a/test/chez/README.md b/test/chez/README.md index ce26841..cfde20e 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -48,13 +48,19 @@ 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 3b (seq tier + dynamic IFn, jolt-5pso): **595/595 compiled -cases pass**, 0 divergences; 2060/2655 out of subset (await clojure.core on Chez). -The seq tier brought up a list/lazy-seq type with first/rest/next/seq/cons/list, -map/filter/reduce/into/remove, range/take/drop/concat/apply, keys/vals, and -nth/peek/pop over seqs; dynamic IFn dispatch (a keyword/vector/coll held in a -local and called as a fn) now routes through the `jolt-invoke` fallback, closing -the 3 ex-known divergences. The probe exits non-zero on any NEW divergence. +Baseline after inc 3c (multi-arity + variadic fns, jolt-gret): **619/619 compiled +cases pass**, 0 divergences; 2036/2655 out of subset (await clojure.core on Chez). +`emit-fn` now lowers multi-arity fns to a Scheme `case-lambda` and variadic fns to +a rest-arg lambda (the Scheme rest list is coerced to a jolt seq, nil when empty), +which is the gating lift for emitting the clojure.core tiers as a prelude. + +Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences, +2060/2655 out of subset. The seq tier brought up a list/lazy-seq type with +first/rest/next/seq/cons/list, map/filter/reduce/into/remove, +range/take/drop/concat/apply, keys/vals, and nth/peek/pop over seqs; dynamic IFn +dispatch (a keyword/vector/coll held in a local and called as a fn) routes through +the `jolt-invoke` fallback, closing the 3 ex-known divergences. The probe exits +non-zero on any NEW divergence. (Prior, inc 3a: 433/436 compiled, 3 known IFn divergences, 2219 out of subset. Inc 2: 182/182 compiled, 0 divergences, 2473 out of subset.) diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet index c8c6d07..3a677b4 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -185,6 +185,28 @@ (ok (string "seq=: " src) (and (= code 0) (= out "true")) (string "chez=" out " | " err)))) +# 3g) multi-arity + variadic fns (inc 3c): case-lambda dispatch, a Scheme rest +# arg collected into a jolt seq (nil when empty), recur within an arity and a +# self-call across arities. Value parity vs the CLI oracle. +(each src ["((fn ([x] (* x 2)) ([x y] (+ x y))) 5)" + "((fn ([x] (* x 2)) ([x y] (+ x y))) 3 4)" + "(defn g ([x] x) ([x y] (+ x y))) (g 10)" + "(defn g ([x] x) ([x y] (+ x y))) (g 10 20)" + "(defn h [a & more] (count more)) (h 1 2 3 4)" + # empty rest is nil (Clojure): count 0, first nil (prints "") + "(defn h [a & more] (count more)) (h 1)" + "(defn h [a & more] (first more)) (h 1)" + "(defn h [a & more] (first more)) (h 1 2 3)" + "(defn h [a & more] (reduce + a more)) (h 1 2 3 4)" + "(defn h [a & more] (reduce + a more)) (apply h [1 2 3 4])" + # self-call from one arity to another, then recur within it + "(defn f ([n] (f n 0)) ([n acc] (if (zero? n) acc (recur (- n 1) (+ acc n))))) (f 5)" + "((fn r [& xs] (if (seq xs) (+ (first xs) (apply r (rest xs))) 0)) 1 2 3)"] + (let [[code out err] (d/run-on-chez ctx src) + want (cli-oracle src)] + (ok (string "arity: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) + # 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers.