Switch to endpoint-based actor.rkt layer

This commit is contained in:
Tony Garnock-Jones 2015-12-03 12:55:40 -08:00
parent 54b80cf79b
commit 1e1fccd34d
2 changed files with 31 additions and 33 deletions

View File

@ -51,6 +51,7 @@
(require "core.rkt") (require "core.rkt")
(require "route.rkt") (require "route.rkt")
(require "endpoint.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actor State ;; Actor State
@ -67,7 +68,7 @@
;; - (patch-instruction Patch (Void -> Instruction)) ;; - (patch-instruction Patch (Void -> Instruction))
;; - (send-instruction Message (Void -> Instruction)) ;; - (send-instruction Message (Void -> Instruction))
;; - (quit-instruction (Option Exn)) ;; - (quit-instruction (Option Exn))
;; - (spawn-instruction LinkageKind Script (-> Variables) Behavior (Void -> Instruction)) ;; - (spawn-instruction LinkageKind Script (-> Variables) (Void -> Instruction))
;; - (script-complete-instruction Variables) ;; - (script-complete-instruction Variables)
;; and represents a side-effect for an actor to take in its ;; and represents a side-effect for an actor to take in its
;; interactions with the outside world. ;; interactions with the outside world.
@ -87,13 +88,11 @@
;; are used, directly or indirectly. (TODO: `background`?) The ;; are used, directly or indirectly. (TODO: `background`?) The
;; included function yielding Variables sets up the initial variables ;; included function yielding Variables sets up the initial variables
;; of the actor, and the included Script transforms the variables and ;; of the actor, and the included Script transforms the variables and
;; performs initial side effects that must be performed in a context ;; performs initial side effects, including establishing the ongoing
;; where the spawned actor's ongoing event handlers are already ;; event handlers via add-endpoint actions. The included (Void ->
;; established. The included Behavior describes exactly the ongoing ;; Instruction) continuation is released when the spawned actor
;; event handlers, and the included (Void -> Instruction) continuation ;; terminates (for blocking variants) or immediately following the
;; is released when the spawned actor terminates (for blocking ;; spawn (for non-blocking variants).
;; variants) or immediately following the spawn (for non-blocking
;; variants).
;; ;;
;; (Background is done differently, with a new continuation for the ;; (Background is done differently, with a new continuation for the
;; background script, and a self-send to activate it. (TODO)) ;; background script, and a self-send to activate it. (TODO))
@ -101,7 +100,7 @@
(struct patch-instruction (patch k) #:transparent) (struct patch-instruction (patch k) #:transparent)
(struct send-instruction (message k) #:transparent) (struct send-instruction (message k) #:transparent)
(struct quit-instruction (maybe-exn) #:transparent) (struct quit-instruction (maybe-exn) #:transparent)
(struct spawn-instruction (linkage-kind init-script init-variables-fn ongoing-handler k) (struct spawn-instruction (linkage-kind init-script init-variables-fn k)
#:transparent) #:transparent)
(struct script-complete-instruction (variables) #:transparent) (struct script-complete-instruction (variables) #:transparent)
@ -112,7 +111,6 @@
caller-id ;; Symbol caller-id ;; Symbol
self-id ;; Symbol self-id ;; Symbol
variables ;; Variables variables ;; Variables
adhoc-assertions ;; Matcher - assert!/retract! aggregate
pending-patch ;; (Option Patch) - assert!/retract! patch being accumulated pending-patch ;; (Option Patch) - assert!/retract! patch being accumulated
) )
#:prefab) #:prefab)
@ -193,9 +191,9 @@
(lambda () (quit-instruction maybe-exn)))) (lambda () (quit-instruction maybe-exn))))
;; Returns new variables, plus values from spawned actor if any. ;; Returns new variables, plus values from spawned actor if any.
(define (spawn! linkage-kind init-script init-variables-fn ongoing-handler) (define (spawn! linkage-kind init-script init-variables-fn)
(call-in-raw-context (call-in-raw-context
(lambda (k) (spawn-instruction linkage-kind init-script init-variables-fn ongoing-handler k)))) (lambda (k) (spawn-instruction linkage-kind init-script init-variables-fn k))))
;; Syntax for spawning a 'call-linked actor. ;; Syntax for spawning a 'call-linked actor.
(define-syntax (state stx) (define-syntax (state stx)
@ -220,6 +218,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main behavior of HLL actors ;; Main behavior of HLL actors
;; Special EID used to track ad-hoc assertions
;; TODO: Revisit this, it is a bit ugly
(define *adhoc-eid* -2) ;; TODO: -1 is used in spawn-endpoint-group
;; Behavior ;; Behavior
(define (generic-actor-behavior e s) (define (generic-actor-behavior e s)
(match e (match e
@ -276,23 +278,20 @@
[(patch-instruction p get-next-instr) [(patch-instruction p get-next-instr)
(define p0 (actor-state-pending-patch s)) (define p0 (actor-state-pending-patch s))
(handle-actor-syscall (transition (struct-copy actor-state s (handle-actor-syscall (transition (struct-copy actor-state s
[adhoc-assertions [pending-patch (if p0 (patch-seq p0 p) p)])
(update-interests (actor-state-adhoc-assertions s) p)]
[pending-patch
(if p0 (patch-seq p0 p) p)])
previous-actions) previous-actions)
(get-next-instr (void)))] (get-next-instr (void)))]
[(send-instruction m get-next-instr) [(send-instruction m get-next-instr)
(handle-actor-syscall (transition (struct-copy actor-state s [pending-patch #f]) (handle-actor-syscall (transition (struct-copy actor-state s [pending-patch #f])
(list previous-actions (list previous-actions
(actor-state-pending-patch s) (as-endpoint *adhoc-eid* (actor-state-pending-patch s))
(message m))) (message m)))
(get-next-instr (void)))] (get-next-instr (void)))]
[(quit-instruction maybe-exn) [(quit-instruction maybe-exn)
(quit #:exception maybe-exn (quit #:exception maybe-exn
(list previous-actions (list previous-actions
(actor-state-pending-patch s)))] (as-endpoint *adhoc-eid* (actor-state-pending-patch s))))]
[(spawn-instruction linkage-kind init-script init-variables-fn ongoing-handler get-next-instr) [(spawn-instruction linkage-kind init-script init-variables-fn get-next-instr)
(define callee-id (gensym 'actor)) (define callee-id (gensym 'actor))
(define callee-caller-id (and (eq? linkage-kind 'call) (actor-state-self-id s))) (define callee-caller-id (and (eq? linkage-kind 'call) (actor-state-self-id s)))
(define sub-to-callees (define sub-to-callees
@ -306,24 +305,23 @@
(transition (store-continuation s callee-id get-next-instr) (transition (store-continuation s callee-id get-next-instr)
(list previous-actions (list previous-actions
(<spawn> (lambda () (<spawn> (lambda ()
(list (if ongoing-handler ;; TODO: ↓ Handle quit, #f etc.
(compose-ongoing-handler ongoing-handler) (match-define (transition initial-state initial-actions)
generic-actor-behavior) (transition-bind
(transition-bind (lambda (s) (run-script s init-script))
(lambda (s) (run-script s init-script)) (transition (actor-state (hasheq)
(transition (actor-state (hasheq) callee-caller-id
callee-caller-id callee-id
callee-id (init-variables-fn)
(init-variables-fn) #f)
(matcher-empty) initial-subs)))
#f) (boot-endpoint-group initial-state initial-actions)))))]
initial-subs)))))))]
[(script-complete-instruction new-variables) [(script-complete-instruction new-variables)
(transition (struct-copy actor-state s (transition (struct-copy actor-state s
[pending-patch #f] [pending-patch #f]
[variables new-variables]) [variables new-variables])
(list previous-actions (list previous-actions
(actor-state-pending-patch s)))])) (as-endpoint *adhoc-eid* (actor-state-pending-patch s))))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compilation of HLL actors ;; Compilation of HLL actors

View File

@ -83,7 +83,7 @@
[(? patch?) (compute-affected-pids routing-table e)] [(? patch?) (compute-affected-pids routing-table e)]
[(message body) [(message body)
(tset->list (matcher-match-value routing-table (observe body) (datum-tset)))])) (tset->list (matcher-match-value routing-table (observe body) (datum-tset)))]))
(sequence-handlers g (for/list [(eid affected-eids)] (sequence-handlers g (for/list [(eid (sort affected-eids <))]
(list (if (patch? e) (list (if (patch? e)
(view-patch e (hash-ref interests eid matcher-empty)) (view-patch e (hash-ref interests eid matcher-empty))
e) e)