ghc/compiler/tests/typecheck/should_fail/Digraph.hs

   1 --!!! trying to have a polymorphic type sig where inappropriate
   2 --
   3 module Digraph where
   4
   5 data MaybeErr val err = Succeeded val | Failed err deriving ()
   6
   7 type Edge  vertex = (vertex, vertex)
   8 type Cycle vertex = [vertex]
   9
  10 stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]]
  11
  12 stronglyConnComp es vs
  13   = snd (span_tree (new_range reversed_edges)
  14                    ([],[])
  15                    ( snd (dfs (new_range es) ([],[]) vs) )
  16         )
  17  where
  18    -- *********** the offending type signature **************
  19    reversed_edges :: Eq v => [Edge v]
  20    reversed_edges = map swap es
  21
  22    -- WRONGOLA: swap :: Eq v => Edge v -> Edge v
  23    swap (x,y) = (y, x)
  24
  25    -- WRONGOLA?: new_range :: Eq v => [Edge v] -> v -> [v]
  26
  27    new_range    []       w = []
  28    new_range ((x,y):xys) w
  29        = if x==w
  30          then (y : (new_range xys w))
  31          else (new_range xys w)
  32
  33    {- WRONGOLA?:
  34    span_tree :: Eq v => (v -> [v])
  35                      -> ([v], [[v]])
  36                      -> [v]
  37                      -> ([v], [[v]])
  38     -}
  39
  40    span_tree r (vs,ns) []   = (vs,ns)
  41    span_tree r (vs,ns) (x:xs)
  42        | x `elem` vs = span_tree r (vs,ns) xs
  43        | otherwise = span_tree r (vs',(x:ns'):ns) xs
  44          where
  45            (vs',ns') = dfs r (x:vs,[]) (r x)
  46
  47 dfs :: Eq v => (v -> [v])
  48             -> ([v], [v])
  49             -> [v]
  50             -> ([v], [v])
  51
  52 dfs r (vs,ns)   []   = (vs,ns)
  53 dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs
  54                      | otherwise = dfs r (vs',(x:ns')++ns) xs
  55                                    where
  56                                      (vs',ns') = dfs r (x:vs,[]) (r x)