Skip to content

Commit

Permalink
Add support for loading multiple components into one repl session
Browse files Browse the repository at this point in the history
There are several parts to this patch which are logically distinct but
work together to support the overal goal of starting a GHCi session with
multiple packages loaded at once.

1. When a user writes "cabal repl <target>" then if the user is using a
   compiler > ghc-9.4.* then we will attempt to start a multi-session
   which loads the selected targets into one multi-package session of
   GHC.
1a. The closure property states that in order to load components `p` and `q` into
    the same session that if `p` depends on `z` and `z` depends on `q`
    then `z` must also be loaded into the session.
1b. Only inplace packages are able to be loaded into a multi session (if a component
    `z` exists then it is already made into an inplace package by
    cabal). Therefore cabal has already engineered that there is source
    code locally available for all packages which we will want to load
    into a session.

2. It is necessary to modify `./Setup configure` to allow users to
   configure a package *without* having previously built the dependency.
   Instead, we promise to the configure phase that we will have built it
   by the time we build the package. This allows us to configure all the
   packages we intend to load into the repl without building any
   dependenices which we will load in the same session, because the
   promise is satisifed due to loading the package and it's dependency
   into one multi-session which ensures the dependency is built before
   it is needed.

   A user of ./Setup configure specifies a promised dependency by
   prepending a "+" to a normal dependency specification. For example:

  ```
     '--dependency=+cabal-install-solver=cabal-install-solver-3.9.0.0-inplace'
  ```

2a. The `./Setup repl` command is modified to allow a user to defer
    starting the repl and instead instruct the command to write the
    necessary build flags to a file. The option is called
    `--repl-multi-file <FILEPATH>`.

    `cabal-install` then invokes this command for each component which
    will populate the session and starts a multi-session with all the
    arguments together.

3. The solver is unmodified, the solver is given the repl targets and
   creates a build plan as before. After the solver is completed then in
   `setRootTargets` and `pruneInstallPlan` we modify the install plan to
   enforce the closure property and mark which dependencies need to be
   promised.

   * Mark the current components as `BuildInPlaceOnly InMemory`, which
     indicates to the compiler that it is to be built in a GHC
     multi-session.
   * Augment the component repl targets to indicate that components
     required by the closure property (in addition to normal targets)
     will be loaded into the repl.
   * Modify the dependency edges in `compLibDependencies` to indicate
     which dependencies are the promised ones (which is precisely
     components which are `BuildInPlaceOnly InMemory` build styles).
     This is the field which is eventually used to populate the
     `--dependency` argument to `./Setup configure`.

Pass this-unit-id for executable components as well as libraries

When starting multi-repl sessions we can have multiple executables so
it's important to distinguish between the different units.

undo

wip

wip - pass all unit-id

error messages

C files and Setup.hs filtering

pruning

Missing file

Keep temp files in cabal multirepl

Undo changes in cabal.project, make tests compile

Use cabal.project.local for allow-newer stuff.
  • Loading branch information
mpickering committed Feb 6, 2023
1 parent a5ddb14 commit bd9c69d
Show file tree
Hide file tree
Showing 36 changed files with 863 additions and 304 deletions.
1 change: 1 addition & 0 deletions Cabal-syntax/src/Distribution/Types/ExposedModule.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.Types.ExposedModule where

import Distribution.Compat.Prelude
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ tests = testGroup "Distribution.Utils.Structured"
, testCase "GenericPackageDescription" $
md5Check (Proxy :: Proxy GenericPackageDescription) 0xa3e9433662ecf0c7a3c26f6d75a53ba1
, testCase "LocalBuildInfo" $
md5Check (Proxy :: Proxy LocalBuildInfo) 0x91ffcd61bbd83525e8edba877435a031
md5Check (Proxy :: Proxy LocalBuildInfo) 0x2d7678029074527cd6b3b03bb3f27ab7
#endif
]

Expand Down
28 changes: 22 additions & 6 deletions Cabal/src/Distribution/Backpack/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..))
import Distribution.Utils.LogProgress
import Distribution.Backpack.ModuleShape

