Rename [] to List (#21294)

This patch implements a small part of GHC Proposal #475.
The key change is in GHC.Types:

	- data [] a = [] | a : [a]
	+ data List a = [] | a : List a

And the rest of the patch makes sure that List is pretty-printed as []
in various contexts.

Updates the haddock submodule.

8 files changed, 61 insertions, 23 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 58c9d9eb25..176685bbf9 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -2781,4 +2781,5 @@ pretendNameIsInScope n
     , liftedDataConKey, unliftedDataConKey
     , tYPETyConKey
     , runtimeRepTyConKey, boxedRepDataConKey
-    , eqTyConKey ]
+    , eqTyConKey
+    , listTyConKey ]
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 54354fcd5f..e566dea938 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -18,7 +18,7 @@ module GHC.Builtin.Types (
         mkWiredInIdName,    -- used in GHC.Types.Id.Make
 
         -- * All wired in things
-        wiredInTyCons, isBuiltInOcc_maybe,
+        wiredInTyCons, isBuiltInOcc_maybe, isPunOcc_maybe,
 
         -- * Bool
         boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
@@ -372,7 +372,7 @@ falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") fa
 trueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon
 
 listTyConName, nilDataConName, consDataConName :: Name
-listTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
+listTyConName     = mkWiredInTyConName   UserSyntax    gHC_TYPES (fsLit "List") listTyConKey listTyCon
 nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
 consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
 
@@ -931,6 +931,21 @@ isBuiltInOcc_maybe occ =
       = choose_ns (getName (tupleTyCon   boxity arity))
                   (getName (tupleDataCon boxity arity))
 
+-- When resolving names produced by Template Haskell (see thOrigRdrName
+-- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not
+-- an Orig name.
+--
+-- This matters for pretty-printing under ListTuplePuns. If we don't do it,
+-- then -ddump-splices will print ''[] as ''GHC.Types.List.
+--
+-- Test case: th/T13776
+--
+isPunOcc_maybe :: Module -> OccName -> Maybe Name
+isPunOcc_maybe mod occ
+  | mod == gHC_TYPES, occ == occName listTyConName
+  = Just listTyConName
+isPunOcc_maybe _ _ = Nothing
+
 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 -- No need to cache these, the caching is done in mk_tuple
 mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index bf74bac0ab..b0f5888317 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4969,6 +4969,7 @@ initSDocContext dflags style = SDC
   , sdocStarIsType                  = xopt LangExt.StarIsType dflags
   , sdocImpredicativeTypes          = xopt LangExt.ImpredicativeTypes dflags
   , sdocLinearTypes                 = xopt LangExt.LinearTypes dflags
+  , sdocListTuplePuns               = True
   , sdocPrintTypeAbbreviations      = True
   , sdocUnitIdForUser               = ftext
   }
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index ab7b344eb9..40dccb6e0e 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -1610,26 +1610,26 @@ pprIfaceCoTcApp ctxt_prec tc tys =
 -- 2. Coercions (from 'pprIfaceCoTcApp')
 ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
                  -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
-ppr_iface_tc_app pp _ tc [ty]
-  | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
 
-ppr_iface_tc_app pp ctxt_prec tc tys
-  | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
-  = ppr_kind_type ctxt_prec
+ppr_iface_tc_app pp ctxt_prec tc tys =
+  sdocOption sdocListTuplePuns $ \listTuplePuns ->
+  if | listTuplePuns, tc `ifaceTyConHasKey` listTyConKey, [ty] <- tys
+     -> brackets (pp topPrec ty)
 
-  | not (isSymOcc (nameOccName (ifaceTyConName tc)))
-  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
+     | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
+     -> ppr_kind_type ctxt_prec
 
-  | [ ty1@(_, Required)
-    , ty2@(_, Required) ] <- tys
-      -- Infix, two visible arguments (we know nothing of precedence though).
-      -- Don't apply this special case if one of the arguments is invisible,
-      -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
-  = pprIfaceInfixApp ctxt_prec (ppr tc)
-                     (pp opPrec ty1) (pp opPrec ty2)
+     | not (isSymOcc (nameOccName (ifaceTyConName tc)))
+     -> pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
 
-  | otherwise
-  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
+     | [ ty1@(_, Required), ty2@(_, Required) ] <- tys
+         -- Infix, two visible arguments (we know nothing of precedence though).
+         -- Don't apply this special case if one of the arguments is invisible,
+         -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
+     -> pprIfaceInfixApp ctxt_prec (ppr tc) (pp opPrec ty1) (pp opPrec ty2)
+
+     | otherwise
+     -> pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
 
 -- | Pretty-print an unboxed sum type. The sum should be saturated:
 -- as many visible arguments as the arity of the sum.
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 82f30c4757..194250aff8 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -57,6 +57,7 @@ import GHC.Utils.Panic
 
 import qualified Data.ByteString as BS
 import Control.Monad( unless, ap )
+import Control.Applicative( (<|>) )
 import Data.Maybe( catMaybes, isNothing )
 import Language.Haskell.TH as TH hiding (sigP)
 import Language.Haskell.TH.Syntax as TH
@@ -2107,9 +2108,10 @@ thRdrName loc ctxt_ns th_occ th_name
 thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
 thOrigRdrName occ th_ns pkg mod =
   let occ' = mk_occ (mk_ghc_ns th_ns) occ
-  in case isBuiltInOcc_maybe occ' of
+      mod' = mkModule (mk_pkg pkg) (mk_mod mod)
+  in case isBuiltInOcc_maybe occ' <|> isPunOcc_maybe mod' occ' of
        Just name -> nameRdrName name
-       Nothing   -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'
+       Nothing   -> (mkOrig $! mod') $! occ'
 
 thRdrNameGuesses :: TH.Name -> [RdrName]
 thRdrNameGuesses (TH.Name occ flavour)
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index d919919e81..3d18d7bbb0 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -54,6 +54,7 @@ module GHC.Types.Name (
         setNameLoc,
         tidyNameOcc,
         localiseName,
+        namePun_maybe,
 
         nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
         pprFullName, pprTickyName,
@@ -83,6 +84,7 @@ module GHC.Types.Name (
 import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.TyThing ( TyThing )
+import {-# SOURCE #-} GHC.Builtin.Types ( listTyCon )
 
 import GHC.Platform
 import GHC.Types.Name.Occurrence
@@ -332,6 +334,12 @@ nameModule_maybe _                                  = Nothing
 is_interactive_or_from :: Module -> Module -> Bool
 is_interactive_or_from from mod = from == mod || isInteractiveModule mod
 
+-- Return the pun for a name if available.
+-- Used for pretty-printing under ListTuplePuns.
+namePun_maybe :: Name -> Maybe FastString
+namePun_maybe name | getUnique name == getUnique listTyCon = Just (fsLit "[]")
+namePun_maybe _ = Nothing
+
 nameIsLocalOrFrom :: Module -> Name -> Bool
 -- ^ Returns True if the name is
 --   (a) Internal
@@ -616,14 +624,21 @@ instance OutputableBndr Name where
     pprPrefixOcc = pprPrefixName
 
 pprName :: Name -> SDoc
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \sty ->
     getPprDebug $ \debug ->
+    sdocOption sdocListTuplePuns $ \listTuplePuns ->
+    handlePuns listTuplePuns (namePun_maybe name) $
     case sort of
       WiredIn mod _ builtin   -> pprExternal debug sty uniq mod occ True  builtin
       External mod            -> pprExternal debug sty uniq mod occ False UserSyntax
       System                  -> pprSystem   debug sty uniq occ
       Internal                -> pprInternal debug sty uniq occ
+  where
+    -- Print GHC.Types.List as [], etc.
+    handlePuns :: Bool -> Maybe FastString -> SDoc -> SDoc
+    handlePuns True (Just pun) _ = ftext pun
+    handlePuns _    _          r = r
 
 -- | Print fully qualified name (with unit-id, module and unique)
 pprFullName :: Module -> Name -> SDoc
diff --git a/compiler/GHC/Types/TyThing/Ppr.hs b/compiler/GHC/Types/TyThing/Ppr.hs
index 536fb63b43..8b203aac20 100644
--- a/compiler/GHC/Types/TyThing/Ppr.hs
+++ b/compiler/GHC/Types/TyThing/Ppr.hs
@@ -33,6 +33,8 @@ import GHC.Iface.Make ( tyThingToIfaceDecl )
 import GHC.Utils.Outputable
 import GHC.Utils.Trace
 
+import Data.Maybe ( isJust )
+
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
 
@@ -178,7 +180,7 @@ pprTyThing ss ty_thing
 
     ppr_bndr :: Name -> Maybe (OccName -> SDoc)
     ppr_bndr name
-      | isBuiltInSyntax name
+      | isBuiltInSyntax name || isJust (namePun_maybe name)
          = Nothing
       | otherwise
          = case nameModule_maybe name of
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index f4bf62232d..782dbd45fc 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -385,6 +385,7 @@ data SDocContext = SDC
   , sdocStarIsType                  :: !Bool
   , sdocLinearTypes                 :: !Bool
   , sdocImpredicativeTypes          :: !Bool
+  , sdocListTuplePuns               :: !Bool
   , sdocPrintTypeAbbreviations      :: !Bool
   , sdocUnitIdForUser               :: !(FastString -> SDoc)
       -- ^ Used to map UnitIds to more friendly "package-version:component"
@@ -444,6 +445,7 @@ defaultSDocContext = SDC
   , sdocStarIsType                  = False
   , sdocImpredicativeTypes          = False
   , sdocLinearTypes                 = False
+  , sdocListTuplePuns               = True
   , sdocPrintTypeAbbreviations      = True
   , sdocUnitIdForUser               = ftext
   }