Handle records in the renamer

This patch moves the field-based logic for disambiguating record updates
to the renamer. The type-directed logic, scheduled for removal, remains
in the typechecker.

To do this properly (and fix the myriad of bugs surrounding the treatment
of duplicate record fields), we took the following main steps:

  1. Create GREInfo, a renamer-level equivalent to TyThing which stores
     information pertinent to the renamer.
     This allows us to uniformly treat imported and local Names in the
     renamer, as described in Note [GREInfo].

  2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which
     distinguished between normal names and field names, we now store
     simple Names in GlobalRdrElt, along with the new GREInfo information
     which allows us to recover the FieldLabel for record fields.

  3. Add namespacing for record fields, within the OccNames themselves.
     This allows us to remove the mangling of duplicate field selectors.

     This change ensures we don't print mangled names to the user in
     error messages, and allows us to handle duplicate record fields
     in Template Haskell.

  4. Move record disambiguation to the renamer, and operate on the
     level of data constructors instead, to handle #21443.

     The error message text for ambiguous record updates has also been
     changed to reflect that type-directed disambiguation is on the way
     out.

(3) means that OccEnv is now a bit more complex: we first key on the
textual name, which gives an inner map keyed on NameSpace:

  OccEnv a ~ FastStringEnv (UniqFM NameSpace a)

Note that this change, along with (2), both increase the memory residency
of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to
regress somewhat in compile-time allocation.

Even though (3) simplified a lot of code (in particular the treatment of
field selectors within Template Haskell and in error messages), it came
with one important wrinkle: in the situation of

  -- M.hs-boot
  module M where { data A; foo :: A -> Int }
  -- M.hs
  module M where { data A = MkA { foo :: Int } }

we have that M.hs-boot exports a variable foo, which is supposed to match
with the record field foo that M exports. To solve this issue, we add a
new impedance-matching binding to M

  foo{var} = foo{fld}

This mimics the logic that existed already for impedance-binding DFunIds,
but getting it right was a bit tricky.
See Note [Record field impedance matching] in GHC.Tc.Module.

We also needed to be careful to avoid introducing space leaks in GHCi.
So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in
ModIface. This means stubbing out all the GREInfo fields, with the
function forceGlobalRdrEnv.
When we read it back in, we rehydrate with rehydrateGlobalRdrEnv.
This robustly avoids any space leaks caused by retaining old type
environments.

Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063

Updates haddock submodule

-------------------------
Metric Increase:
    MultiComponentModules
    MultiLayerModules
    MultiLayerModulesDefsGhci
    MultiLayerModulesNoCode
    T13701
    T14697
    hard_hole_fits
-------------------------

4 files changed, 64 insertions, 34 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 35bca47d25..542f1e16b6 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -23,7 +23,7 @@ import qualified Language.Haskell.TH.Syntax as TH
 import Control.Applicative(liftA, Applicative(..))
 import qualified Data.Kind as Kind (Type)
 import Data.Word( Word8 )
-import Data.List.NonEmpty ( NonEmpty(..) )
+import Data.List.NonEmpty ( NonEmpty(..), toList )
 import GHC.Exts (TYPE)
 import Prelude hiding (Applicative(..))
 
@@ -680,10 +680,10 @@ forallC ns ctxt con = do
   con'  <- con
   pure $ ForallC ns' ctxt' con'
 
-gadtC :: Quote m => [Name] -> [m StrictType] -> m Type -> m Con
+gadtC :: Quote m => NonEmpty Name -> [m StrictType] -> m Type -> m Con
 gadtC cons strtys ty = liftA2 (GadtC cons) (sequenceA strtys) ty
 
-recGadtC :: Quote m => [Name] -> [m VarStrictType] -> m Type -> m Con
+recGadtC :: Quote m => NonEmpty Name -> [m VarStrictType] -> m Type -> m Con
 recGadtC cons varstrtys ty = liftA2 (RecGadtC cons) (sequenceA varstrtys) ty
 
 -------------------------------------------------------------------------------
@@ -1177,7 +1177,7 @@ docCons :: (Q Con, Maybe String, [Maybe String]) -> Q ()
 docCons (c, md, arg_docs) = do
   c' <- c
   -- Attach docs to the constructors
