X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=5289f71ef0a7ffc2897572736caf9be8e37414e3;hp=76bbeb27608a8cdc09aa860b495f51208ccbe973;hb=2fe38b5fb0957f9428864afd69ad3ccd82fae3d0;hpb=9d0c8f842e35dde3d570580cf62a32779f66a6de diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 76bbeb2..5289f71 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -58,9 +58,6 @@ module GHC ( compileCoreToObj, getModSummary, - -- * Parsing Haddock comments - parseHaddockComment, - -- * Inspecting the module structure of the program ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..), getModuleGraph, @@ -245,7 +242,6 @@ import qualified Linker import Linker ( HValue ) import ByteCodeInstr import BreakArray -import NameSet import InteractiveEval import TcRnDriver #endif @@ -265,10 +261,10 @@ import Var import TysPrim ( alphaTyVars ) import TyCon import Class -import FunDeps +-- import FunDeps import DataCon import Name hiding ( varName ) -import OccName ( parenSymOcc ) +-- import OccName ( parenSymOcc ) import InstEnv ( Instance, instanceDFunId, pprInstance, pprInstanceHdr, emptyInstEnv ) import FamInstEnv ( emptyFamInstEnv ) @@ -276,7 +272,7 @@ import SrcLoc --import CoreSyn import TidyPgm import DriverPipeline -import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase ) +import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase ) import HeaderInfo import Finder import HscMain @@ -301,8 +297,6 @@ import StringBuffer ( StringBuffer, hGetStringBuffer, nextChar ) import Outputable import BasicTypes import Maybes ( expectJust, mapCatMaybes ) -import HaddockParse -import HaddockLex ( tokenise ) import FastString import Lexer @@ -627,15 +621,6 @@ setGlobalTypeScope ids hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids } -- ----------------------------------------------------------------------------- --- Parsing Haddock comments - -parseHaddockComment :: String -> Either String (HsDoc RdrName) -parseHaddockComment string = - case parseHaddockParagraphs (tokenise string) of - MyLeft x -> Left x - MyRight x -> Right x - --- ----------------------------------------------------------------------------- -- Loading the program -- | Perform a dependency analysis starting from the current targets @@ -1036,7 +1021,7 @@ instance DesugaredMod DesugaredModule where type ParsedSource = Located (HsModule RdrName) type RenamedSource = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], - Maybe (HsDoc Name), HaddockModInfo Name) + Maybe LHsDocString) type TypecheckedSource = LHsBinds Id -- NOTE: @@ -2333,18 +2318,28 @@ cyclicModuleErr ms = hang (ptext (sLit "Module imports form a cycle for modules:")) 2 (vcat (map show_one ms)) where - show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms), - nest 2 $ ptext (sLit "imports:") <+> - (pp_imps HsBootFile (ms_srcimps ms) - $$ pp_imps HsSrcFile (ms_imps ms))] + mods_in_cycle = map ms_mod_name ms + imp_modname = unLoc . ideclName . unLoc + just_in_cycle = filter ((`elem` mods_in_cycle) . imp_modname) + + show_one ms = + vcat [ show_mod (ms_hsc_src ms) (ms_mod_name ms) <+> + maybe empty (parens . text) (ml_hs_file (ms_location ms)), + nest 2 $ ptext (sLit "imports:") <+> vcat [ + pp_imps HsBootFile (just_in_cycle $ ms_srcimps ms), + pp_imps HsSrcFile (just_in_cycle $ ms_imps ms) ] + ] show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src) - pp_imps src mods = fsep (map (show_mod src) mods) + pp_imps src imps = fsep (map (show_mod src . unLoc . ideclName . unLoc) imps) -- | Inform GHC that the working directory has changed. GHC will flush -- its cache of module locations, since it may no longer be valid. --- Note: if you change the working directory, you should also unload --- the current program (set targets to empty, followed by load). +-- +-- Note: Before changing the working directory make sure all threads running +-- in the same session have stopped. If you change the working directory, +-- you should also unload the current program (set targets to empty, +-- followed by load). workingDirectoryChanged :: GhcMonad m => m () workingDirectoryChanged = withSession $ (liftIO . flushFinderCaches) @@ -2534,7 +2529,7 @@ packageDbModules only_exposed = do return $ [ mkModule pid modname | p <- pkgs , not only_exposed || exposed p - , pid <- [mkPackageId (package p)] + , let pid = packageConfigId p , modname <- exposedModules p ] -- ----------------------------------------------------------------------------- @@ -2585,7 +2580,7 @@ getModuleSourceAndFlags mod = do getTokenStream :: GhcMonad m => Module -> m [Located Token] getTokenStream mod = do (sourceFile, source, flags) <- getModuleSourceAndFlags mod - let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0 + let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1 case lexTokenStream source startLoc flags of POk _ ts -> return ts PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err) @@ -2596,7 +2591,7 @@ getTokenStream mod = do getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)] getRichTokenStream mod = do (sourceFile, source, flags) <- getModuleSourceAndFlags mod - let startLoc = mkSrcLoc (mkFastString sourceFile) 0 0 + let startLoc = mkSrcLoc (mkFastString sourceFile) 1 1 case lexTokenStream source startLoc flags of POk _ ts -> return $ addSourceToTokens startLoc source ts PFailed span err -> throw $ mkSrcErr (unitBag $ mkPlainErrMsg span err) @@ -2627,7 +2622,7 @@ addSourceToTokens loc buf (t@(L span _) : ts) showRichTokenStream :: [(Located Token, String)] -> String showRichTokenStream ts = go startLoc ts "" where sourceFile = srcSpanFile (getLoc . fst . head $ ts) - startLoc = mkSrcLoc sourceFile 0 0 + startLoc = mkSrcLoc sourceFile 1 1 go _ [] = id go loc ((L span _, str):ts) | not (isGoodSrcSpan span) = go loc ts