diff --git a/host/chez/emit.janet b/host/chez/emit.janet index 26ec649..28cc70f 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -43,7 +43,10 @@ "range" "jolt-range" "take" "jolt-take" "drop" "jolt-drop" "keys" "jolt-keys" "vals" "jolt-vals" "even?" "jolt-even?" "odd?" "jolt-odd?" "pos?" "jolt-pos?" "neg?" "jolt-neg?" - "zero?" "jolt-zero?" "identity" "jolt-identity"}) + "zero?" "jolt-zero?" "identity" "jolt-identity" + # exceptions (jolt-vcsl): ex-info builds the tagged map; ex-data/ex-message/ + # ex-cause are pure-over-get Clojure tier fns (no native-op needed). + "ex-info" "jolt-ex-info"}) # Value-position resolution for a clojure.core ref passed AS A VALUE (to map / # filter / reduce / apply). Each native-op already names a usable Scheme @@ -69,7 +72,8 @@ "zero?" |(= $ 1) "identity" |(= $ 1) "cons" |(= $ 2) "filter" |(= $ 2) "remove" |(= $ 2) "into" |(= $ 2) "take" |(= $ 2) "drop" |(= $ 2) "map" |(>= $ 2) "apply" |(>= $ 2) - "reduce" |(or (= $ 2) (= $ 3)) "range" |(and (>= $ 0) (<= $ 3))}) + "reduce" |(or (= $ 2) (= $ 3)) "range" |(and (>= $ 0) (<= $ 3)) + "ex-info" |(or (= $ 2) (= $ 3))}) # If fnode is a clojure.core (or host) ref to a native-op primitive, return the # Scheme op string — only at an arity where the Scheme op and the jolt fn agree. @@ -168,6 +172,22 @@ # (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. +# try/catch/finally (jolt-vcsl). throw raises the jolt value RAW (jolt-throw = +# Scheme `raise`), mirroring the Janet COMPILED backend (which does `(error v)`, +# no :jolt/exception envelope) — so catch binds the value directly, no unwrap. +# catch lowers to `guard` with an `else` clause (catch-all: the IR drops the +# class), finally to `dynamic-wind`'s after-thunk (runs on success, catch, and +# escape — Clojure finally semantics). Both keys are optional on the node. +(defn- emit-try [node] + (def core + (if-let [cs (get node :catch-sym)] + (string "(guard (" (munge cs) " (else " (emit (get node :catch-body)) ")) " + (emit (get node :body)) ")") + (emit (get node :body)))) + (if-let [fin (get node :finally)] + (string "(dynamic-wind (lambda () #f) (lambda () " core ") (lambda () " (emit fin) "))") + core)) + (defn- emit-arity-clause [a] (def params (map munge (vv (get a :params)))) (def restp (when-let [r (get a :rest)] (munge r))) @@ -309,6 +329,8 @@ :let (emit-let node) :loop (emit-loop node) :recur (emit-recur node) + :throw (string "(jolt-throw " (emit (get node :expr)) ")") + :try (emit-try node) :fn (emit-fn node) :def (string "(def-var! " (string/format "%j" (get node :ns)) " " (string/format "%j" (get node :name)) " " (emit (get node :init)) ")") diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 190e9b0..086a53e 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -20,6 +20,25 @@ ;; jolt `not`: only nil and false are falsey. (define (jolt-not x) (if (jolt-truthy? x) #f #t)) +;; --- exceptions (jolt-vcsl) -------------------------------------------------- +;; throw raises the jolt value RAW (no envelope), like the Janet compiled back +;; end; catch (emitted as `guard`) binds it directly. Chez `raise` accepts any +;; object, so a thrown number/map/ex-info all work; uncaught -> non-zero exit. +(define (jolt-throw v) (raise v)) +;; ex-info builds the tagged map {:jolt/type :jolt/ex-info :message :data :cause} +;; — a real jolt-hash-map, so the ex-data/ex-message/ex-cause tier fns read it +;; via jolt-get for free. Arity 2 (msg data) or 3 (msg data cause). +(define jolt-kw-ex-type (keyword "jolt" "type")) +(define jolt-kw-ex-info (keyword "jolt" "ex-info")) +(define jolt-kw-message (keyword #f "message")) +(define jolt-kw-data (keyword #f "data")) +(define jolt-kw-cause (keyword #f "cause")) +(define (jolt-ex-info msg data . more) + (jolt-hash-map jolt-kw-ex-type jolt-kw-ex-info + jolt-kw-message msg + jolt-kw-data data + jolt-kw-cause (if (null? more) jolt-nil (car more)))) + ;; --- var cells: late-bound global roots (Clojure vars) ----------------------- ;; 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 diff --git a/test/chez/README.md b/test/chez/README.md index 24c4774..90535c9 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -48,11 +48,12 @@ 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 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. +Baseline after inc 3e (throw/try + ex-info): **632/632 compiled cases pass**, 0 +divergences; 2023/2655 out of subset (await clojure.core on Chez). Inc 3c +(multi-arity + variadic fns) brought this to 619/619 — `emit-fn` 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); inc 3e's +throw/try/ex-info support pulled 13 more corpus cases into the subset. ## Phase 1 — clojure.core prelude emission (inc 3d, jolt-ocvi) The `-e`-capable jolt-chez path: emit the clojure.core tiers @@ -69,10 +70,14 @@ catalogs the gaps; macros are skipped (analyze-time only, not a runtime value): JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet -Baseline: **303/355 non-macro core forms emit** to Scheme. Remaining 52 gaps: -`:throw` (29, the big one — needs an exception model), `:quote` (8, needs RT -symbols/lists), `:try` (2), Java host interop `.write`/`.isDirectory` (6, io tier), -`letfn` (4), `declare`/def-no-init (2), one edge (`parse-uuid`). Each is a clean +Baseline after inc 3e (throw/try + ex-info): **334/355 non-macro core forms emit** +to Scheme (was 303 at inc 3d). `:throw` lowers to `jolt-throw` (Scheme `raise` of +the raw jolt value, like the Janet compiled back end); `:try` lowers to `guard` +(catch, class dropped → catch-all) + `dynamic-wind` (finally); `ex-info` is a +native-op building the tagged jolt map, so the ex-data/ex-message/ex-cause tier +fns read it over `get` for free. Remaining 21 gaps: `:quote` (8, needs RT +symbols/lists), Java host interop `.write`/`.isDirectory` (6, io tier), `letfn` +(4), `declare`/def-no-init (2), one edge (`parse-uuid`). Each is a clean next-increment target. The probe has a regression floor (raise it as gaps close). Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences, diff --git a/test/chez/core-prelude-probe.janet b/test/chez/core-prelude-probe.janet index f330416..d9e2376 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 303) +(def reach-floor 334) (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 0bd302f..565f2d5 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -207,6 +207,35 @@ (ok (string "arity: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3i) throw / try / catch / finally + ex-info (inc 3e). Value parity vs the CLI +# oracle for caught throws; an uncaught throw must exit non-zero. +(each src [# jolt catch syntax is (catch Class binding body); the class is dropped + # in the IR (catch-all). catch binds the thrown value raw. + "(try (throw 42) (catch Exception e e))" + "(try (+ 1 (throw 7)) (catch Exception e (* e 10)))" + # finally runs and its value is discarded (try returns the body value) + "(try 5 (finally 99))" + "(try (throw 3) (catch Exception e (+ e 1)) (finally 99))" + # body value passes through when nothing throws + "(try (+ 2 3) (catch Exception e :nope))" + # ex-info builds a real jolt map: read message/data via get (native-op) + "(get (ex-info \"boom\" {:a 1}) :message)" + "(get (ex-info \"boom\" {:a 1}) :data)" + "(try (throw (ex-info \"boom\" {:a 1})) (catch Exception e (get e :message)))" + "(try (throw (ex-info \"boom\" {:a 7})) (catch Exception e (get (get e :data) :a)))" + # nested try: inner rethrows, outer catches + "(try (try (throw 1) (catch Exception e (throw (+ e 1)))) (catch Exception e (* e 100)))"] + (let [[code out err] (d/run-on-chez ctx src) + want (cli-oracle src)] + (ok (string "throw/try: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) + +# an uncaught throw aborts the program (non-zero exit) — matches the corpus +# `:throws` semantics (interpret/compile both bail). +(let [[code out err] (d/run-on-chez ctx "(throw (ex-info \"unhandled\" {}))")] + (ok "throw: uncaught exits non-zero" (not= code 0) + (string "code=" code " out=" out))) + # 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.