-  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- get_cons_names c' ]
+  sequence_ [ putDoc (DeclDoc nm) d | Just d <- [md], nm <- toList $ get_cons_names c' ]
   -- Attach docs to the arguments
   case c' of
     -- Record selector documentation isn't stored in the argument map,
@@ -1188,18 +1188,6 @@ docCons (c, md, arg_docs) = do
                 ]
     _ ->
       sequence_ [ putDoc (ArgDoc nm i) arg_doc
-                    | nm <- get_cons_names c'
+                    | nm <- toList $ get_cons_names c'
                     , (i, Just arg_doc) <- zip [0..] arg_docs
                 ]
-  where
-    get_cons_names :: Con -> [Name]
-    get_cons_names (NormalC n _) = [n]
-    get_cons_names (RecC n _) = [n]
-    get_cons_names (InfixC _ n _) = [n]
-    get_cons_names (ForallC _ _ cons) = get_cons_names cons
-    -- GadtC can have multiple names, e.g
-    -- > data Bar a where
-    -- >   MkBar1, MkBar2 :: a -> Bar a
-    -- Will have one GadtC with [MkBar1, MkBar2] as names
-    get_cons_names (GadtC ns _ _) = ns
-    get_cons_names (RecGadtC ns _ _) = ns
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index cedb974976..d3101a985b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -11,6 +11,7 @@ module Language.Haskell.TH.Ppr where
 import Text.PrettyPrint (render)
 import Language.Haskell.TH.PprLib
 import Language.Haskell.TH.Syntax
+import qualified Data.List.NonEmpty as NE ( toList )
 import Data.Word ( Word8 )
 import Data.Char ( toLower, chr)
 import GHC.Show  ( showMultiLineString )
@@ -682,22 +683,22 @@ instance Ppr Con where
                          <+> pprName' Infix c
                          <+> pprBangType st2
 
-    ppr (ForallC ns ctxt (GadtC c sts ty))
-        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt
+    ppr (ForallC ns ctxt (GadtC cs sts ty))
+        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprForall ns ctxt
       <+> pprGadtRHS sts ty
 
-    ppr (ForallC ns ctxt (RecGadtC c vsts ty))
-        = commaSepApplied c <+> dcolon <+> pprForall ns ctxt
+    ppr (ForallC ns ctxt (RecGadtC cs vsts ty))
+        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprForall ns ctxt
       <+> pprRecFields vsts ty
 
     ppr (ForallC ns ctxt con)
         = pprForall ns ctxt <+> ppr con
 
-    ppr (GadtC c sts ty)
-        = commaSepApplied c <+> dcolon <+> pprGadtRHS sts ty
+    ppr (GadtC cs sts ty)
+        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprGadtRHS sts ty
 
-    ppr (RecGadtC c vsts ty)
-        = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty
+    ppr (RecGadtC cs vsts ty)
+        = commaSepApplied (NE.toList cs) <+> dcolon <+> pprRecFields vsts ty
 
 instance Ppr PatSynDir where
   ppr Unidir        = text "<-"
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 8be340bf93..6668273a14 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -48,6 +48,7 @@ import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper, ord )
 import Data.Int
 import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE ( singleton )
 import Data.Void        ( Void, absurd )
 import Data.Word
 import Data.Ratio
@@ -1498,8 +1499,9 @@ dataToExpQ = dataToQa varOrConE litE (foldl appE)
           -- See #10796.
           varOrConE s =
             case nameSpace s of
-                 Just VarName  -> return (VarE s)
-                 Just DataName -> return (ConE s)
+                 Just VarName      -> return (VarE s)
+                 Just (FldName {}) -> return (VarE s)
+                 Just DataName     -> return (ConE s)
                  _ -> error $ "Can't construct an expression from name "
                            ++ showName s
           appE x y = do { a <- x; b <- y; return (AppE a b)}
@@ -1675,6 +1677,14 @@ data NameSpace = VarName        -- ^ Variables
                | DataName       -- ^ Data constructors
                | TcClsName      -- ^ Type constructors and classes; Haskell has them
                                 -- in the same name space for now.
