From 97f07cf40fe58ff71859205a764fc6c892e44e46 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 29 Jun 2026 23:15:12 +0000 Subject: [PATCH] host: rel-kinds is a boot-populated VALUE, loads unrolled (live JIT iteration bug) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The serving-mode JIT dropped 3 of 4 relations when host/blog-rel-kinds map/for-each'd a function-produced list (only the first survived) — so only one relation editor rendered live. Restore slice 1's working shape: host/blog-rel-kinds is a VALUE the boot populates (set! in load-rel-kinds!), and both the cache loads and the list build are UNROLLED (no iteration over the relation list). Metadata still lives on the relation-posts. conformance 287/287. Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 38 +++++++++++++++++++++++--------------- lib/host/tests/blog.sx | 2 +- 2 files changed, 24 insertions(+), 16 deletions(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index e9c54e03..28945eca 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -102,23 +102,31 @@ ;; rel-kinds / kind-symmetric? then read the cache (pure); the relation-posts stay ;; the durable source of truth. host/blog-load-rel-kinds! re-reads them. (define host/blog--rel-cache (dict)) -;; the relation slugs — a small fixed set. (Enumerating them from the graph via -;; host/blog-in "relation" "is-a" proved fragile on the live store: that reduce over -;; ALL edges returned a partial set. A static list is deterministic; the metadata -;; still lives on the relation-posts. Add a relation here + a seed-rel! call.) -(define host/blog--rel-slugs (fn () (list "related" "is-a" "subtype-of" "tagged"))) +;; cache one relation-post's :rel metadata (+ :kind), keyed by slug. +(define host/blog--cache-rel! + (fn (kind) + (let ((m (get (host/blog-get kind) :rel))) + (when m (dict-set! host/blog--rel-cache kind (merge {:kind kind} m)))))) +;; host/blog-rel-kinds is a VALUE (the list of relation specs), populated at boot by +;; load-rel-kinds! — like slice 1's static registry, which mapped fine on the live +;; serving JIT. (Computing it as a function that map/for-each-es a function-produced +;; list silently lost 3 of 4 relations on the live JIT — see plans/relations-as-posts.md +;; / plans/jit-bytecode-correctness.md. Both the cache loads and the list build are +;; therefore UNROLLED — no iteration over the relation list.) Metadata still lives on +;; the relation-posts; add a relation = a seed-rel! + a line in each unrolled list. +(define host/blog-rel-kinds (list)) (define host/blog-load-rel-kinds! (fn () - (for-each - (fn (kind) - (let ((m (get (host/blog-get kind) :rel))) - (when m (dict-set! host/blog--rel-cache kind (merge {:kind kind} m))))) - (host/blog--rel-slugs)))) + (begin + (host/blog--cache-rel! "related") + (host/blog--cache-rel! "is-a") + (host/blog--cache-rel! "subtype-of") + (host/blog--cache-rel! "tagged") + (set! host/blog-rel-kinds + (list (get host/blog--rel-cache "related") (get host/blog--rel-cache "is-a") + (get host/blog--rel-cache "subtype-of") (get host/blog--rel-cache "tagged")))))) ;; spec = the cached :rel metadata + :kind; nil for a non-relation (relate validates). (define host/blog--kind-spec (fn (kind) (get host/blog--rel-cache kind))) -(define host/blog-rel-kinds - (fn () (filter (fn (s) (not (nil? s))) - (map host/blog--kind-spec (host/blog--rel-slugs))))) (define host/blog--kind-symmetric? (fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric))))) @@ -758,7 +766,7 @@ ;; false: the initial edit page renders empty pickers (the load trigger fills ;; each), keeping this render cheap. The relate/unrelate FRAGMENT passes true. (map (fn (spec) (host/blog--relation-editor slug (get spec :kind) false)) - (host/blog-rel-kinds))))) + host/blog-rel-kinds)))) ;; ── read handlers ─────────────────────────────────────────────────── ;; Post body is rendered per-block (a guarded HTML string) then injected raw. @@ -972,7 +980,7 @@ (begin (for-each (fn (o) (host/blog-unrelate! slug o kind)) (host/blog-out slug kind)) (for-each (fn (o) (host/blog-unrelate! o slug kind)) (host/blog-in slug kind))))) - (host/blog-rel-kinds)))) + host/blog-rel-kinds))) (define host/blog-delete-handler (fn (req) diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 8c01af5e..7ff9edbe 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -497,7 +497,7 @@ (host-bl-test "an unknown kind has no spec, so relate still validates it away" (host/blog--kind-spec "bogus-kind") nil) (host-bl-test "rel-kinds is DERIVED from the graph (every post that is-a relation)" - (let ((kinds (map (fn (s) (get s :kind)) (host/blog-rel-kinds)))) + (let ((kinds (map (fn (s) (get s :kind)) host/blog-rel-kinds))) (list (contains? kinds "related") (contains? kinds "is-a") (contains? kinds "subtype-of") (contains? kinds "tagged"))) (list true true true true))