68 lines
2.6 KiB
Racket
68 lines
2.6 KiB
Racket
#lang racket/base
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2016-2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
;; Simple lazy dataflow.
|
|
|
|
(provide dataflow-graph?
|
|
make-dataflow-graph
|
|
dataflow-graph-edges-forward
|
|
|
|
current-dataflow-subject-id
|
|
|
|
dataflow-record-observation!
|
|
dataflow-record-damage!
|
|
dataflow-forget-subject!
|
|
dataflow-repair-damage!)
|
|
|
|
(require racket/set)
|
|
(require "support/hash.rkt")
|
|
|
|
(struct dataflow-graph (edges-forward ;; object-id -> (Setof subject-id)
|
|
edges-reverse ;; subject-id -> (Setof object-id)
|
|
damaged-nodes ;; Hashof object-id True
|
|
)
|
|
#:mutable)
|
|
|
|
(define current-dataflow-subject-id (make-parameter #f))
|
|
|
|
(define (make-dataflow-graph)
|
|
(dataflow-graph (hash)
|
|
(hash)
|
|
(hash)))
|
|
|
|
(define (dataflow-record-observation! g object-id)
|
|
(define subject-id (current-dataflow-subject-id))
|
|
(when subject-id
|
|
(define fwd (dataflow-graph-edges-forward g))
|
|
(set-dataflow-graph-edges-forward! g (hashset-add fwd object-id subject-id))
|
|
(define rev (dataflow-graph-edges-reverse g))
|
|
(set-dataflow-graph-edges-reverse! g (hashset-add rev subject-id object-id))))
|
|
|
|
(define (dataflow-record-damage! g object-id)
|
|
(set-dataflow-graph-damaged-nodes! g (hash-set (dataflow-graph-damaged-nodes g) object-id #t)))
|
|
|
|
(define (dataflow-forget-subject! g subject-id)
|
|
(define rev (dataflow-graph-edges-reverse g))
|
|
(set-dataflow-graph-edges-reverse! g (hash-remove rev subject-id))
|
|
(for [(object-id (in-hashset-values rev subject-id))]
|
|
(define fwd (dataflow-graph-edges-forward g))
|
|
(set-dataflow-graph-edges-forward! g (hashset-remove fwd object-id subject-id))))
|
|
|
|
(define (dataflow-repair-damage! g repair-node!)
|
|
(let loop ()
|
|
(define workset (dataflow-graph-damaged-nodes g))
|
|
(when (not (hash-empty? workset))
|
|
(set-dataflow-graph-damaged-nodes! g (hash))
|
|
(define updated (make-hash))
|
|
(hash-for-each workset
|
|
(lambda (object-id _)
|
|
(for [(subject-id
|
|
(in-hashset-values (dataflow-graph-edges-forward g) object-id))]
|
|
(when (not (hash-has-key? updated subject-id))
|
|
(hash-set! updated subject-id #t)
|
|
(dataflow-forget-subject! g subject-id)
|
|
(parameterize ((current-dataflow-subject-id subject-id))
|
|
(repair-node! subject-id))))))
|
|
(loop))))
|