Simplify and rename %%boot to actor-body->spawn-action
This commit is contained in:
Tony Garnock-Jones
parent
97dceedff2
commit
edaf97ae05
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
))
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
||||
)))
|
||||
))
|
||||
|
|
|
|||
Loading…
Reference in New Issue