diff --git a/racket/syndicate/hierarchy.rkt b/racket/syndicate/hierarchy.rkt index 9f7ff4e..c246f78 100644 --- a/racket/syndicate/hierarchy.rkt +++ b/racket/syndicate/hierarchy.rkt @@ -11,6 +11,8 @@ level-anchor level-anchor->meta-level) +(require "store.rkt") + ;; An event destined for a particular node in the actor hierarchy. ;; Used to inject events from the outside world. (struct targeted-event (relative-path event) #:prefab) @@ -22,10 +24,10 @@ (targeted-event relative-path event) event)) -;; Parameterof (Listof Any) +;; Storeof (Listof Any) ;; Path to the active leaf in the process tree. The car end is the ;; leaf; the cdr end, the root. -(define current-actor-path-rev (make-parameter '())) +(define current-actor-path-rev (make-store #:default-box (box '()))) ;; Retrieves current-actor-path-rev, but reversed, for use with ;; target-event. @@ -34,7 +36,7 @@ ;; Any (-> Any) -> Any ;; Pushes pid on current-actor-path for the duration of the call to thunk. (define (call/extended-actor-path pid thunk) - (parameterize ((current-actor-path-rev (cons pid (current-actor-path-rev)))) + (with-store ((current-actor-path-rev (cons pid (current-actor-path-rev)))) (thunk))) ;; Retrieves an abstract value to be used with level-anchor->meta-level to compute a diff --git a/racket/syndicate/store.rkt b/racket/syndicate/store.rkt index 777a403..18f9c6d 100644 --- a/racket/syndicate/store.rkt +++ b/racket/syndicate/store.rkt @@ -8,17 +8,18 @@ store-ref store-set!) -(struct store (mark-key) +(struct store (mark-key default-box) #:property prop:procedure (case-lambda [(s) (store-ref s)] [(s v) (store-set! s v)])) -(define (make-store) - (store (make-continuation-mark-key (gensym 'store)))) +(define (make-store #:default-box [default-box #f]) + (store (make-continuation-mark-key (gensym 'store)) default-box)) (define (store-box s) (or (continuation-mark-set-first #f (store-mark-key s)) + (store-default-box s) (error 'store-box "Attempt to access store that is not currently in scope"))) diff --git a/racket/syndicate/threaded.rkt b/racket/syndicate/threaded.rkt index b133f68..e7b1021 100644 --- a/racket/syndicate/threaded.rkt +++ b/racket/syndicate/threaded.rkt @@ -10,6 +10,7 @@ (require (except-in syndicate dataspace)) (require (only-in syndicate/actor actor dataspace schedule-action!)) (require syndicate/hierarchy) +(require syndicate/store) (struct proxy-state (thd) #:prefab) (struct thread-quit (exn actions) #:prefab) @@ -55,7 +56,7 @@ (define (deliver-event e proc) (process-transition proc - (parameterize ((current-actor-path-rev actor-path-rev)) + (with-store ((current-actor-path-rev actor-path-rev)) (with-handlers [((lambda (exn) #t) (lambda (exn) ( exn '())))] ((process-behavior proc) e (process-state proc))))))