Factor out commonality from file-system*.rkt examples
This commit is contained in:
parent
e36777584c
commit
e2897d37f4
|
@ -2,13 +2,8 @@
|
||||||
;; Toy file system, based on the example in the ESOP2016 submission.
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
||||||
;; syndicate/actor implementation, using "during" instead of "on asserted/until retracted".
|
;; syndicate/actor implementation, using "during" instead of "on asserted/until retracted".
|
||||||
|
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate "fs-shell.rkt")
|
||||||
(require (only-in racket/port read-bytes-line-evt))
|
(require/activate "fs-protocol.rkt")
|
||||||
(require (only-in racket/string string-trim string-split))
|
|
||||||
|
|
||||||
(struct file (name content) #:prefab)
|
|
||||||
(struct save (file) #:prefab)
|
|
||||||
(struct delete (name) #:prefab)
|
|
||||||
|
|
||||||
(actor (react (field [files (hash)])
|
(actor (react (field [files (hash)])
|
||||||
(during (observe (file $name _))
|
(during (observe (file $name _))
|
||||||
|
@ -20,46 +15,3 @@
|
||||||
(on (message (delete name)) (content #f)))
|
(on (message (delete name)) (content #f)))
|
||||||
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
|
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
|
||||||
(on (message (delete $name)) (files (hash-remove (files) name)))))
|
(on (message (delete $name)) (files (hash-remove (files) name)))))
|
||||||
|
|
||||||
(define (sleep sec)
|
|
||||||
(define timer-id (gensym 'sleep))
|
|
||||||
(until (message (timer-expired timer-id _))
|
|
||||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
||||||
|
|
||||||
;; Shell
|
|
||||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
|
||||||
(define (print-prompt)
|
|
||||||
(printf "> ")
|
|
||||||
(flush-output))
|
|
||||||
(define reader-count 0)
|
|
||||||
(define (generate-reader-id)
|
|
||||||
(begin0 reader-count
|
|
||||||
(set! reader-count (+ reader-count 1))))
|
|
||||||
(actor (print-prompt)
|
|
||||||
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
|
||||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
||||||
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
|
||||||
[(list "open" name)
|
|
||||||
(define reader-id (generate-reader-id))
|
|
||||||
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
|
||||||
(until (message `(stop-watching ,name))
|
|
||||||
(on (asserted (file name $contents))
|
|
||||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
|
||||||
reader-id
|
|
||||||
name
|
|
||||||
contents)))
|
|
||||||
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
|
||||||
[(list "close" name)
|
|
||||||
(send! `(stop-watching ,name))]
|
|
||||||
[(list* "write" name words)
|
|
||||||
(send! (save (file name words)))]
|
|
||||||
[(list "delete" name)
|
|
||||||
(send! (delete name))]
|
|
||||||
[_
|
|
||||||
(printf "I'm afraid I didn't understand that.\n")
|
|
||||||
(printf "Try: open filename\n")
|
|
||||||
(printf " close filename\n")
|
|
||||||
(printf " write filename some text goes here\n")
|
|
||||||
(printf " delete filename\n")])
|
|
||||||
(sleep 0.1)
|
|
||||||
(print-prompt)))))
|
|
||||||
|
|
|
@ -2,15 +2,11 @@
|
||||||
;; Toy file system, based on the example in the ESOP2016 submission.
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
||||||
;; Low-level implementation.
|
;; Low-level implementation.
|
||||||
|
|
||||||
(require (only-in syndicate [assert core:assert]))
|
(require/activate "fs-shell.rkt")
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate "fs-protocol.rkt")
|
||||||
(require (only-in racket/port read-bytes-line-evt))
|
|
||||||
(require (only-in racket/string string-trim string-split))
|
|
||||||
(require racket/set)
|
|
||||||
|
|
||||||
(struct file (name content) #:prefab)
|
(require (only-in syndicate [assert core:assert]))
|
||||||
(struct save (file) #:prefab)
|
(require racket/set)
|
||||||
(struct delete (name) #:prefab)
|
|
||||||
|
|
||||||
(define (file-system-event-handler e files)
|
(define (file-system-event-handler e files)
|
||||||
(match-event e
|
(match-event e
|
||||||
|
@ -51,46 +47,3 @@
|
||||||
(update-file content name new-content)]
|
(update-file content name new-content)]
|
||||||
[(message (delete (== name)))
|
[(message (delete (== name)))
|
||||||
(update-file content name #f)]))
|
(update-file content name #f)]))
|
||||||
|
|
||||||
(define (sleep sec)
|
|
||||||
(define timer-id (gensym 'sleep))
|
|
||||||
(until (message (timer-expired timer-id _))
|
|
||||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
||||||
|
|
||||||
;; Shell
|
|
||||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
|
||||||
(define (print-prompt)
|
|
||||||
(printf "> ")
|
|
||||||
(flush-output))
|
|
||||||
(define reader-count 0)
|
|
||||||
(define (generate-reader-id)
|
|
||||||
(begin0 reader-count
|
|
||||||
(set! reader-count (+ reader-count 1))))
|
|
||||||
(actor (print-prompt)
|
|
||||||
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
|
||||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
||||||
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
|
||||||
[(list "open" name)
|
|
||||||
(define reader-id (generate-reader-id))
|
|
||||||
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
|
||||||
(until (message `(stop-watching ,name))
|
|
||||||
(on (asserted (file name $contents))
|
|
||||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
|
||||||
reader-id
|
|
||||||
name
|
|
||||||
contents)))
|
|
||||||
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
|
||||||
[(list "close" name)
|
|
||||||
(send! `(stop-watching ,name))]
|
|
||||||
[(list* "write" name words)
|
|
||||||
(send! (save (file name words)))]
|
|
||||||
[(list "delete" name)
|
|
||||||
(send! (delete name))]
|
|
||||||
[_
|
|
||||||
(printf "I'm afraid I didn't understand that.\n")
|
|
||||||
(printf "Try: open filename\n")
|
|
||||||
(printf " close filename\n")
|
|
||||||
(printf " write filename some text goes here\n")
|
|
||||||
(printf " delete filename\n")])
|
|
||||||
(sleep 0.1)
|
|
||||||
(print-prompt)))))
|
|
||||||
|
|
|
@ -2,15 +2,11 @@
|
||||||
;; Toy file system, based on the example in the ESOP2016 submission.
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
||||||
;; Low-level implementation, without subconversation.
|
;; Low-level implementation, without subconversation.
|
||||||
|
|
||||||
(require (only-in syndicate [assert core:assert]))
|
(require/activate "fs-shell.rkt")
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate "fs-protocol.rkt")
|
||||||
(require (only-in racket/port read-bytes-line-evt))
|
|
||||||
(require (only-in racket/string string-trim string-split))
|
|
||||||
(require racket/set)
|
|
||||||
|
|
||||||
(struct file (name content) #:prefab)
|
(require (only-in syndicate [assert core:assert]))
|
||||||
(struct save (file) #:prefab)
|
(require racket/set)
|
||||||
(struct delete (name) #:prefab)
|
|
||||||
|
|
||||||
(struct fs-state (files monitored) #:prefab)
|
(struct fs-state (files monitored) #:prefab)
|
||||||
|
|
||||||
|
@ -52,46 +48,3 @@
|
||||||
(patch-seq (sub (observe (file ? ?)))
|
(patch-seq (sub (observe (file ? ?)))
|
||||||
(sub (save (file ? ?)))
|
(sub (save (file ? ?)))
|
||||||
(sub (delete ?))))
|
(sub (delete ?))))
|
||||||
|
|
||||||
(define (sleep sec)
|
|
||||||
(define timer-id (gensym 'sleep))
|
|
||||||
(until (message (timer-expired timer-id _))
|
|
||||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
||||||
|
|
||||||
;; Shell
|
|
||||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
|
||||||
(define (print-prompt)
|
|
||||||
(printf "> ")
|
|
||||||
(flush-output))
|
|
||||||
(define reader-count 0)
|
|
||||||
(define (generate-reader-id)
|
|
||||||
(begin0 reader-count
|
|
||||||
(set! reader-count (+ reader-count 1))))
|
|
||||||
(actor (print-prompt)
|
|
||||||
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
|
||||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
||||||
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
|
||||||
[(list "open" name)
|
|
||||||
(define reader-id (generate-reader-id))
|
|
||||||
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
|
||||||
(until (message `(stop-watching ,name))
|
|
||||||
(on (asserted (file name $contents))
|
|
||||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
|
||||||
reader-id
|
|
||||||
name
|
|
||||||
contents)))
|
|
||||||
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
|
||||||
[(list "close" name)
|
|
||||||
(send! `(stop-watching ,name))]
|
|
||||||
[(list* "write" name words)
|
|
||||||
(send! (save (file name words)))]
|
|
||||||
[(list "delete" name)
|
|
||||||
(send! (delete name))]
|
|
||||||
[_
|
|
||||||
(printf "I'm afraid I didn't understand that.\n")
|
|
||||||
(printf "Try: open filename\n")
|
|
||||||
(printf " close filename\n")
|
|
||||||
(printf " write filename some text goes here\n")
|
|
||||||
(printf " delete filename\n")])
|
|
||||||
(sleep 0.1)
|
|
||||||
(print-prompt)))))
|
|
||||||
|
|
|
@ -2,13 +2,8 @@
|
||||||
;; Toy file system, based on the example in the ESOP2016 submission.
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
||||||
;; syndicate/actor implementation.
|
;; syndicate/actor implementation.
|
||||||
|
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate "fs-shell.rkt")
|
||||||
(require (only-in racket/port read-bytes-line-evt))
|
(require/activate "fs-protocol.rkt")
|
||||||
(require (only-in racket/string string-trim string-split))
|
|
||||||
|
|
||||||
(struct file (name content) #:prefab)
|
|
||||||
(struct save (file) #:prefab)
|
|
||||||
(struct delete (name) #:prefab)
|
|
||||||
|
|
||||||
(actor (react (field [files (hash)])
|
(actor (react (field [files (hash)])
|
||||||
(on (asserted (observe (file $name _)))
|
(on (asserted (observe (file $name _)))
|
||||||
|
@ -21,46 +16,3 @@
|
||||||
(printf "No remaining readers exist for ~v\n" name)))
|
(printf "No remaining readers exist for ~v\n" name)))
|
||||||
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
|
(on (message (save (file $name $content))) (files (hash-set (files) name content)))
|
||||||
(on (message (delete $name)) (files (hash-remove (files) name)))))
|
(on (message (delete $name)) (files (hash-remove (files) name)))))
|
||||||
|
|
||||||
(define (sleep sec)
|
|
||||||
(define timer-id (gensym 'sleep))
|
|
||||||
(until (message (timer-expired timer-id _))
|
|
||||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
||||||
|
|
||||||
;; Shell
|
|
||||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
|
||||||
(define (print-prompt)
|
|
||||||
(printf "> ")
|
|
||||||
(flush-output))
|
|
||||||
(define reader-count 0)
|
|
||||||
(define (generate-reader-id)
|
|
||||||
(begin0 reader-count
|
|
||||||
(set! reader-count (+ reader-count 1))))
|
|
||||||
(actor (print-prompt)
|
|
||||||
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
|
||||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
||||||
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
|
||||||
[(list "open" name)
|
|
||||||
(define reader-id (generate-reader-id))
|
|
||||||
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
|
||||||
(until (message `(stop-watching ,name))
|
|
||||||
(on (asserted (file name $contents))
|
|
||||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
|
||||||
reader-id
|
|
||||||
name
|
|
||||||
contents)))
|
|
||||||
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
|
||||||
[(list "close" name)
|
|
||||||
(send! `(stop-watching ,name))]
|
|
||||||
[(list* "write" name words)
|
|
||||||
(send! (save (file name words)))]
|
|
||||||
[(list "delete" name)
|
|
||||||
(send! (delete name))]
|
|
||||||
[_
|
|
||||||
(printf "I'm afraid I didn't understand that.\n")
|
|
||||||
(printf "Try: open filename\n")
|
|
||||||
(printf " close filename\n")
|
|
||||||
(printf " write filename some text goes here\n")
|
|
||||||
(printf " delete filename\n")])
|
|
||||||
(sleep 0.1)
|
|
||||||
(print-prompt)))))
|
|
||||||
|
|
|
@ -2,15 +2,10 @@
|
||||||
;; Toy file system, based on the example in the ESOP2016 submission.
|
;; Toy file system, based on the example in the ESOP2016 submission.
|
||||||
;; syndicate/actor implementation, without subconversation.
|
;; syndicate/actor implementation, without subconversation.
|
||||||
|
|
||||||
(require/activate syndicate/drivers/timer)
|
(require/activate "fs-shell.rkt")
|
||||||
(require (only-in racket/port read-bytes-line-evt))
|
(require/activate "fs-protocol.rkt")
|
||||||
(require (only-in racket/string string-trim string-split))
|
|
||||||
(require racket/set)
|
(require racket/set)
|
||||||
|
|
||||||
(struct file (name content) #:prefab)
|
|
||||||
(struct save (file) #:prefab)
|
|
||||||
(struct delete (name) #:prefab)
|
|
||||||
|
|
||||||
(actor (react (field [files (hash)] [monitored (set)])
|
(actor (react (field [files (hash)] [monitored (set)])
|
||||||
(on (asserted (observe (file $name _)))
|
(on (asserted (observe (file $name _)))
|
||||||
(printf "At least one reader exists for ~v\n" name)
|
(printf "At least one reader exists for ~v\n" name)
|
||||||
|
@ -30,46 +25,3 @@
|
||||||
(retract! (file name (hash-ref (files) name #f)))
|
(retract! (file name (hash-ref (files) name #f)))
|
||||||
(assert! (file name #f)))
|
(assert! (file name #f)))
|
||||||
(files (hash-remove (files) name)))))
|
(files (hash-remove (files) name)))))
|
||||||
|
|
||||||
(define (sleep sec)
|
|
||||||
(define timer-id (gensym 'sleep))
|
|
||||||
(until (message (timer-expired timer-id _))
|
|
||||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
|
||||||
|
|
||||||
;; Shell
|
|
||||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
|
||||||
(define (print-prompt)
|
|
||||||
(printf "> ")
|
|
||||||
(flush-output))
|
|
||||||
(define reader-count 0)
|
|
||||||
(define (generate-reader-id)
|
|
||||||
(begin0 reader-count
|
|
||||||
(set! reader-count (+ reader-count 1))))
|
|
||||||
(actor (print-prompt)
|
|
||||||
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
|
||||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
|
||||||
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
|
||||||
[(list "open" name)
|
|
||||||
(define reader-id (generate-reader-id))
|
|
||||||
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
|
||||||
(until (message `(stop-watching ,name))
|
|
||||||
(on (asserted (file name $contents))
|
|
||||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
|
||||||
reader-id
|
|
||||||
name
|
|
||||||
contents)))
|
|
||||||
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
|
||||||
[(list "close" name)
|
|
||||||
(send! `(stop-watching ,name))]
|
|
||||||
[(list* "write" name words)
|
|
||||||
(send! (save (file name words)))]
|
|
||||||
[(list "delete" name)
|
|
||||||
(send! (delete name))]
|
|
||||||
[_
|
|
||||||
(printf "I'm afraid I didn't understand that.\n")
|
|
||||||
(printf "Try: open filename\n")
|
|
||||||
(printf " close filename\n")
|
|
||||||
(printf " write filename some text goes here\n")
|
|
||||||
(printf " delete filename\n")])
|
|
||||||
(sleep 0.1)
|
|
||||||
(print-prompt)))))
|
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; File System Demo protocol
|
||||||
|
|
||||||
|
(provide (struct-out file)
|
||||||
|
(struct-out save)
|
||||||
|
(struct-out delete))
|
||||||
|
|
||||||
|
(struct file (name content) #:prefab)
|
||||||
|
(struct save (file) #:prefab)
|
||||||
|
(struct delete (name) #:prefab)
|
|
@ -0,0 +1,51 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; Simple "shell" or REPL, used by the file-system demos.
|
||||||
|
|
||||||
|
(require (only-in racket/port read-bytes-line-evt))
|
||||||
|
(require (only-in racket/string string-trim string-split))
|
||||||
|
|
||||||
|
(require/activate syndicate/drivers/timer)
|
||||||
|
(require/activate "fs-protocol.rkt")
|
||||||
|
|
||||||
|
(define (sleep sec)
|
||||||
|
(define timer-id (gensym 'sleep))
|
||||||
|
(until (message (timer-expired timer-id _))
|
||||||
|
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
||||||
|
|
||||||
|
;; Shell
|
||||||
|
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
||||||
|
(define (print-prompt)
|
||||||
|
(printf "> ")
|
||||||
|
(flush-output))
|
||||||
|
(define reader-count 0)
|
||||||
|
(define (generate-reader-id)
|
||||||
|
(begin0 reader-count
|
||||||
|
(set! reader-count (+ reader-count 1))))
|
||||||
|
(actor (print-prompt)
|
||||||
|
(until (message (inbound (external-event e (list (? eof-object? _)))))
|
||||||
|
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
||||||
|
(match (string-split (string-trim (bytes->string/utf-8 bs)))
|
||||||
|
[(list "open" name)
|
||||||
|
(define reader-id (generate-reader-id))
|
||||||
|
(actor (printf "Reader ~a opening file ~v.\n" reader-id name)
|
||||||
|
(until (message `(stop-watching ,name))
|
||||||
|
(on (asserted (file name $contents))
|
||||||
|
(printf "Reader ~a sees that ~v contains: ~v\n"
|
||||||
|
reader-id
|
||||||
|
name
|
||||||
|
contents)))
|
||||||
|
(printf "Reader ~a closing file ~v.\n" reader-id name))]
|
||||||
|
[(list "close" name)
|
||||||
|
(send! `(stop-watching ,name))]
|
||||||
|
[(list* "write" name words)
|
||||||
|
(send! (save (file name words)))]
|
||||||
|
[(list "delete" name)
|
||||||
|
(send! (delete name))]
|
||||||
|
[_
|
||||||
|
(printf "I'm afraid I didn't understand that.\n")
|
||||||
|
(printf "Try: open filename\n")
|
||||||
|
(printf " close filename\n")
|
||||||
|
(printf " write filename some text goes here\n")
|
||||||
|
(printf " delete filename\n")])
|
||||||
|
(sleep 0.1)
|
||||||
|
(print-prompt)))))
|
Loading…
Reference in New Issue