50 lines
1.9 KiB
Racket
50 lines
1.9 KiB
Racket
#lang syndicate
|
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
|
;; Low-level implementation.
|
|
|
|
(require/activate "fs-shell.rkt")
|
|
(require/activate "fs-protocol.rkt")
|
|
|
|
(require (only-in syndicate [assert core:assert]))
|
|
(require racket/set)
|
|
|
|
(define (file-system-event-handler e files)
|
|
(match-event e
|
|
[(? patch? p)
|
|
(transition files
|
|
(for-trie/list [((observe (file $name _)) (patch-added p))]
|
|
(printf "At least one reader exists for ~v\n" name)
|
|
(define initial-content (hash-ref files name #f))
|
|
(spawn (file-observation-event-handler name)
|
|
initial-content
|
|
(patch-seq (core:assert (file name initial-content))
|
|
(sub (observe (file name ?)))
|
|
(sub (save (file name ?)))
|
|
(sub (delete name))))))]
|
|
[(message (save (file name new-content)))
|
|
(transition (hash-set files name new-content) '())]
|
|
[(message (delete name))
|
|
(transition (hash-remove files name) '())]))
|
|
|
|
(spawn file-system-event-handler
|
|
(hash)
|
|
(patch-seq (sub (observe (file ? ?)))
|
|
(sub (save (file ? ?)))
|
|
(sub (delete ?))))
|
|
|
|
(define (update-file old-content name new-content)
|
|
(transition new-content
|
|
(patch-seq (retract (file name old-content))
|
|
(core:assert (file name new-content)))))
|
|
|
|
(define ((file-observation-event-handler name) e content)
|
|
(match-event e
|
|
[(? patch? p)
|
|
(when (not (set-empty? (project-assertions (patch-removed p) (observe (file (?!) ?)))))
|
|
(printf "No remaining readers exist for ~v\n" name)
|
|
(quit))]
|
|
[(message (save (file (== name) new-content)))
|
|
(update-file content name new-content)]
|
|
[(message (delete (== name)))
|
|
(update-file content name #f)]))
|