diff options
Diffstat (limited to 'compiler/hsSyn/HsDecls.hs')
| -rw-r--r-- | compiler/hsSyn/HsDecls.hs | 89 |
1 files changed, 49 insertions, 40 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index d4742f5..69ca093 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -159,7 +159,7 @@ type instance XRuleD (GhcPass _) = NoExt type instance XSpliceD (GhcPass _) = NoExt type instance XDocD (GhcPass _) = NoExt type instance XRoleAnnotD (GhcPass _) = NoExt -type instance XXHsDecl (GhcPass _) = NoExt +type instance XXHsDecl (GhcPass _) = NoExtCon -- NB: all top-level fixity decls are contained EITHER -- EITHER SigDs @@ -207,7 +207,7 @@ data HsGroup p | XHsGroup (XXHsGroup p) type instance XCHsGroup (GhcPass _) = NoExt -type instance XXHsGroup (GhcPass _) = NoExt +type instance XXHsGroup (GhcPass _) = NoExtCon emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p) @@ -330,7 +330,7 @@ data SpliceDecl p | XSpliceDecl (XXSpliceDecl p) type instance XSpliceDecl (GhcPass _) = NoExt -type instance XXSpliceDecl (GhcPass _) = NoExt +type instance XXSpliceDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (SpliceDecl p) where @@ -588,7 +588,7 @@ type instance XClassDecl GhcPs = NoExt type instance XClassDecl GhcRn = NameSet -- FVs type instance XClassDecl GhcTc = NameSet -- FVs -type instance XXTyClDecl (GhcPass _) = NoExt +type instance XXTyClDecl (GhcPass _) = NoExtCon -- Simple classifiers for TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -639,17 +639,21 @@ isDataFamilyDecl _other = False -- Dealing with names -tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass) +tyFamInstDeclName :: ( XXFamEqn pass (HsTyPats pass) (LHsType pass) ~ NoExtCon + , XXHsImplicitBndrs pass (FamEqn pass (HsTyPats pass) (LHsType pass)) ~ NoExtCon ) + => TyFamInstDecl pass -> IdP pass tyFamInstDeclName = unLoc . tyFamInstDeclLName -tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass) +tyFamInstDeclLName :: ( XXFamEqn pass (HsTyPats pass) (LHsType pass) ~ NoExtCon + , XXHsImplicitBndrs pass (FamEqn pass (HsTyPats pass) (LHsType pass)) ~ NoExtCon ) + => TyFamInstDecl pass -> Located (IdP pass) tyFamInstDeclLName (TyFamInstDecl { tfid_eqn = (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) }) = ln -tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _))) - = panic "tyFamInstDeclLName" -tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _)) - = panic "tyFamInstDeclLName" +tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec))) + = noExtCon nec +tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec)) + = noExtCon nec tyClDeclLName :: TyClDecl pass -> Located (IdP pass) tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln @@ -693,7 +697,7 @@ hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs }) _ -> False hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars -hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk" +hsDeclHasCusk (XTyClDecl nec) = noExtCon nec -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -899,7 +903,7 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis] | XTyClGroup (XXTyClGroup pass) type instance XCTyClGroup (GhcPass _) = NoExt -type instance XXTyClGroup (GhcPass _) = NoExt +type instance XXTyClGroup (GhcPass _) = NoExtCon emptyTyClGroup :: TyClGroup (GhcPass p) @@ -1022,7 +1026,7 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig] type instance XNoSig (GhcPass _) = NoExt type instance XCKindSig (GhcPass _) = NoExt type instance XTyVarSig (GhcPass _) = NoExt -type instance XXFamilyResultSig (GhcPass _) = NoExt +type instance XXFamilyResultSig (GhcPass _) = NoExtCon -- | Located type Family Declaration @@ -1050,7 +1054,7 @@ data FamilyDecl pass = FamilyDecl -- For details on above see note [Api annotations] in ApiAnnotation type instance XCFamilyDecl (GhcPass _) = NoExt -type instance XXFamilyDecl (GhcPass _) = NoExt +type instance XXFamilyDecl (GhcPass _) = NoExtCon -- | Located Injectivity Annotation @@ -1082,7 +1086,7 @@ data FamilyInfo pass -- See Note [CUSKs: complete user-supplied kind signatures] famDeclHasCusk :: Bool -- ^ True <=> this is an associated type family, -- and the parent class has /no/ CUSK - -> FamilyDecl pass + -> FamilyDecl (GhcPass pass) -> Bool famDeclHasCusk assoc_with_no_cusk (FamilyDecl { fdInfo = fam_info @@ -1095,7 +1099,7 @@ famDeclHasCusk assoc_with_no_cusk -- Un-associated open type/data families have CUSKs -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ (XFamilyDecl {}) = panic "famDeclHasCusk" +famDeclHasCusk _ (XFamilyDecl nec) = noExtCon nec -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool @@ -1104,7 +1108,8 @@ hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False hasReturnKindSignature _ = True -- | Maybe return name of the result type variable -resultVariableName :: FamilyResultSig a -> Maybe (IdP a) +resultVariableName :: (XXTyVarBndr a ~ NoExtCon) + => FamilyResultSig a -> Maybe (IdP a) resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig resultVariableName _ = Nothing @@ -1198,7 +1203,7 @@ data HsDataDefn pass -- The payload of a data type defn | XHsDataDefn (XXHsDataDefn pass) type instance XCHsDataDefn (GhcPass _) = NoExt -type instance XXHsDataDefn (GhcPass _) = NoExt +type instance XXHsDataDefn (GhcPass _) = NoExtCon -- | Haskell Deriving clause type HsDeriving pass = Located [LHsDerivingClause pass] @@ -1238,7 +1243,7 @@ data HsDerivingClause pass | XHsDerivingClause (XXHsDerivingClause pass) type instance XCHsDerivingClause (GhcPass _) = NoExt -type instance XXHsDerivingClause (GhcPass _) = NoExt +type instance XXHsDerivingClause (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDerivingClause p) where @@ -1349,7 +1354,7 @@ data ConDecl pass type instance XConDeclGADT (GhcPass _) = NoExt type instance XConDeclH98 (GhcPass _) = NoExt -type instance XXConDecl (GhcPass _) = NoExt +type instance XXConDecl (GhcPass _) = NoExtCon {- Note [GADT abstract syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1392,10 +1397,11 @@ There's a wrinkle in ConDeclGADT type HsConDeclDetails pass = HsConDetails (LBangType pass) (Located [LConDeclField pass]) -getConNames :: ConDecl pass -> [Located (IdP pass)] +getConNames :: (XXConDecl pass ~ NoExtCon) + => ConDecl pass -> [Located (IdP pass)] getConNames ConDeclH98 {con_name = name} = [name] getConNames ConDeclGADT {con_names = names} = names -getConNames XConDecl {} = panic "getConNames" +getConNames (XConDecl nec) = noExtCon nec getConArgs :: ConDecl pass -> HsConDeclDetails pass getConArgs d = con_args d @@ -1642,7 +1648,7 @@ data FamEqn pass pats rhs -- For details on above see note [Api annotations] in ApiAnnotation type instance XCFamEqn (GhcPass _) p r = NoExt -type instance XXFamEqn (GhcPass _) p r = NoExt +type instance XXFamEqn (GhcPass _) p r = NoExtCon ----------------- Class instances ------------- @@ -1675,7 +1681,7 @@ data ClsInstDecl pass | XClsInstDecl (XXClsInstDecl pass) type instance XCClsInstDecl (GhcPass _) = NoExt -type instance XXClsInstDecl (GhcPass _) = NoExt +type instance XXClsInstDecl (GhcPass _) = NoExtCon ----------------- Instances of all kinds ------------- @@ -1698,7 +1704,7 @@ data InstDecl pass -- Both class and family instances type instance XClsInstD (GhcPass _) = NoExt type instance XDataFamInstD (GhcPass _) = NoExt type instance XTyFamInstD (GhcPass _) = NoExt -type instance XXInstDecl (GhcPass _) = NoExt +type instance XXInstDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyFamInstDecl p) where @@ -1840,7 +1846,9 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where -- Extract the declarations of associated data types from an instance -instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass] +instDeclDataFamInsts :: ( XXClsInstDecl pass ~ NoExtCon + , XXInstDecl pass ~ NoExtCon ) + => [LInstDecl pass] -> [DataFamInstDecl pass] instDeclDataFamInsts inst_decls = concatMap do_one inst_decls where @@ -1848,8 +1856,8 @@ instDeclDataFamInsts inst_decls = map unLoc fam_insts do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst] do_one (L _ (TyFamInstD {})) = [] - do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts" - do_one (L _ (XInstDecl _)) = panic "instDeclDataFamInsts" + do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec + do_one (L _ (XInstDecl nec)) = noExtCon nec {- ************************************************************************ @@ -1889,7 +1897,7 @@ data DerivDecl pass = DerivDecl | XDerivDecl (XXDerivDecl pass) type instance XCDerivDecl (GhcPass _) = NoExt -type instance XXDerivDecl (GhcPass _) = NoExt +type instance XXDerivDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (DerivDecl p) where @@ -1972,7 +1980,7 @@ data DefaultDecl pass | XDefaultDecl (XXDefaultDecl pass) type instance XCDefaultDecl (GhcPass _) = NoExt -type instance XXDefaultDecl (GhcPass _) = NoExt +type instance XXDefaultDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (DefaultDecl p) where @@ -2035,7 +2043,7 @@ type instance XForeignExport GhcPs = NoExt type instance XForeignExport GhcRn = NoExt type instance XForeignExport GhcTc = Coercion -type instance XXForeignDecl (GhcPass _) = NoExt +type instance XXForeignDecl (GhcPass _) = NoExtCon -- Specification Of an imported external entity in dependence on the calling -- convention @@ -2143,7 +2151,7 @@ data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass | XRuleDecls (XXRuleDecls pass) type instance XCRuleDecls (GhcPass _) = NoExt -type instance XXRuleDecls (GhcPass _) = NoExt +type instance XXRuleDecls (GhcPass _) = NoExtCon -- | Located Rule Declaration type LRuleDecl pass = Located (RuleDecl pass) @@ -2180,7 +2188,7 @@ type instance XHsRule GhcPs = NoExt type instance XHsRule GhcRn = HsRuleRn type instance XHsRule GhcTc = HsRuleRn -type instance XXRuleDecl (GhcPass _) = NoExt +type instance XXRuleDecl (GhcPass _) = NoExtCon flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls @@ -2201,7 +2209,7 @@ data RuleBndr pass type instance XCRuleBndr (GhcPass _) = NoExt type instance XRuleBndrSig (GhcPass _) = NoExt -type instance XXRuleBndr (GhcPass _) = NoExt +type instance XXRuleBndr (GhcPass _) = NoExtCon collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass] collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs] @@ -2290,7 +2298,7 @@ data WarnDecls pass = Warnings { wd_ext :: XWarnings pass | XWarnDecls (XXWarnDecls pass) type instance XWarnings (GhcPass _) = NoExt -type instance XXWarnDecls (GhcPass _) = NoExt +type instance XXWarnDecls (GhcPass _) = NoExtCon -- | Located Warning pragma Declaration type LWarnDecl pass = Located (WarnDecl pass) @@ -2300,7 +2308,7 @@ data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt | XWarnDecl (XXWarnDecl pass) type instance XWarning (GhcPass _) = NoExt -type instance XXWarnDecl (GhcPass _) = NoExt +type instance XXWarnDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass,OutputableBndr (IdP p)) @@ -2342,7 +2350,7 @@ data AnnDecl pass = HsAnnotation | XAnnDecl (XXAnnDecl pass) type instance XHsAnnotation (GhcPass _) = NoExt -type instance XXAnnDecl (GhcPass _) = NoExt +type instance XXAnnDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where ppr (HsAnnotation _ _ provenance expr) @@ -2395,7 +2403,7 @@ data RoleAnnotDecl pass | XRoleAnnotDecl (XXRoleAnnotDecl pass) type instance XCRoleAnnotDecl (GhcPass _) = NoExt -type instance XXRoleAnnotDecl (GhcPass _) = NoExt +type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndr (IdP p)) => Outputable (RoleAnnotDecl p) where @@ -2407,6 +2415,7 @@ instance (p ~ GhcPass pass, OutputableBndr (IdP p)) pp_role (Just r) = ppr r ppr (XRoleAnnotDecl x) = ppr x -roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass) +roleAnnotDeclName :: (XXRoleAnnotDecl pass ~ NoExtCon) + => RoleAnnotDecl pass -> IdP pass roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name -roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName" +roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec |