Make PatSyn immutablewip/T19074a

Provoked by #19074, this patch makes GHC.Core.PatSyn.PatSyn
immutable, by recording only the *Name* of the matcher and
builder rather than (as currently) the *Id*.

See Note [Keep Ids out of PatSyn] in GHC.Core.PatSyn.

Updates haddock submodule.

29 files changed, 203 insertions, 204 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index c7e7e5c826..c3524c7776 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -1280,7 +1280,7 @@ compileCore simplify fn = do
         gutsToCoreModule safe_mode (Right mg) = CoreModule {
           cm_module  = mg_module mg,
           cm_types   = typeEnvFromEntities (bindersOfBinds (mg_binds mg))
-                                           (mg_tcs mg)
+                                           (mg_tcs mg) (mg_patsyns mg)
                                            (mg_fam_insts mg),
           cm_binds   = mg_binds mg,
           cm_safe    = safe_mode
diff --git a/compiler/GHC/Core/ConLike.hs b/compiler/GHC/Core/ConLike.hs
index efe29f608f..bbdab332a7 100644
--- a/compiler/GHC/Core/ConLike.hs
+++ b/compiler/GHC/Core/ConLike.hs
@@ -16,13 +16,13 @@ module GHC.Core.ConLike (
         , conLikeExTyCoVars
         , conLikeName
         , conLikeStupidTheta
-        , conLikeWrapId_maybe
         , conLikeImplBangs
         , conLikeFullSig
         , conLikeResTy
         , conLikeFieldType
         , conLikesWithFields
         , conLikeIsInfix
+        , conLikeHasBuilder
     ) where
 
 #include "HsVersions.h"
@@ -41,6 +41,7 @@ import GHC.Types.Var
 import GHC.Core.Type(mkTyConApp)
 import GHC.Core.Multiplicity
 
+import Data.Maybe( isJust )
 import qualified Data.Data as Data
 
 {-
@@ -144,12 +145,11 @@ conLikeStupidTheta :: ConLike -> ThetaType
 conLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con
 conLikeStupidTheta (PatSynCon {})         = []
 
--- | Returns the `Id` of the wrapper. This is also known as the builder in
--- some contexts. The value is Nothing only in the case of unidirectional
--- pattern synonyms.
-conLikeWrapId_maybe :: ConLike -> Maybe Id
-conLikeWrapId_maybe (RealDataCon data_con) = Just $ dataConWrapId data_con
-conLikeWrapId_maybe (PatSynCon pat_syn)    = fst <$> patSynBuilder pat_syn
+-- | 'conLikeHasBuilder' returns True except for
+-- uni-directional pattern synonyms, which have no builder
+conLikeHasBuilder :: ConLike -> Bool
+conLikeHasBuilder (RealDataCon {})    = True
+conLikeHasBuilder (PatSynCon pat_syn) = isJust (patSynBuilder pat_syn)
 
 -- | Returns the strictness information for each constructor
 conLikeImplBangs :: ConLike -> [HsImplBang]
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index 8ef66a6a9d..180e562c73 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -60,7 +60,6 @@ import GHC.Data.OrdList
 import GHC.Types.Id as Id
 import GHC.Core.Make            ( mkWildValBinder )
 import GHC.Driver.Session       ( DynFlags )
-import GHC.Driver.Ppr
 import GHC.Builtin.Types
 import GHC.Core.TyCo.Rep        ( TyCoBinder(..) )
 import qualified GHC.Core.Type as Type
@@ -683,7 +682,8 @@ refineFromInScope :: InScopeSet -> Var -> Var
 refineFromInScope in_scope v
   | isLocalId v = case lookupInScope in_scope v of
                   Just v' -> v'
-                  Nothing -> WARN( True, ppr v ) v  -- This is an error!
+                  Nothing -> pprPanic "refineFromInScope" (ppr in_scope $$ ppr v)
+                             -- c.f #19074 for a subtle place where this went wrong
   | otherwise = v
 
 lookupRecBndr :: SimplEnv -> InId -> OutId
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index b07b8265a7..3fa12a626a 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -9,10 +9,10 @@
 
 module GHC.Core.PatSyn (
         -- * Main data types
-        PatSyn, mkPatSyn,
+        PatSyn, PatSynMatcher, PatSynBuilder, mkPatSyn,
 
         -- ** Type deconstruction
-        patSynName, patSynArity, patSynIsInfix,
+        patSynName, patSynArity, patSynIsInfix, patSynResultType,
         patSynArgs,
         patSynMatcher, patSynBuilder,
         patSynUnivTyVarBinders, patSynExTyVars, patSynExTyVarBinders,
@@ -20,7 +20,7 @@ module GHC.Core.PatSyn (
         patSynInstArgTys, patSynInstResTy, patSynFieldLabels,
         patSynFieldType,
 
-        updatePatSynIds, pprPatSynType
+        pprPatSynType
     ) where
 
 #include "HsVersions.h"
@@ -86,34 +86,38 @@ data PatSyn
                                -- See Note [Pattern synonym result type]
 
         -- See Note [Matchers and builders for pattern synonyms]
-        psMatcher     :: (Id, Bool),
-             -- Matcher function.
-             -- If Bool is True then prov_theta and arg_tys are empty
-             -- and type is
-             --   forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs.
-             --                          req_theta
-             --                       => res_ty
-             --                       -> (forall ex_tvs. Void# -> r)
-             --                       -> (Void# -> r)
-             --                       -> r
-             --
-             -- Otherwise type is
-             --   forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs.
-             --                          req_theta
-             --                       => res_ty
-             --                       -> (forall ex_tvs. prov_theta => arg_tys -> r)
-             --                       -> (Void# -> r)
-             --                       -> r
-
-        psBuilder     :: Maybe (Id, Bool)
-             -- Nothing  => uni-directional pattern synonym
-             -- Just (builder, is_unlifted) => bi-directional
-             -- Builder function, of type
-             --  forall univ_tvs, ex_tvs. (req_theta, prov_theta)
-             --                       =>  arg_tys -> res_ty
-             -- See Note [Builder for pattern synonyms with unboxed type]
+        -- See Note [Keep Ids out of PatSyn]
+        psMatcher     :: PatSynMatcher,
+        psBuilder     :: PatSynBuilder
   }
 
+type PatSynMatcher = (Name, Type, Bool)
+     -- Matcher function.
+     -- If Bool is True then prov_theta and arg_tys are empty
+     -- and type is
+     --   forall (p :: RuntimeRep) (r :: TYPE p) univ_tvs.
+     --                          req_theta
+     --                       => res_ty
+     --                       -> (forall ex_tvs. Void# -> r)
+     --                       -> (Void# -> r)
+     --                       -> r
+     --
+     -- Otherwise type is
+     --   forall (p :: RuntimeRep) (r :: TYPE r) univ_tvs.
+     --                          req_theta
+     --                       => res_ty
+     --                       -> (forall ex_tvs. prov_theta => arg_tys -> r)
+     --                       -> (Void# -> r)
+     --                       -> r
+
+type PatSynBuilder = Maybe (Name, Type, Bool)
+     -- Nothing  => uni-directional pattern synonym
+     -- Just (builder, is_unlifted) => bi-directional
+     -- Builder function, of type
+     --  forall univ_tvs, ex_tvs. (req_theta, prov_theta)
+     --                       =>  arg_tys -> res_ty
+     -- See Note [Builder for pattern synonyms with unboxed type]
+
 {- Note [Pattern synonym signature contexts]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In a pattern synonym signature we write
@@ -203,6 +207,22 @@ The latter generates the proper required constraint, the former does not.
 Also rather different to GADTs is the fact that Just42 doesn't have any
 universally quantified type variables, whereas Just'42 or MkS above has.
 
+Note [Keep Ids out of PatSyn]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We carefully arrange that PatSyn does not contain the Ids for the matcher
+and builder.  We want PatSyn, like TyCon and DataCon, to be completely
+immutable. But, the matcher and builder are relatively sophisticated
+functions, and we want to get their final IdInfo in the same way as
+any other Id, so we'd have to update the Ids in the PatSyn too.
+
+Rather than try to tidy PatSyns (which is easy to forget and is a bit
+tricky, see #19074), it seems cleaner to make them entirely immutable,
+like TyCons and Classes.  To that end PatSynBuilder and PatSynMatcher
+contain Names not Ids. Which, it turns out, is absolutely fine.
+
+c.f. DefMethInfo in Class, which contains the Name, but not the Id,
+of the default method.
+
 Note [Pattern synonym representation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following pattern synonym declaration
@@ -363,8 +383,8 @@ mkPatSyn :: Name
                                          -- variables and provided dicts
          -> [Type]               -- ^ Original arguments
          -> Type                 -- ^ Original result type
-         -> (Id, Bool)           -- ^ Name of matcher
-         -> Maybe (Id, Bool)     -- ^ Name of builder
+         -> PatSynMatcher        -- ^ Matcher
+         -> PatSynBuilder        -- ^ Builder
          -> [FieldLabel]         -- ^ Names of fields for
                                  --   a record pattern synonym
          -> PatSyn
@@ -433,17 +453,14 @@ patSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Scaled Type], T
 patSynSig ps = let (u_tvs, req, e_tvs, prov, arg_tys, res_ty) = patSynSigBndr ps
                in (binderVars u_tvs, req, binderVars e_tvs, prov, arg_tys, res_ty)
 
-patSynMatcher :: PatSyn -> (Id,Bool)
+patSynMatcher :: PatSyn -> PatSynMatcher
 patSynMatcher = psMatcher
 
-patSynBuilder :: PatSyn -> Maybe (Id, Bool)
+patSynBuilder :: PatSyn -> PatSynBuilder
 patSynBuilder = psBuilder
 
-updatePatSynIds :: (Id -> Id) -> PatSyn -> PatSyn
-updatePatSynIds tidy_fn ps@(MkPatSyn { psMatcher = matcher, psBuilder = builder })
-  = ps { psMatcher = tidy_pr matcher, psBuilder = fmap tidy_pr builder }
-  where
-    tidy_pr (id, dummy) = (tidy_fn id, dummy)
+patSynResultType :: PatSyn -> Type
+patSynResultType = psResultTy
 
 patSynInstArgTys :: PatSyn -> [Type] -> [Type]
 -- Return the types of the argument patterns
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 3d32985131..8c18a13eb6 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -405,7 +405,7 @@ patSynToIfaceDecl ps
     ex_bndrs   = patSynExTyVarBinders ps
     (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs
     (env2, ex_bndrs')   = tidyTyCoVarBinders env1 ex_bndrs
-    to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
+    to_if_pr (name, _type, needs_dummy) = (name, needs_dummy)
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index ac3a58a592..489c172e23 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -159,12 +159,6 @@ instance Outputable SyntaxExprTc where
 
   ppr NoSyntaxExprTc = text "<no syntax expr>"
 
--- | Extra data fields for a 'RecordCon', added by the type checker
-data RecordConTc = RecordConTc
-      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym
-      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function
-      }
-
 -- | Extra data fields for a 'RecordUpd', added by the type checker
 data RecordUpdTc = RecordUpdTc
       { rupd_cons :: [ConLike]
@@ -254,7 +248,7 @@ type instance XExplicitList  GhcTc = Type
 
 type instance XRecordCon     GhcPs = NoExtField
 type instance XRecordCon     GhcRn = NoExtField
-type instance XRecordCon     GhcTc = RecordConTc
+type instance XRecordCon     GhcTc = PostTcExpr   -- Instantiated constructor function
 
 type instance XRecordUpd     GhcPs = NoExtField
 type instance XRecordUpd     GhcRn = NoExtField
@@ -474,8 +468,15 @@ ppr_expr (HsDo _ do_or_list_comp (L _ stmts)) = pprDo do_or_list_comp stmts
 ppr_expr (ExplicitList _ _ exprs)
   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 
-ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
-  = hang (ppr con_id) 2 (ppr rbinds)
+ppr_expr (RecordCon { rcon_con = con, rcon_flds = rbinds })
+  = hang pp_con 2 (ppr rbinds)
+  where
+    -- con :: ConLikeP (GhcPass p)
+    -- so we need case analysis to know to print it
+    pp_con = case ghcPass @p of
+               GhcPs -> ppr con
+               GhcRn -> ppr con
+               GhcTc -> ppr con
 
 ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
   = hang (ppr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 3098f3a935..7fa71a90e1 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -358,7 +358,6 @@ deriving instance Data (ArithSeqInfo GhcPs)
 deriving instance Data (ArithSeqInfo GhcRn)
 deriving instance Data (ArithSeqInfo GhcTc)
 
-deriving instance Data RecordConTc
 deriving instance Data RecordUpdTc
 deriving instance Data CmdTopTc
 deriving instance Data PendingRnSplice
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 7f9cecda1b..1be6ef274a 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -302,6 +302,7 @@ pprPat (ConPat { pat_con = con
   where
     regular :: OutputableBndr (ConLikeP (GhcPass p)) => SDoc
     regular = pprUserCon (unLoc con) details
+
 pprPat (XPat ext) = case ghcPass @p of
 #if __GLASGOW_HASKELL__ < 811
   GhcPs -> noExtCon ext
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 09f3165b26..198dbd07cc 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -27,7 +27,6 @@ import GHC.Unit
 import GHC.Cmm.CLabel
 
 import GHC.Core.Type
-import GHC.Core.ConLike
 import GHC.Core
 import GHC.Core.TyCon
 
@@ -514,8 +513,11 @@ addTickHsExpr e@(HsVar _ (L _ id))  = do freeVar id; return e
 addTickHsExpr e@(HsUnboundVar {})   = return e
 addTickHsExpr e@(HsRecFld _ (Ambiguous id _))   = do freeVar id; return e
 addTickHsExpr e@(HsRecFld _ (Unambiguous id _)) = do freeVar id; return e
-addTickHsExpr e@(HsConLikeOut _ con)
-  | Just id <- conLikeWrapId_maybe con = do freeVar id; return e
+
+addTickHsExpr e@(HsConLikeOut {}) = return e
+  -- We used to do a freeVar on a pat-syn builder, but actually
+  -- such builders are never in the inScope env, which
+  -- doesn't include top level bindings
 addTickHsExpr e@(HsIPVar {})     = return e
 addTickHsExpr e@(HsOverLit {})   = return e
 addTickHsExpr e@(HsOverLabel{})  = return e
@@ -642,9 +644,6 @@ addTickHsExpr (XExpr (ExpansionExpr (HsExpanded a b))) =
         liftM (XExpr . ExpansionExpr . HsExpanded a) $
               (addTickHsExpr b)
 
--- Others should never happen in expression content.
-addTickHsExpr e  = pprPanic "addTickHsExpr" (ppr e)
-
 addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
 addTickTupArg (L l (Present x e))  = do { e' <- addTickLHsExpr e
                                         ; return (L l (Present x e')) }
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 4106f4f432..259615e64c 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -580,9 +580,9 @@ We also handle @C{}@ as valid construction syntax for an unlabelled
 constructor @C@, setting all of @C@'s fields to bottom.
 -}
 
-dsExpr (RecordCon { rcon_flds = rbinds
-                  , rcon_ext = RecordConTc { rcon_con_expr = con_expr
-                                           , rcon_con_like = con_like }})
+dsExpr (RecordCon { rcon_con  = L _ con_like
+                  , rcon_flds = rbinds
+                  , rcon_ext  = con_expr })
   = do { con_expr' <- dsExpr con_expr
        ; let
              (arg_tys, _) = tcSplitFunTys (exprType con_expr')
@@ -1155,11 +1155,15 @@ dsHsVar var
 
 dsConLike :: ConLike -> DsM CoreExpr
 dsConLike (RealDataCon dc) = dsHsVar (dataConWrapId dc)
-dsConLike (PatSynCon ps)   = return $ case patSynBuilder ps of
-  Just (id, add_void)
-    | add_void  -> mkCoreApp (text "dsConLike" <+> ppr ps) (Var id) (Var voidPrimId)
-    | otherwise -> Var id
-  _ -> pprPanic "dsConLike" (ppr ps)
+dsConLike (PatSynCon ps)
+  | Just (builder_name, _, add_void) <- patSynBuilder ps
+  = do { builder_id <- dsLookupGlobalId builder_name
+       ; return (if add_void
+                 then mkCoreApp (text "dsConLike" <+> ppr ps)
+                                (Var builder_id) (Var voidPrimId)
+                 else Var builder_id) }
+  | otherwise
+  = pprPanic "dsConLike" (ppr ps)
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index a4b4652277..6e832ae6f6 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -253,22 +253,24 @@ runDs hsc_env (ds_gbl, ds_lcl) thing_inside
 
 -- | Run a 'DsM' action in the context of an existing 'ModGuts'
 initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages ErrDoc, Maybe a)
-initDsWithModGuts hsc_env guts thing_inside
+initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds
+                                   , mg_tcs = tycons, mg_fam_insts = fam_insts
+                                   , mg_patsyns = patsyns, mg_rdr_env = rdr_env
+                                   , mg_fam_inst_env = fam_inst_env
+                                   , mg_complete_matches = local_complete_matches
+                          }) thing_inside
   = do { cc_st_var   <- newIORef newCostCentreState
        ; msg_var <- newIORef emptyMessages
        ; eps <- liftIO $ hscEPS hsc_env
        ; let unit_env = hsc_unit_env hsc_env
-             type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts)
-             rdr_env  = mg_rdr_env guts
-             fam_inst_env = mg_fam_inst_env guts
-             this_mod = mg_module guts
+             type_env = typeEnvFromEntities ids tycons patsyns fam_insts
              complete_matches = hptCompleteSigs hsc_env     -- from the home package
-                                ++ mg_complete_matches guts -- from the current module
+                                ++ local_complete_matches  -- from the current module
                                 ++ eps_complete_matches eps -- from imports
 
              bindsToIds (NonRec v _)   = [v]
              bindsToIds (Rec    binds) = map fst binds
-             ids = concatMap bindsToIds (mg_binds guts)
+             ids = concatMap bindsToIds binds
 
              envs  = mkDsEnvs unit_env this_mod rdr_env type_env
                               fam_inst_env msg_var cc_st_var
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 629b082f6e..c9370754a3 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1568,7 +1568,7 @@ repE (ExplicitSum _ alt arity e)
  = do { e1 <- repLE e
       ; repUnboxedSum e1 alt arity }
 
-repE (RecordCon { rcon_con_name = c, rcon_flds = flds })
+repE (RecordCon { rcon_con = c, rcon_flds = flds })
  = do { x <- lookupLOcc c;
         fs <- repFields flds;
         repRecCon x fs }
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 8623a628f3..7c452887f1 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -322,8 +322,9 @@ mkCoSynCaseMatchResult var ty alt = MR_Fallible $ mkPatSynCase var ty alt
 
 mkPatSynCase :: Id -> Type -> CaseAlt PatSyn -> CoreExpr -> DsM CoreExpr
 mkPatSynCase var ty alt fail = do
+    matcher_id <- dsLookupGlobalId matcher_name
     matcher <- dsLExpr $ mkLHsWrap wrapper $
-                         nlHsTyApp matcher [getRuntimeRep ty, ty]
+                         nlHsTyApp matcher_id [getRuntimeRep ty, ty]
     cont <- mkCoreLams bndrs <$> runMatchResult fail match_result
     return $ mkCoreAppsDs (text "patsyn" <+> ppr var) matcher [Var var, ensure_unstrict cont, Lam voidArgId fail]
   where
@@ -331,7 +332,7 @@ mkPatSynCase var ty alt fail = do
                alt_bndrs = bndrs,
                alt_wrapper = wrapper,
                alt_result = match_result} = alt
-    (matcher, needs_void_lam) = patSynMatcher psyn
+    (matcher_name, _, needs_void_lam) = patSynMatcher psyn
 
     -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
     -- on these extra Void# arguments
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index b4dcbddd39..242c893807 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -52,7 +52,7 @@ import GHC.Core.InstEnv
 import GHC.Builtin.Types          ( mkListTy, mkSumTy )
 import GHC.Tc.Types
 import GHC.Tc.Types.Evidence
-import GHC.Types.Var              ( Id, Var, EvId, varName, setVarName, varType, varUnique )
+import GHC.Types.Var              ( Id, Var, EvId, varName, varType, varUnique )
 import GHC.Types.Var.Env
 import GHC.Builtin.Uniques
 import GHC.Iface.Make             ( mkIfaceExports )
@@ -557,21 +557,6 @@ instance HasLoc (HsDataDefn GhcRn) where
     -- Only used for data family instances, so we only need rhs
     -- Most probably the rest will be unhelpful anyway
 
-{- Note [Real DataCon Name]
-The typechecker substitutes the conLikeWrapId for the name, but we don't want
-this showing up in the hieFile, so we replace the name in the Id with the
-original datacon name
-See also Note [Data Constructor Naming]
--}
-class HasRealDataConName p where
-  getRealDataCon :: XRecordCon p -> Located (IdP p) -> Located (IdP p)
-
-instance HasRealDataConName GhcRn where
-  getRealDataCon _ n = n
-instance HasRealDataConName GhcTc where
-  getRealDataCon RecordConTc{rcon_con_like = con} (L sp var) =
-    L sp (setVarName var (conLikeName con))
-
 -- | The main worker class
 -- See Note [Updating HieAst for changes in the GHC AST] for more information
 -- on how to add/modify instances for this.
@@ -795,7 +780,6 @@ class ( IsPass p
       , ToHie (RFContext (Located (FieldOcc (GhcPass p))))
       , ToHie (TScoped (LHsWcType (GhcPass (NoGhcTcPass p))))
       , ToHie (TScoped (LHsSigWcType (GhcPass (NoGhcTcPass p))))
-      , HasRealDataConName (GhcPass p)
       )
       => HiePass p where
   hiePass :: HiePassEv p
@@ -1125,11 +1109,15 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where
       ExplicitList _ _ exprs ->
         [ toHie exprs
         ]
-      RecordCon {rcon_ext = mrealcon, rcon_con_name = name, rcon_flds = binds} ->
-        [ toHie $ C Use (getRealDataCon @(GhcPass p) mrealcon name)
-            -- See Note [Real DataCon Name]
+      RecordCon { rcon_con = con, rcon_flds = binds} ->
+        [ toHie $ C Use $ con_name
         , toHie $ RC RecFieldAssign $ binds
         ]
+        where
+          con_name :: Located Name
+          con_name = case hiePass @p of       -- Like ConPat
+                       HieRn -> con
+                       HieTc -> fmap conLikeName con
       RecordUpd {rupd_expr = expr, rupd_flds = upds}->
         [ toHie expr
         , toHie $ map (RC RecFieldAssign) upds
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index bd9edbe01c..dedfd1772b 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -34,8 +34,6 @@ import GHC.Core.Stats   (coreBindsStats, CoreStats(..))
 import GHC.Core.Seq     (seqBinds)
 import GHC.Core.Lint
 import GHC.Core.Rules
-import GHC.Core.PatSyn
-import GHC.Core.ConLike
 import GHC.Core.Opt.Arity   ( exprArity, exprBotStrictness_maybe )
 import GHC.Core.InstEnv
 import GHC.Core.Type     ( tidyTopType )
@@ -194,10 +192,8 @@ mkBootModDetailsTc hsc_env
 
     final_tcs  = filterOut isWiredIn tcs
                  -- See Note [Drop wired-in things]
-    type_env1  = typeEnvFromEntities final_ids final_tcs fam_insts
-    insts'     = mkFinalClsInsts type_env1 insts
-    pat_syns'  = mkFinalPatSyns  type_env1 pat_syns
-    type_env'  = extendTypeEnvWithPatSyns pat_syns' type_env1
+    type_env'  = typeEnvFromEntities final_ids final_tcs pat_syns fam_insts
+    insts'     = mkFinalClsInsts type_env' insts
 
     -- Default methods have their export flag set (isExportedId),
     -- but everything else doesn't (yet), because this is
@@ -221,13 +217,6 @@ lookupFinalId type_env id
 mkFinalClsInsts :: TypeEnv -> [ClsInst] -> [ClsInst]
 mkFinalClsInsts env = map (updateClsInstDFun (lookupFinalId env))
 
-mkFinalPatSyns :: TypeEnv -> [PatSyn] -> [PatSyn]
-mkFinalPatSyns env = map (updatePatSynIds (lookupFinalId env))
-
-extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv
-extendTypeEnvWithPatSyns tidy_patsyns type_env
-  = extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
-
 globaliseAndTidyBootId :: Id -> Id
 -- For a LocalId with an External Name,
 -- makes it into a GlobalId
@@ -430,10 +419,8 @@ tidyProgram hsc_env  (ModGuts { mg_module           = mod
 
               ; final_tcs      = filterOut isWiredIn tcs
                                  -- See Note [Drop wired-in things]
-              ; type_env       = typeEnvFromEntities final_ids final_tcs fam_insts
-              ; tidy_cls_insts = mkFinalClsInsts type_env cls_insts
-              ; tidy_patsyns   = mkFinalPatSyns  type_env patsyns
-              ; tidy_type_env  = extendTypeEnvWithPatSyns tidy_patsyns type_env
+              ; tidy_type_env  = typeEnvFromEntities final_ids final_tcs patsyns fam_insts
+              ; tidy_cls_insts = mkFinalClsInsts tidy_type_env cls_insts
               ; tidy_rules     = tidyRules tidy_env trimmed_rules
 
               ; -- See Note [Injecting implicit bindings]
diff --git a/compiler/GHC/Iface/UpdateIdInfos.hs b/compiler/GHC/Iface/UpdateIdInfos.hs
index 9b8b058745..e37964c51d 100644
--- a/compiler/GHC/Iface/UpdateIdInfos.hs
+++ b/compiler/GHC/Iface/UpdateIdInfos.hs
@@ -45,8 +45,10 @@ updateModDetailsIdInfos cg_infos mod_details =
               } = mod_details
 
     -- type TypeEnv = NameEnv TyThing
-    ~type_env' = mapNameEnv (updateTyThingIdInfos type_env' cg_infos) type_env
-    -- Not strict!
+    type_env' = mapNameEnv (updateTyThingIdInfos type_env' cg_infos) type_env
+    -- NB: Knot-tied! The result, type_env', is passed right back into into
+    -- updateTyThingIdInfos, so that that occurrences of any Ids (e.g. in
+    -- IdInfos, etc) can be looked up in the tidied env
 
     !insts' = strictMap (updateInstIdInfos type_env' cg_infos) insts
     !rules' = strictMap (updateRuleIdInfos type_env') rules
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index c6cb4c4533..862112060c 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -870,9 +870,9 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = name
        ; return $ AConLike . PatSynCon $ patsyn }}}
   where
      mk_doc n = text "Pattern synonym" <+> ppr n
-     tc_pr :: (IfExtName, Bool) -> IfL (Id, Bool)
+     tc_pr :: (IfExtName, Bool) -> IfL (Name, Type, Bool)
      tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
-                        ; return (id, b) }
+                        ; return (nm, idType id, b) }
 
 tcIfaceDecls :: Bool
           -> [(Fingerprint, IfaceDecl)]
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index de94c185ea..bc2aa0c910 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2156,7 +2156,7 @@ mkRdrRecordUpd exp flds
 
 mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
 mkRdrRecordCon con flds
-  = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds }
+  = RecordCon { rcon_ext = noExtField, rcon_con = con, rcon_flds = flds }
 
 mk_rec_fields :: [Located (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
 mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 55618978a5..8f5bec8cad 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -294,14 +294,14 @@ rnExpr (ExplicitSum x alt arity expr)
   = do { (expr', fvs) <- rnLExpr expr
        ; return (ExplicitSum x alt arity expr', fvs) }
 
-rnExpr (RecordCon { rcon_con_name = con_id
+rnExpr (RecordCon { rcon_con = con_id
                   , rcon_flds = rec_binds@(HsRecFields { rec_dotdot = dd }) })
   = do { con_lname@(L _ con_name) <- lookupLocatedOccRn con_id
        ; (flds, fvs)   <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds
        ; (flds', fvss) <- mapAndUnzipM rn_field flds
        ; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd }
        ; return (RecordCon { rcon_ext = noExtField
-                           , rcon_con_name = con_lname, rcon_flds = rec_binds' }
+                           , rcon_con = con_lname, rcon_flds = rec_binds' }
                 , fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
   where
     mk_hs_var l n = HsVar noExtField (L l n)
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index b61d265583..62c6cb218a 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -320,7 +320,7 @@ tcValBinds top_lvl binds sigs thing_inside
                  do { thing <- thing_inside
                        -- See Note [Pattern synonym builders don't yield dependencies]
                        --     in GHC.Rename.Bind
-                    ; patsyn_builders <- mapM tcPatSynBuilderBind patsyns
+                    ; patsyn_builders <- mapM (tcPatSynBuilderBind prag_fn) patsyns
                     ; let extra_binds = [ (NonRecursive, builder)
                                         | builder <- patsyn_builders ]
                     ; return (extra_binds, thing) }
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 4f0fc23af3..2d5a49f2e6 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -569,7 +569,7 @@ tcExpr (HsStatic fvs expr) res_ty
 ************************************************************************
 -}
 
-tcExpr expr@(RecordCon { rcon_con_name = L loc con_name
+tcExpr expr@(RecordCon { rcon_con = L loc con_name
                        , rcon_flds = rbinds }) res_ty
   = do  { con_like <- tcLookupConLike con_name
 
@@ -580,22 +580,19 @@ tcExpr expr@(RecordCon { rcon_con_name = L loc con_name
         ; let arity = conLikeArity con_like
               Right (arg_tys, actual_res_ty) = tcSplitFunTysN arity con_tau
 
-        ; case conLikeWrapId_maybe con_like of {
-               Nothing -> nonBidirectionalErr (conLikeName con_like) ;
-               Just con_id ->
+        ; checkTc (conLikeHasBuilder con_like) $
+          nonBidirectionalErr (conLikeName con_like)
 
-     do { rbinds' <- tcRecordBinds con_like (map scaledThing arg_tys) rbinds
+        ; rbinds' <- tcRecordBinds con_like (map scaledThing arg_tys) rbinds
                    -- It is currently not possible for a record to have
                    -- multiplicities. When they do, `tcRecordBinds` will take
                    -- scaled types instead. Meanwhile, it's safe to take
                    -- `scaledThing` above, as we know all the multiplicities are
                    -- Many.
 
-        ; let rcon_tc = RecordConTc
-                           { rcon_con_like = con_like
-                           , rcon_con_expr = mkHsWrap con_wrap con_expr }
+        ; let rcon_tc = mkHsWrap con_wrap con_expr
               expr' = RecordCon { rcon_ext = rcon_tc
-                                , rcon_con_name = L loc con_id
+                                , rcon_con = L loc con_like
                                 , rcon_flds = rbinds' }
 
         ; ret <- tcWrapResultMono expr expr' actual_res_ty res_ty
@@ -610,7 +607,7 @@ tcExpr expr@(RecordCon { rcon_con_name = L loc con_name
         -- via a new `HoleSort`.  But that seems too much work.
         ; checkMissingFields con_like rbinds arg_tys
 
-        ; return ret } } }
+        ; return ret }
   where
     orig = OccurrenceOf con_name
 
@@ -837,8 +834,8 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
 
         -- Check that we're not dealing with a unidirectional pattern
         -- synonym
-        ; unless (isJust $ conLikeWrapId_maybe con1)
-                 (nonBidirectionalErr (conLikeName con1))
+        ; checkTc (conLikeHasBuilder con1) $
+          nonBidirectionalErr (conLikeName con1)
 
         -- STEP 3    Note [Criteria for update]
         -- Check that each updated field is polymorphic; that is, its type
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 84e391ee50..fa642131c1 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -773,7 +773,7 @@ tc_infer_id id_name
                    | Just (expr, ty) <- patSynBuilderOcc ps
                    -> return (expr, ty)
                    | otherwise
-                   -> nonBidirectionalErr id_name
+                   -> failWithTc (nonBidirectionalErr id_name)
 
              AGlobal (ATyCon ty_con)
                -> fail_tycon global_env ty_con
@@ -855,10 +855,9 @@ check_naughty lbl id
   | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel lbl)
   | otherwise                  = return ()
 
-nonBidirectionalErr :: Outputable name => name -> TcM a
-nonBidirectionalErr name = failWithTc $
-    text "non-bidirectional pattern synonym"
-    <+> quotes (ppr name) <+> text "used in an expression"
+nonBidirectionalErr :: Outputable name => name -> SDoc
+nonBidirectionalErr name = text "non-bidirectional pattern synonym"
+                           <+> quotes (ppr name) <+> text "used in an expression"
 
 {-
 Note [Linear fields generalization]
diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs
index 52a5592d67..588f209377 100644
--- a/compiler/GHC/Tc/TyCl/Build.hs
+++ b/compiler/GHC/Tc/TyCl/Build.hs
@@ -33,7 +33,6 @@ import GHC.Types.Id.Make
 import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Core.Type
-import GHC.Types.Id
 import GHC.Types.SourceText
 import GHC.Tc.Utils.TcType
 import GHC.Core.Multiplicity
@@ -171,7 +170,7 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
 
 ------------------------------------------------------
 buildPatSyn :: Name -> Bool
-            -> (Id,Bool) -> Maybe (Id, Bool)
+            -> PatSynMatcher -> PatSynBuilder
             -> ([InvisTVBinder], ThetaType) -- ^ Univ and req
             -> ([InvisTVBinder], ThetaType) -- ^ Ex and prov
             -> [Type]                       -- ^ Argument types
@@ -179,7 +178,7 @@ buildPatSyn :: Name -> Bool
             -> [FieldLabel]                 -- ^ Field labels for
                                             --   a record pattern synonym
             -> PatSyn
-buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
+buildPatSyn src_name declared_infix matcher@(_, matcher_ty,_) builder
             (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
             pat_ty field_labels
   = -- The assertion checks that the matcher is
@@ -202,7 +201,7 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
              arg_tys pat_ty
              matcher builder field_labels
   where
-    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
+    ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ matcher_ty
     ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau
     (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy (scaledThing cont_sigma)
     (arg_tys1, _) = (tcSplitFunTys cont_tau)
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 2fd0669f91..d9f9be2afc 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -103,13 +103,12 @@ recoverPSB (PSB { psb_id = L _ name
                         ([mkTyVarBinder SpecifiedSpec alphaTyVar], []) ([], [])
                         [] -- Arg tys
                         alphaTy
-                        (matcher_id, True) Nothing
+                        (matcher_name, matcher_ty, True) Nothing
                         []  -- Field labels
        where
          -- The matcher_id is used only by the desugarer, so actually
          -- and error-thunk would probably do just as well here.
-         matcher_id = mkLocalId matcher_name Many $
-                      mkSpecForAllTys [alphaTyVar] alphaTy
+         matcher_ty = mkSpecForAllTys [alphaTyVar] alphaTy
 
 {- Note [Pattern synonym error recovery]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -699,17 +698,17 @@ tc_patsyn_finish lname dir is_infix lpat' prag_fn
            ppr pat_ty
 
        -- Make the 'matcher'
-       ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat' prag_fn
+       ; (matcher, matcher_bind) <- tcPatSynMatcher lname lpat' prag_fn
                                          (binderVars univ_tvs, req_theta, req_ev_binds, req_dicts)
                                          (binderVars ex_tvs, ex_tys, prov_theta, prov_dicts)
                                          (args, arg_tys)
                                          pat_ty
 
        -- Make the 'builder'
-       ; builder_id <- mkPatSynBuilderId dir lname
-                                         univ_tvs req_theta
-                                         ex_tvs   prov_theta
-                                         arg_tys pat_ty prag_fn
+       ; builder <- mkPatSynBuilder dir lname
+                                    univ_tvs req_theta
+                                    ex_tvs   prov_theta
+                                    arg_tys pat_ty
 
        -- Make the PatSyn itself
        ; let patSyn = mkPatSyn (unLoc lname) is_infix
@@ -717,7 +716,7 @@ tc_patsyn_finish lname dir is_infix lpat' prag_fn
                         (ex_tvs, prov_theta)
                         arg_tys
                         pat_ty
-                        matcher_id builder_id
+                        matcher builder
                         field_labels
 
        -- Selectors
@@ -744,7 +743,7 @@ tcPatSynMatcher :: Located Name
                 -> ([TcTyVar], [TcType], ThetaType, [EvTerm])
                 -> ([LHsExpr GhcTc], [TcType])
                 -> TcType
-                -> TcM ((Id, Bool), LHsBinds GhcTc)
+                -> TcM (PatSynMatcher, LHsBinds GhcTc)
 -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
 tcPatSynMatcher (L loc name) lpat prag_fn
                 (univ_tvs, req_theta, req_ev_binds, req_dicts)
@@ -821,7 +820,7 @@ tcPatSynMatcher (L loc name) lpat prag_fn
        ; traceTc "tcPatSynMatcher" (ppr name $$ ppr (idType matcher_id))
        ; traceTc "tcPatSynMatcher" (ppr matcher_bind)
 
-       ; return ((matcher_prag_id, is_unlifted), matcher_bind) }
+       ; return ((matcher_name, matcher_sigma, is_unlifted), matcher_bind) }
 
 mkPatSynRecSelBinds :: PatSyn
                     -> [FieldLabel]  -- ^ Visible field labels
@@ -843,15 +842,14 @@ isUnidirectional ExplicitBidirectional{} = False
 ************************************************************************
 -}
 
-mkPatSynBuilderId :: HsPatSynDir a -> Located Name
-                  -> [InvisTVBinder] -> ThetaType
-                  -> [InvisTVBinder] -> ThetaType
-                  -> [Type] -> Type
-                  -> TcPragEnv
-                  -> TcM (Maybe (Id, Bool))
-mkPatSynBuilderId dir (L _ name)
+mkPatSynBuilder :: HsPatSynDir a -> Located Name
+                -> [InvisTVBinder] -> ThetaType
+                -> [InvisTVBinder] -> ThetaType
+                -> [Type] -> Type
+                -> TcM PatSynBuilder
+mkPatSynBuilder dir (L _ name)
                   univ_bndrs req_theta ex_bndrs prov_theta
-                  arg_tys pat_ty prag_fn
+                  arg_tys pat_ty
   | isUnidirectional dir
   = return Nothing
   | otherwise
@@ -864,44 +862,47 @@ mkPatSynBuilderId dir (L _ name)
                               mkPhiTy theta $
                               mkVisFunTysMany arg_tys $
                               pat_ty
-             builder_id     = mkExportedVanillaId builder_name builder_sigma
-              -- See Note [Exported LocalIds] in GHC.Types.Id
-
-             builder_id'    = modifyIdInfo (`setLevityInfoWithType` pat_ty) builder_id
-             prags          = lookupPragEnv prag_fn name
-             -- See Note [Pragmas for pattern synonyms]
-
-       ; builder_prag_id <- addInlinePrags builder_id' prags
-       ; return (Just (builder_prag_id, need_dummy_arg)) }
+       ; return (Just (builder_name, builder_sigma, need_dummy_arg)) }
 
-tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn
+tcPatSynBuilderBind :: TcPragEnv
+                    -> PatSynBind GhcRn GhcRn
                     -> TcM (LHsBinds GhcTc)
 -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
-tcPatSynBuilderBind (PSB { psb_id = L loc name
-                         , psb_def = lpat
-                         , psb_dir = dir
-                         , psb_args = details })
+tcPatSynBuilderBind prag_fn (PSB { psb_id = ps_lname@(L loc ps_name)
+                                 , psb_def = lpat
+                                 , psb_dir = dir
+                                 , psb_args = details })
   | isUnidirectional dir
   = return emptyBag
 
   | Left why <- mb_match_group       -- Can't invert the pattern
   = setSrcSpan (getLoc lpat) $ failWithTc $
     vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym"
-                 <+> quotes (ppr name) <> colon)
+                 <+> quotes (ppr ps_name) <> colon)
               2 why
          , text "RHS pattern:" <+> ppr lpat ]
 
   | Right match_group <- mb_match_group  -- Bidirectional
-  = do { patsyn <- tcLookupPatSyn name
+  = do { patsyn <- tcLookupPatSyn ps_name
        ; case patSynBuilder patsyn of {
            Nothing -> return emptyBag ;
              -- This case happens if we found a type error in the
              -- pattern synonym, recovered, and put a placeholder
              -- with patSynBuilder=Nothing in the environment
 
-           Just (builder_id, need_dummy_arg) ->  -- Normal case
+           Just (builder_name, builder_ty, need_dummy_arg) ->  -- Normal case
     do { -- Bidirectional, so patSynBuilder returns Just
-         let match_group' | need_dummy_arg = add_dummy_arg match_group
+         let pat_ty = patSynResultType patsyn
+             builder_id = modifyIdInfo (`setLevityInfoWithType` pat_ty) $
+                          mkExportedVanillaId builder_name builder_ty
+                         -- See Note [Exported LocalIds] in GHC.Types.Id
+             prags = lookupPragEnv prag_fn ps_name
+             -- See Note [Pragmas for pattern synonyms]
+             -- Keyed by the PatSyn Name, not the (internal) builder name
+
+       ; builder_id <- addInlinePrags builder_id prags
+
+       ; let match_group' | need_dummy_arg = add_dummy_arg match_group
                           | otherwise      = match_group
 
              bind = FunBind { fun_id      = L loc (idName builder_id)
@@ -909,10 +910,12 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name
                             , fun_ext     = emptyNameSet
                             , fun_tick    = [] }
 
-             sig = completeSigFromId (PatSynCtxt name) builder_id
+             sig = completeSigFromId (PatSynCtxt ps_name) builder_id
 
        ; traceTc "tcPatSynBuilderBind {" $
-         ppr patsyn $$ ppr builder_id <+> dcolon <+> ppr (idType builder_id)
+         vcat [ ppr patsyn
+              , ppr builder_id <+> dcolon <+> ppr (idType builder_id)
+              , ppr prags ]
        ; (builder_binds, _) <- tcPolyCheck emptyPragEnv sig (noLoc bind)
        ; traceTc "tcPatSynBuilderBind }" $ ppr builder_binds
        ; return builder_binds } } }
@@ -924,7 +927,7 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name
     mb_match_group
        = case dir of
            ExplicitBidirectional explicit_mg -> Right explicit_mg
-           ImplicitBidirectional -> fmap mk_mg (tcPatToExpr name args lpat)
+           ImplicitBidirectional -> fmap mk_mg (tcPatToExpr ps_name args lpat)
            Unidirectional -> panic "tcPatSynBuilderBind"
 
     mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
@@ -932,7 +935,7 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name
           where
             builder_args  = [L loc (VarPat noExtField (L loc n))
                             | L loc n <- args]
-            builder_match = mkMatch (mkPrefixFunRhs (L loc name))
+            builder_match = mkMatch (mkPrefixFunRhs ps_lname)
                                     builder_args body
                                     (noLoc (EmptyLocalBinds noExtField))
 
@@ -951,13 +954,12 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name
 
 patSynBuilderOcc :: PatSyn -> Maybe (HsExpr GhcTc, TcSigmaType)
 patSynBuilderOcc ps
-  | Just (builder_id, add_void_arg) <- patSynBuilder ps
+  | Just (_, builder_ty, add_void_arg) <- patSynBuilder ps
   , let builder_expr = HsConLikeOut noExtField (PatSynCon ps)
-        builder_ty   = idType builder_id
   = Just $
     if add_void_arg
-    then ( builder_expr   -- still just return builder_expr; the void# arg is added
-                          -- by dsConLike in the desugarer
+    then ( builder_expr   -- still just return builder_expr; the void# arg
+                          -- is added by dsConLike in the desugarer
          , tcFunResultTy builder_ty )
     else (builder_expr, builder_ty)
 
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs-boot b/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
index 22e5c9fb86..844a4c394d 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
@@ -12,5 +12,6 @@ tcPatSynDecl :: PatSynBind GhcRn GhcRn
              -> TcPragEnv
              -> TcM (LHsBinds GhcTc, TcGblEnv)
 
-tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc)
+tcPatSynBuilderBind :: TcPragEnv -> PatSynBind GhcRn GhcRn
+                    -> TcM (LHsBinds GhcTc)
 
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 5bd1fe490d..76b101c679 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -889,10 +889,10 @@ zonkExpr env (ExplicitList ty wit exprs)
    where zonkWit env Nothing    = return (env, Nothing)
          zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln
 
-zonkExpr env expr@(RecordCon { rcon_ext = ext, rcon_flds = rbinds })
-  = do  { new_con_expr <- zonkExpr env (rcon_con_expr ext)
+zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds })
+  = do  { new_con_expr <- zonkExpr env con_expr
         ; new_rbinds   <- zonkRecFields env rbinds
-        ; return (expr { rcon_ext  = ext { rcon_con_expr = new_con_expr }
+        ; return (expr { rcon_ext  = new_con_expr
                        , rcon_flds = new_rbinds }) }
 
 zonkExpr env (RecordUpd { rupd_flds = rbinds
diff --git a/compiler/GHC/Types/TypeEnv.hs b/compiler/GHC/Types/TypeEnv.hs
index b7811a5721..1b8fcd0b35 100644
--- a/compiler/GHC/Types/TypeEnv.hs
+++ b/compiler/GHC/Types/TypeEnv.hs
@@ -67,12 +67,13 @@ mkTypeEnvWithImplicits things =
     `plusNameEnv`
   mkTypeEnv (concatMap implicitTyThings things)
 
-typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv
-typeEnvFromEntities ids tcs famInsts =
+typeEnvFromEntities :: [Id] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
+typeEnvFromEntities ids tcs patsyns famInsts =
   mkTypeEnv (   map AnId ids
              ++ map ATyCon all_tcs
              ++ concatMap implicitTyConThings all_tcs
              ++ map (ACoAxiom . toBranchedAxiom . famInstAxiom) famInsts
+             ++ map (AConLike . PatSynCon) patsyns
             )
  where
   all_tcs = tcs ++ famInstsRepTyCons famInsts
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index ecc7c9f828..72c16fe22a 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -354,10 +354,9 @@ data HsExpr p
 
   -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | RecordCon
-      { rcon_ext      :: XRecordCon p
-      , rcon_con_name :: LIdP p             -- The constructor name;
-                                            --  not used after type checking
-      , rcon_flds     :: HsRecordBinds p }  -- The fields
+      { rcon_ext  :: XRecordCon p
+      , rcon_con  :: XRec p (ConLikeP p)  -- The constructor
+      , rcon_flds :: HsRecordBinds p }    -- The fields
 
   -- | Record update
   --
diff --git a/utils/haddock b/utils/haddock
-Subproject 44cb750b563b303195cd01fae5db97b5f16382c
+Subproject 1bdbf284b4ba20ee1738b13c4e3414384955f6f