/*
This program analyzes a directed graph and "breaks" all loops in
the graph.  The program marks a set of nodes in the graph such that
if the ingoing edges to the nodes are deleted, the graph is acyclic.
The technique is as follows:
	For each strongly-connected component (SCC) of the graph,
	mark the root (where the SCC was first entered).
	This reduces the number of loop paths in the SCC,
	breaking the SCC into a set of smaller SCCs.
	Recursively find the SCCs of this reduced SCC, breaking
	loops in the same way.	When finished, all loops in the original
	SCC will be broken.  When each SCC is thus processed,
	the graph will contain no loops.
The algorithm was used as part of a scheme
for generating ultra-fast LR parsers.
It also is a good test for Pascal compilers.

The SCC algorithm was derived from one by Eve and Kurki-Suonio.
See paper by DeRemer and Pennello in Oct. 1982 TOPLAS.

Author:  Tom Pennello of MetaWare Incorporated.

This version is in MetaWare High C.  The ()! syntax denotes a full
function value -- the equivalent of the Pascal procedural parameter --
that consists of the entry point AND the environment pointer.

I challenge any C programmer that feels up to it to re-program this in standard
C.

This version of the program is written using High C iterators.
There is another version supplied that uses only nested procedures.
*/

/* For this sample application, the node size is small. */
/* The graph is represented in code.  See below 	*/
#define Nullnode 0
#define Maxnodes 100
#define Maxnodesp1 101
#define Firstnode 1
#define Lastnode 8

#include <stdio.h>

typedef int Integer;
typedef enum{False,True} Boolean;

typedef Integer /*Subrange!!:Nullnode..Maxnodesp1*/ Node;
/* For translation into C we need to convert sets to arrays of booleans. */
typedef Boolean Nodeset[Maxnodesp1+1];
Nodeset Marked;

void Eachscc(/* of relation R */
      /* Pass in the relation on the nodes; yield each SCC found. */
		    void Eachnode() -> (Node)!,
		    void R(Node) -> (Node)!,
		    Boolean Yieldtrivialsccs)  /* Yield SCCs of one node?	     */
    -> (Node Root, void Each() -> (Node)!)! {
#  define Infinity Maxnodesp1
   Integer /*Subrange!!:0..Maxnodesp1*/ N[Maxnodesp1+1];
   Node Stack[Maxnodes+1];
   Integer /*Subrange!!:0..Maxnodes*/ Sp;

   void Search(Node V) {
      Boolean Vhaspathtoitself; Integer I,T;

      void Eachmember() -> (Node) {
	 Integer I;
	/* yield each member of current SCC */
	 for (I = Sp; I >= T; I--)
	    yield(Stack[I]);
	 } /*Eachmember*/
      if (N[V] == 0) {	     /* stack the node */
	 Vhaspathtoitself = False;
	 Sp++;
	 Stack[Sp] = V; N[V] = Sp;
	 for W <- R(V) do {
	    Search(W);
	    if (W == V)
	       Vhaspathtoitself = True;
	    if (N[W] < N[V])
	       N[V] = N[W];
	    }
	 if (V == Stack[N[V]]) {/* V is root of an SCC */
	    T = N[V];
	    for (I = Sp; I >= T; I--)
	       N[Stack[I]] = Infinity;
	    if (Sp != T || /* single node; V R+ V ? */
		Vhaspathtoitself && Yieldtrivialsccs)
	       yield(V,Eachmember);
	    Sp = T-1;
	    }
	 }
      } /*Search*/
   for Q <- Eachnode() do N[Q] = 0;
   Sp = 0;
   for V <- Eachnode() do Search(V);
   } /*Eachscc*/

/*
The sample graph to be analyzed is as follows:

	1
	V
	2 <--- 3
	|      A
	V      |
	+->4-->+
	A  V   A
	|  5   |
	|  V   |
	+<-6-->7-->+-->8-->+
	       A   V   A   V
	       +<--+   +<--+

Thus, there are eight nodes.
Marking nodes 2, 4, 7, and 8 breaks all loops.
*/

static void Analyzegraph()
   {
   Integer Subsccs;
   Integer Cnt;

   /* The graph is represented by these two procedures. */
   void Eachstate() -> (Node) {
      Node N;
      for (N = Firstnode; N <= Lastnode; N++)
	 yield(N);
      } /*Eachstate*/
   void Successors(Node N) -> (Node) {
      switch (N) {
	 case 1:
	    yield(2);
	    break;
	 case 2:
	    yield(4);
	    break;
	 case 3:
	    yield(2);
	    break;
	 case 4:
	    yield(5);
	    break;
	 case 5:
	    yield(6);
	    break;
	 case 6: {
	    yield(7); yield(4);
	    }
	    break;
	 case 7: {
	    yield(7); yield(3);
	    }
	    break;
	 case 8:
	    yield(8);
	    break;
	 }
      } /*Successors*/
   static void P(Node Root, void Scc() -> (Node)!)
      {
      Nodeset Inscclessroot;
      void Successors2(Node N) -> (Node) {
	 for N2 <- Successors(N) do if (Inscclessroot[N2]) yield(N2);
	 } /*Successors2*/
      void Scclessroot() -> (Node) {
	 for N <- Scc() do {
	    if (Inscclessroot[N]) yield(N);
	    }   	 	  
	 } /*Scclessroot*/
      /* Break the SCC at the root, then recursively do leftover SCCs. */
      /* We run EachSCC only on nodes & edges in SCC, less the root.	*/
      for N <- Eachstate() do Inscclessroot[N] = False;
      for N <- Scc() do {
	 if (N != Root)
	    Inscclessroot[N] = True;
	 } /*Body*/
      Marked[Root] = True;
      printf("Marking node %d\n",Root);
      for Root2, Scc2 <- Eachscc(Scclessroot,Successors2,True) do {
	 Subsccs++;
	 P(Root2,Scc2);
	 } 
      } /*P*/
   for N <- Eachstate() do Marked[N] = False;
   for Root,Scc <- Eachscc(Eachstate,Successors,True) do {
      Subsccs = 0;
      P(Root,Scc);
      Cnt = 0; 
      for N <- Scc() do Cnt++;
      printf("SCC of %d nodes detected, having %d contained SCCs.\n",
				 Cnt, Subsccs);
      } 
   } /*Analyzegraph*/

void main() {
   Analyzegraph();
   }
/*
The correct output reads:

Marking node 2
Marking node 7
Marking node 6
SCC of 6 nodes detected, having 2 contained SCCs.
Marking node 8
SCC of 1 nodes detected, having 0 contained SCCs.

*/
