ghc/interpreter/scc.c

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * Strongly connected components algorithm for static.c.
   4  *
   5  * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
   6  * All rights reserved. See NOTICE for details and conditions of use etc...
   7  * Hugs version 1.4, December 1997
   8  *
   9  * $RCSfile: scc.c,v $
  10  * $Revision: 1.2 $
  11  * $Date: 1998/12/02 13:22:34 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #ifndef SCC_C
  15 #define SCC_C
  16 #define visited(d) (isInt(DEPENDS(d)))  /* binding already visited ?       */
  17
  18 static Cell daSccs = NIL;
  19 static Int  daCount;
  20
  21 static Int local sccMin Args((Int,Int));
  22
  23 static Int local sccMin(x,y)           /* calculate minimum of x,y (unless */
  24 Int x,y; {                             /* 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 Args((Cell));  /* local function                  */
  46 static Int local LOWLINK(v)             /* calculate `lowlink' of v        */
  47 Cell v; {
  48     Int  low = daCount;
  49     Int  dfn = daCount;                 /* depth first search no. of v     */
  50     List ws  = DEPENDS(v);              /* adjacency list for v            */
  51
  52     SETDEPENDS(v,mkInt(daCount++));     /* push v onto stack               */
  53     push(v);
  54
  55     while (nonNull(ws)) {               /* scan adjacency list for v       */
  56         Cell w = hd(ws);
  57         ws     = tl(ws);
  58         low    = sccMin(low, (visited(w) ? intOf(DEPENDS(w)) : LOWLINK(w)));
  59     }
  60
  61     if (low == dfn) {                   /* start a new scc?                */
  62         List temp=NIL;
  63         do {                            /* take elements from stack        */
  64             SETDEPENDS(top(),mkInt(0));
  65             temp = cons(top(),temp);
  66         } while (pop()!=v);
  67         daSccs = cons(temp,daSccs);     /* make new strongly connected comp*/
  68     }
  69
  70     return low;
  71 }
  72
  73 #ifdef SCC
  74 static List local SCC(bs)               /* sort list with added dependency */
  75 List bs; {                              /* info into SCCs                  */
  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
  83     return rev(daSccs);                 /* reverse to obtain correct order */
  84 }
  85 #endif
  86
  87 #ifdef SCC2                             /* Two argument version            */
  88 static List local SCC2(bs,cs)           /* sort lists with added dependency*/
  89 List bs, cs; {                          /* info into SCCs                  */
  90     clearStack();
  91     daSccs = NIL;                       /* clear current list of SCCs      */
  92
  93     for (daCount=1; nonNull(bs); bs=tl(bs))      /* visit each binding     */
  94         if (!visited(hd(bs)))
  95             LOWLINK(hd(bs));
  96     for (; nonNull(cs); cs=tl(cs))
  97         if (!visited(hd(cs)))
  98             LOWLINK(hd(cs));
  99
 100     return rev(daSccs);                 /* reverse to obtain correct order */
 101 }
 102 #endif
 103
 104 /*-------------------------------------------------------------------------*/