diff --git a/racket/syndicate/dataflow.rkt b/racket/syndicate/dataflow.rkt index db6d62d..09859af 100644 --- a/racket/syndicate/dataflow.rkt +++ b/racket/syndicate/dataflow.rkt @@ -78,7 +78,7 @@ [(define (write-proc c port mode) (fprintf port "#" (cell-value c)))]) - (define g (make-dataflow-graph)) + (define g #f) (define (R b) (dataflow-record-observation! g b) @@ -95,12 +95,28 @@ (define-syntax-rule (V expr) (letrec ((node (cell #f)) (handler (lambda () - (printf "Evaluating ~a\n" 'expr) + ;; (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)))) @@ -114,26 +130,43 @@ (/ (R avg) (R scale)))))) (define (fix! stage) - (printf "\n----- Stage: ~a\n" 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)) + ;; (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)) + (fix! 'four-five-six) + (check-results '(4 5 6) 15 3 15/3 1 15/3))