;;;; handler-case — the unwinding handler, spec-conditions.md.
;;;;
;;;; handler-bind runs its clause at the signal, with everything below still
;;;; standing, and carries on from there. This one is the other half: a listed
;;;; condition unwinds the stack back to the form, the clause runs *here*, and
;;;; its value is the value of the whole handler-case. Clojure's try/catch and
;;;; Common Lisp's handler-case, and built out of the two operators that were
;;;; already here — a handler-bind whose clause invokes a restart the form
;;;; established around itself.
;;;;
;;;; What this program pins is the list of things that only an unwind can get
;;;; wrong: the defers between the signal and the form, a condition nobody
;;;; listed carrying on outward untouched, the two nestings against
;;;; handler-bind, and a clause that signals — which must not be caught by the
;;;; handler-case it belongs to, because by the time it runs that form's frames
;;;; are off the stack.
;;;;
;;;; [log] is a digit trace rather than a running sum, which is cleanup.flan's
;;;; device and is here for cleanup.flan's reason: a sum commutes, so a backend
;;;; that ran the defers outermost-first would print exactly the same total as
;;;; one that got them right. A shift records the *order* and a wrong order is
;;;; a different number.
(defstruct Missing [id i32])
(defstruct Corrupt [id i32])
(defstruct Late    [id i32])

(defvar log i64)
(defvar frame Allocator)

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

;;; Two frames below any handler-case here, each with a defer, so an unwind has
;;; something to cross and leaves a mark saying it crossed it — and says in
;;; which order it crossed them (§5: innermost first).
(defn inner [n i32] i32
  (defer (note 1))
  (error (Missing {.id n}))
  0)

(defn middle [n i32] i32
  (defer (note 2))
  (+ (inner n) 1))

;;; Nothing signals: the body's own value stands, which is the case a form that
;;; only ever answers its clauses would quietly get wrong.
(defn quiet [n i32] i32
  (handler-case (+ n 1)
    [(Missing [c] -1)]))

;;; Caught, and the clause reads a local of the function that established the
;;; form. That is the whole difference from handler-bind, whose clause is
;;; lifted into a function of its own and can see no such thing.
(defn caught [n i32] i32
  (let [bonus 100]
    (handler-case (middle n)
      [(Missing [c] (+ bonus (.id c)))])))

;;; Two clauses, and the one whose type was signalled is the one that runs.
(defn raise [k i32] i32
  (cond
    (= k 0) (error (Missing {.id 1}))
    (= k 1) (error (Corrupt {.id 2}))
    :else   (error (Late    {.id 3}))))

(defn two [k i32] i32
  (handler-case (raise k)
    [(Missing [c] (+ 100 (.id c)))
     (Corrupt [c] (+ 200 (.id c)))]))

;;; A condition no clause lists installs no frame that matches it, so this form
;;; never sees it and it goes on outward unchanged. The outer handler-bind is
;;; what proves it arrived, and the 7 is what proves signal still returned ()
;;; and the body carried on from where it was.
(defn unmatched [n i32] i32
  (handler-case
    (do (signal (Corrupt {.id n}))
        7)
    [(Missing [c] -1)]))

;;; A handler-case inside a handler-bind. The Corrupt goes out to the
;;; handler-bind, which returns normally, so the body carries on; the Missing
;;; that follows unwinds to the handler-case in between.
(defn hc-in-hb [n i32] i32
  (handler-bind [(Corrupt [c] (note 4))]
    (handler-case
      (do (signal (Corrupt {.id n}))
          (error (Missing {.id n}))
          0)
      [(Missing [c] (.id c))])))

;;; And the other way round. The inner handler-bind is on the path the unwind
;;; takes, so its frame has to come off as the transfer passes through it —
;;; which is the same landing pad a restart transfer already uses.
(defn hb-in-hc [n i32] i32
  (handler-case
    (handler-bind [(Corrupt [c] (note 5))]
      (do (signal (Corrupt {.id n}))
          (error (Missing {.id n}))
          0))
    [(Missing [c] (* 2 (.id c)))]))

;;; A clause that signals. It runs with its own handler-case's frames already
;;; off the stack, so this Missing must not be caught here — that would be an
;;; unbounded loop rather than a wrong number. It has to leave this function,
;;; running the defer below on the way, and land further out.
(defn arm-signals [n i32] i32
  (defer (note 3))
  (handler-case (middle n)
    [(Missing [c] (do (signal (Missing {.id 99}))
                      (.id c)))]))

(defn arm-caught-outside [n i32] i32
  (handler-case (arm-signals n)
    [(Missing [c] (+ 5000 (.id c)))]))

