Chez Phase 3 inc 3: try/throw + host-call + regex/inst/uuid + def-meta in jolt.backend-scheme
Completes the op coverage of the portable Clojure emitter — it now handles every op emit.janet does (const/local/var/the-var/host/host-static/host-new/if/do/ invoke/vector/set/map/quote/throw/try/regex/inst/uuid/host-call/let/loop/recur/ fn/def). Adds emit-try (guard + dynamic-wind), :throw, :regex/:inst/:uuid, and :host-call (jolt-host-call for rt-shimmed methods else record-method-dispatch). def-meta + quoted-symbol-meta needed emit-quoted to reconstruct plain jolt VALUES (metadata maps), not just reader forms. The blocker was that :meta arrived as a raw Janet table embedded in the IR — jolt's count/map?/keys don't work on a table (counter to jolt.ir's 'no host values embedded'). Fixed at the host seam: h-sym-meta now returns the meta as an immutable struct, which is a portable jolt map (jolt count/map?/keys work on a struct, and the Janet backend's merge/get still do too). emit-quoted handles both reader forms (jolt.host form-* contract) and jolt-value collections (native map?/vector?/set?/seq? branches, after the form-* branches so reader forms win). Gate: emit-parity 55/55 (incl try/catch/finally, ^:private def-var-with-meta! structural check, inst/uuid eq, regex smoke, quoted-sym-meta). Full jpm gate green after clean rebuild (seed change). jolt-me6m.
This commit is contained in:
parent
206fe94a95
commit
f9a665b3c4
3 changed files with 101 additions and 11 deletions
|
|
@ -15,9 +15,12 @@
|
||||||
(+ native-ops)/fn/def + the escaping/flonum/munge helpers.
|
(+ native-ops)/fn/def + the escaping/flonum/munge helpers.
|
||||||
INCREMENT 2 (jolt-7jvp): collection literals (vector/map/set, emit-ordered) +
|
INCREMENT 2 (jolt-7jvp): collection literals (vector/map/set, emit-ordered) +
|
||||||
quote (emit-quoted, walks the raw reader form via the portable jolt.host form-*
|
quote (emit-quoted, walks the raw reader form via the portable jolt.host form-*
|
||||||
contract — same seam the analyzer uses, so it stays host-neutral). Quoted symbol
|
contract — same seam the analyzer uses, so it stays host-neutral).
|
||||||
metadata, def-meta, try/throw, host interop, regex/inst/uuid and program
|
INCREMENT 3 (jolt-me6m): try/throw + host-call + regex/inst/uuid + def-meta +
|
||||||
assembly land in later increments (they throw not-yet-ported so a hit is loud)."
|
quoted-symbol-meta. With this the emitter covers every op emit.janet handles.
|
||||||
|
emit-quoted now also reconstructs plain jolt VALUES (def/symbol :meta), enabled
|
||||||
|
by making :meta a portable struct at the host seam (h-sym-meta). Program
|
||||||
|
assembly + the prelude driver port land with compile-from-source (inc 4+)."
|
||||||
(:require [clojure.string :as str]
|
(:require [clojure.string :as str]
|
||||||
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-sym-meta
|
[jolt.host :refer [form-sym? form-sym-name form-sym-ns form-sym-meta
|
||||||
form-list? form-vec? form-map? form-set? form-char?
|
form-list? form-vec? form-map? form-set? form-char?
|
||||||
|
|
@ -75,6 +78,11 @@
|
||||||
;; but Scheme's < demands a number even there — special-case.
|
;; but Scheme's < demands a number even there — special-case.
|
||||||
(def ^:private cmp1-ops #{"<" ">" "<=" ">="})
|
(def ^:private cmp1-ops #{"<" ">" "<=" ">="})
|
||||||
|
|
||||||
|
;; Host interop methods with a Chez RT shim (rt.ss jolt-host-call). A `.method`
|
||||||
|
;; call on any other method routes to record-method-dispatch (a reify/record
|
||||||
|
;; protocol method). Keep in sync with emit.janet's supported-host-methods.
|
||||||
|
(def ^:private supported-host-methods #{"isDirectory" "listFiles"})
|
||||||
|
|
||||||
;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an
|
;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an
|
||||||
;; :if test built from them needs no jolt-truthy? wrapper (jolt-nkcb).
|
;; :if test built from them needs no jolt-truthy? wrapper (jolt-nkcb).
|
||||||
(def ^:private bool-returning-ops
|
(def ^:private bool-returning-ops
|
||||||
|
|
@ -169,20 +177,36 @@
|
||||||
(str "(jolt-hash-map "
|
(str "(jolt-hash-map "
|
||||||
(str/join " " (mapcat (fn [p] [(emit-quoted (nth p 0)) (emit-quoted (nth p 1))]) pairs))
|
(str/join " " (mapcat (fn [p] [(emit-quoted (nth p 0)) (emit-quoted (nth p 1))]) pairs))
|
||||||
")"))
|
")"))
|
||||||
|
(defn- emit-quoted-map-value [m]
|
||||||
|
;; a jolt map VALUE (def/symbol metadata is a value, not a reader form)
|
||||||
|
(str "(jolt-hash-map "
|
||||||
|
(str/join " " (mapcat (fn [k] [(emit-quoted k) (emit-quoted (get m k))]) (keys m)))
|
||||||
|
")"))
|
||||||
|
;; emit-quoted reconstructs both raw reader forms (from :quote) AND plain jolt
|
||||||
|
;; values (def/symbol :meta). Reader forms are walked via the jolt.host form-*
|
||||||
|
;; contract; the native-predicate branches below catch genuine jolt collection
|
||||||
|
;; VALUES. The form-* branches come first so a reader form (a host-native struct/
|
||||||
|
;; array that a native predicate might also match) is always handled as a form.
|
||||||
(defn- emit-quoted [form]
|
(defn- emit-quoted [form]
|
||||||
(cond
|
(cond
|
||||||
(form-char? form) (emit-const form)
|
(form-char? form) (emit-const form)
|
||||||
(form-literal? form) (emit-const form)
|
(form-literal? form) (emit-const form)
|
||||||
(form-sym? form)
|
(form-sym? form)
|
||||||
(let [m (form-sym-meta form)]
|
(let [m (form-sym-meta form) sns (form-sym-ns form) nm (form-sym-name form)]
|
||||||
(when (and m (pos? (count m)))
|
(if (and m (pos? (count m)))
|
||||||
(throw (ex-info "emit-quoted: quoted symbol with metadata not yet ported (inc 3)" {})))
|
;; carry reader metadata (^:foo bar) onto the quoted symbol so (meta 'x) sees it
|
||||||
(let [sns (form-sym-ns form) nm (form-sym-name form)]
|
(str "(jolt-symbol/meta " (if sns (chez-str-lit sns) "#f") " " (chez-str-lit nm) " "
|
||||||
|
(emit-quoted m) ")")
|
||||||
(str "(jolt-symbol " (if sns (chez-str-lit sns) "#f") " " (chez-str-lit nm) ")")))
|
(str "(jolt-symbol " (if sns (chez-str-lit sns) "#f") " " (chez-str-lit nm) ")")))
|
||||||
(form-set? form) (str "(jolt-hash-set " (str/join " " (map emit-quoted (form-set-items form))) ")")
|
(form-set? form) (str "(jolt-hash-set " (str/join " " (map emit-quoted (form-set-items form))) ")")
|
||||||
(form-list? form) (str "(jolt-list " (str/join " " (map emit-quoted (form-elements form))) ")")
|
(form-list? form) (str "(jolt-list " (str/join " " (map emit-quoted (form-elements form))) ")")
|
||||||
(form-vec? form) (str "(jolt-vector " (str/join " " (map emit-quoted (form-vec-items form))) ")")
|
(form-vec? form) (str "(jolt-vector " (str/join " " (map emit-quoted (form-vec-items form))) ")")
|
||||||
(form-map? form) (emit-quoted-map (form-map-pairs form))
|
(form-map? form) (emit-quoted-map (form-map-pairs form))
|
||||||
|
;; plain jolt VALUES (metadata maps and anything nested in them)
|
||||||
|
(map? form) (emit-quoted-map-value form)
|
||||||
|
(vector? form) (str "(jolt-vector " (str/join " " (map emit-quoted form)) ")")
|
||||||
|
(set? form) (str "(jolt-hash-set " (str/join " " (map emit-quoted form)) ")")
|
||||||
|
(seq? form) (str "(jolt-list " (str/join " " (map emit-quoted form)) ")")
|
||||||
:else (throw (ex-info (str "emit-quoted: unsupported quoted form " (pr-str form)) {}))))
|
:else (throw (ex-info (str "emit-quoted: unsupported quoted form " (pr-str form)) {}))))
|
||||||
|
|
||||||
;; A def's :meta is a jolt map value. Non-empty? (a plain def carries {}).
|
;; A def's :meta is a jolt map value. Non-empty? (a plain def carries {}).
|
||||||
|
|
@ -314,6 +338,19 @@
|
||||||
:else
|
:else
|
||||||
(str "(jolt-invoke " (emit fnode) " " (str/join " " args) ")"))))
|
(str "(jolt-invoke " (emit fnode) " " (str/join " " args) ")"))))
|
||||||
|
|
||||||
|
;; try/catch/finally (jolt-vcsl). throw raises the jolt value RAW (jolt-throw =
|
||||||
|
;; Scheme `raise`); catch lowers to `guard` with an `else` clause (the IR drops
|
||||||
|
;; the class), finally to `dynamic-wind`'s after-thunk (runs on success, catch and
|
||||||
|
;; escape — Clojure finally semantics). Both keys optional on the node.
|
||||||
|
(defn- emit-try [node]
|
||||||
|
(let [core (if-let [cs (:catch-sym node)]
|
||||||
|
(str "(guard (" (munge-name cs) " (else " (emit (:catch-body node)) ")) "
|
||||||
|
(emit (:body node)) ")")
|
||||||
|
(emit (:body node)))]
|
||||||
|
(if-let [fin (:finally node)]
|
||||||
|
(str "(dynamic-wind (lambda () #f) (lambda () " core ") (lambda () " (emit fin) "))")
|
||||||
|
core)))
|
||||||
|
|
||||||
;; Does this IR node emit to an expression that yields a Scheme boolean? Used to
|
;; Does this IR node emit to an expression that yields a Scheme boolean? Used to
|
||||||
;; drop the redundant jolt-truthy? on an :if test.
|
;; drop the redundant jolt-truthy? on an :if test.
|
||||||
(defn- returns-scheme-bool? [node]
|
(defn- returns-scheme-bool? [node]
|
||||||
|
|
@ -358,6 +395,23 @@
|
||||||
:map (emit-ordered "jolt-hash-map"
|
:map (emit-ordered "jolt-hash-map"
|
||||||
(mapcat (fn [p] [(emit (nth p 0)) (emit (nth p 1))]) (:pairs node)))
|
(mapcat (fn [p] [(emit (nth p 0)) (emit (nth p 1))]) (:pairs node)))
|
||||||
:quote (emit-quoted (:form node))
|
:quote (emit-quoted (:form node))
|
||||||
|
:throw (str "(jolt-throw " (emit (:expr node)) ")")
|
||||||
|
:try (emit-try node)
|
||||||
|
;; regex literal #"…" -> a jolt-regex value (regex.ss, vendored irregex).
|
||||||
|
:regex (str "(jolt-regex " (chez-str-lit (:source node)) ")")
|
||||||
|
;; #inst / #uuid literals -> runtime inst / uuid values.
|
||||||
|
:inst (str "(jolt-inst-from-string " (chez-str-lit (:source node)) ")")
|
||||||
|
:uuid (str "(jolt-uuid-from-string " (chez-str-lit (:source node)) ")")
|
||||||
|
;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else
|
||||||
|
;; record-method-dispatch (a reify/record protocol method, jolt-jgoc).
|
||||||
|
:host-call (let [m (:method node)
|
||||||
|
target (emit (:target node))
|
||||||
|
args (map emit (:args node))]
|
||||||
|
(if (supported-host-methods m)
|
||||||
|
(str "(jolt-host-call " (chez-str-lit m) " " target
|
||||||
|
(if (empty? args) "" (str " " (str/join " " args))) ")")
|
||||||
|
(str "(record-method-dispatch " target " " (chez-str-lit m)
|
||||||
|
" (jolt-vector" (if (empty? args) "" (str " " (str/join " " args))) "))")))
|
||||||
:let (emit-let node)
|
:let (emit-let node)
|
||||||
:loop (emit-loop node)
|
:loop (emit-loop node)
|
||||||
:recur (emit-recur node)
|
:recur (emit-recur node)
|
||||||
|
|
@ -368,7 +422,8 @@
|
||||||
(:no-init node)
|
(:no-init node)
|
||||||
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
||||||
(jmeta-nonempty? (:meta node))
|
(jmeta-nonempty? (:meta node))
|
||||||
(throw (ex-info "emit: def with non-empty meta not yet ported (inc 3)" {}))
|
(str "(def-var-with-meta! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||||
|
(emit (:init node)) " " (emit-quoted (:meta node)) ")")
|
||||||
:else
|
:else
|
||||||
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||||
(emit (:init node)) ")"))
|
(emit (:init node)) ")"))
|
||||||
|
|
|
||||||
|
|
@ -32,9 +32,19 @@
|
||||||
(defn h-sym-name [form] (form :name))
|
(defn h-sym-name [form] (form :name))
|
||||||
(defn h-sym-ns [form] (form :ns))
|
(defn h-sym-ns [form] (form :ns))
|
||||||
# Reader metadata on a symbol (e.g. ^:dynamic / ^:redef / ^:private on a def
|
# Reader metadata on a symbol (e.g. ^:dynamic / ^:redef / ^:private on a def
|
||||||
# name). Returns the meta map or nil. Lets the analyzer carry def metadata that
|
# name). Returns the meta map (a portable jolt map) or nil. Lets the analyzer
|
||||||
# the back end applies to the var — without it, compiled defs drop all var meta.
|
# carry def metadata that the back end applies to the var — without it, compiled
|
||||||
(defn h-sym-meta [form] (form :meta))
|
# defs drop all var meta.
|
||||||
|
#
|
||||||
|
# The reader builds meta as a Janet TABLE (mutable). Return it as an immutable
|
||||||
|
# STRUCT so it is a portable jolt value: the Janet back end's merge/get work on a
|
||||||
|
# struct, AND jolt's own count/map?/keys (used by the portable Clojure emitter,
|
||||||
|
# jolt.backend-scheme, to emit def metadata) work on a struct but NOT on a raw
|
||||||
|
# table. A table embedded in the IR is a host value (counter to jolt.ir's "no host
|
||||||
|
# values embedded") — struct keeps :meta host-neutral. (jolt-me6m)
|
||||||
|
(defn h-sym-meta [form]
|
||||||
|
(def m (form :meta))
|
||||||
|
(if (table? m) (table/to-struct m) m))
|
||||||
|
|
||||||
(defn h-list? [form] (array? form)) # a call / list (reader: array)
|
(defn h-list? [form] (array? form)) # a call / list (reader: array)
|
||||||
(defn h-vector? [form] (tuple? form)) # a vector literal (reader: tuple)
|
(defn h-vector? [form] (tuple? form)) # a vector literal (reader: tuple)
|
||||||
|
|
|
||||||
|
|
@ -157,6 +157,20 @@
|
||||||
(check "vector map filter" "(into [] (filter even? (map inc [1 2 3 4 5])))")
|
(check "vector map filter" "(into [] (filter even? (map inc [1 2 3 4 5])))")
|
||||||
(check "map over literal" "(reduce + (vals {:a 1 :b 2 :c 3}))")
|
(check "map over literal" "(reduce + (vals {:a 1 :b 2 :c 3}))")
|
||||||
|
|
||||||
|
# --- inc 3 subset: try/throw + def-meta + quoted-sym-meta + inst/uuid + regex ----
|
||||||
|
|
||||||
|
(check "try catch" `(try (throw (ex-info "boom" {})) (catch Throwable e 42))`)
|
||||||
|
(check "try catch value" `(+ (try (throw (ex-info "" {})) (catch Throwable e 10)) 5)`)
|
||||||
|
(check "try no throw" `(try 7 (catch Throwable e 0))`)
|
||||||
|
(check "try finally" `(try 1 (finally 2))`)
|
||||||
|
(check "try finally side" `(try (throw (ex-info "" {})) (catch Throwable e 3) (finally 9))`)
|
||||||
|
(check "def private runs" `(do (defn ^:private secret [] 99) (secret))`)
|
||||||
|
(check "def tagged runs" `(do (def ^:dynamic *q* 5) *q*)`)
|
||||||
|
(check "quoted sym meta eq" `(do (def x (quote ^:foo bar)) (= x x))`)
|
||||||
|
(check "inst eq" `(= #inst "2020-01-01" #inst "2020-01-01")`)
|
||||||
|
(check "uuid eq" `(= #uuid "00000000-0000-0000-0000-000000000000" #uuid "00000000-0000-0000-0000-000000000000")`)
|
||||||
|
(check "regex smoke" `(do (def r #"[0-9]+") true)`)
|
||||||
|
|
||||||
(check "mandelbrot run(20)"
|
(check "mandelbrot run(20)"
|
||||||
(string ``
|
(string ``
|
||||||
(defn count-point [cr ci cap]
|
(defn count-point [cr ci cap]
|
||||||
|
|
@ -178,5 +192,16 @@
|
||||||
acc))))
|
acc))))
|
||||||
`` "\n(run 20)"))
|
`` "\n(run 20)"))
|
||||||
|
|
||||||
|
# Structural: a ^:private def must now take the def-var-with-meta! path (the meta
|
||||||
|
# is a portable struct after the h-sym-meta fix; before, map?/count failed on the
|
||||||
|
# raw table and it silently fell back to the lean def-var!, dropping the meta).
|
||||||
|
(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def ^:private p 1)") 0)))]
|
||||||
|
(ok "def ^:private emits def-var-with-meta!"
|
||||||
|
(truthy? (string/find "def-var-with-meta!" scm)) scm))
|
||||||
|
(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def plain 1)") 0)))]
|
||||||
|
(ok "plain def stays lean def-var!"
|
||||||
|
(and (truthy? (string/find "(def-var! " scm))
|
||||||
|
(not (string/find "with-meta" scm))) scm))
|
||||||
|
|
||||||
(printf "\n%d/%d ok" (- total fails) total)
|
(printf "\n%d/%d ok" (- total fails) total)
|
||||||
(when (> fails 0) (os/exit 1))
|
(when (> fails 0) (os/exit 1))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue