/*
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.
*/

/* 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;

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

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

      static void Eachmember(void Yield(Node)!)
	 {
	 Integer I;
	/* yield each member of current SCC */
	 for (I = Sp; I >= T; I--)
	    Yield(Stack[I]);
	 } /*Eachmember*/
      static void Body(Node W)
	 {
	 Search(W);
	 if (W == V)
	    Vhaspathtoitself = True;
	 if (N[W] < N[V])
	    N[V] = N[W];
	 } /*Body*/
      if (N[V] == 0) {	     /* stack the node */
	 Vhaspathtoitself = False;
	 Sp++;
	 Stack[Sp] = V; N[V] = Sp;
	 R(V,Body);
	 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*/
   static void Init(Node Q)
      {
      N[Q] = 0;
      } /*Init*/
   Eachnode(Init);
   Sp = 0;
   Eachnode(Search);
   } /*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. */
   static void Eachstate(void Yield(Node)!)
      {
      Node N;
      for (N = Firstnode; N <= Lastnode; N++)
	 Yield(N);
      } /*Eachstate*/
   static void Successors(Node N, void Yield(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(void Yield(Node)!)!)
      {
      Nodeset Inscclessroot;
      static void Successors2(Node N, void Yield(Node)!)
	 {
	 static void Body(Node N2)
	    {
	    if (Inscclessroot[N2])
	       Yield(N2);
	    } /*Body*/
	 Successors(N,Body);
	 } /*Successors2*/
      static void Scclessroot(void Yield(Node)!)
	 {
	 static void Body(Node N) 
	    {
	    if (Inscclessroot[N])
	       Yield(N);
	    } /*Body*/
	 Scc(Body);
	 } /*Scclessroot*/
      /* Break the SCC at the root, then recursively do leftover SCCs. */
      /* We run EachSCC only on nodes & edges in SCC, less the root.	*/
      static void Body(Node N)
	 {
	 if (N != Root)
	    Inscclessroot[N] = True;
	 } /*Body*/
      static void Receivescc(Node Root2, void Scc2(void (Node)!)!)
	 {
	 Subsccs++;
	 P(Root2,Scc2);
	 } /*Receivescc*/
      static void P(Node N)
	 {
	 Inscclessroot[N] = False;
	 } /*P*/
      Eachstate(P);
      Scc(Body);
      Marked[Root] = True;
      printf("Marking node %d\n",Root);
      Eachscc(Scclessroot,Successors2,True,Receivescc);
      } /*P*/
   static void Receivescc(Node Root, void Scc(void (Node)!)!)
      {
      static void Count(Node N)
	 {
	 Cnt++;
	 } /*Count*/
      Subsccs = 0;
      P(Root,Scc);
      Cnt = 0; Scc(Count);
      printf("SCC of %d nodes detected, having %d contained SCCs.\n",
				 Cnt, Subsccs);
      } /*Receivescc*/
   static void Q(Node N)
      {
      Marked[N] = False;
      } /*Q*/
   Eachstate(Q);
   Eachscc(Eachstate,Successors,True,Receivescc);
   } /*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.

*/
