Rename World to Network
This commit is contained in:
parent
ad9a78b4a4
commit
aa9677dbe1
22
FAQ.md
22
FAQ.md
|
@ -2,7 +2,7 @@
|
|||
|
||||
* How do I run a prospect program?
|
||||
- `#lang prospect` collects actions (`spawn`s) from module toplevel and
|
||||
uses them as boot actions for a ground-level world. The alternative
|
||||
uses them as boot actions for a ground-level network. The alternative
|
||||
is to use a different #lang, and to call `run-ground` yourself; see an
|
||||
example in prospect/examples/example-plain.rkt.
|
||||
|
||||
|
@ -20,7 +20,7 @@
|
|||
p - lifecycle events (spawns, crashes, and quits)
|
||||
a - process actions
|
||||
g - dataspace contents
|
||||
Adding 'W' will show whole world-states too. Remove each individual
|
||||
Adding 'N' will show whole network-states too. Remove each individual
|
||||
character to turn off the corresponding trace facility; the default
|
||||
value of the variable is just the empty-string.
|
||||
|
||||
|
@ -68,7 +68,7 @@
|
|||
(spawn/stateless (lambda (event) ... (list action ...))
|
||||
initial-action ...)
|
||||
;; network of actors
|
||||
(spawn-world boot-action ...)
|
||||
(spawn-network boot-action ...)
|
||||
```
|
||||
|
||||
* How do actors at different levels communicate?
|
||||
|
@ -190,10 +190,10 @@
|
|||
|
||||
* I used `spawn` but the actor isn't being created. What happened?
|
||||
- The only two ways to spawn a process are to (a) supply the spawn instruction in
|
||||
that world's boot-actions, or (b) have some already-existing actor supply the
|
||||
that network's boot-actions, or (b) have some already-existing actor supply the
|
||||
spawn instruction in response to some event it receives. Note that calling `spawn`
|
||||
constructs a structure which is perhaps eventually interpreted by the containing
|
||||
world of an actor; it doesn't really "do" anything directly.
|
||||
network of an actor; it doesn't really "do" anything directly.
|
||||
|
||||
* Why does `patch-seq` exist? Aren't all the actions in a transition effectively `patch-seq`d together?
|
||||
- Effectively, yes, that is what happens. The difference is in the
|
||||
|
@ -217,15 +217,15 @@
|
|||
\
|
||||
net3
|
||||
```
|
||||
- use `spawn-world`:
|
||||
- use `spawn-network`:
|
||||
```racket
|
||||
#lang prospect
|
||||
(spawn-world <net1-spawns> ...)
|
||||
(spawn-world <net2-spawns> ...
|
||||
(spawn-world <net3-spawns> ...))
|
||||
(spawn-network <net1-spawns> ...)
|
||||
(spawn-network <net2-spawns> ...
|
||||
(spawn-network <net3-spawns> ...))
|
||||
```
|
||||
`spawn-world` expands into a regular `spawn` with an event-handler and
|
||||
state corresponding to a whole VM. The arguments to spawn-world are
|
||||
`spawn-network` expands into a regular `spawn` with an event-handler and
|
||||
state corresponding to a whole VM. The arguments to spawn-network are
|
||||
actions to take at boot time in the new VM.
|
||||
|
||||
* What is the outcome if I do `(assert X)` and then later `(patch-seq (retract ?) assert X)`?
|
||||
|
|
10
README.md
10
README.md
|
@ -6,7 +6,7 @@ Network-inspired extensions to a functional core represent imperative
|
|||
actions as values, giving side-effects locality and enabling
|
||||
composition of communicating processes.
|
||||
|
||||
Collaborating actors are grouped within task-specific *worlds* (a.k.a.
|
||||
Collaborating actors are grouped within task-specific *networks* (a.k.a.
|
||||
virtual machines) to scope their interactions. Conversations between
|
||||
actors are multi-party (using a publish/subscribe medium), and actors
|
||||
can easily participate in many such conversations at once.
|
||||
|
@ -14,15 +14,15 @@ can easily participate in many such conversations at once.
|
|||
Prospect makes *presence* notifications an integral part of pub/sub
|
||||
through its *shared dataspaces*, akin to
|
||||
[tuplespaces](https://en.wikipedia.org/wiki/Tuple_space). Each shared
|
||||
dataspace doubles as the pub/sub subscription table for its world.
|
||||
dataspace doubles as the pub/sub subscription table for its network.
|
||||
Actors react to *state change notifications* reporting changes in a
|
||||
dataspace, including new subscriptions created by peers and removal of
|
||||
subscriptions when a peer exits or crashes. State change notifications
|
||||
serve to communicate changes in demand for and supply of services,
|
||||
both within a single world and across nested layers of
|
||||
worlds-within-worlds. Programs can give up responsibility for
|
||||
both within a single network and across nested layers of
|
||||
networks-within-networks. Programs can give up responsibility for
|
||||
maintaining shared state and for scoping group communications, letting
|
||||
their containing world take on those burdens.
|
||||
their containing network take on those burdens.
|
||||
|
||||
## The code
|
||||
|
||||
|
|
|
@ -37,7 +37,7 @@
|
|||
(idle 0 (- mx dx) (- my dy))]))
|
||||
(actor (idle 0 orig-x orig-y)))
|
||||
|
||||
(big-bang-world #:width 640
|
||||
(big-bang-network #:width 640
|
||||
#:height 480
|
||||
(actor (forever
|
||||
(on (asserted (active-window $id) #:meta-level 1)
|
||||
|
|
|
@ -19,13 +19,13 @@
|
|||
(on `(,$who says ,$what) (say who "says: ~a" what))
|
||||
(on (message (at-meta (tcp-channel them us $bs)))
|
||||
(define input-string (string-trim (bytes->string/utf-8 bs)))
|
||||
(if (equal? input-string "quit-world")
|
||||
(assert! 'quit-world)
|
||||
(if (equal? input-string "quit-network")
|
||||
(assert! 'quit-network)
|
||||
(send! `(,user says ,input-string)))))
|
||||
(send-to-remote "Goodbye!\n")))
|
||||
|
||||
(spawn-tcp-driver)
|
||||
(let ((us (tcp-listener 5999)))
|
||||
(group (until (asserted 'quit-world)
|
||||
(group (until (asserted 'quit-network)
|
||||
(on (asserted (advertise (tcp-channel $them us ?)) #:meta-level 1)
|
||||
(spawn-session them us)))))
|
||||
|
|
|
@ -50,8 +50,8 @@
|
|||
(require racket/set)
|
||||
(require racket/match)
|
||||
|
||||
(require (except-in "core.rkt" assert)
|
||||
(rename-in "core.rkt" [assert core:assert]))
|
||||
(require (except-in "core.rkt" assert network)
|
||||
(rename-in "core.rkt" [assert core:assert] [network core:network]))
|
||||
(require "route.rkt")
|
||||
(require "mux.rkt")
|
||||
|
||||
|
@ -249,7 +249,7 @@
|
|||
(expand-state 'network
|
||||
#'(I
|
||||
...
|
||||
(perform-core-action! (quit-world))
|
||||
(perform-core-action! (quit-network))
|
||||
(return/no-link-result!))
|
||||
#'()
|
||||
#'()
|
||||
|
@ -371,7 +371,7 @@
|
|||
(store-continuation s callee-id get-next-instr)
|
||||
s)
|
||||
(if (eq? linkage-kind 'network)
|
||||
(spawn-world spawn-action)
|
||||
(spawn-network spawn-action)
|
||||
spawn-action)))))
|
||||
(if blocking?
|
||||
next-t
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide big-bang-world
|
||||
big-bang-universe
|
||||
(provide big-bang-network
|
||||
big-bang-network/universe
|
||||
(struct-out window)
|
||||
(struct-out to-server)
|
||||
(struct-out from-server)
|
||||
|
@ -48,7 +48,7 @@
|
|||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(struct bb (world windows inbound outbound halted? x y) #:transparent)
|
||||
(struct bb (network windows inbound outbound halted? x y) #:transparent)
|
||||
|
||||
(define window-projection (compile-projection (?! (window ? ? ? ? ?))))
|
||||
|
||||
|
@ -72,7 +72,7 @@
|
|||
(matcher-match-value (patch-added p) 'stop #f))]))
|
||||
|
||||
(define (deliver b e)
|
||||
(clean-transition (world-handle-event e (bb-world b))))
|
||||
(clean-transition (network-handle-event e (bb-network b))))
|
||||
|
||||
(define (interpret-actions b txn need-poll?)
|
||||
(match txn
|
||||
|
@ -88,8 +88,8 @@
|
|||
[(cons e rest)
|
||||
(let ((b (struct-copy bb b [inbound rest])))
|
||||
(interpret-actions b (deliver b e) #t))])]
|
||||
[(transition new-world actions)
|
||||
(let process-actions ((b (struct-copy bb b [world new-world])) (actions actions))
|
||||
[(transition new-network actions)
|
||||
(let process-actions ((b (struct-copy bb b [network new-network])) (actions actions))
|
||||
(match actions
|
||||
['() (interpret-actions b #f #t)]
|
||||
[(cons a actions)
|
||||
|
@ -126,8 +126,8 @@
|
|||
(patch-seq (retract (active-window ?))
|
||||
(assert (active-window active-id))))
|
||||
|
||||
(define-syntax-rule (big-bang-world* boot-actions extra-clause ...)
|
||||
(big-bang (interpret-actions (bb (make-world boot-actions)
|
||||
(define-syntax-rule (big-bang-network* boot-actions extra-clause ...)
|
||||
(big-bang (interpret-actions (bb (make-network boot-actions)
|
||||
'()
|
||||
'()
|
||||
'()
|
||||
|
@ -153,23 +153,23 @@
|
|||
(stop-when bb-halted?)
|
||||
extra-clause ...))
|
||||
|
||||
(define-syntax-rule (big-bang-world** width height boot-actions extra-clause ...)
|
||||
(define-syntax-rule (big-bang-network** width height boot-actions extra-clause ...)
|
||||
(if (and width height)
|
||||
(big-bang-world* boot-actions (to-draw render width height) extra-clause ...)
|
||||
(big-bang-world* boot-actions (to-draw render) extra-clause ...)))
|
||||
(big-bang-network* boot-actions (to-draw render width height) extra-clause ...)
|
||||
(big-bang-network* boot-actions (to-draw render) extra-clause ...)))
|
||||
|
||||
(define (big-bang-world #:width [width #f]
|
||||
(define (big-bang-network #:width [width #f]
|
||||
#:height [height #f]
|
||||
. boot-actions)
|
||||
(big-bang-world** width height boot-actions))
|
||||
(big-bang-network** width height boot-actions))
|
||||
|
||||
(define (big-bang-universe #:width [width #f]
|
||||
(define (big-bang-network/universe #:width [width #f]
|
||||
#:height [height #f]
|
||||
#:register [ip LOCALHOST]
|
||||
#:port [port-number SQPORT]
|
||||
#:name [world-name (gensym 'prospect)]
|
||||
. boot-actions)
|
||||
(big-bang-world** width height boot-actions
|
||||
(big-bang-network** width height boot-actions
|
||||
(on-receive (lambda (b sexps)
|
||||
(inject b (for/list ((m sexps)) (message (from-server m))))))
|
||||
(register ip)
|
||||
|
|
|
@ -3,12 +3,12 @@
|
|||
|
||||
(provide (struct-out message)
|
||||
(except-out (struct-out quit) quit)
|
||||
(struct-out quit-world)
|
||||
(struct-out quit-network)
|
||||
(rename-out [quit <quit>])
|
||||
(except-out (struct-out spawn) spawn)
|
||||
(rename-out [spawn <spawn>])
|
||||
(struct-out transition)
|
||||
(struct-out world)
|
||||
(struct-out network)
|
||||
|
||||
(struct-out seal)
|
||||
|
||||
|
@ -44,11 +44,11 @@
|
|||
unpub
|
||||
|
||||
(rename-out [make-quit quit])
|
||||
make-world
|
||||
spawn-world
|
||||
make-network
|
||||
spawn-network
|
||||
(rename-out [spawn-process spawn])
|
||||
spawn/stateless
|
||||
make-spawn-world
|
||||
make-spawn-network
|
||||
|
||||
transition-bind
|
||||
sequence-transitions
|
||||
|
@ -56,10 +56,10 @@
|
|||
sequence-transitions0
|
||||
sequence-transitions0*
|
||||
|
||||
world-handle-event
|
||||
network-handle-event
|
||||
clean-transition
|
||||
|
||||
pretty-print-world)
|
||||
pretty-print-network)
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
|
@ -77,7 +77,7 @@
|
|||
|
||||
;; Actions ⊃ Events
|
||||
(struct spawn (boot) #:prefab)
|
||||
(struct quit-world () #:prefab) ;; NB. An action. Compare (quit), a Transition.
|
||||
(struct quit-network () #: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
|
||||
|
@ -87,7 +87,7 @@
|
|||
;; - #f, a signal from a Process that it is inert and need not be
|
||||
;; scheduled until some Event relevant to it arrives; or,
|
||||
;; - a (transition Any (Constreeof Action)), a new Process state to
|
||||
;; be held by its World and a sequence of Actions for the World
|
||||
;; be held by its Network and a sequence of Actions for the Network
|
||||
;; to take on the transitioning Process's behalf.
|
||||
;; - a (quit (Option Exn) (Constreeof Action)), signalling that the
|
||||
;; Process should never again be handed an event, and that any
|
||||
|
@ -102,7 +102,7 @@
|
|||
;; A Label is a PID or 'meta.
|
||||
|
||||
;; VM private states
|
||||
(struct world (mux ;; Multiplexer
|
||||
(struct network (mux ;; Multiplexer
|
||||
pending-action-queue ;; (Queueof (Cons Label (U Action 'quit)))
|
||||
runnable-pids ;; (Setof PID)
|
||||
behaviors ;; (HashTable PID Behavior)
|
||||
|
@ -111,7 +111,7 @@
|
|||
#:transparent
|
||||
#:methods gen:prospect-pretty-printable
|
||||
[(define (prospect-pretty-print w [p (current-output-port)])
|
||||
(pretty-print-world w p))])
|
||||
(pretty-print-network w p))])
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Seals are used by protocols to prevent the routing tries from
|
||||
|
@ -122,7 +122,7 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (event? x) (or (patch? x) (message? x)))
|
||||
(define (action? x) (or (event? x) (spawn? x) (quit-world? x)))
|
||||
(define (action? x) (or (event? x) (spawn? x) (quit-network? x)))
|
||||
|
||||
(define (prepend-at-meta pattern level)
|
||||
(if (zero? level)
|
||||
|
@ -170,8 +170,8 @@
|
|||
(filter (lambda (x) (and (action? x) (not (patch-empty? x)))) (flatten actions)))
|
||||
|
||||
(define (send-event e pid w)
|
||||
(define behavior (hash-ref (world-behaviors w) pid #f))
|
||||
(define old-state (hash-ref (world-states w) pid #f))
|
||||
(define behavior (hash-ref (network-behaviors w) pid #f))
|
||||
(define old-state (hash-ref (network-states w) pid #f))
|
||||
(if (not behavior)
|
||||
w
|
||||
(begin
|
||||
|
@ -194,7 +194,7 @@
|
|||
(enqueue-actions (disable-process pid exn w) pid (list 'quit)))))))
|
||||
|
||||
(define (update-state w pid s)
|
||||
(struct-copy world w [states (hash-set (world-states w) pid s)]))
|
||||
(struct-copy network w [states (hash-set (network-states w) pid s)]))
|
||||
|
||||
(define (send-event/guard delta pid w)
|
||||
(if (patch-empty? delta)
|
||||
|
@ -206,9 +206,9 @@
|
|||
(log-error "Process ~a died with exception:\n~a"
|
||||
(cons pid (trace-pid-stack))
|
||||
(exn->string exn)))
|
||||
(struct-copy world w
|
||||
[behaviors (hash-remove (world-behaviors w) pid)]
|
||||
[states (hash-remove (world-states w) pid)]))
|
||||
(struct-copy network w
|
||||
[behaviors (hash-remove (network-behaviors w) pid)]
|
||||
[states (hash-remove (network-states w) pid)]))
|
||||
|
||||
(define (invoke-process pid thunk k-ok k-exn)
|
||||
(define-values (ok? result)
|
||||
|
@ -222,12 +222,12 @@
|
|||
(k-exn result)))
|
||||
|
||||
(define (mark-pid-runnable w pid)
|
||||
(struct-copy world w [runnable-pids (set-add (world-runnable-pids w) pid)]))
|
||||
(struct-copy network w [runnable-pids (set-add (network-runnable-pids w) pid)]))
|
||||
|
||||
(define (enqueue-actions w label actions)
|
||||
(struct-copy world w
|
||||
(struct-copy network w
|
||||
[pending-action-queue
|
||||
(queue-append-list (world-pending-action-queue w)
|
||||
(queue-append-list (network-pending-action-queue w)
|
||||
(for/list [(a actions)] (cons label a)))]))
|
||||
|
||||
(define (make-quit #:exception [exn #f] . actions)
|
||||
|
@ -249,20 +249,20 @@
|
|||
[(? quit? q) q]
|
||||
[actions (transition state actions)]))
|
||||
|
||||
(define-syntax-rule (spawn-world boot-action ...)
|
||||
(make-spawn-world (lambda () (list boot-action ...))))
|
||||
(define-syntax-rule (spawn-network boot-action ...)
|
||||
(make-spawn-network (lambda () (list boot-action ...))))
|
||||
|
||||
(define (make-world boot-actions)
|
||||
(world (mux)
|
||||
(define (make-network boot-actions)
|
||||
(network (mux)
|
||||
(list->queue (for/list ((a (in-list (clean-actions boot-actions)))) (cons 'meta a)))
|
||||
(set)
|
||||
(hash)
|
||||
(hash)))
|
||||
|
||||
(define (make-spawn-world boot-actions-thunk)
|
||||
(define (make-spawn-network boot-actions-thunk)
|
||||
(spawn (lambda ()
|
||||
(list world-handle-event
|
||||
(transition (make-world (boot-actions-thunk)) '())))))
|
||||
(list network-handle-event
|
||||
(transition (make-network (boot-actions-thunk)) '())))))
|
||||
|
||||
(define (transition-bind k t0)
|
||||
(match t0
|
||||
|
@ -293,10 +293,10 @@
|
|||
[(? transition? t) (sequence-transitions* t rest)])]))
|
||||
|
||||
(define (inert? w)
|
||||
(and (queue-empty? (world-pending-action-queue w))
|
||||
(set-empty? (world-runnable-pids w))))
|
||||
(and (queue-empty? (network-pending-action-queue w))
|
||||
(set-empty? (network-runnable-pids w))))
|
||||
|
||||
(define (world-handle-event e w)
|
||||
(define (network-handle-event e w)
|
||||
(if (or e (not (inert? w)))
|
||||
(sequence-transitions (transition w '())
|
||||
(inject-event e)
|
||||
|
@ -312,8 +312,8 @@
|
|||
'()))
|
||||
|
||||
(define (perform-actions w)
|
||||
(for/fold ([wt (transition (struct-copy world w [pending-action-queue (make-queue)]) '())])
|
||||
((entry (in-list (queue->list (world-pending-action-queue w)))))
|
||||
(for/fold ([wt (transition (struct-copy network w [pending-action-queue (make-queue)]) '())])
|
||||
((entry (in-list (queue->list (network-pending-action-queue w)))))
|
||||
#:break (quit? wt) ;; TODO: should a quit action be delayed until the end of the turn?
|
||||
(match-define [cons label a] entry)
|
||||
(trace-internal-action label a (transition-state wt))
|
||||
|
@ -337,19 +337,20 @@
|
|||
(match-define (list behavior initial-transition) results)
|
||||
(create-process w behavior initial-transition))
|
||||
(lambda (exn)
|
||||
(log-error "Spawned process in world ~a died with exception:\n~a"
|
||||
(log-error "Spawned process in network ~a died with exception:\n~a"
|
||||
(trace-pid-stack)
|
||||
(exn->string exn))
|
||||
(transition w '())))]
|
||||
['quit
|
||||
(define-values (new-mux _label delta delta-aggregate) (mux-remove-stream (world-mux w) label))
|
||||
(define-values (new-mux _label delta delta-aggregate)
|
||||
(mux-remove-stream (network-mux w) label))
|
||||
;; behavior & state in w already removed by disable-process
|
||||
(deliver-patches w new-mux label delta delta-aggregate)]
|
||||
[(quit-world)
|
||||
[(quit-network)
|
||||
(make-quit)]
|
||||
[(? patch? delta-orig)
|
||||
(define-values (new-mux _label delta delta-aggregate)
|
||||
(mux-update-stream (world-mux w) label delta-orig))
|
||||
(mux-update-stream (network-mux w) label delta-orig))
|
||||
(deliver-patches w new-mux label delta delta-aggregate)]
|
||||
[(and m (message body))
|
||||
(when (observe? body)
|
||||
|
@ -360,7 +361,7 @@
|
|||
(at-meta? body)) ;; it relates to envt, not local
|
||||
(transition w (message (at-meta-claim body)))
|
||||
(transition (for/fold [(w w)]
|
||||
[(pid (in-list (mux-route-message (world-mux w) body)))]
|
||||
[(pid (in-list (mux-route-message (network-mux w) body)))]
|
||||
(send-event m pid w))
|
||||
'()))]))
|
||||
|
||||
|
@ -385,9 +386,9 @@
|
|||
[(cons (? patch? p) rest) (values p rest)]
|
||||
[other (values empty-patch other)]))
|
||||
(define-values (new-mux new-pid delta delta-aggregate)
|
||||
(mux-add-stream (world-mux w) initial-patch))
|
||||
(let* ((w (struct-copy world w
|
||||
[behaviors (hash-set (world-behaviors w)
|
||||
(mux-add-stream (network-mux w) initial-patch))
|
||||
(let* ((w (struct-copy network w
|
||||
[behaviors (hash-set (network-behaviors w)
|
||||
new-pid
|
||||
behavior)]))
|
||||
(w (enqueue-actions (postprocess w new-pid) new-pid remaining-initial-actions)))
|
||||
|
@ -395,25 +396,25 @@
|
|||
|
||||
(define (deliver-patches w new-mux acting-label delta delta-aggregate)
|
||||
(define-values (patches meta-action)
|
||||
(compute-patches (world-mux w) new-mux acting-label delta delta-aggregate))
|
||||
(transition (for/fold [(w (struct-copy world w [mux new-mux]))]
|
||||
(compute-patches (network-mux w) new-mux acting-label delta delta-aggregate))
|
||||
(transition (for/fold [(w (struct-copy network w [mux new-mux]))]
|
||||
[(entry (in-list patches))]
|
||||
(match-define (cons label event) entry)
|
||||
(send-event/guard event label w))
|
||||
meta-action))
|
||||
|
||||
(define (step-children w)
|
||||
(define runnable-pids (world-runnable-pids w))
|
||||
(define runnable-pids (network-runnable-pids w))
|
||||
(if (set-empty? runnable-pids)
|
||||
#f ;; world is inert.
|
||||
(transition (for/fold [(w (struct-copy world w [runnable-pids (set)]))]
|
||||
#f ;; network is inert.
|
||||
(transition (for/fold [(w (struct-copy network w [runnable-pids (set)]))]
|
||||
[(pid (in-set runnable-pids))]
|
||||
(send-event #f pid w))
|
||||
'())))
|
||||
|
||||
(define (pretty-print-world w [p (current-output-port)])
|
||||
(match-define (world mux qs runnable behaviors states) w)
|
||||
(fprintf p "WORLD:\n")
|
||||
(define (pretty-print-network w [p (current-output-port)])
|
||||
(match-define (network mux qs runnable behaviors states) w)
|
||||
(fprintf p "NETWORK:\n")
|
||||
(fprintf p " - ~a queued actions\n" (queue-length qs))
|
||||
(fprintf p " - ~a runnable pids ~a\n" (set-count runnable) (set->list runnable))
|
||||
(fprintf p " - ~a live processes\n" (hash-count states))
|
||||
|
@ -438,10 +439,10 @@
|
|||
(define (step* w)
|
||||
(let loop ((w w) (actions '()))
|
||||
(pretty-print w)
|
||||
(match (world-handle-event #f w)
|
||||
(match (network-handle-event #f w)
|
||||
[#f (values w #f (flatten actions))]
|
||||
[(quit exn new-actions) (values w exn (flatten (cons actions new-actions)))]
|
||||
[(transition new-w new-actions) (loop new-w (cons actions new-actions))])))
|
||||
|
||||
(step* (make-world '()))
|
||||
(step* (make-network '()))
|
||||
)
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(assert (advertise (tcp-channel us them _)) #:meta-level 1)
|
||||
(on (message (tcp-channel them us $bs) #:meta-level 1)
|
||||
(define input-string (string-trim (bytes->string/utf-8 bs)))
|
||||
(if (equal? input-string "quit-world")
|
||||
(if (equal? input-string "quit-network")
|
||||
(send! (shutdown))
|
||||
(send! (says user input-string)))))))
|
||||
|
||||
|
|
|
@ -50,7 +50,7 @@
|
|||
(mouse-sub name)
|
||||
(move-to orig-x orig-y))))
|
||||
|
||||
(big-bang-world #:width 640
|
||||
(big-bang-network #:width 640
|
||||
#:height 480
|
||||
(spawn (lambda (e s)
|
||||
(match e
|
||||
|
|
|
@ -37,7 +37,7 @@
|
|||
))))
|
||||
|
||||
(spawn-tcp-driver)
|
||||
(spawn-world
|
||||
(spawn-network
|
||||
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
#:meta-level 1
|
||||
|
|
|
@ -18,8 +18,8 @@
|
|||
(match e
|
||||
[(message (at-meta (tcp-channel _ _ bs)))
|
||||
(define input-string (string-trim (bytes->string/utf-8 bs)))
|
||||
(if (equal? input-string "quit-world")
|
||||
(quit-world)
|
||||
(if (equal? input-string "quit-network")
|
||||
(quit-network)
|
||||
(message `(,user says ,input-string)))]
|
||||
[(message `(,who says ,what))
|
||||
(say who "says: ~a" what)]
|
||||
|
@ -40,7 +40,7 @@
|
|||
))))
|
||||
|
||||
(spawn-tcp-driver)
|
||||
(spawn-world
|
||||
(spawn-network
|
||||
(spawn-demand-matcher (advertise (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
#:meta-level 1
|
||||
|
|
|
@ -27,7 +27,7 @@
|
|||
#f)]
|
||||
[_ #f]))
|
||||
|
||||
(spawn-world (spawn r (void) (sub ?))
|
||||
(spawn-network (spawn r (void) (sub ?))
|
||||
(spawn b 0 '()))
|
||||
|
||||
(define (echoer e s)
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;; Analogous to nc-incremental-meta-drop.rkt in the Redex model.
|
||||
;; Demonstrates (hopefully) correct processing of meta-interests when dropping a patch.
|
||||
|
||||
(spawn-world
|
||||
(spawn-network
|
||||
(spawn (lambda (e u)
|
||||
(match u
|
||||
[0 (transition 1 '())]
|
||||
|
|
|
@ -63,7 +63,7 @@
|
|||
1
|
||||
(patch-seq (sub (observe (set-timer ? ? ?)))
|
||||
(sub (timer-expired 'tick ?))))
|
||||
(spawn-world (spawn r (void) (sub ?))
|
||||
(spawn-network (spawn r (void) (sub ?))
|
||||
(spawn b 0 '()))
|
||||
(spawn echoer
|
||||
(void)
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
#lang prospect
|
||||
;; Demonstrates quit-world.
|
||||
;; Demonstrates quit-network.
|
||||
|
||||
(require (only-in racket/port read-bytes-line-evt))
|
||||
|
||||
|
@ -9,9 +9,9 @@
|
|||
[(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")))))
|
||||
[(message (at-meta (at-meta (external-event _ (list #"quit-network")))))
|
||||
(printf "Terminating the whole network.\n")
|
||||
(transition s (quit-world))]
|
||||
(transition s (quit-network))]
|
||||
[_ #f]))
|
||||
(void)
|
||||
(sub (external-event (read-bytes-line-evt (current-input-port) 'any) ?)
|
||||
|
@ -31,6 +31,6 @@
|
|||
(void)
|
||||
(sub-to-alarm)))
|
||||
|
||||
(printf "Type 'quit' or 'quit-world'.\n")
|
||||
(spawn-world (spawn-command-listener)
|
||||
(printf "Type 'quit' or 'quit-network'.\n")
|
||||
(spawn-network (spawn-command-listener)
|
||||
(spawn-ticker))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
#lang racket/base
|
||||
;; Breaking the infinite tower of nested Worlds, connecting to the "real" world at the fracture line.
|
||||
;; Breaking the infinite tower of nested Networks, connecting to the "real world" at the fracture line.
|
||||
|
||||
(require racket/async-channel)
|
||||
(require racket/set)
|
||||
|
@ -43,7 +43,7 @@
|
|||
|
||||
;; Projection
|
||||
;; Used to extract event descriptors and results from subscriptions
|
||||
;; from the ground VM's contained World.
|
||||
;; from the ground VM's contained Network.
|
||||
(define event-projection (compile-projection (observe (external-event (?!) ?))))
|
||||
|
||||
;; Interests -> (Listof RacketEvent)
|
||||
|
@ -66,10 +66,10 @@
|
|||
(handle-evt (system-idle-evt) (lambda _ #f)))
|
||||
|
||||
;; Action* -> Void
|
||||
;; Runs a ground VM, booting the outermost World with the given Actions.
|
||||
;; Runs a ground VM, booting the outermost Network with the given Actions.
|
||||
(define (run-ground . boot-actions)
|
||||
(let await-interrupt ((inert? #f)
|
||||
(w (make-world boot-actions))
|
||||
(w (make-network boot-actions))
|
||||
(interests (matcher-empty)))
|
||||
;; (log-info "GROUND INTERESTS:\n~a" (matcher->pretty-string interests))
|
||||
(if (and inert? (matcher-empty? interests))
|
||||
|
@ -79,9 +79,9 @@
|
|||
(current-ground-event-async-channel)
|
||||
(if inert? never-evt idle-handler)
|
||||
(extract-active-events interests))))
|
||||
(trace-process-step e #f world-handle-event w)
|
||||
(define resulting-transition (clean-transition (world-handle-event e w)))
|
||||
(trace-process-step-result e #f world-handle-event w #f resulting-transition)
|
||||
(trace-process-step e #f network-handle-event w)
|
||||
(define resulting-transition (clean-transition (network-handle-event e w)))
|
||||
(trace-process-step-result e #f network-handle-event w #f resulting-transition)
|
||||
(match resulting-transition
|
||||
[#f ;; inert
|
||||
(await-interrupt #t w interests)]
|
||||
|
|
|
@ -46,10 +46,10 @@
|
|||
(exn->string exn)))
|
||||
(record-trace-event 'process-step-result (list (cons-pid pid) e beh st exn t)))
|
||||
|
||||
;; (Option PID) Action World -> Void
|
||||
;; (Option PID) Action Network -> Void
|
||||
(define (trace-internal-action pid a w)
|
||||
(record-trace-event 'internal-action (list (cons-pid pid) a w)))
|
||||
|
||||
;; (Option PID) Action World Transition -> Void
|
||||
;; (Option PID) Action Network Transition -> Void
|
||||
(define (trace-internal-action-result pid a w t)
|
||||
(record-trace-event 'internal-action-result (list (cons-pid pid) a w t)))
|
||||
|
|
|
@ -36,7 +36,7 @@
|
|||
(define show-message-actions? #f)
|
||||
(define show-actions? #f)
|
||||
(define show-routing-table? #f)
|
||||
(define world-is-boring? #t)
|
||||
(define network-is-boring? #t)
|
||||
|
||||
(define (set-stderr-trace-flags! flags-string)
|
||||
(set! flags (for/set [(c flags-string)] (string->symbol (string c))))
|
||||
|
@ -54,7 +54,7 @@
|
|||
(set-flag! M show-message-actions?)
|
||||
(set-flag! a show-actions?)
|
||||
(set-flag! g show-routing-table?)
|
||||
(set! world-is-boring? (not (set-member? flags 'W))))
|
||||
(set! network-is-boring? (not (set-member? flags 'N))))
|
||||
|
||||
(set-stderr-trace-flags! (or (getenv "MINIMART_TRACE") ""))
|
||||
|
||||
|
@ -82,7 +82,7 @@
|
|||
(apply fprintf (current-error-port) fmt args))
|
||||
|
||||
(define (boring-state? state)
|
||||
(or (and (world? state) world-is-boring?)
|
||||
(or (and (network? state) network-is-boring?)
|
||||
(void? state)))
|
||||
|
||||
(define (set-color! c) (when colored-output? (output "\e[0~am" c)))
|
||||
|
@ -163,14 +163,14 @@
|
|||
(prospect-pretty-print (transition-state t) (current-error-port)))))))]
|
||||
[('internal-action (list pids a old-w))
|
||||
(define pidstr (format-pids pids))
|
||||
(define oldcount (hash-count (world-behaviors old-w)))
|
||||
(define oldcount (hash-count (network-behaviors old-w)))
|
||||
(match a
|
||||
[(? spawn?)
|
||||
;; Handle this in internal-action-result
|
||||
(void)]
|
||||
['quit
|
||||
(when (or show-process-lifecycle? show-actions?)
|
||||
(define interests (mux-interests-of (world-mux old-w) (car pids)))
|
||||
(define interests (mux-interests-of (network-mux old-w) (car pids)))
|
||||
(with-color BRIGHT-RED
|
||||
(output "~a exiting (~a total processes remain)\n"
|
||||
pidstr
|
||||
|
@ -178,9 +178,9 @@
|
|||
(unless (matcher-empty? interests)
|
||||
(output "~a's final interests:\n" pidstr)
|
||||
(pretty-print-matcher interests (current-error-port))))]
|
||||
[(quit-world)
|
||||
[(quit-network)
|
||||
(with-color BRIGHT-RED
|
||||
(output "Process ~a performed a quit-world.\n" pidstr))]
|
||||
(output "Process ~a performed a quit-network.\n" pidstr))]
|
||||
[(? patch? p)
|
||||
(when (or show-actions? show-patch-actions?)
|
||||
(output "~a performing a patch:\n" pidstr)
|
||||
|
@ -193,15 +193,15 @@
|
|||
(when (transition? t)
|
||||
(define new-w (transition-state t))
|
||||
(define pidstr (format-pids pids))
|
||||
(define newcount (hash-count (world-behaviors new-w)))
|
||||
(define newcount (hash-count (network-behaviors new-w)))
|
||||
(match a
|
||||
[(? spawn?)
|
||||
(when (or show-process-lifecycle? show-actions?)
|
||||
(define newpid (mux-next-pid (world-mux old-w)))
|
||||
(define newpid (mux-next-pid (network-mux old-w)))
|
||||
(define newpidstr (format-pids (cons newpid (cdr pids)))) ;; replace parent pid
|
||||
(define interests (mux-interests-of (world-mux new-w) newpid))
|
||||
(define behavior (hash-ref (world-behaviors new-w) newpid '#:missing-behavior))
|
||||
(define state (hash-ref (world-states new-w) newpid '#:missing-state))
|
||||
(define interests (mux-interests-of (network-mux new-w) newpid))
|
||||
(define behavior (hash-ref (network-behaviors new-w) newpid '#:missing-behavior))
|
||||
(define state (hash-ref (network-states new-w) newpid '#:missing-state))
|
||||
(with-color BRIGHT-GREEN
|
||||
(output "~a ~v spawned from ~a (~a total processes now)\n"
|
||||
newpidstr
|
||||
|
@ -218,8 +218,8 @@
|
|||
;; other cases handled in internal-action
|
||||
(void)])
|
||||
(when show-routing-table?
|
||||
(define old-table (mux-routing-table (world-mux old-w)))
|
||||
(define new-table (mux-routing-table (world-mux new-w)))
|
||||
(define old-table (mux-routing-table (network-mux old-w)))
|
||||
(define new-table (mux-routing-table (network-mux new-w)))
|
||||
(when (not (equal? old-table new-table))
|
||||
(with-color BRIGHT-BLUE
|
||||
(output "~a's routing table:\n" (format-pids (cdr pids)))
|
||||
|
|
Loading…
Reference in New Issue