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

Simplify and rename %%boot to actor-body->spawn-action

This commit is contained in:
Tony Garnock-Jones 2015-12-12 07:02:13 +13:00
parent 97dceedff2
commit edaf97ae05
4 changed files with 75 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
prospect/actor.rkt
View File

@ -17,7 +17,7 @@
;; forall ;; forall
%%boot actor-body->spawn-action
;;---------------------------------------- ;;----------------------------------------
(struct-out actor-state) (struct-out actor-state)
@ -330,9 +330,9 @@
(script-complete-instruction new-variables))))) (script-complete-instruction new-variables)))))
(void)))) (void))))
(define (%%boot thunk) (define (actor-body->spawn-action thunk)
(match ((reply-to (lambda (dummy) (match ((reply-to (lambda (dummy)
(thunk) (actor (thunk))
(error '%%boot "Reached end of boot thunk"))) (error '%%boot "Reached end of boot thunk")))
(void)) (void))
[(spawn-instruction 'actor action-fn _get-next-instr) [(spawn-instruction 'actor action-fn _get-next-instr)

22
prospect/examples/actor/box-and-client.rkt
View File

@ -6,17 +6,15 @@
(struct set-box (new-value) #:transparent) (struct set-box (new-value) #:transparent)
(struct box-state (value) #:transparent) (struct box-state (value) #:transparent)
(%%boot (actor-body->spawn-action
(lambda () (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)] (actor (forever (on (asserted (box-state $v))
(assert (box-state current-value)) (log-info "client: learned that box's value is now ~v" v)
(on (message (set-box $new-value)) (send! (set-box (+ v 1))))))
(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))))))
)))

19
prospect/examples/actor/chat.rkt
View File

@ -34,16 +34,11 @@
(send! (shutdown)) (send! (shutdown))
(send! (says user input-string))))))) (send! (says user input-string)))))))
(%%boot (actor-body->spawn-action
(lambda () (lambda ()
(actor (perform-core-action! (spawn-tcp-driver))
(network (define us (tcp-listener 5000))
(perform-core-action! (spawn-tcp-driver)) (until (message (shutdown))
(assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)
(network (define us (tcp-listener 5000)) (on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1)
(until (message (shutdown)) (spawn-session them us))))))
(assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)
(on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1)
(spawn-session them us))))
)))

111
prospect/examples/actor/file-system.rkt
View File

@ -10,65 +10,64 @@
(struct save (file) #:prefab) (struct save (file) #:prefab)
(struct delete (name) #:prefab) (struct delete (name) #:prefab)
(%%boot (actor-body->spawn-action
(lambda () (lambda ()
(actor
(perform-core-action! (spawn-timer-driver)) (perform-core-action! (spawn-timer-driver))
(actor (forever #:collect [(files (hash))] (actor (forever #:collect [(files (hash))]
(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)
(begin0 (until (retracted (observe (file name _))) (begin0 (until (retracted (observe (file name _)))
#:collect [(content (hash-ref files name #f))] #:collect [(content (hash-ref files name #f))]
(assert (file name content)) (assert (file name content))
(on (message (save (file name $content))) content) (on (message (save (file name $content))) content)
(on (message (delete name)) #f)) (on (message (delete name)) #f))
(printf "No remaining readers exist for ~v\n" name))) (printf "No remaining readers exist for ~v\n" name)))
(on (message (save (file $name $content))) (hash-set files name content)) (on (message (save (file $name $content))) (hash-set files name content))
(on (message (delete $name)) (hash-remove files name)))) (on (message (delete $name)) (hash-remove files name))))
(define (sleep sec) (define (sleep sec)
(define timer-id (gensym 'sleep)) (define timer-id (gensym 'sleep))
(until (message (timer-expired timer-id _)) (until (message (timer-expired timer-id _))
#:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))])) #:init [(send! (set-timer timer-id (* sec 1000.0) 'relative))]))
;; Shell ;; Shell
(let ((e (read-bytes-line-evt (current-input-port) 'any))) (let ((e (read-bytes-line-evt (current-input-port) 'any)))
(define (print-prompt) (define (print-prompt)
(printf "> ") (printf "> ")
(flush-output)) (flush-output))
(define reader-count 0) (define reader-count 0)
(define (generate-reader-id) (define (generate-reader-id)
(begin0 reader-count (begin0 reader-count
(set! reader-count (+ reader-count 1)))) (set! reader-count (+ reader-count 1))))
(actor (print-prompt) (actor (print-prompt)
(until (message (external-event e (list (? eof-object? _))) #:meta-level 1) (until (message (external-event e (list (? eof-object? _))) #:meta-level 1)
(on (message (external-event e (list (? bytes? $bs))) #:meta-level 1) (on (message (external-event e (list (? bytes? $bs))) #:meta-level 1)
(match (string-split (string-trim (bytes->string/utf-8 bs))) (match (string-split (string-trim (bytes->string/utf-8 bs)))
[(list "open" name) [(list "open" name)
(define reader-id (generate-reader-id)) (define reader-id (generate-reader-id))
(actor (printf "Reader ~a opening file ~v.\n" reader-id name) (actor (printf "Reader ~a opening file ~v.\n" reader-id name)
(until (message `(stop-watching ,name)) (until (message `(stop-watching ,name))
(on (asserted (file name $contents)) (on (asserted (file name $contents))
(printf "Reader ~a sees that ~v contains: ~v\n" (printf "Reader ~a sees that ~v contains: ~v\n"
reader-id reader-id
name name
contents))) contents)))
(printf "Reader ~a closing file ~v.\n" reader-id name))] (printf "Reader ~a closing file ~v.\n" reader-id name))]
[(list "close" name) [(list "close" name)
(send! `(stop-watching ,name))] (send! `(stop-watching ,name))]
[(list* "write" name words) [(list* "write" name words)
(send! (save (file name words)))] (send! (save (file name words)))]
[(list "delete" name) [(list "delete" name)
(send! (delete name))] (send! (delete name))]
[_ [_
(printf "I'm afraid I didn't understand that.\n") (printf "I'm afraid I didn't understand that.\n")
(printf "Try: open filename\n") (printf "Try: open filename\n")
(printf " close filename\n") (printf " close filename\n")
(printf " write filename some text goes here\n") (printf " write filename some text goes here\n")
(printf " delete filename\n")]) (printf " delete filename\n")])
(sleep 0.1) (sleep 0.1)
(print-prompt))))) (print-prompt)))))
))) ))