otel P1: span model + API (with-span, parent stack, ring buffer)

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/host/conformance.sh

@@ -99,6 +99,7 @@ MODULES=(
   "lib/host/page.sx"
   "lib/host/server.sx"
   "lib/host/ledger.sx"
+  "lib/host/otel.sx"
 )
 
 # Suites: NAME RUNNER-FN PATH
@@ -117,6 +118,7 @@ SUITES=(
   "page        host-pg-tests-run!  lib/host/tests/page.sx"
   "server      host-sv-tests-run!  lib/host/tests/server.sx"
   "ledger      host-lg-tests-run!  lib/host/tests/ledger.sx"
+  "otel        host-ot-tests-run!  lib/host/tests/otel.sx"
 )
 
 # Filter to a single suite if a name was given (filter the array itself so its

lib/host/otel.sx

@@ -0,0 +1,89 @@
+;; lib/host/otel.sx — OpenTelemetry in SX, P1: the span model + API.
+;;
+;; A TRACE is a COMPOSITION: a span is {:trace :span :parent :name :t0 :t1 :attrs
+;; :events}, so a trace is a tree of spans (the same shape as an object's :body
+;; composition). Later phases fold that tree into a waterfall (render-fold), OTLP
+;; JSON (export-fold) and metrics (aggregate-fold). This phase gives us the model,
+;; the dynamic parent stack that builds the tree, and a bounded in-memory ring
+;; buffer — spans are cheap timed effects, NOT durable KV rows.
+
+;; ── monotonic id + clock ─────────────────────────────────────────────
+;; A simple process-monotonic counter gives collision-free ids without needing a
+;; random source (Math.random/Date.now aren't available on this host). now-ns is a
+;; placeholder tick here (monotonic non-decreasing); P2 wraps the real host clock.
+(define otel/-id-counter 0)
+(define otel/-next-id
+  (fn (prefix)
+    (begin
+      (set! otel/-id-counter (+ otel/-id-counter 1))
+      (str prefix otel/-id-counter))))
+(define otel/gen-trace-id (fn () (otel/-next-id "trace-")))
+(define otel/gen-span-id  (fn () (otel/-next-id "span-")))
+
+(define otel/-clock 0)
+(define otel/now-ns
+  (fn ()
+    (begin
+      (set! otel/-clock (+ otel/-clock 1))
+      otel/-clock)))
+
+;; ── the dynamic parent stack ─────────────────────────────────────────
+;; head = the innermost (current) span context {:span id :trace id}. Pushing on
+;; with-span entry / popping on exit is what turns lexical nesting into parent
+;; links, so a trace tree falls out of ordinary call nesting.
+(define otel/-stack (list))
+(define otel/-push! (fn (ctx) (set! otel/-stack (cons ctx otel/-stack))))
+(define otel/-pop!  (fn () (set! otel/-stack (rest otel/-stack))))
+(define otel/-top   (fn () (if (= (len otel/-stack) 0) nil (first otel/-stack))))
+
+(define otel/current-span
+  (fn () (let ((t (otel/-top))) (if t (get t :span) nil))))
+(define otel/current-trace
+  (fn () (let ((t (otel/-top))) (if t (get t :trace) nil))))
+
+;; ── the bounded ring buffer ──────────────────────────────────────────
+;; Oldest → newest. record! appends and drops from the front once over cap, so the
+;; buffer stays O(cap) no matter how many spans flow through. NOT persisted.
+(define otel/-cap 1000)
+(define otel/-ring (list))
+(define otel/set-cap! (fn (n) (begin (set! otel/-cap n) nil)))
+
+(define otel/record!
+  (fn (span)
+    (begin
+      (set! otel/-ring (append otel/-ring (list span)))
+      (if (> (len otel/-ring) otel/-cap)
+        (set! otel/-ring (slice otel/-ring (- (len otel/-ring) otel/-cap)))
+        nil)
+      span)))
+
+(define otel/recent (fn () otel/-ring))
+
+;; Clear the ring AND the parent stack — used between tests / requests.
+(define otel/reset!
+  (fn ()
+    (begin
+      (set! otel/-ring (list))
+      (set! otel/-stack (list))
+      nil)))
+
+;; ── with-span: the timed-effect combinator ───────────────────────────
+;; Records a span around (thunk): a fresh span id, the trace inherited from the
+;; enclosing span (or a new trace at the root), the enclosing span as :parent, and
+;; t0/t1 straddling the call. Pushes its context so nested with-spans see it as
+;; parent, pops after, then records the finished span. Returns the thunk's value.
+(define otel/with-span
+  (fn (name attrs thunk)
+    (let ((parent-ctx (otel/-top)))
+      (let ((trace  (if parent-ctx (get parent-ctx :trace) (otel/gen-trace-id)))
+            (span   (otel/gen-span-id))
+            (parent (if parent-ctx (get parent-ctx :span) nil)))
+        (let ((t0 (begin (otel/-push! {:span span :trace trace}) (otel/now-ns))))
+          (let ((result (thunk)))
+            (let ((t1 (otel/now-ns)))
+              (begin
+                (otel/-pop!)
+                (otel/record!
+                  {:trace trace :span span :parent parent :name name
+                   :t0 t0 :t1 t1 :attrs attrs :events (list)})
+                result))))))))

lib/host/tests/otel.sx

@@ -0,0 +1,74 @@
+;; lib/host/tests/otel.sx — P1: span model + API. A span dict
+;; {:trace :span :parent :name :t0 :t1 :attrs :events}; otel/with-span records
+;; t0/t1 and pushes/pops a dynamic parent stack so nesting builds the tree; a
+;; bounded ring buffer (record!/recent, cap, drop-oldest); current-span/current-trace.
+
+(define host-ot-pass 0)
+(define host-ot-fail 0)
+(define host-ot-fails (list))
+
+(define
+  host-ot-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-ot-pass (+ host-ot-pass 1))
+      (begin
+        (set! host-ot-fail (+ host-ot-fail 1))
+        (append! host-ot-fails {:name name :actual actual :expected expected})))))
+
+;; ── nested with-span builds the parent tree ─────────────────────────
+(otel/reset!)
+(otel/with-span "root" {}
+  (fn () (otel/with-span "child" {} (fn () 42))))
+
+(define host-ot-sp (otel/recent))
+(define host-ot-child (first host-ot-sp))   ;; inner span completes+records first
+(define host-ot-root (nth host-ot-sp 1))
+
+(host-ot-test "two spans recorded" (len host-ot-sp) 2)
+(host-ot-test "child name" (get host-ot-child :name) "child")
+(host-ot-test "root name" (get host-ot-root :name) "root")
+(host-ot-test "child parent is root span" (get host-ot-child :parent) (get host-ot-root :span))
+(host-ot-test "root has no parent" (get host-ot-root :parent) nil)
+(host-ot-test "same trace" (= (get host-ot-child :trace) (get host-ot-root :trace)) true)
+(host-ot-test "root t1 >= t0" (>= (get host-ot-root :t1) (get host-ot-root :t0)) true)
+(host-ot-test "root has attrs" (get host-ot-root :attrs) {})
+(host-ot-test "root has events list" (get host-ot-root :events) (list))
+
+;; ── attrs are carried through ───────────────────────────────────────
+(otel/reset!)
+(otel/with-span "req" {:http.method "GET" :http.route "/feed"} (fn () nil))
+(host-ot-test "attrs carried"
+  (get (get (first (otel/recent)) :attrs) :http.method) "GET")
+
+;; ── current-span / current-trace track the dynamic stack ────────────
+(otel/reset!)
+(host-ot-test "no current span outside" (otel/current-span) nil)
+(host-ot-test "no current trace outside" (otel/current-trace) nil)
+(otel/with-span "x" {}
+  (fn ()
+    (begin
+      (host-ot-test "current span set inside" (not (= (otel/current-span) nil)) true)
+      (host-ot-test "current trace set inside" (not (= (otel/current-trace) nil)) true)
+      nil)))
+(host-ot-test "no current span after" (otel/current-span) nil)
+
+;; ── ring buffer caps at N, drops oldest ─────────────────────────────
+(otel/reset!)
+(otel/set-cap! 3)
+(for-each (fn (i) (otel/record! {:span i :name "s"})) (list 1 2 3 4 5))
+(host-ot-test "ring capped at 3" (len (otel/recent)) 3)
+(host-ot-test "oldest dropped" (get (first (otel/recent)) :span) 3)
+(host-ot-test "newest kept" (get (last (otel/recent)) :span) 5)
+(otel/set-cap! 1000)
+
+(define
+  host-ot-tests-run!
+  (fn
+    ()
+    {:total (+ host-ot-pass host-ot-fail)
+     :passed host-ot-pass
+     :failed host-ot-fail
+     :fails host-ot-fails}))