diff options
Diffstat (limited to 'ghc')
| -rw-r--r-- | ghc/GHCi/UI.hs | 46 |
1 files changed, 27 insertions, 19 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index aeab85bcca..99786b550a 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -104,7 +104,7 @@ import Data.Time.Format ( formatTime, defaultTimeLocale ) import Data.Version ( showVersion ) import Exception hiding (catch) -import Foreign +import Foreign hiding (void) import GHC.Stack hiding (SrcLoc(..)) import System.Directory @@ -186,15 +186,15 @@ ghciCommands = map mkCmd [ ("issafe", keepGoing' isSafeCmd, completeModule), ("kind", keepGoing' (kindOfType False), completeIdentifier), ("kind!", keepGoing' (kindOfType True), completeIdentifier), - ("load", keepGoingPaths (loadModule_ False), completeHomeModuleOrFile), - ("load!", keepGoingPaths (loadModule_ True), completeHomeModuleOrFile), + ("load", keepGoingPaths loadModule_, completeHomeModuleOrFile), + ("load!", keepGoingPaths loadModuleDefer, completeHomeModuleOrFile), ("list", keepGoing' listCmd, noCompletion), ("module", keepGoing moduleCmd, completeSetModule), ("main", keepGoing runMain, completeFilename), ("print", keepGoing printCmd, completeExpression), ("quit", quit, noCompletion), - ("reload", keepGoing' (reloadModule False), noCompletion), - ("reload!", keepGoing' (reloadModule True), noCompletion), + ("reload", keepGoing' reloadModule, noCompletion), + ("reload!", keepGoing' reloadModuleDefer, noCompletion), ("run", keepGoing runRun, completeFilename), ("script", keepGoing' scriptCmd, completeFilename), ("set", keepGoing setCmd, completeSetOptions), @@ -1444,7 +1444,7 @@ editFile str = code <- liftIO $ system (cmd ++ cmdArgs) when (code == ExitSuccess) - $ reloadModule False "" + $ reloadModule "" -- The user didn't specify a file so we pick one for them. -- Our strategy is to pick the first module that failed to load, @@ -1604,21 +1604,27 @@ checkModule m = do -- | Sets '-fdefer-type-errors' if 'defer' is true, executes 'load' and unsets -- '-fdefer-type-errors' again if it has not been set before. -deferredLoad :: Bool -> InputT GHCi SuccessFlag -> InputT GHCi () -deferredLoad defer load = do - -- Force originalFlags to avoid leaking the associated HscEnv - !originalFlags <- getDynFlags - when defer $ Monad.void $ - GHC.setProgramDynFlags $ setGeneralFlag' Opt_DeferTypeErrors originalFlags - Monad.void $ load - Monad.void $ GHC.setProgramDynFlags $ originalFlags +wrapDeferTypeErrors :: InputT GHCi a -> InputT GHCi a +wrapDeferTypeErrors load = + gbracket + (do + -- Force originalFlags to avoid leaking the associated HscEnv + !originalFlags <- getDynFlags + void $ GHC.setProgramDynFlags $ + setGeneralFlag' Opt_DeferTypeErrors originalFlags + return originalFlags) + (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags) + (\_ -> load) loadModule :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule fs = timeIt (const Nothing) (loadModule' fs) -- | @:load@ command -loadModule_ :: Bool -> [FilePath] -> InputT GHCi () -loadModule_ defer fs = deferredLoad defer (loadModule (zip fs (repeat Nothing))) +loadModule_ :: [FilePath] -> InputT GHCi () +loadModule_ fs = void $ loadModule (zip fs (repeat Nothing)) + +loadModuleDefer :: [FilePath] -> InputT GHCi () +loadModuleDefer = wrapDeferTypeErrors . loadModule_ loadModule' :: [(FilePath, Maybe Phase)] -> InputT GHCi SuccessFlag loadModule' files = do @@ -1654,13 +1660,15 @@ addModule files = do return () -- | @:reload@ command -reloadModule :: Bool -> String -> InputT GHCi () -reloadModule defer m = deferredLoad defer $ - doLoadAndCollectInfo True loadTargets +reloadModule :: String -> InputT GHCi () +reloadModule m = void $ doLoadAndCollectInfo True loadTargets where loadTargets | null m = LoadAllTargets | otherwise = LoadUpTo (GHC.mkModuleName m) +reloadModuleDefer :: String -> InputT GHCi () +reloadModuleDefer = wrapDeferTypeErrors . reloadModule + -- | Load/compile targets and (optionally) collect module-info -- -- This collects the necessary SrcSpan annotated type information (via |