Hannes Siebenhandl pushed to branch wip/fendor/26300 at Glasgow Haskell Compiler / GHC

Commits:

16 changed files:

Changes:

  • compiler/GHC/Iface/Errors/Ppr.hs
    ... ... @@ -240,7 +240,9 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
    240 240 
           -> vcat (map pprMod mods)
    241 241 
           where
    242 242 
             unambiguousPackages = foldl' unambiguousPackage (Just []) mods
    243 
    -        unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
    243 
    +        unambiguousPackage (Just xs) (m, ExternalUnitOrigin (ModOrigin (Just _) _ _ _))
    244 
    +            = Just (moduleUnit m : xs)
    245 
    +        unambiguousPackage (Just xs) (m, HomeOrigin{})
    244 246 
                 = Just (moduleUnit m : xs)
    245 247 
             unambiguousPackage _ _ = Nothing
    246 248 
         GenericMissing pkg_hiddens mod_hiddens unusables files ->
    ... ... @@ -251,9 +253,16 @@ cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInst
    251 253 
       where
    252 254 
         pprMod (m, o) = text "it is bound as" <+> ppr m <+>
    253 255 
                                     text "by" <+> pprOrigin m o
    254 
    -    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
    255 
    -    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
    256 
    -    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
    256 
    +
    257 
    +    pprOrigin m HomeOrigin = pprHomeOrigin m
    258 
    +    pprOrigin m (ExternalUnitOrigin o) = pprExtOrigin m o
    259 
    +
    260 
    +    pprHomeOrigin m =
    261 
    +      text "package" <+> ppr (moduleUnit m)
    262 
    +
    263 
    +    pprExtOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
    264 
    +    pprExtOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
    265 
    +    pprExtOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
    257 266 
           if e == Just True
    258 267 
               then [text "package" <+> ppr (moduleUnit m)]
    259 268 
               else [] ++

  • compiler/GHC/Iface/Errors/Types.hs
    ... ... @@ -6,6 +6,7 @@ module GHC.Iface.Errors.Types (
    6 6 
       , ReadInterfaceError(..)
    7 7 
       , CantFindInstalled(..)
    8 8 
       , CantFindInstalledReason(..)
    9 
    +  , HomeOrExternalOrigin(..)
    9 10 
       , FindingModuleOrInterface(..)
    10 11
    11 12 
       , BuildingCabalPackage(..)
    ... ... @@ -75,9 +76,13 @@ data CantFindInstalledReason
    75 76 
       | GenericMissing
    76 77 
           [UnitInfo] [Unit]
    77 78 
           [UnusableUnit] [FilePath]
    78 
    -  | MultiplePackages [(Module, ModuleOrigin)]
    79 
    +  | MultiplePackages [(Module, HomeOrExternalOrigin)]
    79 80 
       deriving Generic
    80 81
    82 
    +data HomeOrExternalOrigin
    83 
    +  = HomeOrigin
    84 
    +  | ExternalUnitOrigin ModuleOrigin
    85 
    +
    81 86 
     data CantFindInstalled =
    82 87 
       CantFindInstalled ModuleName CantFindInstalledReason
    83 88 
       deriving Generic

  • compiler/GHC/Unit/Finder.hs
    ... ... @@ -82,6 +82,7 @@ import qualified Data.Set as Set (empty, intersection, difference, null, toList)
    82 82 
     import qualified System.Directory as SD
    83 83 
     import qualified System.OsPath as OsPath
    84 84 
     import qualified Data.List.NonEmpty as NE
    85 
    +import GHC.Iface.Errors.Types
    85 86
    86 87 
     type FileExt = OsString -- Filename extension
    87 88 
     type BaseName = OsPath  -- Basename of file
    ... ... @@ -247,8 +248,12 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit
    247 248 
                                  ue_findHomeUnitEnv home_unit_id ue
    248 249
    249 250 
         other_fopts :: [(UnitId, FinderOpts)]
    250 
    -    other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map
    251 
    +    other_fopts =
    252 
    +      let
    253 
    +        (providers, others) = homeUnitDepsFinderOpts ue home_module_name_providers_map
    251 254 
                                              unit_state mod_name
    255 
    +      in
    256 
    +        providers ++ others
    252 257
    253 258 
     -- | Locate a plugin module requested by the user, for a compiler
    254 259 
     -- plugin.  This consults the same set of exposed packages as
    ... ... @@ -265,7 +270,7 @@ findPluginModuleNoHsc
    265 270 
     findPluginModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit@(Just home_unit) mod_name =
    266 271 
         findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map
    267 272 
                                 mb_home_unit mod_name
    268 
    -    `orIfNotFound`
    273 
    +    `combineFindResult`
    269 274 
         findExposedPluginPackageModule fc fopts unit_state mod_name
    270 275 
       where
    271 276 
         unit_state = HUG.homeUnitEnv_units $
    ... ... @@ -291,9 +296,9 @@ findPluginModule hsc_env mod_name = do
    291 296 
     rankedHomeUnitDeps :: HomeModuleNameProvidersMap
    292 297 
                        -> ModuleName
    293 298 
                        -> Set UnitId
    294 
    -                   -> [UnitId]
    299 
    +                   -> ([UnitId], [UnitId])
    295 300 
     rankedHomeUnitDeps _ _ home_unit_deps | Set.null home_unit_deps
    296 
    -    = []
    301 
    +    = ([], [])
    297 302 
     -- The special handling of the situation where the dependency set is empty does
    298 303 
     -- not change the result, but it avoids triggering evaluation of the module
    299 304 
     -- graph. This is particularly important in one-shot mode, where the module
    ... ... @@ -309,7 +314,7 @@ rankedHomeUnitDeps _ _ home_unit_deps | Set.null home_unit_deps
    309 314 
     --     3 | import {-# source #-} A
    310 315 
     --       | ^^^^^^^^^^^^^^^^^^^^^^^
    311 316 
     rankedHomeUnitDeps home_module_name_providers_map mod_name home_unit_deps
    312 
    -    = Set.toList cached_deps ++ Set.toList uncached_deps
    317 
    +    = (Set.toList cached_deps, Set.toList uncached_deps)
    313 318 
         where
    314 319
    315 320 
         cached_providers :: Set UnitId
    ... ... @@ -330,12 +335,19 @@ homeUnitDepsFinderOpts
    330 335 
       -> HomeModuleNameProvidersMap
    331 336 
       -> UnitState  -- ^ unit state of the requesting home unit
    332 337 
       -> ModuleName
    333 
    -  -> [(UnitId, FinderOpts)]
    338 
    +  -> ([(UnitId, FinderOpts)], [(UnitId, FinderOpts)])
    334 339 
     homeUnitDepsFinderOpts ue home_module_name_providers_map unit_state mod_name =
    335 
    -    [ (uid, initFinderOpts (ue_unitFlags uid ue))
    336 
    -    | uid <- rankedHomeUnitDeps home_module_name_providers_map mod_name
    340 
    +  let
    341 
    +    (providers, otherHomeUnits) = rankedHomeUnitDeps home_module_name_providers_map mod_name
    337 342 
                                     (homeUnitDepends unit_state)
    338 
    -    ]
    343 
    +  in
    344 
    +    ( [ (uid, initFinderOpts (ue_unitFlags uid ue))
    345 
    +      | uid <- providers
    346 
    +      ]
    347 
    +    , [ (uid, initFinderOpts (ue_unitFlags uid ue))
    348 
    +      | uid <- otherHomeUnits
    349 
    +      ]
    350 
    +    )
    339 351
    340 352 
     -- | Search for @mod_name@ in the given home unit.
    341 353 
     findHomeUnitDepModule
    ... ... @@ -371,11 +383,25 @@ findHomeModuleAmongDeps
    371 383 
       -> ModuleName
    372 384 
       -> IO FindResult
    373 385 
     findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map mb_home_unit mod_name =
    374 
    -    foldr1 orIfNotFound (home_import :| map home_pkg_import other_fopts)
    375 
    -    -- Do not try to be smart and change this to `foldr orIfNotFound home_import
    376 
    -    -- (map home_pkg_import other_fopts)`, as that would not be the same.
    377 
    -    -- `home_import` is first because we need to first look within the current
    378 
    -    -- unit before looking at the other units in order.
    386 
    +  case other_fopts of
    387 
    +    [] ->
    388 
    +      foldr1 combineFindResult (home_import :| map home_pkg_import provider_fopts)
    389 
    +      -- Do not try to be smart and change this to `foldr combineFindResult home_import
    390 
    +      -- (map home_pkg_import other_fopts)`, as that would not be the same.
    391 
    +      -- `home_import` is first because we need to first look within the current
    392 
    +      -- unit before looking at the other units in order.
    393 
    +    (x:xs) ->
    394 
    +      foldr1 combineFindResult (home_import :| map home_pkg_import provider_fopts)
    395 
    +      -- Do not try to be smart and change this to `foldr combineFindResult home_import
    396 
    +      -- (map home_pkg_import other_fopts)`, as that would not be the same.
    397 
    +      -- `home_import` is first because we need to first look within the current
    398 
    +      -- unit before looking at the other units in order.
    399 
    +      `orIfNotFound`
    400 
    +      foldr1 orIfNotFound (home_pkg_import x :| map home_pkg_import xs)
    401 
    +      -- Do not try to be smart and change this to `foldr orIfNotFound home_import
    402 
    +      -- (map home_pkg_import other_fopts)`, as that would not be the same.
    403 
    +      -- `home_import` is first because we need to first look within the current
    404 
    +      -- unit before looking at the other units in order.
    379 405 
       where
    380 406 
         home_import = case mb_home_unit of
    381 407 
             Just home_unit -> findHomeModule fc fopts home_unit mod_name
    ... ... @@ -387,7 +413,7 @@ findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map mb_home_unit
    387 413 
             Nothing           -> ue_homeUnitState ue
    388 414 
             Just home_unit_id -> HUG.homeUnitEnv_units $
    389 415 
                                  ue_findHomeUnitEnv home_unit_id ue
    390 
    -    other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map
    416 
    +    (provider_fopts, other_fopts) = homeUnitDepsFinderOpts ue home_module_name_providers_map
    391 417 
                                              unit_state mod_name
    392 418
    393 419 
     -- | Search the home-unit graph and otherwise the regular exposed package
    ... ... @@ -403,7 +429,7 @@ findHomeOrRegularPackageModule
    403 429 
     findHomeOrRegularPackageModule fc fopts ue home_module_name_providers_map mb_home_unit mod_name =
    404 430 
         findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map
    405 431 
                                 mb_home_unit mod_name
    406 
    -    `orIfNotFound`
    432 
    +    `combineFindResult`
    407 433 
         findExposedPackageModule fc fopts unit_state mod_name NoPkgQual
    408 434 
       where
    409 435 
         unit_state = case homeUnitId <$> mb_home_unit of
    ... ... @@ -470,6 +496,40 @@ orIfNotFound this or_this = do
    470 496 
                  _other -> return res2
    471 497 
         _other -> return res
    472 498
    499 
    +combineFindResult :: Monad m => m FindResult -> m FindResult -> m FindResult
    500 
    +combineFindResult this or_this = do
    501 
    +  res <- this
    502 
    +  case res of
    503 
    +    NotFound { fr_paths = paths1, fr_mods_hidden = mh1
    504 
    +             , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
    505 
    +     -> do res2 <- or_this
    506 
    +           case res2 of
    507 
    +             NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
    508 
    +                      , fr_pkgs_hidden = ph2, fr_unusables = u2
    509 
    +                      , fr_suggestions = s2 }
    510 
    +              -> return (NotFound { fr_paths = paths1 ++ paths2
    511 
    +                                  , fr_pkg = mb_pkg2 -- snd arg is the package search
    512 
    +                                  , fr_mods_hidden = mh1 ++ mh2
    513 
    +                                  , fr_pkgs_hidden = ph1 ++ ph2
    514 
    +                                  , fr_unusables = u1 ++ u2
    515 
    +                                  , fr_suggestions = s1  ++ s2 })
    516 
    +             _other -> return res2
    517 
    +    NoPackage{} -> pure res
    518 
    +    FoundMultiple ms -> do
    519 
    +      otherRes <- or_this
    520 
    +      case otherRes of
    521 
    +        Found _ other_mod -> pure $ FoundMultiple $ ms ++ [(other_mod, HomeOrigin)]
    522 
    +        NoPackage{} -> pure res
    523 
    +        FoundMultiple other_ms -> pure $ FoundMultiple $ ms ++ other_ms
    524 
    +        NotFound{} -> pure res
    525 
    +    Found _mod_location modl -> do
    526 
    +      otherRes <- or_this
    527 
    +      case otherRes of
    528 
    +        Found _ other_mod -> pure $ FoundMultiple $ [(modl, HomeOrigin), (other_mod, HomeOrigin)]
    529 
    +        NoPackage{} -> pure res
    530 
    +        FoundMultiple other_ms -> pure $ FoundMultiple $ [(modl, HomeOrigin)] ++ other_ms
    531 
    +        NotFound{} -> pure res
    532 
    +
    473 533 
     -- | Helper function for 'findHomeModule': this function wraps an IO action
    474 534 
     -- which would look up @mod_name@ in the file system (the home package),
    475 535 
     -- and first consults the 'hsc_FC' cache to see if the lookup has already
    ... ... @@ -509,7 +569,7 @@ findLookupResult fc fopts r = case r of
    509 569 
                                              , fr_unusables = []
    510 570 
                                              , fr_suggestions = []})
    511 571 
          LookupMultiple rs ->
    512 
    -       return (FoundMultiple rs)
    572 
    +       return (FoundMultiple $ map (\ (m, o) -> (m, ExternalUnitOrigin o)) rs)
    513 573 
          LookupHidden fr_pkgs_hidden mod_hiddens ->
    514 574 
            return (NotFound{ fr_paths = [], fr_pkg = Nothing
    515 575 
                            , fr_pkgs_hidden

  • compiler/GHC/Unit/Finder/Types.hs
    ... ... @@ -19,6 +19,7 @@ import GHC.Unit.Env
    19 19
    20 20 
     import GHC.Data.FastString
    21 21 
     import GHC.Types.Unique.Set
    22 
    +import GHC.Iface.Errors.Types (HomeOrExternalOrigin)
    22 23
    23 24 
     -- | The 'FinderCache' maps modules to the result of
    24 25 
     -- searching for that module. It records the results of searching for
    ... ... @@ -56,7 +57,7 @@ data FindResult
    56 57 
             -- ^ The module was found
    57 58 
       | NoPackage Unit
    58 59 
             -- ^ The requested unit was not found
    59 
    -  | FoundMultiple [(Module, ModuleOrigin)]
    60 
    +  | FoundMultiple [(Module, HomeOrExternalOrigin)]
    60 61 
             -- ^ _Error_: both in multiple packages
    61 62
    62 63 
             -- | Not found

  • testsuite/tests/ghci/T26300/Makefile
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +.PHONY: prog-mhu006a
    6 
    +prog-mhu006a:
    7 
    +	'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
    8 
    +		-no-user-package-db \
    9 
    +		-unit @unitA -unit @unitB < prog-mhu006a.script

  • testsuite/tests/ghci/T26300/T26300.script
    1 
    +"Report two ambiguous imports."
    2 
    +"The Data.List import is ambiguous with the `base` module."
    3 
    +"Bar module is defined in two home units, as such needs to be reported as ambiguous."

  • testsuite/tests/ghci/T26300/T26300.stderr
    1 
    +a/Main.hs:3:1: error: [GHC-45102]
    2 
    +    Ambiguous module name ‘Data.List’.
    3 
    +    it was found in multiple packages: base-4.23.0.0 b-0.0.1
    4 
    +
    5 
    +a/Main.hs:4:1: error: [GHC-45102]
    6 
    +    Ambiguous module name ‘Bar’.
    7 
    +    it was found in multiple packages: c-0.0.1 b-0.0.1
    8 
    +

  • testsuite/tests/ghci/T26300/T26300.stdout
    1 
    +"Report two ambiguous imports."
    2 
    +"The Data.List import is ambiguous with the `base` module."
    3 
    +"Bar module is defined in two home units, as such needs to be reported as ambiguous."

  • testsuite/tests/ghci/T26300/a/Main.hs
    1 
    +module Main where
    2 
    +
    3 
    +import Data.List
    4 
    +import Bar

  • testsuite/tests/ghci/T26300/all.T
    1 
    +test('T26300',
    2 
    +     [extra_files(['a/', 'b/', 'c/', 'unitA', 'unitB', 'unitC']),
    3 
    +      cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
    4 
    +      normalise_slashes,
    5 
    +      req_interp],
    6 
    +     ghci_multiunit_script, [['unitA', 'unitB', 'unitC'], 'T26300.script'])

  • testsuite/tests/ghci/T26300/b/Bar.hs
    1 
    +module Bar where

  • testsuite/tests/ghci/T26300/b/Data/List.hs
    1 
    +module Data.List where

  • testsuite/tests/ghci/T26300/c/Bar.hs
    1 
    +module Bar where

  • testsuite/tests/ghci/T26300/unitA
    1 
    +-i
    2 
    +-ia
    3 
    +-this-unit-id a-0.0.1
    4 
    +-package-id b-0.0.1
    5 
    +-package-id c-0.0.1
    6 
    +Main

  • testsuite/tests/ghci/T26300/unitB
    1 
    +-i
    2 
    +-ib
    3 
    +-this-unit-id b-0.0.1
    4 
    +Data.List
    5 
    +Bar

  • testsuite/tests/ghci/T26300/unitC
    1 
    +-i
    2 
    +-ic
    3 
    +-this-unit-id c-0.0.1
    4 
    +Bar

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/d8aa95262333abb8485c31bf8aed2da2f9cc7ecd at 1785237151