Commit 1edd6d21 authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot
Browse files

Refactor: remove rnHsDoc

It did not do any useful work.
parent e5523324
{-# 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
......@@ -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
......
......@@ -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) } }
......
......@@ -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.
......
......@@ -423,7 +423,6 @@ Library
GHC.Rename.Bind
GHC.Rename.Env
GHC.Rename.Expr
GHC.Rename.Doc
GHC.Rename.Names
GHC.Rename.Pat
GHC.Rename.Module
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment