diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2020-08-24 09:37:21 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-08-25 07:38:16 -0400 |
commit | fb77207a23deade8e3f8598c34598535711264cc (patch) | |
tree | 69d735724ad944c454eee0c0f532304c041fabc2 | |
parent | db8793ad417ebfcb57d42e8111674a90706a7918 (diff) | |
download | haskell-fb77207a23deade8e3f8598c34598535711264cc.tar.gz |
Use LIdP rather than (XRec p (IdP p))
This patch mainly just replaces use of
XRec p (IdP p)
with
LIdP p
One slightly more significant change is to parameterise
HsPatSynDetails over the pass rather than the argument type,
so that it's uniform with HsConDeclDetails and HsConPatDetails.
I also got rid of the dead code GHC.Hs.type.conDetailsArgs
But this is all just minor refactoring. No change in functionality.
-rw-r--r-- | compiler/GHC/Hs/Binds.hs | 39 | ||||
-rw-r--r-- | compiler/GHC/Hs/Decls.hs | 32 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs | 21 | ||||
-rw-r--r-- | compiler/GHC/Hs/Extension.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Pat.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Hs/Type.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Hs/Utils.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Match/Constructor.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Utils.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/TyCl/PatSyn.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Zonk.hs | 10 |
13 files changed, 71 insertions, 83 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 327aeea2c0..6b4985bcf0 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -243,7 +243,7 @@ data HsBindLR idL idR -- type Int -> forall a'. a' -> a' -- Notice that the coercion captures the free a'. - fun_id :: XRec idL (IdP idL), -- Note [fun_id in Match] in GHC.Hs.Expr + fun_id :: LIdP idL, -- Note [fun_id in Match] in GHC.Hs.Expr fun_matches :: MatchGroup idR (LHsExpr idR), -- ^ The payload @@ -369,9 +369,8 @@ type instance XXABExport (GhcPass p) = NoExtCon data PatSynBind idL idR = PSB { psb_ext :: XPSB idL idR, -- ^ Post renaming, FVs. -- See Note [Bind free vars] - psb_id :: XRec idL (IdP idL), -- ^ Name of the pattern synonym - psb_args :: HsPatSynDetails (XRec idR (IdP idR)), - -- ^ Formal parameter names + psb_id :: LIdP idL, -- ^ Name of the pattern synonym + psb_args :: HsPatSynDetails idR, -- ^ Formal parameter names psb_def :: LPat idR, -- ^ Right-hand side psb_dir :: HsPatSynDir idR -- ^ Directionality } @@ -893,7 +892,7 @@ data Sig pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation TypeSig (XTypeSig pass) - [XRec pass (IdP pass)] -- LHS of the signature; e.g. f,g,h :: blah + [LIdP pass] -- LHS of the signature; e.g. f,g,h :: blah (LHsSigWcType pass) -- RHS of the signature; can have wildcards -- | A pattern synonym type signature @@ -905,7 +904,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | PatSynSig (XPatSynSig pass) [XRec pass (IdP pass)] (LHsSigType pass) + | PatSynSig (XPatSynSig pass) [LIdP pass] (LHsSigType pass) -- P :: forall a b. Req => Prov => ty -- | A signature for a class method @@ -918,7 +917,7 @@ data Sig pass -- -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault', -- 'GHC.Parser.Annotation.AnnDcolon' - | ClassOpSig (XClassOpSig pass) Bool [XRec pass (IdP pass)] (LHsSigType pass) + | ClassOpSig (XClassOpSig pass) Bool [LIdP pass] (LHsSigType pass) -- | A type signature in generated code, notably the code -- generated for record selectors. We simply record @@ -950,8 +949,8 @@ data Sig pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | InlineSig (XInlineSig pass) - (XRec pass (IdP pass)) -- Function name - InlinePragma -- Never defaultInlinePragma + (LIdP pass) -- Function name + InlinePragma -- Never defaultInlinePragma -- | A specialisation pragma -- @@ -966,7 +965,7 @@ data Sig pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | SpecSig (XSpecSig pass) - (XRec pass (IdP pass)) -- Specialise a function or datatype ... + (LIdP pass) -- Specialise a function or datatype ... [LHsSigType pass] -- ... to these types InlinePragma -- The pragma on SPECIALISE_INLINE form. -- If it's just defaultInlinePragma, then we said @@ -996,7 +995,7 @@ data Sig pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | MinimalSig (XMinimalSig pass) - SourceText (LBooleanFormula (XRec pass (IdP pass))) + SourceText (LBooleanFormula (LIdP pass)) -- Note [Pragma source text] in GHC.Types.Basic -- | A "set cost centre" pragma for declarations @@ -1008,8 +1007,8 @@ data Sig pass -- > {-# SCC funName "cost_centre_name" #-} | SCCFunSig (XSCCFunSig pass) - SourceText -- Note [Pragma source text] in GHC.Types.Basic - (XRec pass (IdP pass)) -- Function name + SourceText -- Note [Pragma source text] in GHC.Types.Basic + (LIdP pass) -- Function name (Maybe (XRec pass StringLiteral)) -- | A complete match pragma -- @@ -1020,8 +1019,8 @@ data Sig pass -- synonym definitions. | CompleteMatchSig (XCompleteMatchSig pass) SourceText - (XRec pass [XRec pass (IdP pass)]) - (Maybe (XRec pass (IdP pass))) + (XRec pass [LIdP pass]) + (Maybe (LIdP pass)) | XSig !(XXSig pass) type instance XTypeSig (GhcPass p) = NoExtField @@ -1041,7 +1040,7 @@ type instance XXSig (GhcPass p) = NoExtCon type LFixitySig pass = XRec pass (FixitySig pass) -- | Fixity Signature -data FixitySig pass = FixitySig (XFixitySig pass) [XRec pass (IdP pass)] Fixity +data FixitySig pass = FixitySig (XFixitySig pass) [LIdP pass] Fixity | XFixitySig !(XXFixitySig pass) type instance XFixitySig (GhcPass p) = NoExtField @@ -1229,14 +1228,14 @@ pprMinimalSig (L _ bf) = ppr (fmap unLoc bf) -} -- | Haskell Pattern Synonym Details -type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg] +type HsPatSynDetails pass = HsConDetails (LIdP pass) [RecordPatSynField (LIdP pass)] -- See Note [Record PatSyn Fields] -- | Record Pattern Synonym Field -data RecordPatSynField a +data RecordPatSynField fld = RecordPatSynField { - recordPatSynSelectorId :: a -- Selector name visible in rest of the file - , recordPatSynPatVar :: a + recordPatSynSelectorId :: fld -- Selector name visible in rest of the file + , recordPatSynPatVar :: fld -- Filled in by renamer, the name used internally -- by the pattern } deriving (Data, Functor) diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index aa4d41b4b9..c4d9ff99c5 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -592,7 +592,7 @@ data TyClDecl pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation SynDecl { tcdSExt :: XSynDecl pass -- ^ Post renameer, FVs - , tcdLName :: XRec pass (IdP pass) -- ^ Type constructor + , tcdLName :: LIdP pass -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables; for an -- associated type these -- include outer binders @@ -609,7 +609,7 @@ data TyClDecl pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation DataDecl { tcdDExt :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs - , tcdLName :: XRec pass (IdP pass) -- ^ Type constructor + , tcdLName :: LIdP pass -- ^ Type constructor , tcdTyVars :: LHsQTyVars pass -- ^ Type variables -- See Note [TyVar binders for associated declarations] , tcdFixity :: LexicalFixity -- ^ Fixity used in the declaration @@ -617,7 +617,7 @@ data TyClDecl pass | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs tcdCtxt :: LHsContext pass, -- ^ Context... - tcdLName :: XRec pass (IdP pass), -- ^ Name of the class + tcdLName :: LIdP pass, -- ^ Name of the class tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables tcdFixity :: LexicalFixity, -- ^ Fixity used in the declaration tcdFDs :: [LHsFunDep pass], -- ^ Functional deps @@ -637,7 +637,7 @@ data TyClDecl pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | XTyClDecl !(XXTyClDecl pass) -type LHsFunDep pass = XRec pass (FunDep (XRec pass (IdP pass))) +type LHsFunDep pass = XRec pass (FunDep (LIdP pass)) data DataDeclRn = DataDeclRn { tcdDataCusk :: Bool -- ^ does this have a CUSK? @@ -1135,7 +1135,7 @@ type LFamilyDecl pass = XRec pass (FamilyDecl pass) data FamilyDecl pass = FamilyDecl { fdExt :: XCFamilyDecl pass , fdInfo :: FamilyInfo pass -- type/data, closed/open - , fdLName :: XRec pass (IdP pass) -- type constructor + , fdLName :: LIdP pass -- type constructor , fdTyVars :: LHsQTyVars pass -- type variables -- See Note [TyVar binders for associated declarations] , fdFixity :: LexicalFixity -- Fixity used in the declaration @@ -1168,7 +1168,7 @@ type LInjectivityAnn pass = XRec pass (InjectivityAnn pass) -- -- This will be represented as "InjectivityAnn `r` [`a`, `c`]" data InjectivityAnn pass - = InjectivityAnn (XRec pass (IdP pass)) [XRec pass (IdP pass)] + = InjectivityAnn (LIdP pass) [LIdP pass] -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : -- 'GHC.Parser.Annotation.AnnRarrow', 'GHC.Parser.Annotation.AnnVbar' @@ -1364,7 +1364,7 @@ type LStandaloneKindSig pass = XRec pass (StandaloneKindSig pass) data StandaloneKindSig pass = StandaloneKindSig (XStandaloneKindSig pass) - (XRec pass (IdP pass)) -- Why a single binder? See #16754 + (LIdP pass) -- Why a single binder? See #16754 (LHsSigType pass) -- Why not LHsSigWcType? See Note [Wildcards in standalone kind signatures] | XStandaloneKindSig !(XXStandaloneKindSig pass) @@ -1435,7 +1435,7 @@ type LConDecl pass = XRec pass (ConDecl pass) data ConDecl pass = ConDeclGADT { con_g_ext :: XConDeclGADT pass - , con_names :: [XRec pass (IdP pass)] + , con_names :: [LIdP pass] -- The following fields describe the type after the '::' -- See Note [GADT abstract syntax] @@ -1458,7 +1458,7 @@ data ConDecl pass | ConDeclH98 { con_ext :: XConDeclH98 pass - , con_name :: XRec pass (IdP pass) + , con_name :: LIdP pass , con_forall :: XRec pass Bool -- ^ True <=> explicit user-written forall @@ -1849,7 +1849,7 @@ type FamInstEqn pass rhs = HsImplicitBndrs pass (FamEqn pass rhs) data FamEqn pass rhs = FamEqn { feqn_ext :: XCFamEqn pass rhs - , feqn_tycon :: XRec pass (IdP pass) + , feqn_tycon :: LIdP pass , feqn_bndrs :: Maybe [LHsTyVarBndr () pass] -- ^ Optional quantified type vars , feqn_pats :: HsTyPats pass , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration @@ -2214,13 +2214,13 @@ type LForeignDecl pass = XRec pass (ForeignDecl pass) data ForeignDecl pass = ForeignImport { fd_i_ext :: XForeignImport pass -- Post typechecker, rep_ty ~ sig_ty - , fd_name :: XRec pass (IdP pass) -- defines this name + , fd_name :: LIdP pass -- defines this name , fd_sig_ty :: LHsSigType pass -- sig_ty , fd_fi :: ForeignImport } | ForeignExport { fd_e_ext :: XForeignExport pass -- Post typechecker, rep_ty ~ sig_ty - , fd_name :: XRec pass (IdP pass) -- uses this name + , fd_name :: LIdP pass -- uses this name , fd_sig_ty :: LHsSigType pass -- sig_ty , fd_fe :: ForeignExport } -- ^ @@ -2402,8 +2402,8 @@ type LRuleBndr pass = XRec pass (RuleBndr pass) -- | Rule Binder data RuleBndr pass - = RuleBndr (XCRuleBndr pass) (XRec pass (IdP pass)) - | RuleBndrSig (XRuleBndrSig pass) (XRec pass (IdP pass)) (HsPatSigType pass) + = RuleBndr (XCRuleBndr pass) (LIdP pass) + | RuleBndrSig (XRuleBndrSig pass) (LIdP pass) (HsPatSigType pass) | XRuleBndr !(XXRuleBndr pass) -- ^ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', @@ -2505,7 +2505,7 @@ type instance XXWarnDecls (GhcPass _) = NoExtCon type LWarnDecl pass = XRec pass (WarnDecl pass) -- | Warning pragma Declaration -data WarnDecl pass = Warning (XWarning pass) [XRec pass (IdP pass)] WarningTxt +data WarnDecl pass = Warning (XWarning pass) [LIdP pass] WarningTxt | XWarnDecl !(XXWarnDecl pass) type instance XWarning (GhcPass _) = NoExtField @@ -2592,7 +2592,7 @@ type LRoleAnnotDecl pass = XRec pass (RoleAnnotDecl pass) -- | Role Annotation Declaration data RoleAnnotDecl pass = RoleAnnotDecl (XCRoleAnnotDecl pass) - (XRec pass (IdP pass)) -- type constructor + (LIdP pass) -- type constructor [XRec pass (Maybe Role)] -- optional annotations -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType', -- 'GHC.Parser.Annotation.AnnRole' diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 806ee1d3a7..e7b904736d 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -242,9 +242,8 @@ is Less Cool because -- | A Haskell expression. data HsExpr p = HsVar (XVar p) - (XRec p (IdP p)) -- ^ Variable - - -- See Note [Located RdrNames] + (LIdP p) -- ^ Variable + -- See Note [Located RdrNames] | HsUnboundVar (XUnboundVar p) OccName -- ^ Unbound variable; also used for "holes" @@ -439,7 +438,7 @@ data HsExpr p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | RecordCon { rcon_ext :: XRecordCon p - , rcon_con_name :: XRec p (IdP p) -- The constructor name; + , rcon_con_name :: LIdP p -- The constructor name; -- not used after type checking , rcon_flds :: HsRecordBinds p } -- The fields @@ -2987,7 +2986,7 @@ matchSeparator ThPatSplice = panic "unused" matchSeparator ThPatQuote = panic "unused" matchSeparator PatSyn = panic "unused" -pprMatchContext :: Outputable (IdP p) +pprMatchContext :: (Outputable (IdP p), UnXRec p) => HsMatchContext p -> SDoc pprMatchContext ctxt | want_an ctxt = text "an" <+> pprMatchContextNoun ctxt @@ -2997,11 +2996,11 @@ pprMatchContext ctxt want_an ProcExpr = True want_an _ = False -pprMatchContextNoun :: Outputable (IdP id) - => HsMatchContext id -> SDoc -pprMatchContextNoun (FunRhs {mc_fun=L _ fun}) +pprMatchContextNoun :: forall p. (Outputable (IdP p), UnXRec p) + => HsMatchContext p -> SDoc +pprMatchContextNoun (FunRhs {mc_fun=fun}) = text "equation for" - <+> quotes (ppr fun) + <+> quotes (ppr (unXRec @p fun)) pprMatchContextNoun CaseAlt = text "case alternative" pprMatchContextNoun IfAlt = text "multi-way if alternative" pprMatchContextNoun RecUpd = text "record-update construct" @@ -3016,8 +3015,8 @@ pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in" pprMatchContextNoun PatSyn = text "pattern synonym declaration" ----------------- -pprAStmtContext, pprStmtContext :: Outputable (IdP id) - => HsStmtContext id -> SDoc +pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p) + => HsStmtContext p -> SDoc pprAStmtContext ctxt = article <+> pprStmtContext ctxt where pp_an = text "an" diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs index 4f7ba57552..072e3cc8a9 100644 --- a/compiler/GHC/Hs/Extension.hs +++ b/compiler/GHC/Hs/Extension.hs @@ -307,7 +307,7 @@ type family IdGhcP pass where IdGhcP 'Renamed = Name IdGhcP 'Typechecked = Id -type LIdP p = Located (IdP p) +type LIdP p = XRec p (IdP p) -- | Marks that a field uses the GhcRn variant even when the pass -- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index 1bf9715d18..62de0ab182 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -93,7 +93,7 @@ data Pat p -- AZ:TODO above comment needs to be updated | VarPat (XVarPat p) - (XRec p (IdP p)) -- ^ Variable Pattern + (LIdP p) -- ^ Variable Pattern -- See Note [Located RdrNames] in GHC.Hs.Expr | LazyPat (XLazyPat p) @@ -103,7 +103,7 @@ data Pat p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | AsPat (XAsPat p) - (XRec p (IdP p)) (LPat p) -- ^ As pattern + (LIdP p) (LPat p) -- ^ As pattern -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt' -- For details on above see note [Api annotations] in GHC.Parser.Annotation @@ -224,7 +224,7 @@ data Pat p -- For details on above see note [Api annotations] in GHC.Parser.Annotation | NPlusKPat (XNPlusKPat p) -- Type of overall pattern - (XRec p (IdP p)) -- n+k pattern + (LIdP p) -- n+k pattern (XRec p (HsOverLit p)) -- It'll always be an HsIntegral (HsOverLit p) -- See Note [NPlusK patterns] in GHC.Tc.Gen.Pat -- NB: This could be (PostTc ...), but that induced a @@ -313,7 +313,7 @@ type instance XXPat GhcTc = CoPat type family ConLikeP x type instance ConLikeP GhcPs = RdrName -- IdP GhcPs -type instance ConLikeP GhcRn = Name -- IdP GhcRn +type instance ConLikeP GhcRn = Name -- IdP GhcRn type instance ConLikeP GhcTc = ConLike -- --------------------------------------------------------------------- diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 99d7ef1117..c6960c9c77 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -73,7 +73,6 @@ module GHC.Hs.Type ( mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy, ignoreParens, hsSigType, hsSigWcType, hsPatSigType, hsTyKindSig, - hsConDetailsArgs, setHsTyVarBndrFlag, hsTyVarBndrFlag, -- Printing @@ -638,13 +637,13 @@ data HsTyVarBndr flag pass = UserTyVar -- no explicit kinding (XUserTyVar pass) flag - (XRec pass (IdP pass)) + (LIdP pass) -- See Note [Located RdrNames] in GHC.Hs.Expr | KindedTyVar (XKindedTyVar pass) flag - (XRec pass (IdP pass)) + (LIdP pass) (LHsKind pass) -- The user-supplied kind signature -- ^ -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen', @@ -705,7 +704,7 @@ data HsType pass | HsTyVar (XTyVar pass) PromotionFlag -- Whether explicitly promoted, -- for the pretty printer - (XRec pass (IdP pass)) + (LIdP pass) -- Type variable, type constructor, or data constructor -- see Note [Promotions (HsTyVar)] -- See Note [Located RdrNames] in GHC.Hs.Expr @@ -755,7 +754,7 @@ data HsType pass -- For details on above see note [Api annotations] in GHC.Parser.Annotation | HsOpTy (XOpTy pass) - (LHsType pass) (XRec pass (IdP pass)) (LHsType pass) + (LHsType pass) (LIdP pass) (LHsType pass) -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : None -- For details on above see note [Api annotations] in GHC.Parser.Annotation @@ -1116,14 +1115,6 @@ instance (Outputable arg, Outputable rec) ppr (RecCon rec) = text "RecCon:" <+> ppr rec ppr (InfixCon l r) = text "InfixCon:" <+> ppr [l, r] -hsConDetailsArgs :: - HsConDetails (LHsType (GhcPass p)) (Located [LConDeclField (GhcPass p)]) - -> [LHsType (GhcPass p)] -hsConDetailsArgs details = case details of - InfixCon a b -> [a,b] - PrefixCon xs -> xs - RecCon r -> map (cd_fld_type . unLoc) (unLoc r) - {- Note [ConDeclField passs] ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 01e882cacd..5adcc140e2 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -777,7 +777,7 @@ mkVarBind var rhs = L (getLoc rhs) $ VarBind { var_ext = noExtField, var_id = var, var_rhs = rhs } -mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName) +mkPatSynBind :: Located RdrName -> HsPatSynDetails GhcPs -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs mkPatSynBind name details lpat dir = PatSynBind noExtField psb where @@ -990,7 +990,7 @@ collect_bind omitPatSyn (PatSynBind _ (PSB { psb_id = ps })) acc collect_bind _ (PatSynBind _ (XPatSynBind _)) acc = acc collect_bind _ (XHsBindsLR _) acc = acc -collectMethodBinders :: forall idL idR. UnXRec idL => LHsBindsLR idL idR -> [XRec idL (IdP idL)] +collectMethodBinders :: forall idL idR. UnXRec idL => LHsBindsLR idL idR -> [LIdP idL] -- ^ Used exclusively for the bindings of an instance decl which are all -- 'FunBinds' collectMethodBinders binds = foldr (get . unXRec @idL) [] binds @@ -1173,7 +1173,7 @@ hsLTyClDeclBinders (L loc (DataDecl { tcdLName = (L _ name) ------------------- -hsForeignDeclsBinders :: forall pass. (UnXRec pass, MapXRec pass) => [LForeignDecl pass] -> [XRec pass (IdP pass)] +hsForeignDeclsBinders :: forall pass. (UnXRec pass, MapXRec pass) => [LForeignDecl pass] -> [LIdP pass] -- ^ See Note [SrcSpan for binders] hsForeignDeclsBinders foreign_decls = [ mapXRec @pass (const $ unXRec @pass n) fi diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs index 107c072580..c04f569cf9 100644 --- a/compiler/GHC/HsToCore/Match/Constructor.hs +++ b/compiler/GHC/HsToCore/Match/Constructor.hs @@ -126,7 +126,7 @@ matchPatSyn (var :| vars) ty eqns PatSynCon psyn -> alt{ alt_pat = psyn } _ -> panic "matchPatSyn: not PatSynCon" -type ConArgPats = HsConDetails (LPat GhcTc) (HsRecFields GhcTc (LPat GhcTc)) +type ConArgPats = HsConPatDetails GhcTc matchOneConLike :: [Id] -> Type diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 5710521665..ade2c08675 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -1840,7 +1840,7 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn ; patSynD'' <- wrapGenArgSyms args ss patSynD' ; return (loc, patSynD'') } where - mkGenArgSyms :: HsPatSynDetails (Located Name) -> MetaM [GenSymBind] + mkGenArgSyms :: HsPatSynDetails GhcRn -> MetaM [GenSymBind] -- for Record Pattern Synonyms we want to conflate the selector -- and the pattern-only names in order to provide a nicer TH -- API. Whereas inside GHC, record pattern synonym selectors and @@ -1859,7 +1859,7 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn = [ (pat, id) | (sel, id) <- genSyms, (sel', pat) <- selsPats , sel == sel' ] - wrapGenArgSyms :: HsPatSynDetails (Located Name) + wrapGenArgSyms :: HsPatSynDetails GhcRn -> [GenSymBind] -> Core (M TH.Dec) -> MetaM (Core (M TH.Dec)) wrapGenArgSyms (RecCon _) _ dec = return dec wrapGenArgSyms _ ss dec = wrapGenSyms ss dec @@ -1872,7 +1872,7 @@ repPatSynD :: Core TH.Name repPatSynD (MkC syn) (MkC args) (MkC dir) (MkC pat) = rep2 patSynDName [syn, args, dir, pat] -repPatSynArgs :: HsPatSynDetails (Located Name) -> MetaM (Core (M TH.PatSynArgs)) +repPatSynArgs :: HsPatSynDetails GhcRn -> MetaM (Core (M TH.PatSynArgs)) repPatSynArgs (PrefixCon args) = do { args' <- repList nameTyConName lookupLOcc args ; repPrefixPatSynArgs args' } diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs index 4f0da28586..b4d1b1b761 100644 --- a/compiler/GHC/HsToCore/Utils.hs +++ b/compiler/GHC/HsToCore/Utils.hs @@ -900,7 +900,7 @@ CPR-friendly. This matters a lot: if you don't get it right, you lose the tail call property. For example, see #3403. -} -dsHandleMonadicFailure :: Outputable (IdP p) => HsStmtContext p -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr +dsHandleMonadicFailure :: HsStmtContext GhcRn -> LPat GhcTc -> MatchResult CoreExpr -> FailOperator GhcTc -> DsM CoreExpr -- In a do expression, pattern-match failure just calls -- the monadic 'fail' rather than throwing an exception dsHandleMonadicFailure ctx pat match m_fail_op = @@ -921,8 +921,9 @@ dsHandleMonadicFailure ctx pat match m_fail_op = fail_expr <- dsSyntaxExpr fail_op [fail_msg] body fail_expr -mk_fail_msg :: Outputable (IdP p) => DynFlags -> HsStmtContext p -> Located e -> String -mk_fail_msg dflags ctx pat = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx <+> text "at" <+> ppr (getLoc pat) +mk_fail_msg :: DynFlags -> HsStmtContext GhcRn -> Located e -> String +mk_fail_msg dflags ctx pat + = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx <+> text "at" <+> ppr (getLoc pat) {- ********************************************************************* * * diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 0cd8f29cac..412bee17a6 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1491,7 +1491,7 @@ pattern_synonym_decl :: { LHsDecl GhcPs } (as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) ) }} -pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails (Located RdrName), [AddAnn]) } +pattern_synonym_lhs :: { (Located RdrName, HsPatSynDetails GhcPs, [AddAnn]) } : con vars0 { ($1, PrefixCon $2, []) } | varid conop varid { ($2, InfixCon $1 $3, []) } | con '{' cvars1 '}' { ($1, RecCon $3, [moc $2, mcc $4] ) } diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 0be256c93f..a99ab10404 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -558,7 +558,7 @@ a pattern synonym. What about the /building/ side? a bad idea. -} -collectPatSynArgInfo :: HsPatSynDetails (Located Name) +collectPatSynArgInfo :: HsPatSynDetails GhcRn -> ([Name], [Name], Bool) collectPatSynArgInfo details = case details of diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index cf25fea60c..296dfa79a4 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -626,8 +626,8 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id , psb_dir = dir' } } zonkPatSynDetails :: ZonkEnv - -> HsPatSynDetails (Located TcId) - -> HsPatSynDetails (Located Id) + -> HsPatSynDetails GhcTc + -> HsPatSynDetails GhcTc zonkPatSynDetails env (PrefixCon as) = PrefixCon (map (zonkLIdOcc env) as) zonkPatSynDetails env (InfixCon a1 a2) @@ -1450,10 +1450,8 @@ zonk_pat env (XPat (CoPat co_fn pat ty)) zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat) --------------------------- -zonkConStuff :: ZonkEnv - -> HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc)) - -> TcM (ZonkEnv, - HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc))) +zonkConStuff :: ZonkEnv -> HsConPatDetails GhcTc + -> TcM (ZonkEnv, HsConPatDetails GhcTc) zonkConStuff env (PrefixCon pats) = do { (env', pats') <- zonkPats env pats ; return (env', PrefixCon pats') } |