From ef16b9f8f73e6a4d639919152925ab83d9b1024f Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Fri, 8 Jun 2018 22:20:30 +0200 Subject: Renamer: Warn about ambiguous identifiers (#831) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Renamer: Warn about ambiguous identifiers Example: Warning: 'elem' is ambiguous. It is defined * in ‘Data.Foldable’ * at /home/simon/tmp/hdk/src/Lib.hs:7:1 You may be able to disambiguate the identifier by qualifying it or by hiding some imports. Defaulting to 'elem' defined at /home/simon/tmp/hdk/src/Lib.hs:7:1 Fixes #830. * Deduplicate warnings Fixes #832. --- haddock-api/src/Haddock/Interface.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock/Interface.hs') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 89064a6c..a66745ea 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -184,10 +184,10 @@ processModule verbosity modsum flags modMap instIfaceMap = do if not $ isBootSummary modsum then do out verbosity verbose "Creating interface..." - (interface, msg) <- {-# SCC createIterface #-} + (interface, msgs) <- {-# SCC createIterface #-} withTiming getDynFlags "createInterface" (const ()) $ do runWriterGhc $ createInterface tm flags modMap instIfaceMap - liftIO $ mapM_ putStrLn msg + liftIO $ mapM_ putStrLn (nub msgs) dflags <- getDynFlags let (haddockable, haddocked) = ifaceHaddockCoverage interface percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int -- cgit v1.2.3 From 1868443b01232d57ec11dfc831ac0a6915a2b337 Mon Sep 17 00:00:00 2001 From: Yuji Yamamoto Date: Mon, 23 Jul 2018 15:16:01 +0900 Subject: Avoid "invalid argument (invalid character)" on non-unicode Windows (#892) Steps to reproduce and the error message ==== ``` > stack haddock basement ... snip ... Warning: 'A' is out of scope. Warning: 'haddock: internal error: : commitBuffer: invalid argument (invalid character) ``` Environment ==== OS: Windows 10 ver. 1709 haddock: [HEAD of ghc-8.4 when I reproduce the error](https://github.com/haskell/haddock/commit/532b209d127e4cecdbf7e9e3dcf4f653a5605b5a). (I had to use this version to avoid another probrem already fixed in HEAD) GHC: 8.4.3 stack: Version 1.7.1, Git revision 681c800873816c022739ca7ed14755e85a579565 (5807 commits) x86_64 hpack-0.28.2 Related pull request ==== https://github.com/haskell/haddock/pull/566 --- haddock-api/src/Haddock/Interface.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'haddock-api/src/Haddock/Interface.hs') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index a66745ea..7c7f0e75 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -81,6 +81,7 @@ processModules processModules verbosity modules flags extIfaces = do #if defined(mingw32_HOST_OS) -- Avoid internal error: : hPutChar: invalid argument (invalid character)' non UTF-8 Windows + liftIO $ hSetEncoding stdout $ mkLocaleEncoding TransliterateCodingFailure liftIO $ hSetEncoding stderr $ mkLocaleEncoding TransliterateCodingFailure #endif -- cgit v1.2.3 From 40eb5aabed0ae52982a690be311177b2dea2a0bb Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Mon, 23 Jul 2018 13:23:35 -0700 Subject: Accumulate explicitly which modules to load for 'attachInstances' The old approach to fixing #469, while correct, consumes a lot of memory. We ended up with a HUGE 'GblRdrEnv' in 'ic_rn_gbl_env'. However, 'getNameToInstancesIndex' takes that environment and compresses it down to a much smaller 'ModuleSet'. Now, we compute that 'ModuleSet' explicitly as we process modules. That way we can just tell 'getNameToInstancesIndex' what modules to load (instead of it trying to compute that information from the interactive context). (cherry picked from commit 5c7c596c51d69b92164e9ba920157b36ce2b2ec1) --- haddock-api/src/Haddock/Interface.hs | 59 +++++++++++++--------- .../src/Haddock/Interface/AttachInstances.hs | 11 ++-- 2 files changed, 42 insertions(+), 28 deletions(-) (limited to 'haddock-api/src/Haddock/Interface.hs') diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index a66745ea..c330c5fe 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE CPP, OverloadedStrings, BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Haddock.Interface @@ -51,6 +51,7 @@ import System.Directory import System.FilePath import Text.Printf +import Module (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet) import Digraph import DynFlags hiding (verbosity) import Exception @@ -59,7 +60,9 @@ import HscTypes import FastString (unpackFS) import MonadUtils (liftIO) import TcRnTypes (tcg_rdr_env) -import RdrName (plusGlobalRdrEnv) +import Name (nameIsFromExternalPackage, nameOccName) +import OccName (isTcOcc) +import RdrName (unQualOK, gre_name, globalRdrEnvElts) import ErrUtils (withTiming) #if defined(mingw32_HOST_OS) @@ -87,7 +90,7 @@ processModules verbosity modules flags extIfaces = do out verbosity verbose "Creating interfaces..." let instIfaceMap = Map.fromList [ (instMod iface, iface) | ext <- extIfaces , iface <- ifInstalledIfaces ext ] - interfaces <- createIfaces0 verbosity modules flags instIfaceMap + (interfaces, ms) <- createIfaces0 verbosity modules flags instIfaceMap let exportedNames = Set.unions $ map (Set.fromList . ifaceExports) $ @@ -96,7 +99,7 @@ processModules verbosity modules flags extIfaces = do out verbosity verbose "Attaching instances..." interfaces' <- {-# SCC attachInstances #-} withTiming getDynFlags "attachInstances" (const ()) $ do - attachInstances (exportedNames, mods) interfaces instIfaceMap + attachInstances (exportedNames, mods) interfaces instIfaceMap ms out verbosity verbose "Building cross-linking environment..." -- Combine the link envs of the external packages into one @@ -120,7 +123,7 @@ processModules verbosity modules flags extIfaces = do -------------------------------------------------------------------------------- -createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface] +createIfaces0 :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc ([Interface], ModuleSet) createIfaces0 verbosity modules flags instIfaceMap = -- Output dir needs to be set before calling depanal since depanal uses it to -- compute output file names that are stored in the DynFlags of the @@ -150,43 +153,51 @@ createIfaces0 verbosity modules flags instIfaceMap = depanal [] False -createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc [Interface] +createIfaces :: Verbosity -> [Flag] -> InstIfaceMap -> ModuleGraph -> Ghc ([Interface], ModuleSet) createIfaces verbosity flags instIfaceMap mods = do let sortedMods = flattenSCCs $ topSortModuleGraph False mods Nothing out verbosity normal "Haddock coverage:" - (ifaces, _) <- foldM f ([], Map.empty) sortedMods - return (reverse ifaces) + (ifaces, _, !ms) <- foldM f ([], Map.empty, emptyModuleSet) sortedMods + return (reverse ifaces, ms) where - f (ifaces, ifaceMap) modSummary = do + f (ifaces, ifaceMap, !ms) modSummary = do x <- {-# SCC processModule #-} withTiming getDynFlags "processModule" (const ()) $ do processModule verbosity modSummary flags ifaceMap instIfaceMap return $ case x of - Just iface -> (iface:ifaces, Map.insert (ifaceMod iface) iface ifaceMap) - Nothing -> (ifaces, ifaceMap) -- Boot modules don't generate ifaces. + Just (iface, ms') -> ( iface:ifaces + , Map.insert (ifaceMod iface) iface ifaceMap + , unionModuleSet ms ms' ) + Nothing -> ( ifaces + , ifaceMap + , ms ) -- Boot modules don't generate ifaces. -processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe Interface) +processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> Ghc (Maybe (Interface, ModuleSet)) processModule verbosity modsum flags modMap instIfaceMap = do out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..." tm <- {-# SCC "parse/typecheck/load" #-} loadModule =<< typecheckModule =<< parseModule modsum - -- We need to modify the interactive context's environment so that when - -- Haddock later looks for instances, it also looks in the modules it - -- encountered while typechecking. - -- - -- See https://github.com/haskell/haddock/issues/469. - hsc_env@HscEnv{ hsc_IC = old_IC } <- getSession - let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm - setSession hsc_env{ hsc_IC = old_IC { - ic_rn_gbl_env = ic_rn_gbl_env old_IC `plusGlobalRdrEnv` new_rdr_env - } } - if not $ isBootSummary modsum then do out verbosity verbose "Creating interface..." (interface, msgs) <- {-# SCC createIterface #-} withTiming getDynFlags "createInterface" (const ()) $ do runWriterGhc $ createInterface tm flags modMap instIfaceMap + + -- We need to keep track of which modules were somehow in scope so that when + -- Haddock later looks for instances, it also looks in these modules too. + -- + -- See https://github.com/haskell/haddock/issues/469. + hsc_env <- getSession + let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm + this_pkg = thisPackage (hsc_dflags hsc_env) + !mods = mkModuleSet [ nameModule name + | gre <- globalRdrEnvElts new_rdr_env + , let name = gre_name gre + , nameIsFromExternalPackage this_pkg name + , isTcOcc (nameOccName name) -- Types and classes only + , unQualOK gre ] -- In scope unqualified + liftIO $ mapM_ putStrLn (nub msgs) dflags <- getDynFlags let (haddockable, haddocked) = ifaceHaddockCoverage interface @@ -220,7 +231,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do unless header $ out verbosity normal " Module header" mapM_ (out verbosity normal . (" " ++)) undocumentedExports interface' <- liftIO $ evaluate interface - return (Just interface') + return (Just (interface', mods)) else return Nothing diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index bf50ded3..2d72d117 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash #-} +{-# LANGUAGE CPP, MagicHash, BangPatterns #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -34,6 +34,7 @@ import FamInstEnv import FastString import GHC import InstEnv +import Module ( ModuleSet, moduleSetElts ) import MonadUtils (liftIO) import Name import NameEnv @@ -51,11 +52,13 @@ type Modules = Set.Set Module type ExportInfo = (ExportedNames, Modules) -- Also attaches fixities -attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface] -attachInstances expInfo ifaces instIfaceMap = do - (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces) +attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> ModuleSet -> Ghc [Interface] +attachInstances expInfo ifaces instIfaceMap mods = do + (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces) mods' mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces where + mods' = Just (moduleSetElts mods) + -- TODO: take an IfaceMap as input ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ] -- cgit v1.2.3