102 lines
3.1 KiB
Racket
102 lines
3.1 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021-2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide (except-out (struct-out entity) entity)
|
|
(rename-out [make-entity entity] [entity <entity>])
|
|
|
|
(struct-out actor)
|
|
(struct-out facet)
|
|
(struct-out entity-ref)
|
|
|
|
parse-Cap!)
|
|
|
|
(require racket/match)
|
|
(require (only-in racket/string string-join))
|
|
|
|
(require struct-defaults)
|
|
(require "support/counter.rkt")
|
|
(require "engine.rkt")
|
|
|
|
(struct entity (id name assert retract message sync data)
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define (write-proc e port mode)
|
|
(fprintf port "#<entity:~a:~a>" (entity-id e) (entity-name e)))])
|
|
|
|
(define generate-entity-id (make-counter))
|
|
|
|
(define-struct-defaults make-entity entity
|
|
(#:_id [entity-id (generate-entity-id)]
|
|
#:name [entity-name '?]
|
|
#:assert [entity-assert #f]
|
|
#:retract [entity-retract #f]
|
|
#:message [entity-message #f]
|
|
#:sync [entity-sync #f]
|
|
#:data [entity-data (void)]))
|
|
|
|
(struct actor (id
|
|
name
|
|
engine
|
|
[daemon? #:mutable]
|
|
dataflow
|
|
[root #:mutable]
|
|
[exit-reason #:mutable] ;; #f -> running, #t -> terminated OK, exn -> error
|
|
[exit-hooks #:mutable])
|
|
#:methods gen:custom-write
|
|
[(define (write-proc a port mode)
|
|
(fprintf port "#<actor:~a/~a:~a>" (engine-id (actor-engine a)) (actor-id a) (actor-name a)))])
|
|
|
|
(define (facet-path-to-root f)
|
|
(string-join (reverse (let loop ((f f))
|
|
(if (facet-parent f)
|
|
(cons (number->string (facet-id f)) (loop (facet-parent f)))
|
|
'())))
|
|
"/"))
|
|
|
|
(define (facet-liveness f)
|
|
(if (facet-live? f)
|
|
""
|
|
":(DEAD)"))
|
|
|
|
(struct facet (id
|
|
actor
|
|
parent
|
|
children
|
|
outbound
|
|
[end-of-turn-actions #:mutable]
|
|
[shutdown-actions #:mutable]
|
|
[live? #:mutable]
|
|
[inert-check-preventers #:mutable])
|
|
#:methods gen:custom-write
|
|
[(define (write-proc f port mode)
|
|
(local-require (only-in racket/string string-join))
|
|
(fprintf port "#<facet:~a/~a:~a:~a~a>"
|
|
(engine-id (actor-engine (facet-actor f)))
|
|
(actor-id (facet-actor f))
|
|
(actor-name (facet-actor f))
|
|
(facet-path-to-root f)
|
|
(facet-liveness f)))])
|
|
|
|
(struct entity-ref (relay target attenuation)
|
|
#:transparent
|
|
#:methods gen:custom-write
|
|
[(define (write-proc r port mode)
|
|
(match-define (entity-ref f e a) r)
|
|
(fprintf port "#<ref:~a:~a:~a/~a:~a:~a~a~a>"
|
|
(entity-id e)
|
|
(entity-name e)
|
|
(engine-id (actor-engine (facet-actor f)))
|
|
(actor-id (facet-actor f))
|
|
(actor-name (facet-actor f))
|
|
(facet-path-to-root f)
|
|
(facet-liveness f)
|
|
(if (null? a)
|
|
""
|
|
(format " ~s" a))))])
|
|
|
|
(define (parse-Cap! r)
|
|
(if (entity-ref? r)
|
|
r
|
|
(error 'parse-Ref! "Expected entity-ref; got ~v" r)))
|