;;;; 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.
(defstruct Missing [id i32])
(defstruct Corrupt [id i32])
(defstruct Late    [id i32])

(defvar log i64)
(defvar frame Allocator)

;;; 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 (§5).
(defn inner [n i32] i32
  (defer (set log (+ log 1)))
  (error (Missing {.id n}))
  0)

(defn middle [n i32] i32
  (defer (set log (+ log 10)))
  (+ (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] (set log (+ log 1000)))]
    (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] (set log (+ log 1)))]
      (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 (set log (+ log 100)))
  (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)))]))

;;; 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 answers
;;; its own condition, so the total says they are different names.
(defn in-clause-a [] ()
  (handler-bind
    [(Late [c]
       (set log
         (+ log (i64 (handler-case (error (Corrupt {.id 3}))
                       [(Corrupt [d] (.id d))])))))]
    (signal (Late {.id 0}))))

(defn in-clause-b [] ()
  (handler-bind
    [(Late [c]
       (set log
         (+ log (i64 (handler-case (error (Corrupt {.id 40}))
                       [(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 "")                ; 42
  (print log) (println "")                       ; 0 — nothing unwound

  ;; Caught, with both defers between the signal and the form having run.
  (print (caught 5)) (println "")                ; 105
  (print log) (println "")                       ; 11

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

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

  ;; The two nestings. Neither signals from under [middle], so neither moves
  ;; the defer count: what each adds is its own handler-bind's clause.
  (print (hc-in-hb 6)) (println "")              ; 6
  (print log) (println "")                       ; 10011 + 1000 = 11011
  (print (hb-in-hc 8)) (println "")              ; 16
  (print log) (println "")                       ; 11011 + 1 = 11012

  ;; 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 "")    ; 5099
  (print log) (println "")                       ; 11012 + 11 + 100 = 11123

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

  ;; 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 "")                ; 23
  (arena-destroy frame)
  (let [h (vec-new i32)]
    (push h 9)
    (print (len h)) (println ""))                ; 1
  0)