import Data.Either
( lefts )
Expand All @@ -66,15 +67,15 @@ configureComponentLocalBuildInfos
-> Flag String -- configIPID
-> Flag ComponentId -- configCID
-> PackageDescription
-> [PreExistingComponent]
-> ([PreExistingComponent], [FakePreExistingComponent])
-> FlagAssignment -- configConfigurationsFlags
-> [(ModuleName, Module)] -- configInstantiateWith
-> InstalledPackageIndex
-> Compiler
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
configureComponentLocalBuildInfos
verbosity use_external_internal_deps enabled deterministic ipid_flag cid_flag pkg_descr
prePkgDeps flagAssignment instantiate_with installedPackageSet comp = do
(prePkgDeps, promisedPkgDeps) flagAssignment instantiate_with installedPackageSet comp = do
-- NB: In single component mode, this returns a *single* component.
-- In this graph, the graph is NOT closed.
graph0 <- case mkComponentsGraph enabled pkg_descr of
Expand All @@ -92,6 +93,10 @@ configureComponentLocalBuildInfos
ann_cname = pc_compname pkg
}))
| pkg <- prePkgDeps]
`Map.union`
Map.fromListWith Map.union
[ (pkg, Map.singleton (ann_cname aid) aid)
| FakePreExistingComponent pkg aid <- promisedPkgDeps]
graph1 <- toConfiguredComponents use_external_internal_deps
flagAssignment
deterministic ipid_flag cid_flag pkg_descr
Expand All @@ -102,13 +107,17 @@ configureComponentLocalBuildInfos
let shape_pkg_map = Map.fromList
[ (pc_cid pkg, (pc_open_uid pkg, pc_shape pkg))
| pkg <- prePkgDeps]
`Map.union`
Map.fromList
[ (ann_id aid, (DefiniteUnitId (unsafeMkDefUnitId $ mkUnitId (unComponentId (ann_id aid) )), emptyModuleShape))
| FakePreExistingComponent _ aid <- promisedPkgDeps]
uid_lookup def_uid
| Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid
= FullUnitId (Installed.installedComponentId pkg)
(Map.fromList (Installed.instantiatedWith pkg))
| otherwise = error ("uid_lookup: " ++ prettyShow uid)
where uid = unDefUnitId def_uid
graph2 <- toLinkedComponents verbosity uid_lookup
graph2 <- toLinkedComponents verbosity (not (null promisedPkgDeps)) uid_lookup
(package pkg_descr) shape_pkg_map graph1

infoProgress $
Expand All @@ -129,7 +138,7 @@ configureComponentLocalBuildInfos
infoProgress $ hang (text "Ready component graph:") 4
(vcat (map dispReadyComponent graph4))

toComponentLocalBuildInfos comp installedPackageSet pkg_descr prePkgDeps graph4
toComponentLocalBuildInfos comp installedPackageSet promisedPkgDeps pkg_descr prePkgDeps graph4

------------------------------------------------------------------------------
-- ComponentLocalBuildInfo
Expand All @@ -138,13 +147,14 @@ configureComponentLocalBuildInfos
toComponentLocalBuildInfos
:: Compiler
-> InstalledPackageIndex -- FULL set
-> [FakePreExistingComponent]
-> PackageDescription
-> [PreExistingComponent] -- external package deps
-> [ReadyComponent]
-> LogProgress ([ComponentLocalBuildInfo],
InstalledPackageIndex) -- only relevant packages
toComponentLocalBuildInfos
comp installedPackageSet pkg_descr externalPkgDeps graph = do
comp installedPackageSet promisedPkgDeps pkg_descr externalPkgDeps graph = do
-- Check and make sure that every instantiated component exists.
-- We have to do this now, because prior to linking/instantiating
-- we don't actually know what the full set of 'UnitId's we need
Expand Down Expand Up @@ -178,9 +188,15 @@ toComponentLocalBuildInfos
--
packageDependsIndex = PackageIndex.fromList (lefts local_graph)
fullIndex = Graph.fromDistinctList local_graph

