[Git][ghc/ghc][wip/fendor/T27202] Use home unit package db stacks in GHCi prompt and session unit
by Hannes Siebenhandl (＠fendor) 12 May '26
by Hannes Siebenhandl (＠fendor) 12 May '26
12 May '26
Hannes Siebenhandl pushed to branch wip/fendor/T27202 at Glasgow Haskell Compiler / GHC
Commits:
32390e99 by fendor at 2026-05-12T16:05:56+02:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitEnv`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitEnv`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that this rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
23 changed files:
- changelog.d/T27202
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI.hs
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
Changes:
=====================================
changelog.d/T27202
=====================================
@@ -1,9 +1,13 @@
section: ghci
-synopsis: Fix regression to allow loading modules into the GHCi after startup.
+synopsis: Fix regression to honour module targets in nested directories into GHCi after startup.
issues: #27202
mrs: !15980
description: {
Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup.
GHCi wasn't honouring the `-i<directory>` argument if given via `ghci -i<directory>`.
+
+ Further, we fix a bug while setting up package database stacks for GHCi that was uncovered during this fix.
+ By underspecifying the version of dependencies, import modules from dependencies were ambiguous, even though
+ they shouldn't have been!
}
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -37,6 +37,7 @@ module GHC.Driver.DynFlags (
packageFlagsChanged,
IgnorePackageFlag(..), TrustFlag(..),
PackageDBFlag(..), PkgDbRef(..),
+ isPackageDbRef,
Option(..), showOpt,
DynLibLoader(..),
positionIndependent,
@@ -881,7 +882,7 @@ isNoLink _ = False
data PackageArg =
PackageArg String -- ^ @-package@, by 'PackageName'
| UnitIdArg Unit -- ^ @-package-id@, by 'Unit'
- deriving (Eq, Show)
+ deriving (Eq, Ord, Show)
instance Outputable PackageArg where
ppr (PackageArg pn) = text "package" <+> text pn
@@ -902,7 +903,7 @@ data ModRenaming = ModRenaming {
modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
-- under name @n@.
- } deriving (Eq)
+ } deriving (Eq, Ord)
instance Outputable ModRenaming where
ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
@@ -920,14 +921,21 @@ data TrustFlag
data PackageFlag
= ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@
| HidePackage String -- ^ @-hide-package@
- deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
+ deriving (Eq, Ord) -- NB: equality instance is used by packageFlagsChanged
data PackageDBFlag
= PackageDB PkgDbRef
| NoUserPackageDB
| NoGlobalPackageDB
| ClearPackageDBs
- deriving (Eq)
+ deriving (Eq, Ord)
+
+isPackageDbRef :: PackageDBFlag -> Maybe PkgDbRef
+isPackageDbRef = \ case
+ PackageDB ref -> Just ref
+ NoUserPackageDB -> Nothing
+ NoGlobalPackageDB -> Nothing
+ ClearPackageDBs -> Nothing
packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged idflags1 idflags0 =
@@ -1009,7 +1017,7 @@ data PkgDbRef
= GlobalPkgDb
| UserPkgDb
| PkgDbPath OsPath
- deriving Eq
+ deriving (Eq, Ord)
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -68,7 +68,9 @@ module GHC.Unit.State (
pprRawUnitIds,
-- * Utils
- unwireUnit)
+ unwireUnit,
+ selectHptFlag,
+ )
where
import GHC.Prelude
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -9,6 +9,7 @@
{-# OPTIONS -fno-warn-name-shadowing #-}
-- This module does a lot of it
+{-# OPTIONS -Wno-x-partial #-}
-----------------------------------------------------------------------------
--
@@ -53,6 +54,7 @@ import GHC.Driver.Errors (printOrThrowDiagnostics)
import GHC.Driver.Errors.Types
import GHC.Driver.Phases
import GHC.Driver.Session as DynFlags
+import GHC.Driver.DynFlags as DynFlags
import GHC.Driver.Ppr hiding (printForUser)
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Monad ( modifySession, modifySessionM )
@@ -131,6 +133,7 @@ import qualified Data.Foldable as Foldable
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( find, intercalate, intersperse,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import Data.Maybe
@@ -745,6 +748,48 @@ installInteractiveHomeUnits dflags = do
sessionUnitExposedFlag =
homeUnitPkgFlag interactiveSessionUnitId
+ -- Currently, we are in a somewhat awkward situation.
+ -- Users clearly want to control precisely which packages are available at the GHCi prompt,
+ -- but there is currently no way for the user to declaratively change the set of packages
+ -- available at the prompt. Thus, a bit of guessing is necessary to provide the reasonable
+ -- GHCi UX experience, but in the future, we might want to give the user more precise control.
+ --
+ -- The prompt and session home unit may not have any package db specified, but we still want to
+ -- to import modules from our home unit dependencies.
+ -- To make this possible, the prompt and session home unit need to have a package db, but which one?
+ -- We decide, if a package db is given at the top level, e.g. @ghci -package-db ...@,
+ -- then we honour what the user requests and only use this @-package-db@.
+ -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there
+ -- are not @-package-db@ arguments in the base 'DynFlags'...
+ -- To fix this, we look at the home units and merge their package dbs stacks.
+ -- We assume, that many package db stacks look almost identical, and only differ in view elements.
+ -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat
+ -- the rest of the package db stacks. At last, we add the two result package db stacks.
+ -- This should work reliably with cabal and stack, but it is hacky.
+ -- A proper solution would be to teach cabal and other tooling to specify the correct package db
+ -- stacks for the prompt and session home unit.
+ ghciPackageDbStacks =
+ if all (isNothing . DynFlags.isPackageDbRef) (packageDBFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatPackageDbStacksUsingLongestCommonPrefix . map (packageDBFlags . HUG.homeUnitEnv_dflags . snd)
+ else
+ packageDBFlags dflags0
+
+ -- Make sure the prompt and session home unit use the correct dependencies.
+ ghciPackageFlags =
+ if null (packageFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatMap (packageFlags . HUG.homeUnitEnv_dflags . snd)
+ -- We don't want to add `-package-id` flags for home units.
+ -- This is mostly for a clear separation of concerns,
+ -- to indicate we only care about unit dependencies from package dbs.
+ & filter (not . selectHptFlag (HUG.allUnits $ hsc_HUG hsc_env))
+ & ordNub
+ else
+ packageFlags dflags0
+
-- Explicitly depends on all home units and 'sessionUnitExposedFlag'.
-- Normalise the 'dflagsPrompt', as they will be used for 'ic_dflags'
-- of the 'InteractiveContext'.
@@ -759,8 +804,9 @@ installInteractiveHomeUnits dflags = do
, [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags0
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
, importPaths = []
}
@@ -773,25 +819,19 @@ installInteractiveHomeUnits dflags = do
[ [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
}
let
- cached_unit_dbs =
- concat
- . catMaybes
- . fmap homeUnitEnv_unit_dbs
- $ Foldable.toList
- $ hsc_HUG hsc_env
-
all_unit_ids =
S.insert interactiveGhciUnitId $
S.insert interactiveSessionUnitId $
hsc_all_home_unit_ids hsc_env
- ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids cached_unit_dbs
- ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids cached_unit_dbs
+ ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids
+ ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids
let
-- Setup up the HUG, install the interactive home units
withInteractiveUnits =
@@ -813,13 +853,26 @@ installInteractiveHomeUnits dflags = do
pure ()
where
- setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> [UnitDatabase UnitId] -> m HomeUnitEnv
- setupHomeUnitFor logger dflags all_home_units cached_unit_dbs = do
+ setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv
+ setupHomeUnitFor logger dflags all_home_units = do
(dbs,unit_state,home_unit,_mconstants) <-
- liftIO $ initUnits logger dflags (Just cached_unit_dbs) all_home_units
+ liftIO $ initUnits logger dflags Nothing all_home_units
hpt <- liftIO emptyHomePackageTable
pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit))
+ concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
+ concatPackageDbStacksUsingLongestCommonPrefix stacks =
+ let
+ -- O (m * n)
+ -- m ... Number of PackageDBFlag stacks
+ -- n ... Size of the stacks
+ longestCommonPrefix =
+ map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose
+ prefix =
+ longestCommonPrefix stacks
+ in
+ prefix ++ ordNub (concatMap (List.drop (length prefix)) stacks)
+
reportError :: GhciMonad m => GhciCommandMessage -> m ()
reportError err = do
printError err
=====================================
testsuite/tests/ghci/prog-mhu006/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: prog-mhu006a
+prog-mhu006a:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db \
+ -unit @unitA -unit @unitB < prog-mhu006a.script
=====================================
testsuite/tests/ghci/prog-mhu006/a/A.hs
=====================================
@@ -0,0 +1 @@
+module A where
=====================================
testsuite/tests/ghci/prog-mhu006/all.T
=====================================
@@ -0,0 +1,8 @@
+
+proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB'])
+
+test('prog-mhu006a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu006a'])
=====================================
testsuite/tests/ghci/prog-mhu006/b/B.hs
=====================================
@@ -0,0 +1 @@
+module B where
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
=====================================
@@ -0,0 +1,4 @@
+"Can import modules from dependencies"
+:m + Data.ByteString
+:m + Data.Text
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
=====================================
@@ -0,0 +1,2 @@
+"Can import modules from dependencies"
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/unitA
=====================================
@@ -0,0 +1,9 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-global-package-db
+-package base
+-package-id b-0.0.0
+-package containers
=====================================
testsuite/tests/ghci/prog-mhu006/unitB
=====================================
@@ -0,0 +1,8 @@
+-i
+-ib/
+B
+-this-unit-id b-0.0.0
+-this-package-name b
+-global-package-db
+-package base
+-package bytestring
=====================================
testsuite/tests/ghci/prog025/Makefile
=====================================
@@ -0,0 +1,54 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+PKGCONF01=local01.package.conf
+LOCAL_GHC_PKG01 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF01)
+
+# When the user package databases are cleared, the GHCi prompt still needs to be able to find
+# modules from home unit dependencies.
+# Moreover, it needs to find the correct dependency unit, not just any.
+.PHONY: prog025a
+prog025a:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code -unit @unitA < prog025a.script
+
+# Same as prog025a, but the home unit arguments are not provided using a response file
+.PHONY: prog025b
+prog025b:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ # Uses response file for argument, doesn't use it as a -unit argument
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code \
+ @unitA < prog025b.script
=====================================
testsuite/tests/ghci/prog025/a/A.hs
=====================================
@@ -0,0 +1,3 @@
+module A where
+
+import Test
=====================================
testsuite/tests/ghci/prog025/all.T
=====================================
@@ -0,0 +1,14 @@
+
+proj_files = extra_files(['a/', 'unitA', 'testpkg/'])
+
+test('prog025a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025a'])
+
+test('prog025b',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025b'])
=====================================
testsuite/tests/ghci/prog025/prog025a.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025a.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/testpkg/Test.hs
=====================================
@@ -0,0 +1 @@
+module Test where
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.1.0.0
+id: testpkg-0.1.0.0-XXX
+key: testpkg-0.1.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/dist-testpkg-0.1.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.2.0.0
+id: testpkg-0.2.0.0-XXX
+key: testpkg-0.2.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/testpkg/dist-testpkg-0.2.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/unitA
=====================================
@@ -0,0 +1,11 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-clear-package-db
+-global-package-db
+-no-user-package-db
+-package-db local01.package.conf
+-package base
+-package-id testpkg-0.2.0.0-XXX
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32390e99033b73484da479eed3fa457…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32390e99033b73484da479eed3fa457…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/T27202] Use home unit package db stacks in GHCi prompt and session unit
by Hannes Siebenhandl (＠fendor) 12 May '26
by Hannes Siebenhandl (＠fendor) 12 May '26
12 May '26
Hannes Siebenhandl pushed to branch wip/fendor/T27202 at Glasgow Haskell Compiler / GHC
Commits:
833ca63e by fendor at 2026-05-12T16:04:53+02:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitEnv`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitEnv`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that this rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
24 changed files:
- changelog.d/T27202
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI.hs
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
Changes:
=====================================
changelog.d/T27202
=====================================
@@ -1,9 +1,13 @@
section: ghci
-synopsis: Fix regression to allow loading modules into the GHCi after startup.
+synopsis: Fix regression to honour module targets in nested directories into GHCi after startup.
issues: #27202
mrs: !15980
description: {
Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup.
GHCi wasn't honouring the `-i<directory>` argument if given via `ghci -i<directory>`.
+
+ Further, we fix a bug while setting up package database stacks for GHCi that was uncovered during this fix.
+ By underspecifying the version of dependencies, import modules from dependencies were ambiguous, even though
+ they shouldn't have been!
}
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -37,6 +37,7 @@ module GHC.Driver.DynFlags (
packageFlagsChanged,
IgnorePackageFlag(..), TrustFlag(..),
PackageDBFlag(..), PkgDbRef(..),
+ isPackageDbRef,
Option(..), showOpt,
DynLibLoader(..),
positionIndependent,
@@ -881,7 +882,7 @@ isNoLink _ = False
data PackageArg =
PackageArg String -- ^ @-package@, by 'PackageName'
| UnitIdArg Unit -- ^ @-package-id@, by 'Unit'
- deriving (Eq, Show)
+ deriving (Eq, Ord, Show)
instance Outputable PackageArg where
ppr (PackageArg pn) = text "package" <+> text pn
@@ -902,7 +903,7 @@ data ModRenaming = ModRenaming {
modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
-- under name @n@.
- } deriving (Eq)
+ } deriving (Eq, Ord)
instance Outputable ModRenaming where
ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
@@ -920,14 +921,21 @@ data TrustFlag
data PackageFlag
= ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@
| HidePackage String -- ^ @-hide-package@
- deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
+ deriving (Eq, Ord) -- NB: equality instance is used by packageFlagsChanged
data PackageDBFlag
= PackageDB PkgDbRef
| NoUserPackageDB
| NoGlobalPackageDB
| ClearPackageDBs
- deriving (Eq)
+ deriving (Eq, Ord)
+
+isPackageDbRef :: PackageDBFlag -> Maybe PkgDbRef
+isPackageDbRef = \ case
+ PackageDB ref -> Just ref
+ NoUserPackageDB -> Nothing
+ NoGlobalPackageDB -> Nothing
+ ClearPackageDBs -> Nothing
packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged idflags1 idflags0 =
@@ -1009,7 +1017,7 @@ data PkgDbRef
= GlobalPkgDb
| UserPkgDb
| PkgDbPath OsPath
- deriving Eq
+ deriving (Eq, Ord)
=====================================
compiler/GHC/Unit/Home/Graph.hs
=====================================
@@ -118,6 +118,10 @@ allAnns :: HomeUnitGraph -> IO AnnEnv
allAnns hug = foldr go (pure emptyAnnEnv) hug where
go hue = liftA2 plusAnnEnv (hptAllAnnotations (homeUnitEnv_hpt hue))
+-- | Retrieve all 'UnitId's of units in the 'HomeUnitGraph'.
+allUnits :: HomeUnitGraph -> Set.Set UnitId
+allUnits = unitEnv_keys
+
--------------------------------------------------------------------------------
-- HomeUnitGraph (HUG)
--------------------------------------------------------------------------------
@@ -211,10 +215,6 @@ renameUnitId oldUnit newUnit hug = case unitEnv_lookup_maybe oldUnit hug of
unitEnv_insert newUnit oldHue $
unitEnv_delete oldUnit hug
--- | Retrieve all 'UnitId's of units in the 'HomeUnitGraph'.
-allUnits :: HomeUnitGraph -> Set.Set UnitId
-allUnits = unitEnv_keys
-
-- | Set the 'DynFlags' of the 'HomeUnitEnv' for unit in the 'HomeModuleGraph'
updateUnitFlags :: UnitId -> (DynFlags -> DynFlags) -> HomeUnitGraph -> HomeUnitGraph
updateUnitFlags uid f = unitEnv_adjust update uid
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -68,7 +68,9 @@ module GHC.Unit.State (
pprRawUnitIds,
-- * Utils
- unwireUnit)
+ unwireUnit,
+ selectHptFlag,
+ )
where
import GHC.Prelude
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -9,6 +9,7 @@
{-# OPTIONS -fno-warn-name-shadowing #-}
-- This module does a lot of it
+{-# OPTIONS -Wno-x-partial #-}
-----------------------------------------------------------------------------
--
@@ -53,6 +54,7 @@ import GHC.Driver.Errors (printOrThrowDiagnostics)
import GHC.Driver.Errors.Types
import GHC.Driver.Phases
import GHC.Driver.Session as DynFlags
+import GHC.Driver.DynFlags as DynFlags
import GHC.Driver.Ppr hiding (printForUser)
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Monad ( modifySession, modifySessionM )
@@ -131,6 +133,7 @@ import qualified Data.Foldable as Foldable
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( find, intercalate, intersperse,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import Data.Maybe
@@ -745,6 +748,48 @@ installInteractiveHomeUnits dflags = do
sessionUnitExposedFlag =
homeUnitPkgFlag interactiveSessionUnitId
+ -- Currently, we are in a somewhat awkward situation.
+ -- Users clearly want to control precisely which packages are available at the GHCi prompt,
+ -- but there is currently no way for the user to declaratively change the set of packages
+ -- available at the prompt. Thus, a bit of guessing is necessary to provide the reasonable
+ -- GHCi UX experience, but in the future, we might want to give the user more precise control.
+ --
+ -- The prompt and session home unit may not have any package db specified, but we still want to
+ -- to import modules from our home unit dependencies.
+ -- To make this possible, the prompt and session home unit need to have a package db, but which one?
+ -- We decide, if a package db is given at the top level, e.g. @ghci -package-db ...@,
+ -- then we honour what the user requests and only use this @-package-db@.
+ -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there
+ -- are not @-package-db@ arguments in the base 'DynFlags'...
+ -- To fix this, we look at the home units and merge their package dbs stacks.
+ -- We assume, that many package db stacks look almost identical, and only differ in view elements.
+ -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat
+ -- the rest of the package db stacks. At last, we add the two result package db stacks.
+ -- This should work reliably with cabal and stack, but it is hacky.
+ -- A proper solution would be to teach cabal and other tooling to specify the correct package db
+ -- stacks for the prompt and session home unit.
+ ghciPackageDbStacks =
+ if all (isNothing . DynFlags.isPackageDbRef) (packageDBFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatPackageDbStacksUsingLongestCommonPrefix . map (packageDBFlags . HUG.homeUnitEnv_dflags . snd)
+ else
+ packageDBFlags dflags0
+
+ -- Make sure the prompt and session home unit use the correct dependencies.
+ ghciPackageFlags =
+ if null (packageFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatMap (packageFlags . HUG.homeUnitEnv_dflags . snd)
+ -- We don't want to add `-package-id` flags for home units.
+ -- This is mostly for a clear separation of concerns,
+ -- to indicate we only care about unit dependencies from package dbs.
+ & filter (not . selectHptFlag (HUG.allUnits $ hsc_HUG hsc_env))
+ & ordNub
+ else
+ packageFlags dflags0
+
-- Explicitly depends on all home units and 'sessionUnitExposedFlag'.
-- Normalise the 'dflagsPrompt', as they will be used for 'ic_dflags'
-- of the 'InteractiveContext'.
@@ -759,8 +804,9 @@ installInteractiveHomeUnits dflags = do
, [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags0
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
, importPaths = []
}
@@ -773,25 +819,19 @@ installInteractiveHomeUnits dflags = do
[ [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
}
let
- cached_unit_dbs =
- concat
- . catMaybes
- . fmap homeUnitEnv_unit_dbs
- $ Foldable.toList
- $ hsc_HUG hsc_env
-
all_unit_ids =
S.insert interactiveGhciUnitId $
S.insert interactiveSessionUnitId $
hsc_all_home_unit_ids hsc_env
- ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids cached_unit_dbs
- ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids cached_unit_dbs
+ ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids
+ ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids
let
-- Setup up the HUG, install the interactive home units
withInteractiveUnits =
@@ -813,13 +853,26 @@ installInteractiveHomeUnits dflags = do
pure ()
where
- setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> [UnitDatabase UnitId] -> m HomeUnitEnv
- setupHomeUnitFor logger dflags all_home_units cached_unit_dbs = do
+ setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv
+ setupHomeUnitFor logger dflags all_home_units = do
(dbs,unit_state,home_unit,_mconstants) <-
- liftIO $ initUnits logger dflags (Just cached_unit_dbs) all_home_units
+ liftIO $ initUnits logger dflags Nothing all_home_units
hpt <- liftIO emptyHomePackageTable
pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit))
+ concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
+ concatPackageDbStacksUsingLongestCommonPrefix stacks =
+ let
+ -- O (m * n)
+ -- m ... Number of PackageDBFlag stacks
+ -- n ... Size of the stacks
+ longestCommonPrefix =
+ map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose
+ prefix =
+ longestCommonPrefix stacks
+ in
+ prefix ++ ordNub (concatMap (List.drop (length prefix)) stacks)
+
reportError :: GhciMonad m => GhciCommandMessage -> m ()
reportError err = do
printError err
=====================================
testsuite/tests/ghci/prog-mhu006/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: prog-mhu006a
+prog-mhu006a:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db \
+ -unit @unitA -unit @unitB < prog-mhu006a.script
=====================================
testsuite/tests/ghci/prog-mhu006/a/A.hs
=====================================
@@ -0,0 +1 @@
+module A where
=====================================
testsuite/tests/ghci/prog-mhu006/all.T
=====================================
@@ -0,0 +1,8 @@
+
+proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB'])
+
+test('prog-mhu006a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu006a'])
=====================================
testsuite/tests/ghci/prog-mhu006/b/B.hs
=====================================
@@ -0,0 +1 @@
+module B where
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
=====================================
@@ -0,0 +1,4 @@
+"Can import modules from dependencies"
+:m + Data.ByteString
+:m + Data.Text
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
=====================================
@@ -0,0 +1,2 @@
+"Can import modules from dependencies"
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/unitA
=====================================
@@ -0,0 +1,9 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-global-package-db
+-package base
+-package-id b-0.0.0
+-package containers
=====================================
testsuite/tests/ghci/prog-mhu006/unitB
=====================================
@@ -0,0 +1,8 @@
+-i
+-ib/
+B
+-this-unit-id b-0.0.0
+-this-package-name b
+-global-package-db
+-package base
+-package bytestring
=====================================
testsuite/tests/ghci/prog025/Makefile
=====================================
@@ -0,0 +1,54 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+PKGCONF01=local01.package.conf
+LOCAL_GHC_PKG01 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF01)
+
+# When the user package databases are cleared, the GHCi prompt still needs to be able to find
+# modules from home unit dependencies.
+# Moreover, it needs to find the correct dependency unit, not just any.
+.PHONY: prog025a
+prog025a:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code -unit @unitA < prog025a.script
+
+# Same as prog025a, but the home unit arguments are not provided using a response file
+.PHONY: prog025b
+prog025b:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ # Uses response file for argument, doesn't use it as a -unit argument
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code \
+ @unitA < prog025b.script
=====================================
testsuite/tests/ghci/prog025/a/A.hs
=====================================
@@ -0,0 +1,3 @@
+module A where
+
+import Test
=====================================
testsuite/tests/ghci/prog025/all.T
=====================================
@@ -0,0 +1,14 @@
+
+proj_files = extra_files(['a/', 'unitA', 'testpkg/'])
+
+test('prog025a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025a'])
+
+test('prog025b',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025b'])
=====================================
testsuite/tests/ghci/prog025/prog025a.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025a.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/testpkg/Test.hs
=====================================
@@ -0,0 +1 @@
+module Test where
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.1.0.0
+id: testpkg-0.1.0.0-XXX
+key: testpkg-0.1.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/dist-testpkg-0.1.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.2.0.0
+id: testpkg-0.2.0.0-XXX
+key: testpkg-0.2.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/testpkg/dist-testpkg-0.2.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/unitA
=====================================
@@ -0,0 +1,11 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-clear-package-db
+-global-package-db
+-no-user-package-db
+-package-db local01.package.conf
+-package base
+-package-id testpkg-0.2.0.0-XXX
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/833ca63ebbee0e73a391a125dfab414…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/833ca63ebbee0e73a391a125dfab414…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/fendor/T27202] Use home unit package db stacks in GHCi prompt and session unit
by Hannes Siebenhandl (＠fendor) 12 May '26
by Hannes Siebenhandl (＠fendor) 12 May '26
12 May '26
Hannes Siebenhandl pushed to branch wip/fendor/T27202 at Glasgow Haskell Compiler / GHC
Commits:
77d6c0a6 by fendor at 2026-05-12T15:51:35+02:00
Use home unit package db stacks in GHCi prompt and session unit
In order to import modules from home unit dependencies (e.g., `Data.Map`),
the ghci prompt unit needs to populate its `UnitEnv`.
This is tricky to handle correctly, which `PackageDBFlag`s should we use
to populate the `UnitEnv`?
We decide, the most intuitive solution for users is to depend on all
`PackageDBFlag`s, so that any dependency can be imported in GHCi.
This assumes consistency in the `PackageDBFlag`s, so no two home units
specify `PackageDBFlag`s that are inconsistent with each other.
We could simply concat all the `PackageDBFlag`s of the existing home
units, but later `PackageDBFlag`s shadow earlier ones, leading to the
last processed home units' `PackageDBFlag`s to shadow the earlier ones.
This is hard to fix, we need to give users the capability to provide ghc
options for the ghci prompt home unit.
However, as this is considerably more work, we decided on an
approximation that should work out most of the time.
Package Db stacks in cabal and stack follow a certain structure:
-no-user-package-db > -package-db $cabal-store > -package-db $local-db
The first two arguments are always the same, namely the
`-no-user-package-db` and `-package-db`.
We compute the longest common prefix over all home units, and use that
as the start of the package db stack. Then, over the rest of the
`PackageDBFlag`s, we simply take the union and append them to our
initial stack.
We assume, that this rest of package dbs only defines very few, "local"
units that are usually not shadowing each other.
This allows us to get a relatively consistent package database stack for
the ghci prompt home unit.
Similar reasoning applies to the session unit in order to add modules to
the session and have dependencies available in the module.
We do something similar for `-package` flags, to make sure only the
correct units are actually visible in the ghci session.
This time, we simply take the union of all `PackageFlag`s, allowing us
to import modules from the home unit dependencies.
In the future, it would be beneficial to allow the user to provide the
exact ghc options to control the visibilities. For now, this will have
to do.
- - - - -
24 changed files:
- changelog.d/T27202
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Unit/Home/Graph.hs
- compiler/GHC/Unit/State.hs
- ghc/GHCi/UI.hs
- + testsuite/tests/ghci/prog-mhu006/Makefile
- + testsuite/tests/ghci/prog-mhu006/a/A.hs
- + testsuite/tests/ghci/prog-mhu006/all.T
- + testsuite/tests/ghci/prog-mhu006/b/B.hs
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
- + testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
- + testsuite/tests/ghci/prog-mhu006/unitA
- + testsuite/tests/ghci/prog-mhu006/unitB
- + testsuite/tests/ghci/prog025/Makefile
- + testsuite/tests/ghci/prog025/a/A.hs
- + testsuite/tests/ghci/prog025/all.T
- + testsuite/tests/ghci/prog025/prog025a.script
- + testsuite/tests/ghci/prog025/prog025a.stdout
- + testsuite/tests/ghci/prog025/prog025b.script
- + testsuite/tests/ghci/prog025/prog025b.stdout
- + testsuite/tests/ghci/prog025/testpkg/Test.hs
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
- + testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
- + testsuite/tests/ghci/prog025/unitA
Changes:
=====================================
changelog.d/T27202
=====================================
@@ -1,9 +1,13 @@
section: ghci
-synopsis: Fix regression to allow loading modules into the GHCi after startup.
+synopsis: Fix regression to honour module targets in nested directories into GHCi after startup.
issues: #27202
mrs: !15980
description: {
Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup.
GHCi wasn't honouring the `-i<directory>` argument if given via `ghci -i<directory>`.
+
+ Further, we fix a bug while setting up package database stacks for GHCi that was uncovered during this fix.
+ By underspecifying the version of dependencies, import modules from dependencies were ambiguous, even though
+ they shouldn't have been!
}
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -37,6 +37,7 @@ module GHC.Driver.DynFlags (
packageFlagsChanged,
IgnorePackageFlag(..), TrustFlag(..),
PackageDBFlag(..), PkgDbRef(..),
+ isPackageDbRef,
Option(..), showOpt,
DynLibLoader(..),
positionIndependent,
@@ -881,7 +882,7 @@ isNoLink _ = False
data PackageArg =
PackageArg String -- ^ @-package@, by 'PackageName'
| UnitIdArg Unit -- ^ @-package-id@, by 'Unit'
- deriving (Eq, Show)
+ deriving (Eq, Ord, Show)
instance Outputable PackageArg where
ppr (PackageArg pn) = text "package" <+> text pn
@@ -902,7 +903,7 @@ data ModRenaming = ModRenaming {
modRenamingWithImplicit :: Bool, -- ^ Bring all exposed modules into scope?
modRenamings :: [(ModuleName, ModuleName)] -- ^ Bring module @m@ into scope
-- under name @n@.
- } deriving (Eq)
+ } deriving (Eq, Ord)
instance Outputable ModRenaming where
ppr (ModRenaming b rns) = ppr b <+> parens (ppr rns)
@@ -920,14 +921,21 @@ data TrustFlag
data PackageFlag
= ExposePackage String PackageArg ModRenaming -- ^ @-package@, @-package-id@
| HidePackage String -- ^ @-hide-package@
- deriving (Eq) -- NB: equality instance is used by packageFlagsChanged
+ deriving (Eq, Ord) -- NB: equality instance is used by packageFlagsChanged
data PackageDBFlag
= PackageDB PkgDbRef
| NoUserPackageDB
| NoGlobalPackageDB
| ClearPackageDBs
- deriving (Eq)
+ deriving (Eq, Ord)
+
+isPackageDbRef :: PackageDBFlag -> Maybe PkgDbRef
+isPackageDbRef = \ case
+ PackageDB ref -> Just ref
+ NoUserPackageDB -> Nothing
+ NoGlobalPackageDB -> Nothing
+ ClearPackageDBs -> Nothing
packageFlagsChanged :: DynFlags -> DynFlags -> Bool
packageFlagsChanged idflags1 idflags0 =
@@ -1009,7 +1017,7 @@ data PkgDbRef
= GlobalPkgDb
| UserPkgDb
| PkgDbPath OsPath
- deriving Eq
+ deriving (Eq, Ord)
=====================================
compiler/GHC/Unit/Home/Graph.hs
=====================================
@@ -118,6 +118,10 @@ allAnns :: HomeUnitGraph -> IO AnnEnv
allAnns hug = foldr go (pure emptyAnnEnv) hug where
go hue = liftA2 plusAnnEnv (hptAllAnnotations (homeUnitEnv_hpt hue))
+-- | Retrieve all 'UnitId's of units in the 'HomeUnitGraph'.
+allUnits :: HomeUnitGraph -> Set.Set UnitId
+allUnits = unitEnv_keys
+
--------------------------------------------------------------------------------
-- HomeUnitGraph (HUG)
--------------------------------------------------------------------------------
@@ -211,10 +215,6 @@ renameUnitId oldUnit newUnit hug = case unitEnv_lookup_maybe oldUnit hug of
unitEnv_insert newUnit oldHue $
unitEnv_delete oldUnit hug
--- | Retrieve all 'UnitId's of units in the 'HomeUnitGraph'.
-allUnits :: HomeUnitGraph -> Set.Set UnitId
-allUnits = unitEnv_keys
-
-- | Set the 'DynFlags' of the 'HomeUnitEnv' for unit in the 'HomeModuleGraph'
updateUnitFlags :: UnitId -> (DynFlags -> DynFlags) -> HomeUnitGraph -> HomeUnitGraph
updateUnitFlags uid f = unitEnv_adjust update uid
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -68,7 +68,9 @@ module GHC.Unit.State (
pprRawUnitIds,
-- * Utils
- unwireUnit)
+ unwireUnit,
+ selectHptFlag,
+ )
where
import GHC.Prelude
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -8,6 +8,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
+{-# OPTIONS -Wno-x-partial #-}
-- This module does a lot of it
-----------------------------------------------------------------------------
@@ -53,6 +54,7 @@ import GHC.Driver.Errors (printOrThrowDiagnostics)
import GHC.Driver.Errors.Types
import GHC.Driver.Phases
import GHC.Driver.Session as DynFlags
+import GHC.Driver.DynFlags as DynFlags
import GHC.Driver.Ppr hiding (printForUser)
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Monad ( modifySession, modifySessionM )
@@ -131,6 +133,7 @@ import qualified Data.Foldable as Foldable
import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
import Data.List ( find, intercalate, intersperse,
isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) )
+import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import Data.Maybe
@@ -745,6 +748,48 @@ installInteractiveHomeUnits dflags = do
sessionUnitExposedFlag =
homeUnitPkgFlag interactiveSessionUnitId
+ -- Currently, we are in a somewhat awkward situation.
+ -- Users clearly want to control precisely which packages are available at the GHCi prompt,
+ -- but there is currently no way for the user to declaratively change the set of packages
+ -- available at the prompt. Thus, a bit of guessing is necessary to provide the reasonable
+ -- GHCi UX experience, but in the future, we might want to give the user more precise control.
+ --
+ -- The prompt and session home unit may not have any package db specified, but we still want to
+ -- to import modules from our home unit dependencies.
+ -- To make this possible, the prompt and session home unit need to have a package db, but which one?
+ -- We decide, if a package db is given at the top level, e.g. @ghci -package-db ...@,
+ -- then we honour what the user requests and only use this @-package-db@.
+ -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there
+ -- are not @-package-db@ arguments in the base 'DynFlags'...
+ -- To fix this, we look at the home units and merge their package dbs stacks.
+ -- We assume, that many package db stacks look almost identical, and only differ in view elements.
+ -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat
+ -- the rest of the package db stacks. At last, we add the two result package db stacks.
+ -- This should work reliably with cabal and stack, but it is hacky.
+ -- A proper solution would be to teach cabal and other tooling to specify the correct package db
+ -- stacks for the prompt and session home unit.
+ ghciPackageDbStacks =
+ if all (isNothing . DynFlags.isPackageDbRef) (packageDBFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatPackageDbStacksUsingLongestCommonPrefix . map (packageDBFlags . HUG.homeUnitEnv_dflags . snd)
+ else
+ packageDBFlags dflags0
+
+ -- Make sure the prompt and session home unit use the correct dependencies.
+ ghciPackageFlags =
+ if null (packageFlags dflags0)
+ then
+ HUG.unitEnv_assocs (hsc_HUG hsc_env)
+ & concatMap (packageFlags . HUG.homeUnitEnv_dflags . snd)
+ -- We don't want to add `-package-id` flags for home units.
+ -- This is mostly for a clear separation of concerns,
+ -- to indicate we only care about unit dependencies from package dbs.
+ & filter (not . selectHptFlag (HUG.allUnits $ hsc_HUG hsc_env))
+ & ordNub
+ else
+ packageFlags dflags0
+
-- Explicitly depends on all home units and 'sessionUnitExposedFlag'.
-- Normalise the 'dflagsPrompt', as they will be used for 'ic_dflags'
-- of the 'InteractiveContext'.
@@ -759,8 +804,9 @@ installInteractiveHomeUnits dflags = do
, [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags0
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
, importPaths = []
}
@@ -773,25 +819,19 @@ installInteractiveHomeUnits dflags = do
[ [ homeUnitPkgFlag uid
| uid <- S.toList $ HUG.allUnits $ hsc_HUG hsc_env
]
- , packageFlags dflags
+ , ghciPackageFlags
]
+ , packageDBFlags = ghciPackageDbStacks
}
let
- cached_unit_dbs =
- concat
- . catMaybes
- . fmap homeUnitEnv_unit_dbs
- $ Foldable.toList
- $ hsc_HUG hsc_env
-
all_unit_ids =
S.insert interactiveGhciUnitId $
S.insert interactiveSessionUnitId $
hsc_all_home_unit_ids hsc_env
- ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids cached_unit_dbs
- ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids cached_unit_dbs
+ ghciPromptUnit <- setupHomeUnitFor logger dflagsPrompt all_unit_ids
+ ghciSessionUnit <- setupHomeUnitFor logger dflagsSession all_unit_ids
let
-- Setup up the HUG, install the interactive home units
withInteractiveUnits =
@@ -813,13 +853,26 @@ installInteractiveHomeUnits dflags = do
pure ()
where
- setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> [UnitDatabase UnitId] -> m HomeUnitEnv
- setupHomeUnitFor logger dflags all_home_units cached_unit_dbs = do
+ setupHomeUnitFor :: GHC.GhcMonad m => Logger -> DynFlags -> S.Set UnitId -> m HomeUnitEnv
+ setupHomeUnitFor logger dflags all_home_units = do
(dbs,unit_state,home_unit,_mconstants) <-
- liftIO $ initUnits logger dflags (Just cached_unit_dbs) all_home_units
+ liftIO $ initUnits logger dflags Nothing all_home_units
hpt <- liftIO emptyHomePackageTable
pure (HUG.mkHomeUnitEnv unit_state (Just dbs) dflags hpt (Just home_unit))
+ concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
+ concatPackageDbStacksUsingLongestCommonPrefix stacks =
+ let
+ -- O (m * n)
+ -- m ... Number of PackageDBFlag stacks
+ -- n ... Size of the stacks
+ longestCommonPrefix =
+ map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose
+ prefix =
+ longestCommonPrefix stacks
+ in
+ prefix ++ ordNub (concatMap (List.drop (length prefix)) stacks)
+
reportError :: GhciMonad m => GhciCommandMessage -> m ()
reportError err = do
printError err
=====================================
testsuite/tests/ghci/prog-mhu006/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: prog-mhu006a
+prog-mhu006a:
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db \
+ -unit @unitA -unit @unitB < prog-mhu006a.script
=====================================
testsuite/tests/ghci/prog-mhu006/a/A.hs
=====================================
@@ -0,0 +1 @@
+module A where
=====================================
testsuite/tests/ghci/prog-mhu006/all.T
=====================================
@@ -0,0 +1,8 @@
+
+proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB'])
+
+test('prog-mhu006a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog-mhu006a'])
=====================================
testsuite/tests/ghci/prog-mhu006/b/B.hs
=====================================
@@ -0,0 +1 @@
+module B where
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.script
=====================================
@@ -0,0 +1,4 @@
+"Can import modules from dependencies"
+:m + Data.ByteString
+:m + Data.Text
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/prog-mhu006a.stdout
=====================================
@@ -0,0 +1,2 @@
+"Can import modules from dependencies"
+"Imported Data.ByteString and Data.Text"
=====================================
testsuite/tests/ghci/prog-mhu006/unitA
=====================================
@@ -0,0 +1,9 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-global-package-db
+-package base
+-package-id b-0.0.0
+-package containers
=====================================
testsuite/tests/ghci/prog-mhu006/unitB
=====================================
@@ -0,0 +1,8 @@
+-i
+-ib/
+B
+-this-unit-id b-0.0.0
+-this-package-name b
+-global-package-db
+-package base
+-package bytestring
=====================================
testsuite/tests/ghci/prog025/Makefile
=====================================
@@ -0,0 +1,54 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+PKGCONF01=local01.package.conf
+LOCAL_GHC_PKG01 = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF01)
+
+# When the user package databases are cleared, the GHCi prompt still needs to be able to find
+# modules from home unit dependencies.
+# Moreover, it needs to find the correct dependency unit, not just any.
+.PHONY: prog025a
+prog025a:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code -unit @unitA < prog025a.script
+
+# Same as prog025a, but the home unit arguments are not provided using a response file
+.PHONY: prog025b
+prog025b:
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.1.0.0 -this-unit-id testpkg-0.1.0.0-XXX \
+ -i. Test
+ cd testpkg && \
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
+ -v0 -fno-code -fwrite-interface -hidir dist-testpkg-0.2.0.0 -this-unit-id testpkg-0.2.0.0-XXX \
+ -i. Test
+
+ $(LOCAL_GHC_PKG01) init $(PKGCONF01) 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.1.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) register --force testpkg/testpkg-0.2.0.0.pkg 2>/dev/null
+ $(LOCAL_GHC_PKG01) hide testpkg-0.1.0.0
+ $(LOCAL_GHC_PKG01) hide testpkg-0.2.0.0
+ $(LOCAL_GHC_PKG01) list
+
+ # Uses response file for argument, doesn't use it as a -unit argument
+ '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
+ -no-user-package-db -fno-code \
+ @unitA < prog025b.script
=====================================
testsuite/tests/ghci/prog025/a/A.hs
=====================================
@@ -0,0 +1,3 @@
+module A where
+
+import Test
=====================================
testsuite/tests/ghci/prog025/all.T
=====================================
@@ -0,0 +1,14 @@
+
+proj_files = extra_files(['a/', 'unitA', 'testpkg/'])
+
+test('prog025a',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025a'])
+
+test('prog025b',
+ [proj_files,
+ cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
+ req_interp],
+ makefile_test, ['prog025b'])
=====================================
testsuite/tests/ghci/prog025/prog025a.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025a.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.script
=====================================
@@ -0,0 +1,2 @@
+:m + Test
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/prog025b.stdout
=====================================
@@ -0,0 +1,7 @@
+Reading package info from "testpkg/testpkg-0.1.0.0.pkg" ... done.
+Reading package info from "testpkg/testpkg-0.2.0.0.pkg" ... done.
+local01.package.conf
+ (testpkg-0.1.0.0)
+ (testpkg-0.2.0.0)
+
+"Imported package dependency module with multiple installed versions"
=====================================
testsuite/tests/ghci/prog025/testpkg/Test.hs
=====================================
@@ -0,0 +1 @@
+module Test where
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.1.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.1.0.0
+id: testpkg-0.1.0.0-XXX
+key: testpkg-0.1.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/dist-testpkg-0.1.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/testpkg/testpkg-0.2.0.0.pkg
=====================================
@@ -0,0 +1,11 @@
+name: testpkg
+version: 0.2.0.0
+id: testpkg-0.2.0.0-XXX
+key: testpkg-0.2.0.0-XXX
+exposed: True
+exposed-modules: Test
+hidden-modules:
+import-dirs: ${pkgroot}/testpkg/dist-testpkg-0.2.0.0
+library-dirs:
+include-dirs:
+hs-libraries:
=====================================
testsuite/tests/ghci/prog025/unitA
=====================================
@@ -0,0 +1,11 @@
+-i
+-ia/
+A
+-this-unit-id a-0.0.0
+-this-package-name a
+-clear-package-db
+-global-package-db
+-no-user-package-db
+-package-db local01.package.conf
+-package base
+-package-id testpkg-0.2.0.0-XXX
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77d6c0a687bf3cf71efaa24d796f186…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77d6c0a687bf3cf71efaa24d796f186…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Script for downloading and copying `base-exports` file
by Marge Bot (＠marge-bot) 12 May '26
by Marge Bot (＠marge-bot) 12 May '26
12 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c8dae539 by Alice Rixte at 2026-05-12T09:50:52-04:00
Script for downloading and copying `base-exports` file
- - - - -
3 changed files:
- + testsuite/tests/interface-stability/.gitignore
- testsuite/tests/interface-stability/README.mkd
- + testsuite/tests/interface-stability/download-base-exports.sh
Changes:
=====================================
testsuite/tests/interface-stability/.gitignore
=====================================
@@ -0,0 +1 @@
+download-base-exports
=====================================
testsuite/tests/interface-stability/README.mkd
=====================================
@@ -1,6 +1,6 @@
# Interface stability testing
-The tests in this directory verify that the interfaces of exposed by GHC's
+The tests in this directory verify that the interfaces exposed by GHC's
core libraries do not inadvertently change. They use the `utils/dump-decls`
utility to dump all exported declarations of all exposed modules for the
following packages:
@@ -27,7 +27,9 @@ The `base-exports` test in particular has rather platform-dependent output.
Consequently, updating its output can be a bit tricky. There are two ways by
which one can do this:
- * Extrapolation: The various platforms' `base-exports.stdout` files are
+#### Extrapolation
+
+The various platforms' `base-exports.stdout` files are
similar enough that one can often apply the same patch of one file to the
others. For instance:
```
@@ -40,8 +42,44 @@ which one can do this:
In the case of conflicts, increasing the fuzz factor (using `-F`) can be
quite effective.
- * Using CI: Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
+#### Using CI
+
+Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
which contains the output produced by the job's failing tests. Simply
- download this tarball and extracting the appropriate `base-exports.stdout-*`
+ download this tarball and extract the appropriate `base-exports.stdout-*`
files into this directory.
+Doing this by hand is of course very annoying. To make things faster, use the script in this folder called `download.base-exports.sh` :
+
+* Running for the first time
+ 1. Find the URL for downloading unexpected-test-output.tar.gz. To do so
+ * Go to the CI job page you want to download
+ * Click on "Browse"
+ * Find unexpected-test-output.tar.gz
+ * Right-click the download link then "Copy link" (Firefox)
+ 2. The URL should look like this :
+ `https://gitlab.haskell.org/ghc/ghc/-/jobs/2503744/artifacts/file/unexpected-test-output.tar.gz`
+ * the prefix is : `https://gitlab.haskell.org/ghc/ghc/-/jobs/`
+ * the job ID is : `2503744`
+ * and the suffix : `/artifacts/file/unexpected-test-output.tar.gz`
+ 3. The script prompts you with URL prefix and suffix.
+ 4. It will save a file to remember this, so you only need to do this once.
+ 5. If you need to change the URL, just edit the file `download-base-exports/url-unexpected-test-output` directly.
+
+* Downloading the artifacts
+ 1. Find all the job IDs you want to download. For this, just go to the jobs
+ page `https://gitlab.haskell.org/<YOUR-FORK>/ghc/-/jobs`
+ 2. Make sure you get all the artifacts. You need 3 of them.
+ To get all 3 CI jobs, the label `javascript` must be on the MR.
+ If you don't have the rights for adding these labels, ask.
+ 1. The `x86` CI job for darwin or linux : `base-exports.stdout`
+ 2. The `windows` job : `base-exports.stdout-mingw32`
+ 3. The `javascript` CI job :
+ `base-exports.stdout-javascript-unknown-ghcjs`
+ 3. Run the script with all the job IDs :
+ `./download-base-exports.sh 2502789 2502792 2502793`
+
+ Using a range downloads more artifacts than necessary, but is a
+ no-brainer:
+
+ `./download-base-exports.sh {2502789..2502795}`
=====================================
testsuite/tests/interface-stability/download-base-exports.sh
=====================================
@@ -0,0 +1,55 @@
+#!/usr/bin/env bash
+
+# See the README file in this folder for usage
+
+jobIDs=("$@")
+
+BASE_DIR_NAME=download-base-exports
+DL_DIR_NAME=dl
+BASE_DIR="$(dirname "$0")/$BASE_DIR_NAME"
+DL_DIR=$BASE_DIR/$DL_DIR_NAME
+URL_FILE="$BASE_DIR/url-unexpected-test-output"
+
+DEFAULT_PREFIX="https://gitlab.haskell.org/ghc/ghc/-/jobs/"
+DEFAULT_POSTFIX="/artifacts/raw/unexpected-test-output.tar.gz"
+
+mkdir -p "$BASE_DIR"
+
+# URL configuration for finding unexpected-test-output.tar.gz
+
+if [[ ! -f "$URL_FILE" ]]; then
+ echo "No URL for unexpected-test-output.tar.gz was found"
+
+ read -p "Enter job URL prefix [${DEFAULT_PREFIX}]: " inputPrefix
+ read -p "Enter job URL postfix [${DEFAULT_POSTFIX}]: " inputPostfix
+
+ urlPrefix="${inputPrefix:-$DEFAULT_PREFIX}"
+ urlPostfix="${inputPostfix:-$DEFAULT_POSTFIX}"
+
+ {
+ echo "urlPrefix=$urlPrefix"
+ echo "urlPostfix=$urlPostfix"
+ } > "$URL_FILE"
+else
+ source "$URL_FILE"
+fi
+
+mkdir -p $DL_DIR
+
+echo "urlPrefix: $urlPrefix"
+echo "jobIDs: $jobIDs"
+echo "urlPostfix: $urlPostfix"
+echo ""
+echo "Downloading unexpected-test-output.tar.gz for each job ..."
+
+# Download and copy base-exports* files
+
+for jobID in "${jobIDs[@]}"; do
+ unexpectedOutputUrl="$urlPrefix$jobID$urlPostfix"
+
+ wget -O "$DL_DIR/job$jobID.tar.gz" $unexpectedOutputUrl
+
+ mkdir -p "$DL_DIR/job$jobID"
+ tar -xzf "$DL_DIR/job$jobID.tar.gz" -C "$DL_DIR/job$jobID"
+ cp "$DL_DIR/job$jobID"/unexpected-test-output/testsuite/tests/interface-stability/base-exports* "$BASE_DIR/.."
+done
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8dae539f646e9fa3387fbcf833bbe2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8dae539f646e9fa3387fbcf833bbe2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] 6 commits: Add minimal dlltool support to ghc-toolchain
by Marge Bot (＠marge-bot) 12 May '26
by Marge Bot (＠marge-bot) 12 May '26
12 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1bdcddec by Duncan Coutts at 2026-05-12T09:49:48-04:00
Add minimal dlltool support to ghc-toolchain
The dlltool is a tool that can create dll import libraries from .def
files. These .def files list the exported symbols of dlls. Its somewhat
like gnu linker scripts, but more limited.
We will need dlltool to build the rts and ghc-internal libraries as DLLs
on Windows. The rts and ghc-internal libraries have a recursive
dependency on each other. Import libraries can be used to resolve
recursive dependencies between dlls. We will use an import library for
the rts when linking the ghc-internal library.
- - - - -
f7fc3770 by Duncan Coutts at 2026-05-12T09:49:48-04:00
Add minimal dlltool support into ./configure
Find dlltool, and hopefully support finding it within the bundled llvm
toolchain on windows.
- - - - -
e4e22bfb by Duncan Coutts at 2026-05-12T09:49:48-04:00
Update the default host and target files for dlltool support
- - - - -
5666c8f9 by Duncan Coutts at 2026-05-12T09:49:48-04:00
Add dlltool as a hadrian builder
Optional except on windows.
- - - - -
5e14fe3f by Duncan Coutts at 2026-05-12T09:49:48-04:00
Update and generate libHSghc-internal.def from .def.in file
The only symbol that the rts imports from the ghc-internal package now
is init_ghc_hs_iface. So the rts only needs an import lib that defines
that one symbol.
Also, remove the libHSghc-prim.def because it is redundant. The rts no
longer imports anything from ghc-prim.
Keep libHSffi.def for now. We may yet need it once it is clear how
libffi is going to be built/used for ghc.
- - - - -
3d91e4a6 by Duncan Coutts at 2026-05-12T09:49:48-04:00
Add rule to build libHSghc-internal.dll.a and link into the rts
On windows only, with dynamic linking.
This is needed because on windows, all symbols in dlls must be resolved.
No dangling symbols allowed. References to external symbols must be
explicit. We resolve this with an import library. We create an import
library for ghc-internal, a .dll.a file. This is a static archive
containing .o files that define the symbols we need, and crucially have
".idata" sections that specifies the symbols the dll imports and from
where.
Note that we do not install this libHSghc-internal.dll.a, and it does
not need to list all the symbols exported by that package. We create a
special purpose import lib and only use it when linking the rts dll, so
it only has to list the symbols that the rts uses from ghc-internal
(which is exactly one symbol: init_ghc_hs_iface).
- - - - -
16 changed files:
- configure.ac
- distrib/configure.ac.in
- hadrian/cfg/default.host.target.in
- hadrian/cfg/default.target.in
- hadrian/src/Builder.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Rts.hs
- m4/find_llvm_prog.m4
- m4/fp_setup_windows_toolchain.m4
- m4/ghc_toolchain.m4
- m4/prep_target_file.m4
- rts/.gitignore
- + rts/win32/libHSghc-internal.def.in
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
Changes:
=====================================
configure.ac
=====================================
@@ -314,13 +314,16 @@ else
AC_CHECK_TOOL([RANLIB],[ranlib])
AC_CHECK_TOOL([OBJDUMP],[objdump])
AC_CHECK_TOOL([WindresCmd],[windres])
+ AC_CHECK_TOOL([DlltoolCmd],[llvm-dlltool])
AC_CHECK_TOOL([Genlib],[genlib])
if test "$HostOS" = "mingw32"; then
AC_CHECK_TARGET_TOOL([WindresCmd],[windres])
+ AC_CHECK_TARGET_TOOL([DlltoolCmd],[llvm-dlltool])
AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump])
WindresCmd="$(cygpath -m $WindresCmd)"
+ DlltoolCmd="$(cygpath -m $DlltoolCmd)"
if test "$Genlib" != ""; then
GenlibCmd="$(cygpath -m $Genlib)"
@@ -568,6 +571,11 @@ FIND_LLVM_PROG([OPT], [opt], [$LlvmMinVersion], [$LlvmMaxVersion])
OptCmd="$OPT"
AC_SUBST([OptCmd])
+dnl ** Which LLVM llvm-dlltool to use?
+dnl --------------------------------------------------------------
+AC_ARG_VAR(DlltoolCmd,[Use as the path to LLVM's llvm-dlltool [default=autodetect]])
+FIND_LLVM_PROG([DlltoolCmd], [llvm-dlltool], [$LlvmMinVersion], [$LlvmMaxVersion])
+
dnl ** look to see if we have a C compiler using an llvm back end.
dnl
FP_CC_LLVM_BACKEND
@@ -1080,9 +1088,10 @@ echo "\
libdw : $UseLibdw
Using LLVM tools
- llc : $LlcCmd
- opt : $OptCmd
- llvm-as : $LlvmAsCmd"
+ llc : $LlcCmd
+ opt : $OptCmd
+ llvm-as : $LlvmAsCmd
+ llvm-dlltool : $DlltoolCmd"
if test "$HSCOLOUR" = ""; then
echo "
=====================================
distrib/configure.ac.in
=====================================
@@ -229,6 +229,13 @@ FIND_LLVM_PROG([LLVMAS], [clang], [$LlvmMinVersion], [$LlvmMaxVersion])
LlvmAsCmd="$LLVMAS"
AC_SUBST([LlvmAsCmd])
+dnl ** Which LLVM llvm-dlltool to use?
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([DlltoolCmd],[llvm-dlltool])
+AC_ARG_VAR(DlltoolCmd,[Use as the path to LLVM's llvm-dlltool [default=autodetect]])
+FIND_LLVM_PROG([DlltoolCmd], [llvm-dlltool], [$LlvmMinVersion], [$LlvmMaxVersion])
+AC_SUBST([DlltoolCmd])
+
dnl We know that `clang` supports `--target` and it is necessary to pass it
dnl lest we see #25793.
if test -z "$LlvmAsFlags" && ! test -z "$LlvmTarget"; then
=====================================
hadrian/cfg/default.host.target.in
=====================================
@@ -45,6 +45,7 @@ Target
, tgtOpt = Nothing
, tgtLlvmAs = Nothing
, tgtWindres = Nothing
+, tgtDlltool = Nothing
, tgtOtool = Nothing
, tgtInstallNameTool = Nothing
}
=====================================
hadrian/cfg/default.target.in
=====================================
@@ -45,6 +45,7 @@ Target
, tgtOpt = @OptCmdMaybeProg@
, tgtLlvmAs = @LlvmAsCmdMaybeProg@
, tgtWindres = @WindresCmdMaybeProg@
+, tgtDlltool = @DlltoolCmdMaybeProg@
, tgtOtool = @OtoolCmdMaybeProg@
, tgtInstallNameTool = @InstallNameToolCmdMaybeProg@
}
=====================================
hadrian/src/Builder.hs
=====================================
@@ -17,7 +17,7 @@ import Development.Shake.Classes
import Development.Shake.Command
import Development.Shake.FilePath
import GHC.Generics
-import GHC.Platform.ArchOS (ArchOS(..), Arch(..))
+import GHC.Platform.ArchOS (ArchOS(..), Arch(..), OS(..))
import qualified Hadrian.Builder as H
import Hadrian.Builder hiding (Builder)
import Hadrian.Builder.Ar
@@ -180,6 +180,7 @@ data Builder = Alex
| Objdump
| Python
| Ranlib
+ | Dlltool
| Testsuite TestMode
| Sphinx SphinxMode
| Tar TarMode
@@ -418,6 +419,7 @@ isOptional target = \case
Alex -> True
-- Most ar implemententions no longer need ranlib, but some still do
Ranlib -> not $ Toolchain.arNeedsRanlib (tgtAr target)
+ Dlltool -> archOS_OS (tgtArchOs target) /= OSMinGW32
JsCpp -> not $ (archOS_arch . tgtArchOs) target == ArchJavaScript -- ArchWasm32 too?
_ -> False
@@ -442,6 +444,7 @@ systemBuilderPath builder = case builder of
Objdump -> fromKey "objdump"
Python -> fromKey "python"
Ranlib -> fromTargetTC "ranlib" (maybeProg Toolchain.ranlibProgram . tgtRanlib)
+ Dlltool -> fromTargetTC "dlltool" (maybeProg id . tgtDlltool)
Testsuite _ -> fromKey "python"
Sphinx _ -> fromKey "sphinx-build"
Tar _ -> fromKey "tar"
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -377,6 +377,7 @@ templateRules = do
, interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1
, interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2
]
+ templateRule "rts/win32/libHSghc-internal.def" projectVersion
templateRule "docs/index.html" $ packageUnitIds Stage1
templateRule "docs/users_guide/ghc_config.py" $ mconcat
[ projectVersion
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -4,6 +4,8 @@ import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
import qualified Text.Parsec as Parsec
+import GHC.Platform.ArchOS (ArchOS(archOS_OS), OS(..))
+import GHC.Toolchain.Target (Target(tgtArchOs))
import Base
import Context
@@ -185,9 +187,13 @@ jsObjects context = do
srcs <- interpretInContext context (getContextData jsSrcs)
mapM (objectPath context) srcs
--- | Return extra object files needed to build the given library context. The
--- resulting list is currently non-empty only when the package from the
--- 'Context' is @ghc-internal@ built with in-tree GMP backend.
+-- | Return extra object files needed to build the given library context.
+--
+-- This is non-empty for:
+--
+-- * @ghc-internal@ when built with in-tree GMP backend
+-- * @rts@ on Windows when linking dynamically
+--
extraObjects :: Context -> Action [FilePath]
extraObjects context
| package context == ghcInternal = do
@@ -195,6 +201,13 @@ extraObjects context
"gmp" -> gmpObjects (stage context)
_ -> return []
+ | package context == rts = do
+ target <- interpretInContext context getStagedTarget
+ builddir <- buildPath context
+ return [ builddir -/- "libHSghc-internal.dll.a"
+ | archOS_OS (tgtArchOs target) == OSMinGW32
+ , Dynamic `wayUnit` way context ]
+
| otherwise = return []
-- | Return all the object files to be put into the library we're building for
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -24,6 +24,20 @@ rtsRules = priority 3 $ do
(addRtsDummyVersion $ takeFileName rtsLibFilePath')
rtsLibFilePath'
+ -- Solve the recursive dependency between the rts and ghc-internal
+ -- on Windows by creating an import lib for the ghc-internal dll,
+ -- to be linked into the rts dll.
+ forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
+ let buildPath = root -/- buildDir (rtsContext stage)
+ buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib
+
+buildGhcInternalImportLib :: FilePath -> Action ()
+buildGhcInternalImportLib target = do
+ let input = "rts/win32/libHSghc-internal.def"
+ output = target -- the .dll.a import lib
+ need [input]
+ runBuilder Dlltool ["-d", input, "-l", output] [input] [output]
+
-- Need symlinks generated by rtsRules.
needRtsSymLinks :: Stage -> Set.Set Way -> Action ()
needRtsSymLinks stage rtsWays
=====================================
m4/find_llvm_prog.m4
=====================================
@@ -16,9 +16,12 @@ AC_DEFUN([FIND_LLVM_PROG],[
AS_IF([test x"$$1" != x],[
PROG_VERSION=`$$1 --version | sed -n -e 's/.*version \(\([[0-9]][[0-9]]*\.\)\([[0-9]][[0-9]]*\.\)*[[0-9]][[0-9]]*\).*/\1/gp'`
AS_IF([test x"$PROG_VERSION" = x],
- [AC_MSG_RESULT(no)
- $1=""
- AC_MSG_NOTICE([We only support llvm $3 upto $4 (non-inclusive) (no version found).])],
+ [AS_IF(
+ [test x"$2" = x"llvm-dlltool"],
+ [AC_MSG_RESULT(yes)], # llvm-dlltool doesn't have a --version
+ [AC_MSG_RESULT(no)
+ AC_MSG_NOTICE([We only support llvm $3 upto $4 (non-inclusive) (no version found).])]
+ )],
[AC_MSG_CHECKING([$$1 version ($PROG_VERSION) is between $3 and $4])
AX_COMPARE_VERSION([$PROG_VERSION], [lt], [$3],
[AC_MSG_RESULT(no)
=====================================
m4/fp_setup_windows_toolchain.m4
=====================================
@@ -131,8 +131,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[
AR="${mingwbin}llvm-ar.exe"
RANLIB="${mingwbin}llvm-ranlib.exe"
OBJDUMP="${mingwbin}llvm-objdump.exe"
- DLLTOOL="${mingwbin}llvm-dlltool.exe"
WindresCmd="${mingwbin}llvm-windres.exe"
+ DlltoolCmd="${mingwbin}llvm-dlltool.exe"
LLC="${mingwbin}llc.exe"
OPT="${mingwbin}opt.exe"
LLVMAS="${mingwbin}clang.exe"
=====================================
m4/ghc_toolchain.m4
=====================================
@@ -95,6 +95,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN],
echo "--merge-objs=$MergeObjsCmd" >> acargs
echo "--readelf=$READELF" >> acargs
echo "--windres=$WindresCmd" >> acargs
+ echo "--dlltool=$DlltoolCmd" >> acargs
echo "--llc=$LlcCmd" >> acargs
echo "--opt=$OptCmd" >> acargs
echo "--llvm-as=$LlvmAsCmd" >> acargs
=====================================
m4/prep_target_file.m4
=====================================
@@ -191,6 +191,7 @@ AC_DEFUN([PREP_TARGET_FILE],[
PREP_MAYBE_SIMPLE_PROGRAM([OptCmd])
PREP_MAYBE_PROGRAM([LlvmAsCmd], [LlvmAsFlags])
PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd])
+ PREP_MAYBE_SIMPLE_PROGRAM([DlltoolCmd])
PREP_MAYBE_SIMPLE_PROGRAM([OtoolCmd])
PREP_MAYBE_SIMPLE_PROGRAM([InstallNameToolCmd])
PREP_MAYBE_STRING([TargetVendor_CPP])
=====================================
rts/.gitignore
=====================================
@@ -20,3 +20,4 @@
/ghcautoconf.h.autoconf.in
/ghcautoconf.h.autoconf
/include/ghcautoconf.h
+/win32/libHSghc-internal.def
=====================================
rts/win32/libHSghc-internal.def.in
=====================================
@@ -0,0 +1,4 @@
+LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll
+
+EXPORTS
+ init_ghc_hs_iface
=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -56,6 +56,7 @@ data Opts = Opts
, optOpt :: ProgOpt
, optLlvmAs :: ProgOpt
, optWindres :: ProgOpt
+ , optDlltool :: ProgOpt
, optOtool :: ProgOpt
, optInstallNameTool :: ProgOpt
-- Note we don't actually configure LD into anything but
@@ -114,6 +115,7 @@ emptyOpts = Opts
, optOpt = po0
, optLlvmAs = po0
, optWindres = po0
+ , optDlltool = po0
, optLd = po0
, optOtool = po0
, optInstallNameTool = po0
@@ -132,7 +134,7 @@ emptyOpts = Opts
_optCc, _optCxx, _optCpp, _optHsCpp, _optJsCpp, _optCmmCpp, _optCcLink, _optAr,
_optRanlib, _optNm, _optReadelf, _optMergeObjs, _optLlc, _optOpt, _optLlvmAs,
- _optWindres, _optLd, _optOtool, _optInstallNameTool
+ _optWindres, _optDlltool, _optLd, _optOtool, _optInstallNameTool
:: Lens Opts ProgOpt
_optCc = Lens optCc (\x o -> o {optCc=x})
_optCxx = Lens optCxx (\x o -> o {optCxx=x})
@@ -150,6 +152,7 @@ _optLlc = Lens optLlc (\x o -> o {optLlc=x})
_optOpt = Lens optOpt (\x o -> o {optOpt=x})
_optLlvmAs = Lens optLlvmAs (\x o -> o {optLlvmAs=x})
_optWindres = Lens optWindres (\x o -> o {optWindres=x})
+_optDlltool = Lens optDlltool (\x o -> o {optDlltool=x})
_optLd = Lens optLd (\x o -> o {optLd=x})
_optOtool = Lens optOtool (\x o -> o {optOtool=x})
_optInstallNameTool = Lens optInstallNameTool (\x o -> o {optInstallNameTool=x})
@@ -218,6 +221,7 @@ options =
, progOpts "opt" "LLVM opt utility" _optOpt
, progOpts "llvm-as" "Assembler used for LLVM backend (typically clang)" _optLlvmAs
, progOpts "windres" "windres utility" _optWindres
+ , progOpts "dlltool" "Windows dll utility" _optDlltool
, progOpts "ld" "linker" _optLd
, progOpts "otool" "otool utility" _optOtool
, progOpts "install-name-tool" "install-name-tool utility" _optInstallNameTool
@@ -482,6 +486,7 @@ mkTarget opts = do
-- for windows, also used for cross compiling
windres <- optional $ findProgram "windres" (optWindres opts) ["windres"]
+ dlltool <- optional $ findProgram "dlltool" (optDlltool opts) ["llvm-dlltool"]
-- Darwin-specific utilities
(otool, installNameTool) <-
@@ -536,6 +541,7 @@ mkTarget opts = do
, tgtOpt = opt
, tgtLlvmAs = llvmAs
, tgtWindres = windres
+ , tgtDlltool = dlltool
, tgtOtool = otool
, tgtInstallNameTool = installNameTool
, tgtWordSize
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Target.hs
=====================================
@@ -93,6 +93,7 @@ data Target = Target
-- Windows-specific tools
, tgtWindres :: Maybe Program
+ , tgtDlltool :: Maybe Program
-- Darwin-specific tools
, tgtOtool :: Maybe Program
@@ -150,6 +151,7 @@ instance Show Target where
, ", tgtOpt = " ++ show tgtOpt
, ", tgtLlvmAs = " ++ show tgtLlvmAs
, ", tgtWindres = " ++ show tgtWindres
+ , ", tgtDlltool = " ++ show tgtDlltool
, ", tgtOtool = " ++ show tgtOtool
, ", tgtInstallNameTool = " ++ show tgtInstallNameTool
, "}"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ac3f7d62f5a691c275a357b3e12ab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ac3f7d62f5a691c275a357b3e12ab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
12 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4ac3f7d6 by Vladislav Zavialov at 2026-05-12T09:49:03-04:00
EPA: Use AnnParen for tuples and sums
Summary of changes
* Do not use AnnParen in XListTy, replace it with EpToken "[" and "]"
* Specialise AnnParen to tuple/sums by dropping the AnnParensSquare
and keeping only AnnParens and AnnParensHash
* Use AnnParen in XExplicitTuple
* Use AnnParen in XExplicitTupleTy
* Use AnnParen in XTuplePat
* Use AnnParen in XExplicitSum (via AnnExplicitSum)
* Use AnnParen in XSumPat (via EpAnnSumPat)
This is a refactoring with no user-facing changes.
- - - - -
14 changed files:
- + changelog.d/ghc-api-epa-parens
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
changelog.d/ghc-api-epa-parens
=====================================
@@ -0,0 +1,12 @@
+section: ghc-lib
+synopsis: Use ``AnnParen`` for tuples and sums
+issues: #26969
+mrs: !15836
+
+description: {
+Do not use ``AnnParen`` in ``XListTy``, replacing it with ``EpToken "["`` and ``"]"``,
+and specialise it to tuples/sums by dropping the ``AnnParensSquare`` constructor,
+keeping only ``AnnParens`` and ``AnnParensHash``. Use ``AnnParen`` in ``XExplicitTuple``,
+``XExplicitTupleTy``, ``XTuplePat``, ``XExplicitSum`` (via ``AnnExplicitSum``), and
+``XSumPat`` (via ``EpAnnSumPat``).
+}
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -221,7 +221,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
NoBlankEpAnnotations -> parens (case ap of
(AnnParens o c) -> text "AnnParens" $$ vcat [showAstData' o, showAstData' c]
(AnnParensHash o c) -> text "AnnParensHash" $$ vcat [showAstData' o, showAstData' c]
- (AnnParensSquare o c) -> text "AnnParensSquare" $$ vcat [showAstData' o, showAstData' c]
)
annClassDecl :: AnnClassDecl -> SDoc
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -264,7 +264,7 @@ type instance XPar GhcPs = (EpToken "(", EpToken ")")
type instance XPar GhcRn = NoExtField
type instance XPar GhcTc = NoExtField
-type instance XExplicitTuple GhcPs = (EpaLocation, EpaLocation)
+type instance XExplicitTuple GhcPs = AnnParen
type instance XExplicitTuple GhcRn = NoExtField
type instance XExplicitTuple GhcTc = NoExtField
@@ -554,14 +554,13 @@ mkHsVarWithUserRdr rdr n = HsVar noExtField $
data AnnExplicitSum
= AnnExplicitSum {
- aesOpen :: EpaLocation,
+ aesParens :: AnnParen,
aesBarsBefore :: [EpToken "|"],
- aesBarsAfter :: [EpToken "|"],
- aesClose :: EpaLocation
+ aesBarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn AnnExplicitSum where
- noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
+ noAnn = AnnExplicitSum noAnn noAnn noAnn
data AnnFieldLabel
= AnnFieldLabel {
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -113,7 +113,7 @@ type instance XListPat GhcRn = NoExtField
type instance XListPat GhcTc = Type
-- List element type, for use in hsPatType.
-type instance XTuplePat GhcPs = (EpaLocation, EpaLocation)
+type instance XTuplePat GhcPs = AnnParen
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
@@ -263,13 +263,13 @@ discarded inside tcMatchPats, where we know if visible pattern retained or erase
-- API Annotations types
data EpAnnSumPat = EpAnnSumPat
- { sumPatParens :: (EpaLocation, EpaLocation)
+ { sumPatParens :: AnnParen
, sumPatVbarsBefore :: [EpToken "|"]
, sumPatVbarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn EpAnnSumPat where
- noAnn = EpAnnSumPat (noAnn, noAnn) [] []
+ noAnn = EpAnnSumPat noAnn [] []
-- ---------------------------------------------------------------------
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -445,7 +445,7 @@ type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpToken "'"
type instance XAppTy (GhcPass _) = NoExtField
type instance XFunTy (GhcPass _) = NoExtField
-type instance XListTy (GhcPass _) = AnnParen
+type instance XListTy (GhcPass _) = (EpToken "[", EpToken "]")
type instance XTupleTy (GhcPass _) = AnnParen
type instance XSumTy (GhcPass _) = AnnParen
type instance XOpTy (GhcPass _) = NoExtField
@@ -470,7 +470,7 @@ type instance XExplicitListTy GhcPs = (EpToken "'", EpToken "[", EpToken "]")
type instance XExplicitListTy GhcRn = NoExtField
type instance XExplicitListTy GhcTc = Kind
-type instance XExplicitTupleTy GhcPs = (EpToken "'", EpToken "(", EpToken ")")
+type instance XExplicitTupleTy GhcPs = (EpToken "'", AnnParen)
type instance XExplicitTupleTy GhcRn = NoExtField
type instance XExplicitTupleTy GhcTc = [Kind]
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2398,14 +2398,14 @@ atype :: { LHsType GhcPs }
| '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE '(' ')' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) IsPromoted []) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $3)) IsPromoted []) }}
| SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }
| SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)
; amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}
| SIMPLEQUOTE '(' ktype ',' comma_types1 ')'
{% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; h <- addTrailingCommaA $3 (epTok $4)
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) IsPromoted (h : $5)) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $6)) IsPromoted (h : $5)) }}
| '[' ']' {% withCombinedComments $1 $> (mkListSyntaxTy0 (epTok $1) (epTok $2)) }
| SIMPLEQUOTE '[' comma_types0 ']' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; amsA' (sLL $1 $> $ HsExplicitListTy (epTok $1, epTok $2, epTok $4) IsPromoted $3) }}
@@ -3221,7 +3221,7 @@ aexp2 :: { ECP }
| '(' tup_exprs ')' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2
- (glR $1,glR $3)}
+ (AnnParens (epTok $1) (epTok $3))}
| '(' orpats(exp2) ')' {% do
{ pat <- hintOrPats (sL1a $2 (OrPat NoExtField (unLoc $2)))
@@ -3237,11 +3237,11 @@ aexp2 :: { ECP }
| '(#' texp '#)' { ECP $
unECP $2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed (Tuple [Right $2])
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '(#' tup_exprs '#)' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed $2
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '[' list ']' { ECP $ $2 (comb2 $1 $>) (glR $1,glR $3) }
| '_' { ECP $ mkHsWildCardPV (getLoc $1) }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -552,12 +552,11 @@ data AnnListBrackets
-- Annotations for parenthesised elements, such as tuples, lists
-- ---------------------------------------------------------------------
--- | exact print annotation for an item having surrounding "brackets", such as
--- tuples or lists
+-- | exact print annotation for an item having parentheses, with or without
+-- the hash symbol, e.g. tuples, unboxed tuples, unboxed sums
data AnnParen
= AnnParens (EpToken "(") (EpToken ")") -- ^ '(', ')'
| AnnParensHash (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)'
- | AnnParensSquare (EpToken "[") (EpToken "]") -- ^ '[', ']'
deriving Data
-- ---------------------------------------------------------------------
@@ -1219,7 +1218,6 @@ instance (Outputable e)
instance Outputable AnnParen where
ppr (AnnParens o c) = text "AnnParens" <+> ppr o <+> ppr c
ppr (AnnParensHash o c) = text "AnnParensHash" <+> ppr o <+> ppr c
- ppr (AnnParensSquare o c) = text "AnnParensSquare" <+> ppr o <+> ppr c
instance Outputable AnnListItem where
ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1228,17 +1228,11 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
-- With NoListTuplePuns, contexts are parsed as data constructors, which causes failure
-- downstream.
-- This converts them just like when they are parsed as types in the punned case.
- check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) _ ts))
- = punsAllowed >>= \case
- True -> unprocessed
- False -> do
- let
- (op, cp) = case q of
- EpTok ql -> ([EpTok ql], [c])
- _ -> ([o], [c])
- mkCTuple (oparens ++ op, cp ++ cparens, cs) ts
+ check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (_, AnnParens o c) NotPromoted ts))
+ = mkCTuple (oparens ++ [o], c : cparens, cs) ts
+
check (opi,cpi,csi) (L _lp1 (HsParTy (o,c) ty))
- -- to be sure HsParTy doesn't get into the way
+ -- to be sure HsParTy doesn't get in the way
= check (o:opi, c:cpi, csi) ty
-- No need for anns, returning original
@@ -1269,11 +1263,10 @@ checkContextExpr orig_expr@(L (EpAnn l _ cs) _) =
where
check :: ([EpToken "("],[EpToken ")"],EpAnnComments)
-> LHsExpr GhcPs -> PV (LocatedC [LHsExpr GhcPs])
- check (oparens,cparens,cs) (L _ (ExplicitTuple (ap_open, ap_close) tup_args boxity))
+ check (oparens,cparens,cs) (L _ (ExplicitTuple (AnnParens open_tok close_tok) tup_args Boxed))
-- Neither unboxed tuples (#e1,e2#) nor tuple sections (e1,,e2,) can be a context
- | isBoxed boxity
- , Just es <- tupArgsPresent_maybe tup_args
- = mkCTuple (oparens ++ [EpTok ap_open], EpTok ap_close : cparens, cs) es
+ | Just es <- tupArgsPresent_maybe tup_args
+ = mkCTuple (oparens ++ [open_tok], close_tok : cparens, cs) es
check (opi, cpi, csi) (L _ (HsPar (open_tok, close_tok) expr))
= check (opi ++ [open_tok], close_tok : cpi, csi) expr
check (oparens,cparens,cs) (L _ (HsVar _ (L (EpAnn _ (NameAnnOnly (NameParens open closed) []) _) name)))
@@ -1861,7 +1854,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
mkHsBangPatPV :: SrcSpan -> LocatedA b -> EpToken "!" -> PV (LocatedA b)
-- | Disambiguate tuple sections and unboxed sums
mkSumOrTuplePV
- :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> (EpaLocation, EpaLocation) -> PV (LocatedA b)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> AnnParen -> PV (LocatedA b)
-- | Disambiguate "type t" (embedded type)
mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate modifiers (%a)
@@ -3694,7 +3687,7 @@ hintBangPat span e = do
addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalBangPattern e
mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
- -> (EpaLocation, EpaLocation)
+ -> AnnParen
-> PV (LHsExpr GhcPs)
-- Tuple
@@ -3709,15 +3702,15 @@ mkSumOrTupleExpr l@(EpAnn anc an csIn) boxity (Tuple es) anns = do
-- Sum
-- mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
-- return $ L l (ExplicitSum noExtField alt arity e)
-mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) (o, c) = do
- let an = AnnExplicitSum o barsp barsa c
+mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) anns = do
+ let an = AnnExplicitSum anns barsp barsa
!cs <- getCommentsFor (locA l)
return $ L (EpAnn anc anIn (csIn Semi.<> cs)) (ExplicitSum an alt arity e)
mkSumOrTupleExpr l Boxed a@Sum{} _ =
addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrUnsupportedBoxedSumExpr a
mkSumOrTuplePat
- :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> (EpaLocation, EpaLocation)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> AnnParen
-> PV (LocatedA (PatBuilder GhcPs))
-- Tuple
@@ -3843,7 +3836,7 @@ mkTupleSyntaxTy parOpen args parClose =
HsExplicitTupleTy annsKeyword NotPromoted args
annParen = AnnParens parOpen parClose
- annsKeyword = (NoEpTok, parOpen, parClose)
+ annsKeyword = (NoEpTok, annParen)
-- | Decide whether to parse tuple con syntax @(,)@ in a type as a
-- type or data constructor, based on the extension @ListTuplePuns@.
@@ -3895,7 +3888,7 @@ mkListSyntaxTy1 brkOpen t brkClose =
HsExplicitListTy annsKeyword NotPromoted [t]
annsKeyword = (NoEpTok, brkOpen, brkClose)
- annParen = AnnParensSquare brkOpen brkClose
+ annParen = (brkOpen, brkClose)
parseError :: HsExpr GhcPs
parseError = HsHole HoleError
=====================================
testsuite/tests/ghc-api/T25121_status.stdout
=====================================
@@ -18,8 +18,8 @@ X(ExplicitList) mismatch
>>> AnnList ()
<<< ((EpToken "'"),(EpToken "["),(EpToken "]"))
X(ExplicitTuple) mismatch
- >>> ((EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]),(EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]))
- <<< ((EpToken "'"),(EpToken "("),(EpToken ")"))
+ >>> AnnParen
+ <<< ((EpToken "'"),AnnParen)
X(Hole) match = HoleKind
Extension fields @GhcRn
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -274,7 +274,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:9:16 }))
(EpTok
@@ -656,7 +656,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:10:27 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -602,7 +602,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:12:27 }))
(EpTok
@@ -710,7 +710,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:11:16 }))
(EpTok
@@ -1930,7 +1930,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:31:12 }))
(EpTok
@@ -1995,7 +1995,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:32:10 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -728,7 +728,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:19:12 }))
(EpTok
@@ -1424,13 +1424,14 @@
(EpaComments
[]))
(HsExplicitTupleTy
- ((,,)
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:16 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:17 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:44 })))
+ (AnnParens
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:17 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:44 }))))
(IsPromoted)
[(L
(EpAnn
@@ -1508,7 +1509,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:34 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -458,7 +458,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:8:57 }))
(EpTok
@@ -705,7 +705,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:9:57 }))
(EpTok
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -858,9 +858,6 @@ markParenO (AnnParens o c) = do
markParenO (AnnParensHash o c) = do
o' <- markEpToken o
return (AnnParensHash o' c)
-markParenO (AnnParensSquare o c) = do
- o' <- markEpToken o
- return (AnnParensSquare o' c)
markParenC :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markParenC (AnnParens o c) = do
@@ -869,9 +866,6 @@ markParenC (AnnParens o c) = do
markParenC (AnnParensHash o c) = do
c' <- markEpToken c
return (AnnParensHash o c')
-markParenC (AnnParensSquare o c) = do
- c' <- markEpToken c
- return (AnnParensSquare o c')
-- ---------------------------------------------------------------------
-- Bare bones Optics
@@ -1015,15 +1009,14 @@ lsnd k parent = fmap (\new -> (fst parent, new))
-- -------------------------------------
-- data AnnExplicitSum
-- = AnnExplicitSum {
--- aesOpen :: EpaLocation,
+-- aesParens :: AnnParen,
-- aesBarsBefore :: [EpToken "|"],
--- aesBarsAfter :: [EpToken "|"],
--- aesClose :: EpaLocation
+-- aesBarsAfter :: [EpToken "|"]
-- } deriving Data
-laesOpen :: Lens AnnExplicitSum EpaLocation
-laesOpen k parent = fmap (\new -> parent { aesOpen = new })
- (k (aesOpen parent))
+laesParens :: Lens AnnExplicitSum AnnParen
+laesParens k parent = fmap (\new -> parent { aesParens = new })
+ (k (aesParens parent))
laesBarsBefore :: Lens AnnExplicitSum [EpToken "|"]
laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })
@@ -1033,10 +1026,6 @@ laesBarsAfter :: Lens AnnExplicitSum [EpToken "|"]
laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })
(k (aesBarsAfter parent))
-laesClose :: Lens AnnExplicitSum EpaLocation
-laesClose k parent = fmap (\new -> parent { aesClose = new })
- (k (aesClose parent))
-
-- -------------------------------------
-- data AnnFieldLabel
-- = AnnFieldLabel {
@@ -1183,12 +1172,12 @@ lga_sep k parent = fmap (\new -> parent { ga_sep = new })
-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
--- { sumPatParens :: (EpaLocation, EpaLocation)
+-- { sumPatParens :: AnnParen
-- , sumPatVbarsBefore :: [EpToken "|"]
-- , sumPatVbarsAfter :: [EpToken "|"]
-- } deriving Data
-lsumPatParens :: Lens EpAnnSumPat (EpaLocation, EpaLocation)
+lsumPatParens :: Lens EpAnnSumPat AnnParen
lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })
(k (sumPatParens parent))
@@ -2940,23 +2929,21 @@ instance ExactPrint (HsExpr GhcPs) where
expr' <- markAnnotated expr
return (SectionR an op' expr')
- exact (ExplicitTuple (o,c) args b) = do
- o0 <- if b == Boxed then printStringAtAA o "("
- else printStringAtAA o "(#"
+ exact (ExplicitTuple an args b) = do
+ an0 <- markOpeningParen an
args' <- mapM markAnnotated args
- c0 <- if b == Boxed then printStringAtAA c ")"
- else printStringAtAA c "#)"
+ an1 <- markClosingParen an0
debugM $ "ExplicitTuple done"
- return (ExplicitTuple (o0,c0) args' b)
+ return (ExplicitTuple an1 args' b)
exact (ExplicitSum an alt arity expr) = do
- an0 <- markLensFun an laesOpen (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an laesParens markOpeningParen
an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM markEpToken locs)
expr' <- markAnnotated expr
an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 laesClose (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 laesParens markClosingParen
return (ExplicitSum an3 alt arity expr')
exact (HsCase an e alts) = do
@@ -3970,11 +3957,11 @@ instance ExactPrint (HsType GhcPs) where
(mult', ty1') <- markModifiedFunArrOf mult (markAnnotated ty1)
ty2' <- markAnnotated ty2
return (HsFunTy an mult' ty1' ty2')
- exact (HsListTy an tys) = do
- an0 <- markOpeningParen an
- tys' <- markAnnotated tys
- an1 <- markClosingParen an0
- return (HsListTy an1 tys')
+ exact (HsListTy (o,c) t) = do
+ o' <- markEpToken o
+ t' <- markAnnotated t
+ c' <- markEpToken c
+ return (HsListTy (o',c') t')
exact (HsTupleTy an con tys) = do
an0 <- markOpeningParen an
tys' <- markAnnotated tys
@@ -4026,14 +4013,14 @@ instance ExactPrint (HsType GhcPs) where
tys' <- markAnnotated tys
c' <- markEpToken c
return (HsExplicitListTy (sq',o',c') prom tys')
- exact (HsExplicitTupleTy (sq, o, c) prom tys) = do
+ exact (HsExplicitTupleTy (sq, an) prom tys) = do
sq' <- if (isPromoted prom)
then markEpToken sq
else return sq
- o' <- markEpToken o
+ an0 <- markOpeningParen an
tys' <- markAnnotated tys
- c' <- markEpToken c
- return (HsExplicitTupleTy (sq', o', c') prom tys')
+ an1 <- markClosingParen an0
+ return (HsExplicitTupleTy (sq', an1) prom tys')
exact (HsTyLit an lit) = do
lit' <- withPpr lit
return (HsTyLit an lit')
@@ -4713,22 +4700,18 @@ instance ExactPrint (Pat GhcPs) where
(an', pats') <- markAnnList' an (markAnnotated pats)
return (ListPat an' pats')
- exact (TuplePat (o,c) pats boxity) = do
- o0 <- case boxity of
- Boxed -> printStringAtAA o "("
- Unboxed -> printStringAtAA o "(#"
+ exact (TuplePat an pats boxity) = do
+ an0 <- markOpeningParen an
pats' <- markAnnotated pats
- c0 <- case boxity of
- Boxed -> printStringAtAA c ")"
- Unboxed -> printStringAtAA c "#)"
- return (TuplePat (o0,c0) pats' boxity)
+ an1 <- markClosingParen an0
+ return (TuplePat an1 pats' boxity)
exact (SumPat an pat alt arity) = do
- an0 <- markLensFun an (lsumPatParens . lfst) (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an lsumPatParens markOpeningParen
an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM markEpToken locs)
pat' <- markAnnotated pat
an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 (lsumPatParens . lsnd) (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 lsumPatParens markClosingParen
return (SumPat an3 pat' alt arity)
exact (OrPat an pats) = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ac3f7d62f5a691c275a357b3e12ab3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ac3f7d62f5a691c275a357b3e12ab3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Move the `Text.Read` implementation into `base`
by Marge Bot (＠marge-bot) 12 May '26
by Marge Bot (＠marge-bot) 12 May '26
12 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
44cf9cd7 by Wolfgang Jeltsch at 2026-05-12T09:48:18-04:00
Move the `Text.Read` implementation into `base`
- - - - -
10 changed files:
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/Text/Read.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- − libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- testsuite/tests/th/T24111.stdout
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T21130.stderr
Changes:
=====================================
libraries/base/src/Data/Functor/Classes.hs
=====================================
@@ -85,7 +85,7 @@ import GHC.Internal.Read (expectP, list, paren, readField)
import GHC.Internal.Show (appPrec)
import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
-import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
+import Text.Read (Read(..), parens, prec, step, reset)
import GHC.Internal.Text.Read.Lex (Lexeme(..))
import GHC.Internal.Text.Show (showListWith)
import Prelude
=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Internal.Data.Foldable (Foldable(..))
import GHC.Internal.Data.Monoid (Sum(..), All(..), Any(..), Product(..))
import GHC.Internal.Data.Type.Equality (TestEquality(..), (:~:)(..))
import GHC.Generics (Generic, Generic1)
-import GHC.Internal.Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
+import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
import Prelude
infixr 9 `Compose`
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -179,7 +179,7 @@ import GHC.Internal.Data.Tuple
import GHC.Internal.Base hiding ( foldr, mapM, sequence )
import GHC.Internal.Classes
import GHC.Internal.Err
-import GHC.Internal.Text.Read
+import Text.Read
import GHC.Internal.Enum
import GHC.Internal.Num
import GHC.Internal.Prim (seq)
=====================================
libraries/base/src/Text/Read.hs
=====================================
@@ -39,5 +39,84 @@ module Text.Read
readMaybe
) where
-import GHC.Internal.Text.Read
+import GHC.Err (errorWithoutStackTrace)
+import GHC.Read
+ (
+ ReadS,
+ Read (readsPrec, readList, readPrec, readListPrec),
+ lex,
+ readParen,
+ readListDefault,
+ lexP,
+ parens,
+ readListPrecDefault
+ )
+import Control.Monad (return)
+import Data.Function (id)
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Either (Either (Left, Right), either)
+import Data.String (String)
+import Text.Read.Lex (Lexeme (Char, String, Punc, Ident, Symbol, Number, EOF))
+import Text.ParserCombinators.ReadP (skipSpaces)
import Text.ParserCombinators.ReadPrec
+
+-- $setup
+-- >>> import Prelude
+
+------------------------------------------------------------------------
+-- utility functions
+
+-- | equivalent to 'readsPrec' with a precedence of 0.
+reads :: Read a => ReadS a
+reads = readsPrec minPrec
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+-- A 'Left' value indicates a parse error.
+--
+-- >>> readEither "123" :: Either String Int
+-- Right 123
+--
+-- >>> readEither "hello" :: Either String Int
+-- Left "Prelude.read: no parse"
+--
+-- @since base-4.6.0.0
+readEither :: Read a => String -> Either String a
+readEither s =
+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+ [x] -> Right x
+ [] -> Left "Prelude.read: no parse"
+ _ -> Left "Prelude.read: ambiguous parse"
+ where
+ read' =
+ do x <- readPrec
+ lift skipSpaces
+ return x
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+--
+-- >>> readMaybe "123" :: Maybe Int
+-- Just 123
+--
+-- >>> readMaybe "hello" :: Maybe Int
+-- Nothing
+--
+-- @since base-4.6.0.0
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case readEither s of
+ Left _ -> Nothing
+ Right a -> Just a
+
+-- | The 'read' function reads input from a string, which must be
+-- completely consumed by the input process. 'read' fails with an 'error' if the
+-- parse is unsuccessful, and it is therefore discouraged from being used in
+-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
+--
+-- >>> read "123" :: Int
+-- 123
+--
+-- >>> read "hello" :: Int
+-- *** Exception: Prelude.read: no parse
+read :: Read a => String -> a
+read s = either errorWithoutStackTrace id (readEither s)
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -329,7 +329,6 @@ Library
GHC.Internal.System.Posix.Types
GHC.Internal.Text.ParserCombinators.ReadP
GHC.Internal.Text.ParserCombinators.ReadPrec
- GHC.Internal.Text.Read
GHC.Internal.Text.Read.Lex
GHC.Internal.Text.Show
GHC.Internal.Type.Reflection
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Internal.IO.Encoding.Types
import qualified GHC.Internal.IO.Encoding.Iconv as Iconv
#else
import qualified GHC.Internal.IO.Encoding.CodePage as CodePage
-import GHC.Internal.Text.Read (reads)
+import GHC.Internal.Read (readsPrec)
#endif
import qualified GHC.Internal.IO.Encoding.Latin1 as Latin1
import qualified GHC.Internal.IO.Encoding.UTF8 as UTF8
@@ -319,7 +319,8 @@ mkTextEncoding' cfm enc =
_ | isAscii -> return (Latin1.mkAscii cfm)
_ | isLatin1 -> return (Latin1.mkLatin1_checked cfm)
#if defined(mingw32_HOST_OS)
- 'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp
+ 'C':'P':n | [(cp,"")] <- readsPrec 0 n -> return $ CodePage.mkCodePageEncoding cfm cp
+ -- 'readsPrec 0' is the same as 'reads', but 'reads' is only defined in @base@.
_ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)
#else
-- Otherwise, handle other encoding needs via iconv.
=====================================
libraries/ghc-internal/src/GHC/Internal/Text/Read.hs deleted
=====================================
@@ -1,115 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.Text.Read
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : provisional
--- Portability : non-portable (uses Text.ParserCombinators.ReadP)
---
--- Converting strings to values.
---
--- The "Text.Read" library is the canonical library to import for
--- 'Read'-class facilities. For GHC only, it offers an extended and much
--- improved 'Read' class, which constitutes a proposed alternative to the
--- Haskell 2010 'Read'. In particular, writing parsers is easier, and
--- the parsers are much more efficient.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.Text.Read (
- -- * The 'Read' class
- Read(..),
- ReadS,
-
- -- * Haskell 2010 functions
- reads,
- read,
- readParen,
- lex,
-
- -- * New parsing functions
- module GHC.Internal.Text.ParserCombinators.ReadPrec,
- L.Lexeme(..),
- lexP,
- parens,
- readListDefault,
- readListPrecDefault,
- readEither,
- readMaybe
-
- ) where
-
-import GHC.Internal.Base (String, id, return)
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
-import GHC.Internal.Read
-import GHC.Internal.Data.Either
-import GHC.Internal.Text.ParserCombinators.ReadP as P
-import GHC.Internal.Text.ParserCombinators.ReadPrec
-import qualified GHC.Internal.Text.Read.Lex as L
-
--- $setup
--- >>> import Prelude
-
-------------------------------------------------------------------------
--- utility functions
-
--- | equivalent to 'readsPrec' with a precedence of 0.
-reads :: Read a => ReadS a
-reads = readsPrec minPrec
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
--- A 'Left' value indicates a parse error.
---
--- >>> readEither "123" :: Either String Int
--- Right 123
---
--- >>> readEither "hello" :: Either String Int
--- Left "Prelude.read: no parse"
---
--- @since base-4.6.0.0
-readEither :: Read a => String -> Either String a
-readEither s =
- case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
- [x] -> Right x
- [] -> Left "Prelude.read: no parse"
- _ -> Left "Prelude.read: ambiguous parse"
- where
- read' =
- do x <- readPrec
- lift P.skipSpaces
- return x
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
---
--- >>> readMaybe "123" :: Maybe Int
--- Just 123
---
--- >>> readMaybe "hello" :: Maybe Int
--- Nothing
---
--- @since base-4.6.0.0
-readMaybe :: Read a => String -> Maybe a
-readMaybe s = case readEither s of
- Left _ -> Nothing
- Right a -> Just a
-
--- | The 'read' function reads input from a string, which must be
--- completely consumed by the input process. 'read' fails with an 'error' if the
--- parse is unsuccessful, and it is therefore discouraged from being used in
--- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
---
--- >>> read "123" :: Int
--- 123
---
--- >>> read "hello" :: Int
--- *** Exception: Prelude.read: no parse
-read :: Read a => String -> a
-read s = either errorWithoutStackTrace id (readEither s)
=====================================
testsuite/tests/th/T24111.stdout
=====================================
@@ -3,6 +3,6 @@ pattern (:+_0) :: GHC.Internal.Types.Int ->
(GHC.Internal.Types.Int, GHC.Internal.Types.Int)
pattern x_1 :+_0 y_2 = (x_1, y_2)
pattern A_0 :: GHC.Internal.Types.Int -> GHC.Internal.Base.String
-pattern A_0 n_1 <- (GHC.Internal.Text.Read.read -> n_1) where
+pattern A_0 n_1 <- (Text.Read.read -> n_1) where
A_0 0 = "hi"
A_0 1 = "bye"
=====================================
testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
=====================================
@@ -11,14 +11,13 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef
words :: String -> [String]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.OldList’))
- read :: forall a. Read a => String -> a
- with read @[String]
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Text.Read’))
repeat :: forall a. a -> [a]
with repeat @String
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.List’))
+ read :: forall a. Read a => String -> a
+ with read @[String]
+ (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
mempty :: forall a. Monoid a => a
with mempty @(String -> [String])
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_fail/T21130.stderr
=====================================
@@ -6,6 +6,9 @@ T21130.hs:10:6: error: [GHC-88464]
In an equation for ‘x’: x = (_ f) :: Int
• Relevant bindings include x :: Int (bound at T21130.hs:10:1)
Valid hole fits include
+ read :: forall a. Read a => String -> a
+ with read @Int
+ (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
with head @Int
(imported from ‘Prelude’
@@ -14,10 +17,6 @@ T21130.hs:10:6: error: [GHC-88464]
with last @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.List’))
- read :: forall a. Read a => String -> a
- with read @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Text.Read’))
T21130.hs:10:8: error: [GHC-39999]
• Ambiguous type variable ‘t0’ arising from a use of ‘f’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44cf9cd789673cd8d6ef3f456759585…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44cf9cd789673cd8d6ef3f456759585…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Add reason for the special branch in `rankedHomeUnitDeps`
by Wolfgang Jeltsch (＠jeltsch) 12 May '26
by Wolfgang Jeltsch (＠jeltsch) 12 May '26
12 May '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC
Commits:
e2ffbc50 by Wolfgang Jeltsch at 2026-05-12T16:27:24+03:00
Add reason for the special branch in `rankedHomeUnitDeps`
- - - - -
1 changed file:
- compiler/GHC/Unit/Finder.hs
Changes:
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -296,7 +296,18 @@ rankedHomeUnitDeps _ _ home_unit_deps | Set.null home_unit_deps
= []
-- The special handling of the situation where the dependency set is empty does
-- not change the result, but it avoids triggering evaluation of the module
--- graph.
+-- graph. This is particularly important in one-shot mode, where the module
+-- graph is not needed. Computing it nevertheless would result in a, possibly
+-- dramatic, increase of memory usage. Worse, GHC would erroneously look for the
+-- sources of modules, which would, for example, cause test `boot1` to fail with
+-- the following error message:
+--
+-- B.hs:3:1: error: [GHC-87110]
+-- Could not find module ‘A’.
+-- Use -v to see a list of the files searched for.
+-- |
+-- 3 | import {-# source #-} A
+-- | ^^^^^^^^^^^^^^^^^^^^^^^
rankedHomeUnitDeps home_module_name_providers_map mod_name home_unit_deps
= Set.toList cached_deps ++ Set.toList uncached_deps
where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2ffbc507f54a1fd64139e82d8d24ee…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2ffbc507f54a1fd64139e82d8d24ee…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Zubin pushed new branch wip/27113-retry at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/27113-retry
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding] Change back the style of the comment of `any_home_import`
by Wolfgang Jeltsch (＠jeltsch) 12 May '26
by Wolfgang Jeltsch (＠jeltsch) 12 May '26
12 May '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding at Glasgow Haskell Compiler / GHC
Commits:
1f97e7a4 by Wolfgang Jeltsch at 2026-05-12T15:00:34+03:00
Change back the style of the comment of `any_home_import`
- - - - -
1 changed file:
- compiler/GHC/Unit/Finder.hs
Changes:
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -248,12 +248,10 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit
any_home_import :: IO FindResult
any_home_import = foldr1 orIfNotFound $
home_import :| map home_pkg_import other_fopts
- {-
- Do not try to be smart and change this to `foldr orIfNotFound
- home_import (map home_pkg_import other_fopts)`, as that would not be the
- same. `home_import` is first because we need to first look within the
- current unit before looking at the other units in order.
- -}
+ -- Do not try to be smart and change this to `foldr orIfNotFound home_import
+ -- (map home_pkg_import other_fopts)`, as that would not be the same.
+ -- `home_import` is first because we need to first look within the current
+ -- unit before looking at the other units in order.
pkg_import :: IO FindResult
pkg_import = findExposedPackageModule fc fopts unit_state mod_name mb_pkg
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f97e7a4cbed9e3062da00b730e57fc…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f97e7a4cbed9e3062da00b730e57fc…
You're receiving this email because of your account on gitlab.haskell.org.
1
0