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.
This commit is contained in:
parent
f0419b560d
commit
b8e4e78372
4 changed files with 54 additions and 4 deletions
|
|
@ -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)) " ") ")")
|
||||
|
|
|
|||
39
host/chez/natives-meta.ss
Normal file
39
host/chez/natives-meta.ss
Normal file
|
|
@ -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)
|
||||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue