More structured FID representation.

syndicate/dataspace.rkt

@@ -13,14 +13,18 @@
 (require "pattern.rkt")
 (require "bag.rkt")
 
+;; An `ActorID` uniquely identifies an actor in a `Dataspace`.
+;;
 ;; A `FID` is a Facet ID, uniquely identifying both a facet and its
 ;; ancestry in a `Dataspace`.
 ;;
-;;     FID = (Listof Nat)
+;;     FID = (facet-id ActorID (Listof Nat))
 ;;
-;; The first `Nat` in the list is the unique identifier for this
+(struct facet-id (actor path) #:prefab)
-;; facet; the `cdr` of the list is the FID of its parent facet. No two
+;;
-;; `FID`s in a `Dataspace` have the same first `Nat`.
+;; The first `Nat` in `path` is the unique identifier for this facet;
+;; the `cdr` of the list is the `path` its parent facet. No two `FID`s
+;; in a `Dataspace` have the same first `Nat` in their `path`.
 
 ;; A `Dataspace` is a ... TODO
 
@@ -33,7 +37,7 @@
 (struct dataspace ([next-id #:mutable] ;; Nat
                    routing-table ;; Skeleton
                    facets ;; (MutableHash FID Facet)
-                   actors ;; (MutableHash FID Any) ;; maps FID to actor name
+                   actors ;; (MutableHash ActorID Any) ;; maps ActorID to actor name
                    assertions ;; (Bagof Assertion)
                    dataflow ;; DataflowGraph
                    pending-scripts ;; (MutableVectorof (Queueof (-> Any)))
@@ -41,7 +45,7 @@
                    )
   #:transparent)
 
-(struct facet (id ;; FID
+(struct facet (fid ;; FID
                endpoints ;; (MutableHash EID Endpoint)
                [stop-scripts #:mutable] ;; (Listof Script) -- IN REVERSE ORDER
                [children #:mutable] ;; (Setof FID)
@@ -59,7 +63,7 @@
 ;; it on access.
 (struct field-handle (name ;; Symbol
                       id ;; Nat
-                      owner ;; FID
+                      owner ;; ActorID
                       [value #:mutable] ;; Any
                       )
   #:methods gen:custom-write
@@ -135,36 +139,38 @@
     (set-dataspace-next-id! ds (+ id 1))
     id))
 
+;; TODO: remove??
 (define (fid-parent fid)
-  (cdr fid))
+  (match-define (facet-id actor (cons _ path)) fid)
+  (facet-id actor path))
 
 (define (generate-fid! ds parent-fid)
-  (cons (generate-id! ds) parent-fid))
+  (match-define (facet-id actor path) parent-fid)
-
+  (facet-id actor (cons (generate-id! ds) path)))
-(define (actor-fid? fid)
-  (null? (fid-parent fid)))
-
-(define (fid->actor-fid fid)
-  (if (actor-fid? fid)
-      fid
-      (fid->actor-fid (fid-parent fid))))
 
 (define (fid-ancestor? fid maybe-ancestor)
-  (and (pair? fid) ;; empty fid lists obviously no ancestors at all!
+  (and (equal? (facet-id-actor fid) (facet-id-actor maybe-ancestor))
-       (or (equal? fid maybe-ancestor)
+       (let ((b-path (facet-id-path maybe-ancestor)))
-           (fid-ancestor? (cdr fid) maybe-ancestor))))
+         (let walk ((a-path (facet-id-path fid)))
+           (and (pair? a-path) ;; empty fid lists obviously no ancestors at all!
+                (or (equal? a-path b-path)
+                    (walk (cdr a-path))))))))
+
+(define (has-parent? fid)
+  (pair? (cdr (facet-id-path fid))))
 
 (define (add-actor! ds name boot-proc initial-assertions)
-  (define actor-fid (generate-fid! ds '()))
+  (define actor-id (generate-id! ds))
-  (hash-set! (dataspace-actors ds) actor-fid name)
+  (define root-fid (facet-id actor-id (list actor-id))) ;; TODO: bad convention. Use a fresh Nat, don't reuse actor-id in the path
+  (hash-set! (dataspace-actors ds) actor-id name)
   (for [(a initial-assertions)]
     (match (bag-change! (dataspace-assertions ds) a 1)
       ['absent->present (add-assertion! (dataspace-routing-table ds) a)]
       ;; 'absent->absent and 'present->absent absurd
       ['present->present (void)])) ;; i.e. no visible change
-  (add-facet! ds #f actor-fid (lambda ()
+  (add-facet! ds #f root-fid (lambda ()
-                                (boot-proc)
+                               (boot-proc)
-                                (for [(a initial-assertions)] (dataspace-retract! ds a)))))
+                               (for [(a initial-assertions)] (dataspace-retract! ds a)))))
 
 (define (lookup-facet ds fid)
   (hash-ref (dataspace-facets ds) fid #f))
@@ -176,7 +182,7 @@
                    (current-facet-id fid)
                    (in-script? script?))
       (with-handlers ([(lambda (e) (not (exn:break? e)))
-                       (lambda (e) (terminate-actor! ds (fid->actor-fid fid)))]) ;; TODO: tracing
+                       (lambda (e) (terminate-actor! ds (facet-id-actor fid)))]) ;; TODO: tracing
         body ...
         (void)))))
 
@@ -258,14 +264,15 @@
                    '()
                    (set)))
   (hash-set! (dataspace-facets ds) fid f)
-  (when (pair? parent-fid)
+  (when (has-parent? fid)
     (define pf (lookup-facet ds parent-fid))
     (when pf (set-facet-children! pf (set-add (facet-children pf) fid))))
   (with-current-facet [ds fid #f]
     (boot-proc))
   (schedule-script!* ds (lambda ()
                           (when (and (facet-live? ds fid)
-                                     (or (and (pair? parent-fid) (not (facet-live? ds parent-fid)))
+                                     (or (and (has-parent? fid)
+                                              (not (facet-live? ds parent-fid)))
                                          (facet-live-but-inert? ds fid)))
                             (terminate-facet! ds fid)))))
 
@@ -295,11 +302,9 @@
                             (when h (dataspace-unsubscribe! ds h))))))
 
 ;; Abruptly terminates an entire actor, without running stop-scripts etc.
-(define (terminate-actor! ds actor-fid)
+(define (terminate-actor! ds actor-id)
-  (when (not (actor-fid? actor-fid))
+  (hash-remove! (dataspace-actors ds) actor-id)
-    (error 'terminate-actor! "Attempt to terminate non-actor FID ~a" actor-fid))
+  (let abort-facet! ((fid (facet-id actor-id (list actor-id)))) ;; TODO: ugh
-  (hash-remove! (dataspace-actors ds) actor-fid)
-  (let abort-facet! ((fid actor-fid))
     (define f (lookup-facet ds fid))
     (when f
       (hash-remove! (dataspace-facets ds) fid)
@@ -312,7 +317,7 @@
   (when f
     (define parent-fid (fid-parent fid))
 
-    (when (pair? parent-fid)
+    (when (has-parent? fid)
       (define pf (lookup-facet ds parent-fid))
       (when pf (set-facet-children! pf (set-remove (facet-children pf) fid))))
 
@@ -335,7 +340,7 @@
      #:priority *gc-priority*
      ds
      (lambda ()
-       (if (pair? parent-fid)
+       (if (has-parent? fid)
            (when (facet-live-but-inert? ds parent-fid) (terminate-facet! ds parent-fid))
            (terminate-actor! ds fid))))))
 
@@ -415,7 +420,7 @@
         (lambda ()
           (define current-value (field-handle 'current-value
                                               (generate-id! (current-dataspace))
-                                              (fid->actor-fid (current-facet-id))
+                                              (facet-id-actor (current-facet-id))
                                               0))
           (add-endpoint! (current-dataspace)
                          'stop-when-ten