case Graph.broken fullIndex of
[] -> return ()
broken ->
-- If there are promised dependencies, we don't know what the dependencies
-- of these are and that can easily lead to a broken graph. So assume that
-- any promised package is not broken (ie all its dependencies, transitively,
-- will be there). That's a promise.
broken | not (null promisedPkgDeps) -> return ()
| otherwise ->
-- TODO: ppr this
dieProgress . text $
"The following packages are broken because other"
Expand Down
26 changes: 14 additions & 12 deletions Cabal/src/Distribution/Backpack/ConfiguredComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ import qualified Data.Map as Map
import Distribution.Pretty
import Text.PrettyPrint (Doc, hang, text, vcat, hsep, quotes, ($$))
import qualified Text.PrettyPrint as PP
import Distribution.Compat.Stack

-- | A configured component, we know exactly what its 'ComponentId' is,
-- and the 'ComponentId's of the things it depends on.
Expand Down Expand Up @@ -177,22 +178,23 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
if newPackageDepsBehaviour pkg_descr
then fmap concat $ forM (targetBuildDepends bi) $
\(Dependency name _ sublibs) -> do
pkg <- case Map.lookup name lib_dep_map of
case Map.lookup name lib_dep_map of
Nothing ->
dieProgress $
text "Dependency on unbuildable" <+>
text "package" <+> pretty name
Just p -> return p
-- Return all library components
forM (NonEmptySet.toList sublibs) $ \lib ->
let comp = CLibName lib in
case Map.lookup comp pkg of
Nothing ->
dieProgress $
text "Dependency on unbuildable" <+>
text (showLibraryName lib) <+>
text "from" <+> pretty name
Just v -> return v
$$ text (prettyCallStack callStack)
Just pkg -> do
-- Return all library components
forM (NonEmptySet.toList sublibs) $ \lib ->
let comp = CLibName lib in
case Map.lookup comp pkg of
Nothing ->
dieProgress $
text "Dependency on unbuildable" <+>
text (showLibraryName lib) <+>
text "from" <+> pretty name
Just v -> return v
else return old_style_lib_deps
mkConfiguredComponent
pkg_descr this_cid
Expand Down
34 changes: 27 additions & 7 deletions Cabal/src/Distribution/Backpack/LinkedComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -114,12 +114,13 @@ instance Package LinkedComponent where

toLinkedComponent
:: Verbosity
-> Bool
-> FullDb
-> PackageId
-> LinkedComponentMap
-> ConfiguredComponent
-> LogProgress LinkedComponent
toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
toLinkedComponent verbosity any_promised db this_pid pkg_map ConfiguredComponent {
cc_ann_id = aid@AnnotatedId { ann_id = this_cid },
cc_component = component,
cc_exe_deps = exe_deps,
Expand Down Expand Up @@ -276,9 +277,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
case filter (\x' -> unWithSource x /= unWithSource x') xs of
[] -> return ()
_ -> Left $ ambiguousReexportMsg reex x xs
return (to, unWithSource x)
return (to, Just (unWithSource x))
_ ->
Left (brokenReexportMsg reex)
-- Can't resolve it right now.. carry on with the assumption it will be resolved
-- dynamically later by an in-memory package which hasn't been installed yet.
if any_promised
then return (to, Nothing)
-- But if nothing is promised, eagerly report an error, as we already know everything.
else Left (brokenReexportMsg reex)

-- TODO: maybe check this earlier; it's syntactically obvious.
let build_reexports m (k, v)
Expand All @@ -289,8 +295,20 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
provs <- foldM build_reexports Map.empty $
-- TODO: doublecheck we have checked for
-- src_provs duplicates already!
[ (mod_name, OpenModule this_uid mod_name) | mod_name <- src_provs ] ++
reexports_list
-- These are normal module exports.
[ (mod_name, (OpenModule this_uid mod_name)) | mod_name <- src_provs ]
++
-- These are reexports, which we managed to resolve to something in an external package.
[(mn_new, om) | (mn_new, Just om) <- reexports_list ]
++
-- These ones.. we didn't resolve but also we might not have to resolve them because they could come from a promised unit, which we don't know
-- anything about yet. GHC will resolve these itself when it is dealing with the multi-session. These ones will not be built, registered and put
-- into a package database, we only need them to make it as far as generating GHC options where the info will be used to pass the reexported-module option
-- to GHC.

-- We also know that in the case there are promised units that we will not be doing anything to do with backpack like unification etc..
[ (mod_name, (OpenModule (DefiniteUnitId (unsafeMkDefUnitId (mkUnitId "fake"))) mod_name)) | (mod_name, Nothing) <- reexports_list ]
-- [(mn_new, OpenModule mn_new) | (mn_new, Nothing) <- reexports_list ]

let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape))

