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

Rename World to Network

This commit is contained in:
Tony Garnock-Jones 2016-01-18 14:29:48 -05:00
parent ad9a78b4a4
commit aa9677dbe1
18 changed files with 178 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
FAQ.md
View File

@ -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
View File

@ -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

20
doc/big-bang.rkt.txt
View File

@ -37,15 +37,15 @@
(idle 0 (- mx dx) (- my dy))]))
(actor (idle 0 orig-x orig-y)))
(big-bang-world #:width 640
#:height 480
(actor (forever
(on (asserted (active-window $id) #:meta-level 1)
(update-window 'active-window-label 300 0
(text (format "~v" id) 22 "black")))))
(button #:background "red" 'stop-button 0 0 "Exit"
(lambda () (assert! 'stop #:meta-level 1)))
(draggable-shape 'c1 50 50 (circle 30 "solid" "orange"))
(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")))
(big-bang-network #:width 640
#:height 480
(actor (forever
(on (asserted (active-window $id) #:meta-level 1)
(update-window 'active-window-label 300 0
(text (format "~v" id) 22 "black")))))
(button #:background "red" 'stop-button 0 0 "Exit"
(lambda () (assert! 'stop #:meta-level 1)))
(draggable-shape 'c1 50 50 (circle 30 "solid" "orange"))
(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")))
(exit 0)

6
doc/chat.rkt.txt
View File

@ -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)))))

8
prospect/actor.rkt
View File

@ -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

54
prospect/big-bang.rkt
View File

@ -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,25 +153,25 @@
(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]
#:height [height #f]
. boot-actions)
(big-bang-world** width height boot-actions))
(define (big-bang-network #:width [width #f]
#:height [height #f]
. boot-actions)
(big-bang-network** width height boot-actions))
(define (big-bang-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
(on-receive (lambda (b sexps)
(inject b (for/list ((m sexps)) (message (from-server m))))))
(register ip)
(port port-number)
(name world-name)))
(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-network** width height boot-actions
(on-receive (lambda (b sexps)
(inject b (for/list ((m sexps)) (message (from-server m))))))
(register ip)
(port port-number)
(name world-name)))

121
prospect/core.rkt
View File

@ -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,16 +102,16 @@
;; A Label is a PID or 'meta.
;; VM private states
(struct world (mux ;; Multiplexer
pending-action-queue ;; (Queueof (Cons Label (U Action 'quit)))
runnable-pids ;; (Setof PID)
behaviors ;; (HashTable PID Behavior)
states ;; (HashTable PID Any)
)
(struct network (mux ;; Multiplexer
pending-action-queue ;; (Queueof (Cons Label (U Action 'quit)))
runnable-pids ;; (Setof PID)
behaviors ;; (HashTable PID Behavior)
states ;; (HashTable PID Any)
)
#: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)
(list->queue (for/list ((a (in-list (clean-actions boot-actions)))) (cons 'meta a)))
(set)
(hash)
(hash)))
(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 '()))
)

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

@ -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)))))))

36
prospect/examples/big-bang.rkt
View File

@ -50,23 +50,23 @@
(mouse-sub name)
(move-to orig-x orig-y))))
(big-bang-world #:width 640
#:height 480
(spawn (lambda (e s)
(match e
[(? patch? p)
(define-values (in out)
(patch-project/set/single p
(compile-projection
(at-meta (?! (active-window ?))))))
(transition s (update-window 'active-window-label 300 0
(text (format "~v" in) 22 "black")))]
[_ #f]))
(void)
(sub (active-window ?) #:meta-level 1))
(button #:background "red" 'stop-button 0 0 "Exit"
(lambda () (assert 'stop #:meta-level 1)))
(draggable-shape 'c1 50 50 (circle 30 "solid" "orange"))
(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")))
(big-bang-network #:width 640
#:height 480
(spawn (lambda (e s)
(match e
[(? patch? p)
(define-values (in out)
(patch-project/set/single p
(compile-projection
(at-meta (?! (active-window ?))))))
(transition s (update-window 'active-window-label 300 0
(text (format "~v" in) 22 "black")))]
[_ #f]))
(void)
(sub (active-window ?) #:meta-level 1))
(button #:background "red" 'stop-button 0 0 "Exit"
(lambda () (assert 'stop #:meta-level 1)))
(draggable-shape 'c1 50 50 (circle 30 "solid" "orange"))
(draggable-shape 's1 100 100 (star 40 "solid" "firebrick")))
(exit 0)

2
prospect/examples/chat-no-quit-world.rkt
View File

@ -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

6
prospect/examples/chat.rkt
View File

@ -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

4
prospect/examples/example-lang.rkt
View File

@ -27,8 +27,8 @@
#f)]
[_ #f]))
(spawn-world (spawn r (void) (sub ?))
(spawn b 0 '()))
(spawn-network (spawn r (void) (sub ?))
(spawn b 0 '()))
(define (echoer e s)
(match e

2
prospect/examples/example-meta-drop.rkt
View File

@ -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 '())]

4
prospect/examples/example-plain.rkt
View File

@ -63,8 +63,8 @@
1
(patch-seq (sub (observe (set-timer ? ? ?)))
(sub (timer-expired 'tick ?))))
(spawn-world (spawn r (void) (sub ?))
(spawn b 0 '()))
(spawn-network (spawn r (void) (sub ?))
(spawn b 0 '()))
(spawn echoer
(void)
(sub (external-event (read-line-evt (current-input-port) 'any) ?)

12
prospect/examples/example-quit-world.rkt
View File

@ -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)
(spawn-ticker))
(printf "Type 'quit' or 'quit-network'.\n")
(spawn-network (spawn-command-listener)
(spawn-ticker))

14
prospect/ground.rkt
View File

@ -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)]

4
prospect/trace.rkt
View File

@ -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)))

28
prospect/trace/stderr.rkt
View File

@ -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)))