Merge remote-tracking branch 'origin/ghc-head' into HEAD

4 files changed, 99 insertions, 73 deletions

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index e6de8b81..e9433d73 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -68,6 +68,7 @@ library
   ghc-options: -funbox-strict-fields -O2
                -Wall
                -Wcompat
+               -Wcompat-unqualified-imports
                -Widentities
                -Wredundant-constraints
                -Wnoncanonical-monad-instances
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 16643d0e..b42ae1a3 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -34,43 +34,44 @@ module Haddock.Interface (
 ) where
 
 
-import Haddock.GhcUtils
-import Haddock.InterfaceFile
-import Haddock.Interface.Create
-import Haddock.Interface.AttachInstances
-import Haddock.Interface.Rename
+import Haddock.GhcUtils (moduleString, pretty)
+import Haddock.Interface.AttachInstances (attachInstances)
+import Haddock.Interface.Create (createInterface1, runIfM)
+import Haddock.Interface.Rename (renameInterface)
+import Haddock.InterfaceFile (InterfaceFile, ifInstalledIfaces, ifLinkEnv)
 import Haddock.Options hiding (verbosity)
-import Haddock.Types
-import Haddock.Utils
-
-import Control.Monad
-import Control.Monad.IO.Class ( MonadIO )
-import Data.IORef
+import Haddock.Types (DocOption (..), Documentation (..), ExportItem (..), IfaceMap, InstIfaceMap, Interface, LinkEnv,
+                      expItemDecl, expItemMbDoc, ifaceDoc, ifaceExportItems, ifaceExports, ifaceHaddockCoverage,
+                      ifaceInstances, ifaceMod, ifaceOptions, ifaceVisibleExports, instMod, runWriter, throwE)
+import Haddock.Utils (Verbosity (..), normal, out, verbose)
+
+import Control.Monad (unless, when)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.IORef (atomicModifyIORef', newIORef, readIORef)
 import Data.List (foldl', isPrefixOf, nub)
+import Text.Printf (printf)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Text.Printf
 
-import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
-import GHC.Unit.Module.ModSummary
-import GHC.Unit.Module.Graph
-import GHC.Unit.Types
-import GHC.Data.Graph.Directed
-import GHC.Driver.Session hiding (verbosity)
 import GHC hiding (verbosity)
-import GHC.Driver.Env
-import GHC.Driver.Monad
 import GHC.Data.FastString (unpackFS)
-import GHC.Utils.Error
-import GHC.Tc.Types (TcM, TcGblEnv(..))
-import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv)
+import GHC.Data.Graph.Directed (flattenSCCs)
+import GHC.Driver.Env (hsc_dflags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units)
+import GHC.Driver.Monad (modifySession, withTimingM)
+import GHC.Driver.Session hiding (verbosity)
+import GHC.HsToCore.Docs (getMainDeclBinder)
+import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource)
+import GHC.Tc.Types (TcGblEnv (..), TcM)
 import GHC.Tc.Utils.Env (tcLookupGlobal)
+import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv)
 import GHC.Types.Name (nameIsFromExternalPackage, nameOccName)
 import GHC.Types.Name.Occurrence (isTcOcc)
-import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts)
-import GHC.HsToCore.Docs
-import GHC.Plugins (Outputable, StaticPlugin(..), Plugin(..), PluginWithArgs(..),
-                     defaultPlugin, keepRenamedSource)
+import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK)
+import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet)
+import GHC.Unit.Module.Graph (ModuleGraphNode (..))
+import GHC.Unit.Module.ModSummary (emsModSummary, isBootSummary)
+import GHC.Unit.Types (IsBootInterface (..))
+import GHC.Utils.Error (withTiming)
 
 #if defined(mingw32_HOST_OS)
 import System.IO
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 317258eb..6bc8b8c8 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -28,6 +28,7 @@ import Data.Maybe ( maybeToList, mapMaybe, fromMaybe )
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
+import GHC.Data.FastString (unpackFS)
 import GHC.Core.Class
 import GHC.Driver.Session
 import GHC.Core (isOrphan)
