#lang racket/base (provide digraph) (define (zero-thunk) 0) ;; digraph: ;; ('a list) * ('a -> 'a list) * ('a -> 'b) * ('b * 'b -> 'b) * (-> 'b) ;; -> ('a -> 'b) ;; DeRemer and Pennello 1982 ;; Computes (f x) = (f- x) union Union{(f y) | y in (edges x)} ;; We use a hash-table to represent the result function 'a -> 'b set, so ;; the values of type 'a must be comparable with eq?. (define (digraph nodes edges f- union fail) (define results (make-hasheq)) (define (f x) (hash-ref results x fail)) ;; Maps elements of 'a to integers. (define N (make-hasheq)) (define (get-N x) (hash-ref N x zero-thunk)) (define (set-N x d) (hash-set! N x d)) (define stack null) (define (push x) (set! stack (cons x stack))) (define (pop) (begin0 (car stack) (set! stack (cdr stack)))) (define (depth) (length stack)) ;; traverse: 'a -> (define (traverse x) (push x) (define d (depth)) (set-N x d) (hash-set! results x (f- x)) (for ([y (in-list (edges x))]) (when (= 0 (get-N y)) (traverse y)) (hash-set! results x (union (f x) (f y))) (set-N x (min (get-N x) (get-N y)))) (when (= d (get-N x)) (let loop ([p (pop)]) (set-N p +inf.0) (hash-set! results p (f x)) (when (not (eq? x p)) (loop (pop)))))) ;; Will map elements of 'a to 'b sets (for ([x (in-list nodes)] #:when (zero? (get-N x))) (traverse x)) f)