diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 6442ac5bf3be0774081c51d5681122ac2c2df746..f6f051511c47d388e320a795869fcb9d0c155c67 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -314,9 +314,7 @@ type instance XParTy (GhcPass _) = EpAnn AnnParen type instance XIParamTy GhcPs = EpAnn [AddEpAnn] type instance XIParamTy GhcRn = EpAnn [AddEpAnn] type instance XIParamTy GhcTc = Void -type instance XStarTy GhcPs = NoExtField -type instance XStarTy GhcRn = NoExtField -type instance XStarTy GhcTc = Void +type instance XStarTy (GhcPass _) = NoExtField type instance XKindSig GhcPs = EpAnn [AddEpAnn] type instance XKindSig GhcRn = EpAnn [AddEpAnn] type instance XKindSig GhcTc = Void @@ -327,9 +325,8 @@ type instance XSpliceTy GhcPs = NoExtField type instance XSpliceTy GhcRn = NoExtField type instance XSpliceTy GhcTc = Void -type instance XDocTy GhcPs = EpAnn [AddEpAnn] -type instance XDocTy GhcRn = EpAnn [AddEpAnn] -type instance XDocTy GhcTc = Void +type instance XDocTy (GhcPass _) = EpAnn [AddEpAnn] + type instance XBangTy GhcPs = EpAnn [AddEpAnn] type instance XBangTy GhcRn = EpAnn [AddEpAnn] type instance XBangTy GhcTc = Void @@ -346,9 +343,7 @@ type instance XExplicitTupleTy GhcPs = EpAnn [AddEpAnn] type instance XExplicitTupleTy GhcRn = NoExtField type instance XExplicitTupleTy GhcTc = Void -type instance XTyLit GhcPs = NoExtField -type instance XTyLit GhcRn = NoExtField -type instance XTyLit GhcTc = Void +type instance XTyLit (GhcPass _) = NoExtField type instance XWildCardTy GhcPs = NoExtField type instance XWildCardTy GhcRn = NoExtField @@ -386,20 +381,25 @@ dsHsType t = case t of HsTupleTy v _ _ -> dataConCantHappen v HsSumTy v _ -> dataConCantHappen v HsOpTy _ t1 op t2 -> mkAppTys (mkTyVarTy (unLoc op)) [dsLHsType t1, dsLHsType t2] - HsParTy _ t -> dsLHsType t + HsParTy _ t1 -> dsLHsType t1 HsIParamTy v _ _ -> dataConCantHappen v HsKindSig v _ _ -> dataConCantHappen v HsSpliceTy v _ -> dataConCantHappen v - HsDocTy v _ _ -> dataConCantHappen v + HsDocTy _ t1 _ -> dsLHsType t1 HsBangTy v _ _ -> dataConCantHappen v HsRecTy v _ -> dataConCantHappen v HsExplicitListTy v _ _ -> dataConCantHappen v HsExplicitTupleTy v _ -> dataConCantHappen v - HsTyLit v _ -> dataConCantHappen v + HsTyLit _ lit -> dsHsTyLit lit HsWildCardTy v -> dataConCantHappen v - HsStarTy v _ -> dataConCantHappen v + HsStarTy _ _ -> liftedTypeKind XHsType (HsTypeTc t' _) -> t' +dsHsTyLit :: HsTyLit -> Type +dsHsTyLit (HsNumTy _ n) = mkNumLitTy n +dsHsTyLit (HsStrTy _ str) = mkStrLitTy str +dsHsTyLit (HsCharTy _ c) = mkCharLitTy c + dsLHsType :: LHsType GhcTc -> Type dsLHsType = dsHsType . unLoc @@ -438,14 +438,14 @@ unTcHsType t = case t of HsIParamTy v _ _ -> dataConCantHappen v HsKindSig v _ _ -> dataConCantHappen v HsSpliceTy v _ -> dataConCantHappen v - HsDocTy v _ _ -> dataConCantHappen v + HsDocTy x t1 doc -> HsDocTy x (unTcLHsType t1) doc HsBangTy v _ _ -> dataConCantHappen v HsRecTy v _ -> dataConCantHappen v HsExplicitListTy v _ _ -> dataConCantHappen v HsExplicitTupleTy v _ -> dataConCantHappen v - HsTyLit v _ -> dataConCantHappen v + HsTyLit x lit -> HsTyLit x lit HsWildCardTy v -> dataConCantHappen v - HsStarTy v _ -> dataConCantHappen v + HsStarTy x isUni -> HsStarTy x isUni XHsType (HsTypeTc _ t') -> t'