Skip to content

Commit d499486

Browse files
angermanangerman
committed
wip: thread compiler
1 parent 43b3daf commit d499486

File tree

10 files changed

+47
-26
lines changed

10 files changed

+47
-26
lines changed

‎cabal-install-solver/src/Distribution/Solver/Modular.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -57,16 +57,17 @@ import Distribution.Verbosity
5757
import Distribution.Solver.Modular.Configured (CP (..))
5858
import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
5959
import Distribution.Pretty (Pretty (..))
60-
import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
60+
import Text.PrettyPrint (text, vcat, Doc, nest, ($+$))
6161
import Distribution.Solver.Types.OptionalStanza (showStanzas, optStanzaSetNull)
6262
import Distribution.Types.Flag (nullFlagAssignment)
6363

6464

6565
showCP :: CP QPN -> Doc
66-
showCP (CP qpi fa es ds) =
66+
showCP (CP qpi compiler fa es ds) =
6767
text "package:" <+> text (showPI qpi) $+$ nest 2 (
6868
vcat
69-
[ if nullFlagAssignment fa then mempty else text "flags:" <+> pretty fa
69+
[ text "compiler:" <+> text (show compiler)
70+
, if nullFlagAssignment fa then mempty else text "flags:" <+> pretty fa
7071
, if optStanzaSetNull es then mempty else text "stanzas:" <+> text (showStanzas es)
7172
, vcat
7273
[ text "component" <+> pretty c $+$
@@ -75,7 +76,7 @@ showCP (CP qpi fa es ds) =
7576
| (c, deps) <- ComponentDeps.toList ds
7677
]
7778
])
78-
79+
7980
-- | Ties the two worlds together: classic cabal-install vs. the modular
8081
-- solver. Performs the necessary translations before and after.
8182
modularResolver :: SolverConfig -> DependencyResolver loc

‎cabal-install-solver/src/Distribution/Solver/Modular/Assignment.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ import qualified Data.Map as M
1616
import Data.Maybe (fromJust)
1717

1818
import Distribution.PackageDescription (FlagAssignment, mkFlagAssignment) -- from Cabal
19-
19+
import Distribution.Simple.Compiler (Compiler)
2020
import Distribution.Solver.Types.ComponentDeps (ComponentDeps, Component)
2121
import qualified Distribution.Solver.Types.ComponentDeps as CD
2222
import Distribution.Solver.Types.OptionalStanza
@@ -31,12 +31,12 @@ import Distribution.Solver.Modular.Package
3131
-- | A (partial) package assignment. Qualified package names
3232
-- are associated with instances.
3333
type PAssignment = Map QPN I
34-
34+
type CAssignment = Map QPN Compiler
3535
type FAssignment = Map QFN Bool
3636
type SAssignment = Map QSN Bool
3737

3838
-- | A (partial) assignment of variables.
39-
data Assignment = A PAssignment FAssignment SAssignment
39+
data Assignment = A PAssignment CAssignment FAssignment SAssignment
4040
deriving (Show, Eq)
4141

4242
-- | Delivers an ordered list of fully configured packages.
@@ -46,7 +46,7 @@ data Assignment = A PAssignment FAssignment SAssignment
4646
-- of one package version chosen by the solver, which will lead to
4747
-- clashes.
4848
toCPs :: Assignment -> RevDepMap -> [CP QPN]
49-
toCPs (A pa fa sa) rdm =
49+
toCPs (A pa ca fa sa) rdm =
5050
let
5151
-- get hold of the graph
5252
g :: Graph Component
@@ -88,6 +88,7 @@ toCPs (A pa fa sa) rdm =
8888
depp' = CD.fromList . L.map (\(comp, d) -> (comp, [d])) . depp
8989
in
9090
L.map (\ pi@(PI qpn _) -> CP pi
91+
(fromJust (M.lookup qpn ca))
9192
(M.findWithDefault mempty qpn fapp)
9293
(M.findWithDefault mempty qpn sapp)
9394
(depp' qpn))

‎cabal-install-solver/src/Distribution/Solver/Modular/Configured.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,11 +3,12 @@ module Distribution.Solver.Modular.Configured
33
) where
44

55
import Distribution.PackageDescription (FlagAssignment)
6+
import Distribution.Simple.Compiler (Compiler)
67

78
import Distribution.Solver.Modular.Package
89
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
910
import Distribution.Solver.Types.OptionalStanza
1011

1112
-- | A configured package is a package instance together with
1213
-- a flag assignment and complete dependencies.
13-
data CP qpn = CP (PI qpn) FlagAssignment OptionalStanzaSet (ComponentDeps [PI qpn])
14+
data CP qpn = CP (PI qpn) Compiler FlagAssignment OptionalStanzaSet (ComponentDeps [PI qpn])

‎cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ import Distribution.Solver.Types.SourcePackage
2626
convCP :: SI.InstalledPackageIndex ->
2727
CI.PackageIndex (SourcePackage loc) ->
2828
CP QPN -> ResolverPackage loc
29-
convCP iidx sidx (CP qpi fa es ds) =
29+
convCP iidx sidx (CP qpi compiler fa es ds) =
3030
case qpi of
3131
-- Installed
3232
(PI qpn (I _ (Inst pi))) ->
@@ -43,6 +43,7 @@ convCP iidx sidx (CP qpi fa es ds) =
4343
Configured $
4444
SolverPackage {
4545
solverPkgQPN = qpn,
46+
solverPkgCompiler = compiler,
4647
solverPkgSource = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi,
4748
solverPkgFlags = fa,
4849
solverPkgStanzas = es,

‎cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -183,7 +183,7 @@ updateCM cs cm =
183183

184184
-- | Record complete assignments on 'Done' nodes.
185185
assign :: Tree d c -> Tree Assignment c
186-
assign tree = go tree (A M.empty M.empty M.empty)
186+
assign tree = go tree (A M.empty M.empty M.empty M.empty)
187187
where
188188
go :: Tree d c -> Assignment -> Tree Assignment c
189189
go (Fail c fr) _ = Fail c fr

‎cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ import Prelude ()
88

99
import Distribution.Package ( Package(..) )
1010
import Distribution.PackageDescription ( FlagAssignment )
11+
import Distribution.Simple.Compiler (Compiler)
1112
import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
1213
import Distribution.Solver.Types.OptionalStanza
1314
import Distribution.Solver.Types.PackagePath (QPN)
@@ -23,6 +24,7 @@ import Distribution.Solver.Types.SourcePackage
2324
--
2425
data SolverPackage loc = SolverPackage {
2526
solverPkgQPN :: QPN,
27+
solverPkgCompiler:: Compiler,
2628
solverPkgSource :: SourcePackage loc,
2729
solverPkgFlags :: FlagAssignment,
2830
solverPkgStanzas :: OptionalStanzaSet,

‎cabal-install/src/Distribution/Client/ProjectOrchestration.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1122,6 +1122,9 @@ printPlan
11221122
"Build profile: "
11231123
++ unwords
11241124
[ "-w " ++ (showCompilerId . toolchainCompiler . buildToolchain . pkgConfigToolchains) elaboratedShared
1125+
, if (buildToolchain . pkgConfigToolchains) elaboratedShared /= (hostToolchain . pkgConfigToolchains) elaboratedShared
1126+
then "-W " ++ (showCompilerId . toolchainCompiler . hostToolchain . pkgConfigToolchains) elaboratedShared
1127+
else ""
11251128
, "-O"
11261129
++ ( case globalOptimization <> localOptimization of -- if local is not set, read global
11271130
Setup.Flag NoOptimisation -> "0"

‎cabal-install/src/Distribution/Client/ProjectPlanning.hs‎

Lines changed: 22 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -503,7 +503,7 @@ configureCompiler
503503
)
504504
$ do
505505
liftIO $ info verbosity "Compiler settings changed, reconfiguring..."
506-
506+
507507
defdb <- liftIO $ resolveProgramDb verbosity projectConfigLocalPackages
508508

509509
buildToolchain <- do
@@ -664,7 +664,7 @@ rebuildInstallPlan
664664
(solverPlan, pkgConfigDB, totalIndexState, activeRepos) <-
665665
phaseRunSolver
666666
projectConfig
667-
toolchains
667+
(hostToolchain toolchains)
668668
localPackages
669669
(fromMaybe mempty mbInstalledPackages)
670670
( elaboratedPlan
@@ -743,7 +743,7 @@ rebuildInstallPlan
743743
--
744744
phaseRunSolver
745745
:: ProjectConfig
746-
-> Toolchains
746+
-> Toolchain
747747
-> [PackageSpecifier UnresolvedSourcePackage]
748748
-> InstalledPackageIndex
749749
-> Rebuild (SolverInstallPlan, Maybe PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
@@ -752,7 +752,7 @@ rebuildInstallPlan
752752
{ projectConfigShared
753753
, projectConfigBuildOnly
754754
}
755-
toolchains
755+
toolchain
756756
localPackages
757757
installedPackages =
758758
rerunIfChanged
@@ -761,24 +761,25 @@ rebuildInstallPlan
761761
( solverSettings
762762
, localPackages
763763
, localPackagesEnabledStanzas
764-
, toolchains
764+
, toolchain
765765
, hookHashes
766766
)
767767
$ do
768+
liftIO $ print corePackageDbs
768769
installedPkgIndex <-
769770
getInstalledPackages
770771
verbosity
771-
(buildToolchain toolchains)
772+
toolchain
772773
corePackageDbs
773-
774+
774775
(sourcePkgDb, tis, ar) <-
775776
getSourcePackages
776777
verbosity
777778
withRepoCtx
778779
(solverSettingIndexState solverSettings)
779780
(solverSettingActiveRepos solverSettings)
780-
781-
pkgConfigDB <- getPkgConfigDb verbosity (toolchainProgramDb $ buildToolchain toolchains)
781+
782+
pkgConfigDB <- getPkgConfigDb verbosity (toolchainProgramDb toolchain)
782783

783784
-- TODO: [code cleanup] it'd be better if the Compiler contained the
784785
-- ConfiguredPrograms that it needs, rather than relying on the progdb
@@ -791,7 +792,7 @@ rebuildInstallPlan
791792
foldProgress logMsg (pure . Left) (pure . Right) $
792793
planPackages
793794
verbosity
794-
(hostToolchain toolchains)
795+
toolchain
795796
solverSettings
796797
(installedPackages <> installedPkgIndex)
797798
sourcePkgDb
@@ -800,7 +801,7 @@ rebuildInstallPlan
800801
localPackagesEnabledStanzas
801802
case planOrError of
802803
Left msg -> do
803-
reportPlanningFailure projectConfig (hostToolchain toolchains) localPackages
804+
reportPlanningFailure projectConfig toolchain localPackages
804805
dieWithException verbosity $ PhaseRunSolverErr msg
805806
Right plan -> return (plan, pkgConfigDB, tis, ar)
806807
where
@@ -1680,7 +1681,7 @@ elaborateInstallPlan
16801681
:: (SolverId -> [ElaboratedPlanPackage])
16811682
-> SolverPackage UnresolvedPkgLoc
16821683
-> LogProgress [ElaboratedConfiguredPackage]
1683-
elaborateSolverToComponents mapDep spkg@(SolverPackage qpn _ _ _ deps0 exe_deps0) =
1684+
elaborateSolverToComponents mapDep spkg@(SolverPackage qpn _compiler _ _ _ deps0 exe_deps0) =
16841685
case mkComponentsGraph (elabEnabledSpec elab0) pd of
16851686
Right g -> do
16861687
let src_comps = componentsGraphToList g
@@ -1785,6 +1786,7 @@ elaborateInstallPlan
17851786
elab0
17861787
{ elabModuleShape = emptyModuleShape
17871788
, elabUnitId = notImpl "elabUnitId"
1789+
, elabCompiler = error "setupComponent: elabCompiler"
17881790
, elabComponentId = notImpl "elabComponentId"
17891791
, elabLinkedInstantiatedWith = Map.empty
17901792
, elabInstallDirs = notImpl "elabInstallDirs"
@@ -1921,6 +1923,7 @@ elaborateInstallPlan
19211923
elab1
19221924
{ elabModuleShape = lc_shape lc
19231925
, elabUnitId = abstractUnitId (lc_uid lc)
1926+
, elabCompiler = error "buildComponent: elabCompiler"
19241927
, elabComponentId = lc_cid lc
19251928
, elabLinkedInstantiatedWith = Map.fromList (lc_insts lc)
19261929
, elabPkgOrComp =
@@ -2071,6 +2074,7 @@ elaborateInstallPlan
20712074
pkgWhyNotPerComponent
20722075
pkg@( SolverPackage
20732076
qpn
2077+
_compiler
20742078
(SourcePackage pkgid _gpd _srcloc _descOverride)
20752079
_flags
20762080
_stanzas
@@ -2091,6 +2095,7 @@ elaborateInstallPlan
20912095
elab1 =
20922096
elab0
20932097
{ elabUnitId = newSimpleUnitId pkgInstalledId
2098+
, elabCompiler = error "elaborateSolverToPackage: elabCompiler"
20942099
, elabComponentId = pkgInstalledId
20952100
, elabLinkedInstantiatedWith = Map.empty
20962101
, elabPkgOrComp = ElabPackage $ ElaboratedPackage{..}
@@ -2174,6 +2179,7 @@ elaborateInstallPlan
21742179
-> (ElaboratedConfiguredPackage, LogProgress ())
21752180
elaborateSolverToCommon
21762181
pkg@( SolverPackage
2182+
_compiler
21772183
qpn
21782184
(SourcePackage pkgid gdesc srcloc descOverride)
21792185
flags
@@ -2187,6 +2193,7 @@ elaborateInstallPlan
21872193

21882194
-- These get filled in later
21892195
elabUnitId = error "elaborateSolverToCommon: elabUnitId"
2196+
elabCompiler = error "elaborateSolverToCommon: elabCompiler"
21902197
elabComponentId = error "elaborateSolverToCommon: elabComponentId"
21912198
elabInstantiatedWith = Map.empty
21922199
elabLinkedInstantiatedWith = error "elaborateSolverToCommon: elabLinkedInstantiatedWith"
@@ -2419,9 +2426,9 @@ elaborateInstallPlan
24192426

24202427
inplacePackageDbs =
24212428
corePackageDbs
2422-
++ [distPackageDB (compilerId compiler)]
2429+
++ [distPackageDB (compilerId hostCompiler)]
24232430

2424-
corePackageDbs = storePackageDBStack compiler (projectConfigPackageDBs sharedPackageConfig)
2431+
corePackageDbs = storePackageDBStack hostCompiler (projectConfigPackageDBs sharedPackageConfig)
24252432

24262433
-- For this local build policy, every package that lives in a local source
24272434
-- dir (as opposed to a tarball), or depends on such a package, will be
@@ -2835,6 +2842,7 @@ instantiateInstallPlan storeDirLayout defaultInstallDirs elaboratedShared plan =
28352842
fixupBuildStyle build_style $
28362843
elab0
28372844
{ elabUnitId = uid
2845+
, elabCompiler = error "instantiateComponent: elabCompiler"
28382846
, elabComponentId = cid
28392847
, elabInstantiatedWith = fmap fst insts
28402848
, elabIsCanonical = Map.null (fmap fst insts)

‎cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -206,6 +206,8 @@ instance Structured ElaboratedSharedConfig
206206
data ElaboratedConfiguredPackage = ElaboratedConfiguredPackage
207207
{ elabUnitId :: UnitId
208208
-- ^ The 'UnitId' which uniquely identifies this item in a build plan
209+
, elabCompiler :: Compiler
210+
-- ^ Use this compiler to build this package.
209211
, elabComponentId :: ComponentId
210212
, elabInstantiatedWith :: Map ModuleName Module
211213
, elabLinkedInstantiatedWith :: Map ModuleName OpenModule

‎cabal-install/src/Distribution/Client/SetupWrapper.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1064,10 +1064,12 @@ getExternalSetupMethod verbosity options pkg bt = do
10641064
setupHsNewer <- i setupHs `moreRecentFile` i setupProgFile
10651065
cabalVersionNewer <- i setupVersionFile `moreRecentFile` i setupProgFile
10661066
let outOfDate = setupHsNewer || cabalVersionNewer
1067-
when (outOfDate || forceCompile) $ do
1067+
when (outOfDate || forceCompile || True) $ do
10681068
debug verbosity "Setup executable needs to be updated, compiling..."
10691069
(compiler, progdb, options'') <- configureCompiler options'
1070+
print ("compiler", compilerId compiler)
10701071
pkgDbs <- traverse (traverse (makeRelativeToDirS mbWorkDir)) (coercePackageDBStack (usePackageDB options''))
1072+
print ("pkgDbs", pkgDbs)
10711073
let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
10721074
(program, extraOpts) =
10731075
case compilerFlavor compiler of

0 commit comments

Comments
 (0)