otel P8: W3C traceparent propagation + error spans

otel/format-traceparent + otel/current-traceparent emit '00-<32hex>-<16hex>-01';
otel/parse-traceparent round-trips it (nil on malformed/bad-width). otel/-timed
now guards the thunk: success spans get :status ok, a raised error records a
span with :status error + an exception event then propagates. Error propagation
uses a false-returning guard clause test (an explicit (raise e) in a guard
handler re-enters the guard and hangs).

lib/host/otel.sx

@@ -87,16 +87,30 @@
             (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 (merge attrs (finalize result))
-                   :events (list)})
-                result))))))))
+          ;; guard the body: on a raise, pop + record an ERROR span (status +
+          ;; exception event) as a SIDE EFFECT in a clause test that returns false,
+          ;; so the condition auto-propagates to the outer handler. (An explicit
+          ;; `(raise e)` inside a guard handler re-enters this guard and hangs.)
+          (guard (e ((begin
+                       (let ((t1 (otel/now-ns)))
+                         (begin
+                           (otel/-pop!)
+                           (otel/record!
+                             {:trace trace :span span :parent parent :name name
+                              :t0 t0 :t1 t1 :status "error" :attrs attrs
+                              :events (list {:name "exception" :time t1 :message (str e)})})))
+                       false)
+                     nil))
+            (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 :status "ok"
+                     :attrs (merge attrs (finalize result))
+                     :events (list)})
+                  result)))))))))
 
 ;; with-span — a plain timed span; no result-derived attrs.
 (define otel/with-span
@@ -462,3 +476,34 @@
        :url endpoint
        :headers {:content-type "application/json"}
        :body (otel/export-otlp-json spans)})))
+
+;; ── P8: W3C traceparent context propagation ───────────────────────────
+;; traceparent = "<version>-<trace-id>-<parent-id>-<flags>" (RFC: version 00,
+;; trace-id 32 hex, parent-id 16 hex, flags 2 hex; low bit = sampled). Emitting it
+;; on outbound inter-service calls and parsing it on inbound requests lets ONE
+;; trace span multiple services. Our internal ids hex-encode via the OTLP helpers.
+(define otel/format-traceparent
+  (fn (trace-id span-id)
+    (str "00-" (otel/-trace-hex trace-id) "-" (otel/-span-hex span-id) "-01")))
+
+;; the traceparent for the CURRENT span (nil outside any span) — for outbound calls.
+(define otel/current-traceparent
+  (fn ()
+    (let ((t (otel/-top)))
+      (if (nil? t) nil (otel/format-traceparent (get t :trace) (get t :span))))))
+
+;; parse an inbound traceparent → {:version :trace-id :parent-id :flags :sampled};
+;; nil if absent or malformed (wrong field count / hex widths).
+(define otel/parse-traceparent
+  (fn (header)
+    (if (or (nil? header) (= header ""))
+      nil
+      (let ((parts (split header "-")))
+        (if (= (len parts) 4)
+          (let ((ver (nth parts 0)) (tid (nth parts 1))
+                (pid (nth parts 2)) (flags (nth parts 3)))
+            (if (and (= (len tid) 32) (= (len pid) 16))
+              {:version ver :trace-id tid :parent-id pid :flags flags
+               :sampled (not (= flags "00"))}
+              nil))
+          nil)))))