diff --git a/examples/netstack/incremental-highlevel/main.rkt b/examples/netstack/incremental-highlevel/main.rkt
index d721f91..dc10fd7 100644
--- a/examples/netstack/incremental-highlevel/main.rkt
+++ b/examples/netstack/incremental-highlevel/main.rkt
@@ -41,11 +41,12 @@
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
+ (define us (tcp-listener 5999))
(dataspace #:name 'chat-dataspace
- (define us (tcp-listener 5999))
- (forever (assert (outbound (advertise (observe (tcp-channel _ us _)))))
- (on (asserted (inbound (advertise (tcp-channel $them us _))))
- (spawn-session them us)))))
+ (spawn #:name 'chat-server
+ (assert (outbound (advertise (observe (tcp-channel _ us _)))))
+ (on (asserted (inbound (advertise (tcp-channel $them us _))))
+ (spawn-session them us)))))
(let ((dst (udp-listener 6667)))
(spawn #:name 'udp-echo-program
@@ -61,25 +62,25 @@
(send! `(counter ,(counter)))
(counter (+ (counter) 1))))
- (forever (define us (tcp-listener 80))
- (assert (outbound (advertise (observe (tcp-channel _ us _)))))
- (during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
- #:name (list 'webserver-session them)
- (log-info "Got connection from ~v" them)
- (assert (outbound (advertise (tcp-channel us them _))))
- (on (message (inbound (tcp-channel them us _)))) ;; ignore input
+ (define us (tcp-listener 80))
+ (spawn (assert (outbound (advertise (observe (tcp-channel _ us _)))))
+ (during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
+ #:name (list 'webserver-session them)
+ (log-info "Got connection from ~v" them)
+ (assert (outbound (advertise (tcp-channel us them _))))
+ (on (message (inbound (tcp-channel them us _)))) ;; ignore input
- (on-start (send! 'bump))
- (on (message `(counter ,$counter))
- (define response
- (string->bytes/utf-8
- (format (string-append
- "HTTP/1.0 200 OK\r\n\r\n"
- "
Hello world from syndicate-netstack!
\n"
- "This is running on syndicate's own\n"
- "\n"
- "TCP/IP stack.
\n"
- "There have been ~a requests prior to this one.
\n")
- counter)))
- (send! (outbound (tcp-channel us them response)))
- (stop-facet (current-facet-id)))))))
+ (on-start (send! 'bump))
+ (on (message `(counter ,$counter))
+ (define response
+ (string->bytes/utf-8
+ (format (string-append
+ "HTTP/1.0 200 OK\r\n\r\n"
+ "Hello world from syndicate-netstack!
\n"
+ "This is running on syndicate's own\n"
+ "\n"
+ "TCP/IP stack.
\n"
+ "There have been ~a requests prior to this one.
\n")
+ counter)))
+ (send! (outbound (tcp-channel us them response)))
+ (stop-facet (current-facet-id)))))))
diff --git a/examples/platformer/hll-main.rkt b/examples/platformer/hll-main.rkt
index aecbe28..e37a0de 100644
--- a/examples/platformer/hll-main.rkt
+++ b/examples/platformer/hll-main.rkt
@@ -671,17 +671,17 @@
;; kills the dataspace.
(define (wait-for-level-termination)
- (react/suspend (done)
- (assert (outbound (level-running)))
- (stop-when (retracted (game-piece-configuration player-id _ _ _))
- (log-info "Player died! Terminating level.")
- (play-sound-sequence 270328)
- (done))
- (stop-when (message (inbound (level-completed)))
- (log-info "Level completed! Terminating level.")
- (play-sound-sequence 270330)
- (send! (outbound (add-to-score 100)))
- (done))))
+ (spawn
+ (assert (outbound (level-running)))
+ (on (retracted (game-piece-configuration player-id _ _ _))
+ (log-info "Player died! Terminating level.")
+ (play-sound-sequence 270328)
+ (quit-dataspace!))
+ (on (message (inbound (level-completed)))
+ (log-info "Level completed! Terminating level.")
+ (play-sound-sequence 270330)
+ (send! (outbound (add-to-score 100)))
+ (quit-dataspace!))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LevelSpawner
@@ -816,5 +816,4 @@
(spawn-keyboard-integrator)
(spawn-scene-manager)
(dataspace (spawn-score-keeper)
- (spawn-level-spawner 0)
- (forever))
+ (spawn-level-spawner 0))
diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt
index eb818da..3afdf9f 100644
--- a/racket/syndicate/actor.rkt
+++ b/racket/syndicate/actor.rkt
@@ -57,6 +57,7 @@
patch!
perform-actions!
flush!
+ quit-dataspace!
syndicate-effects-available?
@@ -342,10 +343,7 @@
(syntax-parse stx
[(_ name:name script ...)
(quasisyntax/loc stx
- (let ((spawn-action (core:dataspace-actor
- #:name name.N
- (actor-action script ...
- (schedule-action! (core:quit-dataspace))))))
+ (let ((spawn-action (core:dataspace-actor #:name name.N (actor-action script ...))))
(if (syndicate-effects-available?)
(schedule-action! spawn-action)
spawn-action)))]))
@@ -1322,6 +1320,10 @@
(until (core:message ack)
(on-start (send! ack))))
+(define (quit-dataspace!)
+ (ensure-in-script! 'quit-dataspace!)
+ (schedule-action! (core:quit-dataspace)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (format-field-descriptor d)
diff --git a/racket/syndicate/dataspace.rkt b/racket/syndicate/dataspace.rkt
index ab26076..13e5806 100644
--- a/racket/syndicate/dataspace.rkt
+++ b/racket/syndicate/dataspace.rkt
@@ -177,6 +177,10 @@
[( boot initial-assertions)
(invoke-process (mux-next-pid (dataspace-mux w)) ;; anticipate pid allocation
(lambda ()
+ (when (not (trie? initial-assertions))
+ (error 'actor
+ "actor initial assertions must be trie; was ~v"
+ initial-assertions))
(match (boot)
[(and results (list (? procedure?) (? general-transition?) _))
results]
diff --git a/racket/syndicate/examples/actor/chat-no-quit-world.rkt b/racket/syndicate/examples/actor/chat-no-quit-world.rkt
index 37154a0..131e624 100644
--- a/racket/syndicate/examples/actor/chat-no-quit-world.rkt
+++ b/racket/syndicate/examples/actor/chat-no-quit-world.rkt
@@ -7,24 +7,23 @@
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
-(dataspace (define us (tcp-listener 5999))
- (forever
- (assert (outbound (advertise (observe (tcp-channel _ us _)))))
- (during/spawn (inbound (advertise (tcp-channel $them us _)))
- (assert (outbound (advertise (tcp-channel us them _))))
+(define us (tcp-listener 5999))
+(dataspace (spawn (assert (outbound (advertise (observe (tcp-channel _ us _)))))
+ (during/spawn (inbound (advertise (tcp-channel $them us _)))
+ (assert (outbound (advertise (tcp-channel us them _))))
- (define (send-to-remote fmt . vs)
- (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
+ (define (send-to-remote fmt . vs)
+ (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
- (define user (gensym 'user))
+ (define user (gensym 'user))
- (on-start (send-to-remote "Welcome, ~a.\n" user))
- (assert (present user))
- (on (message (inbound (tcp-channel them us $bs)))
- (send! (says user (string-trim (bytes->string/utf-8 bs)))))
+ (on-start (send-to-remote "Welcome, ~a.\n" user))
+ (assert (present user))
+ (on (message (inbound (tcp-channel them us $bs)))
+ (send! (says user (string-trim (bytes->string/utf-8 bs)))))
- (during (present $who)
- (unless (equal? who user)
- (on-start (send-to-remote "~a arrived.\n" who))
- (on-stop (send-to-remote "~a departed.\n" who))
- (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
+ (during (present $who)
+ (unless (equal? who user)
+ (on-start (send-to-remote "~a arrived.\n" who))
+ (on-stop (send-to-remote "~a departed.\n" who))
+ (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
diff --git a/racket/syndicate/examples/actor/chat.rkt b/racket/syndicate/examples/actor/chat.rkt
index 185f9d2..3849651 100644
--- a/racket/syndicate/examples/actor/chat.rkt
+++ b/racket/syndicate/examples/actor/chat.rkt
@@ -8,27 +8,27 @@
(struct present (who) #:prefab)
(struct shutdown () #:prefab)
-(dataspace (define us (tcp-listener 5999))
- (until (message (shutdown))
- (assert (outbound (advertise (observe (tcp-channel _ us _)))))
- (during/spawn (inbound (advertise (tcp-channel $them us _)))
- (assert (outbound (advertise (tcp-channel us them _))))
+(define us (tcp-listener 5999))
+(dataspace (spawn (on (message (shutdown)) (quit-dataspace!))
+ (assert (outbound (advertise (observe (tcp-channel _ us _)))))
+ (during/spawn (inbound (advertise (tcp-channel $them us _)))
+ (assert (outbound (advertise (tcp-channel us them _))))
- (define (send-to-remote fmt . vs)
- (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
+ (define (send-to-remote fmt . vs)
+ (send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
- (define user (gensym 'user))
+ (define user (gensym 'user))
- (on-start (send-to-remote "Welcome, ~a.\n" user))
- (assert (present user))
- (on (message (inbound (tcp-channel them us $bs)))
- (define input-string (string-trim (bytes->string/utf-8 bs)))
- (if (equal? input-string "quit-dataspace")
- (send! (shutdown))
- (send! (says user input-string))))
+ (on-start (send-to-remote "Welcome, ~a.\n" user))
+ (assert (present user))
+ (on (message (inbound (tcp-channel them us $bs)))
+ (define input-string (string-trim (bytes->string/utf-8 bs)))
+ (if (equal? input-string "quit-dataspace")
+ (send! (shutdown))
+ (send! (says user input-string))))
- (during (present $who)
- (unless (equal? who user)
- (on-start (send-to-remote "~a arrived.\n" who))
- (on-stop (send-to-remote "~a departed.\n" who))
- (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
+ (during (present $who)
+ (unless (equal? who user)
+ (on-start (send-to-remote "~a arrived.\n" who))
+ (on-stop (send-to-remote "~a departed.\n" who))
+ (on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
diff --git a/racket/syndicate/examples/actor/fib-server.rkt b/racket/syndicate/examples/actor/fib-server.rkt
index 325db6e..5f1c5d6 100644
--- a/racket/syndicate/examples/actor/fib-server.rkt
+++ b/racket/syndicate/examples/actor/fib-server.rkt
@@ -50,4 +50,5 @@
(until (rising-edge (= (counter) 2)))
(log-info "Quitting main")
(until (message (inbound (timer-expired 'wait _)))
- (on-start (send! (outbound (set-timer 'wait 100 'relative))))))
+ (on-start (send! (outbound (set-timer 'wait 100 'relative)))))
+ (quit-dataspace!))
diff --git a/racket/syndicate/examples/actor/query-set.rkt b/racket/syndicate/examples/actor/query-set.rkt
index a92ba09..46693fa 100644
--- a/racket/syndicate/examples/actor/query-set.rkt
+++ b/racket/syndicate/examples/actor/query-set.rkt
@@ -65,5 +65,4 @@
(on-start (log-info "observer-in-ds: STARTING"))
(define/query-set items (inbound* LEVEL `(item ,$a ,$b)) (list a b))
(on (message (inbound* LEVEL 'dump))
- (log-info "observer-in-ds: ~v" (items))))
- (forever)))
+ (log-info "observer-in-ds: ~v" (items))))))
diff --git a/racket/syndicate/examples/actor/sandbox-os.rkt b/racket/syndicate/examples/actor/sandbox-os.rkt
index 641c076..45d5b3a 100644
--- a/racket/syndicate/examples/actor/sandbox-os.rkt
+++ b/racket/syndicate/examples/actor/sandbox-os.rkt
@@ -29,12 +29,13 @@
(dataspace (define id (symbol->string (gensym 'app)))
(printf "Starting app ~a\n" id)
(schedule-action! (program-boot-actions 'syndicate/examples/actor/bank-account))
- (forever
+ (spawn
(assert (outbound (running-app id)))
- (stop-when (message (inbound (kill-app id)))
- (printf "Received signal for app ~a\n" id))
+ (on (message (inbound (kill-app id)))
+ (printf "Received signal for app ~a\n" id)
+ (quit-dataspace!))
(during (account $balance)
- (assert (outbound (named-account name balance)))))))
+ (assert (outbound (named-account name balance)))))))
(run-bank-account 'a)
(run-bank-account 'b)