#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2016-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(require "../../dataflow.rkt")

(module+ test
  (require rackunit)

  (struct cell (value) #:mutable
    #:methods gen:custom-write
    [(define (write-proc c port mode)
       (fprintf port "#<cell:~v>" (cell-value c)))])

  (define g #f)

  (define (R b)
    (dataflow-record-observation! g b)
    (cell-value b))

  (define (W b v)
    (when (not (equal? (cell-value b) v))
      (dataflow-record-damage! g b)
      (set-cell-value! b v)))

  (define (repair! b)
    (b))

  (define-syntax-rule (V expr)
    (letrec ((node (cell #f))
             (handler (lambda ()
                        ;; (printf "Evaluating ~a\n" 'expr)
                        (W node expr))))
      (parameterize ((current-dataflow-subject-id handler))
        (handler)
        node)))

  (set! g (make-dataflow-graph))
  (let* ((c (V 123))
         (d (V (* (R c) 2))))
    (check-equal? (list (R c) (R d)) (list 123 246))
    (dataflow-repair-damage! g repair!)
    (check-equal? (list (R c) (R d)) (list 123 246))
    (dataflow-repair-damage! g repair!)
    (check-equal? (list (R c) (R d)) (list 123 246))
    (W c 124)
    (check-equal? (list (R c) (R d)) (list 124 246))
    (dataflow-repair-damage! g repair!)
    (check-equal? (list (R c) (R d)) (list 124 248)))
  ;; (newline)

  (set! g (make-dataflow-graph))

  (define xs (V (list 1 2 3 4)))
  (define sum (V (foldr + 0 (R xs))))
  (define len (V (length (R xs))))
  (define avg (V (if (zero? (R len))
                     (void)
                     (/ (R sum) (R len)))))
  (define scale (V 1))
  (define ans (V (if (zero? (R scale))
                     (void)
                     (and (number? (R avg))
                          (/ (R avg) (R scale))))))

  (define (fix! stage)
    ;; (printf "\n----- Stage: ~a\n" stage)
    (dataflow-repair-damage! g repair!)
    ;; (write `((xs ,(R xs))
    ;;          (sum ,(R sum))
    ;;          (len ,(R len))
    ;;          (avg ,(R avg))
    ;;          (scale ,(R scale))
    ;;          (ans ,(R ans))))
    ;; (newline)
    )

  (define-syntax-rule (check-results vs ...)
    (check-equal? (map R (list xs sum len avg scale ans)) (list vs ...)))

  (fix! 'initial)
  (check-results '(1 2 3 4) 10 4 10/4 1 10/4)

  (W scale 0)
  (fix! 'scale-zero)
  (check-results '(1 2 3 4) 10 4 10/4 0 (void))

  (W xs (list* 9 0 (R xs)))
  (fix! 'with-nine-and-zero)
  (check-results '(9 0 1 2 3 4) 19 6 19/6 0 (void))

  (W xs (list* 5 4 (cddr (R xs))))
  (fix! 'with-five-and-four)
  (check-results '(5 4 1 2 3 4) 19 6 19/6 0 (void))

  (W scale 1)
  (fix! 'scale-one)
  (check-results '(5 4 1 2 3 4) 19 6 19/6 1 19/6)

  (W xs '())
  (fix! 'empty)
  (check-results '() 0 0 (void) 1 #f)

  (W xs (list 4 5 6))
  (fix! 'four-five-six)
  (check-results '(4 5 6) 15 3 15/3 1 15/3))