Skip to content
Snippets Groups Projects
Commit cc86b105 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Follow changes to tcdKindSig (Trac #5937)

parent 7b381312
No related branches found
No related tags found
No related merge requests found
...@@ -164,7 +164,7 @@ ppTyFamHeader summary associated decl unicode qual = ...@@ -164,7 +164,7 @@ ppTyFamHeader summary associated decl unicode qual =
ppTyClBinderWithVars summary decl <+> ppTyClBinderWithVars summary decl <+>
case tcdKindSig decl of case tcdKindSig decl of
Just kind -> dcolon unicode <+> ppLKind unicode qual kind Just (HsBSig kind _) -> dcolon unicode <+> ppLKind unicode qual kind
Nothing -> noHtml Nothing -> noHtml
......
...@@ -104,15 +104,14 @@ synifyTyCon tc ...@@ -104,15 +104,14 @@ synifyTyCon tc
(zipWith (zipWith
(\fakeTyVar realKind -> noLoc $ (\fakeTyVar realKind -> noLoc $
KindedTyVar (getName fakeTyVar) KindedTyVar (getName fakeTyVar)
(HsBSig (synifyKind realKind) placeHolderBndrs) (synifyKindSig realKind))
placeHolderKind)
alphaTyVars --a, b, c... which are unfortunately all kind * alphaTyVars --a, b, c... which are unfortunately all kind *
(fst . splitKindFunTys $ tyConKind tc) (fst . splitKindFunTys $ tyConKind tc)
) )
-- assume primitive types aren't members of data/newtype families: -- assume primitive types aren't members of data/newtype families:
Nothing Nothing
-- we have their kind accurately: -- we have their kind accurately:
(Just (synifyKind (tyConKind tc))) (Just (synifyKindSig (tyConKind tc)))
-- no algebraic constructors: -- no algebraic constructors:
[] []
-- "deriving" needn't be specified: -- "deriving" needn't be specified:
...@@ -121,7 +120,7 @@ synifyTyCon tc ...@@ -121,7 +120,7 @@ synifyTyCon tc
case synTyConRhs tc of case synTyConRhs tc of
SynFamilyTyCon -> SynFamilyTyCon ->
TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc)) TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
(Just (synifyKind (synTyConResKind tc))) -- placeHolderKind (Just (synifyKindSig (synTyConResKind tc)))
_ -> error "synifyTyCon: impossible open type synonym?" _ -> error "synifyTyCon: impossible open type synonym?"
| isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?) | isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?)
case algTyConRhs tc of case algTyConRhs tc of
...@@ -167,7 +166,7 @@ synifyTyCon tc ...@@ -167,7 +166,7 @@ synifyTyCon tc
syn_type = synifyType WithinType (synTyConType tc) syn_type = synifyType WithinType (synTyConType tc)
in if isSynTyCon tc in if isSynTyCon tc
then TySynonym name tyvars typats syn_type placeHolderNames then TySynonym name tyvars typats syn_type placeHolderNames
else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKind alg_kindSig) alg_cons alg_deriv else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKindSig alg_kindSig) alg_cons alg_deriv
-- User beware: it is your responsibility to pass True (use_gadt_syntax) -- User beware: it is your responsibility to pass True (use_gadt_syntax)
...@@ -240,8 +239,8 @@ synifyTyVars = map synifyTyVar ...@@ -240,8 +239,8 @@ synifyTyVars = map synifyTyVar
kind = tyVarKind tv kind = tyVarKind tv
name = getName tv name = getName tv
in if isLiftedTypeKind kind in if isLiftedTypeKind kind
then UserTyVar name placeHolderKind then UserTyVar name
else KindedTyVar name (HsBSig (synifyKind kind) placeHolderBndrs) placeHolderKind else KindedTyVar name (synifyKindSig kind)
--states of what to do with foralls: --states of what to do with foralls:
...@@ -309,8 +308,8 @@ synifyType s forallty@(ForAllTy _tv _ty) = ...@@ -309,8 +308,8 @@ synifyType s forallty@(ForAllTy _tv _ty) =
in noLoc $ in noLoc $
HsForAllTy forallPlicitness sTvs sCtx sTau HsForAllTy forallPlicitness sTvs sCtx sTau
synifyKind :: Kind -> LHsKind Name synifyKindSig :: Kind -> HsBndrSig (LHsKind Name)
synifyKind = synifyType (error "synifyKind") synifyKindSig k = HsBSig (synifyType (error "synifyKind") k) placeHolderBndrs
synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
([HsType Name], Name, [HsType Name]) ([HsType Name], Name, [HsType Name])
......
...@@ -206,9 +206,12 @@ renameLType = mapM renameType ...@@ -206,9 +206,12 @@ renameLType = mapM renameType
renameLKind :: LHsKind Name -> RnM (LHsKind DocName) renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
renameLKind = renameLType renameLKind = renameLType
renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName)) renameMaybeLKind :: Maybe (HsBndrSig (LHsKind Name))
-> RnM (Maybe (HsBndrSig (LHsKind DocName)))
renameMaybeLKind Nothing = return Nothing renameMaybeLKind Nothing = return Nothing
renameMaybeLKind (Just ki) = renameLKind ki >>= return . Just renameMaybeLKind (Just (HsBSig ki fvs))
= do { ki' <- renameLKind ki
; return (Just (HsBSig ki' fvs)) }
renameType :: HsType Name -> RnM (HsType DocName) renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of renameType t = case t of
...@@ -260,13 +263,13 @@ renameType t = case t of ...@@ -260,13 +263,13 @@ renameType t = case t of
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
renameLTyVarBndr (L loc (UserTyVar n tck)) renameLTyVarBndr (L loc (UserTyVar n))
= do { n' <- rename n = do { n' <- rename n
; return (L loc (UserTyVar n' tck)) } ; return (L loc (UserTyVar n')) }
renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs) tck)) renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs)))
= do { n' <- rename n = do { n' <- rename n
; k' <- renameLKind k ; k' <- renameLKind k
; return (L loc (KindedTyVar n' (HsBSig k' fvs) tck)) } ; return (L loc (KindedTyVar n' (HsBSig k' fvs))) }
renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName]) renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
renameLContext (L loc context) = do renameLContext (L loc context) = do
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment