diff --git a/os2-example.rkt b/os2-example.rkt index 746af01..b4d0e26 100644 --- a/os2-example.rkt +++ b/os2-example.rkt @@ -13,7 +13,7 @@ #:name id #:state state [(timer-expired (== id) now) - (sequence-actions state + (sequence-actions (transition state) k (delete-role id))]))) @@ -32,7 +32,7 @@ (define spy (lambda (spy-pid) (define (hs label) - (define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) values) + (define ((w kind) . args) (write `(,label ,kind ,@args)) (newline) transition) (handlers (w 'presence) (w 'absence) (w 'message))) diff --git a/os2-nested-example.rkt b/os2-nested-example.rkt index e20b0e9..23ada89 100644 --- a/os2-nested-example.rkt +++ b/os2-nested-example.rkt @@ -7,7 +7,7 @@ (define (spy spy-label) (lambda (spy-pid) (define (hs label) - (define ((w kind) . args) (write `(,spy-label ,label ,kind ,@args)) (newline) values) + (define ((w kind) . args) (write `(,spy-label ,label ,kind ,@args)) (newline) transition) (handlers (w 'presence) (w 'absence) (w 'message))) diff --git a/os2-tcp-test-bytewise-echo.rkt b/os2-tcp-test-bytewise-echo.rkt index 6d34c5b..cbbd195 100644 --- a/os2-tcp-test-bytewise-echo.rkt +++ b/os2-tcp-test-bytewise-echo.rkt @@ -11,14 +11,11 @@ (define ((connection-handler local-addr remote-addr) self-pid) (define (reader-role) (role (topic-subscriber (tcp-channel remote-addr local-addr (wild))) - #:state state [(tcp-channel remote _ (? bytes? bs)) - (transition state - (send-tcp-credit remote-addr local-addr 16) - (send-message (tcp-channel local-addr remote-addr bs)))] + (list (send-tcp-credit remote-addr local-addr 16) + (send-message (tcp-channel local-addr remote-addr bs)))] [(tcp-channel remote _ (? eof-object?)) - (transition state - (kill))])) + (kill)])) (transition 'no-state (send-tcp-credit remote-addr local-addr 16) @@ -27,20 +24,18 @@ (define (listener local-addr) (transition 'no-state (role (topic-subscriber (tcp-channel (wild) local-addr (wild)) #:monitor? #t) - #:state state #:topic t #:on-presence (match t [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) - (transition state (spawn (connection-handler local-addr remote-addr)))])))) + (spawn (connection-handler local-addr remote-addr))])))) (define (main port) (define (arm-timer) (role (topic-subscriber (timer-expired (wild) (wild))) #:name 'waiter - #:state state - #:on-presence (transition state (send-message (set-timer 'label 500 'relative))) - [(timer-expired _ _) - (transition state (delete-role 'waiter) (arm-timer))])) + #:on-presence (send-message (set-timer 'label 500 'relative)) + [(timer-expired _ _) (list (delete-role 'waiter) + (arm-timer))])) (ground-vm (transition 'none (spawn tcp-spy) diff --git a/os2-tcp-test-chat-service.rkt b/os2-tcp-test-chat-service.rkt index db785da..859130b 100644 --- a/os2-tcp-test-chat-service.rkt +++ b/os2-tcp-test-chat-service.rkt @@ -23,13 +23,14 @@ (define (connection-handler local-addr) (transition (set) ;; of remote TcpAddresses + (role (topic-publisher (tcp-channel local-addr (wild) (wild)))) (role (topic-subscriber (tcp-channel (wild) local-addr (wild))) #:state active-remotes #:topic t #:on-presence (match t [(topic 'publisher (tcp-channel (== local-addr) _ _) #f) ;; Ignore loopback flow. - active-remotes] + (transition active-remotes)] [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) (write `(arrived ,remote-addr)) (newline) (transition (set-add active-remotes remote-addr) @@ -40,11 +41,11 @@ (send-tcp-credit remote-addr local-addr 1))]) #:on-absence (match t [(topic 'publisher (tcp-channel (== local-addr) _ _) #f) - ;; Ignore loopback flow. - active-remotes] + ;; Ignore loopback flow. + (transition active-remotes)] [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) (write `(departed ,remote-addr)) (newline) - (set-remove active-remotes remote-addr)]) + (transition (set-remove active-remotes remote-addr))]) [(tcp-channel remote-addr (== local-addr) (? eof-object?)) (define new-active-remotes (set-remove active-remotes remote-addr)) (transition new-active-remotes @@ -53,9 +54,7 @@ [(tcp-channel remote-addr (== local-addr) (? bytes? bs)) (transition active-remotes (send-tcp-credit remote-addr local-addr 1) - (send-to-all local-addr active-remotes remote-addr bs))]) - (role (topic-publisher (tcp-channel local-addr (wild) (wild))) - #:state active-remotes))) + (send-to-all local-addr active-remotes remote-addr bs))]))) (define (main port) (ground-vm diff --git a/os2-tcp-test-date-service.rkt b/os2-tcp-test-date-service.rkt index 36e8641..1e7311e 100644 --- a/os2-tcp-test-date-service.rkt +++ b/os2-tcp-test-date-service.rkt @@ -10,10 +10,7 @@ (define ((connection-handler local-addr remote-addr) self-pid) (transition 'no-state (role (topic-publisher (tcp-channel local-addr remote-addr (wild))) - #:state state - [(tcp-channel _ _ (tcp-credit _)) - (transition state - (kill))]) + [(tcp-channel _ _ (tcp-credit _)) (kill)]) (send-message (tcp-channel local-addr remote-addr (string->bytes/utf-8 (format "~a\n" (current-inexact-milliseconds))))))) @@ -21,11 +18,10 @@ (define (listener local-addr) (transition 'no-state (role (topic-subscriber (tcp-channel (wild) local-addr (wild)) #:monitor? #t) - #:state state #:topic t #:on-presence (match t [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) - (transition state (spawn (connection-handler local-addr remote-addr)))])))) + (spawn (connection-handler local-addr remote-addr))])))) (define (main port) (ground-vm diff --git a/os2-tcp-test-echo-service.rkt b/os2-tcp-test-echo-service.rkt index 75956a4..84917d3 100644 --- a/os2-tcp-test-echo-service.rkt +++ b/os2-tcp-test-echo-service.rkt @@ -12,24 +12,20 @@ (send-tcp-mode remote-addr local-addr 'lines) (send-tcp-credit remote-addr local-addr 1) (role (topic-subscriber (tcp-channel remote-addr local-addr (wild))) - #:state state [(tcp-channel remote _ (? bytes? line)) - (transition state - (send-tcp-credit remote-addr local-addr 1) - (send-message - (tcp-channel local-addr remote-addr (bytes-append #"You said: " line #"\n"))))] + (list (send-tcp-credit remote-addr local-addr 1) + (send-message + (tcp-channel local-addr remote-addr (bytes-append #"You said: " line #"\n"))))] [(tcp-channel remote _ (? eof-object?)) - (transition state - (kill))]))) + (kill)]))) (define (listener local-addr) (transition 'no-state (role (topic-subscriber (tcp-channel (wild) local-addr (wild)) #:monitor? #t) - #:state state #:topic t #:on-presence (match t [(topic 'publisher (tcp-channel remote-addr (== local-addr) _) #f) - (transition state (spawn (connection-handler local-addr remote-addr)))])))) + (spawn (connection-handler local-addr remote-addr))])))) (define (main port) (ground-vm diff --git a/os2-tcp.rkt b/os2-tcp.rkt index 8e90ed9..5fd8779 100644 --- a/os2-tcp.rkt +++ b/os2-tcp.rkt @@ -104,9 +104,9 @@ [(or (topic 'publisher (tcp-channel local-addr remote-addr _) _) (topic 'subscriber (tcp-channel remote-addr local-addr _) _)) (cond - [(ground? remote-addr) active-handles] - [(not (ground? local-addr)) active-handles] - [(set-member? active-handles (cons local-addr remote-addr)) active-handles] + [(ground? remote-addr) (transition active-handles)] + [(not (ground? local-addr)) (transition active-handles)] + [(set-member? active-handles (cons local-addr remote-addr)) (transition active-handles)] [else (transition (set-add active-handles (cons local-addr remote-addr)) (spawn (driver-fun local-addr remote-addr) @@ -118,9 +118,9 @@ [(or (topic 'publisher (tcp-channel local-addr remote-addr _) _) (topic 'subscriber (tcp-channel remote-addr local-addr _) _)) (cond - [(ground? remote-addr) active-handles] - [(not (ground? local-addr)) active-handles] - [else (set-remove active-handles local-addr)])])) + [(ground? remote-addr) (transition active-handles)] + [(not (ground? local-addr)) (transition active-handles)] + [else (transition (set-remove active-handles local-addr))])])) ;; TcpAddress TcpAddress -> BootK (define ((tcp-listener-manager local-addr dummy-remote-addr) self-pid) @@ -140,7 +140,7 @@ [(or (topic 'publisher (tcp-channel (== local-addr) remote-addr _) _) (topic 'subscriber (tcp-channel remote-addr (== local-addr) _) _)) (if (ground? remote-addr) - state + (transition state) (transition 'listener-is-closed (kill) (when (eq? state 'listener-is-running) @@ -231,10 +231,10 @@ [(tcp-channel (== remote-addr) (== local-addr) subpacket) (match subpacket [(tcp-credit amount) - (and state (adjust-credit state amount))] + (if state (adjust-credit state amount) (transition state))] [(tcp-mode new-mode) ;; Also resets credit to zero. - (and state (adjust-credit (tcp-connection-state new-mode 0) 0))] + (if state (adjust-credit (tcp-connection-state new-mode 0) 0) (transition state))] [_ (error 'tcp-connection-manager* "Subscriber on a channel may only send channel control messages")])]))) @@ -247,17 +247,16 @@ (transition 'no-state (role (set (topic-subscriber (wild) #:monitor? #t) (topic-publisher (wild) #:monitor? #t)) - #:state state [(tcp-channel source dest (? bytes? body)) (write `(TCPDATA ,source --> ,dest)) (newline) (dump-bytes! body (bytes-length body)) - state] + (void)] [(tcp-channel source dest (? eof-object?)) (write `(TCPEOF ,source --> ,dest)) (newline) - state] + (void)] [(tcp-channel source dest (tcp-credit amount)) (write `(TCPCREDIT ,source --> ,dest ,amount)) (newline) - state] + (void)] [other (write `(TCPOTHER ,other)) (newline) - state]))) + (void)]))) diff --git a/os2-testing.rkt b/os2-testing.rkt index 9e79a05..31e6401 100644 --- a/os2-testing.rkt +++ b/os2-testing.rkt @@ -9,9 +9,7 @@ (provide check-role) (define (flatten-transition t) - (if (transition? t) - (apply transition (transition-state t) (flatten (transition-actions t))) - (transition t))) + (apply transition (transition-state t) (flatten (transition-actions t)))) ;; AddRole World SendMessage World ConsTreeOf -> Void ;; Passes the given message to the given message-handler, with the diff --git a/os2-timer.rkt b/os2-timer.rkt index 0c92bea..7d392b7 100644 --- a/os2-timer.rkt +++ b/os2-timer.rkt @@ -110,7 +110,7 @@ [(cons (? evt?) now) (define to-send (fire-timers! (driver-state-heap state) now)) ;; Note: compute to-send before recursing, because of side-effects on heap - (sequence-actions state + (sequence-actions (transition state) update-time-listener! to-send)])))) diff --git a/os2-udp-test.rkt b/os2-udp-test.rkt index 7a323b5..67e42a7 100644 --- a/os2-udp-test.rkt +++ b/os2-udp-test.rkt @@ -10,14 +10,11 @@ (define (packet-handler local-addr) (role (set (topic-publisher (udp-packet local-addr (wild) (wild))) (topic-subscriber (udp-packet (wild) local-addr (wild)))) - #:state state [(udp-packet source _ #"quit\n") - (transition state - (send-message (udp-packet local-addr source #"OK, quitting\n")) - (kill #:reason "Asked to quit"))] + (list (send-message (udp-packet local-addr source #"OK, quitting\n")) + (kill #:reason "Asked to quit"))] [(udp-packet source sink body) - (transition state - (send-message (udp-packet sink source body)))])) + (send-message (udp-packet sink source body))])) (check-role (packet-handler (udp-listener 5555)) 'arbitrary diff --git a/os2-udp.rkt b/os2-udp.rkt index 058061a..7f24615 100644 --- a/os2-udp.rkt +++ b/os2-udp.rkt @@ -58,7 +58,7 @@ #:on-presence (match t [(topic _ (udp-packet _ local-addr _) #f) (cond - [(set-member? active-handles local-addr) active-handles] + [(set-member? active-handles local-addr) (transition active-handles)] [else (transition (set-add active-handles local-addr) (spawn (udp-socket-manager local-addr) @@ -102,7 +102,7 @@ #:debug-name (list 'udp-socket-closer local-addr)))) [(udp-packet (== local-addr) (udp-address remote-host remote-port) body) (udp-send-to s remote-host remote-port body) - state]) + (transition state)]) ;; Listen for messages arriving on the actual socket using a ;; ground event, and relay them at this level. (role (topic-subscriber (cons (udp-receive!-evt s buffer) (wild))) @@ -119,11 +119,10 @@ (define udp-spy (transition 'no-state (role (topic-subscriber (wild) #:monitor? #t) - #:state state [(udp-packet source dest body) (write `(UDP ,source --> ,dest)) (newline) (dump-bytes! body (bytes-length body)) - state] + (void)] [other (write `(UDP ,other)) (newline) - state]))) + (void)]))) diff --git a/os2.rkt b/os2.rkt index 53988f2..ceb9ec1 100644 --- a/os2.rkt +++ b/os2.rkt @@ -174,7 +174,9 @@ ;; Transition -> (transition ConsTreeOf) (define (maybe-transition->transition t) (cond [(transition? t) t] - [else (transition t '())])) + [else + (define message (format "maybe-transition->transition: Expected transition; got ~v" t)) + (transition #f (kill #f (exn:fail:contract message (current-continuation-marks))))])) ;; Preactions. ;; Ks are various TrapKs or #f, signifying lack of interest. @@ -277,7 +279,7 @@ (match message-body [message-pattern clause-body ...] ... - [_ state])]))))]) + [_ (make-transition state)])]))))]) #`(add-role #,(if (attribute pre-eid) #'pre-eid #'(gensym 'anonymous-role)) @@ -407,7 +409,7 @@ ;; Composing state transitions and action emissions. (define (sequence-actions t . more-actions-and-transformers) - (match-define (transition initial-state initial-actions) (maybe-transition->transition t)) + (match-define (transition initial-state initial-actions) t) (let loop ((state initial-state) (actions initial-actions) (items more-actions-and-transformers)) @@ -415,8 +417,7 @@ ['() (transition state actions)] [(cons (? procedure? transformer) remaining-items) - (match-define (transition new-state more-actions) - (maybe-transition->transition (transformer state))) + (match-define (transition new-state more-actions) (transformer state)) (loop new-state (cons actions more-actions) remaining-items)] @@ -724,7 +725,7 @@ (define (((wrap-trapk pid new-party trapk) . args) state) (if (hash-has-key? (vm-processes state) pid) (run-vm (apply run-trapk state pid new-party trapk args)) - state)) + (make-transition state))) (define (transform-meta-action pid preaction state) (match preaction