{- |
    Module      :  $Header$
    Description :  Computation of strongly connected components
    Copyright   :  (c) 2000, 2002 - 2003 Wolfgang Lux
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   At various places in the compiler we had to partition a list of
   declarations into strongly connected components. The function
   'scc' computes this relation in two steps. First, the list is
   topologically sorted downwards using the 'defs' relation.
   Then the resulting list is sorted upwards using the 'uses' relation
   and partitioned into the connected components. Both relations
   are computed within this module using the bound and free names of each
   declaration.

   In order to avoid useless recomputations, the code in the module first
   decorates the declarations with their bound and free names and a
   unique number. The latter is only used to provide a trivial ordering
   so that the declarations can be used as set elements.
-}

module Base.SCC (scc) where

import qualified Data.Set as Set (empty, member, insert)

data Node a b = Node { key :: Int, bvs :: [b], fvs :: [b], node :: a }

instance Eq (Node a b) where
  n1 == n2 = key n1 == key n2

instance Ord (Node b a) where
  n1 `compare` n2 = key n1 `compare` key n2

-- |Computation of strongly connected components
scc :: Eq b => (a -> [b]) -- ^entities defined by node
            -> (a -> [b]) -- ^entities used by node
            -> [a]        -- ^list of nodes
            -> [[a]]      -- ^strongly connected components
scc bvs' fvs' = map (map node) . tsort' . tsort . zipWith wrap [0 ..]
  where wrap i n = Node i (bvs' n) (fvs' n) n

tsort :: Eq b => [Node a b] -> [Node a b]
tsort xs = snd (dfs xs Set.empty []) where
  dfs [] marks stack = (marks,stack)
  dfs (x : xs') marks stack
    | x `Set.member` marks = dfs xs' marks stack
    | otherwise = dfs xs' marks' (x : stack')
    where (marks',stack') = dfs (defs x) (x `Set.insert` marks) stack
          defs x1 = filter (any (`elem` fvs x1) . bvs) xs

tsort' :: Eq b => [Node a b] -> [[Node a b]]
tsort' xs = snd (dfs xs Set.empty []) where
  dfs [] marks stack = (marks,stack)
  dfs (x : xs') marks stack
    | x `Set.member` marks = dfs xs' marks stack
    | otherwise = dfs xs' marks' ((x : concat stack') : stack)
    where (marks',stack') = dfs (uses x) (x `Set.insert` marks) []
          uses x1 = filter (any (`elem` bvs x1) . fvs) xs