diff options
author | Gert-Jan Bottu <gertjan.bottu@kuleuven.be> | 2020-04-05 11:16:56 +0200 |
---|---|---|
committer | Gert-Jan Bottu <gertjan.bottu@kuleuven.be> | 2020-05-15 22:09:44 +0200 |
commit | a8d7e66da4dcc3b242103271875261604be42d6e (patch) | |
tree | e468ca29b905b35f76318f547a173de401995672 /haddock-api/src/Haddock/Interface | |
parent | 97f301a63ea8461074bfaa1486eb798e4be65f15 (diff) |
Explicit Specificity Support for Haddock
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 12 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 18 |
2 files changed, 15 insertions, 15 deletions
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 59c2f818..848acb1f 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -304,14 +304,14 @@ renameLHsQTyVars (HsQTvs { hsq_explicit = tvs }) ; return (HsQTvs { hsq_ext = noExtField , hsq_explicit = tvs' }) } -renameLTyVarBndr :: LHsTyVarBndr GhcRn -> RnM (LHsTyVarBndr DocNameI) -renameLTyVarBndr (L loc (UserTyVar x (L l n))) +renameLTyVarBndr :: LHsTyVarBndr flag GhcRn -> RnM (LHsTyVarBndr flag DocNameI) +renameLTyVarBndr (L loc (UserTyVar x fl (L l n))) = do { n' <- rename n - ; return (L loc (UserTyVar x (L l n'))) } -renameLTyVarBndr (L loc (KindedTyVar x (L lv n) kind)) + ; return (L loc (UserTyVar x fl (L l n'))) } +renameLTyVarBndr (L loc (KindedTyVar x fl (L lv n) kind)) = do { n' <- rename n ; kind' <- renameLKind kind - ; return (L loc (KindedTyVar x (L lv n') kind')) } + ; return (L loc (KindedTyVar x fl (L lv n') kind')) } renameLContext :: Located [LHsType GhcRn] -> RnM (Located [LHsType DocNameI]) renameLContext (L loc context) = do @@ -475,7 +475,7 @@ renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars , con_res_ty = res_ty , con_doc = mbldoc }) = do lnames' <- mapM renameL lnames - ltyvars' <- renameLHsQTyVars ltyvars + ltyvars' <- mapM renameLTyVarBndr ltyvars lcontext' <- traverse renameLContext lcontext details' <- renameDetails details res_ty' <- renameLType res_ty diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index a939dfbd..cbfea762 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -60,8 +60,8 @@ specializeTyVarBndrs bndrs typs = specialize $ zip bndrs' typs where bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs - bname (UserTyVar _ (L _ name)) = name - bname (KindedTyVar _ (L _ name) _) = name + bname (UserTyVar _ _ (L _ name)) = name + bname (KindedTyVar _ _ (L _ name) _) = name bname (XTyVarBndr _) = error "haddock:specializeTyVarBndrs" @@ -291,10 +291,10 @@ renameLTypes = mapM renameLType renameContext :: HsContext GhcRn -> Rename (IdP GhcRn) (HsContext GhcRn) renameContext = renameLTypes -renameBinder :: HsTyVarBndr GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr GhcRn) -renameBinder (UserTyVar x lname) = UserTyVar x <$> located renameName lname -renameBinder (KindedTyVar x lname lkind) = - KindedTyVar x <$> located renameName lname <*> located renameType lkind +renameBinder :: HsTyVarBndr flag GhcRn -> Rename (IdP GhcRn) (HsTyVarBndr flag GhcRn) +renameBinder (UserTyVar x fl lname) = UserTyVar x fl <$> located renameName lname +renameBinder (KindedTyVar x fl lname lkind) = + KindedTyVar x fl <$> located renameName lname <*> located renameType lkind -- | Core renaming logic. renameName :: (Eq name, SetName name) => name -> Rename name name @@ -348,7 +348,7 @@ located :: Functor f => (a -> f b) -> Located a -> f (Located b) located f (L loc e) = L loc <$> f e -tyVarName :: HsTyVarBndr name -> IdP name -tyVarName (UserTyVar _ name) = unLoc name -tyVarName (KindedTyVar _ (L _ name) _) = name +tyVarName :: HsTyVarBndr flag name -> IdP name +tyVarName (UserTyVar _ _ name) = unLoc name +tyVarName (KindedTyVar _ _ (L _ name) _) = name tyVarName (XTyVarBndr _ ) = error "haddock:tyVarName" |