diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-05-11 22:45:15 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-05-11 22:45:15 +0100 |
commit | fef07ac22cc89888e78233807e55c7dbf6f405f5 (patch) | |
tree | 2dc0e91b2fe3f313a06da5e98f860d9c7e56241c /src/Haddock | |
parent | 1c308b7c0dc44a431c7e2a894162f346d4f9ff85 (diff) |
Follow changes to LHsTyVarBndrs
Diffstat (limited to 'src/Haddock')
-rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 7 | ||||
-rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 12 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 16 | ||||
-rw-r--r-- | src/Haddock/Convert.hs | 12 | ||||
-rw-r--r-- | src/Haddock/Interface/Rename.hs | 33 |
5 files changed, 43 insertions, 37 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index c0569006..d176c9f7 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -141,10 +141,10 @@ ppClass x = out x{tcdSigs=[]} : addContext _ = error "expected TypeSig" f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d - f t = HsForAllTy Implicit [] (reL [context]) (reL t) + f t = HsForAllTy Implicit (mkHsQTvs []) (reL [context]) (reL t) context = nlHsTyConApp (unL $ tcdLName x) - (map (reL . HsTyVar . hsTyVarName . unL) (tcdTyVars x)) + (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tcdTyVars x))) ppInstance :: ClsInst -> [String] @@ -193,7 +193,8 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con)) name = out $ unL $ con_name con resType = case con_res con of - ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [hsTyVarName v | v@UserTyVar {} <- map unL $ tcdTyVars dat] + ResTyH98 -> apps $ map (reL . HsTyVar) $ + unL (tcdLName dat) : [hsTyVarName v | L _ (v@UserTyVar {}) <- hsQTvBndrs $ tcdTyVars dat] ResTyGADT x -> x diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index a02079c6..fc07a07e 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -388,12 +388,12 @@ ppTypeSig nms ty unicode = <+> ppType unicode ty -ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX] +ppTyVars :: LHsTyVarBndrs DocName -> [LaTeX] ppTyVars tvs = map ppSymName (tyvarNames tvs) -tyvarNames :: [LHsTyVarBndr DocName] -> [Name] -tyvarNames = map (getName . hsTyVarName . unLoc) +tyvarNames :: LHsTyVarBndrs DocName -> [Name] +tyvarNames = map getName . hsLTyVarNames declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX @@ -442,7 +442,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName - -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])] + -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])] -> Bool -> LaTeX ppClassHdr summ lctxt n tvs fds unicode = keyword "class" @@ -826,13 +826,13 @@ ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell -ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)] +ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName -> Located (HsContext DocName) -> Bool -> LaTeX ppForAll expl tvs cxt unicode | show_forall = forall_part <+> ppLContext cxt unicode | otherwise = ppLContext cxt unicode where - show_forall = not (null tvs) && is_explicit + show_forall = not (null (hsQTvBndrs tvs)) && is_explicit is_explicit = case expl of {Explicit -> True; Implicit -> False} forall_part = hsep (forallSymbol unicode : ppTyVars tvs) <> dot diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 18506e8f..b4afee3d 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -99,12 +99,12 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) = (leader <+> ppType unicode qual t, argDoc n, []) : [] -ppTyVars :: [LHsTyVarBndr DocName] -> [Html] +ppTyVars :: LHsTyVarBndrs DocName -> [Html] ppTyVars tvs = map ppTyName (tyvarNames tvs) -tyvarNames :: [LHsTyVarBndr DocName] -> [Name] -tyvarNames = map (getName . hsTyVarName . unLoc) +tyvarNames :: LHsTyVarBndrs DocName -> [Name] +tyvarNames = map getName . hsLTyVarNames ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName @@ -162,8 +162,8 @@ ppTyFamHeader summary associated decl unicode qual = ppTyClBinderWithVars summary decl <+> case tcdKindSig decl of - Just (HsBSig kind _) -> dcolon unicode <+> ppLKind unicode qual kind - Nothing -> noHtml + Just kind -> dcolon unicode <+> ppLKind unicode qual kind + Nothing -> noHtml ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> @@ -275,7 +275,7 @@ pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt) ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName - -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])] + -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])] -> Bool -> Qualification -> Html ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" @@ -646,13 +646,13 @@ ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell -ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)] +ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName -> Located (HsContext DocName) -> Bool -> Qualification -> Html ppForAll expl tvs cxt unicode qual | show_forall = forall_part <+> ppLContext cxt unicode qual | otherwise = ppLContext cxt unicode qual where - show_forall = not (null tvs) && is_explicit + show_forall = not (null (hsQTvBndrs tvs)) && is_explicit is_explicit = case expl of {Explicit -> True; Implicit -> False} forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 58f6a872..e2eb990b 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -87,7 +87,7 @@ synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs }) typats = map (synifyType WithinType) args hs_rhs_ty = synifyType WithinType rhs in FamInstDecl { fid_tycon = name - , fid_pats = HsBSig typats ([], map tyVarName tvs) + , fid_pats = HsWB { hswb_cts = typats, hswb_kvs = [], hswb_tvs = map tyVarName tvs } , fid_defn = TySynonym hs_rhs_ty, fid_fvs = placeHolderNames } | otherwise = error "synifyAxiom" @@ -97,7 +97,7 @@ synifyTyCon tc | isFunTyCon tc || isPrimTyCon tc = TyDecl { tcdLName = synifyName tc , tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up: - zipWith + mkHsQTvs $ zipWith (\fakeTyVar realKind -> noLoc $ KindedTyVar (getName fakeTyVar) (synifyKindSig realKind)) @@ -230,8 +230,8 @@ synifyCtx :: [PredType] -> LHsContext Name synifyCtx = noLoc . map (synifyType WithinType) -synifyTyVars :: [TyVar] -> [LHsTyVarBndr Name] -synifyTyVars = map synifyTyVar +synifyTyVars :: [TyVar] -> LHsTyVarBndrs Name +synifyTyVars tvs = mkHsQTvs (map synifyTyVar tvs) where synifyTyVar tv = noLoc $ let kind = tyVarKind tv @@ -311,8 +311,8 @@ synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy n synifyTyLit (StrTyLit s) = HsStrTy s -synifyKindSig :: Kind -> HsBndrSig (LHsKind Name) -synifyKindSig k = mkHsBSig (synifyType (error "synifyKind") k) +synifyKindSig :: Kind -> LHsKind Name +synifyKindSig k = synifyType (error "synifyKind") k synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> ([HsType Name], Name, [HsType Name]) diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index a766be18..5e819e59 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -206,17 +206,17 @@ renameLType = mapM renameType renameLKind :: LHsKind Name -> RnM (LHsKind DocName) renameLKind = renameLType -renameMaybeLKind :: Maybe (HsBndrSig (LHsKind Name)) - -> RnM (Maybe (HsBndrSig (LHsKind DocName))) +renameMaybeLKind :: Maybe (LHsKind Name) + -> RnM (Maybe (LHsKind DocName)) renameMaybeLKind Nothing = return Nothing -renameMaybeLKind (Just (HsBSig ki fvs)) +renameMaybeLKind (Just ki) = do { ki' <- renameLKind ki - ; return (Just (HsBSig ki' fvs)) } + ; return (Just ki') } renameType :: HsType Name -> RnM (HsType DocName) renameType t = case t of HsForAllTy expl tyvars lcontext ltype -> do - tyvars' <- mapM renameLTyVarBndr tyvars + tyvars' <- renameLTyVarBndrs tyvars lcontext' <- renameLContext lcontext ltype' <- renameLType ltype return (HsForAllTy expl tyvars' lcontext' ltype') @@ -264,14 +264,19 @@ renameType t = case t of _ -> error "renameType" +renameLTyVarBndrs :: LHsTyVarBndrs Name -> RnM (LHsTyVarBndrs DocName) +renameLTyVarBndrs qtvs + = do { tvs' <- mapM renameLTyVarBndr (hsQTvBndrs qtvs) + ; return (mkHsQTvs tvs') } + renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) renameLTyVarBndr (L loc (UserTyVar n)) = do { n' <- rename n ; return (L loc (UserTyVar n')) } -renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs))) +renameLTyVarBndr (L loc (KindedTyVar n k)) = do { n' <- rename n ; k' <- renameLKind k - ; return (L loc (KindedTyVar n' (HsBSig k' fvs))) } + ; return (L loc (KindedTyVar n' k')) } renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName]) renameLContext (L loc context) = do @@ -321,7 +326,7 @@ renameTyClD d = case d of -- TyFamily flav lname ltyvars kind tckind -> do TyFamily flav lname ltyvars tckind -> do lname' <- renameL lname - ltyvars' <- mapM renameLTyVarBndr ltyvars + ltyvars' <- renameLTyVarBndrs ltyvars -- kind' <- renameMaybeLKind kind tckind' <- renameMaybeLKind tckind -- return (TyFamily flav lname' ltyvars' kind' tckind) @@ -329,7 +334,7 @@ renameTyClD d = case d of TyDecl { tcdLName = lname, tcdTyVars = tyvars, tcdTyDefn = defn, tcdFVs = fvs } -> do lname' <- renameL lname - tyvars' <- mapM renameLTyVarBndr tyvars + tyvars' <- renameLTyVarBndrs tyvars defn' <- renameTyDefn defn return (TyDecl { tcdLName = lname', tcdTyVars = tyvars', tcdTyDefn = defn', tcdFVs = fvs }) @@ -337,7 +342,7 @@ renameTyClD d = case d of , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do lcontext' <- renameLContext lcontext lname' <- renameL lname - ltyvars' <- mapM renameLTyVarBndr ltyvars + ltyvars' <- renameLTyVarBndrs ltyvars lfundeps' <- mapM renameLFunDep lfundeps lsigs' <- mapM renameLSig lsigs ats' <- mapM renameLTyClD ats @@ -374,7 +379,7 @@ renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars , con_cxt = lcontext, con_details = details , con_res = restype, con_doc = mbldoc }) = do lname' <- renameL lname - ltyvars' <- mapM renameLTyVarBndr ltyvars + ltyvars' <- renameLTyVarBndrs ltyvars lcontext' <- renameLContext lcontext details' <- renameDetails details restype' <- renameResType restype @@ -431,11 +436,11 @@ renameInstD (FamInstD { lid_inst = d }) = do return (FamInstD { lid_inst = d' }) renameFamInstD :: FamInstDecl Name -> RnM (FamInstDecl DocName) -renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = HsBSig pats fvs, fid_defn = defn }) +renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = pats_w_bndrs, fid_defn = defn }) = do { tc' <- renameL tc - ; pats' <- mapM renameLType pats + ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs) ; defn' <- renameTyDefn defn - ; return (FamInstDecl { fid_tycon = tc', fid_pats = HsBSig pats' fvs + ; return (FamInstDecl { fid_tycon = tc', fid_pats = pats_w_bndrs { hswb_cts = pats' } , fid_defn = defn', fid_fvs = placeHolderNames }) } |