@@ -178,19 +179,30 @@ findFixity iface ifaceMap instIfaceMap = \name ->
 -- Collecting and sorting instances
 --------------------------------------------------------------------------------
 
+-- | Stable name for stable comparisons. GHC's `Name` uses unstable
+-- ordering based on their `Unique`'s.
+newtype SName = SName Name
+
+instance Eq SName where
+  SName n1 == SName n2 = n1 `stableNameCmp` n2 == EQ
+
+instance Ord SName where
+  SName n1 `compare` SName n2 = n1 `stableNameCmp` n2
 
 -- | Simplified type for sorting types, ignoring qualification (not visible
 -- in Haddock output) and unifying special tycons with normal ones.
 -- For the benefit of the user (looks nice and predictable) and the
 -- tests (which prefer output to be deterministic).
-data SimpleType = SimpleType Name [SimpleType]
-                | SimpleTyLit TyLit
+data SimpleType = SimpleType SName [SimpleType]
+                | SimpleIntTyLit Integer
+                | SimpleStringTyLit String
+                | SimpleCharTyLit Char
                   deriving (Eq,Ord)
 
 
-instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])
+instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], SName, [SimpleType])
 instHead (_, _, cls, args)
-  = (map argCount args, className cls, map simplify args)
+  = (map argCount args, SName (className cls), map simplify args)
 
 argCount :: Type -> Int
 argCount (AppTy t _)     = argCount t + 1
@@ -201,14 +213,16 @@ argCount (CastTy t _)    = argCount t
 argCount _ = 0
 
 simplify :: Type -> SimpleType
-simplify (FunTy _ _ t1 t2)  = SimpleType funTyConName [simplify t1, simplify t2]
+simplify (FunTy _ _ t1 t2)  = SimpleType (SName funTyConName) [simplify t1, simplify t2]
 simplify (ForAllTy _ t) = simplify t
 simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2))
   where (SimpleType s ts) = simplify t1
-simplify (TyVarTy v) = SimpleType (tyVarName v) []
-simplify (TyConApp tc ts) = SimpleType (tyConName tc)
+simplify (TyVarTy v) = SimpleType (SName (tyVarName v)) []
+simplify (TyConApp tc ts) = SimpleType (SName (tyConName tc))
                                        (mapMaybe simplify_maybe ts)
-simplify (LitTy l) = SimpleTyLit l
+simplify (LitTy (NumTyLit n)) = SimpleIntTyLit n
+simplify (LitTy (StrTyLit s)) = SimpleStringTyLit (unpackFS s)
+simplify (LitTy (CharTyLit c)) = SimpleCharTyLit c
 simplify (CastTy ty _) = simplify ty
 simplify (CoercionTy _) = error "simplify:Coercion"
 
@@ -217,9 +231,9 @@ simplify_maybe (CoercionTy {}) = Nothing
 simplify_maybe ty              = Just (simplify ty)
 
 -- Used for sorting
-instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
+instFam :: FamInst -> ([Int], SName, [SimpleType], Int, SimpleType)
 instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
-  = (map argCount ts, n, map simplify ts, argCount t, simplify t)
+  = (map argCount ts, SName n, map simplify ts, argCount t, simplify t)
 
 
 --------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 4357cb79..02fc86d9 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1,8 +1,17 @@
