Chez Phase 2 (inc L): var def-time metadata (jolt-zikh)
Capture a def's reader metadata on the Chez var. The :def emit now lowers a def
with non-empty metadata to def-var-with-meta!, which stores the user meta
(^:private / ^Type tag / docstring -> {:doc}) in an eq side-table keyed by the
var-cell. jolt-meta of a var-cell merges that onto {:ns :name} derived from the
cell, so every var reports {:ns :name} like Clojure with the def-time meta
layered on. (^{:map} metadata on a def name stays uncompilable for the compiler
generally — analyzer rejects it, the Janet back end punts to its interpreter,
which Chez lacks — so it's out of subset, not a meta-capture gap.)
Added natives-meta.ss to the prelude-cache fingerprint. Prelude parity
1969 -> 1972, 0 new divergences; the three var-metadata allowlist entries
(^:private / ^Type tag / docstring) dropped. New focused gate
test/chez/_var_meta.janet.
This commit is contained in:
parent
32e2d8bd58
commit
737288bff5
6 changed files with 87 additions and 11 deletions
|
|
@ -218,6 +218,15 @@
|
|||
(or (struct? form) (table? form)) (emit-quoted-map form)
|
||||
(errorf "emit-quoted: unsupported quoted form %p" form))))
|
||||
|
||||
# A def's :meta is a jolt map value (Janet struct/table or phm). Non-empty?
|
||||
# (a plain def carries {} — keep it on the lean def-var! path).
|
||||
(defn- jmeta-nonempty? [m]
|
||||
(cond
|
||||
(nil? m) false
|
||||
(phm/phm? m) (> (length (phm/phm-to-struct m)) 0)
|
||||
(or (struct? m) (table? m)) (> (length m) 0)
|
||||
false))
|
||||
|
||||
(defn- emit-binding [b]
|
||||
(def b (vv b))
|
||||
(string "(" (munge (get b 0)) " " (emit (get b 1)) ")"))
|
||||
|
|
@ -481,9 +490,16 @@
|
|||
:fn (emit-fn node)
|
||||
# (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)
|
||||
# A def with non-empty reader metadata (^:private / ^Type tag / docstring ->
|
||||
# {:doc}) lowers to def-var-with-meta! so (meta (var x)) sees it (jolt-zikh).
|
||||
:def (cond
|
||||
(get node :no-init)
|
||||
(string "(declare-var! " (chez-str-lit (get node :ns)) " "
|
||||
(chez-str-lit (get node :name)) ")")
|
||||
(jmeta-nonempty? (get node :meta))
|
||||
(string "(def-var-with-meta! " (chez-str-lit (get node :ns)) " "
|
||||
(chez-str-lit (get node :name)) " " (emit (get node :init)) " "
|
||||
(emit-quoted (get node :meta)) ")")
|
||||
(string "(def-var! " (chez-str-lit (get node :ns)) " "
|
||||
(chez-str-lit (get node :name)) " " (emit (get node :init)) ")"))
|
||||
(errorf "emit: unhandled op %p" (get node :op)))))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(each f ["host/chez/emit.janet" "host/chez/driver.janet" "host/chez/rt.ss"
|
||||
"host/chez/values.ss" "host/chez/collections.ss" "host/chez/seq.ss"
|
||||
"host/chez/atoms.ss" "host/chez/predicates.ss" "host/chez/regex.ss"
|
||||
"host/chez/ns.ss" "host/chez/post-prelude.ss"]
|
||||
"host/chez/ns.ss" "host/chez/post-prelude.ss" "host/chez/natives-meta.ss"]
|
||||
(array/push parts (slurp f)))
|
||||
(string/slice (string (hash (string/join parts))) 0))
|
||||
|
||||
|
|
|
|||
|
|
@ -12,6 +12,13 @@
|
|||
(define (jolt-meta x)
|
||||
(cond
|
||||
((symbol-t? x) (let ((m (symbol-t-meta x))) (if (jolt-nil? m) jolt-nil m)))
|
||||
;; a var's meta is {:ns :name} (derived from the cell) + any def-time user
|
||||
;; meta from rt.ss's var-meta-table (jolt-zikh).
|
||||
((var-cell? x)
|
||||
(let ((user (hashtable-ref var-meta-table x #f)))
|
||||
(jolt-assoc (if user user (jolt-hash-map))
|
||||
jolt-kw-var-ns (var-cell-ns x)
|
||||
jolt-kw-var-name (var-cell-name x))))
|
||||
((or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x) (jrec? x) (procedure? x))
|
||||
(hashtable-ref meta-table x jolt-nil))
|
||||
(else jolt-nil)))
|
||||
|
|
|
|||
|
|
@ -82,6 +82,16 @@
|
|||
;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the
|
||||
;; return, so this is transparent there.
|
||||
(define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c))
|
||||
;; var def-time metadata (jolt-zikh): the :def emit passes the def's reader meta
|
||||
;; (^:private / ^Type tag / docstring -> {:doc}) here, stored in an eq side-table
|
||||
;; keyed by the cell. jolt-meta (natives-meta.ss) merges it onto {:ns :name},
|
||||
;; which it derives from the cell — so EVERY var (plain def, native-op, declare)
|
||||
;; reports {:ns :name} like Clojure, with the user meta layered on when present.
|
||||
(define var-meta-table (make-eq-hashtable))
|
||||
(define jolt-kw-var-ns (keyword #f "ns"))
|
||||
(define jolt-kw-var-name (keyword #f "name"))
|
||||
(define (def-var-with-meta! ns name v m)
|
||||
(let ((c (def-var! ns name v))) (hashtable-set! var-meta-table c m) c))
|
||||
;; 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. Returns the cell either way.
|
||||
|
|
|
|||
45
test/chez/_var_meta.janet
Normal file
45
test/chez/_var_meta.janet
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
# jolt-zikh — var def-time metadata capture (^:private / ^Type tag / docstring).
|
||||
# (meta (var v)) must carry the def-time reader metadata + :ns/:name, matching the
|
||||
# JVM-canonical build/jolt. TDD harness: bin/jolt-chez -e per case, last line ==
|
||||
# expected.
|
||||
#
|
||||
# janet test/chez/_var_meta.janet
|
||||
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
|
||||
|
||||
(def cases
|
||||
# NOTE: ^{:map} metadata on a def name (e.g. (def ^{:doc "hi"} dv 1)) reads as
|
||||
# (def (with-meta name m) v) and is uncompilable for the COMPILER generally
|
||||
# (analyzer.clj rejects it; the Janet back end punts to its interpreter, which
|
||||
# Chez lacks) — out of subset, not a meta-capture gap. Shorthand ^:kw / ^Type
|
||||
# and the docstring form keep the name a plain symbol, so they're in scope.
|
||||
[["^:private on var" "(do (def ^:private pv 1) (:private (meta (var pv))))" "true"]
|
||||
["^Type tag on var" "(do (def ^String tv \"a\") (:tag (meta (var tv))))" "String"]
|
||||
["(def name doc val)" "(do (def dv2 \"hi\" 1) (:doc (meta (var dv2))))" "hi"]
|
||||
["meta carries :name" "(do (def mv 1) (:name (meta (var mv))))" "mv"]
|
||||
["meta carries :ns" "(do (def nv 1) (:ns (meta (var nv))))" "user"]
|
||||
["plain def: no user meta" "(do (def pl 1) (nil? (:private (meta (var pl)))))" "true"]])
|
||||
|
||||
(defn run-capture [expr]
|
||||
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
|
||||
(def out (ev/read (proc :out) 0x100000))
|
||||
(def err (ev/read (proc :err) 0x100000))
|
||||
(def code (os/proc-wait proc))
|
||||
(def lines (filter (fn [l] (not (empty? l)))
|
||||
(string/split "\n" (string/trim (if out (string out) "")))))
|
||||
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
|
||||
|
||||
(var pass 0)
|
||||
(def fails @[])
|
||||
(each [label expr expected] cases
|
||||
(def [code got err] (run-capture expr))
|
||||
(cond
|
||||
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
|
||||
(= got expected) (++ pass)
|
||||
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
|
||||
|
||||
(printf "\n_var_meta parity [%s]: %d/%d passed" jolt-bin pass (length cases))
|
||||
(when (> (length fails) 0)
|
||||
(printf "%d FAIL(s):" (length fails))
|
||||
(each [l m] fails (printf " FAIL [%s] %s" l m)))
|
||||
(flush)
|
||||
(os/exit (if (empty? fails) 0 1))
|
||||
|
|
@ -69,14 +69,9 @@
|
|||
"defmethod overrides a record, top level" true
|
||||
"defmethod fires nested in a map" true
|
||||
"defmethod fires through prn" true
|
||||
"methods table inspectable" true
|
||||
# Phase 2 inc I (jolt-n7rz) made (var x)/#'x emit + the static var ops run; a
|
||||
# var's def-time metadata (^:private / ^Type tag / docstring) isn't captured on
|
||||
# the Chez var-cell yet, so (meta (var v)) is nil — var-metadata capture is a
|
||||
# later increment.
|
||||
"^:private on var" true
|
||||
"^Type tag on var" true
|
||||
"(def name doc val) doc" true})
|
||||
# var def-time metadata (^:private / ^Type tag / docstring) is now captured on
|
||||
# the Chez var-cell (jolt-zikh), so those three cases pass.
|
||||
"methods table inspectable" true})
|
||||
|
||||
(def ctx (d/make-ctx))
|
||||
|
||||
|
|
@ -190,8 +185,11 @@
|
|||
# jolt-yxqm (namespace value model — find-ns/ns-name/all-ns/resolve/ns-publics/
|
||||
# in-ns/*ns* over the var-table + a jns ns value; native-op var cells so
|
||||
# (resolve '+) is a var; *ns* bound to the user ns) 1969.
|
||||
# jolt-zikh (var def-time metadata — :def emit passes reader meta to
|
||||
# def-var-with-meta!; (meta (var v)) is {:ns :name} + ^:private/^Type tag/
|
||||
# docstring) 1972.
|
||||
# Strided runs scale down.
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1969")))
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1972")))
|
||||
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
|
||||
(when (or (> (length diverged) 0) (< pass floor))
|
||||
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue