;;; regression-named-let-leak.lsp
;;;
;;; Pins two leak shapes that crashed neoblanka on 2026-06-03 when
;;; ecdsa/lumbda/main.lsp ran through ~/git/lumbda/c/lumbda --fast.
;;;
;;; Both shapes share the same root cause: lumbda C tier shipped
;;; without Boehm GC linked, so ul_free was a no-op and every env,
;;; vstack data buffer, and closure leaked. The named-let + inner
;;; user-fn call pattern allocates fast enough to hit kernel oom-killer
;;; in seconds.
;;;
;;; Wrapper at tests/regression-named-let-leak.sh runs this under
;;; ulimit -v + timeout so a memory regression fails the run instead
;;; of consuming all RAM.

(define *pass* 0)
(define *fail* 0)

(define (assert-equal name got expected)
  (if (equal? got expected)
      (begin (set! *pass* (+ *pass* 1))
             (display "PASS: ") (display name) (newline))
      (begin (set! *fail* (+ *fail* 1))
             (display "FAIL: ") (display name)
             (display " got=") (write got)
             (display " expected=") (write expected) (newline))))

;;; ── Shape 1 — c/TODO-named-let-bytecode.md reproducer ─────────

(define (maybe x) (if (> x 3) #f (+ x 1)))
(define (g start)
  (let loop ((t start))
    (let ((next (maybe t)))
      (if next (loop next) t))))
(assert-equal "named-let + inner let + if-tail-call" (g 0) 4)

;;; ── Shape 2 — F1 from ecdsa/docs/lumbda-c-tier-leak-SP.md ────

(define (always-true) #t)
(define (walk1 ops)
  (let loop ((rest ops))
    (if (null? rest)
        #t
        (if (always-true)
            (loop (cdr rest))
            #f))))
(assert-equal "named-let + inner user-fn call per iter (3-list)"
              (walk1 (list 'a 'b 'c)) #t)

;;; ── Shape 3 — same shape, larger N, hits leak harder if present ──

(define (count-down n)
  (let loop ((i n) (sum 0))
    (if (= i 0)
        sum
        (if (always-true)
            (loop (- i 1) (+ sum 1))
            sum))))
(assert-equal "named-let + inner user-fn call, 200-iter" (count-down 200) 200)

;;; ── Shape 4 — emulates ecdsa run-ops! shape on a small list ──

(define state-vec (vector 0 0 0 0 0 0 'running))
(define (st-status v) (vector-ref v 6))
(define (st-ok? v) (eq? (st-status v) 'running))
(define (exec-noop v op) v)
(define (run-ops! v ops)
  (let loop ((rest ops))
    (cond
      ((null? rest) #t)
      ((not (st-ok? v)) #f)
      (else
        (exec-noop v (car rest))
        (loop (cdr rest))))))
(assert-equal "named-let + cond + inner-fn calls (run-ops! shape)"
              (run-ops! state-vec (list 'x 'cx 'ccx 'x 'cx)) #t)

;;; ── Summary ───────────────────────────────────────────────────

(newline)
(display "regression-named-let-leak: pass=") (display *pass*)
(display " fail=") (display *fail*) (newline)
(if (> *fail* 0) (exit 1) (exit 0))
