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)