;;;; A handler-bind in value position, and the shapes around it.
;;;;
;;;; This is here because for a long time nothing in the corpus asked a
;;;; [handler-bind] what its value was. [check.ml] typed the form [unit] and
;;;; dropped the expectation without checking it, so a caller that asked got an
;;;; answer anyway -- and the two backends had picked different ones. [emit.ml]
;;;; answered a literal zero; the hand-written backend answered whatever the
;;;; body's last form had left in the destination slot. The program below
;;;; printed 0 through LLVM and 2 through --x86, and neither number was the
;;;; restart's.
;;;;
;;;; The four programs that did write a [handler-bind] in value position all
;;;; wrote it as a [restart-case] body -- restarts.flan, cleanup.flan,
;;;; p6-transfer.flan, p10-defer-transfer.flan -- where §3 makes the types
;;;; agree but a transfer always leaves before the fall-through is reached. So
;;;; the value was never read and the hole stayed open. Here it is read:
;;;; [answered] returns through the handler-bind, and its value has to be the
;;;; clause's.
;;;;
;;;; The rest are the neighbouring shapes, because a divergence is rarely
;;;; alone: a clause parameter, two nested restart-cases, a defer between the
;;;; signal and the restart-case, and three types wider than the i32 the
;;;; condition corpus is written in.
(defstruct Oops [id i32])

(defvar trace i64)

;;; The shape that had no answer. The handler-bind is this function's last
;;; form, so what it yields is what the function returns, two frames above the
;;; restart-case the transfer lands in.
(defn risky [] i64
  (restart-case (do (signal (Oops {.id 1})) 7)
    (use-zero [] 42)))

(defn answered [] i64
  (handler-bind [(Oops [c] (invoke-restart 'use-zero))]
    (risky)))

;;; The fall-through half of the same shape: nothing handles the signal, so the
;;; body's own value is the one that comes back out through both forms.
(defn unanswered [] i64
  (handler-bind [(Oops [c] (set trace (+ trace 100)))]
    (risky)))

;;; §3's parameter, crossing into an i64 clause.
(defn supplied [] i64
  (restart-case (do (signal (Oops {.id 2})) 7)
    (use-value [v i64] (* v 3))))

;;; §4: the inner frame wins, and the arithmetic written around it still runs.
(defn nested [] i64
  (restart-case
    (+ (restart-case (do (signal (Oops {.id 3})) 7)
         (use-zero [] 10))
       1000)
    (use-zero [] 20)))

;;; §5: a defer between the signal and the restart-case runs on the way out,
;;; before the clause body starts.
(defn mid [] i64
  (defer (set trace (+ trace 1)))
  (signal (Oops {.id 4}))
  7)

(defn deferred [] i64
  (restart-case (mid) (use-zero [] 9)))

;;; Two widths the condition corpus does not otherwise carry across a transfer:
;;; a float, which travels in the other register file, and a string, which is a
;;; pointer and a length rather than one machine word.
(defn floating [] f64
  (restart-case (do (signal (Oops {.id 5})) 1.5)
    (use-value [v f64] (* v 2.0))))

(defn spelled [] string
  (restart-case (do (signal (Oops {.id 6})) "fell-through")
    (use-value [v string] v)))

(defn main [] i32
  (handler-bind [(Oops [c] (invoke-restart 'use-zero))]
    (println (answered)))                                   ; 42
  (println (unanswered))                                    ; 7
  (println trace)                                           ; 100
  (handler-bind [(Oops [c] (invoke-restart 'use-value (i64 5)))]
    (println (supplied)))                                   ; 15
  (handler-bind [(Oops [c] (invoke-restart 'use-zero))]
    (println (nested)))                                     ; 1010
  (handler-bind [(Oops [c] (invoke-restart 'use-zero))]
    (println (deferred)))                                   ; 9
  (println trace)                                           ; 101 — the defer ran
  (handler-bind [(Oops [c] (invoke-restart 'use-value 2.5))]
    (println (floating)))                                   ; 5
  (handler-bind [(Oops [c] (invoke-restart 'use-value "supplied"))]
    (println (spelled)))                                    ; supplied
  0)