diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2016-01-09 16:59:05 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2016-01-15 15:43:43 -0500 |
| commit | d459f55c36c50ae02c55a7fb1331ef81af6751f5 (patch) | |
| tree | 8bb736c6158cbd8dbdbeb1916ba3420f187cd9d1 /compiler/main/HscMain.hs | |
| parent | d4af57fa2a2af0b369087c13c0c7dae869e323bd (diff) | |
| download | haskell-d459f55c36c50ae02c55a7fb1331ef81af6751f5.tar.gz | |
Fix #10872.
This moves the duplicate-unique check from knownKeyNames (which omits
TH) to allKnownKeyNames (which includes TH).
Diffstat (limited to 'compiler/main/HscMain.hs')
| -rw-r--r-- | compiler/main/HscMain.hs | 33 |
1 files changed, 30 insertions, 3 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 7807f653e3..f8945b2a76 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -148,6 +148,8 @@ import DynFlags import ErrUtils import Outputable +import UniqFM +import NameEnv import HscStats ( ppSourceStats ) import HscTypes import FastString @@ -199,12 +201,37 @@ newHscEnv dflags = do allKnownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta, -allKnownKeyNames = -- where templateHaskellNames are defined - knownKeyNames +allKnownKeyNames -- where templateHaskellNames are defined + | debugIsOn + , not (isNullUFM badNamesEnv) + = panic ("badAllKnownKeyNames:\n" ++ badNamesStr) + -- NB: We can't use ppr here, because this is sometimes evaluated in a + -- context where there are no DynFlags available, leading to a cryptic + -- "<<details unavailable>>" error. (This seems to happen only in the + -- stage 2 compiler, for reasons I [Richard] have no clue of.) + + | otherwise + = all_names + where + all_names = knownKeyNames #ifdef GHCI - ++ templateHaskellNames + ++ templateHaskellNames #endif + namesEnv = foldl (\m n -> extendNameEnv_Acc (:) singleton m n n) + emptyUFM all_names + badNamesEnv = filterNameEnv (\ns -> length ns > 1) namesEnv + badNamesPairs = nameEnvUniqueElts badNamesEnv + badNamesStrs = map pairToStr badNamesPairs + badNamesStr = unlines badNamesStrs + + pairToStr (uniq, ns) = " " ++ + show uniq ++ + ": [" ++ + intercalate ", " (map (occNameString . nameOccName) ns) ++ + "]" + + -- ----------------------------------------------------------------------------- getWarnings :: Hsc WarningMessages |