[Git][ghc/ghc][master] Refactor: remove rnHsDoc
Marge Bot
gitlab at gitlab.haskell.org
Thu Oct 1 22:39:16 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1edd6d21 by Vladislav Zavialov at 2020-10-01T18:39:10-04:00
Refactor: remove rnHsDoc
It did not do any useful work.
- - - - -
5 changed files:
- − compiler/GHC/Rename/Doc.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/Rename/Doc.hs deleted
=====================================
@@ -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
=====================================
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
=====================================
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) } }
=====================================
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.
=====================================
compiler/ghc.cabal.in
=====================================
@@ -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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1edd6d21c0abea34b498a627234a97df21648024
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1edd6d21c0abea34b498a627234a97df21648024
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201001/643ae547/attachment-0001.html>
More information about the ghc-commits
mailing list