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.
52 lines
1.5 KiB
Plaintext
52 lines
1.5 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 (fetch 1)) (println "")
|
|
|
|
(handler-bind [(AssetMissing [c] (set seen (+ seen (i64 (.id c)))))]
|
|
(print (fetch 2)) (println ""))
|
|
|
|
(handler-bind [(AssetMissing [c] (invoke-restart 'use-placeholder))]
|
|
(print (fetch 3)) (println ""))
|
|
|
|
(print seen) (println "")
|
|
(print ticks) (println ""))
|
|
|
|
(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)
|