Commit 7e5d4a0e authored by alexbiehl's avatar alexbiehl Committed by Ben Gamari
Browse files

Remember the AvailInfo for each IE

This is another take on https://phabricator.haskell.org/D3844.

This patch removes then need for haddock to reimplement the calculation
of exported names from modules. Instead when renaming export lists ghc
annotates each IE with its exported names.

Haddocks current  export logic has caused lots of trouble in the past
(on the Github issue tracker):
  - https://github.com/haskell/haddock/issues/121
  - https://github.com/haskell/haddock/issues/174
  - https://github.com/haskell/haddock/issues/225
  - https://github.com/haskell/haddock/issues/344
  - https://github.com/haskell/haddock/issues/584
  - https://github.com/haskell/haddock/issues/591
  - https://github.com/haskell/haddock/issues/597

Updates haddock submodule.

Reviewers: austin, bgamari, ezyang

Reviewed By: bgamari, ezyang

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3864
parent b996e12d
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
-- --
-- (c) The University of Glasgow -- (c) The University of Glasgow
-- --
...@@ -35,6 +36,7 @@ import ListSetOps ...@@ -35,6 +36,7 @@ import ListSetOps
import Outputable import Outputable
import Util import Util
import Data.Data ( Data )
import Data.List ( find ) import Data.List ( find )
import Data.Function import Data.Function
...@@ -59,7 +61,7 @@ data AvailInfo = Avail Name -- ^ An ordinary identifier in scope ...@@ -59,7 +61,7 @@ data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
-- to be in scope, it must be -- to be in scope, it must be
-- *first* in this list. Thus, -- *first* in this list. Thus,
-- typically: @AvailTC Eq [Eq, ==, \/=]@ -- typically: @AvailTC Eq [Eq, ==, \/=]@
deriving( Eq ) deriving( Eq, Data )
-- Equality used when deciding if the -- Equality used when deciding if the
-- interface has changed -- interface has changed
......
...@@ -847,7 +847,7 @@ instance DesugaredMod DesugaredModule where ...@@ -847,7 +847,7 @@ instance DesugaredMod DesugaredModule where
coreModule m = dm_core_module m coreModule m = dm_core_module m
type ParsedSource = Located (HsModule GhcPs) type ParsedSource = Located (HsModule GhcPs)
type RenamedSource = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [LIE GhcRn], type RenamedSource = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
Maybe LHsDocString) Maybe LHsDocString)
type TypecheckedSource = LHsBinds GhcTc type TypecheckedSource = LHsBinds GhcTc
......
...@@ -97,6 +97,7 @@ import Panic ...@@ -97,6 +97,7 @@ import Panic
import ConLike import ConLike
import Control.Concurrent import Control.Concurrent
import Avail ( Avails )
import Module import Module
import Packages import Packages
import RdrName import RdrName
...@@ -383,7 +384,7 @@ hscParse' mod_summary ...@@ -383,7 +384,7 @@ hscParse' mod_summary
-- can become a Nothing and decide whether this should instead throw an -- can become a Nothing and decide whether this should instead throw an
-- exception/signal an error. -- exception/signal an error.
type RenamedStuff = type RenamedStuff =
(Maybe (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [LIE GhcRn], (Maybe (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
Maybe LHsDocString)) Maybe LHsDocString))
-- | Rename and typecheck a module, additionally returning the renamed syntax -- | Rename and typecheck a module, additionally returning the renamed syntax
......
...@@ -158,7 +158,7 @@ checkHsigIface tcg_env gr sig_iface ...@@ -158,7 +158,7 @@ checkHsigIface tcg_env gr sig_iface
-- TODO: Actually this error swizzle doesn't work -- TODO: Actually this error swizzle doesn't work
let p (L _ ie) = name `elem` ieNames ie let p (L _ ie) = name `elem` ieNames ie
loc = case tcg_rn_exports tcg_env of loc = case tcg_rn_exports tcg_env of
Just es | Just e <- find p es Just es | Just e <- find p (map fst es)
-- TODO: maybe we can be a little more -- TODO: maybe we can be a little more
-- precise here and use the Located -- precise here and use the Located
-- info for the *specific* name we matched. -- info for the *specific* name we matched.
......
...@@ -91,13 +91,13 @@ You just have to use an explicit export list: ...@@ -91,13 +91,13 @@ You just have to use an explicit export list:
data ExportAccum -- The type of the accumulating parameter of data ExportAccum -- The type of the accumulating parameter of
-- the main worker function in rnExports -- the main worker function in rnExports
= ExportAccum = ExportAccum
[LIE GhcRn] -- Export items with Names [(LIE GhcRn, Avails)] -- Export items with names and
-- their exported stuff
-- Not nub'd!
ExportOccMap -- Tracks exported occurrence names ExportOccMap -- Tracks exported occurrence names
[AvailInfo] -- The accumulated exported stuff
-- Not nub'd!
emptyExportAccum :: ExportAccum emptyExportAccum :: ExportAccum
emptyExportAccum = ExportAccum [] emptyOccEnv [] emptyExportAccum = ExportAccum [] emptyOccEnv
type ExportOccMap = OccEnv (Name, IE GhcPs) type ExportOccMap = OccEnv (Name, IE GhcPs)
-- Tracks what a particular exported OccName -- Tracks what a particular exported OccName
...@@ -170,7 +170,11 @@ exports_from_avail :: Maybe (Located [LIE GhcPs]) ...@@ -170,7 +170,11 @@ exports_from_avail :: Maybe (Located [LIE GhcPs])
-- 'module Foo' export is valid (it's not valid -- 'module Foo' export is valid (it's not valid
-- if we didn't import Foo!) -- if we didn't import Foo!)
-> Module -> Module
-> RnM (Maybe [LIE GhcRn], [AvailInfo]) -> RnM (Maybe [(LIE GhcRn, Avails)], Avails)
-- (Nothing, _) <=> no explicit export list
-- if explicit export list is present it contains
-- each renamed export item together with its exported
-- names.
exports_from_avail Nothing rdr_env _imports _this_mod exports_from_avail Nothing rdr_env _imports _this_mod
-- The same as (module M) where M is the current module name, -- The same as (module M) where M is the current module name,
...@@ -197,10 +201,10 @@ exports_from_avail Nothing rdr_env _imports _this_mod ...@@ -197,10 +201,10 @@ exports_from_avail Nothing rdr_env _imports _this_mod
exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= do ExportAccum ie_names _ exports = do ExportAccum ie_avails _
<- foldAndRecoverM do_litem emptyExportAccum rdr_items <- foldAndRecoverM do_litem emptyExportAccum rdr_items
let final_exports = nubAvails exports -- Combine families let final_exports = nubAvails (concat (map snd ie_avails)) -- Combine families
return (Just ie_names, final_exports) return (Just ie_avails, final_exports)
where where
do_litem :: ExportAccum -> LIE GhcPs -> RnM ExportAccum do_litem :: ExportAccum -> LIE GhcPs -> RnM ExportAccum
do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie) do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
...@@ -215,10 +219,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ...@@ -215,10 +219,10 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
, imv <- importedByUser xs ] , imv <- importedByUser xs ]
exports_from_item :: ExportAccum -> LIE GhcPs -> RnM ExportAccum exports_from_item :: ExportAccum -> LIE GhcPs -> RnM ExportAccum
exports_from_item acc@(ExportAccum ie_names occs exports) exports_from_item acc@(ExportAccum ie_avails occs)
(L loc (IEModuleContents (L lm mod))) (L loc (IEModuleContents (L lm mod)))
| let earlier_mods = [ mod | let earlier_mods = [ mod
| (L _ (IEModuleContents (L _ mod))) <- ie_names ] | ((L _ (IEModuleContents (L _ mod))), _) <- ie_avails ]
, mod `elem` earlier_mods -- Duplicate export of M , mod `elem` earlier_mods -- Duplicate export of M
= do { warnIfFlag Opt_WarnDuplicateExports True = do { warnIfFlag Opt_WarnDuplicateExports True
(dupModuleExport mod) ; (dupModuleExport mod) ;
...@@ -251,14 +255,14 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ...@@ -251,14 +255,14 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
; traceRn "export_mod" ; traceRn "export_mod"
(vcat [ ppr mod (vcat [ ppr mod
, ppr new_exports ]) , ppr new_exports ])
; return (ExportAccum (L loc (IEModuleContents (L lm mod)) : ie_names)
occs'
(new_exports ++ exports)) }
exports_from_item acc@(ExportAccum lie_names occs exports) (L loc ie) ; return (ExportAccum (((L loc (IEModuleContents (L lm mod))), new_exports) : ie_avails)
occs') }
exports_from_item acc@(ExportAccum lie_avails occs) (L loc ie)
| isDoc ie | isDoc ie
= do new_ie <- lookup_doc_ie ie = do new_ie <- lookup_doc_ie ie
return (ExportAccum (L loc new_ie : lie_names) occs exports) return (ExportAccum ((L loc new_ie, []) : lie_avails) occs)
| otherwise | otherwise
= do (new_ie, avail) <- = do (new_ie, avail) <-
...@@ -269,7 +273,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod ...@@ -269,7 +273,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
occs' <- check_occs ie occs (availNames avail) occs' <- check_occs ie occs (availNames avail)
return (ExportAccum (L loc new_ie : lie_names) occs' (avail : exports)) return (ExportAccum ((L loc new_ie, [avail]) : lie_avails) occs')
------------- -------------
lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo) lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)
......
...@@ -614,10 +614,12 @@ data TcGblEnv ...@@ -614,10 +614,12 @@ data TcGblEnv
-- The binds, rules and foreign-decl fields are collected -- The binds, rules and foreign-decl fields are collected
-- initially in un-zonked form and are finally zonked in tcRnSrcDecls -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
tcg_rn_exports :: Maybe [Located (IE GhcRn)], tcg_rn_exports :: Maybe [(Located (IE GhcRn), Avails)],
-- Nothing <=> no explicit export list -- Nothing <=> no explicit export list
-- Is always Nothing if we don't want to retain renamed -- Is always Nothing if we don't want to retain renamed
-- exports -- exports.
-- If present contains each renamed export list item
-- together with its exported names.
tcg_rn_imports :: [LImportDecl GhcRn], tcg_rn_imports :: [LImportDecl GhcRn],
-- Keep the renamed imports regardless. They are not -- Keep the renamed imports regardless. They are not
......
Subproject commit 815d2deb9c0222c916becccf8464b740c26255fd Subproject commit 5fa4ef3028dfded480f7d54e4c736862e8892223
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