;; -*- Mode: Irken -*-

(include "lib/basis.scm")
(include "lib/set2.scm")
(include "lib/alist2.scm")

(define (transpose g)
  (let ((gt (alist-maker)))
    (g::iterate
     (lambda (k _)
       (gt::add k (set-maker '()))))
    (g::iterate
     (lambda (k vl)
       (for-each
	(lambda (v)
	  (match (gt::get v) with
	    (maybe:no) -> (gt::add v (set-maker (LIST k)))
	    (maybe:yes s) -> (s::add k)))
	(vl::get))))
    gt))

(define (print-graph g)
  (print-string "graph = {\n")
  (g::iterate
   (lambda (k v)
     (print-string "  ")
     (print k)
     (print-string " ")
     (printn (v::get))))
  (print-string "}\n"))

(define (strongly g)
  (let ((s '())
	(visited (set-maker '())))
    (define (visit0 u)
      (visited::add u)
      (match (g::get u) with
	(maybe:no)     -> #u
	(maybe:yes vl) -> (vl::iterate
			   (lambda (v)
			     (if (not (visited::in v))
				 (visit0 v)))))
      (PUSH s u))
    (g::iterate
     (lambda (u v)
       (if (not (visited::in u))
	   (visit0 u))))
    (let ((gt (transpose g))
	  (visited (set-maker '()))
	  (r0 '())
	  (r1 (set-maker '())))
      (define (visit1 u)
	(visited::add u)
	(match (gt::get u) with
	  (maybe:no) -> #u
	  (maybe:yes vl) -> (vl::iterate
			     (lambda (v)
			       (if (not (visited::in v))
				   (visit1 v)))))
	(r1::add u))
      (while
       (not (null? s))
       (let ((u (pop s)))
	 (if (not (visited::in u))
	     (begin
	       (set! r1 (set-maker '()))
	       (visit1 u)
	       (PUSH r0 (r1::get))))))
      r0)))

(define test-g
  '((foo baz)
    (baz bar)
    (bar foo)
    (biff barf)
    (barf snoo snee)
    (snoo biff)
    (snee)
    (top foo biff)))

(define (make-sample)
  (let ((g (alist-maker)))
    (for-each
     (lambda (l)
       (g::add (car l) (set-maker (cdr l))))
     test-g)
    g))

(let ((g (make-sample)))
  (print-graph g)
  (printn (strongly g)))