-{-# LANGUAGE StandaloneDeriving, FlexibleInstances, MultiParamTypeClasses, CPP, TupleSections, BangPatterns, LambdaCase, NamedFieldPuns, ScopedTypeVariables, RecordWildCards #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wwarn #-}
 -----------------------------------------------------------------------------
 -- |
@@ -23,48 +32,49 @@
 module Haddock.Interface.Create (IfM, runIfM, createInterface1) where
 
 import Documentation.Haddock.Doc (metaDocAppend)
+import Haddock.Convert (PrintRuntimeReps (..), tyThingToLHsDecl)
+import Haddock.GhcUtils (addClassContext, filterSigNames, lHsQTyVarsToTypes, mkEmptySigType, moduleString, parents,
+                         pretty, restrictTo, sigName, unL)
+import Haddock.Interface.LexParseRn (processDocString, processDocStringParas, processDocStrings, processModuleHeader)
+import Haddock.Options (Flag (..), modulePackageInfo)
 import Haddock.Types hiding (liftErrMsg)
-import Haddock.Options
-import Haddock.GhcUtils
-import Haddock.Utils
-import Haddock.Convert
-import Haddock.Interface.LexParseRn
+import Haddock.Utils (replace)
 
-import Control.Monad.Reader
+import Control.Monad.Reader (MonadReader (..), ReaderT, asks, runReaderT)
 import Control.Monad.Writer.Strict hiding (tell)
-import Data.Bitraversable
-import qualified Data.Map as M
+import Data.Bitraversable (bitraverse)
+import Data.List (find, foldl')
 import Data.Map (Map)
-import Data.List
-import Data.Maybe
-import Data.Traversable
-import GHC.Stack
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, fromJust, isJust, mapMaybe, maybeToList)
+import Data.Traversable (for)
 
+import GHC hiding (lookupName)
+import GHC.Core.Class (ClassMinimalDef, classMinimalDef)
+import GHC.Core.ConLike (ConLike (..))
+import GHC.Data.FastString (bytesFS, unpackFS)
+import GHC.Driver.Ppr (showSDoc)
+import GHC.HsToCore.Docs hiding (mkMaps)
+import GHC.Parser.Annotation (IsUnicodeSyntax (..))
+import GHC.Stack (HasCallStack)
+import GHC.Tc.Types hiding (IfM)
 import GHC.Tc.Utils.Monad (finalSafeMode)
 import GHC.Types.Avail hiding (avail)
-import qualified GHC.Types.Avail  as Avail
-import qualified GHC.Unit.Module as Module
-import GHC.Unit.Module.ModSummary
+import qualified GHC.Types.Avail as Avail
+import GHC.Types.Basic (PromotionFlag (..))
+import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName)
+import GHC.Types.Name.Env (lookupNameEnv)
+import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv)
+import GHC.Types.Name.Set (elemNameSet, mkNameSet)
+import GHC.Types.SourceFile (HscSource (..))
+import GHC.Types.SourceText (SourceText (..), sl_fs)
 import qualified GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.SourceFile
-import GHC.Core.Class
-import GHC.Core.ConLike (ConLike(..))
-import GHC hiding (lookupName)
-import GHC.Driver.Ppr
-import GHC.Types.Name
-import GHC.Types.Name.Set
-import GHC.Types.Name.Env
-import GHC.Unit.State
-import GHC.Types.Name.Reader
-import GHC.Tc.Types hiding (IfM)
-import GHC.Data.FastString ( unpackFS, bytesFS )
-import GHC.Types.Basic ( PromotionFlag(..) )
-import GHC.Types.SourceText
+import qualified GHC.Unit.Module as Module
+import GHC.Unit.Module.ModSummary (msHsFilePath)
+import GHC.Unit.Module.Warnings (WarningTxt (..), Warnings (..))
+import GHC.Unit.State (PackageName (..), UnitState, lookupModuleInAllUnits)
 import qualified GHC.Utils.Outputable as O
-import GHC.Utils.Panic
-import GHC.HsToCore.Docs hiding (mkMaps)
-import GHC.Parser.Annotation (IsUnicodeSyntax(..))
-import GHC.Unit.Module.Warnings
+import GHC.Utils.Panic (pprPanic)
 
 newtype IfEnv m = IfEnv
   {