From 4905b83a2d448c65ccced385343d4e8124548a3b Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 18 Nov 2015 16:42:24 +0000 Subject: Remote GHCi, -fexternal-interpreter Summary: (Apologies for the size of this patch, I couldn't make a smaller one that was validate-clean and also made sense independently) (Some of this code is derived from GHCJS.) This commit adds support for running interpreted code (for GHCi and TemplateHaskell) in a separate process. The functionality is experimental, so for now it is off by default and enabled by the flag -fexternal-interpreter. Reaosns we want this: * compiling Template Haskell code with -prof does not require building the code without -prof first * when GHC itself is profiled, it can interpret unprofiled code, and the same applies to dynamic linking. We would no longer need to force -dynamic-too with TemplateHaskell, and we can load ordinary objects into a dynamically-linked GHCi (and vice versa). * An unprofiled GHCi can load and run profiled code, which means it can use the stack-trace functionality provided by profiling without taking the performance hit on the compiler that profiling would entail. Amongst other things; see https://ghc.haskell.org/trac/ghc/wiki/RemoteGHCi for more details. Notes on the implementation are in Note [Remote GHCi] in the new module compiler/ghci/GHCi.hs. It probably needs more documenting, feel free to suggest things I could elaborate on. Things that are not currently implemented for -fexternal-interpreter: * The GHCi debugger * :set prog, :set args in GHCi * `recover` in Template Haskell * Redirecting stdin/stdout for the external process These are all doable, I just wanted to get to a working validate-clean patch first. I also haven't done any benchmarking yet. I expect there to be slight hit to link times for byte code and some penalty due to having to serialize/deserialize TH syntax, but I don't expect it to be a serious problem. There's also lots of low-hanging fruit in the byte code generator/linker that we could exploit to speed things up. Test Plan: * validate * I've run parts of the test suite with EXTRA_HC_OPTS=-fexternal-interpreter, notably tests/ghci and tests/th. There are a few failures due to the things not currently implemented (see above). Reviewers: simonpj, goldfire, ezyang, austin, alanz, hvr, niteria, bgamari, gibiansky, luite Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1562 --- ghc/Main.hs | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) (limited to 'ghc/Main.hs') diff --git a/ghc/Main.hs b/ghc/Main.hs index c85f0b3a8b..7d4e1e235c 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -166,20 +166,7 @@ main' postLoadMode dflags0 args flagWarnings = do DoAbiHash -> (OneShot, dflt_target, LinkBinary) _ -> (OneShot, dflt_target, LinkBinary) - let dflags1 = case lang of - HscInterpreted -> - let platform = targetPlatform dflags0 - dflags0a = updateWays $ dflags0 { ways = interpWays } - dflags0b = foldl gopt_set dflags0a - $ concatMap (wayGeneralFlags platform) - interpWays - dflags0c = foldl gopt_unset dflags0b - $ concatMap (wayUnsetGeneralFlags platform) - interpWays - in dflags0c - _ -> - dflags0 - dflags2 = dflags1{ ghcMode = mode, + let dflags1 = dflags0{ ghcMode = mode, hscTarget = lang, ghcLink = link, verbosity = case postLoadMode of @@ -191,14 +178,29 @@ main' postLoadMode dflags0 args flagWarnings = do -- can be overriden from the command-line -- XXX: this should really be in the interactive DynFlags, but -- we don't set that until later in interactiveUI - dflags3 | DoInteractive <- postLoadMode = imp_qual_enabled + dflags2 | DoInteractive <- postLoadMode = imp_qual_enabled | DoEval _ <- postLoadMode = imp_qual_enabled - | otherwise = dflags2 - where imp_qual_enabled = dflags2 `gopt_set` Opt_ImplicitImportQualified + | otherwise = dflags1 + where imp_qual_enabled = dflags1 `gopt_set` Opt_ImplicitImportQualified -- The rest of the arguments are "dynamic" -- Leftover ones are presumably files - (dflags4, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags3 args + (dflags3, fileish_args, dynamicFlagWarnings) <- + GHC.parseDynamicFlags dflags2 args + + let dflags4 = case lang of + HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) -> + let platform = targetPlatform dflags3 + dflags3a = updateWays $ dflags3 { ways = interpWays } + dflags3b = foldl gopt_set dflags3a + $ concatMap (wayGeneralFlags platform) + interpWays + dflags3c = foldl gopt_unset dflags3b + $ concatMap (wayUnsetGeneralFlags platform) + interpWays + in dflags3c + _ -> + dflags3 GHC.prettyPrintGhcErrors dflags4 $ do @@ -209,9 +211,6 @@ main' postLoadMode dflags0 args flagWarnings = do liftIO $ exitWith (ExitFailure 1)) $ do liftIO $ handleFlagWarnings dflags4 flagWarnings' - -- make sure we clean up after ourselves - GHC.defaultCleanupHandler dflags4 $ do - liftIO $ showBanner postLoadMode dflags4 let @@ -336,9 +335,10 @@ checkOptions mode dflags srcs objs = do -- -prof and --interactive are not a good combination when ((filter (not . wayRTSOnly) (ways dflags) /= interpWays) - && isInterpretiveMode mode) $ + && isInterpretiveMode mode + && not (gopt Opt_ExternalInterpreter dflags)) $ do throwGhcException (UsageError - "--interactive can't be used with -prof or -static.") + "-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).") -- -ohi sanity check if (isJust (outputHi dflags) && (isCompManagerMode mode || srcs `lengthExceeds` 1)) -- cgit v1.2.1