Multiple Home Units

Multiple home units allows you to load different packages which may depend on
each other into one GHC session. This will allow both GHCi and HLS to support
multi component projects more naturally.

Public Interface
~~~~~~~~~~~~~~~~

In order to specify multiple units, the -unit @⟨filename⟩ flag
is given multiple times with a response file containing the arguments for each unit.
The response file contains a newline separated list of arguments.

```
ghc -unit @unitLibCore -unit @unitLib
```

where the `unitLibCore` response file contains the normal arguments that cabal would pass to `--make` mode.

```
-this-unit-id lib-core-0.1.0.0
-i
-isrc
LibCore.Utils
LibCore.Types
```

The response file for lib, can specify a dependency on lib-core, so then modules in lib can use modules from lib-core.

```
-this-unit-id lib-0.1.0.0
-package-id lib-core-0.1.0.0
-i
-isrc
Lib.Parse
Lib.Render
```

Then when the compiler starts in --make mode it will compile both units lib and lib-core.

There is also very basic support for multiple home units in GHCi, at the
moment you can start a GHCi session with multiple units but only the
:reload is supported. Most commands in GHCi assume a single home unit,
and so it is additional work to work out how to modify the interface to
support multiple loaded home units.

Options used when working with Multiple Home Units

There are a few extra flags which have been introduced specifically for
working with multiple home units. The flags allow a home unit to pretend
it’s more like an installed package, for example, specifying the package
name, module visibility and reexported modules.

-working-dir ⟨dir⟩

    It is common to assume that a package is compiled in the directory
    where its cabal file resides. Thus, all paths used in the compiler
    are assumed to be relative to this directory. When there are
    multiple home units the compiler is often not operating in the
    standard directory and instead where the cabal.project file is
    located. In this case the -working-dir option can be passed which
    specifies the path from the current directory to the directory the
    unit assumes to be it’s root, normally the directory which contains
    the cabal file.

    When the flag is passed, any relative paths used by the compiler are
    offset by the working directory. Notably this includes -i and
    -I⟨dir⟩ flags.

-this-package-name ⟨name⟩

    This flag papers over the awkward interaction of the PackageImports
    and multiple home units. When using PackageImports you can specify
    the name of the package in an import to disambiguate between modules
    which appear in multiple packages with the same name.

    This flag allows a home unit to be given a package name so that you
    can also disambiguate between multiple home units which provide
    modules with the same name.

-hidden-module ⟨module name⟩

    This flag can be supplied multiple times in order to specify which
    modules in a home unit should not be visible outside of the unit it
    belongs to.

    The main use of this flag is to be able to recreate the difference
    between an exposed and hidden module for installed packages.

-reexported-module ⟨module name⟩

    This flag can be supplied multiple times in order to specify which
    modules are not defined in a unit but should be reexported. The
    effect is that other units will see this module as if it was defined
    in this unit.

    The use of this flag is to be able to replicate the reexported
    modules feature of packages with multiple home units.

Offsetting Paths in Template Haskell splices
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

When using Template Haskell to embed files into your program,
traditionally the paths have been interpreted relative to the directory
where the .cabal file resides. This causes problems for multiple home
units as we are compiling many different libraries at once which have
.cabal files in different directories.

For this purpose we have introduced a way to query the value of the
-working-dir flag to the Template Haskell API. By using this function we
can implement a makeRelativeToProject function which offsets a path
which is relative to the original project root by the value of
-working-dir.

```
import Language.Haskell.TH.Syntax ( makeRelativeToProject )

foo = $(makeRelativeToProject "./relative/path" >>= embedFile)
```

> If you write a relative path in a Template Haskell splice you should use the makeRelativeToProject function so that your library works correctly with multiple home units.

A similar function already exists in the file-embed library. The
function in template-haskell implements this function in a more robust
manner by honouring the -working-dir flag rather than searching the file
system.

Closure Property for Home Units
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For tools or libraries using the API there is one very important closure
property which must be adhered to:

> Any dependency which is not a home unit must not (transitively) depend
  on a home unit.

For example, if you have three packages p, q and r, then if p depends on
q which depends on r then it is illegal to load both p and r as home
units but not q, because q is a dependency of the home unit p which
depends on another home unit r.

If you are using GHC by the command line then this property is checked,
but if you are using the API then you need to check this property
yourself. If you get it wrong you will probably get some very confusing
errors about overlapping instances.

Limitations of Multiple Home Units
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

