Chez Phase 1 (increment 3e): throw/try/catch/finally + ex-info
Emit :throw as jolt-throw (Scheme raise of the raw jolt value, matching the
Janet compiled back end's (error v) — no envelope, so catch binds it directly).
Emit :try as guard (catch; the class is dropped in the IR, so it's catch-all)
plus dynamic-wind for finally. ex-info is a native-op building the tagged jolt
map {:jolt/type :jolt/ex-info :message :data :cause}, so the ex-data/ex-message/
ex-cause tier fns read it over jolt-get for free.
Prelude emit reach 303 -> 334/355 (:throw and :try gaps close). Subset probe
619 -> 632/632 compiled, 0 divergences (throw/try/ex-info pull 13 corpus cases
into the subset). emit-test 94/94 (added 11 throw/try/ex-info cases + uncaught
exits non-zero). Full gate green.
This commit is contained in:
parent
8f26433469
commit
ffa122440a
5 changed files with 87 additions and 12 deletions
|
|
@ -43,7 +43,10 @@
|
||||||
"range" "jolt-range" "take" "jolt-take" "drop" "jolt-drop"
|
"range" "jolt-range" "take" "jolt-take" "drop" "jolt-drop"
|
||||||
"keys" "jolt-keys" "vals" "jolt-vals"
|
"keys" "jolt-keys" "vals" "jolt-vals"
|
||||||
"even?" "jolt-even?" "odd?" "jolt-odd?" "pos?" "jolt-pos?" "neg?" "jolt-neg?"
|
"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 /
|
# 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
|
# filter / reduce / apply). Each native-op already names a usable Scheme
|
||||||
|
|
@ -69,7 +72,8 @@
|
||||||
"zero?" |(= $ 1) "identity" |(= $ 1)
|
"zero?" |(= $ 1) "identity" |(= $ 1)
|
||||||
"cons" |(= $ 2) "filter" |(= $ 2) "remove" |(= $ 2) "into" |(= $ 2)
|
"cons" |(= $ 2) "filter" |(= $ 2) "remove" |(= $ 2) "into" |(= $ 2)
|
||||||
"take" |(= $ 2) "drop" |(= $ 2) "map" |(>= $ 2) "apply" |(>= $ 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
|
# 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.
|
# 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
|
# (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
|
# 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.
|
# 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]
|
(defn- emit-arity-clause [a]
|
||||||
(def params (map munge (vv (get a :params))))
|
(def params (map munge (vv (get a :params))))
|
||||||
(def restp (when-let [r (get a :rest)] (munge r)))
|
(def restp (when-let [r (get a :rest)] (munge r)))
|
||||||
|
|
@ -309,6 +329,8 @@
|
||||||
:let (emit-let node)
|
:let (emit-let node)
|
||||||
:loop (emit-loop node)
|
:loop (emit-loop node)
|
||||||
:recur (emit-recur node)
|
:recur (emit-recur node)
|
||||||
|
:throw (string "(jolt-throw " (emit (get node :expr)) ")")
|
||||||
|
:try (emit-try node)
|
||||||
:fn (emit-fn node)
|
:fn (emit-fn node)
|
||||||
:def (string "(def-var! " (string/format "%j" (get node :ns)) " "
|
:def (string "(def-var! " (string/format "%j" (get node :ns)) " "
|
||||||
(string/format "%j" (get node :name)) " " (emit (get node :init)) ")")
|
(string/format "%j" (get node :name)) " " (emit (get node :init)) ")")
|
||||||
|
|
|
||||||
|
|
@ -20,6 +20,25 @@
|
||||||
;; jolt `not`: only nil and false are falsey.
|
;; jolt `not`: only nil and false are falsey.
|
||||||
(define (jolt-not x) (if (jolt-truthy? x) #f #t))
|
(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) -----------------------
|
;; --- 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`
|
;; 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 reads it at use time (late binding), so a forward/mutually-recursive
|
||||||
|
|
|
||||||
|
|
@ -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
|
JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet
|
||||||
|
|
||||||
Baseline after inc 3c (multi-arity + variadic fns, jolt-gret): **619/619 compiled
|
Baseline after inc 3e (throw/try + ex-info): **632/632 compiled cases pass**, 0
|
||||||
cases pass**, 0 divergences; 2036/2655 out of subset (await clojure.core on Chez).
|
divergences; 2023/2655 out of subset (await clojure.core on Chez). Inc 3c
|
||||||
`emit-fn` now lowers multi-arity fns to a Scheme `case-lambda` and variadic fns to
|
(multi-arity + variadic fns) brought this to 619/619 — `emit-fn` lowers
|
||||||
a rest-arg lambda (the Scheme rest list is coerced to a jolt seq, nil when empty),
|
multi-arity fns to a Scheme `case-lambda` and variadic fns to a rest-arg lambda
|
||||||
which is the gating lift for emitting the clojure.core tiers as a prelude.
|
(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)
|
## Phase 1 — clojure.core prelude emission (inc 3d, jolt-ocvi)
|
||||||
The `-e`-capable jolt-chez path: emit the clojure.core tiers
|
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
|
JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet
|
||||||
|
|
||||||
Baseline: **303/355 non-macro core forms emit** to Scheme. Remaining 52 gaps:
|
Baseline after inc 3e (throw/try + ex-info): **334/355 non-macro core forms emit**
|
||||||
`:throw` (29, the big one — needs an exception model), `:quote` (8, needs RT
|
to Scheme (was 303 at inc 3d). `:throw` lowers to `jolt-throw` (Scheme `raise` of
|
||||||
symbols/lists), `:try` (2), Java host interop `.write`/`.isDirectory` (6, io tier),
|
the raw jolt value, like the Janet compiled back end); `:try` lowers to `guard`
|
||||||
`letfn` (4), `declare`/def-no-init (2), one edge (`parse-uuid`). Each is a clean
|
(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).
|
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,
|
Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences,
|
||||||
|
|
|
||||||
|
|
@ -98,7 +98,7 @@
|
||||||
|
|
||||||
# Regression floor (raise it as new IR ops / RT shims land, like the suite
|
# 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.
|
# baseline). Fails if prelude emit reach drops below the recorded baseline.
|
||||||
(def reach-floor 303)
|
(def reach-floor 334)
|
||||||
(when (< compiled reach-floor)
|
(when (< compiled reach-floor)
|
||||||
(printf "REGRESSION: prelude emit reach %d < floor %d" compiled reach-floor)
|
(printf "REGRESSION: prelude emit reach %d < floor %d" compiled reach-floor)
|
||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
|
|
|
||||||
|
|
@ -207,6 +207,35 @@
|
||||||
(ok (string "arity: " src) (and (= code 0) (= out want))
|
(ok (string "arity: " src) (and (= code 0) (= out want))
|
||||||
(string "chez=" out " janet=" want " | " err))))
|
(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
|
# 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".
|
# 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.
|
# `frequencies` is a core fn but not a native-op, so it exercises the switch.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue