;;;; The re-propagation branches, which the corpus walks past.
;;;;
;;;; Every landing pad this backend emits has two halves: the one a body
;;;; reaches by finishing, and the one a transfer reaches by passing through.
;;;; `test/programs` exercises the first everywhere and the second only for
;;;; with-allocator (allocators.flan's last case aims an invoke-restart out of
;;;; a with-allocator body at a restart-case outside it). The two below it does
;;;; not reach at all, so they are here:
;;;;
;;;;   hxfer  a transfer crossing a handler-bind, which has to take the handler
;;;;          frames off before it goes any further -- in restarts.flan every
;;;;          transfer stops at a restart-case *inside* the handler-bind's
;;;;          extent, so that pop never runs on the transfer path
;;;;
;;;;   rxfer's last branch
;;;;          a restart-case the transfer is not aimed at: it puts the target
;;;;          back in the channel and re-propagates. restarts.flan's `nested`
;;;;          and `shadowed` both have the *inner* frame offering the name, so
;;;;          the inner one always wins and this branch is never taken.
;;;;
;;;; Proved the way everything else here is: built both ways, and compared by
;;;; what it prints.

(defstruct Blip [n i32])

(defvar log i64)

;;; Two frames down, with a defer between, so the transfer crosses a function
;;; boundary and a transfer exit that has work to do.
(defn deep [n i32] i32
  (signal (Blip {.n n}))
  0)

(defn middle [n i32] i32
  (defer (set log (+ log 1)))
  (deep n))

;;; The handler frames come off on the transfer path. The restart-case is
;;; outside the handler-bind, so the pad pops and re-propagates rather than
;;; the body's own pop running.
(defn crosses-handler [n i32] i32
  (restart-case
    (handler-bind [(Blip [c] (invoke-restart 'outer-one))]
      (middle n))
    (outer-one [] 11)))

;;; An inner restart-case that does not offer the name. Its pad clears the
;;; channel, pops its frames, matches nothing, and puts the target back.
(defn crosses-restart [n i32] i32
  (restart-case
    (handler-bind [(Blip [c] (invoke-restart 'outer-two))]
      (restart-case (middle n)
        (inner-only [] 22)))
    (outer-two [] 33)))

;;; Both at once, and a parameter as well, so the buffer the outer frame owns
;;; is written by an invoke two pads and one function away from it.
(defn crosses-both [n i32] i32
  (restart-case
    (handler-bind [(Blip [c] (invoke-restart 'outer-three 7)) ]
      (restart-case (middle n)
        (inner-only [] 44)))
    (outer-three [v i32] (* v 100))))

(defn main [] i32
  (print (crosses-handler 1)) (println "")   ; 11
  (print log) (println "")                   ; 1 — the defer ran
  (print (crosses-restart 2)) (println "")   ; 33
  (print log) (println "")                   ; 2
  (print (crosses-both 3)) (println "")      ; 700
  (print log) (println "")                   ; 3
  0)