There are a few limitations of the initial implementation which will be smoothed out on user demand.

    * Package thinning/renaming syntax is not supported
    * More complicated reexports/renaming are not yet supported.
    * It’s more common to run into existing linker bugs when loading a
      large number of packages in a session (for example #20674, #20689)
    * Backpack is not yet supported when using multiple home units.
    * Dependency chasing can be quite slow with a large number of
      modules and packages.
    * Loading wired-in packages as home units is currently not supported
      (this only really affects GHC developers attempting to load
      template-haskell).
    * Barely any normal GHCi features are supported, it would be good to
      support enough for ghcid to work correctly.

Despite these limitations, the implementation works already for nearly
all packages. It has been testing on large dependency closures,
including the whole of head.hackage which is a total of 4784 modules
from 452 packages.

Internal Changes
~~~~~~~~~~~~~~~~

* The biggest change is that the HomePackageTable is replaced with the
  HomeUnitGraph. The HomeUnitGraph is a map from UnitId to HomeUnitEnv,
  which contains information specific to each home unit.
* The HomeUnitEnv contains:
    - A unit state, each home unit can have different package db flags
    - A set of dynflags, each home unit can have different flags
    - A HomePackageTable
* LinkNode: A new node type is added to the ModuleGraph, this is used to
  place the linking step into the build plan so linking can proceed in
  parralel with other packages being built.
* New invariant: Dependencies of a ModuleGraphNode can be completely
  determined by looking at the value of the node. In order to achieve
  this, downsweep now performs a more complete job of downsweeping and
  then the dependenices are recorded forever in the node rather than
  being computed again from the ModSummary.
* Some transitive module calculations are rewritten to use the
  ModuleGraph which is more efficient.
* There is always an active home unit, which simplifies modifying a lot
  of the existing API code which is unit agnostic (for example, in the
  driver).

The road may be bumpy for a little while after this change but the
basics are well-tested.

One small metric increase, which we accept and also submodule update to
haddock which removes ExtendedModSummary.

Closes #10827

-------------------------
Metric Increase:
    MultiLayerModules
-------------------------

Co-authored-by: Fendor <power.walross@gmail.com>

3 files changed, 337 insertions, 101 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 137619100b..a51d30232c 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -51,7 +51,6 @@ import GHC.Driver.Session as DynFlags
 import GHC.Driver.Ppr hiding (printForUser)
 import GHC.Utils.Error hiding (traceCmd)
 import GHC.Driver.Monad ( modifySession )
-import GHC.Driver.Config.Finder (initFinderOpts)
 import GHC.Driver.Config.Parser (initParserOpts)
 import GHC.Driver.Config.Diagnostic
 import qualified GHC
@@ -162,6 +161,7 @@ import GHC.IO.Handle ( hFlushAll )
 import GHC.TopHandler ( topHandler )
 
 import GHCi.Leak
+import qualified GHC.Unit.Module.Graph as GHC
 
 -----------------------------------------------------------------------------
 
@@ -197,7 +197,7 @@ ghciCommands = map mkCmd [
   ("back",      keepGoing backCmd,              noCompletion),
   ("browse",    keepGoing' (browseCmd False),   completeModule),
   ("browse!",   keepGoing' (browseCmd True),    completeModule),
-  ("cd",        keepGoing' changeDirectory,     completeFilename),
+  ("cd",        keepGoingMulti' changeDirectory,     completeFilename),
   ("check",     keepGoing' checkModule,         completeHomeModule),
   ("continue",  keepGoing continueCmd,          noCompletion),
   ("cmd",       keepGoing cmdCmd,               completeExpression),
@@ -213,14 +213,14 @@ ghciCommands = map mkCmd [
   ("etags",     keepGoing createETagsFileCmd,   completeFilename),
   ("force",     keepGoing forceCmd,             completeExpression),
   ("forward",   keepGoing forwardCmd,           noCompletion),
-  ("help",      keepGoing help,                 noCompletion),
-  ("history",   keepGoing historyCmd,           noCompletion),
-  ("info",      keepGoing' (info False),        completeIdentifier),
-  ("info!",     keepGoing' (info True),         completeIdentifier),
+  ("help",      keepGoingMulti help,                 noCompletion),
+  ("history",   keepGoingMulti historyCmd,           noCompletion),
+  ("info",      keepGoingMulti' (info False),        completeIdentifier),
+  ("info!",     keepGoingMulti' (info True),         completeIdentifier),
   ("issafe",    keepGoing' isSafeCmd,           completeModule),
   ("ignore",    keepGoing ignoreCmd,            noCompletion),
-  ("kind",      keepGoing' (kindOfType False),  completeIdentifier),
-  ("kind!",     keepGoing' (kindOfType True),   completeIdentifier),
+  ("kind",      keepGoingMulti' (kindOfType False),  completeIdentifier),
+  ("kind!",     keepGoingMulti' (kindOfType True),   completeIdentifier),
   ("load",      keepGoingPaths loadModule_,     completeHomeModuleOrFile),
   ("load!",     keepGoingPaths loadModuleDefer, completeHomeModuleOrFile),
   ("list",      keepGoing' listCmd,             noCompletion),
@@ -228,19 +228,19 @@ ghciCommands = map mkCmd [
   ("main",      keepGoing runMain,              completeFilename),
   ("print",     keepGoing printCmd,             completeExpression),
   ("quit",      quit,                           noCompletion),
-  ("reload",    keepGoing' reloadModule,        noCompletion),
-  ("reload!",   keepGoing' reloadModuleDefer,   noCompletion),
+  ("reload",    keepGoingMulti' reloadModule,   noCompletion),
+  ("reload!",   keepGoingMulti' reloadModuleDefer,   noCompletion),
   ("run",       keepGoing runRun,               completeFilename),
   ("script",    keepGoing' scriptCmd,           completeFilename),
   ("set",       keepGoing setCmd,               completeSetOptions),
   ("seti",      keepGoing setiCmd,              completeSeti),
-  ("show",      keepGoing showCmd,              completeShowOptions),
+  ("show",      keepGoingMulti' showCmd,              completeShowOptions),
   ("showi",     keepGoing showiCmd,             completeShowiOptions),
   ("sprint",    keepGoing sprintCmd,            completeExpression),
   ("step",      keepGoing stepCmd,              completeIdentifier),
   ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
   ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
-  ("type",      keepGoing' typeOfExpr,          completeExpression),
+  ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
   ("trace",     keepGoing traceCmd,             completeExpression),
   ("unadd",     keepGoingPaths unAddModule,     completeFilename),
   ("undef",     keepGoing undefineMacro,        completeMacro),
@@ -294,15 +294,31 @@ flagWordBreakChars = " \t\n"
 keepGoing :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
 keepGoing a str = keepGoing' (lift . a) str
 
-keepGoing' :: Monad m => (String -> m ()) -> String -> m Bool
-keepGoing' a str = a str >> return False
+keepGoingMulti :: (String -> GHCi ()) -> (String -> InputT GHCi Bool)
+keepGoingMulti a str = keepGoingMulti' (lift . a) str
+
+keepGoing' :: GhciMonad m => (a -> m ()) -> a -> m Bool
+keepGoing' a str = do
+  in_multi <- inMultiMode
+  if in_multi
+    then
+      liftIO $ hPutStrLn stderr "Command is not supported (yet) in multi-mode"
+    else
+      a str
+  return False
+
+-- For commands which are actually support in multi-mode, initially just :reload
+keepGoingMulti' :: GhciMonad m => (String -> m ()) -> String -> m Bool
+keepGoingMulti' a str = a str >> return False
+
+inMultiMode :: GhciMonad m => m Bool
+inMultiMode = multiMode <$> getGHCiState
 
 keepGoingPaths :: ([FilePath] -> InputT GHCi ()) -> (String -> InputT GHCi Bool)
 keepGoingPaths a str
  = do case toArgsNoLoc str of
-          Left err -> liftIO $ hPutStrLn stderr err
-          Right args -> a args
-      return False
+          Left err -> liftIO $ hPutStrLn stderr err >> return False
+          Right args -> keepGoing' a args
 
 defShortHelpText :: String
 defShortHelpText = "use :? for help.\n"
@@ -456,9 +472,12 @@ default_prompt_cont = generatePromptFunctionFromString "ghci| "
 default_args :: [String]
 default_args = []
 
-interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
+interactiveUI :: GhciSettings -> [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String]
               -> Ghc ()
 interactiveUI config srcs maybe_exprs = do
+   -- This is a HACK to make sure dynflags are not overwritten when setting
+   -- options. When GHCi is made properly multi component it should be removed.
+   modifySession (\env -> hscSetActiveUnitId (hscActiveUnitId env) env)
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -517,6 +536,8 @@ interactiveUI config srcs maybe_exprs = do
    default_editor <- liftIO $ findEditor
    eval_wrapper <- mkEvalWrapper default_progname default_args
    let prelude_import = simpleImportDecl preludeModuleName
+   hsc_env <- GHC.getSession
+   let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname           = default_progname,
                    args               = default_args,
@@ -526,6 +547,7 @@ interactiveUI config srcs maybe_exprs = do
                    stop               = default_stop,
                    editor             = default_editor,
                    options            = [],
+                   multiMode          = in_multi,
                    localConfig        = SourceLocalConfig,
                    -- We initialize line number as 0, not 1, because we use
                    -- current line number while reporting errors which is
@@ -620,7 +642,7 @@ withGhcConfig right left = do
                right dir
         _ -> left
 
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
+runGHCi :: [(FilePath, Maybe UnitId, Maybe Phase)] -> Maybe [String] -> GHCi ()
 runGHCi paths maybe_exprs = do
   dflags <- getDynFlags
   let
@@ -703,13 +725,12 @@ runGHCi paths maybe_exprs = do
     -- Importantly, if $PWD/.ghci was ignored due to configuration,
     -- explicitly specifying it does cause it to be processed.
 
-  -- Perform a :load for files given on the GHCi command line
+  -- Perform a :reload for files given on the GHCi command line
+  -- The appropiate targets will already be set
   -- When in -e mode, if the load fails then we want to stop
   -- immediately rather than going on to evaluate the expression.
   when (not (null paths)) $ do
      ok <- ghciHandle (\e -> do showException e; return Failed) $
-                -- TODO: this is a hack.
-                runInputTWithPrefs defaultPrefs defaultSettings $
                     loadModule paths
      when (isJust maybe_exprs && failed ok) $
         liftIO (exitWith (ExitFailure 1))
@@ -1628,7 +1649,7 @@ changeDirectory dir = do
         liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
   -- delete targets and all eventually defined breakpoints (#1620)
   clearAllTargets
-  setContextAfterLoad False []
+  setContextAfterLoad False Nothing
   GHC.workingDirectoryChanged
   dir' <- expandPath dir
   liftIO $ setCurrentDirectory dir'
@@ -1683,7 +1704,7 @@ editFile str =
 -- Our strategy is to pick the first module that failed to load,
 -- or otherwise the first target.
 --
--- XXX: Can we figure out what happened if the depndecy analysis fails
+-- XXX: Can we figure out what happened if the dependency analysis fails
 --      (e.g., because the porgrammeer mistyped the name of a module)?
 -- XXX: Can we figure out the location of an error to pass to the editor?
 -- XXX: if we could figure out the list of errors that occurred during the
@@ -1691,11 +1712,12 @@ editFile str =
 -- of those.
 chooseEditFile :: GHC.GhcMonad m => m String
 chooseEditFile =
-  do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
+  do let hasFailed (GHC.ModuleNode _deps x) = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
+         hasFailed _ = return False
 
      graph <- GHC.getModuleGraph
      failed_graph <-
-       GHC.mkModuleGraph . fmap extendModSummaryNoDeps <$> filterM hasFailed (GHC.mgModSummaries graph)
+       GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries' graph)
      let order g  = flattenSCCs $ filterToposortToModules $
            GHC.topSortModuleGraph True g Nothing
          pick xs  = case xs of
@@ -1968,24 +1990,24 @@ wrapDeferTypeErrors load =
     (\originalFlags -> void $ GHC.setProgramDynFlags originalFlags)
     (\_ -> load)
 
-loadModule :: GhciMonad m => [(FilePath, Maybe Phase)] -> m SuccessFlag
+loadModule :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
 loadModule fs = do
   (_, result) <- runAndPrintStats (const Nothing) (loadModule' fs)
   either (liftIO . Exception.throwIO) return result
 
 -- | @:load@ command
 loadModule_ :: GhciMonad m => [FilePath] -> m ()
-loadModule_ fs = void $ loadModule (zip fs (repeat Nothing))
+loadModule_ fs = void $ loadModule (zip3 fs (repeat Nothing) (repeat Nothing))
 
 loadModuleDefer :: GhciMonad m => [FilePath] -> m ()
 loadModuleDefer = wrapDeferTypeErrors . loadModule_
 
-loadModule' :: GhciMonad m => [(FilePath, Maybe Phase)] -> m SuccessFlag
+loadModule' :: GhciMonad m => [(FilePath, Maybe UnitId, Maybe Phase)] -> m SuccessFlag
 loadModule' files = do
-  let (filenames, phases) = unzip files
+  let (filenames, uids, phases) = unzip3 files
   exp_filenames <- mapM expandPath filenames
-  let files' = zip exp_filenames phases
-  targets <- mapM (\(file, phase) -> GHC.guessTarget file Nothing phase) files'
+  let files' = zip3 exp_filenames uids phases
+  targets <- mapM (\(file, uid, phase) -> GHC.guessTarget file uid phase) files'
 
   -- NOTE: we used to do the dependency anal first, so that if it
   -- fails we didn't throw away the current set of modules.  This would
@@ -2034,13 +2056,9 @@ addModule files = do
     checkTargetModule :: GHC.GhcMonad m => ModuleName -> m Bool
     checkTargetModule m = do
       hsc_env <- GHC.getSession
-      let fc        = hsc_FC hsc_env
       let home_unit = hsc_home_unit hsc_env
-      let units     = hsc_units hsc_env
-      let dflags    = hsc_dflags hsc_env
-      let fopts     = initFinderOpts dflags
       result <- liftIO $
-        Finder.findImportedModule fc fopts units (Just home_unit) m (ThisPkg (homeUnitId home_unit))
+        Finder.findImportedModule hsc_env m (ThisPkg (homeUnitId home_unit))
       case result of
         Found _ _ -> return True
         _ -> (liftIO $ putStrLn $
@@ -2063,10 +2081,13 @@ unAddModule files = do
 
 -- | @:reload@ command
 reloadModule :: GhciMonad m => String -> m ()
-reloadModule m = void $ doLoadAndCollectInfo True loadTargets
+reloadModule m = do
+  session <- GHC.getSession
+  let home_unit = homeUnitId (hsc_home_unit session)
+  void $ doLoadAndCollectInfo True (loadTargets home_unit)
   where
-    loadTargets | null m    = LoadAllTargets
-                | otherwise = LoadUpTo (GHC.mkModuleName m)
+    loadTargets hu | null m    = LoadAllTargets
+                | otherwise = LoadUpTo (mkModule hu (GHC.mkModuleName m))
 
 reloadModuleDefer :: GhciMonad m => String -> m ()
 reloadModuleDefer = wrapDeferTypeErrors . reloadModule
@@ -2130,34 +2151,40 @@ afterLoad ok retain_context = do
   discardTickArrays
   loaded_mods <- getLoadedModules
   modulesLoadedMsg ok loaded_mods
-  setContextAfterLoad retain_context loaded_mods
+  graph <- GHC.getModuleGraph
+  setContextAfterLoad retain_context (Just graph)
 
-setContextAfterLoad :: GhciMonad m => Bool -> [GHC.ModSummary] -> m ()
-setContextAfterLoad keep_ctxt [] = do
+setContextAfterLoad :: GhciMonad m => Bool -> Maybe GHC.ModuleGraph -> m ()
+setContextAfterLoad keep_ctxt Nothing = do
   setContextKeepingPackageModules keep_ctxt []
-setContextAfterLoad keep_ctxt ms = do
+setContextAfterLoad keep_ctxt (Just graph) = do
   -- load a target if one is available, otherwise load the topmost module.
   targets <- GHC.getTargets
-  case [ m | Just m <- map (findTarget ms) targets ] of
+  loaded_graph <- filterM is_loaded $ GHC.mgModSummaries' graph
+  case [ m | Just m <- map (findTarget loaded_graph) targets ] of
         []    ->
-          let graph = GHC.mkModuleGraph $ extendModSummaryNoDeps <$> ms
-              graph' = flattenSCCs $ filterToposortToModules $
-                GHC.topSortModuleGraph True graph Nothing
-          in load_this (last graph')
+          let graph' = flattenSCCs $ filterToposortToModules $
+                GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing
+          in case graph' of
+              [] -> setContextKeepingPackageModules keep_ctxt []
+              xs -> load_this (last xs)
         (m:_) ->
           load_this m
  where
+   is_loaded (GHC.ModuleNode _ ms) = GHC.isLoaded (ms_mod_name ms)
+   is_loaded _ = return False
+
    findTarget mds t
-    = case filter (`matches` t) mds of
+    = case mapMaybe (`matches` t) mds of
         []    -> Nothing
         (m:_) -> Just m
 
-   summary `matches` Target { targetId = TargetModule m }
-        = GHC.ms_mod_name summary == m
-   summary `matches` Target { targetId = TargetFile f _ }
-        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   = f == f'
-   _ `matches` _
-        = False
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetModule m }
+        = if GHC.ms_mod_name summary == m then Just summary else Nothing
+   (GHC.ModuleNode _ summary) `matches` Target { targetId = TargetFile f _ }
+        | Just f' <- GHC.ml_hs_file (GHC.ms_location summary)   =
+          if f == f' then Just summary else Nothing
+   _ `matches` _ = Nothing
 
    load_this summary | m <- GHC.ms_mod summary = do
         is_interp <- GHC.moduleIsInterpreted m
@@ -3114,7 +3141,7 @@ newDynFlags interactive_only minus_opts = do
             let units = preloadUnits (hsc_units hsc_env)
             liftIO $ Loader.loadPackages interp hsc_env units
           -- package flags changed, we can't re-use any of the old context
-          setContextAfterLoad False []
+          setContextAfterLoad False Nothing
           -- and copy the package flags to the interactive DynFlags
           idflags <- GHC.getInteractiveDynFlags
           GHC.setInteractiveDynFlags
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 72a44530e6..157b9e8950 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -90,6 +90,7 @@ data GHCiState = GHCiState
         prompt_cont    :: PromptFunction,
         editor         :: String,
         stop           :: String,
+        multiMode      :: Bool,
         localConfig    :: LocalConfigBehaviour,
         options        :: [GHCiOption],
         line_number    :: !Int,         -- ^ input line
diff --git a/ghc/Main.hs b/ghc/Main.hs
index d00ae72990..69ec3a8593 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -29,7 +29,6 @@ import GHC.Driver.Pipeline  ( oneShot, compileFile )
 import GHC.Driver.MakeFile  ( doMkDependHS )
 import GHC.Driver.Backpack  ( doBackpack )
 import GHC.Driver.Plugins
-import GHC.Driver.Config.Finder (initFinderOpts)
 import GHC.Driver.Config.Logger (initLogFlags)
 import GHC.Driver.Config.Diagnostic
 
@@ -44,10 +43,13 @@ import GHCi.UI              ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings
 import GHC.Runtime.Loader   ( loadFrontendPlugin )
 
 import GHC.Unit.Env
+import GHC.Unit (UnitId, homeUnitDepends)
+import GHC.Unit.Home.ModInfo (emptyHomePackageTable)
 import GHC.Unit.Module ( ModuleName, mkModuleName )
 import GHC.Unit.Module.ModIface
 import GHC.Unit.State  ( pprUnits, pprUnitsSimple )
 import GHC.Unit.Finder ( findImportedModule, FindResult(..) )
+import qualified GHC.Unit.State as State
 import GHC.Unit.Types  ( IsBootInterface(..) )
 
 import GHC.Types.Basic     ( failed )
@@ -76,6 +78,7 @@ import GHC.Iface.Load
 import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
 
 import GHC.Tc.Utils.Monad      ( initIfaceCheck )
+import System.FilePath
 
 -- Standard Haskell libraries
 import System.IO
@@ -85,10 +88,15 @@ import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Data.Char
-import Data.List ( isPrefixOf, partition, intercalate )
+import Data.List ( isPrefixOf, partition, intercalate, (\\) )
 import qualified Data.Set as Set
+import qualified Data.Map as Map
 import Data.Maybe
 import Prelude
+import GHC.ResponseFile (expandResponse)
+import Data.Bifunctor
+import GHC.Data.Graph.Directed
+import qualified Data.List.NonEmpty as NE
 
 -----------------------------------------------------------------------------
 -- ToDo:
@@ -119,7 +127,7 @@ main = do
     let argv2 = map (mkGeneralLocated "on the commandline") argv1
 
     -- 2. Parse the "mode" flags (--make, --interactive etc.)
-    (mode, argv3, flagWarnings) <- parseModeFlags argv2
+    (mode, units, argv3, flagWarnings) <- parseModeFlags argv2
 
     -- If all we want to do is something like showing the version number
     -- then do it now, before we start a GHC session etc. This makes
@@ -151,11 +159,11 @@ main = do
                             ShowGhciUsage          -> showGhciUsage dflags
                             PrintWithDynFlags f    -> putStrLn (f dflags)
                 Right postLoadMode ->
-                    main' postLoadMode dflags argv3 flagWarnings
+                    main' postLoadMode units dflags argv3 flagWarnings
 
-main' :: PostLoadMode -> DynFlags -> [Located String] -> [Warn]
+main' :: PostLoadMode -> [String] -> DynFlags -> [Located String] -> [Warn]
       -> Ghc ()
-main' postLoadMode dflags0 args flagWarnings = do
+main' postLoadMode units dflags0 args flagWarnings = do
   let args' = case postLoadMode of
                 DoRun -> takeWhile (\arg -> unLoc arg /= "--") args
                 _     -> args
@@ -252,7 +260,7 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
         ---------------- Final sanity checking -----------
-  liftIO $ checkOptions postLoadMode dflags6 srcs objs
+  liftIO $ checkOptions postLoadMode dflags6 srcs objs units
 
   ---------------- Do the business -----------
   handleSourceError (\e -> do
@@ -264,12 +272,12 @@ main' postLoadMode dflags0 args flagWarnings = do
                                                     (hsc_units  hsc_env)
                                                     (hsc_NC     hsc_env)
                                                     f
-       DoMake                 -> doMake srcs
+       DoMake                 -> doMake units srcs
        DoMkDependHS           -> doMkDependHS (map fst srcs)
        StopBefore p           -> liftIO (oneShot hsc_env p srcs)
-       DoInteractive          -> ghciUI srcs Nothing
-       DoEval exprs           -> ghciUI srcs $ Just $ reverse exprs
-       DoRun                  -> doRun srcs args
+       DoInteractive          -> ghciUI units srcs Nothing
+       DoEval exprs           -> ghciUI units srcs $ Just $ reverse exprs
+       DoRun                  -> doRun units srcs args
        DoAbiHash              -> abiHash (map fst srcs)
        ShowPackages           -> liftIO $ showUnits hsc_env
        DoFrontend f           -> doFrontend f srcs
@@ -277,20 +285,30 @@ main' postLoadMode dflags0 args flagWarnings = do
 
   liftIO $ dumpFinalStats logger
 
-doRun :: [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
-doRun srcs args = do
+doRun :: [String] -> [(FilePath, Maybe Phase)] -> [Located String] -> Ghc ()
+doRun units srcs args = do
     dflags <- getDynFlags
     let mainFun = fromMaybe "main" (mainFunIs dflags)
-    ghciUI srcs (Just ["System.Environment.withArgs " ++ show args' ++ " (Control.Monad.void " ++ mainFun ++ ")"])
+    ghciUI units srcs (Just ["System.Environment.withArgs " ++ show args' ++ " (Control.Monad.void " ++ mainFun ++ ")"])
   where
     args' = drop 1 $ dropWhile (/= "--") $ map unLoc args
 
-ghciUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
+ghciUI :: [String] -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
 #if !defined(HAVE_INTERNAL_INTERPRETER)
-ghciUI _ _ =
+ghciUI _ _ _ =
   throwGhcException (CmdLineError "not built for interactive use")
 #else
-ghciUI srcs maybe_expr = interactiveUI defaultGhciSettings srcs maybe_expr
+ghciUI units srcs maybe_expr = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      case srcs of
+        [] -> return []
+        _  -> do
+          s <- initMake srcs
+          return $ map (uncurry (,Nothing,)) s
+  interactiveUI defaultGhciSettings hs_srcs maybe_expr
 #endif
 
 
@@ -300,9 +318,9 @@ ghciUI srcs maybe_expr = interactiveUI defaultGhciSettings srcs maybe_expr
 -- | Ensure sanity of options.
 --
 -- Throws 'UsageError' or 'CmdLineError' if not.
-checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
+checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
      -- Final sanity checking before kicking off a compilation (pipeline).
-checkOptions mode dflags srcs objs = do
+checkOptions mode dflags srcs objs units = do
      -- Complain about any unknown flags
    let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
    when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
@@ -341,8 +359,8 @@ checkOptions mode dflags srcs objs = do
 
         -- Check that there are some input files
         -- (except in the interactive case)
-   if null srcs && (null objs || not_linking) && needsInputsMode mode
-        then throwGhcException (UsageError "no input files")
+   if null srcs && (null objs || not_linking) && needsInputsMode mode && null units
+        then throwGhcException (UsageError "no input files" )
         else do
 
    case mode of
@@ -538,13 +556,13 @@ isCompManagerMode _             = False
 -- Parsing the mode flag
 
 parseModeFlags :: [Located String]
-               -> IO (Mode,
+               -> IO (Mode, [String],
                       [Located String],
                       [Warn])
 parseModeFlags args = do
-  let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =
+  let ((leftover, errs1, warns), (mModeFlag, units, errs2, flags')) =
           runCmdLine (processArgs mode_flags args)
-                     (Nothing, [], [])
+                     (Nothing, [], [], [])
       mode = case mModeFlag of
              Nothing     -> doMakeMode
              Just (m, _) -> m
@@ -553,9 +571,9 @@ parseModeFlags args = do
   unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
       map (("on the commandline", )) $ map (unLoc . errMsg) errs1 ++ errs2
 
-  return (mode, flags' ++ leftover, warns)
+  return (mode, units, flags' ++ leftover, warns)
 
-type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
+type ModeM = CmdLineP (Maybe (Mode, String), [String], [String], [Located String])
   -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
   -- so we collect the new ones and return them.
 
@@ -612,6 +630,7 @@ mode_flags =
   , defFlag "S"            (PassFlag (setMode (stopBeforeMode StopAs)))
   , defFlag "-run"         (PassFlag (setMode doRunMode))
   , defFlag "-make"        (PassFlag (setMode doMakeMode))
+  , defFlag "unit"         (SepArg   (\s -> addUnit s "-unit"))
   , defFlag "-backpack"    (PassFlag (setMode doBackpackMode))
   , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
   , defFlag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
@@ -619,9 +638,14 @@ mode_flags =
   , defFlag "-frontend"    (SepArg   (\s -> setMode (doFrontendMode s) "-frontend"))
   ]
 
+addUnit :: String -> String -> EwM ModeM ()
+addUnit unit_str _arg = liftEwM $ do
+  (mModeFlag, units, errs, flags') <- getCmdLineState
+  putCmdLineState (mModeFlag, unit_str:units, errs, flags')
+
 setMode :: Mode -> String -> EwM ModeM ()
 setMode newMode newFlag = liftEwM $ do
-    (mModeFlag, errs, flags') <- getCmdLineState
+    (mModeFlag, units, errs, flags') <- getCmdLineState
     let (modeFlag', errs') =
             case mModeFlag of
             Nothing -> ((newMode, newFlag), errs)
@@ -670,7 +694,7 @@ setMode newMode newFlag = liftEwM $ do
                     -- Otherwise, complain
                     _ -> let err = flagMismatchErr oldFlag newFlag
                          in ((oldMode, oldFlag), err : errs)
-    putCmdLineState (Just modeFlag', errs', flags')
+    putCmdLineState (Just modeFlag', units, errs', flags')
   where isDominantFlag f = isShowGhcUsageMode   f ||
                            isShowGhciUsageMode  f ||
                            isShowVersionMode    f ||
@@ -682,15 +706,31 @@ flagMismatchErr oldFlag newFlag
 
 addFlag :: String -> String -> EwM ModeM ()
 addFlag s flag = liftEwM $ do
-  (m, e, flags') <- getCmdLineState
-  putCmdLineState (m, e, mkGeneralLocated loc s : flags')
+  (m, units, e, flags') <- getCmdLineState
+  putCmdLineState (m, units, e, mkGeneralLocated loc s : flags')
     where loc = "addFlag by " ++ flag ++ " on the commandline"
 
 -- ----------------------------------------------------------------------------
 -- Run --make mode
 
-doMake :: [(String,Maybe Phase)] -> Ghc ()
-doMake srcs  = do
+doMake :: [String] -> [(String, Maybe Phase)] -> Ghc ()
+doMake units targets = do
+  hs_srcs <- case NE.nonEmpty units of
+    Just ne_units -> do
+      initMulti ne_units
+    Nothing -> do
+      s <- initMake targets
+      return $ map (uncurry (,Nothing,)) s
+  case hs_srcs of
+    [] -> return ()
+    _  -> do
+      targets' <- mapM (\(src, uid, phase) -> GHC.guessTarget src uid phase) hs_srcs
+      GHC.setTargets targets'
+      ok_flag <- GHC.load LoadAllTargets
+      when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
+
+initMake :: [(String,Maybe Phase)] -> Ghc [(String, Maybe Phase)]
+initMake srcs  = do
     let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
 
     hsc_env <- GHC.getSession
@@ -700,7 +740,7 @@ doMake srcs  = do
     -- This means that "ghc Foo.o Bar.o -o baz" links the program as
     -- we expect.
     if (null hs_srcs)
-       then liftIO (oneShot hsc_env NoStop srcs)
+       then liftIO (oneShot hsc_env NoStop srcs) >> return []
        else do
 
     o_files <- mapMaybeM (\x -> liftIO $ compileFile hsc_env NoStop x)
@@ -709,14 +749,186 @@ doMake srcs  = do
     let dflags' = dflags { ldInputs = map (FileOption "") o_files
                                       ++ ldInputs dflags }
     _ <- GHC.setSessionDynFlags dflags'
+    return hs_srcs
+
+-- Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.
+removeRTS :: [String] -> [String]
+removeRTS ("+RTS" : xs)  =
+  case dropWhile (/= "-RTS") xs of
+    [] -> []
+    (_ : ys) -> removeRTS ys
+removeRTS (y:ys)         = y : removeRTS ys
+removeRTS []             = []
+
+initMulti :: NE.NonEmpty String -> Ghc ([(String, Maybe UnitId, Maybe Phase)])
+initMulti unitArgsFiles  = do
+  hsc_env <- GHC.getSession
+  let logger = hsc_logger hsc_env
+  initial_dflags <- GHC.getSessionDynFlags
+
+  dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do
+    when (verbosity initial_dflags > 2) (liftIO $ print f)
+    args <- liftIO $ expandResponse [f]
+    (dflags2, fileish_args, warns) <- parseDynamicFlagsCmdLine initial_dflags (map (mkGeneralLocated f) (removeRTS args))
+    handleSourceError (\e -> do
+       GHC.printException e
+       liftIO $ exitWith (ExitFailure 1)) $ do
+         liftIO $ handleFlagWarnings logger (initDiagOpts dflags2) warns
+
+    let (dflags3, srcs, objs) = parseTargetFiles dflags2 (map unLoc fileish_args)
+        dflags4 = offsetDynFlags dflags3
+
+    let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
+
+    -- This is dubious as the whole unit environment won't be set-up correctly, but
+    -- that doesn't matter for what we use it for (linking and oneShot)
+    let dubious_hsc_env = hscSetFlags dflags4 hsc_env
+    -- if we have no haskell sources from which to do a dependency
+    -- analysis, then just do one-shot compilation and/or linking.
+    -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+    -- we expect.
+    if (null hs_srcs)
+       then liftIO (oneShot dubious_hsc_env NoStop srcs) >> return (dflags4, [])
+       else do
+
+    o_files <- mapMaybeM (\x -> liftIO $ compileFile dubious_hsc_env NoStop x)
+                 non_hs_srcs
+    let dflags5 = dflags4 { ldInputs = map (FileOption "") o_files
+                                      ++ ldInputs dflags4 }
+
+    liftIO $ checkOptions DoMake dflags5 srcs objs []
+
+    pure (dflags5, hs_srcs)
+
+  let
+    unitDflags = NE.map fst dynFlagsAndSrcs
+    srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs
+    (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs))
+
+  checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags))
+
+  let (initial_home_graph, mainUnitId) = createUnitEnvFromFlags unitDflags
+      home_units = unitEnv_keys initial_home_graph
+
+  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do
+    let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv
+        hue_flags = homeUnitEnv_dflags homeUnitEnv
+        dflags = homeUnitEnv_dflags homeUnitEnv
+    (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units
+
+    updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
+    pure $ HomeUnitEnv
+      { homeUnitEnv_units = unit_state
+      , homeUnitEnv_unit_dbs = Just dbs
+      , homeUnitEnv_dflags = updated_dflags
+      , homeUnitEnv_hpt = emptyHomePackageTable
+      , homeUnitEnv_home_unit = Just home_unit
+      }
+
+  checkUnitCycles initial_dflags home_unit_graph
+
+  let dflags = homeUnitEnv_dflags $ unitEnv_lookup mainUnitId home_unit_graph
+  unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags))
+  let final_hsc_env = hsc_env { hsc_unit_env = unitEnv }
+
+  GHC.setSession final_hsc_env
+
+  -- if we have no haskell sources from which to do a dependency
+  -- analysis, then just do one-shot compilation and/or linking.
+  -- This means that "ghc Foo.o Bar.o -o baz" links the program as
+  -- we expect.
+  if (null hs_srcs)
+      then do
+        liftIO $ hPutStrLn stderr $ "Multi Mode can not be used for one-shot mode."
+        liftIO $ exitWith (ExitFailure 1)
+      else do
+
+{-
+  o_files <- liftIO $ mapMaybeM
+                (\(src, uid, mphase) ->
+                  compileFile (hscSetActiveHomeUnit (ue_unitHomeUnit (fromJust uid) unitEnv) final_hsc_env) NoStop (src, mphase)
+                )
+                (concat non_hs_srcs)
+                -}
+
+  -- MP: This should probably modify dflags for each unit?
+  --let dflags' = dflags { ldInputs = map (FileOption "") o_files
+  --                                  ++ ldInputs dflags }
+  return $ concat hs_srcs
+
+-- | Check that we don't have multiple units with the same UnitId.
+
+checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
+checkUnitCycles dflags graph = processSCCs sccs
+  where
+    mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
+    mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
+    nodes = map mkNode (unitEnv_elts graph)
+
+    sccs = stronglyConnCompFromEdgedVerticesOrd nodes
+
+    processSCCs [] = return ()
+    processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs
+    processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids)
+
+
+    cycle_err uids =
+      hang (text "Units form a dependency cycle:")
+           2
+           (one_err uids)
+
+    one_err uids = vcat $
+                    (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start)
+                    ++ [text "-" <+> ppr final]
+      where
+        start = init uids
+        final = last uids
+
+checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc ()
+checkDuplicateUnits dflags flags =
+  unless (null duplicate_ids)
+         (throwGhcException $ CmdLineError $ showSDoc dflags multi_err)
+
+  where
+    uids = map (second homeUnitId_) flags
+    deduplicated_uids = ordNubOn snd uids
+    duplicate_ids = Set.fromList (map snd uids \\ map snd deduplicated_uids)
+
+    duplicate_flags = filter (flip Set.member duplicate_ids . snd) uids
+
+    one_err (fp, home_uid) = text "-" <+> ppr home_uid <+> text "defined in" <+> text fp
+
+    multi_err =
+      hang (text "Multiple units with the same unit-id:")
+           2
+           (vcat (map one_err duplicate_flags))
+
+
+offsetDynFlags :: DynFlags -> DynFlags
+offsetDynFlags dflags =
+  dflags { hiDir = c hiDir
+         , objectDir  = c objectDir
+         , stubDir = c stubDir
+         , hieDir  = c hieDir
+         , dumpDir = c dumpDir  }
+
+  where
+    c f = augment_maybe (f dflags)
 
-    targets <- mapM (\(src, phase) -> GHC.guessTarget src Nothing phase) hs_srcs
-    GHC.setTargets targets
-    ok_flag <- GHC.load LoadAllTargets
+    augment_maybe Nothing = Nothing
+    augment_maybe (Just f) = Just (augment f)
+    augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f
+              | otherwise = f
 
-    when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
-    return ()
 
+createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)
+createUnitEnvFromFlags unitDflags =
+  let
+    newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing
+    unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags
+    activeUnit = fst $ NE.head unitEnvList
+  in
+    (unitEnv_new (Map.fromList (NE.toList (unitEnvList))), activeUnit)
 
 -- ---------------------------------------------------------------------------
 -- Various banners and verbosity output.
@@ -873,17 +1085,13 @@ abiHash :: [String] -- ^ List of module names
         -> Ghc ()
 abiHash strs = do
   hsc_env <- getSession
-  let fc         = hsc_FC hsc_env
-  let mhome_unit = ue_home_unit (hsc_unit_env hsc_env)
-  let units      = hsc_units hsc_env
-  let dflags     = hsc_dflags hsc_env
-  let fopts      = initFinderOpts dflags
+  let dflags    = hsc_dflags hsc_env
 
   liftIO $ do
 
   let find_it str = do
          let modname = mkModuleName str
-         r <- findImportedModule fc fopts units mhome_unit modname NoPkgQual
+         r <- findImportedModule hsc_env modname NoPkgQual
          case r of
            Found _ m -> return m
            _error    -> throwGhcException $ CmdLineError $ showSDoc dflags $