From e2897d37f4b59e5be9c0021c4442388b00f7c1f3 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sun, 31 Jul 2016 12:17:12 -0400 Subject: [PATCH] Factor out commonality from file-system*.rkt examples --- .../examples/actor/file-system-during.rkt | 52 +----------------- .../examples/actor/file-system-lll.rkt | 55 ++----------------- .../examples/actor/file-system-lll2.rkt | 55 ++----------------- .../syndicate/examples/actor/file-system.rkt | 52 +----------------- .../syndicate/examples/actor/file-system2.rkt | 52 +----------------- .../syndicate/examples/actor/fs-protocol.rkt | 10 ++++ racket/syndicate/examples/actor/fs-shell.rkt | 51 +++++++++++++++++ 7 files changed, 75 insertions(+), 252 deletions(-) create mode 100644 racket/syndicate/examples/actor/fs-protocol.rkt create mode 100644 racket/syndicate/examples/actor/fs-shell.rkt diff --git a/racket/syndicate/examples/actor/file-system-during.rkt b/racket/syndicate/examples/actor/file-system-during.rkt index 23631ab..da3dde3 100644 --- a/racket/syndicate/examples/actor/file-system-during.rkt +++ b/racket/syndicate/examples/actor/file-system-during.rkt @@ -2,13 +2,8 @@ ;; Toy file system, based on the example in the ESOP2016 submission. ;; syndicate/actor implementation, using "during" instead of "on asserted/until retracted". -(require/activate syndicate/drivers/timer) -(require (only-in racket/port read-bytes-line-evt)) -(require (only-in racket/string string-trim string-split)) - -(struct file (name content) #:prefab) -(struct save (file) #:prefab) -(struct delete (name) #:prefab) +(require/activate "fs-shell.rkt") +(require/activate "fs-protocol.rkt") (actor (react (field [files (hash)]) (during (observe (file $name _)) @@ -20,46 +15,3 @@ (on (message (delete name)) (content #f))) (on (message (save (file $name $content))) (files (hash-set (files) name content))) (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))))) diff --git a/racket/syndicate/examples/actor/file-system-lll.rkt b/racket/syndicate/examples/actor/file-system-lll.rkt index 0e4b1df..e119655 100644 --- a/racket/syndicate/examples/actor/file-system-lll.rkt +++ b/racket/syndicate/examples/actor/file-system-lll.rkt @@ -2,15 +2,11 @@ ;; Toy file system, based on the example in the ESOP2016 submission. ;; Low-level implementation. -(require (only-in syndicate [assert core:assert])) -(require/activate syndicate/drivers/timer) -(require (only-in racket/port read-bytes-line-evt)) -(require (only-in racket/string string-trim string-split)) -(require racket/set) +(require/activate "fs-shell.rkt") +(require/activate "fs-protocol.rkt") -(struct file (name content) #:prefab) -(struct save (file) #:prefab) -(struct delete (name) #:prefab) +(require (only-in syndicate [assert core:assert])) +(require racket/set) (define (file-system-event-handler e files) (match-event e @@ -51,46 +47,3 @@ (update-file content name new-content)] [(message (delete (== name))) (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))))) diff --git a/racket/syndicate/examples/actor/file-system-lll2.rkt b/racket/syndicate/examples/actor/file-system-lll2.rkt index ea7f61b..221ac2e 100644 --- a/racket/syndicate/examples/actor/file-system-lll2.rkt +++ b/racket/syndicate/examples/actor/file-system-lll2.rkt @@ -2,15 +2,11 @@ ;; Toy file system, based on the example in the ESOP2016 submission. ;; Low-level implementation, without subconversation. -(require (only-in syndicate [assert core:assert])) -(require/activate syndicate/drivers/timer) -(require (only-in racket/port read-bytes-line-evt)) -(require (only-in racket/string string-trim string-split)) -(require racket/set) +(require/activate "fs-shell.rkt") +(require/activate "fs-protocol.rkt") -(struct file (name content) #:prefab) -(struct save (file) #:prefab) -(struct delete (name) #:prefab) +(require (only-in syndicate [assert core:assert])) +(require racket/set) (struct fs-state (files monitored) #:prefab) @@ -52,46 +48,3 @@ (patch-seq (sub (observe (file ? ?))) (sub (save (file ? ?))) (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))))) diff --git a/racket/syndicate/examples/actor/file-system.rkt b/racket/syndicate/examples/actor/file-system.rkt index 32cacd3..4bbb65e 100644 --- a/racket/syndicate/examples/actor/file-system.rkt +++ b/racket/syndicate/examples/actor/file-system.rkt @@ -2,13 +2,8 @@ ;; Toy file system, based on the example in the ESOP2016 submission. ;; syndicate/actor implementation. -(require/activate syndicate/drivers/timer) -(require (only-in racket/port read-bytes-line-evt)) -(require (only-in racket/string string-trim string-split)) - -(struct file (name content) #:prefab) -(struct save (file) #:prefab) -(struct delete (name) #:prefab) +(require/activate "fs-shell.rkt") +(require/activate "fs-protocol.rkt") (actor (react (field [files (hash)]) (on (asserted (observe (file $name _))) @@ -21,46 +16,3 @@ (printf "No remaining readers exist for ~v\n" name))) (on (message (save (file $name $content))) (files (hash-set (files) name content))) (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))))) diff --git a/racket/syndicate/examples/actor/file-system2.rkt b/racket/syndicate/examples/actor/file-system2.rkt index 1fce33f..3ef3af2 100644 --- a/racket/syndicate/examples/actor/file-system2.rkt +++ b/racket/syndicate/examples/actor/file-system2.rkt @@ -2,15 +2,10 @@ ;; Toy file system, based on the example in the ESOP2016 submission. ;; syndicate/actor implementation, without subconversation. -(require/activate syndicate/drivers/timer) -(require (only-in racket/port read-bytes-line-evt)) -(require (only-in racket/string string-trim string-split)) +(require/activate "fs-shell.rkt") +(require/activate "fs-protocol.rkt") (require racket/set) -(struct file (name content) #:prefab) -(struct save (file) #:prefab) -(struct delete (name) #:prefab) - (actor (react (field [files (hash)] [monitored (set)]) (on (asserted (observe (file $name _))) (printf "At least one reader exists for ~v\n" name) @@ -30,46 +25,3 @@ (retract! (file name (hash-ref (files) name #f))) (assert! (file name #f))) (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))))) diff --git a/racket/syndicate/examples/actor/fs-protocol.rkt b/racket/syndicate/examples/actor/fs-protocol.rkt new file mode 100644 index 0000000..1697956 --- /dev/null +++ b/racket/syndicate/examples/actor/fs-protocol.rkt @@ -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) diff --git a/racket/syndicate/examples/actor/fs-shell.rkt b/racket/syndicate/examples/actor/fs-shell.rkt new file mode 100644 index 0000000..7755a64 --- /dev/null +++ b/racket/syndicate/examples/actor/fs-shell.rkt @@ -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)))))