+               | FldName
+                 { fldParent :: !String
+                   -- ^ The textual name of the parent of the field.
+                   --
+                   --   - For a field of a datatype, this is the name of the first constructor
+                   --     of the datatype (regardless of whether this constructor has this field).
+                   --   - For a field of a pattern synonym, this is the name of the pattern synonym.
+                 }
                deriving( Eq, Ord, Show, Data, Generic )
 
 -- | @Uniq@ is used by GHC to distinguish names from each other.
@@ -1834,6 +1844,13 @@ mkNameG_v  = mkNameG VarName
 mkNameG_tc = mkNameG TcClsName
 mkNameG_d  = mkNameG DataName
 
+mkNameG_fld :: String -- ^ package
+            -> String -- ^ module
+            -> String -- ^ parent (first constructor of parent type)
+            -> String -- ^ field name
+            -> Name
+mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ
+
 data NameIs = Alone | Applied | Infix
 
 showName :: Name -> String
@@ -1857,11 +1874,11 @@ showName' ni nm
         -- We may well want to distinguish them in the end.
         -- Ditto NameU and NameL
         nms = case nm of
-                    Name occ NameS         -> occString occ
-                    Name occ (NameQ m)     -> modString m ++ "." ++ occString occ
-                    Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
-                    Name occ (NameU u)     -> occString occ ++ "_" ++ show u
-                    Name occ (NameL u)     -> occString occ ++ "_" ++ show u
+          Name occ NameS          -> occString occ
+          Name occ (NameQ m)      -> modString m ++ "." ++ occString occ
+          Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
+          Name occ (NameU u)      -> occString occ ++ "_" ++ show u
+          Name occ (NameL u)      -> occString occ ++ "_" ++ show u
 
         pnam = classify nms
 
@@ -2705,10 +2722,10 @@ data Con = NormalC Name [BangType]       -- ^ @C Int a@
          | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@
          | InfixC BangType Name BangType -- ^ @Int :+ a@
          | ForallC [TyVarBndr Specificity] Cxt Con -- ^ @forall a. Eq a => C [a]@
-         | GadtC [Name] [BangType]
+         | GadtC (NonEmpty Name) [BangType]
                  Type                    -- See Note [GADT return type]
                                          -- ^ @C :: a -> b -> T b Int@
-         | RecGadtC [Name] [VarBangType]
+         | RecGadtC (NonEmpty Name) [VarBangType]
                     Type                 -- See Note [GADT return type]
                                          -- ^ @C :: { v :: Int } -> T b Int@
         deriving (Show, Eq, Ord, Data, Generic)
@@ -2907,3 +2924,15 @@ cmpEq _  = False
 thenCmp :: Ordering -> Ordering -> Ordering
 thenCmp EQ o2 = o2
 thenCmp o1 _  = o1
+
+get_cons_names :: Con -> NonEmpty Name
+get_cons_names (NormalC n _)     = NE.singleton n
+get_cons_names (RecC n _)        = NE.singleton n
+get_cons_names (InfixC _ n _)    = NE.singleton n
+get_cons_names (ForallC _ _ con) = get_cons_names con
+-- GadtC can have multiple names, e.g
+-- > data Bar a where
+-- >   MkBar1, MkBar2 :: a -> Bar a
+-- Will have one GadtC with [MkBar1, MkBar2] as names
+get_cons_names (GadtC ns _ _)    = ns
+get_cons_names (RecGadtC ns _ _) = ns
\ No newline at end of file
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 8382efd1fc..821c776d96 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -1,5 +1,17 @@
 # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
 
+## 2.21.0.0
+
+  * The `GadtC` and `RecGadtC` constructors of the `Con` datatype now take
+    non-empty lists of constructors. This means that the `gadtC` and `recGadtC`
+    smart constructors also expect non-empty lists as arguments.
+
+  * Record fields now belong to separate `NameSpace`s, keyed by the parent of
+    the record field. This is the name of the first constructor of the parent type,
+    even if this constructor does not have the field in question.  
+
+    This change enables TemplateHaskell support for `DuplicateRecordFields`.
+
 ## 2.20.0.0
 
   * The `Ppr.pprInfixT` function has gained a `Precedence` argument.