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