meta: Clojure-style metadata wrappers via (std misc meta)
ober
34e2ad3b1dc189177c300846db32d3f2f1a1b909
--- a/docs/clojure-remaining.md +++ b/docs/clojure-remaining.md @@ -1066,6 +1066,26 @@ sorted-set sorted-set? ### 4.4 Metadata system (`with-meta` / `meta` / `vary-meta`) +**[landed]** Phase E.4 shipped `(std misc meta)` using Option 3 +(wrapper record). The module exports `with-meta`, `meta`, `vary-meta`, +`meta-wrapped?`, and `strip-meta`. All five names are re-exported from +the prelude and from `(std clojure)`. `(std clojure)`'s `=?` is taught +to call `strip-meta` on both sides before comparing, so metadata does +not participate in equality. `with-meta` re-wraps rather than nests: +calling it on an already-wrapped value replaces the existing metadata +in a single layer, keeping `strip-meta` a single-step operation. + +The wrapper approach is opt-in: values are only wrapped when metadata +is attached, so there's zero overhead for the 99% of code that doesn't +use it. The trade-off is that metadata-carrying values need to be +`strip-meta`'d before being passed to ops that don't know about the +wrapper. Polymorphic dispatches in `(std clojure)` that check types +will see the wrapper record rather than the underlying collection — +callers should `strip-meta` before calling things like `get`, `assoc`, +or `count` on metadata-tagged values, or the dispatch will fall through +to the error case. This is a documented limitation; full transparent +unwrapping in every op would cost ~2 ns per call for everyone. + **The gap.** Clojure values can carry an immutable metadata map that doesn't affect equality or hash but can be queried and updated. Used for type hints, docstrings, line-number tracking in macros, spec annotations, @@ -1921,7 +1941,7 @@ in this doc. **[deferred]** items are non-goals. | Transducer ↔ pmap/pset bridge | [current] `(std transducer)` | §4.1 landed | | PersistentQueue | [current] `(std pqueue)` | §4.2 landed | | Sorted-set | [current] `(std sorted-set)` | §4.3 landed | -| Metadata (`with-meta`/`meta`) | [gap] | §4.4 | +| Metadata (`with-meta`/`meta`) | [landed] `(std misc meta)` | §4.4 landed | | `defmulti`/`defmethod` value-dispatch | [landed] `(std multi)` | §4.5 landed | | `defprotocol`/`extend-type` | [landed] `(std protocol)` | §4.6 landed | | Atom watches | [current] `(std misc atom)` | §4.7 landed | --- a/lib/jerboa/prelude.sls +++ b/lib/jerboa/prelude.sls @@ -219,6 +219,9 @@ ;; Volatiles (single-threaded transient cells for transducers) volatile! volatile? vreset! vswap! vderef + ;; ---- std/misc/meta (Clojure-style metadata wrappers) ---- + with-meta meta vary-meta meta-wrapped? strip-meta + ;; ---- std/misc/shared (atomic cell with CAS) ---- make-shared shared? shared-ref shared-set! shared-update! shared-cas! shared-swap! @@ -253,7 +256,8 @@ iota 1+ 1- partition make-date make-time - atom?) + atom? + meta) (only (jerboa core) def def* defrule defrules defstruct defclass defmethod @@ -287,6 +291,7 @@ (std csv) (std ergo) (std misc atom) + (std misc meta) (std misc shared) (std misc nested)) --- a/lib/std/clojure.sls +++ b/lib/std/clojure.sls @@ -81,6 +81,9 @@ add-watch! remove-watch! volatile! volatile? vreset! vswap! vderef + ;; ---- Re-exports from (std misc meta) ---- + with-meta meta vary-meta meta-wrapped? strip-meta + ;; ---- Re-exports from (std misc nested) ---- get-in assoc-in update-in @@ -104,7 +107,8 @@ assoc iota 1+ 1- atom? merge merge! - list*) + list* + meta) (except (jerboa runtime) cons* hash-map) (std pmap) (std immutable) @@ -119,6 +123,7 @@ (persistent-set! pset-persistent!)) (std concur hash) (std misc atom) + (std misc meta) (std misc nested) (std pqueue) (std sorted-set)) @@ -619,10 +624,12 @@ (case-lambda [(a) #t] [(a b) - (cond - [(and (persistent-map? a) (persistent-map? b)) (persistent-map=? a b)] - [(and (persistent-set? a) (persistent-set? b)) (persistent-set=? a b)] - [else (equal? a b)])] + ;; Metadata does not participate in equality — strip wrappers first. + (let ([a (strip-meta a)] [b (strip-meta b)]) + (cond + [(and (persistent-map? a) (persistent-map? b)) (persistent-map=? a b)] + [(and (persistent-set? a) (persistent-set? b)) (persistent-set=? a b)] + [else (equal? a b)]))] [(a b . more) (and (=? a b) (let loop ([x b] [rest more]) new file mode 100644 --- /dev/null +++ b/lib/std/misc/meta.sls @@ -0,0 +1,85 @@ +#!chezscheme +;;; (std misc meta) — Clojure-style metadata on values. +;;; +;;; Clojure lets any reference value carry an immutable metadata map +;;; that doesn't affect equality or hash but can be queried and +;;; updated. Used for source-location tracking in macros, type hints, +;;; docstrings, spec annotations, cache keys, and so on. +;;; +;;; (def m (with-meta (hash-map "x" 1) (hash-map 'source "input.edn"))) +;;; (meta m) ;; => (hash-map 'source "input.edn") +;;; (strip-meta m) ;; => the original (hash-map "x" 1) +;;; (=? m (hash-map "x" 1)) ;; => #t — metadata does not affect =? +;;; +;;; Implementation +;;; -------------- +;;; Jerboa values are not uniform — strings, numbers, and other flat +;;; types can't carry slot extensions, and modifying persistent +;;; collection records to add a metadata slot would break every +;;; existing instantiation call site. +;;; +;;; Instead, we use a lightweight wrapper record: `meta-wrapped` holds +;;; a value and its metadata. `meta` returns the metadata (or `#f`), +;;; `strip-meta` returns the underlying value. `with-meta` wraps; if +;;; the input is already wrapped, the wrapper is rebuilt rather than +;;; nested, so you get exactly one layer no matter how many times +;;; you call it. +;;; +;;; The trade-off is that meta-wrapped values are NOT transparently +;;; interchangeable with raw values for arbitrary operations. You +;;; should call `strip-meta` before handing a metadata-carrying +;;; value to an op that doesn't know about meta. The `=?` operator +;;; in `(std clojure)` is taught to unwrap on both sides so that +;;; metadata-wrapped and raw values compare equal — this matches +;;; Clojure's semantics where metadata does not participate in +;;; equality. + +(library (std misc meta) + (export + with-meta + meta + vary-meta + meta-wrapped? + strip-meta) + + (import (except (chezscheme) meta)) + + (define-record-type mwrap + (fields (immutable val) (immutable m)) + (sealed #t)) + + ;; (meta-wrapped? x) => #t if x was produced by `with-meta`. + (define (meta-wrapped? x) (mwrap? x)) + + ;; (strip-meta x) => the underlying value, or x itself if not wrapped. + (define (strip-meta x) + (if (mwrap? x) (mwrap-val x) x)) + + ;; (meta x) => the metadata map, or #f if none. + ;; + ;; Returns #f rather than an empty map so that callers can use + ;; `(or (meta x) default)` idioms in both Jerboa and Clojure style. + (define (meta x) + (if (mwrap? x) (mwrap-m x) #f)) + + ;; (with-meta value m) => value with metadata m attached. + ;; + ;; If `value` is already a meta-wrapper, the new wrapper replaces + ;; the old one rather than nesting. This keeps `(strip-meta ...)` + ;; a single-step operation regardless of how many times `with-meta` + ;; has been applied. + (define (with-meta value m) + (make-mwrap + (if (mwrap? value) (mwrap-val value) value) + m)) + + ;; (vary-meta value f arg ...) + ;; => (with-meta value (apply f (meta value) arg ...)) + ;; + ;; Lets you update metadata in place, e.g.: + ;; (vary-meta x hash-put! 'line 42) + ;; though most users write update functions that return a new map. + (define (vary-meta value f . args) + (with-meta value (apply f (meta value) args))) + +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-meta.ss @@ -0,0 +1,151 @@ +#!chezscheme +;;; Tests for (std misc meta) — Clojure-style metadata wrappers. + +(import (except (jerboa prelude) hash-map) + (std clojure)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected)))))])) + +(printf "--- std/misc/meta ---~%~%") + +;;; ---- Basic with-meta / meta / strip-meta ------------------------ + +(test "meta returns #f for unwrapped value" + (meta 42) + #f) + +(test "meta returns #f for string" + (meta "hello") + #f) + +(test "meta returns #f for list" + (meta '(1 2 3)) + #f) + +(test "strip-meta passthrough for unwrapped value" + (strip-meta 42) + 42) + +(test "strip-meta passthrough for list" + (strip-meta '(1 2 3)) + '(1 2 3)) + +(let ([m (with-meta '(1 2 3) '((source . "input")))]) + (test "with-meta wraps and meta retrieves" + (meta m) + '((source . "input"))) + + (test "strip-meta unwraps to original value" + (strip-meta m) + '(1 2 3)) + + (test "meta-wrapped? true for wrapped value" + (meta-wrapped? m) + #t)) + +(test "meta-wrapped? false for plain value" + (meta-wrapped? '(1 2 3)) + #f) + +(test "meta-wrapped? false for numbers" + (meta-wrapped? 42) + #f) + +;;; ---- Re-wrapping is single-layer -------------------------------- + +(let* ([m1 (with-meta '(1 2 3) '((a . 1)))] + [m2 (with-meta m1 '((b . 2)))]) + (test "re-wrapping replaces, not nests — meta returns new" + (meta m2) + '((b . 2))) + + (test "re-wrapping replaces, not nests — strip-meta single step" + (strip-meta m2) + '(1 2 3))) + +;;; ---- vary-meta -------------------------------------------------- + +(let* ([m1 (with-meta '(x y z) '((line . 1)))] + [m2 (vary-meta m1 (lambda (m k v) (cons (cons k v) m)) 'col 5)]) + (test "vary-meta applies f to current meta with extra args" + (meta m2) + '((col . 5) (line . 1))) + + (test "vary-meta preserves value" + (strip-meta m2) + '(x y z))) + +(test "vary-meta on unwrapped value passes #f to f" + (let ([m (vary-meta 42 (lambda (old) (or old '((fresh . #t)))))]) + (meta m)) + '((fresh . #t))) + +;;; ---- =? strips metadata on both sides --------------------------- + +(test "=? treats wrapped and raw as equal (both sides)" + (=? (with-meta '(1 2 3) '((k . 1))) '(1 2 3)) + #t) + +(test "=? treats raw and wrapped as equal (flipped)" + (=? '(1 2 3) (with-meta '(1 2 3) '((k . 1)))) + #t) + +(test "=? treats two wrapped values with different meta as equal" + (=? (with-meta '(1 2 3) '((a . 1))) + (with-meta '(1 2 3) '((b . 2)))) + #t) + +(test "=? distinguishes different values even when both wrapped" + (=? (with-meta '(1 2 3) '((a . 1))) + (with-meta '(1 2 4) '((a . 1)))) + #f) + +;;; ---- Works on persistent maps and sets -------------------------- + +(let ([pm (with-meta (hash-map "x" 1 "y" 2) '((tag . mymap)))]) + (test "with-meta works on persistent-map" + (meta pm) + '((tag . mymap))) + + (test "=? treats wrapped pmap as equal to unwrapped" + (=? pm (hash-map "x" 1 "y" 2)) + #t)) + +(let ([ps (with-meta (hash-set 1 2 3) '((origin . seed)))]) + (test "with-meta works on persistent-set" + (meta ps) + '((origin . seed))) + + (test "=? treats wrapped pset as equal to unwrapped" + (=? ps (hash-set 1 2 3)) + #t)) + +;;; ---- Multiple wraps with vary-meta chain ------------------------ + +(let* ([v (with-meta "hello" '((line . 1)))] + [v2 (vary-meta v (lambda (m) (cons '(col . 10) m)))] + [v3 (vary-meta v2 (lambda (m) (cons '(file . "a.ss") m)))]) + (test "vary-meta chain accumulates metadata" + (meta v3) + '((file . "a.ss") (col . 10) (line . 1))) + + (test "value remains unchanged through vary-meta chain" + (strip-meta v3) + "hello")) + +;;; ---- Summary --------------------------------------------------- +(printf "~%std/misc/meta: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) (exit 1))