From 5b328a178628cb922443a1f668fe9ab9f94b2214 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 29 Feb 2016 09:43:25 -0500 Subject: [PATCH] More file system variations --- prospect/examples/actor/file-system-lll.rkt | 13 +-- prospect/examples/actor/file-system-lll2.rkt | 100 +++++++++++++++++++ prospect/examples/actor/file-system-script | 14 +++ prospect/examples/actor/file-system2.rkt | 78 +++++++++++++++ 4 files changed, 199 insertions(+), 6 deletions(-) create mode 100644 prospect/examples/actor/file-system-lll2.rkt create mode 100644 prospect/examples/actor/file-system-script create mode 100644 prospect/examples/actor/file-system2.rkt diff --git a/prospect/examples/actor/file-system-lll.rkt b/prospect/examples/actor/file-system-lll.rkt index 4232aea..bd211cd 100644 --- a/prospect/examples/actor/file-system-lll.rkt +++ b/prospect/examples/actor/file-system-lll.rkt @@ -15,6 +15,11 @@ (spawn-timer-driver) +(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 e [(? patch? p) @@ -23,13 +28,9 @@ (begin (printf "No remaining readers exist for ~v\n" name) (quit)))] [(message (save (file (== name) new-content))) - (transition new-content - (patch-seq (retract (file name content)) - (core:assert (file name new-content))))] + (update-file content name new-content)] [(message (delete (== name))) - (transition #f - (patch-seq (retract (file name content)) - (core:assert (file name #f))))] + (update-file content name #f)] [_ #f])) (define (file-system-event-handler e files) diff --git a/prospect/examples/actor/file-system-lll2.rkt b/prospect/examples/actor/file-system-lll2.rkt new file mode 100644 index 0000000..8987081 --- /dev/null +++ b/prospect/examples/actor/file-system-lll2.rkt @@ -0,0 +1,100 @@ +#lang prospect +;; Toy file system, based on the example in the ESOP2016 submission. +;; Low-level implementation, without subconversation. + +(require (only-in prospect [assert core:assert])) +(require prospect/actor) +(require prospect/drivers/timer) +(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) +(struct save (file) #:prefab) +(struct delete (name) #:prefab) + +(struct fs-state (files monitored) #:prefab) + +(spawn-timer-driver) + +(define (update-file state name new-content) + (transition (struct-copy fs-state state + [files (if new-content + (hash-set (fs-state-files state) name new-content) + (hash-remove (fs-state-files state) name))]) + (if (set-member? (fs-state-monitored state) name) + (patch-seq (retract (file name (hash-ref (fs-state-files state) name #f))) + (core:assert (file name new-content))) + '()))) + +(define (file-system-event-handler e state) + (match e + [(? patch? p) + (define monitored-to-add + (for-trie/set [((observe (file $name _)) (patch-added p))] name)) + (define monitored-to-remove + (for-trie/set [((observe (file $name _)) (patch-removed p))] name)) + (transition (struct-copy fs-state state + [monitored (set-subtract (set-union (fs-state-monitored state) + monitored-to-add) + monitored-to-remove)]) + (list (for/list [(name monitored-to-add)] + (printf "At least one reader exists for ~v\n" name) + (core:assert (file name (hash-ref (fs-state-files state) name #f)))) + (for/list [(name monitored-to-remove)] + (printf "No remaining readers exist for ~v\n" name) + (retract (file name ?)))))] + [(message (save (file name new-content))) + (update-file state name new-content)] + [(message (delete name)) + (update-file state name #f)] + [_ #f])) + +(spawn file-system-event-handler + (fs-state (hash) (set)) + (patch-seq (sub (observe (file ? ?))) + (sub (save (file ? ?))) + (sub (delete ?)))) + +(define (sleep sec) + (define timer-id (gensym 'sleep)) + (until (message (timer-expired timer-id _)) + #:init [(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 (external-event e (list (? eof-object? _))) #:meta-level 1) + (on (message (external-event e (list (? bytes? $bs))) #:meta-level 1) + (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/prospect/examples/actor/file-system-script b/prospect/examples/actor/file-system-script new file mode 100644 index 0000000..86acac6 --- /dev/null +++ b/prospect/examples/actor/file-system-script @@ -0,0 +1,14 @@ +write a hello +write b world +open a +open a +write a goodbye +open b +delete a +close a +write a another text +open a +close b +delete b +delete a +close a diff --git a/prospect/examples/actor/file-system2.rkt b/prospect/examples/actor/file-system2.rkt new file mode 100644 index 0000000..59726e7 --- /dev/null +++ b/prospect/examples/actor/file-system2.rkt @@ -0,0 +1,78 @@ +#lang prospect +;; Toy file system, based on the example in the ESOP2016 submission. +;; prospect/actor implementation, without subconversation. + +(require prospect/actor) +(require prospect/drivers/timer) +(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) +(struct save (file) #:prefab) +(struct delete (name) #:prefab) + +(spawn-timer-driver) + +(actor (forever #:collect [(files (hash)) (monitored (set))] + (on (asserted (observe (file $name _))) + (printf "At least one reader exists for ~v\n" name) + (assert! (file name (hash-ref files name #f))) + (values files (set-add monitored name))) + (on (retracted (observe (file $name _))) + (printf "No remaining readers exist for ~v\n" name) + (retract! (file name (hash-ref files name #f))) + (values files (set-remove monitored name))) + (on (message (save (file $name $content))) + (when (set-member? monitored name) + (retract! (file name (hash-ref files name #f))) + (assert! (file name content))) + (values (hash-set files name content) monitored)) + (on (message (delete $name)) + (when (set-member? monitored name) + (retract! (file name (hash-ref files name #f))) + (assert! (file name #f))) + (values (hash-remove files name) monitored)))) + +(define (sleep sec) + (define timer-id (gensym 'sleep)) + (until (message (timer-expired timer-id _)) + #:init [(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 (external-event e (list (? eof-object? _))) #:meta-level 1) + (on (message (external-event e (list (? bytes? $bs))) #:meta-level 1) + (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)))))