syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

More file system variations

This commit is contained in:
Tony Garnock-Jones 2016-02-29 09:43:25 -05:00
parent f8f61dd43d
commit 5b328a1786
4 changed files with 199 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
prospect/examples/actor/file-system-lll.rkt
View File

@ -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)

100
prospect/examples/actor/file-system-lll2.rkt Normal file
View File

@ -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)))))

14
prospect/examples/actor/file-system-script Normal file
View File

@ -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

78
prospect/examples/actor/file-system2.rkt Normal file
View File

@ -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)))))