diff options
Diffstat (limited to 'compiler/GHC/Hs/Decls.hs')
| -rw-r--r-- | compiler/GHC/Hs/Decls.hs | 111 |
1 files changed, 25 insertions, 86 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 8a5cc16fbe..c3388b6362 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -154,7 +154,7 @@ data HsDecl p -- (Includes quasi-quotes) | DocD (XDocD p) (DocDecl) -- ^ Documentation comment declaration | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration - | XHsDecl (XXHsDecl p) + | XHsDecl !(XXHsDecl p) type instance XTyClD (GhcPass _) = NoExtField type instance XInstD (GhcPass _) = NoExtField @@ -248,7 +248,7 @@ data HsGroup p hs_docs :: [LDocDecl] } - | XHsGroup (XXHsGroup p) + | XHsGroup !(XXHsGroup p) type instance XCHsGroup (GhcPass _) = NoExtField type instance XXHsGroup (GhcPass _) = NoExtCon @@ -281,7 +281,6 @@ hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) = | L _ ClassDecl{tcdSigs = sigs} <- tyClGroupTyClDecls tyclds , L loc (FixSig _ sig) <- sigs ] -hsGroupTopLevelFixitySigs (XHsGroup nec) = noExtCon nec appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p) @@ -324,7 +323,6 @@ appendGroups hs_warnds = warnds1 ++ warnds2, hs_ruleds = rulds1 ++ rulds2, hs_docs = docs1 ++ docs2 } -appendGroups _ _ = panic "appendGroups" instance (OutputableBndrId p) => Outputable (HsDecl (GhcPass p)) where ppr (TyClD _ dcl) = ppr dcl @@ -341,7 +339,6 @@ instance (OutputableBndrId p) => Outputable (HsDecl (GhcPass p)) where ppr (SpliceD _ dd) = ppr dd ppr (DocD _ doc) = ppr doc ppr (RoleAnnotD _ ra) = ppr ra - ppr (XHsDecl x) = ppr x instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where ppr (HsGroup { hs_valds = val_decls, @@ -376,7 +373,6 @@ instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where vcat_mb _ [] = empty vcat_mb gap (Nothing : ds) = vcat_mb gap ds vcat_mb gap (Just d : ds) = gap $$ d $$ vcat_mb blankLine ds - ppr (XHsGroup x) = ppr x -- | Located Splice Declaration type LSpliceDecl pass = Located (SpliceDecl pass) @@ -387,7 +383,7 @@ data SpliceDecl p (XSpliceDecl p) (Located (HsSplice p)) SpliceExplicitFlag - | XSpliceDecl (XXSpliceDecl p) + | XSpliceDecl !(XXSpliceDecl p) type instance XSpliceDecl (GhcPass _) = NoExtField type instance XXSpliceDecl (GhcPass _) = NoExtCon @@ -395,7 +391,6 @@ type instance XXSpliceDecl (GhcPass _) = NoExtCon instance OutputableBndrId p => Outputable (SpliceDecl (GhcPass p)) where ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f - ppr (XSpliceDecl x) = ppr x {- ************************************************************************ @@ -604,7 +599,7 @@ data TyClDecl pass -- 'ApiAnnotation.AnnRarrow' -- For details on above see note [Api annotations] in ApiAnnotation - | XTyClDecl (XXTyClDecl pass) + | XTyClDecl !(XXTyClDecl pass) type LHsFunDep pass = Located (FunDep (Located (IdP pass))) @@ -707,17 +702,12 @@ tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p)) tyFamInstDeclLName (TyFamInstDecl { tfid_eqn = (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) }) = ln -tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec))) - = noExtCon nec -tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec)) - = noExtCon nec tyClDeclLName :: TyClDecl (GhcPass p) -> Located (IdP (GhcPass p)) tyClDeclLName (FamDecl { tcdFam = fd }) = familyDeclLName fd tyClDeclLName (SynDecl { tcdLName = ln }) = ln tyClDeclLName (DataDecl { tcdLName = ln }) = ln tyClDeclLName (ClassDecl { tcdLName = ln }) = ln -tyClDeclLName (XTyClDecl nec) = noExtCon nec tcdName :: TyClDecl (GhcPass p) -> IdP (GhcPass p) tcdName = unLoc . tyClDeclLName @@ -756,8 +746,6 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) = hsTvbAllKinded tyvars && isJust (hsTyKindSig rhs) hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk (FamDecl { tcdFam = XFamilyDecl nec }) = noExtCon nec -hsDeclHasCusk (XTyClDecl nec) = noExtCon nec -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -793,8 +781,6 @@ instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where <+> pp_vanilla_decl_head lclas tyvars fixity context <+> pprFundeps (map unLoc fds) - ppr (XTyClDecl x) = ppr x - instance OutputableBndrId p => Outputable (TyClGroup (GhcPass p)) where ppr (TyClGroup { group_tyclds = tyclds @@ -808,7 +794,6 @@ instance OutputableBndrId p ppr tyclds $$ ppr roles $$ ppr instds - ppr (XTyClGroup x) = ppr x pp_vanilla_decl_head :: (OutputableBndrId p) => Located (IdP (GhcPass p)) @@ -830,20 +815,14 @@ pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context | otherwise = hsep [ pprPrefixOcc (unLoc thing) , hsep (map (ppr.unLoc) (varl:varsr))] pp_tyvars [] = pprPrefixOcc (unLoc thing) -pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc pprTyClDeclFlavour (ClassDecl {}) = text "class" pprTyClDeclFlavour (SynDecl {}) = text "type" pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }}) = pprFlavour info <+> text "family" -pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl nec }) - = noExtCon nec pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) = ppr nd -pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x }) - = ppr x -pprTyClDeclFlavour (XTyClDecl x) = ppr x {- Note [CUSKs: complete user-supplied kind signatures] @@ -972,7 +951,7 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis] , group_roles :: [LRoleAnnotDecl pass] , group_kisigs :: [LStandaloneKindSig pass] , group_instds :: [LInstDecl pass] } - | XTyClGroup (XXTyClGroup pass) + | XTyClGroup !(XXTyClGroup pass) type instance XCTyClGroup (GhcPass _) = NoExtField type instance XXTyClGroup (GhcPass _) = NoExtCon @@ -1081,7 +1060,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] -- ^ - 'ApiAnnotation.AnnKeywordId' : -- 'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon', -- 'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual' - | XFamilyResultSig (XXFamilyResultSig pass) + | XFamilyResultSig !(XXFamilyResultSig pass) -- For details on above see note [Api annotations] in ApiAnnotation @@ -1106,7 +1085,7 @@ data FamilyDecl pass = FamilyDecl , fdResultSig :: LFamilyResultSig pass -- result signature , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann } - | XFamilyDecl (XXFamilyDecl pass) + | XFamilyDecl !(XXFamilyDecl pass) -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType', -- 'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily', -- 'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP', @@ -1150,7 +1129,6 @@ data FamilyInfo pass familyDeclLName :: FamilyDecl (GhcPass p) -> Located (IdP (GhcPass p)) familyDeclLName (FamilyDecl { fdLName = n }) = n -familyDeclLName (XFamilyDecl nec) = noExtCon nec familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p) familyDeclName = unLoc . familyDeclLName @@ -1162,8 +1140,6 @@ famResultKindSignature (TyVarSig _ bndr) = case unLoc bndr of UserTyVar _ _ -> Nothing KindedTyVar _ _ ki -> Just ki - XTyVarBndr nec -> noExtCon nec -famResultKindSignature (XFamilyResultSig nec) = noExtCon nec -- | Maybe return name of the result type variable resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a)) @@ -1196,7 +1172,6 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon NoSig _ -> empty KindSig _ kind -> dcolon <+> ppr kind TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr - XFamilyResultSig nec -> noExtCon nec pp_inj = case mb_inj of Just (L _ (InjectivityAnn lhs rhs)) -> hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ] @@ -1208,7 +1183,6 @@ pprFamilyDecl top_level (FamilyDecl { fdInfo = info, fdLName = ltycon Nothing -> text ".." Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns ) _ -> (empty, empty) -pprFamilyDecl _ (XFamilyDecl nec) = noExtCon nec pprFlavour :: FamilyInfo pass -> SDoc pprFlavour DataFamily = text "data" @@ -1259,7 +1233,7 @@ data HsDataDefn pass -- The payload of a data type defn -- For details on above see note [Api annotations] in ApiAnnotation } - | XHsDataDefn (XXHsDataDefn pass) + | XHsDataDefn !(XXHsDataDefn pass) type instance XCHsDataDefn (GhcPass _) = NoExtField @@ -1300,7 +1274,7 @@ data HsDerivingClause pass -- -- should produce a derived instance for @C [a] (T b)@. } - | XHsDerivingClause (XXHsDerivingClause pass) + | XHsDerivingClause !(XXHsDerivingClause pass) type instance XCHsDerivingClause (GhcPass _) = NoExtField type instance XXHsDerivingClause (GhcPass _) = NoExtCon @@ -1327,7 +1301,6 @@ instance OutputableBndrId p case dcs of Just (L _ via@ViaStrategy{}) -> (empty, ppr via) _ -> (ppDerivStrategy dcs, empty) - ppr (XHsDerivingClause x) = ppr x -- | Located Standalone Kind Signature type LStandaloneKindSig pass = Located (StandaloneKindSig pass) @@ -1336,14 +1309,13 @@ data StandaloneKindSig pass = StandaloneKindSig (XStandaloneKindSig pass) (Located (IdP pass)) -- Why a single binder? See #16754 (LHsSigType pass) -- Why not LHsSigWcType? See Note [Wildcards in standalone kind signatures] - | XStandaloneKindSig (XXStandaloneKindSig pass) + | XStandaloneKindSig !(XXStandaloneKindSig pass) type instance XStandaloneKindSig (GhcPass p) = NoExtField type instance XXStandaloneKindSig (GhcPass p) = NoExtCon standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p) standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname -standaloneKindSigName (XStandaloneKindSig nec) = noExtCon nec {- Note [Wildcards in standalone kind signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1442,7 +1414,7 @@ data ConDecl pass , con_doc :: Maybe LHsDocString -- ^ A possible Haddock comment. } - | XConDecl (XXConDecl pass) + | XConDecl !(XXConDecl pass) type instance XConDeclGADT (GhcPass _) = NoExtField type instance XConDeclH98 (GhcPass _) = NoExtField @@ -1492,7 +1464,6 @@ type HsConDeclDetails pass getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))] getConNames ConDeclH98 {con_name = name} = [name] getConNames ConDeclGADT {con_names = names} = names -getConNames (XConDecl nec) = noExtCon nec getConArgs :: ConDecl pass -> HsConDeclDetails pass getConArgs d = con_args d @@ -1529,7 +1500,6 @@ pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context Nothing -> empty Just kind -> dcolon <+> ppr kind pp_derivings (L _ ds) = vcat (map ppr ds) -pp_data_defn _ (XHsDataDefn x) = ppr x instance OutputableBndrId p => Outputable (HsDataDefn (GhcPass p)) where @@ -1539,7 +1509,6 @@ instance OutputableBndrId p => Outputable (StandaloneKindSig (GhcPass p)) where ppr (StandaloneKindSig _ v ki) = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki - ppr (XStandaloneKindSig nec) = noExtCon nec instance Outputable NewOrData where ppr NewType = text "newtype" @@ -1585,8 +1554,6 @@ pprConDecl (ConDeclGADT { con_names = cons, con_qvars = qvars ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as) ppr_arrow_chain [] = empty -pprConDecl (XConDecl x) = ppr x - ppr_con_names :: (OutputableBndr a) => [Located a] -> SDoc ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) @@ -1731,7 +1698,7 @@ data FamEqn pass rhs } -- ^ -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual' - | XFamEqn (XXFamEqn pass rhs) + | XFamEqn !(XXFamEqn pass rhs) -- For details on above see note [Api annotations] in ApiAnnotation @@ -1766,7 +1733,7 @@ data ClsInstDecl pass -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose', -- For details on above see note [Api annotations] in ApiAnnotation - | XClsInstDecl (XXClsInstDecl pass) + | XClsInstDecl !(XXClsInstDecl pass) type instance XCClsInstDecl (GhcPass _) = NoExtField type instance XXClsInstDecl (GhcPass _) = NoExtCon @@ -1787,7 +1754,7 @@ data InstDecl pass -- Both class and family instances | TyFamInstD -- type family instance { tfid_ext :: XTyFamInstD pass , tfid_inst :: TyFamInstDecl pass } - | XInstDecl (XXInstDecl pass) + | XInstDecl !(XXInstDecl pass) type instance XClsInstD (GhcPass _) = NoExtField type instance XDataFamInstD (GhcPass _) = NoExtField @@ -1819,8 +1786,6 @@ ppr_fam_inst_eqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ tycon , feqn_fixity = fixity , feqn_rhs = rhs }}) = pprHsFamInstLHS tycon bndrs pats fixity noLHsContext <+> equals <+> ppr rhs -ppr_fam_inst_eqn (HsIB { hsib_body = XFamEqn x }) = ppr x -ppr_fam_inst_eqn (XHsImplicitBndrs x) = ppr x instance OutputableBndrId p => Outputable (DataFamInstDecl (GhcPass p)) where @@ -1840,22 +1805,10 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = <+> pprHsFamInstLHS tycon bndrs pats fixity ctxt -- pp_data_defn pretty-prints the kind sig. See #14817. -pprDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn x))) - = ppr x -pprDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs x)) - = ppr x - pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }}}}) = ppr nd -pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = - FamEqn { feqn_rhs = XHsDataDefn x}}}) - = ppr x -pprDataFamInstFlavour (DataFamInstDecl (HsIB _ (XFamEqn x))) - = ppr x -pprDataFamInstFlavour (DataFamInstDecl (XHsImplicitBndrs x)) - = ppr x pprHsFamInstLHS :: (OutputableBndrId p) => IdP (GhcPass p) @@ -1897,7 +1850,6 @@ instance OutputableBndrId p where top_matter = text "instance" <+> ppOverlapPragma mbOverlap <+> ppr inst_ty - ppr (XClsInstDecl x) = ppr x ppDerivStrategy :: OutputableBndrId p => Maybe (LDerivStrategy (GhcPass p)) -> SDoc @@ -1924,7 +1876,6 @@ instance (OutputableBndrId p) => Outputable (InstDecl (GhcPass p)) where ppr (ClsInstD { cid_inst = decl }) = ppr decl ppr (TyFamInstD { tfid_inst = decl }) = ppr decl ppr (DataFamInstD { dfid_inst = decl }) = ppr decl - ppr (XInstDecl x) = ppr x -- Extract the declarations of associated data types from an instance @@ -1932,12 +1883,11 @@ instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)] instDeclDataFamInsts inst_decls = concatMap do_one inst_decls where + do_one :: LInstDecl (GhcPass p) -> [DataFamInstDecl (GhcPass p)] do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } })) = map unLoc fam_insts do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst] do_one (L _ (TyFamInstD {})) = [] - do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec - do_one (L _ (XInstDecl nec)) = noExtCon nec {- ************************************************************************ @@ -1974,7 +1924,7 @@ data DerivDecl pass = DerivDecl -- For details on above see note [Api annotations] in ApiAnnotation } - | XDerivDecl (XXDerivDecl pass) + | XDerivDecl !(XXDerivDecl pass) type instance XCDerivDecl (GhcPass _) = NoExtField type instance XXDerivDecl (GhcPass _) = NoExtCon @@ -1989,7 +1939,6 @@ instance OutputableBndrId p , text "instance" , ppOverlapPragma o , ppr ty ] - ppr (XDerivDecl x) = ppr x {- ************************************************************************ @@ -2075,7 +2024,7 @@ data DefaultDecl pass -- 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation - | XDefaultDecl (XXDefaultDecl pass) + | XDefaultDecl !(XXDefaultDecl pass) type instance XCDefaultDecl (GhcPass _) = NoExtField type instance XXDefaultDecl (GhcPass _) = NoExtCon @@ -2084,7 +2033,6 @@ instance OutputableBndrId p => Outputable (DefaultDecl (GhcPass p)) where ppr (DefaultDecl _ tys) = text "default" <+> parens (interpp'SP tys) - ppr (XDefaultDecl x) = ppr x {- ************************************************************************ @@ -2122,7 +2070,7 @@ data ForeignDecl pass -- 'ApiAnnotation.AnnDcolon' -- For details on above see note [Api annotations] in ApiAnnotation - | XForeignDecl (XXForeignDecl pass) + | XForeignDecl !(XXForeignDecl pass) {- In both ForeignImport and ForeignExport: @@ -2196,7 +2144,6 @@ instance OutputableBndrId p ppr (ForeignExport { fd_name = n, fd_sig_ty = ty, fd_fe = fexport }) = hang (text "foreign export" <+> ppr fexport <+> ppr n) 2 (dcolon <+> ppr ty) - ppr (XForeignDecl x) = ppr x instance Outputable ForeignImport where ppr (CImport cconv safety mHeader spec (L _ srcText)) = @@ -2246,7 +2193,7 @@ type LRuleDecls pass = Located (RuleDecls pass) data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass , rds_src :: SourceText , rds_rules :: [LRuleDecl pass] } - | XRuleDecls (XXRuleDecls pass) + | XRuleDecls !(XXRuleDecls pass) type instance XCRuleDecls (GhcPass _) = NoExtField type instance XXRuleDecls (GhcPass _) = NoExtCon @@ -2277,7 +2224,7 @@ data RuleDecl pass -- 'ApiAnnotation.AnnClose', -- 'ApiAnnotation.AnnForall','ApiAnnotation.AnnDot', -- 'ApiAnnotation.AnnEqual', - | XRuleDecl (XXRuleDecl pass) + | XRuleDecl !(XXRuleDecl pass) data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS deriving Data @@ -2298,7 +2245,7 @@ type LRuleBndr pass = Located (RuleBndr pass) data RuleBndr pass = RuleBndr (XCRuleBndr pass) (Located (IdP pass)) | RuleBndrSig (XRuleBndrSig pass) (Located (IdP pass)) (LHsSigWcType pass) - | XRuleBndr (XXRuleBndr pass) + | XRuleBndr !(XXRuleBndr pass) -- ^ -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen', -- 'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnClose' @@ -2320,7 +2267,6 @@ instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where , rds_rules = rules }) = pprWithSourceText st (text "{-# RULES") <+> vcat (punctuate semi (map ppr rules)) <+> text "#-}" - ppr (XRuleDecls x) = ppr x instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where ppr (HsRule { rd_name = name @@ -2338,12 +2284,10 @@ instance (OutputableBndrId p) => Outputable (RuleDecl (GhcPass p)) where pp_forall_ty (Just qtvs) = forAllLit <+> fsep (map ppr qtvs) <> dot pp_forall_tm Nothing | null tms = empty pp_forall_tm _ = forAllLit <+> fsep (map ppr tms) <> dot - ppr (XRuleDecl x) = ppr x instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where ppr (RuleBndr _ name) = ppr name ppr (RuleBndrSig _ name ty) = parens (ppr name <> dcolon <> ppr ty) - ppr (XRuleBndr x) = ppr x {- ************************************************************************ @@ -2393,7 +2337,7 @@ data WarnDecls pass = Warnings { wd_ext :: XWarnings pass , wd_src :: SourceText , wd_warnings :: [LWarnDecl pass] } - | XWarnDecls (XXWarnDecls pass) + | XWarnDecls !(XXWarnDecls pass) type instance XWarnings (GhcPass _) = NoExtField type instance XXWarnDecls (GhcPass _) = NoExtCon @@ -2403,7 +2347,7 @@ type LWarnDecl pass = Located (WarnDecl pass) -- | Warning pragma Declaration data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt - | XWarnDecl (XXWarnDecl pass) + | XWarnDecl !(XXWarnDecl pass) type instance XWarning (GhcPass _) = NoExtField type instance XXWarnDecl (GhcPass _) = NoExtCon @@ -2414,14 +2358,12 @@ instance OutputableBndr (IdP (GhcPass p)) ppr (Warnings _ (SourceText src) decls) = text src <+> vcat (punctuate comma (map ppr decls)) <+> text "#-}" ppr (Warnings _ NoSourceText _decls) = panic "WarnDecls" - ppr (XWarnDecls x) = ppr x instance OutputableBndr (IdP (GhcPass p)) => Outputable (WarnDecl (GhcPass p)) where ppr (Warning _ thing txt) = hsep ( punctuate comma (map ppr thing)) <+> ppr txt - ppr (XWarnDecl x) = ppr x {- ************************************************************************ @@ -2445,7 +2387,7 @@ data AnnDecl pass = HsAnnotation -- 'ApiAnnotation.AnnClose' -- For details on above see note [Api annotations] in ApiAnnotation - | XAnnDecl (XXAnnDecl pass) + | XAnnDecl !(XXAnnDecl pass) type instance XHsAnnotation (GhcPass _) = NoExtField type instance XXAnnDecl (GhcPass _) = NoExtCon @@ -2453,7 +2395,6 @@ type instance XXAnnDecl (GhcPass _) = NoExtCon instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where ppr (HsAnnotation _ _ provenance expr) = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"] - ppr (XAnnDecl x) = ppr x -- | Annotation Provenance data AnnProvenance name = ValueAnnProvenance (Located name) @@ -2498,7 +2439,7 @@ data RoleAnnotDecl pass -- 'ApiAnnotation.AnnRole' -- For details on above see note [Api annotations] in ApiAnnotation - | XRoleAnnotDecl (XXRoleAnnotDecl pass) + | XRoleAnnotDecl !(XXRoleAnnotDecl pass) type instance XCRoleAnnotDecl (GhcPass _) = NoExtField type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon @@ -2511,8 +2452,6 @@ instance OutputableBndr (IdP (GhcPass p)) where pp_role Nothing = underscore pp_role (Just r) = ppr r - ppr (XRoleAnnotDecl x) = ppr x roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p) roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name -roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec |