Step 5 complete: named actor registry with auto-unregister
ober
739b162eebc13adba51a618c395669254df508af
--- a/docs/actor-model.md +++ b/docs/actor-model.md @@ -3375,23 +3375,25 @@ Implementation checklist: **Note**: Use `(only (jerboa core) match)` not bare `(jerboa core)` to avoid identifier conflicts with `(chezscheme)` (`1+`, `iota`, `make-hash-table`). -### Step 5: Registry +### Step 5: Registry ✓ COMPLETE **File**: `lib/std/actor/registry.sls` **Test**: `tests/test-actor-registry.ss` -**Dependencies**: `core.sls`, `protocol.sls`, `(jerboa core)` (for `match`) +**Dependencies**: `core.sls`, `protocol.sls`, `(only (jerboa core) match)` Implementation checklist: -- [ ] `start-registry!` spawns the registry actor -- [ ] `register!` registers name, returns `'already-registered` if duplicate -- [ ] `whereis` returns actor-ref or `#f` -- [ ] `unregister!` removes name -- [ ] Auto-unregister when actor dies (via monitor + DOWN message) -- [ ] `registered-names` returns list of all names -- [ ] Test: register, whereis returns same ref -- [ ] Test: register duplicate returns 'already-registered -- [ ] Test: actor dies, whereis returns #f -- [ ] Test: unregister manually, whereis returns #f +- [x] `start-registry!` spawns the registry actor +- [x] `register!` registers name, returns `'already-registered` if duplicate +- [x] `whereis` returns actor-ref or `#f` +- [x] `unregister!` removes name +- [x] Auto-unregister when actor dies (via monitor + DOWN message) +- [x] `registered-names` returns list of all names +- [x] Test: register, whereis returns same ref +- [x] Test: register duplicate returns 'already-registered +- [x] Test: actor dies, whereis returns #f +- [x] Test: unregister manually, whereis returns #f +- [x] Test: two names for the same actor both resolve +- [x] Test: 10 register/unregister cycles leaves clean state (12/12 passed) ### Step 6: Work-Stealing Scheduler new file mode 100644 --- /dev/null +++ b/lib/std/actor/registry.sls @@ -0,0 +1,86 @@ +#!chezscheme +;;; (std actor registry) — Named actor registry +;;; +;;; The registry is itself an actor. Names map to actor-refs. +;;; When a registered actor dies, its name is auto-removed via a monitor. + +(library (std actor registry) + (export + start-registry! + register! ;; (register! name actor-ref) → 'ok | 'already-registered + unregister! ;; (unregister! name) → 'ok + whereis ;; (whereis name) → actor-ref or #f + registered-names ;; → list of registered names + registry-actor ;; → the registry actor-ref itself + ) + (import (chezscheme) + (only (jerboa core) match) + (std actor core) + (std actor protocol)) + + (define *registry-actor* #f) + (define (registry-actor) *registry-actor*) + + ;; -------- Registry behavior -------- + + (define (make-registry-behavior) + (let ([table (make-eq-hashtable)]) + (lambda (msg) + (with-ask-context msg + (lambda (actual) + (match actual + [('register name ref) + (if (hashtable-ref table name #f) + (reply 'already-registered) + (begin + ;; Monitor the actor: auto-unregister on death + (actor-ref-monitors-set! ref + (cons (cons (self) name) + (actor-ref-monitors ref))) + (hashtable-set! table name ref) + (reply 'ok)))] + + [('unregister name) + (let ([ref (hashtable-ref table name #f)]) + (when ref + ;; Remove our monitor from the actor's list + (when (actor-alive? ref) + (actor-ref-monitors-set! ref + (filter (lambda (mon) + (not (and (eq? (car mon) (self)) + (eq? (cdr mon) name)))) + (actor-ref-monitors ref))))) + (hashtable-delete! table name) + (reply 'ok))] + + [('whereis name) + (reply (hashtable-ref table name #f))] + + [('names) + (reply (vector->list (hashtable-keys table)))] + + ;; Actor died — auto-unregister its name (from monitor DOWN) + [('DOWN name dead-id reason) + (hashtable-delete! table name)] + + [_ (void)])))))) + + ;; -------- Public API -------- + + (define (start-registry!) + (set! *registry-actor* + (spawn-actor (make-registry-behavior) 'registry))) + + (define (register! name actor-ref) + (ask-sync *registry-actor* (list 'register name actor-ref))) + + (define (unregister! name) + (ask-sync *registry-actor* (list 'unregister name))) + + (define (whereis name) + (ask-sync *registry-actor* (list 'whereis name))) + + (define (registered-names) + (ask-sync *registry-actor* '(names))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-actor-registry.ss @@ -0,0 +1,94 @@ +#!chezscheme +;;; Tests for (std actor registry) — named actor registry + +(import (chezscheme) (jerboa core) + (std actor core) (std actor protocol) (std actor registry)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn + [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: exception ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s, expected ~s~%" name got expected)))))])) + +(define (wait-ms n) + (sleep (make-time 'time-duration (* n 1000000) 0))) + +(printf "--- (std actor registry) tests ---~%") + +(start-registry!) + +;; Test 1: register! then whereis returns same ref +(let ([a (spawn-actor (lambda (msg) (void)))]) + (test "register-ok" (register! 'actor-1 a) 'ok) + (test "whereis-found" (whereis 'actor-1) a) + (unregister! 'actor-1) + (actor-kill! a)) + +;; Test 2: duplicate registration returns 'already-registered +(let ([a (spawn-actor (lambda (msg) (void)))]) + (register! 'dup a) + (test "dup-register" (register! 'dup a) 'already-registered) + (unregister! 'dup) + (actor-kill! a)) + +;; Test 3: unregister then whereis returns #f +(let ([a (spawn-actor (lambda (msg) (void)))]) + (register! 'going a) + (test "unregister-ok" (unregister! 'going) 'ok) + (test "whereis-after-unreg" (whereis 'going) #f) + (actor-kill! a)) + +;; Test 4: actor dies → auto-unregistered via monitor +(let ([a (spawn-actor (lambda (msg) (void)))]) + (register! 'dying a) + (actor-kill! a) + ;; Wait for DOWN to propagate through the registry actor + (wait-ms 200) + (test "auto-unregister" (whereis 'dying) #f)) + +;; Test 5: registered-names returns all current names +(let ([a (spawn-actor (lambda (msg) (void)))] + [b (spawn-actor (lambda (msg) (void)))]) + (register! 'first a) + (register! 'second b) + (let ([names (registered-names)]) + (test "names-has-first" (if (memq 'first names) #t #f) #t) + (test "names-has-second" (if (memq 'second names) #t #f) #t)) + (unregister! 'first) + (unregister! 'second) + (actor-kill! a) + (actor-kill! b)) + +;; Test 6: register the same actor under two names +(let ([a (spawn-actor (lambda (msg) (void)))]) + (register! 'name-x a) + (register! 'name-y a) + (test "two-names-x" (whereis 'name-x) a) + (test "two-names-y" (whereis 'name-y) a) + (unregister! 'name-x) + (unregister! 'name-y) + (actor-kill! a)) + +;; Test 7: whereis unknown name returns #f +(test "whereis-unknown" (whereis 'no-such-actor) #f) + +;; Test 8: registry survives multiple register/unregister cycles +(let ([a (spawn-actor (lambda (msg) (void)))]) + (do ([i 0 (+ i 1)]) ((= i 10)) + (register! 'cycling a) + (unregister! 'cycling)) + (test "cycling-final" (whereis 'cycling) #f) + (actor-kill! a)) + +(printf "~%Results: ~a passed, ~a failed~%" pass fail) +(when (> fail 0) (exit 1))