diff options
Diffstat (limited to 'compiler/hsSyn/HsTypes.hs')
| -rw-r--r-- | compiler/hsSyn/HsTypes.hs | 77 |
1 files changed, 44 insertions, 33 deletions
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 9bb73c3..0649ee3 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -329,7 +329,7 @@ type instance XHsQTvs GhcPs = NoExt type instance XHsQTvs GhcRn = HsQTvsRn type instance XHsQTvs GhcTc = HsQTvsRn -type instance XXLHsQTyVars (GhcPass _) = NoExt +type instance XXLHsQTyVars (GhcPass _) = NoExtCon mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs } @@ -367,7 +367,7 @@ type instance XHsIB GhcPs _ = NoExt type instance XHsIB GhcRn _ = [Name] type instance XHsIB GhcTc _ = [Name] -type instance XXHsImplicitBndrs (GhcPass _) _ = NoExt +type instance XXHsImplicitBndrs (GhcPass _) _ = NoExtCon -- | Haskell Wildcard Binders data HsWildCardBndrs pass thing @@ -389,7 +389,7 @@ type instance XHsWC GhcPs b = NoExt type instance XHsWC GhcRn b = [Name] type instance XHsWC GhcTc b = [Name] -type instance XXHsWildCardBndrs (GhcPass _) b = NoExt +type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon -- | Located Haskell Signature Type type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only @@ -402,11 +402,13 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both -- See Note [Representing type signatures] -hsImplicitBody :: HsImplicitBndrs pass thing -> thing +hsImplicitBody :: (XXHsImplicitBndrs pass thing ~ NoExtCon) + => HsImplicitBndrs pass thing -> thing hsImplicitBody (HsIB { hsib_body = body }) = body -hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody" +hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec -hsSigType :: LHsSigType pass -> LHsType pass +hsSigType :: (XXHsImplicitBndrs pass (LHsType pass) ~ NoExtCon) + => LHsSigType pass -> LHsType pass hsSigType = hsImplicitBody hsSigWcType :: LHsSigWcType pass -> LHsType pass @@ -495,16 +497,18 @@ data HsTyVarBndr pass type instance XUserTyVar (GhcPass _) = NoExt type instance XKindedTyVar (GhcPass _) = NoExt -type instance XXTyVarBndr (GhcPass _) = NoExt +type instance XXTyVarBndr (GhcPass _) = NoExtCon -- | Does this 'HsTyVarBndr' come with an explicit kind annotation? -isHsKindedTyVar :: HsTyVarBndr pass -> Bool +isHsKindedTyVar :: (XXTyVarBndr pass ~ NoExtCon) + => HsTyVarBndr pass -> Bool isHsKindedTyVar (UserTyVar {}) = False isHsKindedTyVar (KindedTyVar {}) = True -isHsKindedTyVar (XTyVarBndr{}) = panic "isHsKindedTyVar" +isHsKindedTyVar (XTyVarBndr nec) = noExtCon nec -- | Do all type variables in this 'LHsQTyVars' come with kind annotations? -hsTvbAllKinded :: LHsQTyVars pass -> Bool +hsTvbAllKinded :: (XXTyVarBndr pass ~ NoExtCon) + => LHsQTyVars pass -> Bool hsTvbAllKinded = all (isHsKindedTyVar . unLoc) . hsQTvExplicit -- | Haskell Type @@ -882,7 +886,7 @@ data ConDeclField pass -- Record fields have Haddoc docs on them | XConDeclField (XXConDeclField pass) type instance XConDeclField (GhcPass _) = NoExt -type instance XXConDeclField (GhcPass _) = NoExt +type instance XXConDeclField (GhcPass _) = NoExtCon instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ConDeclField p) where @@ -945,8 +949,8 @@ hsWcScopedTvs sig_ty -- include kind variables only if the type is headed by forall -- (this is consistent with GHC 7 behaviour) _ -> nwcs -hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs" -hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs" +hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec +hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec hsScopedTvs :: LHsSigType GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType @@ -972,18 +976,22 @@ I don't know if this is a good idea, but there it is. -} --------------------- -hsTyVarName :: HsTyVarBndr pass -> IdP pass +hsTyVarName :: (XXTyVarBndr pass ~ NoExtCon) + => HsTyVarBndr pass -> IdP pass hsTyVarName (UserTyVar _ (L _ n)) = n hsTyVarName (KindedTyVar _ (L _ n) _) = n -hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName" +hsTyVarName (XTyVarBndr nec) = noExtCon nec -hsLTyVarName :: LHsTyVarBndr pass -> IdP pass +hsLTyVarName :: (XXTyVarBndr pass ~ NoExtCon) + => LHsTyVarBndr pass -> IdP pass hsLTyVarName = hsTyVarName . unLoc -hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass] +hsLTyVarNames :: (XXTyVarBndr pass ~ NoExtCon) + => [LHsTyVarBndr pass] -> [IdP pass] hsLTyVarNames = map hsLTyVarName -hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass] +hsExplicitLTyVarNames :: (XXTyVarBndr pass ~ NoExtCon) + => LHsQTyVars pass -> [IdP pass] -- Explicit variables only hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs) @@ -992,12 +1000,14 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name] hsAllLTyVarNames (HsQTvs { hsq_ext = kvs , hsq_explicit = tvs }) = kvs ++ hsLTyVarNames tvs -hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames" +hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec -hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass) +hsLTyVarLocName :: (XXTyVarBndr pass ~ NoExtCon) + => LHsTyVarBndr pass -> Located (IdP pass) hsLTyVarLocName = onHasSrcSpan hsTyVarName -hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)] +hsLTyVarLocNames :: (XXTyVarBndr pass ~ NoExtCon) + => LHsQTyVars pass -> [Located (IdP pass)] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs) -- | Convert a LHsTyVarBndr to an equivalent LHsType. @@ -1007,13 +1017,13 @@ hsLTyVarBndrToType = onHasSrcSpan cvt cvt (KindedTyVar _ (L name_loc n) kind) = HsKindSig noExt (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind - cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType" + cvt (XTyVarBndr nec) = noExtCon nec -- | Convert a LHsTyVarBndrs to a list of types. -- Works on *type* variable only, no kind vars. hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)] hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs -hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes" +hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec --------------------- ignoreParens :: LHsType pass -> LHsType pass @@ -1253,9 +1263,10 @@ splitLHsInstDeclTy (HsIB { hsib_ext = itkvs = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty) -- Return implicitly bound type and kind vars -- For an instance decl, all of them are in scope -splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy" +splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec -getLHsInstDeclHead :: LHsSigType pass -> LHsType pass +getLHsInstDeclHead :: (XXHsImplicitBndrs pass (LHsType pass) ~ NoExtCon) + => LHsSigType pass -> LHsType pass getLHsInstDeclHead inst_ty | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty) = body_ty @@ -1298,7 +1309,7 @@ type instance XCFieldOcc GhcPs = NoExt type instance XCFieldOcc GhcRn = Name type instance XCFieldOcc GhcTc = Id -type instance XXFieldOcc (GhcPass _) = NoExt +type instance XXFieldOcc (GhcPass _) = NoExtCon instance Outputable (FieldOcc pass) where ppr = ppr . rdrNameFieldOcc @@ -1332,7 +1343,7 @@ type instance XAmbiguous GhcPs = NoExt type instance XAmbiguous GhcRn = NoExt type instance XAmbiguous GhcTc = Id -type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt +type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where ppr = ppr . rdrNameAmbiguousFieldOcc @@ -1347,23 +1358,23 @@ mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr rdrNameAmbiguousFieldOcc (Ambiguous _ (L _ rdr)) = rdr -rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _) - = panic "rdrNameAmbiguousFieldOcc" +rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec) + = noExtCon nec selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id selectorAmbiguousFieldOcc (Unambiguous sel _) = sel selectorAmbiguousFieldOcc (Ambiguous sel _) = sel -selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _) - = panic "selectorAmbiguousFieldOcc" +selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec) + = noExtCon nec unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel -unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc" +unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr -ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc" +ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec {- ************************************************************************ |