small improvements

racket/typed/proto.rkt

@@ -187,7 +187,21 @@
       (Observe (Struct 'BookQuoteT (list String ⋆))))
     (check-true (hash-has-key? transitions (Know quote-request)))
     (check-equal? (hash-ref transitions (Know quote-request))
-                  (set (set 'seller 'fulfill)))))
+                  (set (set 'seller 'fulfill))))
+  (test-case
+      "compile role that quits"
+    (define r
+      (Role 'x
+            (list (Reacts (Know Int)
+                          (Stop 'x '())))))
+    (define state# (compile r))
+    (check-true (hash-has-key? state# (set)))
+    (check-true (hash-has-key? state# (set 'x)))
+    (define state0 (hash-ref state# (set 'x)))
+    (define transitions (state-transitions state0))
+    (check-true (hash-has-key? transitions (Know Int)))
+    (check-equal? (hash-ref transitions (Know Int))
+                  (set (set)))))
 
 ;; Role -> FacetTree
 (define (make-facet-tree role)
@@ -348,36 +362,31 @@
 ;; Role -> (Hashof FacetName TransitionDesc)
 ;; Extract a description of all roles mentioned in a Role
 (define (describe-roles role)
-  (let loop ([roles (list role)]
+  (define all-roles (enumerate-roles role))
-             [desc (hash)])
+  (for/hash ([r (in-list all-roles)])
-    (match roles
+    (define txn (describe-role r))
-      [(cons role roles)
+    (values (Role-nm r)
-       (match-define (Role nm eps) role)
+            txn)))
-       (define txn (describe-role role))
+
-       (define next-desc (hash-set desc nm txn))
+;; T -> (Listof Role)
-       (define acts
+;; Find all nested role descriptions
-         (for*/list ([ep (in-list eps)]
+(define (enumerate-roles t)
-                     #:when (Reacts? ep)
+  (match t
-                     [body (in-value (Reacts-body ep))]
+    [(Role _ eps)
-                     [act (in-list (Body->actions body))])
+     (define rs
-           act))
+       (for*/list ([ep (in-list eps)]
-       ;; need to find references to Roles inside arbitrarily nested Stops
+                   #:when (Reacts? ep)
-       (let search ([acts acts]
+                   [body (in-value (Reacts-body ep))]
-                    [more-roles roles])
+                   [act (in-list (Body->actions body))]
-         (match acts
+                   [role (in-list (enumerate-roles act))])
-           ['()
+         role))
-            (loop more-roles next-desc)]
+     (cons t rs)]
-           [(cons act acts)
+    [(Stop _ body)
-            (match act
+     (for*/list ([act (in-list (Body->actions body))]
-              [(Role _ _)
+                 [role (in-list (enumerate-roles act))])
-               (search acts (cons act more-roles))]
+       role)]
-              [(Stop _ body)
+    [(Spawn _)
-               (define more-acts (Body->actions body))
+     (error)]))
-               (search (append acts more-acts) more-roles)]
-              [_
-               (search acts more-roles)])]))]
-      ['()
-       desc])))
 
 ;; Role -> TransitionDesc
 ;; determine how the event handlers in a role alter the facet tree