;;; A clause that returns. A clause runs at the form, in the function that
;;; wrote it, so a [return] there is an ordinary return from *this* function —
;;; not the refusal the body gets, where the frames are still standing. It has
;;; to run this function's own defer on the way out, after the two the unwind
;;; already ran, and it has to leave nothing on the handler stack: main signals
;;; once more afterwards with nothing listening, which would be a call into a
;;; frame that has gone if anything leaked.
(defn return-from-clause [n i32] i32
  (defer (note 9))
  (handler-case (middle n)
    [(Missing [c] (return (+ 700 (.id c))))])
  0)

;;; A handler-case inside a defer. A defer is itself the cleanup an unwind
;;; runs, so establishing frames in one has to work like establishing them
;;; anywhere — what a defer may not do is start a transfer that leaves it, and
;;; this one begins and ends inside. Two defers, so the order is pinned here
;;; too: the handler-case one is innermost and notes first.
(defn hc-in-defer [n i32] i32
  (defer (note 8))
  (defer (note (i64 (handler-case (error (Corrupt {.id n}))
                      [(Corrupt [d] (.id d))]))))
  n)

;;; Two handler-cases written inside handler-bind clauses. Such a clause is
;;; lifted into a function of its own, so both of these mint their made-up
;;; restart name out of one shared bucket rather than out of a function's —
;;; which is exactly where two forms landing on the same name would show, the
;;; inner shadowing the outer wherever their extents overlapped. Each notes the
;;; id of the condition *it* caught, so the trace says they are two names.
(defn in-clause-a [] ()
  (handler-bind
    [(Late [c]
       (note (i64 (handler-case (error (Corrupt {.id 6}))
                    [(Corrupt [d] (.id d))]))))]
    (signal (Late {.id 0}))))

(defn in-clause-b [] ()
  (handler-bind
    [(Late [c]
       (note (i64 (handler-case (error (Corrupt {.id 7}))
                    [(Corrupt [d] (.id d))]))))]
    (signal (Late {.id 0}))))

;;; A with-allocator on the way out. It rebinds the context allocator for its
;;; extent and the transfer passes straight through it, so the restore has to
;;; happen on that path as well as on the normal one — otherwise the clause,
;;; and everything after the whole form, would be allocating out of a region
;;; nobody else knows about. main destroys the arena before it allocates
;;; again, so a context left pointing at it would not be a wrong number.
(defn scoped [n i32] i32
  (handler-case
    (with-allocator frame
      (let [v (vec-new i32)]
        (push v 1)
        (error (Missing {.id n}))
        (i32 (len v))))
    [(Missing [c] (+ 20 (.id c)))]))

(defn main [] i32
  ;; Normal completion.
  (print (quiet 41)) (println "")
  (print log) (println "")

  ;; Caught, with both defers between the signal and the form having run, and
  ;; the trace saying inner's ran before middle's.
  (print (caught 5)) (println "")
  (print log) (println "")

  ;; The arm that matches is the arm that runs.
  (print (two 0)) (println "")
  (print (two 1)) (println "")

  ;; Unmatched: past this form and out to a handler-bind around it, and the
  ;; body's own value still stands.
  (handler-bind [(Corrupt [c] (note 6))]
    (print (unmatched 3)) (println ""))
  (print log) (println "")

  ;; The two nestings. Neither signals from under [middle], so what each adds
  ;; to the trace is its own handler-bind's clause and nothing else.
  (print (hc-in-hb 6)) (println "")
  (print (hb-in-hc 8)) (println "")
  (print log) (println "")

  ;; A clause that signals, caught by the handler-case outside it. Two unwinds,
  ;; so both defers under [middle] run and then the one in [arm-signals] does.
  (print (arm-caught-outside 4)) (println "")
  (print log) (println "")

  ;; A clause that returns, and then a signal nothing is listening for. The
  ;; second is the leak check: it must be the no-op §2 says it is.
  (print (return-from-clause 5)) (println "")
  (print log) (println "")
  (signal (Missing {.id 0}))
  (print log) (println "")

  ;; A handler-case established inside a defer.
  (print (hc-in-defer 4)) (println "")
  (print log) (println "")

  ;; Two forms out of the one bucket of made-up names, each answering its own.
  (in-clause-a)
  (in-clause-b)
  (print log) (println "")

  ;; And the allocator scope. The arena is destroyed straight after, so the
  ;; heap allocation below is only possible if the context was put back.
  (set frame (arena-new 4096))
  (print (scoped 3)) (println "")
  (arena-destroy frame)
  (let [h (vec-new i32)]
    (push h 9)
    (print (len h)) (println "")
    (free h))
  0)