giles
e896deffc8
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Guest Scheme call/cc is escape-only (re-entry hangs), so durable resume uses deterministic replay: suspend escapes to the driver; resume re-runs the flow and replays resolved suspends from a (tag value) log. No live continuation is ever serialized — persisted state is plain data, survives restart. Adds flow/start (now state-returning, backward compatible), flow/resume, flow/cancel, store.sx. Harness reuses one env with a per-test reset (full env rebuild 66x was too slow). Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
30 lines
3.5 KiB
Plaintext
30 lines
3.5 KiB
Plaintext
;; lib/flow/store.sx — durable flow store + lifecycle (Phase 3).
|
|
;;
|
|
;; The store maps flow-id -> record. A record is a plain list:
|
|
;; (flow input log status payload)
|
|
;; flow — the flow procedure (live; re-resolved by name on restart)
|
|
;; input — the original start input (plain data)
|
|
;; log — replay log: list of (tag value) entries (plain data)
|
|
;; status — done | suspended | cancelled
|
|
;; payload — result (done) | waiting-tag (suspended) | #f (cancelled)
|
|
;;
|
|
;; Lifecycle (all use deterministic replay via flow-drive — see spec.sx):
|
|
;; (flow/start flow input) — run from empty log. If it completes, return the raw
|
|
;; result (backward compatible with Phases 1-2). If it suspends, register the
|
|
;; record and return (flow-suspended id tag).
|
|
;; (flow/resume id value) — append (tag value) to the log and re-drive. Returns
|
|
;; the raw result on completion, (flow-suspended id tag) on a further suspend,
|
|
;; or (flow-error reason) if the id is unknown / not suspended.
|
|
;; (flow/cancel id) — mark cancelled; a later resume is rejected (the stale
|
|
;; replay can never wake a cancelled flow).
|
|
|
|
(define
|
|
flow-store-src
|
|
"(define flow-store (list))\n (define flow-next-id 0)\n (define (flow-store-put! id rec) (set! flow-store (cons (list id rec) flow-store)))\n (define (flow-store-find id store)\n (if (null? store)\n (list)\n (if (= (car (car store)) id)\n (car (cdr (car store)))\n (flow-store-find id (cdr store)))))\n (define (flow-store-get id) (flow-store-find id flow-store))\n (define (flow-mk-rec flow input log status payload)\n (list flow input log status payload))\n (define (flow-rec-flow r) (car r))\n (define (flow-rec-input r) (car (cdr r)))\n (define (flow-rec-log r) (car (cdr (cdr r))))\n (define (flow-rec-status r) (car (cdr (cdr (cdr r)))))\n (define (flow-rec-payload r) (car (cdr (cdr (cdr (cdr r))))))\n (define (flow-outcome id flow input log outcome)\n (if (eq? (car outcome) (quote flow-done))\n (begin\n (flow-store-put! id (flow-mk-rec flow input log (quote done) (car (cdr outcome))))\n (car (cdr outcome)))\n (begin\n (flow-store-put! id (flow-mk-rec flow input log (quote suspended) (car (cdr outcome))))\n (list (quote flow-suspended) id (car (cdr outcome))))))\n (define (flow/start flow input)\n (set! flow-next-id (+ flow-next-id 1))\n (flow-outcome flow-next-id flow input (list) (flow-drive flow input (list))))\n (define (flow/resume id value)\n (let ((rec (flow-store-get id)))\n (if (null? rec)\n (list (quote flow-error) (quote no-such-flow))\n (if (eq? (flow-rec-status rec) (quote suspended))\n (let ((newlog (cons (list (flow-rec-payload rec) value) (flow-rec-log rec))))\n (flow-outcome id (flow-rec-flow rec) (flow-rec-input rec) newlog\n (flow-drive (flow-rec-flow rec) (flow-rec-input rec) newlog)))\n (list (quote flow-error) (quote not-suspended))))))\n (define (flow/cancel id)\n (let ((rec (flow-store-get id)))\n (if (null? rec)\n (list (quote flow-error) (quote no-such-flow))\n (begin\n (flow-store-put! id\n (flow-mk-rec (flow-rec-flow rec) (flow-rec-input rec) (flow-rec-log rec) (quote cancelled) #f))\n (list (quote flow-cancelled) id)))))")
|
|
|
|
(define
|
|
flow-load-store!
|
|
(fn
|
|
(env)
|
|
(begin (scheme-eval-program (scheme-parse-all flow-store-src) env) env)))
|