From 2f70b752b35757e06de80be2ec523255becd8be2 Mon Sep 17 00:00:00 2001 From: Vladislav Zavialov Date: Wed, 30 Sep 2020 23:31:22 +0300 Subject: Refactor: remove rnHsDoc It did not do any useful work. --- compiler/GHC/Rename/Doc.hs | 25 ------------------------- compiler/GHC/Rename/HsType.hs | 7 ++----- compiler/GHC/Rename/Module.hs | 38 ++++---------------------------------- compiler/GHC/Tc/Gen/Export.hs | 24 +++++++----------------- compiler/ghc.cabal.in | 1 - 5 files changed, 13 insertions(+), 82 deletions(-) delete mode 100644 compiler/GHC/Rename/Doc.hs diff --git a/compiler/GHC/Rename/Doc.hs b/compiler/GHC/Rename/Doc.hs deleted file mode 100644 index f053795073..0000000000 --- a/compiler/GHC/Rename/Doc.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE ViewPatterns #-} - -module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where - -import GHC.Prelude - -import GHC.Tc.Types -import GHC.Hs -import GHC.Types.SrcLoc - - -rnMbLHsDoc :: Maybe LHsDocString -> RnM (Maybe LHsDocString) -rnMbLHsDoc mb_doc = case mb_doc of - Just doc -> do - doc' <- rnLHsDoc doc - return (Just doc') - Nothing -> return Nothing - -rnLHsDoc :: LHsDocString -> RnM LHsDocString -rnLHsDoc (L pos doc) = do - doc' <- rnHsDoc doc - return (L pos doc') - -rnHsDoc :: HsDocString -> RnM HsDocString -rnHsDoc = pure diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index 79f2bee61f..8d67aa1df2 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -41,7 +41,6 @@ import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType ) import GHC.Driver.Session import GHC.Hs -import GHC.Rename.Doc ( rnLHsDoc, rnMbLHsDoc ) import GHC.Rename.Env import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext , mapFvRn, pprHsDocContext, bindLocalNamesFV @@ -698,8 +697,7 @@ rnHsTyKi _ (HsSpliceTy _ sp) rnHsTyKi env (HsDocTy _ ty haddock_doc) = do { (ty', fvs) <- rnLHsTyKi env ty - ; haddock_doc' <- rnLHsDoc haddock_doc - ; return (HsDocTy noExtField ty' haddock_doc', fvs) } + ; return (HsDocTy noExtField ty' haddock_doc, fvs) } rnHsTyKi _ (XHsType (NHsCoreTy ty)) = return (XHsType (NHsCoreTy ty), emptyFVs) @@ -1168,8 +1166,7 @@ rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs rnField fl_env env (L l (ConDeclField _ names ty haddock_doc)) = do { let new_names = map (fmap lookupField) names ; (new_ty, fvs) <- rnLHsTyKi env ty - ; new_haddock_doc <- rnMbLHsDoc haddock_doc - ; return (L l (ConDeclField noExtField new_names new_ty new_haddock_doc) + ; return (L l (ConDeclField noExtField new_names new_ty haddock_doc) , fvs) } where lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index bdc1957627..2eedd939a5 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -38,7 +38,6 @@ import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames , addNoNestedForallsContextsErr, checkInferredVars ) import GHC.Rename.Unbound ( mkUnboundName, notInScopeErr ) import GHC.Rename.Names -import GHC.Rename.Doc ( rnHsDoc, rnMbLHsDoc ) import GHC.Tc.Gen.Annotation ( annCtxt ) import GHC.Tc.Utils.Monad @@ -199,8 +198,6 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ; (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ; (rn_splice_decls, src_fvs7) <- rnList rnSpliceDecl splice_decls ; - -- Haddock docs; no free vars - rn_docs <- mapM (wrapLocM rnDocDecl) docs ; last_tcg_env <- getGblEnv ; -- (I) Compute the results and return @@ -216,7 +213,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, hs_annds = rn_ann_decls, hs_defds = rn_default_decls, hs_ruleds = rn_rule_decls, - hs_docs = rn_docs } ; + hs_docs = docs } ; tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ; other_def = (Just (mkNameSet tcf_bndrs), emptyNameSet) ; @@ -245,28 +242,6 @@ addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus } rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars) rnList f xs = mapFvRn (wrapLocFstM f) xs -{- -********************************************************* -* * - HsDoc stuff -* * -********************************************************* --} - -rnDocDecl :: DocDecl -> RnM DocDecl -rnDocDecl (DocCommentNext doc) = do - rn_doc <- rnHsDoc doc - return (DocCommentNext rn_doc) -rnDocDecl (DocCommentPrev doc) = do - rn_doc <- rnHsDoc doc - return (DocCommentPrev rn_doc) -rnDocDecl (DocCommentNamed str doc) = do - rn_doc <- rnHsDoc doc - return (DocCommentNamed str rn_doc) -rnDocDecl (DocGroup lev doc) = do - rn_doc <- rnHsDoc doc - return (DocGroup lev rn_doc) - {- ********************************************************* * * @@ -1770,15 +1745,12 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls, -- since that is done by GHC.Rename.Names.extendGlobalRdrEnvRn -- and the methods are already in scope - -- Haddock docs - ; docs' <- mapM (wrapLocM rnDocDecl) docs - ; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls', tcdTyVars = tyvars', tcdFixity = fixity, tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs', - tcdDocs = docs', tcdCExt = all_fvs }, + tcdDocs = docs, tcdCExt = all_fvs }, all_fvs ) } where cls_doc = ClassDeclCtx lcls @@ -2196,7 +2168,6 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_doc = mb_doc, con_forall = forall }) = do { _ <- addLocM checkConName name ; new_name <- lookupLocatedTopBndrRn name - ; mb_doc' <- rnMbLHsDoc mb_doc -- We bind no implicit binders here; this is just like -- a nested HsForAllTy. E.g. consider @@ -2220,7 +2191,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs ; return (decl { con_ext = noExtField , con_name = new_name, con_ex_tvs = new_ex_tvs , con_mb_cxt = new_context, con_args = new_args - , con_doc = mb_doc' + , con_doc = mb_doc , con_forall = forall }, -- Remove when #18311 is fixed all_fvs) }} @@ -2233,7 +2204,6 @@ rnConDecl decl@(ConDeclGADT { con_names = names , con_doc = mb_doc }) = do { mapM_ (addLocM checkConName) names ; new_names <- mapM lookupLocatedTopBndrRn names - ; mb_doc' <- rnMbLHsDoc mb_doc ; let theta = hsConDeclTheta mcxt arg_tys = hsConDeclArgTys args @@ -2269,7 +2239,7 @@ rnConDecl decl@(ConDeclGADT { con_names = names ; return (decl { con_g_ext = implicit_tkvs, con_names = new_names , con_qvars = explicit_tkvs, con_mb_cxt = new_cxt , con_args = new_args, con_res_ty = new_res_ty - , con_doc = mb_doc' + , con_doc = mb_doc , con_forall = forall }, -- Remove when #18311 is fixed all_fvs) } } diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs index fc0f993f03..c30773fbd4 100644 --- a/compiler/GHC/Tc/Gen/Export.hs +++ b/compiler/GHC/Tc/Gen/Export.hs @@ -41,7 +41,6 @@ import GHC.Data.FastString (fsLit) import Control.Monad import GHC.Driver.Session -import GHC.Rename.Doc ( rnHsDoc ) import GHC.Parser.PostProcess ( setRdrNameSpace ) import Data.Either ( partitionEithers ) @@ -323,9 +322,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod , new_exports))) } exports_from_item acc@(ExportAccum occs mods) (L loc ie) - | isDoc ie - = do new_ie <- lookup_doc_ie ie - return (Just (acc, (L loc new_ie, []))) + | Just new_ie <- lookup_doc_ie ie + = return (Just (acc, (L loc new_ie, []))) | otherwise = do (new_ie, avail) <- lookup_ie ie @@ -406,13 +404,11 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod return (L l name, non_flds, flds) ------------- - lookup_doc_ie :: IE GhcPs -> RnM (IE GhcRn) - lookup_doc_ie (IEGroup _ lev doc) = do rn_doc <- rnHsDoc doc - return (IEGroup noExtField lev rn_doc) - lookup_doc_ie (IEDoc _ doc) = do rn_doc <- rnHsDoc doc - return (IEDoc noExtField rn_doc) - lookup_doc_ie (IEDocNamed _ str) = return (IEDocNamed noExtField str) - lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier + lookup_doc_ie :: IE GhcPs -> Maybe (IE GhcRn) + lookup_doc_ie (IEGroup _ lev doc) = Just (IEGroup noExtField lev doc) + lookup_doc_ie (IEDoc _ doc) = Just (IEDoc noExtField doc) + lookup_doc_ie (IEDocNamed _ str) = Just (IEDocNamed noExtField str) + lookup_doc_ie _ = Nothing -- In an export item M.T(A,B,C), we want to treat the uses of -- A,B,C as if they were M.A, M.B, M.C @@ -431,12 +427,6 @@ classifyGRE gre = case gre_par gre of where n = gre_name gre -isDoc :: IE GhcPs -> Bool -isDoc (IEDoc {}) = True -isDoc (IEDocNamed {}) = True -isDoc (IEGroup {}) = True -isDoc _ = False - -- Renaming and typechecking of exports happens after everything else has -- been typechecked. diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 0266513a13..f4f5c2a18b 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -420,7 +420,6 @@ Library GHC.Rename.Bind GHC.Rename.Env GHC.Rename.Expr - GHC.Rename.Doc GHC.Rename.Names GHC.Rename.Pat GHC.Rename.Module -- cgit v1.2.1