Expand Down Expand Up @@ -337,20 +355,22 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- every ComponentId gets converted into a UnitId by way of SimpleUnitId.
toLinkedComponents
:: Verbosity
-> Bool -- ^ Whether there are any "promised" package dependencies which we won't
-- find already installed.
-> FullDb
-> PackageId
-> LinkedComponentMap
-> [ConfiguredComponent]
-> LogProgress [LinkedComponent]
toLinkedComponents verbosity db this_pid lc_map0 comps
toLinkedComponents verbosity any_promised db this_pid lc_map0 comps
= fmap snd (mapAccumM go lc_map0 comps)
where
go :: Map ComponentId (OpenUnitId, ModuleShape)
-> ConfiguredComponent
-> LogProgress (Map ComponentId (OpenUnitId, ModuleShape), LinkedComponent)
go lc_map cc = do
lc <- addProgressCtx (text "In the stanza" <+> text (componentNameStanza (cc_name cc))) $
toLinkedComponent verbosity db this_pid lc_map cc
toLinkedComponent verbosity any_promised db this_pid lc_map cc
return (extendLinkedComponentMap lc lc_map, lc)

type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape)
Expand Down
5 changes: 5 additions & 0 deletions Cabal/src/Distribution/Backpack/PreExistingComponent.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.PreExistingComponent (
PreExistingComponent(..),
FakePreExistingComponent(..),
ipiToPreExistingComponent,
) where

Expand All @@ -20,6 +21,9 @@ import Distribution.Package
import qualified Data.Map as Map
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import Distribution.Types.AnnotatedId

data FakePreExistingComponent = FakePreExistingComponent PackageName (AnnotatedId ComponentId)

-- | Stripped down version of 'LinkedComponent' for things
-- we don't need to know how to build.
Expand Down Expand Up @@ -56,6 +60,7 @@ ipiToPreExistingComponent ipi =
pc_shape = shapeInstalledPackage ipi
}


instance HasMungedPackageId PreExistingComponent where
mungedId = pc_munged_id

Expand Down
16 changes: 15 additions & 1 deletion Cabal/src/Distribution/Compat/ResponseFile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
-- Compatibility layer for GHC.ResponseFile
-- Implementation from base 4.12.0 is used.
-- http://hackage.haskell.org/package/base-4.12.0.0/src/LICENSE
module Distribution.Compat.ResponseFile (expandResponse) where
module Distribution.Compat.ResponseFile (expandResponse, escapeArgs) where

import Distribution.Compat.Prelude
import Prelude ()
Expand Down Expand Up @@ -47,6 +47,20 @@ unescape args = reverse . map reverse $ go args NoneQ False [] []
| '"' == c = go cs DblQ False a as
| otherwise = go cs NoneQ False (c:a) as

escapeArgs :: [String] -> String
escapeArgs = unlines . map escapeArg

escapeArg :: String -> String
escapeArg = reverse . foldl' escape []

escape :: String -> Char -> String
escape cs c
| isSpace c
|| '\\' == c
|| '\'' == c
|| '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
| otherwise = c:cs

#endif

expandResponse :: [String] -> IO [String]
Expand Down
Loading

0 comments on commit bd9c69d

Please sign in to comment.