flan/test/programs/restarts.flan

;;;; restart-case and invoke-restart — spec-conditions.md §3 to §6.
;;;;
;;;; The transfer. A handler runs where the signal was, decides, and control
;;;; resumes at a restart-case further out: every function in between returns
;;;; early with the target in the channel, running its defers on the way (§5).
;;;;
;;;; §3's parameters are here too, along with the run-time check they need: the
;;;; supply-a-value half of the vocabulary, which is the half whose answer comes
;;;; from outside the program. With no argument this program is the exit-0 case
;;;; the table pins; with one it selects a mismatch, which traps and is asserted
;;;; on its reason.
(defstruct AssetMissing [id i32])

(defvar log i64)

;;; The signalling end. Two frames below the restart-case, so the transfer has
;;; something to cross.
(defn load [n i32] i32
  (signal (AssetMissing {:id n}))
  100)

;;; §5: this defer runs whether the call below returns or transfers, and it
;;; runs before the clause body starts.
(defn middle [n i32] i32
  (defer (set log (+ log 1)))
  (+ (load n) 1))

;;; The spec's load-texture shape (§1): a restart-case in value position, whose
;;; fall-through has to produce the type too.
(defn fetch [n i32] i32
  (restart-case (middle n)
    (use-placeholder [] -1)
    (retry        [] 7)))

;;; §4: an inner restart-case shadows an outer one offering the same name, and
;;; the outer one is reached again once the inner has been left.
(defn nested [n i32] i32
  (restart-case
    (+ (restart-case (middle n)
         (use-placeholder [] 10))
       1000)
    (use-placeholder [] 20)))

;;; §2's diverging variant. Same lookup, but a handler that returns normally
;;; has not answered it: only a transfer gets past, so the fall-through the
;;; signalling version needs does not exist here.
(defn strict [n i32] i32
  (restart-case
    (do (error (AssetMissing {:id n}))
        ;; unreachable — error is Never, so nothing after it runs
        0)
    (use-placeholder [] -2)))

;;; Called from nowhere but inside an [invoke-restart]'s argument list.
(defn half [x i32] i32 (/ x 2))

;;; §3: a clause with parameters. The value comes from the handler, which is
;;; the whole point — [use-value] and [store-value] are the two restarts whose
;;; answer is not in the program. The parameters are slots of *this* function
;;; and the invoker fills a buffer this frame owns, because by the time the
;;; clause runs the invoking frame has gone (§5).
(defn supplied [n i32] i32
  (restart-case (middle n)
    (use-value [v i32] (* v 2))
    (use-pair  [a i32 b i32] (+ a b))
    (retry     [] 7)))

;;; Parameters of more than one type, and one that is not a machine word: a
;;; string is ptr+len and crosses the transfer as the two of them.
(defn labelled [n i32] i32
  (restart-case (middle n)
    (use-labelled [label string v i32]
      (do (print label) (println "") v))))

;;; The mismatch cases. Each is selected by the argument, because each stops
;;; the program: what a restart takes is not knowable where it is invoked, so
;;; §3 checks it at run time and this is what that check refuses.
(defn mismatched [n i32] i32
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-value))]
    (supplied n)))

(defn mistyped [n i32] i32
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-value "forty-one"))]
    (supplied n)))

(defn overfull [n i32] i32
  (handler-bind [(AssetMissing [c] (invoke-restart 'retry 1))]
    (supplied n)))

;;; §4 meets §3: lookup is by *name*, and the signature is checked against
;;; whatever that finds. An inner frame offering use-value shadows the outer
;;; one, so an i32 is refused here even though the outer clause would have
;;; taken it — a name finds one frame, it does not search for a fitting one.
(defn shadowed [n i32] i32
  (restart-case
    (restart-case (middle n)
      (use-value [s string] (do (print s) 0)))
    (use-value [v i32] v)))

(defn mislaid [n i32] i32
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-value 21))]
    (shadowed n)))

(defn main [args [string]] i32
  ;; One argument selects a trap; none runs the table's case.
  (if (> (len args) 1)
    (let [k (i32 (bytes->i64 (bytes (at args 1))))]
      (cond
        (= k 1) (print (mismatched 90))
        (= k 2) (print (mistyped 91))
        (= k 3) (print (overfull 92))
        (= k 4) (print (mislaid 93))
        :else (println "?"))
      (return 0)))

  ;; Nothing handles it, so signal is a no-op and the body's own value stands.
  (print (fetch 1)) (println "")                          ; 101
  (print log) (println "")                                ; 1

  ;; A handler that transfers: the clause's value is the restart-case's.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
    (print (fetch 2)) (println ""))                       ; -1
  (print log) (println "")                                ; 2 — the defer ran

  (handler-bind [(AssetMissing [c] (invoke-restart 'retry))]
    (print (fetch 3)) (println ""))                       ; 7

  ;; §4: the innermost frame offering the name wins, and the clause yields to
  ;; *its* own continuation — so the +1000 written around the inner
  ;; restart-case still runs, and the outer clause never does.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
    (print (nested 4)) (println ""))                      ; 1010

  ;; A handler that returns normally transfers nothing: §1's accumulation case
  ;; still works, and the fall-through stands.
  (handler-bind [(AssetMissing [c] (set log (+ log 100)))]
    (print (fetch 5)) (println ""))                       ; 101
  ;; The handler runs at the signal, which is inside the call the defer
  ;; belongs to, so its +100 lands before that defer's +1.
  (print log) (println "")                                ; 4 + 100 + 1 = 105

  ;; error, answered by a transfer. Unanswered it stops the program, which is
  ;; the trap case in the acceptance table rather than a line here.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
    (print (strict 6)) (println ""))                        ; -2

  ;; §3: the handler supplies the value, and the clause computes with it —
  ;; the arithmetic is in the clause so that a transfer which forgot to copy
  ;; the argument could not pass by returning what it was given.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-value 21))]
    (print (supplied 7)) (println ""))                      ; 42
  ;; Two parameters, so their order is pinned: 1 and 2 would sum the same
  ;; whichever way round they landed.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-pair 30 4))]
    (print (supplied 8)) (println ""))                      ; 34
  ;; A clause with no parameters is still reachable from a restart-case that
  ;; has some, and an invoke with no arguments still matches it.
  (handler-bind [(AssetMissing [c] (invoke-restart 'retry))]
    (print (supplied 9)) (println ""))                      ; 7
  ;; A string and an integer together: two different widths, and the string is
  ;; ptr+len rather than a machine word.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-labelled "supplied" 5))]
    (print (labelled 10)) (println ""))                     ; supplied / 5
  ;; The argument is an ordinary expression, evaluated where the invoke is —
  ;; here a call, and [half] is reached from nowhere else, so a walk that did
  ;; not look inside an invoke-restart would drop it and fail to link.
  (handler-bind [(AssetMissing [c] (invoke-restart 'use-value (half 42)))]
    (print (supplied 12)) (println ""))                     ; 21 * 2
  0)