diff options
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/check-exact/Main.hs | 31 | ||||
| -rw-r--r-- | utils/check-ppr/Main.hs | 24 |
2 files changed, 20 insertions, 35 deletions
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index d0971dac65..04ec500e8b 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -10,9 +10,12 @@ import Data.List (intercalate) import Data.Data import GHC.Types.Name.Occurrence import GHC.Types.Name.Reader +import GHC.Unit.Module.ModSummary +import Control.Monad.IO.Class import GHC hiding (moduleName) import GHC.Driver.Ppr import GHC.Driver.Session +import GHC.Driver.Make import GHC.Hs.Dump import GHC.Data.Bag import System.Environment( getArgs ) @@ -334,29 +337,19 @@ ppAst :: Data a => a -> String ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast parseOneFile :: FilePath -> FilePath -> IO (ParsedModule, [Located Token]) -parseOneFile libdir fileName = do - let modByFile m = - case ml_hs_file $ ms_location m of - Nothing -> False - Just fn -> fn == fileName +parseOneFile libdir fileName = runGhc (Just libdir) $ do dflags <- getSessionDynFlags let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream _ <- setSessionDynFlags dflags2 - addTarget Target { targetId = TargetFile fileName Nothing - , targetUnitId = homeUnitId_ dflags - , targetAllowObjCode = True - , targetContents = Nothing } - _ <- load LoadAllTargets - graph <- getModuleGraph - let - modSum = case filter modByFile (mgModSummaries graph) of - [x] -> x - xs -> error $ "Can't find module, got:" - ++ show (map (ml_hs_file . ms_location) xs) - pm <- GHC.parseModule modSum - toks <- getTokenStream (ms_mod modSum) - return (pm, toks) + hsc_env <- getSession + emodSum <- liftIO $ summariseFile hsc_env [] fileName Nothing True Nothing + case emsModSummary <$> emodSum of + Left _err -> error "parseOneFile" + Right modSum -> do + pm <- GHC.parseModule modSum + toks <- liftIO $ getTokenStream modSum + return (pm, toks) -- --------------------------------------------------------------------- diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs index 542a35780e..80828874f6 100644 --- a/utils/check-ppr/Main.hs +++ b/utils/check-ppr/Main.hs @@ -5,11 +5,14 @@ import Data.List import Data.Data +import Control.Monad.IO.Class import GHC.Types.SrcLoc import GHC hiding (moduleName) import GHC.Hs.Dump import GHC.Driver.Session import GHC.Driver.Ppr +import GHC.Driver.Make +import GHC.Unit.Module.ModSummary import GHC.Utils.Outputable hiding (space) import System.Environment( getArgs ) import System.Exit @@ -77,26 +80,15 @@ testOneFile libdir fileName = do parseOneFile :: FilePath -> FilePath -> IO ParsedModule parseOneFile libdir fileName = do - let modByFile m = - case ml_hs_file $ ms_location m of - Nothing -> False - Just fn -> fn == fileName runGhc (Just libdir) $ do dflags <- getSessionDynFlags let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream _ <- setSessionDynFlags dflags2 - addTarget Target { targetId = TargetFile fileName Nothing - , targetAllowObjCode = True - , targetUnitId = homeUnitId_ dflags - , targetContents = Nothing } - _ <- load LoadAllTargets - graph <- getModuleGraph - let - modSum = case filter modByFile (mgModSummaries graph) of - [x] -> x - xs -> error $ "Can't find module, got:" - ++ show (map (ml_hs_file . ms_location) xs) - parseModule modSum + hsc_env <- getSession + ms <- liftIO $ summariseFile hsc_env [] fileName Nothing True Nothing + case ms of + Left _err -> error "parseOneFile" + Right ems -> parseModule (emsModSummary ems) getPragmas :: Located HsModule -> String getPragmas (L _ (HsModule { hsmodAnn = anns'})) = pragmaStr |