Joseph Ferano
9a820d86cd
The script is in tools/ rather than thrown away, because two lanes are
writing Flan in the old spelling right now and their files need the same
pass at merge.
It works on forms, not on text: a keyword becomes a dot only where it sits
in a field-label position inside a brace, so an enum member in value
position, a map key inside an EDN string and a type-position {K V} are all
left alone. :keys keeps its colon -- it names no field.
170 lines
7.5 KiB
Plaintext
170 lines
7.5 KiB
Plaintext
;;;; 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)
|