    -- |
    -- Module      :  Cryptol.TypeCheck.Depends
    -- Copyright   :  (c) 2013-2016 Galois, Inc.
    -- License     :  BSD3
    -- Maintainer  :  cryptol@galois.com
    -- Stability   :  provisional
    -- Portability :  portable

    {-# LANGUAGE Safe #-}
    {-# LANGUAGE FlexibleInstances #-}
    module Cryptol.TypeCheck.Depends where

    import           Cryptol.ModuleSystem.Name (Name)
    import qualified Cryptol.Parser.AST as P
    import           Cryptol.Parser.Position(Range, Located(..), thing)
    import           Cryptol.Parser.Names (namesB, tnamesT, tnamesC,
                                          boundNamesSet, boundNames)
    import           Cryptol.TypeCheck.Monad( InferM, recordError, getTVars )
    import           Cryptol.TypeCheck.Error(Error(..))
    import           Cryptol.Utils.Panic(panic)

    import           Data.List(sortBy, groupBy)
    import           Data.Function(on)
    import           Data.Maybe(mapMaybe)
    import           Data.Graph.SCC(stronglyConnComp)
    import           Data.Graph (SCC(..))
    import           Data.Map (Map)
    import qualified Data.Map as Map
    import qualified Data.Set as Set

    data TyDecl =
        TS (P.TySyn Name) (Maybe String)          -- ^ Type synonym
      | NT (P.Newtype Name) (Maybe String)        -- ^ Newtype
      | AT (P.ParameterType Name) (Maybe String)  -- ^ Parameter type
      | PS (P.PropSyn Name) (Maybe String)        -- ^ Property synonym
      | PT (P.PrimType Name) (Maybe String)       -- ^ A primitive/abstract typee
        deriving Int -> TyDecl -> ShowS
    [TyDecl] -> ShowS
    TyDecl -> String
    (Int -> TyDecl -> ShowS)
    -> (TyDecl -> String) -> ([TyDecl] -> ShowS) -> Show TyDecl
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [TyDecl] -> ShowS
    $cshowList :: [TyDecl] -> ShowS
    show :: TyDecl -> String
    $cshow :: TyDecl -> String
    showsPrec :: Int -> TyDecl -> ShowS
    $cshowsPrec :: Int -> TyDecl -> ShowS
    Show

    setDocString :: Maybe String -> TyDecl -> TyDecl
    setDocString :: Maybe String -> TyDecl -> TyDecl
    setDocString x :: Maybe String
    x d :: TyDecl
    d =
      case TyDecl
    d of
        TS a :: TySyn Name
    a _ -> TySyn Name -> Maybe String -> TyDecl
    TS TySyn Name
    a Maybe String
    x
        PS a :: PropSyn Name
    a _ -> PropSyn Name -> Maybe String -> TyDecl
    PS PropSyn Name
    a Maybe String
    x
        NT a :: Newtype Name
    a _ -> Newtype Name -> Maybe String -> TyDecl
    NT Newtype Name
    a Maybe String
    x
        AT a :: ParameterType Name
    a _ -> ParameterType Name -> Maybe String -> TyDecl
    AT ParameterType Name
    a Maybe String
    x
        PT a :: PrimType Name
    a _ -> PrimType Name -> Maybe String -> TyDecl
    PT PrimType Name
    a Maybe String
    x

    -- | Check for duplicate and recursive type synonyms.
    -- Returns the type-synonyms in dependency order.
    orderTyDecls :: [TyDecl] -> InferM [TyDecl]
    orderTyDecls :: [TyDecl] -> InferM [TyDecl]
    orderTyDecls ts :: [TyDecl]
    ts =
      do Set Name
    vs <- InferM (Set Name)
    getTVars
         Map Name (Located (TyDecl, [Name]))
    ds <- [(Name, Located (TyDecl, [Name]))]
    -> InferM (Map Name (Located (TyDecl, [Name])))
    forall a. [(Name, Located a)] -> InferM (Map Name (Located a))
    combine ([(Name, Located (TyDecl, [Name]))]
     -> InferM (Map Name (Located (TyDecl, [Name]))))
    -> [(Name, Located (TyDecl, [Name]))]
    -> InferM (Map Name (Located (TyDecl, [Name])))
    forall a b. (a -> b) -> a -> b
    $ (TyDecl -> (Name, Located (TyDecl, [Name])))
    -> [TyDecl] -> [(Name, Located (TyDecl, [Name]))]
    forall a b. (a -> b) -> [a] -> [b]
    map (Set Name -> TyDecl -> (Name, Located (TyDecl, [Name]))
    toMap Set Name
    vs) [TyDecl]
    ts
         let ordered :: [SCC TyDecl]
    ordered = [(TyDecl, [Name], [Name])] -> [SCC TyDecl]
    forall a. [(a, [Name], [Name])] -> [SCC a]
    mkScc [ (TyDecl
    t,[Name
    x],[Name]
    deps)
                                  | (x :: Name
    x,(t :: TyDecl
    t,deps :: [Name]
    deps)) <- Map Name (TyDecl, [Name]) -> [(Name, (TyDecl, [Name]))]
    forall k a. Map k a -> [(k, a)]
    Map.toList ((Located (TyDecl, [Name]) -> (TyDecl, [Name]))
    -> Map Name (Located (TyDecl, [Name])) -> Map Name (TyDecl, [Name])
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map Located (TyDecl, [Name]) -> (TyDecl, [Name])
    forall a. Located a -> a
    thing Map Name (Located (TyDecl, [Name]))
    ds) ]
         [[TyDecl]] -> [TyDecl]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[TyDecl]] -> [TyDecl]) -> InferM [[TyDecl]] -> InferM [TyDecl]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (SCC TyDecl -> InferM [TyDecl])
    -> [SCC TyDecl] -> InferM [[TyDecl]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM SCC TyDecl -> InferM [TyDecl]
    check [SCC TyDecl]
    ordered

      where
      toMap :: Set Name -> TyDecl -> (Name, Located (TyDecl, [Name]))
    toMap vs :: Set Name
    vs ty :: TyDecl
    ty@(PT p :: PrimType Name
    p _) =
        let x :: Located Name
    x       = PrimType Name -> Located Name
    forall name. PrimType name -> Located name
    P.primTName PrimType Name
    p
            (as :: [TParam Name]
    as,cs :: [Prop Name]
    cs) = PrimType Name -> ([TParam Name], [Prop Name])
    forall name. PrimType name -> ([TParam name], [Prop name])
    P.primTCts PrimType Name
    p
        in  ( Located Name -> Name
    forall a. Located a -> a
    thing Located Name
    x
            , Located Name
    x { thing :: (TyDecl, [Name])
    thing = (TyDecl
    ty, Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $
                               Set Name -> Set Name -> Set Name
    forall name. Ord name => Set name -> Set name -> Set name
    boundNamesSet Set Name
    vs (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               [Name] -> Set Name -> Set Name
    forall name. Ord name => [name] -> Set name -> Set name
    boundNames ((TParam Name -> Name) -> [TParam Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TParam Name -> Name
    forall n. TParam n -> n
    P.tpName [TParam Name]
    as) (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               [Set Name] -> Set Name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions ([Set Name] -> Set Name) -> [Set Name] -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               (Prop Name -> Set Name) -> [Prop Name] -> [Set Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Prop Name -> Set Name
    forall name. Ord name => Prop name -> Set name
    tnamesC [Prop Name]
    cs
                          )
                 }
            )

      toMap _ ty :: TyDecl
    ty@(AT a :: ParameterType Name
    a _) =
        let x :: Located Name
    x = ParameterType Name -> Located Name
    forall name. ParameterType name -> Located name
    P.ptName ParameterType Name
    a
        in ( Located Name -> Name
    forall a. Located a -> a
    thing Located Name
    x, Located Name
    x { thing :: (TyDecl, [Name])
    thing = (TyDecl
    ty, []) } )

      toMap vs :: Set Name
    vs ty :: TyDecl
    ty@(NT (P.Newtype x :: Located Name
    x as :: [TParam Name]
    as fs :: [Named (Type Name)]
    fs) _) =
        ( Located Name -> Name
    forall a. Located a -> a
    thing Located Name
    x
        , Located Name
    x { thing :: (TyDecl, [Name])
    thing = (TyDecl
    ty, Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $
                           Set Name -> Set Name -> Set Name
    forall name. Ord name => Set name -> Set name -> Set name
    boundNamesSet Set Name
    vs (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                           [Name] -> Set Name -> Set Name
    forall name. Ord name => [name] -> Set name -> Set name
    boundNames ((TParam Name -> Name) -> [TParam Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TParam Name -> Name
    forall n. TParam n -> n
    P.tpName [TParam Name]
    as) (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                           [Set Name] -> Set Name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions ([Set Name] -> Set Name) -> [Set Name] -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                           (Named (Type Name) -> Set Name)
    -> [Named (Type Name)] -> [Set Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Type Name -> Set Name
    forall name. Ord name => Type name -> Set name
    tnamesT (Type Name -> Set Name)
    -> (Named (Type Name) -> Type Name)
    -> Named (Type Name)
    -> Set Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Named (Type Name) -> Type Name
    forall a. Named a -> a
    P.value) [Named (Type Name)]
    fs
                      )
            }
        )

      toMap vs :: Set Name
    vs ty :: TyDecl
    ty@(TS (P.TySyn x :: Located Name
    x _ as :: [TParam Name]
    as t :: Type Name
    t) _) =
            (Located Name -> Name
    forall a. Located a -> a
    thing Located Name
    x
            , Located Name
    x { thing :: (TyDecl, [Name])
    thing = (TyDecl
    ty, Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $
                               Set Name -> Set Name -> Set Name
    forall name. Ord name => Set name -> Set name -> Set name
    boundNamesSet Set Name
    vs (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               [Name] -> Set Name -> Set Name
    forall name. Ord name => [name] -> Set name -> Set name
    boundNames ((TParam Name -> Name) -> [TParam Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TParam Name -> Name
    forall n. TParam n -> n
    P.tpName [TParam Name]
    as) (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               Type Name -> Set Name
    forall name. Ord name => Type name -> Set name
    tnamesT Type Name
    t
                          )
                 }
            )

      toMap vs :: Set Name
    vs ty :: TyDecl
    ty@(PS (P.PropSyn x :: Located Name
    x _ as :: [TParam Name]
    as ps :: [Prop Name]
    ps) _) =
            (Located Name -> Name
    forall a. Located a -> a
    thing Located Name
    x
            , Located Name
    x { thing :: (TyDecl, [Name])
    thing = (TyDecl
    ty, Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList (Set Name -> [Name]) -> Set Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $
                               Set Name -> Set Name -> Set Name
    forall name. Ord name => Set name -> Set name -> Set name
    boundNamesSet Set Name
    vs (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               [Name] -> Set Name -> Set Name
    forall name. Ord name => [name] -> Set name -> Set name
    boundNames ((TParam Name -> Name) -> [TParam Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TParam Name -> Name
    forall n. TParam n -> n
    P.tpName [TParam Name]
    as) (Set Name -> Set Name) -> Set Name -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               [Set Name] -> Set Name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions ([Set Name] -> Set Name) -> [Set Name] -> Set Name
    forall a b. (a -> b) -> a -> b
    $
                               (Prop Name -> Set Name) -> [Prop Name] -> [Set Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Prop Name -> Set Name
    forall name. Ord name => Prop name -> Set name
    tnamesC [Prop Name]
    ps
                          )
                 }
            )
      getN :: TyDecl -> Name
    getN (TS x :: TySyn Name
    x _) = Located Name -> Name
    forall a. Located a -> a
    thing (TySyn Name -> Located Name
    forall name. TySyn name -> Located name
    P.tsName TySyn Name
    x)
      getN (PS x :: PropSyn Name
    x _) = Located Name -> Name
    forall a. Located a -> a
    thing (PropSyn Name -> Located Name
    forall name. PropSyn name -> Located name
    P.psName PropSyn Name
    x)
      getN (NT x :: Newtype Name
    x _) = Located Name -> Name
    forall a. Located a -> a
    thing (Newtype Name -> Located Name
    forall name. Newtype name -> Located name
    P.nName Newtype Name
    x)
      getN (AT x :: ParameterType Name
    x _) = Located Name -> Name
    forall a. Located a -> a
    thing (ParameterType Name -> Located Name
    forall name. ParameterType name -> Located name
    P.ptName ParameterType Name
    x)
      getN (PT x :: PrimType Name
    x _) = Located Name -> Name
    forall a. Located a -> a
    thing (PrimType Name -> Located Name
    forall name. PrimType name -> Located name
    P.primTName PrimType Name
    x)

      check :: SCC TyDecl -> InferM [TyDecl]
    check (AcyclicSCC x :: TyDecl
    x) = [TyDecl] -> InferM [TyDecl]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [TyDecl
    x]

      -- We don't support any recursion, for now.
      -- We could support recursion between newtypes, or newtypes and tysysn.
      check (CyclicSCC xs :: [TyDecl]
    xs) =
        do Error -> InferM ()
    recordError ([Name] -> Error
    RecursiveTypeDecls ((TyDecl -> Name) -> [TyDecl] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyDecl -> Name
    getN [TyDecl]
    xs))
           [TyDecl] -> InferM [TyDecl]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] -- XXX: This is likely to cause fake errors for missing
                     -- type synonyms. We could avoid this by, for example, checking
                     -- for recursive synonym errors, when looking up tycons.

    -- | Associate type signatures with bindings and order bindings by dependency.
    orderBinds :: [P.Bind Name] -> [SCC (P.Bind Name)]
    orderBinds :: [Bind Name] -> [SCC (Bind Name)]
    orderBinds bs :: [Bind Name]
    bs = [(Bind Name, [Name], [Name])] -> [SCC (Bind Name)]
    forall a. [(a, [Name], [Name])] -> [SCC a]
    mkScc [ (Bind Name
    b, (Located Name -> Name) -> [Located Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Located Name -> Name
    forall a. Located a -> a
    thing [Located Name]
    defs, Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    uses)
                          | Bind Name
    b <- [Bind Name]
    bs
                          , let (defs :: [Located Name]
    defs,uses :: Set Name
    uses) = Bind Name -> ([Located Name], Set Name)
    forall name. Ord name => Bind name -> ([Located name], Set name)
    namesB Bind Name
    b
                          ]

    class FromDecl d where
      toBind             :: d -> Maybe (P.Bind Name)
      toParamFun         :: d -> Maybe (P.ParameterFun Name)
      toParamConstraints :: d -> [P.Located (P.Prop Name)]
      toTyDecl           :: d -> Maybe TyDecl
      isTopDecl          :: d -> Bool

    instance FromDecl (P.TopDecl Name) where
      toBind :: TopDecl Name -> Maybe (Bind Name)
    toBind (P.Decl x :: TopLevel (Decl Name)
    x)         = Decl Name -> Maybe (Bind Name)
    forall d. FromDecl d => d -> Maybe (Bind Name)
    toBind (TopLevel (Decl Name) -> Decl Name
    forall a. TopLevel a -> a
    P.tlValue TopLevel (Decl Name)
    x)
      toBind _                  = Maybe (Bind Name)
    forall a. Maybe a
    Nothing

      toParamFun :: TopDecl Name -> Maybe (ParameterFun Name)
    toParamFun (P.DParameterFun d :: ParameterFun Name
    d)  = ParameterFun Name -> Maybe (ParameterFun Name)
    forall a. a -> Maybe a
    Just ParameterFun Name
    d
      toParamFun _                    = Maybe (ParameterFun Name)
    forall a. Maybe a
    Nothing

      toParamConstraints :: TopDecl Name -> [Located (Prop Name)]
    toParamConstraints (P.DParameterConstraint xs :: [Located (Prop Name)]
    xs) = [Located (Prop Name)]
    xs
      toParamConstraints _                           = []

      toTyDecl :: TopDecl Name -> Maybe TyDecl
    toTyDecl (P.DPrimType p :: TopLevel (PrimType Name)
    p)      = TyDecl -> Maybe TyDecl
    forall a. a -> Maybe a
    Just (PrimType Name -> Maybe String -> TyDecl
    PT (TopLevel (PrimType Name) -> PrimType Name
    forall a. TopLevel a -> a
    P.tlValue TopLevel (PrimType Name)
    p) (Located String -> String
    forall a. Located a -> a
    thing (Located String -> String)
    -> Maybe (Located String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TopLevel (PrimType Name) -> Maybe (Located String)
    forall a. TopLevel a -> Maybe (Located String)
    P.tlDoc TopLevel (PrimType Name)
    p))
      toTyDecl (P.DParameterType d :: ParameterType Name
    d) = TyDecl -> Maybe TyDecl
    forall a. a -> Maybe a
    Just (ParameterType Name -> Maybe String -> TyDecl
    AT ParameterType Name
    d (ParameterType Name -> Maybe String
    forall name. ParameterType name -> Maybe String
    P.ptDoc ParameterType Name
    d))
      toTyDecl (P.TDNewtype d :: TopLevel (Newtype Name)
    d)      = TyDecl -> Maybe TyDecl
    forall a. a -> Maybe a
    Just (Newtype Name -> Maybe String -> TyDecl
    NT (TopLevel (Newtype Name) -> Newtype Name
    forall a. TopLevel a -> a
    P.tlValue TopLevel (Newtype Name)
    d) (Located String -> String
    forall a. Located a -> a
    thing (Located String -> String)
    -> Maybe (Located String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TopLevel (Newtype Name) -> Maybe (Located String)
    forall a. TopLevel a -> Maybe (Located String)
    P.tlDoc TopLevel (Newtype Name)
    d))
      toTyDecl (P.Decl x :: TopLevel (Decl Name)
    x)           = Maybe String -> TyDecl -> TyDecl
    setDocString (Located String -> String
    forall a. Located a -> a
    thing (Located String -> String)
    -> Maybe (Located String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TopLevel (Decl Name) -> Maybe (Located String)
    forall a. TopLevel a -> Maybe (Located String)
    P.tlDoc TopLevel (Decl Name)
    x)
                                      (TyDecl -> TyDecl) -> Maybe TyDecl -> Maybe TyDecl
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Decl Name -> Maybe TyDecl
    forall d. FromDecl d => d -> Maybe TyDecl
    toTyDecl (TopLevel (Decl Name) -> Decl Name
    forall a. TopLevel a -> a
    P.tlValue TopLevel (Decl Name)
    x)
      toTyDecl _                    = Maybe TyDecl
    forall a. Maybe a
    Nothing

      isTopDecl :: TopDecl Name -> Bool
    isTopDecl _               = Bool
    True

    instance FromDecl (P.Decl Name) where
      toBind :: Decl Name -> Maybe (Bind Name)
    toBind (P.DLocated d :: Decl Name
    d _) = Decl Name -> Maybe (Bind Name)
    forall d. FromDecl d => d -> Maybe (Bind Name)
    toBind Decl Name
    d
      toBind (P.DBind b :: Bind Name
    b)      = Bind Name -> Maybe (Bind Name)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bind Name
    b
      toBind _                = Maybe (Bind Name)
    forall a. Maybe a
    Nothing

      toParamFun :: Decl Name -> Maybe (ParameterFun Name)
    toParamFun _ = Maybe (ParameterFun Name)
    forall a. Maybe a
    Nothing
      toParamConstraints :: Decl Name -> [Located (Prop Name)]
    toParamConstraints _ = []

      toTyDecl :: Decl Name -> Maybe TyDecl
    toTyDecl (P.DLocated d :: Decl Name
    d _) = Decl Name -> Maybe TyDecl
    forall d. FromDecl d => d -> Maybe TyDecl
    toTyDecl Decl Name
    d
      toTyDecl (P.DType x :: TySyn Name
    x)      = TyDecl -> Maybe TyDecl
    forall a. a -> Maybe a
    Just (TySyn Name -> Maybe String -> TyDecl
    TS TySyn Name
    x Maybe String
    forall a. Maybe a
    Nothing)
      toTyDecl (P.DProp x :: PropSyn Name
    x)      = TyDecl -> Maybe TyDecl
    forall a. a -> Maybe a
    Just (PropSyn Name -> Maybe String -> TyDecl
    PS PropSyn Name
    x Maybe String
    forall a. Maybe a
    Nothing)
      toTyDecl _                = Maybe TyDecl
    forall a. Maybe a
    Nothing

      isTopDecl :: Decl Name -> Bool
    isTopDecl _               = Bool
    False

    {- | Given a list of declarations, annoted with (i) the names that they
    define, and (ii) the names that they use, we compute a list of strongly
    connected components of the declarations.  The SCCs are in dependency order. -}
    mkScc :: [(a,[Name],[Name])] -> [SCC a]
    mkScc :: [(a, [Name], [Name])] -> [SCC a]
    mkScc ents :: [(a, [Name], [Name])]
    ents = [(a, Integer, [Integer])] -> [SCC a]
    forall key node. Ord key => [(node, key, [key])] -> [SCC node]
    stronglyConnComp ([(a, Integer, [Integer])] -> [SCC a])
    -> [(a, Integer, [Integer])] -> [SCC a]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> (a, [Name], [Name]) -> (a, Integer, [Integer]))
    -> [Integer] -> [(a, [Name], [Name])] -> [(a, Integer, [Integer])]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Integer -> (a, [Name], [Name]) -> (a, Integer, [Integer])
    forall b a b. b -> (a, b, [Name]) -> (a, b, [Integer])
    mkGr [Integer]
    keys [(a, [Name], [Name])]
    ents
      where
      keys :: [Integer]
    keys                    = [ 0 :: Integer .. ]

      mkGr :: b -> (a, b, [Name]) -> (a, b, [Integer])
    mkGr i :: b
    i (x :: a
    x,_,uses :: [Name]
    uses)       = (a
    x,b
    i,(Name -> Maybe Integer) -> [Name] -> [Integer]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Name -> Map Name Integer -> Maybe Integer
    forall k a. Ord k => k -> Map k a -> Maybe a
    `Map.lookup` Map Name Integer
    nodeMap) [Name]
    uses)

      -- Maps names to node ids.
      nodeMap :: Map Name Integer
    nodeMap                 = [(Name, Integer)] -> Map Name Integer
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Integer)] -> Map Name Integer)
    -> [(Name, Integer)] -> Map Name Integer
    forall a b. (a -> b) -> a -> b
    $ [[(Name, Integer)]] -> [(Name, Integer)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Name, Integer)]] -> [(Name, Integer)])
    -> [[(Name, Integer)]] -> [(Name, Integer)]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> (a, [Name], [Name]) -> [(Name, Integer)])
    -> [Integer] -> [(a, [Name], [Name])] -> [[(Name, Integer)]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Integer -> (a, [Name], [Name]) -> [(Name, Integer)]
    forall b a a c. b -> (a, [a], c) -> [(a, b)]
    mkNode [Integer]
    keys [(a, [Name], [Name])]
    ents
      mkNode :: b -> (a, [a], c) -> [(a, b)]
    mkNode i :: b
    i (_,defs :: [a]
    defs,_)     = [ (a
    d,b
    i) | a
    d <- [a]
    defs ]

    {- | Combine a bunch of definitions into a single map.  Here we check
    that each name is defined only onces. -}
    combineMaps :: [Map Name (Located a)] -> InferM (Map Name (Located a))
    combineMaps :: [Map Name (Located a)] -> InferM (Map Name (Located a))
    combineMaps ms :: [Map Name (Located a)]
    ms = if [(Name, [Range])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Name, [Range])]
    bad then Map Name (Located a) -> InferM (Map Name (Located a))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Map Name (Located a)] -> Map Name (Located a)
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    f (Map k a) -> Map k a
    Map.unions [Map Name (Located a)]
    ms)
                                 else String -> [String] -> InferM (Map Name (Located a))
    forall a. HasCallStack => String -> [String] -> a
    panic "combineMaps" ([String] -> InferM (Map Name (Located a)))
    -> [String] -> InferM (Map Name (Located a))
    forall a b. (a -> b) -> a -> b
    $ "Multiple definitions"
                                                          String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ((Name, [Range]) -> String) -> [(Name, [Range])] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, [Range]) -> String
    forall a. Show a => a -> String
    show [(Name, [Range])]
    bad
      where
      bad :: [(Name, [Range])]
    bad = do Map Name (Located a)
    m <- [Map Name (Located a)]
    ms
               [Located Name] -> [(Name, [Range])]
    forall a. Ord a => [Located a] -> [(a, [Range])]
    duplicates [ Located a
    a { thing :: Name
    thing = Name
    x } | (x :: Name
    x,a :: Located a
    a) <- Map Name (Located a) -> [(Name, Located a)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Name (Located a)
    m ]

    {- | Combine a bunch of definitions into a single map.  Here we check
    that each name is defined only onces. -}
    combine :: [(Name, Located a)] -> InferM (Map Name (Located a))
    combine :: [(Name, Located a)] -> InferM (Map Name (Located a))
    combine m :: [(Name, Located a)]
    m = if [(Name, [Range])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Name, [Range])]
    bad then Map Name (Located a) -> InferM (Map Name (Located a))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, Located a)] -> Map Name (Located a)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(Name, Located a)]
    m)
                            else String -> [String] -> InferM (Map Name (Located a))
    forall a. HasCallStack => String -> [String] -> a
    panic "combine" ([String] -> InferM (Map Name (Located a)))
    -> [String] -> InferM (Map Name (Located a))
    forall a b. (a -> b) -> a -> b
    $ "Multiple definitions"
                                                 String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ((Name, [Range]) -> String) -> [(Name, [Range])] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, [Range]) -> String
    forall a. Show a => a -> String
    show [(Name, [Range])]
    bad
      where
      bad :: [(Name, [Range])]
    bad = [Located Name] -> [(Name, [Range])]
    forall a. Ord a => [Located a] -> [(a, [Range])]
    duplicates [ Located a
    a { thing :: Name
    thing = Name
    x } | (x :: Name
    x,a :: Located a
    a) <- [(Name, Located a)]
    m ]

    -- | Identify multiple occurances of something.
    duplicates :: Ord a => [Located a] -> [(a,[Range])]
    duplicates :: [Located a] -> [(a, [Range])]
    duplicates = ([Located a] -> Maybe (a, [Range]))
    -> [[Located a]] -> [(a, [Range])]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [Located a] -> Maybe (a, [Range])
    forall a. [Located a] -> Maybe (a, [Range])
    multiple
               ([[Located a]] -> [(a, [Range])])
    -> ([Located a] -> [[Located a]]) -> [Located a] -> [(a, [Range])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located a -> Located a -> Bool) -> [Located a] -> [[Located a]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (a -> a -> Bool)
    -> (Located a -> a) -> Located a -> Located a -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Located a -> a
    forall a. Located a -> a
    thing)
               ([Located a] -> [[Located a]])
    -> ([Located a] -> [Located a]) -> [Located a] -> [[Located a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located a -> Located a -> Ordering) -> [Located a] -> [Located a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (a -> a -> Ordering)
    -> (Located a -> a) -> Located a -> Located a -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Located a -> a
    forall a. Located a -> a
    thing)
      where
      multiple :: [Located a] -> Maybe (a, [Range])
    multiple xs :: [Located a]
    xs@(x :: Located a
    x : _ : _) = (a, [Range]) -> Maybe (a, [Range])
    forall a. a -> Maybe a
    Just (Located a -> a
    forall a. Located a -> a
    thing Located a
    x, (Located a -> Range) -> [Located a] -> [Range]
    forall a b. (a -> b) -> [a] -> [b]
    map Located a -> Range
    forall a. Located a -> Range
    srcRange [Located a]
    xs)
      multiple _              = Maybe (a, [Range])
    forall a. Maybe a
    Nothing