54 lines
2.0 KiB
Plaintext
54 lines
2.0 KiB
Plaintext
;;;; The second transfer, which the checker can only half refuse.
|
|
;;;;
|
|
;;;; spec-conditions.md §5 says a defer is the cleanup a transfer runs on its
|
|
;;;; way out. Starting a *second* transfer from inside one would leave this
|
|
;;;; frame's defers half run with two targets and no way to choose, so both
|
|
;;;; backends emit a branch into `flan_transfer_fail` for it and the runtime
|
|
;;;; dies there with the frame's location.
|
|
;;;;
|
|
;;;; `check.ml`'s `Ast.InvokeRestart` arm refuses the *lexical* case -- an
|
|
;;;; `invoke-restart` written inside the `defer` form itself -- with the same
|
|
;;;; reasoning. What it cannot see is a defer that *calls* a function that
|
|
;;;; invokes a restart, because the callee is ordinary code and knows nothing
|
|
;;;; about who called it. That is the case below, and it is the only way to
|
|
;;;; reach the branch.
|
|
;;;;
|
|
;;;; The order matters and is what makes this a real second transfer rather
|
|
;;;; than a first one: `outer` establishes both restart-cases, calls `middle`,
|
|
;;;; `deep` signals, `outer`'s handler aims at `esc-one`, and the transfer
|
|
;;;; unwinds `deep` and then `middle`. `middle`'s transfer exit clears the
|
|
;;;; channel and runs its defers -- and the defer calls `second`, which aims a
|
|
;;;; transfer at `esc-two`. Both restart frames are still pushed: `outer`'s
|
|
;;;; pad is what pops them, and `outer` has not been reached yet.
|
|
;;;;
|
|
;;;; Exits 134 with the message on stderr, both ways.
|
|
|
|
(defstruct Blip [n i32])
|
|
|
|
(defvar log i64)
|
|
|
|
(defn deep [n i32] i32
|
|
(signal (Blip {.n n}))
|
|
0)
|
|
|
|
;;; Ordinary code. The checker has nothing to object to here, because from
|
|
;;; where it stands this is a function like any other.
|
|
(defn second [] i64
|
|
(invoke-restart 'esc-two))
|
|
|
|
(defn middle [n i32] i32
|
|
(defer (set log (second)))
|
|
(deep n))
|
|
|
|
(defn outer [n i32] i32
|
|
(restart-case
|
|
(restart-case
|
|
(handler-bind [(Blip [c] (invoke-restart 'esc-one))]
|
|
(middle n))
|
|
(esc-one [] 11))
|
|
(esc-two [] 22)))
|
|
|
|
(defn main [] i32
|
|
(print (outer 1)) (println "")
|
|
0)
|