From b8e4e78372f530c6f39b3b538c195bcac8688b00 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 18 Jun 2026 12:16:48 -0400 Subject: [PATCH] Chez Phase 2 (inc E): meta / with-meta meta/with-meta resolved to jolt-nil. Chez values don't carry metadata, so collections use an identity-keyed side-table: with-meta returns a fresh copy of the value (new identity) and records its meta there, leaving the original unchanged (immutable-with-meta) and dropping meta on a later copying op. Symbols carry meta in their existing field; meta on a non-metadatable value is nil. vary-meta works over these. with-meta on a fn stays fn? (jolt is lenient). emit.janet carries a quoted symbol's reader metadata (^:foo bar) onto the emitted jolt-symbol so (meta 'x) sees it; symbol = still ignores meta. Prelude parity 1701 -> 1723, 0 new divergences. jolt-rkbc. --- host/chez/emit.janet | 11 ++++++--- host/chez/natives-meta.ss | 39 ++++++++++++++++++++++++++++++ host/chez/rt.ss | 4 +++ test/chez/run-corpus-prelude.janet | 4 ++- 4 files changed, 54 insertions(+), 4 deletions(-) create mode 100644 host/chez/natives-meta.ss diff --git a/host/chez/emit.janet b/host/chez/emit.janet index 25643f9..6eca9ef 100644 --- a/host/chez/emit.janet +++ b/host/chez/emit.janet @@ -201,9 +201,14 @@ (or (nil? form) (boolean? form) (number? form) (string? form) (keyword? form)) (emit-const form) (and (struct? form) (= :symbol (get form :jolt/type))) - (let [ns (get form :ns)] - (string "(jolt-symbol " (if ns (chez-str-lit ns) "#f") " " - (chez-str-lit (get form :name)) ")")) + (let [ns (get form :ns) + m (get form :meta)] + (if (and m (not (nil? m)) (> (length m) 0)) + # carry reader metadata (^:foo bar) onto the quoted symbol so (meta 'x) sees it + (string "(jolt-symbol/meta " (if ns (chez-str-lit ns) "#f") " " + (chez-str-lit (get form :name)) " " (emit-quoted m) ")") + (string "(jolt-symbol " (if ns (chez-str-lit ns) "#f") " " + (chez-str-lit (get form :name)) ")"))) (and (struct? form) (= :jolt/char (get form :jolt/type))) (emit-const form) (and (struct? form) (= :jolt/set (get form :jolt/type))) (string "(jolt-hash-set " (string/join (map emit-quoted (get form :value)) " ") ")") diff --git a/host/chez/natives-meta.ss b/host/chez/natives-meta.ss new file mode 100644 index 0000000..9c25b53 --- /dev/null +++ b/host/chez/natives-meta.ss @@ -0,0 +1,39 @@ +;; metadata (jolt-cf1q.3 Phase 2 inc E) — meta / with-meta. Chez values don't +;; carry metadata, so collections use an identity-keyed side-table: with-meta +;; returns a fresh COPY of the value (new identity) and records its meta there, so +;; the original is unchanged (Clojure's immutable-with-meta) and a copy made by a +;; later op (conj/assoc) drops the meta. Symbols carry meta in their own field. +;; meta on a non-metadatable value (number/string/keyword) is nil. +;; +;; Loaded after records.ss (jrec) + collections/seq/values (the ctors it copies). + +(define meta-table (make-eq-hashtable)) + +(define (jolt-meta x) + (cond + ((symbol-t? x) (let ((m (symbol-t-meta x))) (if (jolt-nil? m) jolt-nil m))) + ((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))) + +;; fresh-identity copy of a metadatable value (so attaching meta doesn't mutate +;; the original). cseq/procedure can't be copied meaningfully — keyed in place. +(define (meta-copy x) + (cond + ((pvec? x) (make-pvec (pvec-v x) (pvec-ent x))) + ((pmap? x) (make-pmap (pmap-root x) (pmap-cnt x))) + ((pset? x) (make-pset (pset-m x))) + ((jrec? x) (make-jrec (jrec-tag x) (jrec-pairs x))) + (else x))) ; cseq / empty-list / procedure + +(define (jolt-with-meta x m) + (cond + ((symbol-t? x) (make-symbol-t (symbol-t-ns x) (symbol-t-name x) m)) + ((or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x) (jrec? x) (procedure? x)) + (let ((c (meta-copy x))) + (if (jolt-nil? m) (hashtable-delete! meta-table c) (hashtable-set! meta-table c m)) + c)) + (else (error #f "with-meta: value does not support metadata" x)))) + +(def-var! "clojure.core" "meta" jolt-meta) +(def-var! "clojure.core" "with-meta" jolt-with-meta) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index cf4ad84..10227b9 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -193,6 +193,10 @@ ;; transients). (load "host/chez/records.ss") +;; metadata (jolt-rkbc, Phase 2 inc E): meta / with-meta over an identity-keyed +;; side-table. After records.ss (jrec) + the collection ctors it copies. +(load "host/chez/natives-meta.ss") + ;; dynamic vars (jolt-9ls5): *clojure-version* / *unchecked-math* constants the seed ;; binds natively. After collections.ss (jolt-hash-map) + def-var!. (load "host/chez/dynamic-vars.ss") diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 52ac687..f52e1aa 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -163,8 +163,10 @@ # Phase 2 inc D (jolt-jgoc: records + protocols — defrecord/deftype/defprotocol/ # extend-type/reify; jrec type + protocol registry/dispatch; emit routes record # .method dot-calls to runtime dispatch) 1701. +# Phase 2 inc E (jolt-rkbc: meta / with-meta over an identity-keyed side-table + +# symbol reader-meta carried through quote emit) 1723. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1701"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1723"))) (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)))