;;;; Conditions where the program has not started yet, and the defer that has
;;;; not registered yet.
;;;;
;;;; The report that opened this file said handler-case segfaults in a global
;;;; initialiser. It does not, and the top half here is what says so: all three
;;;; condition forms run in that position, before main, and answer the same
;;;; numbers they would answer anywhere. §5 of spec-conditions.md is not
;;;; suspended at startup, because an initialiser is a call from main and not a
;;;; constructor the loader runs.
;;;;
;;;; What did crash was underneath, and had nothing to do with startup:
;;;;
;;;;     (defn read-file [path string] dyn
;;;;       (let [src (slurp path (heap-allocator))]
;;;;         (defer (free src))
;;;;         (read (as-slice src))))
;;;;
;;;; `slurp` signals FileError and the handler further out unwinds. The
;;;; transfer leaves this frame through its defers — and `src` was never
;;;; written, because the form that would have written it is the one that
;;;; transferred. `free` then read whatever the stack held under that slot,
;;;; which at -O0 in a small program is zero and at -O2 is a pointer.
;;;;
;;;; A [return] never had this: the checker splices the defers registered
;;;; *above* it and no others, and says so. The transfer exit took the whole
;;;; list. The bottom half of this file is that distinction, pinned from both
;;;; sides — the defer below the signal must not run, the one above it must.
;;;;
;;;; [log] is a digit trace and not a running sum, for handler-case.flan's
;;;; reason: a sum commutes and would score a wrong order right.
;;;;
;;;; DO NOT DROP THE edn IMPORT. This program is in test_valgrind.ml, and only
;;;; one half of it earns that row: [game-data] below, whose initialiser goes
;;;; through edn/read-file and so through the real (defer (free src)) over a
;;;; binding slurp transferred out of. That is the free of an uninitialised
;;;; slot, and memcheck names it. The [note] half is output-only — revert the
;;;; fix and its printed trace changes, but no memcheck error is produced,
;;;; because a wrong integer written to a global is not a memory error. So a
;;;; later edit that trims the edn dependency out of here leaves the valgrind
;;;; row green and no longer looking at anything. Move it to a program that
;;;; still frees, or take the row out honestly.

(import edn "vendor:edn")

(defstruct Missing [id i32])
(defstruct Late    [id i32])

(defonce log i64)
;;; A counter of its own, because two computed globals that both wrote [log]
;;; would be asserting the order the initialiser sort happened to pick between
;;; two that do not depend on each other — and that order is not this file's
;;; subject.
(defonce late i64)

(defn note [n i64] () (set log (+ (* log 10) n)))

(defn raise [n i32] i32
  (error (Missing {.id n}))
  0)

;;; A defer written *below* the form that transfers. Nothing reached it when
;;; the unwind starts, so it must not run: there is no v for it to run on, and
;;; in the shape this was found in the cleanup was a free.
(defn unreached [n i32] i32
  (let [v (raise n)]
    (defer (note 1))
    (+ v 1)))

;;; And one written above it, which did register. It must still run — a fix
;;; that dropped this one would turn the crash into a leak, which is the same
;;; bug wearing a quieter coat.
(defn reached [n i32] i32
  (defer (note 2))
  (let [v (raise n)]
    (+ v 1)))

;;; Both at once, so the trace says which of the two ran rather than how many.
(defn both [n i32] i32
  (defer (note 2))
  (let [v (raise n)]
    (defer (note 1))
    (+ v 1)))

;;; And the ordinary case, where nothing transfers: every defer registers and
;;; every one runs, innermost first.
(defn no-signal [n i32] i32
  (defer (note 2))
  (let [v (+ n 1)]
    (defer (note 1))
    (+ v 1)))

;;; ── The three forms, in a global initialiser ──────────────────────
;;;
;;; Each of these runs before main. A handler-case whose condition fires, one
;;; whose body completes and whose clause therefore never runs, a handler-bind
;;; that returns normally and lets signal carry on, and a restart-case with a
;;; handler-bind inside it — which is slurp's own shape and the reason the
;;; checker lets a condition form stand here at all.

(defonce fired i32
  (handler-case (both 4)
    [(Missing [c] (+ 100 (.id c)))]))

(defonce quiet i32
  (handler-case (+ 1 40)
    [(Missing [c] -1)]))

(defonce bound i32
  (handler-bind [(Late [c] (set late 5))]
    (do (signal (Late {.id 1}))
        7)))

(defonce restarted i32
  (restart-case
    (handler-bind [(Missing [c] (invoke-restart 'use-zero 9))]
      (raise 3))
    (use-zero [k i32] k)))

;;; The author's own form, which is what sent anyone looking: a dyn global read
;;; out of a file that is not there, with the FileError answered by nil. The
;;; path is never present in a build directory, so the condition always fires.
(defonce game-data dyn
  (handler-case (edn/read-file "no-such-file-here.edn")
    [(FileError [c] nil)]))

(defn main [] i32
  ;; The initialisers ran above; this is what they left.
  (println fired)
  (println quiet)
  (println bound)
  (println restarted)
  (println game-data)
  (println late)
  ;; The 2 is `both`'s registered defer. The 1 is the one that never
  ;; registered, and its absence here is the whole fix.
  (println log)
  (set log 0)
  ;; The same three shapes from an ordinary function, where they always worked
  ;; and must go on working.
  (println (handler-case (unreached 1) [(Missing [c] (+ 200 (.id c)))]))
  (println log)
  (set log 0)
  (println (handler-case (reached 2) [(Missing [c] (+ 300 (.id c)))]))
  (println log)
  (set log 0)
  (println (handler-case (both 3) [(Missing [c] (+ 400 (.id c)))]))
  (println log)
  (set log 0)
  (println (no-signal 5))
  (println log)
  0)