spawn->process+transition

This commit is contained in:
Tony Garnock-Jones 2016-07-30 13:48:42 -04:00
parent c0786c86ca
commit 17db697690
4 changed files with 21 additions and 21 deletions

View File

@ -60,7 +60,8 @@
clean-actions clean-actions
clean-transition clean-transition
update-process-state) update-process-state
spawn->process+transition)
(require racket/match) (require racket/match)
(require (only-in racket/list flatten)) (require (only-in racket/list flatten))
@ -154,6 +155,10 @@
(define (update-process-state i new-state) (define (update-process-state i new-state)
(struct-copy process i [state new-state])) (struct-copy process i [state new-state]))
(define (spawn->process+transition s)
(match-define (list beh t name) ((spawn-boot s)))
(values (process name beh 'undefined-initial-state) t))
(define (make-quit #:exception [exn #f] . actions) (define (make-quit #:exception [exn #f] . actions)
(quit exn actions)) (quit exn actions))

View File

@ -154,5 +154,5 @@
;; Spawn -> Void ;; Spawn -> Void
(define (run-ground* s) (define (run-ground* s)
(match-define (list beh t name) ((spawn-boot s))) (define-values (proc t) (spawn->process+transition s))
(process-transition t (process name beh 'undefined-initial-ground-state) trie-empty 0)) (process-transition t proc trie-empty 0))

View File

@ -91,20 +91,18 @@
inbound-parenthesis inbound-parenthesis
inner-spawn) inner-spawn)
(<spawn> (lambda () (<spawn> (lambda ()
(match-define (list inner-behavior initial-transition name) ((spawn-boot inner-spawn))) (define-values (proc initial-transition) (spawn->process+transition inner-spawn))
(define initial-relay-state (relay outbound? (define initial-relay-state (relay outbound?
outbound-assertion outbound-assertion
outbound-parenthesis outbound-parenthesis
inbound-constructor inbound-constructor
inbound-parenthesis inbound-parenthesis
(process name proc))
inner-behavior
'uninitialized:initial-inner-state)))
(list relay-handle-event (list relay-handle-event
(relay-transition (transition-bind (inject-relay-subscription initial-relay-state) (relay-transition (transition-bind (inject-relay-subscription initial-relay-state)
initial-transition) initial-transition)
initial-relay-state) initial-relay-state)
name)))) (process-name proc)))))
(define (pretty-print-relay r p) (define (pretty-print-relay r p)
(fprintf p "RELAY ~a/~a\n" (fprintf p "RELAY ~a/~a\n"

View File

@ -41,33 +41,30 @@
(define (run-thread actor-path spawn-action-thunk) (define (run-thread actor-path spawn-action-thunk)
(define actor-path-rev (reverse actor-path)) (define actor-path-rev (reverse actor-path))
(match-define (list (? procedure? behaviour)
(? general-transition? initial-transition)
_name)
((spawn-boot (spawn-action-thunk))))
(define (process-transition state t) (define (process-transition proc t)
(match t (match t
[(<quit> exn acs) [(<quit> exn acs)
(send-ground-message (thread-quit exn acs) #:path actor-path)] (send-ground-message (thread-quit exn acs) #:path actor-path)]
[(transition new-state acs) [(transition new-state acs)
(when (not (or (null? acs) (eq? acs #f) (void? acs))) (when (not (or (null? acs) (eq? acs #f) (void? acs)))
(send-ground-message (thread-transition acs) #:path actor-path)) (send-ground-message (thread-transition acs) #:path actor-path))
(deliver-event #f new-state)] (deliver-event #f (update-process-state proc new-state))]
[_ [_
(await-event state)])) (await-event proc)]))
(define (deliver-event e state) (define (deliver-event e proc)
(process-transition state (process-transition proc
(parameterize ((current-actor-path-rev actor-path-rev)) (parameterize ((current-actor-path-rev actor-path-rev))
(with-handlers [((lambda (exn) #t) (lambda (exn) (<quit> exn '())))] (with-handlers [((lambda (exn) #t) (lambda (exn) (<quit> exn '())))]
(behaviour e state))))) ((process-behavior proc) e (process-state proc))))))
(define (await-event state) (define (await-event proc)
(signal-background-activity! #f) (signal-background-activity! #f)
(deliver-event (thread-receive) state)) (deliver-event (thread-receive) proc))
(process-transition (void) initial-transition)) (call-with-values (lambda () (spawn->process+transition (spawn-action-thunk)))
process-transition))
(define-syntax actor/thread (define-syntax actor/thread
(syntax-rules () (syntax-rules ()