Joseph Ferano
b50e8d6cad
conditions.org is how to drive what is built, as against spec-conditions.md which is what it should mean and NEXT.md which is why it is shaped that way. Every refusal message in it is verbatim rather than paraphrased, because the reason is the thing worth knowing and a remembered approximation of it is how a cheatsheet starts lying. conditions-play.flan is the program to poke at. It loops rather than exiting so flan dev can attach to it, and it is deliberately two frames deep with a defer in the middle, so that redefining probe or fetch from Emacs and watching the next pass through run-once shows the transfer crossing something. It also carries the two gotchas that are not in any spec or message: a handler closes over nothing, and invoking a restart re-runs whatever sits between it and the target - which is what "restarts go at the resync point" is actually about.
52 lines
1.6 KiB
Plaintext
52 lines
1.6 KiB
Plaintext
;;;; A program to poke at conditions and restarts with — see conditions.org.
|
|
;;;;
|
|
;;;; It loops instead of exiting, so `flan dev conditions-play.flan` can attach
|
|
;;;; and you can redefine `probe` and `run-once` from Emacs while it runs. The
|
|
;;;; socket written here is only a fallback; the daemon overrides it.
|
|
(import agent "vendor:agent")
|
|
|
|
(defstruct AssetMissing [id i32])
|
|
(defstruct Corrupt [id i32])
|
|
|
|
;;; Handlers cannot see the establishing function's locals yet, so anything a
|
|
;;; handler accumulates into has to be a global.
|
|
(defvar seen i64)
|
|
(defvar ticks i64)
|
|
|
|
;;; Two frames under the restart-case, so a transfer has something to cross.
|
|
(defn probe [n i32] i32
|
|
(signal (AssetMissing {:id n}))
|
|
100)
|
|
|
|
(defn middle [n i32] i32
|
|
(defer (set ticks (+ ticks 1))) ; runs on the way out, transfer or not
|
|
(+ (probe n) 1))
|
|
|
|
;;; The shape spec-conditions.md §1 uses: 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)))
|
|
|
|
(defn run-once []
|
|
(print-i64 (i64 (fetch 1))) (newline)
|
|
|
|
(handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))]
|
|
(print-i64 (i64 (fetch 2))) (newline))
|
|
|
|
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
|
|
(print-i64 (i64 (fetch 3))) (newline))
|
|
|
|
(print-i64 seen) (newline)
|
|
(print-i64 ticks) (newline))
|
|
|
|
(defn main [] i32
|
|
(agent/start "/tmp/flan-conditions.sock")
|
|
(run-once)
|
|
(while (= (agent/wait 200) 0) 0)
|
|
(run-once)
|
|
(while (= (agent/wait 200) 0) 0)
|
|
(run-once)
|
|
0)
|