quit-world action
This commit is contained in:
parent
f5d331b0d8
commit
d7095c9995
|
@ -3,6 +3,7 @@
|
|||
|
||||
(provide (struct-out message)
|
||||
(except-out (struct-out quit) quit)
|
||||
(struct-out quit-world)
|
||||
(rename-out [quit <quit>])
|
||||
(except-out (struct-out spawn) spawn)
|
||||
(rename-out [spawn <spawn>])
|
||||
|
@ -73,6 +74,7 @@
|
|||
|
||||
;; Actions ⊃ Events
|
||||
(struct spawn (boot) #:prefab)
|
||||
(struct quit-world () #:prefab) ;; NB. An action. Compare (quit), a Transition.
|
||||
|
||||
;; A Behavior is a ((Option Event) Any -> Transition): a function
|
||||
;; mapping an Event (or, in the #f case, a poll signal) and a
|
||||
|
@ -115,7 +117,7 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (event? x) (or (patch? x) (message? x)))
|
||||
(define (action? x) (or (event? x) (spawn? x)))
|
||||
(define (action? x) (or (event? x) (spawn? x) (quit-world? x)))
|
||||
|
||||
(define (prepend-at-meta pattern level)
|
||||
(if (zero? level)
|
||||
|
@ -333,6 +335,8 @@
|
|||
;; ^ behavior & state already removed by disable-process
|
||||
patches
|
||||
meta-action)]
|
||||
[(quit-world)
|
||||
(make-quit)]
|
||||
[(? patch? delta-orig)
|
||||
(define-values (new-mux _label patches meta-action)
|
||||
(mux-update-stream (world-mux w) label delta-orig))
|
||||
|
|
|
@ -0,0 +1,36 @@
|
|||
#lang prospect
|
||||
;; Demonstrates quit-world.
|
||||
|
||||
(require (only-in racket/port read-bytes-line-evt))
|
||||
|
||||
(define (spawn-command-listener)
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (at-meta (at-meta (external-event _ (list #"quit")))))
|
||||
(printf "Quitting just the leaf actor.\n")
|
||||
(quit)]
|
||||
[(message (at-meta (at-meta (external-event _ (list #"quit-world")))))
|
||||
(printf "Terminating the whole network.\n")
|
||||
(transition s (quit-world))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(sub (external-event (read-bytes-line-evt (current-input-port) 'any) ?)
|
||||
#:meta-level 2)))
|
||||
|
||||
(define (spawn-ticker)
|
||||
(define (sub-to-alarm)
|
||||
(sub (external-event (alarm-evt (+ (current-inexact-milliseconds) 1000)) ?) #:meta-level 2))
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(message (at-meta (at-meta (external-event _ _))))
|
||||
(printf "Tick!\n")
|
||||
(transition s
|
||||
(list (retract ?)
|
||||
(sub-to-alarm)))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(sub-to-alarm)))
|
||||
|
||||
(printf "Type 'quit' or 'quit-world'.\n")
|
||||
(spawn-world (spawn-command-listener)
|
||||
(spawn-ticker))
|
|
@ -171,6 +171,9 @@
|
|||
(unless (matcher-empty? interests)
|
||||
(output "~a's final interests:\n" pidstr)
|
||||
(pretty-print-matcher interests (current-error-port))))]
|
||||
[(quit-world)
|
||||
(with-color BRIGHT-RED
|
||||
(output "Process ~a performed a quit-world.\n" pidstr))]
|
||||
[(? patch? p)
|
||||
(when (or show-actions? show-patch-actions?)
|
||||
(output "~a performing a patch:\n" pidstr)
|
||||
|
@ -180,7 +183,7 @@
|
|||
(output "~a sending a message:\n" pidstr)
|
||||
(pretty-write body (current-error-port)))])]
|
||||
[('internal-action-result (list pids a old-w t))
|
||||
(when t
|
||||
(when (transition? t)
|
||||
(define new-w (transition-state t))
|
||||
(define pidstr (format-pids pids))
|
||||
(define newcount (hash-count (world-behaviors new-w)))
|
||||
|
|
Loading…
Reference in New Issue