ghc/interpreter/scc.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Strongly connected components algorithm for static.c.
   4  *
   5  * Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
   6  * Haskell Group 1994-99, and is distributed as Open Source software
   7  * under the Artistic License; see the file "Artistic" that is included
   8  * in the distribution for details.
   9  *
  10  * $RCSfile: scc.c,v $
  11  * $Revision: 1.4 $
  12  * $Date: 1999/04/27 10:07:01 $
  13  * ------------------------------------------------------------------------*/
  14
  15 #ifndef SCC_C
  16 #define SCC_C
  17 #define visited(d) (isInt(DEPENDS(d)))          /* binding already visited?*/
  18
  19 static Cell daSccs = NIL;
  20 static Int  daCount;
  21
  22 static Int local sccMin Args((Int,Int));
  23
  24 static Int local sccMin(x,y)            /* calculate minimum of x,y        */
  25 Int x, y; {                             /* (unless y is zero)              */
  26     return (x<=y || y==0) ? x : y;
  27 }
  28 #endif
  29
  30 /* --------------------------------------------------------------------------
  31  * A couple of parts of this program require an algorithm for sorting a list
  32  * of values (with some added dependency information) into a list of strongly
  33  * connected components in which each value appears before its dependents.
  34  *
  35  * The algorithm used here is based on those described in:
  36  * 1) Robert Tarjan, Depth-first search and Linear Graph Algorithms,
  37  *    SIAM J COMPUT, vol 1, no 2, June 1972, pp.146-160.
  38  * 2) Aho, Hopcroft and Ullman, Design and Analysis of Algorithms,
  39  *    Addison Wesley, 1972.  pp.189-195.
  40  * The version used here probably owes most to the latter presentation but
  41  * has been modified to simplify the algorithm and improve the use of space.
  42  *
  43  * This would probably have been a good application for C++ templates ...
  44  * ------------------------------------------------------------------------*/
  45
  46 static Int local LOWLINK Args((Cell));  /* local function                  */
  47 static Int local LOWLINK(v)             /* calculate `lowlink' of v        */
  48 Cell v; {
  49     Int  low = daCount;
  50     Int  dfn = daCount;                 /* depth first search no. of v     */
  51     List ws  = DEPENDS(v);              /* adjacency list for v            */
  52
  53     SETDEPENDS(v,mkInt(daCount++));     /* push v onto stack               */
  54     push(v);
  55
  56     while (nonNull(ws)) {               /* scan adjacency list for v       */
  57         Cell w = hd(ws);
  58         ws     = tl(ws);
  59         low    = sccMin(low, (visited(w) ? intOf(DEPENDS(w)) : LOWLINK(w)));
  60     }
  61
  62     if (low == dfn) {                   /* start a new scc?                */
  63         List temp=NIL;
  64         do {                            /* take elements from stack        */
  65             SETDEPENDS(top(),mkInt(0));
  66             temp = cons(top(),temp);
  67         } while (pop()!=v);
  68         daSccs = cons(temp,daSccs);     /* make new strongly connected comp*/
  69     }
  70
  71     return low;
  72 }
  73
  74 #ifdef SCC
  75 static List local SCC(bs)               /* sort list with added dependency */
  76 List bs; {                              /* info into SCCs                  */
  77     List tmp = NIL;
  78     clearStack();
  79     daSccs = NIL;                       /* clear current list of SCCs      */
  80
  81     for (daCount=1; nonNull(bs); bs=tl(bs))      /* visit each binding     */
  82         if (!visited(hd(bs)))
  83             LOWLINK(hd(bs));
  84     tmp = rev(daSccs);
  85     daSccs = NIL;
  86     return tmp;                         /* reverse to obtain correct order */
  87 }
  88 #endif
  89
  90 #ifdef SCC2                             /* Two argument version            */
  91 static List local SCC2(bs,cs)           /* sort lists with added dependency*/
  92 List bs, cs; {                          /* info into SCCs                  */
  93     List tmp = NIL;
  94     clearStack();
  95     daSccs = NIL;                       /* clear current list of SCCs      */
  96
  97     for (daCount=1; nonNull(bs); bs=tl(bs))      /* visit each binding     */
  98         if (!visited(hd(bs)))
  99             LOWLINK(hd(bs));
 100     for (; nonNull(cs); cs=tl(cs))
 101         if (!visited(hd(cs)))
 102             LOWLINK(hd(cs));
 103     tmp = rev(daSccs);
 104     daSccs = NIL;
 105     return tmp;                         /* reverse to obtain correct order */
 106 }
 107 #endif
 108
 109 /*-------------------------------------------------------------------------*/