ghc/interpreter/scc.c

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