#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))))