From edaf97ae05ef4839dd11b6936b586414091962d3 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Sat, 12 Dec 2015 07:02:13 +1300 Subject: [PATCH] Simplify and rename %%boot to actor-body->spawn-action --- prospect/actor.rkt | 6 +- prospect/examples/actor/box-and-client.rkt | 22 ++-- prospect/examples/actor/chat.rkt | 19 ++-- prospect/examples/actor/file-system.rkt | 111 ++++++++++----------- 4 files changed, 75 insertions(+), 83 deletions(-) diff --git a/prospect/actor.rkt b/prospect/actor.rkt index 4d7e8de..9977abf 100644 --- a/prospect/actor.rkt +++ b/prospect/actor.rkt @@ -17,7 +17,7 @@ ;; forall - %%boot + actor-body->spawn-action ;;---------------------------------------- (struct-out actor-state) @@ -330,9 +330,9 @@ (script-complete-instruction new-variables))))) (void)))) -(define (%%boot thunk) +(define (actor-body->spawn-action thunk) (match ((reply-to (lambda (dummy) - (thunk) + (actor (thunk)) (error '%%boot "Reached end of boot thunk"))) (void)) [(spawn-instruction 'actor action-fn _get-next-instr) diff --git a/prospect/examples/actor/box-and-client.rkt b/prospect/examples/actor/box-and-client.rkt index 7c576ab..d61c3e3 100644 --- a/prospect/examples/actor/box-and-client.rkt +++ b/prospect/examples/actor/box-and-client.rkt @@ -6,17 +6,15 @@ (struct set-box (new-value) #:transparent) (struct box-state (value) #:transparent) -(%%boot +(actor-body->spawn-action (lambda () - (actor + (actor (forever #:collect [(current-value 0)] + (assert (box-state current-value)) + (on (message (set-box $new-value)) + (log-info "box: taking on new-value ~v" new-value) + new-value))) - (actor (forever #:collect [(current-value 0)] - (assert (box-state current-value)) - (on (message (set-box $new-value)) - (log-info "box: taking on new-value ~v" new-value) - new-value))) - - (actor (forever (on (asserted (box-state $v)) - (log-info "client: learned that box's value is now ~v" v) - (send! (set-box (+ v 1)))))) - ))) + (actor (forever (on (asserted (box-state $v)) + (log-info "client: learned that box's value is now ~v" v) + (send! (set-box (+ v 1)))))) + )) diff --git a/prospect/examples/actor/chat.rkt b/prospect/examples/actor/chat.rkt index b03e2e1..b44d6fa 100644 --- a/prospect/examples/actor/chat.rkt +++ b/prospect/examples/actor/chat.rkt @@ -34,16 +34,11 @@ (send! (shutdown)) (send! (says user input-string))))))) -(%%boot +(actor-body->spawn-action (lambda () - (actor - - (perform-core-action! (spawn-tcp-driver)) - - (network (define us (tcp-listener 5000)) - (until (message (shutdown)) - (assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1) - (on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1) - (spawn-session them us)))) - - ))) + (perform-core-action! (spawn-tcp-driver)) + (network (define us (tcp-listener 5000)) + (until (message (shutdown)) + (assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1) + (on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1) + (spawn-session them us)))))) diff --git a/prospect/examples/actor/file-system.rkt b/prospect/examples/actor/file-system.rkt index e423f5e..d4ecd96 100644 --- a/prospect/examples/actor/file-system.rkt +++ b/prospect/examples/actor/file-system.rkt @@ -10,65 +10,64 @@ (struct save (file) #:prefab) (struct delete (name) #:prefab) -(%%boot +(actor-body->spawn-action (lambda () - (actor - (perform-core-action! (spawn-timer-driver)) + (perform-core-action! (spawn-timer-driver)) - (actor (forever #:collect [(files (hash))] - (on (asserted (observe (file $name _))) - (printf "At least one reader exists for ~v\n" name) - (begin0 (until (retracted (observe (file name _))) - #:collect [(content (hash-ref files name #f))] - (assert (file name content)) - (on (message (save (file name $content))) content) - (on (message (delete name)) #f)) - (printf "No remaining readers exist for ~v\n" name))) - (on (message (save (file $name $content))) (hash-set files name content)) - (on (message (delete $name)) (hash-remove files name)))) + (actor (forever #:collect [(files (hash))] + (on (asserted (observe (file $name _))) + (printf "At least one reader exists for ~v\n" name) + (begin0 (until (retracted (observe (file name _))) + #:collect [(content (hash-ref files name #f))] + (assert (file name content)) + (on (message (save (file name $content))) content) + (on (message (delete name)) #f)) + (printf "No remaining readers exist for ~v\n" name))) + (on (message (save (file $name $content))) (hash-set files name content)) + (on (message (delete $name)) (hash-remove files name)))) - (define (sleep sec) - (define timer-id (gensym 'sleep)) - (until (message (timer-expired timer-id _)) - #:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))])) + (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))))) + ;; 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))))) - ))) + ))