; Latency-distribution bench fixture — explicit-mode variant.
;
; Companion to bench_latency_implicit. Same algorithm, with
; `(borrow T)` / `(own T)` annotations so that under --alloc=rc the
; codegen emits proper inc/dec instrumentation: the persistent tree
; cache is borrowed (no inc/dec on pin_root's hot path), the per-op
; IntList is owned by sum_list (param drop at fn return frees the
; chain). The drop-iterative annotation on IntList keeps the per-op
; deallocation O(1)-stack regardless of list length.
;
; This is the "RC-fair" arm of the latency bench; together with
; bench_latency_implicit (under --alloc=gc) it tests the hypothesis
; "Boehm has unbounded p99 per-operation latency under continuous
; alloc pressure with a large persistent live working set; RC under
; explicit-mode has p99 within a small constant factor of the
; median".
;
; Workload (must match bench_latency_implicit's parameters exactly
; for the comparison to be fair):
;   - Live cache: balanced binary tree of depth 19 (524_287 nodes,
;     ~16 MB), borrowed throughout the loop.
;   - Per-op: build a CHUNK_LEN-cell IntList of 0..CHUNK_LEN-1, sum
;     it, drop it. CHUNK_LEN, NUM_OPS, PRINT_K hardcoded to match
;     the implicit variant.
;   - Same stdout shape: one READY (8888), N_PRINT timing markers
;     each containing the per-op sum (validatable, always equal),
;     one DONE (9999).

(module bench_latency_explicit

  (data Tree
    (doc "Balanced binary tree, 32-byte cells. Borrowed across the bench loop; tree-depth recursion at scope close is bounded (depth 19) so no drop-iterative needed.")
    (ctor TLeaf)
    (ctor TNode (con Int) (con Tree) (con Tree)))

  (data IntList
    (doc "Singly-linked Int list. Per-op chains are CHUNK_LEN long; (drop-iterative) keeps Own-param drop O(1) stack regardless of length.")
    (ctor LNil)
    (ctor LCons (con Int) (con IntList))
    (drop-iterative))

  ; ---------- Live cache: balanced tree of given depth ----------

  (fn build_tree
    (doc "Build a balanced tree of given depth, every value = 1. Returns owned Tree; main holds it across the loop and the final drop fires at main's scope close.")
    (type
      (fn-type
        (params (con Int))
        (ret (own (con Tree)))))
    (params depth)
    (body
      (if (app == depth 0)
        (term-ctor Tree TLeaf)
        (term-ctor Tree TNode
          1
          (app build_tree (app - depth 1))
          (app build_tree (app - depth 1))))))

  (fn pin_root
    (doc "Constant-time tree liveness pin — read root tag, return 1 (TNode) or 0 (TLeaf). Borrows t so the persistent cache is not inc/dec'd on every op.")
    (type
      (fn-type
        (params (borrow (con Tree)))
        (ret (con Int))))
    (params t)
    (body
      (match t
        (case (pat-ctor TLeaf) 0)
        (case (pat-ctor TNode v l r) 1))))

  ; ---------- Per-op work: build/sum an N-cell list ----------

  (fn cons_n_acc
    (doc "Tail-recursive list builder. Returns owned chain; caller is sum_list which owns and drops it.")
    (type
      (fn-type
        (params (con Int) (own (con IntList)))
        (ret (own (con IntList)))))
    (params n acc)
    (body
      (if (app == n 0)
        acc
        (tail-app cons_n_acc
          (app - n 1)
          (term-ctor IntList LCons (app - n 1) acc)))))

  (fn cons_n
    (doc "Build [0,1,...,n-1] :: IntList. Returns owned chain.")
    (type
      (fn-type
        (params (con Int))
        (ret (own (con IntList)))))
    (params n)
    (body
      (app cons_n_acc n (term-ctor IntList LNil))))

  (fn sum_list_acc
    (doc "Tail-recursive sum. Owns xs; consumes it via the LCons arm's t binder (move-into-tail-call).")
    (type
      (fn-type
        (params (own (con IntList)) (con Int))
        (ret (con Int))))
    (params xs acc)
    (body
      (match xs
        (case (pat-ctor LNil) acc)
        (case (pat-ctor LCons h t)
          (tail-app sum_list_acc t (app + acc h))))))

  (fn sum_list
    (doc "Sum every element. Owns xs, hands it to sum_list_acc which consumes it.")
    (type
      (fn-type
        (params (own (con IntList)))
        (ret (con Int))))
    (params xs)
    (body
      (app sum_list_acc xs 0)))

  (fn one_op
    (doc "One bench operation: build+sum a fresh CHUNK_LEN-cell list, pin the tree's root, return their sum so the value chain stays observable. Tree is borrowed; no inc/dec on the hot path against the persistent cache.")
    (type
      (fn-type
        (params (con Int) (borrow (con Tree)))
        (ret (con Int))))
    (params chunk_len t)
    (body
      (app + (app sum_list (app cons_n chunk_len)) (app pin_root t))))

  ; ---------- Bench loop ----------

  (fn loop
    (doc "Tail-recursive bench loop. Tree is borrowed across all iterations.")
    (type
      (fn-type
        (params (con Int) (con Int) (con Int) (con Int) (borrow (con Tree)))
        (ret (con Unit))
        (effects IO)))
    (params remaining print_countdown chunk_len print_k t)
    (body
      (if (app == remaining 0)
        (do io/print_int 9999)
        (if (app == print_countdown 0)
          (seq
            (do io/print_int (app one_op chunk_len t))
            (tail-app loop
              (app - remaining 1)
              (app - print_k 1)
              chunk_len
              print_k
              t))
          (let _v (app one_op chunk_len t)
            (tail-app loop
              (app - remaining 1)
              (app - print_countdown 1)
              chunk_len
              print_k
              t))))))

  (fn main
    (doc "Top-level: build tree, signal READY (8888), run loop, signal DONE (9999 emitted by loop).")
    (type (fn-type (params) (ret (con Unit)) (effects IO)))
    (params)
    (body
      (let t (app build_tree 19)
        (let _root (app pin_root t)
          (seq
            (do io/print_int 8888)
            (app loop 20000 0 500 20 t)))))))