Hannes Siebenhandl pushed to branch wip/fendor/homeunit-is-just at Glasgow Haskell Compiler / GHC

Commits:

21 changed files:

Changes:

  • compiler/GHC.hs
    ... ... @@ -678,7 +678,7 @@ setUnitDynFlagsNoCheck uid dflags1 = do
    678 678
            hue
    
    679 679
               { homeUnitEnv_units = unit_state
    
    680 680
               , homeUnitEnv_dflags = updated_dflags
    
    681
    -          , homeUnitEnv_home_unit = Just home_unit
    
    681
    +          , homeUnitEnv_home_unit = home_unit
    
    682 682
               }
    
    683 683
     
    
    684 684
       let unit_env = UnitEnv.ue_updateHomeUnitEnv upd uid (hsc_unit_env hsc_env)
    
    ... ... @@ -767,7 +767,7 @@ setProgramDynFlags_ invalidate_needed dflags = do
    767 767
                 { homeUnitEnv_units = unit_state
    
    768 768
                 , homeUnitEnv_dflags = updated_dflags
    
    769 769
                 , homeUnitEnv_hpt = old_hpt
    
    770
    -            , homeUnitEnv_home_unit = Just home_unit
    
    770
    +            , homeUnitEnv_home_unit = home_unit
    
    771 771
                 }
    
    772 772
     
    
    773 773
             let dflags1 = homeUnitEnv_dflags $ HUG.unitEnv_lookup (ue_currentUnit old_unit_env) home_unit_graph
    
    ... ... @@ -891,7 +891,7 @@ setProgramHUG_ invalidate_needed new_hug0 = do
    891 891
             { homeUnitEnv_units = unit_state
    
    892 892
             , homeUnitEnv_dflags = updated_dflags
    
    893 893
             , homeUnitEnv_hpt = old_hpt
    
    894
    -        , homeUnitEnv_home_unit = Just home_unit
    
    894
    +        , homeUnitEnv_home_unit = home_unit
    
    895 895
             }
    
    896 896
     
    
    897 897
     -- When changing the DynFlags, we want the changes to apply to future
    
    ... ... @@ -1684,7 +1684,7 @@ findQualifiedModule :: GhcMonad m => PkgQual -> ModuleName -> m Module
    1684 1684
     findQualifiedModule pkgqual mod_name = withSession $ \hsc_env -> do
    
    1685 1685
       let logger = hsc_logger hsc_env
    
    1686 1686
       liftIO $ trace_if logger (text "findQualifiedModule" <+> ppr mod_name <+> ppr pkgqual)
    
    1687
    -  let mhome_unit = hsc_home_unit_maybe hsc_env
    
    1687
    +  let home_unit = hsc_home_unit hsc_env
    
    1688 1688
       let dflags = hsc_dflags hsc_env
    
    1689 1689
       let sec = initSourceErrorContext dflags
    
    1690 1690
       case pkgqual of
    
    ... ... @@ -1695,7 +1695,7 @@ findQualifiedModule pkgqual mod_name = withSession $ \hsc_env -> do
    1695 1695
             Nothing -> liftIO $ do
    
    1696 1696
                res <- findImportedModule hsc_env LookupUser mod_name pkgqual
    
    1697 1697
                case res of
    
    1698
    -             Found loc m | notHomeModuleMaybe mhome_unit m -> return m
    
    1698
    +             Found loc m | notHomeModule home_unit m -> return m
    
    1699 1699
                              | otherwise -> modNotLoadedError dflags m loc
    
    1700 1700
                  err -> throwOneError sec $ noModError hsc_env noSrcSpan mod_name err
    
    1701 1701
     
    

  • compiler/GHC/Driver/Backpack.hs
    ... ... @@ -470,7 +470,7 @@ addUnit u = do
    470 470
               , ue_home_unit_graph =
    
    471 471
                     HUG.unitEnv_singleton
    
    472 472
                         (homeUnitId home_unit)
    
    473
    -                    (HUG.mkHomeUnitEnv unit_state dflags (ue_hpt old_unit_env) (Just home_unit))
    
    473
    +                    (HUG.mkHomeUnitEnv unit_state dflags (ue_hpt old_unit_env) home_unit)
    
    474 474
               , ue_eps       = ue_eps old_unit_env
    
    475 475
               , ue_module_graph = ue_module_graph old_unit_env
    
    476 476
               , ue_uic = ue_uic old_unit_env
    

  • compiler/GHC/Driver/Env.hs
    ... ... @@ -7,7 +7,6 @@ module GHC.Driver.Env
    7 7
        , hscUpdateFlags
    
    8 8
        , hscSetFlags
    
    9 9
        , hsc_home_unit
    
    10
    -   , hsc_home_unit_maybe
    
    11 10
        , hsc_units
    
    12 11
        , hsc_HPT
    
    13 12
        , hsc_HUE
    
    ... ... @@ -122,10 +121,7 @@ runInteractiveHsc :: HscEnv -> Hsc a -> IO a
    122 121
     runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
    
    123 122
     
    
    124 123
     hsc_home_unit :: HscEnv -> HomeUnit
    
    125
    -hsc_home_unit = ue_unsafeHomeUnit . hsc_unit_env
    
    126
    -
    
    127
    -hsc_home_unit_maybe :: HscEnv -> Maybe HomeUnit
    
    128
    -hsc_home_unit_maybe = ue_homeUnit . hsc_unit_env
    
    124
    +hsc_home_unit = ue_homeUnit . hsc_unit_env
    
    129 125
     
    
    130 126
     hsc_units :: HasDebugCallStack => HscEnv -> UnitState
    
    131 127
     hsc_units = ue_homeUnitState . hsc_unit_env
    
    ... ... @@ -390,7 +386,7 @@ lookupIfaceByModuleHsc hsc_env mod = do
    390 386
       lookupIfaceByModule (hsc_HUG hsc_env) (eps_PIT eps) mod
    
    391 387
     
    
    392 388
     mainModIs :: HomeUnitEnv -> Module
    
    393
    -mainModIs hue = mkHomeModule (expectJust $ homeUnitEnv_home_unit hue) (mainModuleNameIs (homeUnitEnv_dflags hue))
    
    389
    +mainModIs hue = mkHomeModule (homeUnitEnv_home_unit hue) (mainModuleNameIs (homeUnitEnv_dflags hue))
    
    394 390
     
    
    395 391
     -- | Retrieve the target code interpreter
    
    396 392
     --
    

  • compiler/GHC/Driver/Main/Hsc.hs
    ... ... @@ -112,7 +112,7 @@ newHscEnv top_dir dflags = do
    112 112
       where
    
    113 113
         home_unit_graph hpt = HUG.unitEnv_singleton
    
    114 114
                             (homeUnitId_ dflags)
    
    115
    -                        (HUG.mkHomeUnitEnv emptyUnitState dflags hpt Nothing)
    
    115
    +                        (HUG.mkHomeUnitEnv emptyUnitState dflags hpt (DefiniteHomeUnit (homeUnitId_ dflags) Nothing))
    
    116 116
     
    
    117 117
     newHscEnvWithHUG :: FilePath -> DynFlags -> UnitId -> HomeUnitGraph -> IO HscEnv
    
    118 118
     newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
    

  • compiler/GHC/Driver/Make.hs
    ... ... @@ -1672,7 +1672,7 @@ maybeRehydrateBefore hsc_env mni (Just mns) = do
    1672 1672
     
    
    1673 1673
       where
    
    1674 1674
        initialise_knot_var hsc_env = liftIO $
    
    1675
    -    let mod_name = homeModuleInstantiation (hsc_home_unit_maybe hsc_env) (moduleNodeInfoModule mni)
    
    1675
    +    let mod_name = homeModuleInstantiation (hsc_home_unit hsc_env) (moduleNodeInfoModule mni)
    
    1676 1676
         in mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv
    
    1677 1677
     
    
    1678 1678
     rehydrateAfter :: HscEnv
    

  • compiler/GHC/Driver/Pipeline/Execute.hs
    ... ... @@ -373,7 +373,7 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
    373 373
       let dflags    = hsc_dflags hsc_env
    
    374 374
       let logger    = hsc_logger hsc_env
    
    375 375
       let unit_env  = hsc_unit_env hsc_env
    
    376
    -  let home_unit = hsc_home_unit_maybe hsc_env
    
    376
    +  let home_unit = hsc_home_unit hsc_env
    
    377 377
       let tmpfs     = hsc_tmpfs hsc_env
    
    378 378
       let tmpdir    = tmpDir dflags
    
    379 379
       let platform  = ue_platform unit_env
    
    ... ... @@ -473,12 +473,11 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
    473 473
               -- These symbols are imported into the stub.c file via RtsAPI.h, and the
    
    474 474
               -- way we do the import depends on whether we're currently compiling
    
    475 475
               -- the base package or not.
    
    476
    -                 ++ (case home_unit of
    
    477
    -                        Just hu
    
    478
    -                          | isHomeUnitId hu ghcInternalUnitId
    
    479
    -                          , platformOS platform == OSMinGW32
    
    480
    -                          -> ["-DCOMPILING_GHC_INTERNAL_PACKAGE"]
    
    481
    -                        _ -> [])
    
    476
    +                 ++ (if
    
    477
    +                      | isHomeUnitId home_unit ghcInternalUnitId
    
    478
    +                      , platformOS platform == OSMinGW32
    
    479
    +                      -> ["-DCOMPILING_GHC_INTERNAL_PACKAGE"]
    
    480
    +                      | otherwise -> [])
    
    482 481
     
    
    483 482
                      -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.
    
    484 483
                      ++ (if (cc_phase /= Ccxx && cc_phase /= Cobjcxx)
    

  • compiler/GHC/Driver/Session/Units.hs
    ... ... @@ -17,9 +17,9 @@ import GHC.Driver.Config.Diagnostic
    17 17
     
    
    18 18
     import GHC.Unit.Env
    
    19 19
     import GHC.Unit (UnitId)
    
    20
    +import GHC.Unit.Home (homeUnitId)
    
    20 21
     import GHC.Unit.Home.PackageTable
    
    21 22
     import qualified GHC.Unit.Home.Graph as HUG
    
    22
    -import GHC.Unit.State  ( emptyUnitState )
    
    23 23
     import qualified GHC.Unit.State as State
    
    24 24
     
    
    25 25
     import GHC.Types.SrcLoc
    
    ... ... @@ -125,23 +125,24 @@ initMulti unitArgsFiles lintDynFlagsAndSrcs = do
    125 125
     
    
    126 126
       checkDuplicateUnits initial_dflags (NE.toList (NE.zip unitArgsFiles unitDflags))
    
    127 127
     
    
    128
    -  (initial_home_graph, mainUnitId) <- liftIO $ createUnitEnvFromFlags unitDflags
    
    129
    -  let home_units = HUG.allUnits initial_home_graph
    
    128
    +  let home_units = Set.fromList $ map homeUnitId_ $ NE.toList unitDflags
    
    130 129
     
    
    131
    -  home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do
    
    132
    -    let hue_flags = homeUnitEnv_dflags homeUnitEnv
    
    133
    -        dflags = homeUnitEnv_dflags homeUnitEnv
    
    134
    -    (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags (hscUIC hsc_env) home_units
    
    130
    +  home_unit_envs <- forM unitDflags $ \dflags -> do
    
    131
    +    emptyHpt <- liftIO $ emptyHomePackageTable
    
    132
    +    (unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger dflags (hscUIC hsc_env) home_units
    
    135 133
     
    
    136 134
         updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants
    
    137
    -    emptyHpt <- liftIO $ emptyHomePackageTable
    
    138 135
         pure $ HomeUnitEnv
    
    139 136
           { homeUnitEnv_units = unit_state
    
    140 137
           , homeUnitEnv_dflags = updated_dflags
    
    141 138
           , homeUnitEnv_hpt = emptyHpt
    
    142
    -      , homeUnitEnv_home_unit = Just home_unit
    
    139
    +      , homeUnitEnv_home_unit = home_unit
    
    143 140
           }
    
    144 141
     
    
    142
    +
    
    143
    +  let mainUnitId = homeUnitId $ homeUnitEnv_home_unit $ NE.head home_unit_envs
    
    144
    +  let home_unit_graph = HUG.hugFromHomeUnitEnvs $ NE.toList home_unit_envs
    
    145
    +
    
    145 146
       checkUnitCycles initial_dflags home_unit_graph
    
    146 147
     
    
    147 148
       let dflags = homeUnitEnv_dflags $ HUG.unitEnv_lookup mainUnitId home_unit_graph
    
    ... ... @@ -230,16 +231,3 @@ offsetDynFlags dflags =
    230 231
         augment_maybe (Just f) = Just (augment f)
    
    231 232
         augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f
    
    232 233
                   | otherwise = f
    233
    -
    
    234
    -
    
    235
    -createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> IO (HomeUnitGraph, UnitId)
    
    236
    -createUnitEnvFromFlags unitDflags = do
    
    237
    -  unitEnvList <- forM unitDflags $ \dflags -> do
    
    238
    -    emptyHpt <- emptyHomePackageTable
    
    239
    -    let newInternalUnitEnv =
    
    240
    -          HUG.mkHomeUnitEnv emptyUnitState dflags emptyHpt Nothing
    
    241
    -    return (homeUnitId_ dflags, newInternalUnitEnv)
    
    242
    -  let activeUnit = fst $ NE.head unitEnvList
    
    243
    -  return (HUG.hugFromList (NE.toList unitEnvList), activeUnit)
    
    244
    -
    
    245
    -

  • compiler/GHC/HsToCore/Usage.hs
    ... ... @@ -82,7 +82,7 @@ mkUsageInfo uc plugins fc unit_env
    82 82
       = do
    
    83 83
         file_hashes <- liftIO $ mapM getFileHash dependent_files
    
    84 84
         dirs_hashes <- liftIO $ mapM getDirHash dependent_dirs
    
    85
    -    let hu = ue_unsafeHomeUnit unit_env
    
    85
    +    let hu = ue_homeUnit unit_env
    
    86 86
         -- Dependencies on object files due to TH and plugins
    
    87 87
         object_usages <- liftIO $ mkObjectUsage plugins fc needed_links needed_pkgs
    
    88 88
         let all_home_ids = HUG.allUnits (ue_home_unit_graph unit_env)
    

  • compiler/GHC/Iface/Errors.hs
    ... ... @@ -27,20 +27,20 @@ badIfaceFile file err
    27 27
       = vcat [text "Bad interface file:" <+> text file,
    
    28 28
               nest 4 err]
    
    29 29
     
    
    30
    -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile
    
    30
    +cannotFindInterface :: UnitState -> HomeUnit -> Profile
    
    31 31
                         -> ModuleName -> InstalledFindResult -> MissingInterfaceError
    
    32
    -cannotFindInterface us mhu p mn ifr =
    
    32
    +cannotFindInterface us hu p mn ifr =
    
    33 33
       CantFindErr us FindingInterface $
    
    34
    -  cantFindInstalledErr us mhu p mn ifr
    
    34
    +  cantFindInstalledErr us hu p mn ifr
    
    35 35
     
    
    36 36
     cantFindInstalledErr
    
    37 37
         :: UnitState
    
    38
    -    -> Maybe HomeUnit
    
    38
    +    -> HomeUnit
    
    39 39
         -> Profile
    
    40 40
         -> ModuleName
    
    41 41
         -> InstalledFindResult
    
    42 42
         -> CantFindInstalled
    
    43
    -cantFindInstalledErr unit_state mhome_unit profile mod_name find_result
    
    43
    +cantFindInstalledErr unit_state home_unit profile mod_name find_result
    
    44 44
       = CantFindInstalled mod_name more_info
    
    45 45
       where
    
    46 46
         build_tag  = waysBuildTag (profileWays profile)
    
    ... ... @@ -52,7 +52,7 @@ cantFindInstalledErr unit_state mhome_unit profile mod_name find_result
    52 52
     
    
    53 53
                 InstalledNotFound files mb_pkg
    
    54 54
                     | Just pkg <- mb_pkg
    
    55
    -                , notHomeUnitId mhome_unit pkg
    
    55
    +                , not (isHomeUnitId home_unit pkg)
    
    56 56
                     -> not_found_in_package pkg $ fmap unsafeDecodeUtf files
    
    57 57
     
    
    58 58
                     | null files
    
    ... ... @@ -102,7 +102,7 @@ cantFindErr _ _ mod_name (FoundMultiple mods)
    102 102
     cantFindErr unit_env profile mod_name find_result
    
    103 103
       = CantFindInstalled mod_name more_info
    
    104 104
       where
    
    105
    -    mhome_unit = ue_homeUnit unit_env
    
    105
    +    home_unit = ue_homeUnit unit_env
    
    106 106
         more_info
    
    107 107
           = case find_result of
    
    108 108
                 NoPackage pkg
    
    ... ... @@ -111,12 +111,7 @@ cantFindErr unit_env profile mod_name find_result
    111 111
                          , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
    
    112 112
                          , fr_unusables = unusables, fr_suggestions = suggest }
    
    113 113
                     | Just pkg <- mb_pkg
    
    114
    -                , Nothing <- mhome_unit           -- no home-unit
    
    115
    -                -> not_found_in_package (toUnitId pkg) files
    
    116
    -
    
    117
    -                | Just pkg <- mb_pkg
    
    118
    -                , Just home_unit <- mhome_unit    -- there is a home-unit but the
    
    119
    -                , not (isHomeUnit home_unit pkg)  -- module isn't from it
    
    114
    +                , not (isHomeUnit home_unit pkg)  -- module isn't from this home unit
    
    120 115
                     -> not_found_in_package (toUnitId pkg) files
    
    121 116
     
    
    122 117
                     | not (null suggest)
    

  • compiler/GHC/Iface/Load.hs
    ... ... @@ -774,14 +774,14 @@ loadInterface doc_str mod from
    774 774
     
    
    775 775
                     -- Check whether we have the interface already
    
    776 776
             ; hsc_env <- getTopEnv
    
    777
    -        ; let mhome_unit = ue_homeUnit (hsc_unit_env hsc_env)
    
    777
    +        ; let home_unit = ue_homeUnit (hsc_unit_env hsc_env)
    
    778 778
             ; liftIO (lookupIfaceByModule hug (eps_PIT eps) mod) >>= \case {
    
    779 779
                 Just iface
    
    780 780
                     -> return (Succeeded iface) ;   -- Already loaded
    
    781 781
                 _ -> do {
    
    782 782
     
    
    783 783
             -- READ THE MODULE IN
    
    784
    -        ; read_result <- case wantHiBootFile mhome_unit eps mod from of
    
    784
    +        ; read_result <- case wantHiBootFile home_unit eps mod from of
    
    785 785
                                Failed err             -> return (Failed err)
    
    786 786
                                Succeeded hi_boot_file -> do
    
    787 787
                                  hsc_env <- getTopEnv
    
    ... ... @@ -877,7 +877,7 @@ loadInterface doc_str mod from
    877 877
     
    
    878 878
             ; warnPprTrace bad_boot "loadInterface" (ppr mod) $
    
    879 879
               updateEps_  $ \ eps ->
    
    880
    -           if elemModuleEnv mod (eps_PIT eps) || is_external_sig mhome_unit iface
    
    880
    +           if elemModuleEnv mod (eps_PIT eps) || is_external_sig home_unit iface
    
    881 881
                     then eps
    
    882 882
                else if bad_boot
    
    883 883
                     -- See Note [Loading your own hi-boot file]
    
    ... ... @@ -1042,12 +1042,12 @@ dontLeakTheHUG thing_inside = do
    1042 1042
     -- | Returns @True@ if a 'ModIface' comes from an external package.
    
    1043 1043
     -- In this case, we should NOT load it into the EPS; the entities
    
    1044 1044
     -- should instead come from the local merged signature interface.
    
    1045
    -is_external_sig :: Maybe HomeUnit -> ModIface -> Bool
    
    1046
    -is_external_sig mhome_unit iface =
    
    1045
    +is_external_sig :: HomeUnit -> ModIface -> Bool
    
    1046
    +is_external_sig home_unit iface =
    
    1047 1047
         -- It's a signature iface...
    
    1048 1048
         mi_semantic_module iface /= mi_module iface &&
    
    1049 1049
         -- and it's not from the local package
    
    1050
    -    notHomeModuleMaybe mhome_unit (mi_module iface)
    
    1050
    +    notHomeModule home_unit (mi_module iface)
    
    1051 1051
     
    
    1052 1052
     -- | This is an improved version of 'findAndReadIface' which can also
    
    1053 1053
     -- handle the case when a user requests @p[A=<B>]:M@ but we only
    
    ... ... @@ -1071,13 +1071,12 @@ computeInterface
    1071 1071
       -> IO (MaybeErr MissingInterfaceError (ModIface, ModLocation))
    
    1072 1072
     computeInterface hsc_env doc_str hi_boot_file mod0 = do
    
    1073 1073
       massert (not (isHoleModule mod0))
    
    1074
    -  let mhome_unit  = hsc_home_unit_maybe hsc_env
    
    1074
    +  let home_unit  = hsc_home_unit hsc_env
    
    1075 1075
       let find_iface m = findAndReadIface hsc_env doc_str
    
    1076 1076
                                           m mod0 hi_boot_file
    
    1077 1077
       case getModuleInstantiation mod0 of
    
    1078 1078
           (imod, Just indef)
    
    1079
    -        | Just home_unit <- mhome_unit
    
    1080
    -        , isHomeUnitIndefinite home_unit ->
    
    1079
    +        | isHomeUnitIndefinite home_unit ->
    
    1081 1080
               find_iface imod >>= \case
    
    1082 1081
                 Succeeded (iface0, path) ->
    
    1083 1082
                   rnModIface hsc_env (instUnitInsts (moduleUnit indef)) Nothing iface0 >>= \case
    
    ... ... @@ -1134,13 +1133,13 @@ moduleFreeHolesPrecise doc_str mod
    1134 1133
                     return (Succeeded (renameFreeHoles ifhs insts))
    
    1135 1134
                 Failed err -> return (Failed err)
    
    1136 1135
     
    
    1137
    -wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom
    
    1136
    +wantHiBootFile :: HomeUnit -> ExternalPackageState -> Module -> WhereFrom
    
    1138 1137
                    -> MaybeErr MissingInterfaceError IsBootInterface
    
    1139 1138
     -- Figure out whether we want Foo.hi or Foo.hi-boot
    
    1140
    -wantHiBootFile mhome_unit eps mod from
    
    1139
    +wantHiBootFile home_unit eps mod from
    
    1141 1140
       = case from of
    
    1142 1141
            ImportByUser usr_boot
    
    1143
    -          | usr_boot == IsBoot && notHomeModuleMaybe mhome_unit mod
    
    1142
    +          | usr_boot == IsBoot && notHomeModule home_unit mod
    
    1144 1143
               -> Failed (BadSourceImport mod)
    
    1145 1144
               | otherwise -> Succeeded usr_boot
    
    1146 1145
     
    
    ... ... @@ -1148,7 +1147,7 @@ wantHiBootFile mhome_unit eps mod from
    1148 1147
               -> Succeeded NotBoot
    
    1149 1148
     
    
    1150 1149
            ImportBySystem
    
    1151
    -          | notHomeModuleMaybe mhome_unit mod
    
    1150
    +          | notHomeModule home_unit mod
    
    1152 1151
               -> Succeeded NotBoot
    
    1153 1152
                  -- If the module to be imported is not from this package
    
    1154 1153
                  -- don't look it up in eps_is_boot, because that is keyed
    
    ... ... @@ -1222,7 +1221,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    1222 1221
       let profile = targetProfile dflags
    
    1223 1222
           unit_state = hsc_units hsc_env
    
    1224 1223
           name_cache = hsc_NC hsc_env
    
    1225
    -      mhome_unit  = hsc_home_unit_maybe hsc_env
    
    1224
    +      home_unit  = hsc_home_unit hsc_env
    
    1226 1225
           dflags     = hsc_dflags hsc_env
    
    1227 1226
           logger     = hsc_logger hsc_env
    
    1228 1227
           hooks      = hsc_hooks hsc_env
    
    ... ... @@ -1261,7 +1260,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    1261 1260
               trace_if logger (text "...not found")
    
    1262 1261
               return $ Failed $ cannotFindInterface
    
    1263 1262
                                   unit_state
    
    1264
    -                              mhome_unit
    
    1263
    +                              home_unit
    
    1265 1264
                                   profile
    
    1266 1265
                                   (moduleName mod)
    
    1267 1266
                                   err
    

  • compiler/GHC/Linker/Deps.hs
    ... ... @@ -160,22 +160,18 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
    160 160
           = HUG.lookupHugByModule mod (ue_home_unit_graph unit_env) >>= \case
    
    161 161
               Just mod_info -> adjust_linkable (expectJust (homeModLinkable mod_info))
    
    162 162
               Nothing -> do
    
    163
    -           -- It's not in the HPT because we are in one shot mode,
    
    164
    -           -- so use the Finder to get a ModLocation...
    
    165
    -           case ue_homeUnit unit_env of
    
    166
    -            Nothing -> no_obj mod
    
    167
    -            Just home_unit -> do
    
    168
    -
    
    169
    -              let fc = ldFinderCache opts
    
    170
    -              let fopts = ldFinderOpts opts
    
    171
    -              mb_stuff <- findHomeModule fc fopts home_unit (moduleName mod)
    
    172
    -              case mb_stuff of
    
    173
    -                Found loc _ -> do
    
    174
    -                  from_bc <- ldLoadByteCode opts mod loc
    
    175
    -                  maybe (fallback_no_bytecode home_unit mod) pure from_bc
    
    176
    -                _ -> fallback_no_bytecode home_unit mod
    
    163
    +            -- It's not in the HPT because we are in one shot mode,
    
    164
    +            -- so use the Finder to get a ModLocation...
    
    165
    +            let fc = ldFinderCache opts
    
    166
    +            let fopts = ldFinderOpts opts
    
    167
    +            mb_stuff <- findHomeModule fc fopts hu (moduleName mod)
    
    168
    +            case mb_stuff of
    
    169
    +              Found loc _ -> do
    
    170
    +                from_bc <- ldLoadByteCode opts mod loc
    
    171
    +                maybe (fallback_no_bytecode hu mod) pure from_bc
    
    172
    +              _ -> fallback_no_bytecode hu mod
    
    177 173
             where
    
    178
    -
    
    174
    +            hu = ue_homeUnit unit_env
    
    179 175
                 fallback_no_bytecode home_unit mod = do
    
    180 176
                   let fc = ldFinderCache opts
    
    181 177
                   let fopts = ldFinderOpts opts
    

  • compiler/GHC/Rename/Names.hs
    ... ... @@ -487,7 +487,7 @@ renamePkgQual :: UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
    487 487
     renamePkgQual unit_env mn mb_pkg = case mb_pkg of
    
    488 488
       Nothing -> NoPkgQual
    
    489 489
       Just pkg_fs
    
    490
    -    | Just uid <- homeUnitId <$> ue_homeUnit unit_env
    
    490
    +    | uid <- homeUnitId (ue_homeUnit unit_env)
    
    491 491
         , pkg_fs == fsLit "this"
    
    492 492
         -> ThisPkg uid
    
    493 493
     
    

  • compiler/GHC/StgToJS/Linker/Linker.hs
    ... ... @@ -485,17 +485,15 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache ar_cache
    485 485
       let load_info mod = do
    
    486 486
             -- Adapted from the tangled code in GHC.Linker.Loader.getLinkDeps.
    
    487 487
             linkable <- HUG.lookupHugByModule mod (ue_home_unit_graph unit_env) >>= \case
    
    488
    -          Nothing ->
    
    488
    +          Nothing -> do
    
    489 489
                     -- It's not in the HPT because we are in one shot mode,
    
    490 490
                     -- so use the Finder to get a ModLocation...
    
    491
    -              case ue_homeUnit unit_env of
    
    492
    -                Nothing -> pprPanic "getDeps: No home-unit: " (pprModule mod)
    
    493
    -                Just home_unit -> do
    
    494
    -                    mb_stuff <- findHomeModule finder_cache finder_opts home_unit (moduleName mod)
    
    495
    -                    case mb_stuff of
    
    496
    -                      Found loc mod -> found loc mod
    
    497
    -                      _ -> pprPanic "getDeps: Couldn't find home-module: " (pprModule mod)
    
    491
    +                mb_stuff <- findHomeModule finder_cache finder_opts home_unit (moduleName mod)
    
    492
    +                case mb_stuff of
    
    493
    +                  Found loc mod -> found loc mod
    
    494
    +                  _ -> pprPanic "getDeps: Couldn't find home-module: " (pprModule mod)
    
    498 495
                     where
    
    496
    +                    home_unit = ue_homeUnit unit_env
    
    499 497
                         found loc mod = do {
    
    500 498
                           mb_lnk <- findObjectLinkableMaybe mod loc ;
    
    501 499
                           case mb_lnk of {
    

  • compiler/GHC/Tc/Utils/Backpack.hs
    ... ... @@ -286,11 +286,11 @@ implicitRequirements hsc_env normal_imports
    286 286
         forM normal_imports $ \e -> do
    
    287 287
             found <- resolveImport hsc_env e
    
    288 288
             case found of
    
    289
    -            Found _ mod | notHomeModuleMaybe mhome_unit mod ->
    
    289
    +            Found _ mod | notHomeModule home_unit mod ->
    
    290 290
                     return (uniqDSetToList (moduleFreeHoles mod))
    
    291 291
                 _ -> return []
    
    292 292
       where
    
    293
    -    mhome_unit = hsc_home_unit_maybe hsc_env
    
    293
    +    home_unit = hsc_home_unit hsc_env
    
    294 294
     
    
    295 295
     -- | Like @implicitRequirements'@, but returns the instantiated unit the
    
    296 296
     -- imported module is from, so that that instantiated unit can be processed and
    
    ... ... @@ -302,13 +302,13 @@ implicitRequirementsShallow
    302 302
       -> IO [InstantiatedUnit]
    
    303 303
     implicitRequirementsShallow hsc_env normal_imports = go [] normal_imports
    
    304 304
      where
    
    305
    -  mhome_unit = hsc_home_unit_maybe hsc_env
    
    305
    +  home_unit = hsc_home_unit hsc_env
    
    306 306
     
    
    307 307
       go acc [] = pure acc
    
    308 308
       go accR (e:imports) = do
    
    309 309
         found <- resolveImport hsc_env e
    
    310 310
         let acc' = case found of
    
    311
    -          Found _ mod | notHomeModuleMaybe mhome_unit mod ->
    
    311
    +          Found _ mod | notHomeModule home_unit mod ->
    
    312 312
                   case moduleUnit mod of
    
    313 313
                       HoleUnit -> panic "implicitRequirementsShallow: HoleUnit is unreachable through findImportedModule!"
    
    314 314
                       RealUnit _ -> accR
    

  • compiler/GHC/Tc/Utils/Env.hs
    ... ... @@ -180,8 +180,8 @@ lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr (Either Name IfaceMessage)
    180 180
     lookupGlobal_maybe hsc_env name
    
    181 181
       = do  {    -- Try local envt
    
    182 182
               let mod = icInteractiveModule (hsc_IC hsc_env)
    
    183
    -              mhome_unit = hsc_home_unit_maybe hsc_env
    
    184
    -              tcg_semantic_mod = homeModuleInstantiation mhome_unit mod
    
    183
    +              home_unit = hsc_home_unit hsc_env
    
    184
    +              tcg_semantic_mod = homeModuleInstantiation home_unit mod
    
    185 185
     
    
    186 186
             ; if nameIsLocalOrFrom tcg_semantic_mod name
    
    187 187
               then return $ Failed $ Left name
    

  • compiler/GHC/Tc/Utils/Monad.hs
    ... ... @@ -371,7 +371,7 @@ initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc =
    371 371
          ; let
    
    372 372
             -- bangs to avoid leaking the env (#19356)
    
    373 373
             !dflags = hsc_dflags hsc_env
    
    374
    -        !mhome_unit = hsc_home_unit_maybe hsc_env
    
    374
    +        !home_unit = hsc_home_unit hsc_env
    
    375 375
             !logger = hsc_logger hsc_env
    
    376 376
     
    
    377 377
             maybe_rn_syntax :: forall a. a -> Maybe a ;
    
    ... ... @@ -399,7 +399,7 @@ initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc =
    399 399
               , tcg_th_docs            = th_docs_var
    
    400 400
     
    
    401 401
               , tcg_mod                = mod
    
    402
    -          , tcg_semantic_mod       = homeModuleInstantiation mhome_unit mod
    
    402
    +          , tcg_semantic_mod       = homeModuleInstantiation home_unit mod
    
    403 403
               , tcg_src                = hsc_src
    
    404 404
               , tcg_rdr_env            = emptyGlobalRdrEnv
    
    405 405
               , tcg_fix_env            = emptyNameEnv
    
    ... ... @@ -2574,11 +2574,11 @@ initIfaceTcRn thing_inside
    2574 2574
       = do  { tcg_env <- getGblEnv
    
    2575 2575
             ; hsc_env <- getTopEnv
    
    2576 2576
               -- bangs to avoid leaking the envs (#19356)
    
    2577
    -        ; let !mhome_unit = hsc_home_unit_maybe hsc_env
    
    2577
    +        ; let !home_unit = hsc_home_unit hsc_env
    
    2578 2578
                   !knot_vars = tcg_knot_vars tcg_env
    
    2579 2579
                   -- When we are instantiating a signature,
    
    2580 2580
                   -- we DEFINITELY do not want to knot tie.
    
    2581
    -              is_instantiate = fromMaybe False (isHomeUnitInstantiating <$> mhome_unit)
    
    2581
    +              is_instantiate = isHomeUnitInstantiating home_unit
    
    2582 2582
     
    
    2583 2583
                   if_env = IfGblEnv { if_doc = text "initIfaceTcRn"
    
    2584 2584
                                     , if_rec_types = if is_instantiate
    

  • compiler/GHC/Unit/Env.hs
    ... ... @@ -53,7 +53,6 @@ module GHC.Unit.Env
    53 53
         , ue_unitHomeUnit_maybe
    
    54 54
         , ue_updateHomeUnitEnv
    
    55 55
         , ue_all_home_unit_ids
    
    56
    -    , ue_unsafeHomeUnit
    
    57 56
     
    
    58 57
         -- * HUG Re-export
    
    59 58
         , HomeUnitGraph
    
    ... ... @@ -235,14 +234,13 @@ preloadUnitsInfo' unit_env ids0 = all_infos
    235 234
       where
    
    236 235
         unit_state = HUG.homeUnitEnv_units (ue_currentHomeUnitEnv unit_env)
    
    237 236
         ids      = ids0 ++ inst_ids
    
    238
    -    inst_ids = case ue_homeUnit unit_env of
    
    239
    -      Nothing -> []
    
    240
    -      Just home_unit
    
    241
    -       -- An indefinite package will have insts to HOLE,
    
    242
    -       -- which is not a real package. Don't look it up.
    
    243
    -       -- Fixes #14525
    
    244
    -       | isHomeUnitIndefinite home_unit -> []
    
    245
    -       | otherwise -> map (toUnitId . moduleUnit . snd) (homeUnitInstantiations home_unit)
    
    237
    +    home_unit = ue_homeUnit unit_env
    
    238
    +    inst_ids
    
    239
    +      -- An indefinite package will have insts to HOLE,
    
    240
    +      -- which is not a real package. Don't look it up.
    
    241
    +      -- Fixes #14525
    
    242
    +      | isHomeUnitIndefinite home_unit = []
    
    243
    +      | otherwise = map (toUnitId . moduleUnit . snd) (homeUnitInstantiations home_unit)
    
    246 244
         pkg_map = unitInfoMap unit_state
    
    247 245
         preload = preloadUnits unit_state
    
    248 246
     
    
    ... ... @@ -320,20 +318,15 @@ ue_setFlags dflags env =
    320 318
     -- Query and modify home units in HomeUnitEnv
    
    321 319
     -- -------------------------------------------------------
    
    322 320
     
    
    323
    -ue_homeUnit :: UnitEnv -> Maybe HomeUnit
    
    321
    +ue_homeUnit :: UnitEnv -> HomeUnit
    
    324 322
     ue_homeUnit = HUG.homeUnitEnv_home_unit . ue_currentHomeUnitEnv
    
    325 323
     
    
    326
    -ue_unsafeHomeUnit :: UnitEnv -> HomeUnit
    
    327
    -ue_unsafeHomeUnit ue = case ue_homeUnit ue of
    
    328
    -  Nothing -> panic "ue_unsafeHomeUnit: No home unit"
    
    329
    -  Just h  -> h
    
    330
    -
    
    331 324
     ue_unitHomeUnit :: UnitId -> UnitEnv -> HomeUnit
    
    332 325
     ue_unitHomeUnit uid = expectJust . ue_unitHomeUnit_maybe uid
    
    333 326
     
    
    334 327
     ue_unitHomeUnit_maybe :: UnitId -> UnitEnv -> Maybe HomeUnit
    
    335 328
     ue_unitHomeUnit_maybe uid ue_env =
    
    336
    -  HUG.homeUnitEnv_home_unit =<< HUG.lookupHugUnitId uid (ue_home_unit_graph ue_env)
    
    329
    +  HUG.homeUnitEnv_home_unit <$> HUG.lookupHugUnitId uid (ue_home_unit_graph ue_env)
    
    337 330
     
    
    338 331
     -- -------------------------------------------------------
    
    339 332
     -- Query and modify the currently active unit
    

  • compiler/GHC/Unit/Finder.hs
    ... ... @@ -5,6 +5,7 @@
    5 5
     
    
    6 6
     
    
    7 7
     {-# LANGUAGE RecordWildCards  #-}
    
    8
    +{-# LANGUAGE MultiWayIf #-}
    
    8 9
     
    
    9 10
     -- | Module finder
    
    10 11
     module GHC.Unit.Finder (
    
    ... ... @@ -210,7 +211,7 @@ findImportedModule
    210 211
       -> IO FindResult
    
    211 212
     findImportedModule hsc_env scope mod pkg_qual =
    
    212 213
       let fc           = hsc_FC hsc_env
    
    213
    -      mb_home_unit = hsc_home_unit_maybe hsc_env
    
    214
    +      home_unit    = hsc_home_unit hsc_env
    
    214 215
           dflags       = hsc_dflags hsc_env
    
    215 216
           fopts        = initFinderOpts dflags
    
    216 217
           providers    = mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env)
    
    ... ... @@ -220,7 +221,7 @@ findImportedModule hsc_env scope mod pkg_qual =
    220 221
           fopts
    
    221 222
           (hsc_unit_env hsc_env)
    
    222 223
           providers
    
    223
    -      mb_home_unit
    
    224
    +      home_unit
    
    224 225
           scope
    
    225 226
           mod
    
    226 227
           pkg_qual
    
    ... ... @@ -230,33 +231,30 @@ findImportedModuleNoHsc
    230 231
       -> FinderOpts
    
    231 232
       -> UnitEnv
    
    232 233
       -> HomeModuleNameProvidersMap
    
    233
    -  -> Maybe HomeUnit
    
    234
    +  -> HomeUnit
    
    234 235
       -> ModuleLookupScope
    
    235 236
       -> ModuleName
    
    236 237
       -> PkgQual
    
    237 238
       -> IO FindResult
    
    238
    -findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit scope mod_name mb_pkg =
    
    239
    +findImportedModuleNoHsc fc fopts ue home_module_name_providers_map home_unit scope mod_name mb_pkg =
    
    239 240
       case mb_pkg of
    
    240 241
         NoPkgQual  -> unqual_import
    
    241
    -    ThisPkg uid | (homeUnitId <$> mb_home_unit) == Just uid -> home_import
    
    242
    +    ThisPkg uid | homeUnitId home_unit == uid -> home_import
    
    242 243
                     | Just os <- lookup uid other_fopts -> home_pkg_import (uid, os)
    
    243
    -                | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mb_home_unit) $$ ppr uid $$ ppr (map fst all_opts))
    
    244
    +                | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr home_unit_id $$ ppr uid $$ ppr (map fst all_opts))
    
    244 245
         OtherPkg _ -> pkg_import
    
    245 246
       where
    
    246 247
     
    
    247
    -    mb_home_unit_id :: Maybe UnitId
    
    248
    -    mb_home_unit_id = homeUnitId <$> mb_home_unit
    
    248
    +    home_unit_id :: UnitId
    
    249
    +    home_unit_id = homeUnitId home_unit
    
    249 250
     
    
    250 251
         all_opts :: [(UnitId, FinderOpts)]
    
    251
    -    all_opts = case mb_home_unit_id of
    
    252
    -        Nothing           -> other_fopts
    
    253
    -        Just home_unit_id -> (home_unit_id, fopts) : other_fopts
    
    252
    +    all_opts =
    
    253
    +      (home_unit_id, fopts) : other_fopts
    
    254 254
     
    
    255 255
         home_import :: IO FindResult
    
    256
    -    home_import = case mb_home_unit of
    
    257
    -        Just home_unit -> findHomeModule fc fopts home_unit mod_name
    
    258
    -        Nothing        -> pure $
    
    259
    -                          NoPackage (panic "findImportedModule: no home-unit")
    
    256
    +    home_import =
    
    257
    +      findHomeModule fc fopts home_unit mod_name
    
    260 258
     
    
    261 259
         home_pkg_import :: (UnitId, FinderOpts) -> IO FindResult
    
    262 260
         home_pkg_import = findHomeUnitDepModule fc ue home_module_name_providers_map scope mod_name
    
    ... ... @@ -266,13 +264,11 @@ findImportedModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit
    266 264
     
    
    267 265
         unqual_import :: IO FindResult
    
    268 266
         unqual_import = findHomeOrRegularPackageModule fc fopts ue
    
    269
    -                        home_module_name_providers_map mb_home_unit scope mod_name
    
    267
    +                        home_module_name_providers_map home_unit scope mod_name
    
    270 268
     
    
    271 269
         unit_state :: UnitState
    
    272
    -    unit_state = case mb_home_unit_id of
    
    273
    -        Nothing           -> ue_homeUnitState ue
    
    274
    -        Just home_unit_id -> HUG.homeUnitEnv_units $
    
    275
    -                             ue_findHomeUnitEnv home_unit_id ue
    
    270
    +    unit_state = HUG.homeUnitEnv_units $
    
    271
    +      ue_findHomeUnitEnv home_unit_id ue
    
    276 272
     
    
    277 273
         other_fopts :: [(UnitId, FinderOpts)]
    
    278 274
         other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map
    
    ... ... @@ -287,28 +283,26 @@ findPluginModuleNoHsc
    287 283
       -> FinderOpts
    
    288 284
       -> UnitEnv
    
    289 285
       -> HomeModuleNameProvidersMap
    
    290
    -  -> Maybe HomeUnit
    
    286
    +  -> HomeUnit
    
    291 287
       -> ModuleName
    
    292 288
       -> IO FindResult
    
    293
    -findPluginModuleNoHsc fc fopts ue home_module_name_providers_map mb_home_unit@(Just home_unit) mod_name =
    
    289
    +findPluginModuleNoHsc fc fopts ue home_module_name_providers_map home_unit mod_name =
    
    294 290
         findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map
    
    295
    -                            mb_home_unit LookupUser mod_name
    
    291
    +                            home_unit LookupUser mod_name
    
    296 292
         `orIfNotFound`
    
    297 293
         findExposedPluginPackageModule fc fopts unit_state mod_name
    
    298 294
       where
    
    299 295
         unit_state = HUG.homeUnitEnv_units $
    
    300 296
                      ue_findHomeUnitEnv (homeUnitId home_unit) ue
    
    301
    -findPluginModuleNoHsc fc fopts ue _ Nothing mod_name =
    
    302
    -  findExposedPluginPackageModule fc fopts (ue_homeUnitState ue) mod_name
    
    303 297
     
    
    304 298
     findPluginModule :: HscEnv -> ModuleName -> IO FindResult
    
    305 299
     findPluginModule hsc_env mod_name = do
    
    306 300
       let fc           = hsc_FC hsc_env
    
    307
    -      mb_home_unit = hsc_home_unit_maybe hsc_env
    
    301
    +      home_unit    = hsc_home_unit hsc_env
    
    308 302
           home_module_name_providers_map =
    
    309 303
             mgHomeModuleNameProvidersMap (hsc_mod_graph hsc_env)
    
    310 304
       findPluginModuleNoHsc fc (initFinderOpts (hsc_dflags hsc_env))
    
    311
    -    (hsc_unit_env hsc_env) home_module_name_providers_map mb_home_unit mod_name
    
    305
    +    (hsc_unit_env hsc_env) home_module_name_providers_map home_unit mod_name
    
    312 306
     
    
    313 307
     -- -----------------------------------------------------------------------------
    
    314 308
     -- Home Module Finder Helpers
    
    ... ... @@ -380,7 +374,7 @@ findHomeUnitDepModule fc ue home_module_name_providers_map scope mod_name (uid,
    380 374
         | Just real_mod_name
    
    381 375
               <- lookupUniqMap (finder_reexportedModules opts) mod_name
    
    382 376
             = findHomeOrRegularPackageModule fc opts ue home_module_name_providers_map
    
    383
    -              (Just $ DefiniteHomeUnit uid Nothing)
    
    377
    +              (DefiniteHomeUnit uid Nothing)
    
    384 378
                   scope real_mod_name
    
    385 379
         | elementOfUniqSet mod_name (finder_hiddenModules opts)
    
    386 380
         , LookupUser <- scope -- A system lookup is allowed to find hidden modules.
    
    ... ... @@ -397,27 +391,22 @@ findHomeModuleAmongDeps
    397 391
       -> FinderOpts
    
    398 392
       -> UnitEnv
    
    399 393
       -> HomeModuleNameProvidersMap
    
    400
    -  -> Maybe HomeUnit
    
    394
    +  -> HomeUnit
    
    401 395
       -> ModuleLookupScope
    
    402 396
       -> ModuleName
    
    403 397
       -> IO FindResult
    
    404
    -findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map mb_home_unit scope mod_name =
    
    398
    +findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map home_unit scope mod_name =
    
    405 399
         foldr1 orIfNotFound (home_import :| map home_pkg_import other_fopts)
    
    406 400
         -- Do not try to be smart and change this to `foldr orIfNotFound home_import
    
    407 401
         -- (map home_pkg_import other_fopts)`, as that would not be the same.
    
    408 402
         -- `home_import` is first because we need to first look within the current
    
    409 403
         -- unit before looking at the other units in order.
    
    410 404
       where
    
    411
    -    home_import = case mb_home_unit of
    
    412
    -        Just home_unit -> findHomeModule fc fopts home_unit mod_name
    
    413
    -        Nothing        -> pure $
    
    414
    -                          NoPackage (panic "findHomeModuleAmongDeps: no home-unit")
    
    405
    +    home_import = findHomeModule fc fopts home_unit mod_name
    
    406
    +
    
    415 407
         home_pkg_import = findHomeUnitDepModule fc ue home_module_name_providers_map scope mod_name
    
    416 408
     
    
    417
    -    unit_state = case homeUnitId <$> mb_home_unit of
    
    418
    -        Nothing           -> ue_homeUnitState ue
    
    419
    -        Just home_unit_id -> HUG.homeUnitEnv_units $
    
    420
    -                             ue_findHomeUnitEnv home_unit_id ue
    
    409
    +    unit_state = HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
    
    421 410
         other_fopts = homeUnitDepsFinderOpts ue home_module_name_providers_map
    
    422 411
                                              unit_state mod_name
    
    423 412
     
    
    ... ... @@ -428,33 +417,31 @@ findHomeOrRegularPackageModule
    428 417
       -> FinderOpts
    
    429 418
       -> UnitEnv
    
    430 419
       -> HomeModuleNameProvidersMap
    
    431
    -  -> Maybe HomeUnit
    
    420
    +  -> HomeUnit
    
    432 421
       -> ModuleLookupScope
    
    433 422
       -> ModuleName
    
    434 423
       -> IO FindResult
    
    435
    -findHomeOrRegularPackageModule fc fopts ue home_module_name_providers_map mb_home_unit scope mod_name =
    
    424
    +findHomeOrRegularPackageModule fc fopts ue home_module_name_providers_map home_unit scope mod_name =
    
    436 425
         findHomeModuleAmongDeps fc fopts ue home_module_name_providers_map
    
    437
    -                            mb_home_unit scope mod_name
    
    426
    +                            home_unit scope mod_name
    
    438 427
         `orIfNotFound`
    
    439 428
         findExposedPackageModule fc fopts unit_state scope mod_name NoPkgQual
    
    440 429
       where
    
    441
    -    unit_state = case homeUnitId <$> mb_home_unit of
    
    442
    -        Nothing           -> ue_homeUnitState ue
    
    443
    -        Just home_unit_id -> HUG.homeUnitEnv_units $
    
    444
    -                             ue_findHomeUnitEnv home_unit_id ue
    
    430
    +    unit_state = HUG.homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
    
    445 431
     
    
    446 432
     
    
    447 433
     -- | A version of findExactModule which takes the exact parts of the HscEnv it needs
    
    448 434
     -- directly.
    
    449
    -findExactModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IsBootInterface -> IO InstalledFindResult
    
    450
    -findExactModuleNoHsc fc fopts other_fopts unit_state mb_home_unit mod is_boot = do
    
    451
    -  res <- case mb_home_unit of
    
    452
    -    Just home_unit
    
    435
    +findExactModuleNoHsc :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> HomeUnit -> InstalledModule -> IsBootInterface -> IO InstalledFindResult
    
    436
    +findExactModuleNoHsc fc fopts other_fopts unit_state home_unit mod is_boot = do
    
    437
    +  res <-
    
    438
    +    if
    
    453 439
          | isHomeInstalledModule home_unit mod
    
    454 440
             -> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName mod)
    
    455 441
          | Just home_fopts <- HUG.unitEnv_lookup_maybe (moduleUnit mod) other_fopts
    
    456 442
             -> findInstalledHomeModule fc home_fopts (moduleUnit mod) (moduleName mod)
    
    457
    -    _ -> findPackageModule fc unit_state fopts mod
    
    443
    +     | otherwise
    
    444
    +        -> findPackageModule fc unit_state fopts mod
    
    458 445
       case (res, is_boot) of
    
    459 446
         (InstalledFound loc, IsBoot) -> return (InstalledFound (addBootSuffixLocn loc))
    
    460 447
         _ -> return res
    
    ... ... @@ -470,7 +457,7 @@ findExactModule hsc_env mod is_boot = do
    470 457
       let dflags = hsc_dflags hsc_env
    
    471 458
       let fc = hsc_FC hsc_env
    
    472 459
       let unit_state = hsc_units hsc_env
    
    473
    -  let home_unit = hsc_home_unit_maybe hsc_env
    
    460
    +  let home_unit = hsc_home_unit hsc_env
    
    474 461
       let other_fopts = initFinderOpts . homeUnitEnv_dflags <$> (hsc_HUG hsc_env)
    
    475 462
       findExactModuleNoHsc fc (initFinderOpts dflags) other_fopts unit_state home_unit mod is_boot
    
    476 463
     
    

  • compiler/GHC/Unit/Home.hs
    ... ... @@ -18,9 +18,7 @@ module GHC.Unit.Home
    18 18
        , isHomeUnitInstanceOf
    
    19 19
        , isHomeModule
    
    20 20
        , isHomeInstalledModule
    
    21
    -   , notHomeUnitId
    
    22 21
        , notHomeModule
    
    23
    -   , notHomeModuleMaybe
    
    24 22
        , notHomeInstalledModule
    
    25 23
        , notHomeInstalledModuleMaybe
    
    26 24
        -- * Helpers
    
    ... ... @@ -144,11 +142,6 @@ isHomeUnit hu u = u == homeUnitAsUnit hu
    144 142
     isHomeUnitId :: GenHomeUnit u -> UnitId -> Bool
    
    145 143
     isHomeUnitId hu uid = uid == homeUnitId hu
    
    146 144
     
    
    147
    --- | Test if the unit-id is not the home unit-id
    
    148
    -notHomeUnitId :: Maybe (GenHomeUnit u) -> UnitId -> Bool
    
    149
    -notHomeUnitId Nothing   _   = True
    
    150
    -notHomeUnitId (Just hu) uid = not (isHomeUnitId hu uid)
    
    151
    -
    
    152 145
     -- | Test if the home unit is an instance of the given unit-id
    
    153 146
     isHomeUnitInstanceOf :: HomeUnit -> UnitId -> Bool
    
    154 147
     isHomeUnitInstanceOf hu u = homeUnitInstanceOf hu == u
    
    ... ... @@ -175,10 +168,6 @@ notHomeInstalledModuleMaybe mh m = fromMaybe True $ fmap (`notHomeInstalledModul
    175 168
     notHomeModule :: HomeUnit -> Module -> Bool
    
    176 169
     notHomeModule hu m = not (isHomeModule hu m)
    
    177 170
     
    
    178
    --- | Test if a module doesn't come from the given home unit
    
    179
    -notHomeModuleMaybe :: Maybe HomeUnit -> Module -> Bool
    
    180
    -notHomeModuleMaybe mh m = fromMaybe True $ fmap (`notHomeModule` m) mh
    
    181
    -
    
    182 171
     ----------------------------
    
    183 172
     -- helpers
    
    184 173
     ----------------------------
    
    ... ... @@ -211,9 +200,8 @@ homeModuleNameInstantiation hu mod_name =
    211 200
     --       the instantiating module of @r:A@ in @p[A=q[]:B]@ is @r:A@.
    
    212 201
     --       the instantiating module of @p:A@ in @p@ is @p:A@.
    
    213 202
     --       the instantiating module of @r:A@ in @p@ is @r:A@.
    
    214
    -homeModuleInstantiation :: Maybe HomeUnit -> Module -> Module
    
    215
    -homeModuleInstantiation mhu mod
    
    216
    -   | Just hu <- mhu
    
    217
    -   , isHomeModule hu mod = homeModuleNameInstantiation hu (moduleName mod)
    
    203
    +homeModuleInstantiation :: HomeUnit -> Module -> Module
    
    204
    +homeModuleInstantiation hu mod
    
    205
    +   | isHomeModule hu mod = homeModuleNameInstantiation hu (moduleName mod)
    
    218 206
        | otherwise           = mod
    
    219 207
     

  • compiler/GHC/Unit/Home/Graph.hs
    ... ... @@ -50,6 +50,7 @@ module GHC.Unit.Home.Graph
    50 50
       -- * Utilities
    
    51 51
       , hugSCCs
    
    52 52
       , hugFromList
    
    53
    +  , hugFromHomeUnitEnvs
    
    53 54
     
    
    54 55
       -- ** Printing
    
    55 56
       , pprHomeUnitGraph
    
    ... ... @@ -150,11 +151,11 @@ data HomeUnitEnv = HomeUnitEnv
    150 151
         --
    
    151 152
         -- (This changes a previous invariant: changed Jan 05.)
    
    152 153
     
    
    153
    -  , homeUnitEnv_home_unit :: !(Maybe HomeUnit)
    
    154
    +  , homeUnitEnv_home_unit :: !HomeUnit
    
    154 155
         -- ^ Home-unit
    
    155 156
       }
    
    156 157
     
    
    157
    -mkHomeUnitEnv :: UnitState -> DynFlags -> HomePackageTable -> Maybe HomeUnit -> HomeUnitEnv
    
    158
    +mkHomeUnitEnv :: UnitState -> DynFlags -> HomePackageTable -> HomeUnit -> HomeUnitEnv
    
    158 159
     mkHomeUnitEnv us dflags hpt home_unit = HomeUnitEnv
    
    159 160
       { homeUnitEnv_units = us
    
    160 161
       , homeUnitEnv_dflags = dflags
    
    ... ... @@ -363,6 +364,9 @@ hugSCCs hug = sccs where
    363 364
     hugFromList :: [(UnitId, HomeUnitEnv)] -> HomeUnitGraph
    
    364 365
     hugFromList = UnitEnvGraph . Map.fromList
    
    365 366
     
    
    367
    +hugFromHomeUnitEnvs :: [HomeUnitEnv] -> HomeUnitGraph
    
    368
    +hugFromHomeUnitEnvs = hugFromList . fmap (\hue -> (homeUnitId $ homeUnitEnv_home_unit hue, hue))
    
    369
    +
    
    366 370
     pprHomeUnitGraph :: HomeUnitGraph -> IO SDoc
    
    367 371
     pprHomeUnitGraph unitEnv = do
    
    368 372
       docs <- mapM (\(k, v) -> pprHomeUnitEnv k v) $ Map.assocs $ unitEnv_graph unitEnv
    
    ... ... @@ -372,6 +376,6 @@ pprHomeUnitEnv :: UnitId -> HomeUnitEnv -> IO SDoc
    372 376
     pprHomeUnitEnv uid env = do
    
    373 377
       hptDoc <- pprHPT $ homeUnitEnv_hpt env
    
    374 378
       return $
    
    375
    -    ppr uid <+> text "(flags:" <+> ppr (homeUnitId_ $ homeUnitEnv_dflags env) <> text "," <+> ppr (fmap homeUnitId $ homeUnitEnv_home_unit env) <> text ")" <+> text "->"
    
    379
    +    ppr uid <+> text "(flags:" <+> ppr (homeUnitId_ $ homeUnitEnv_dflags env) <> text "," <+> ppr (homeUnitId $ homeUnitEnv_home_unit env) <> text ")" <+> text "->"
    
    376 380
         $$ nest 4 hptDoc
    
    377 381
     

  • ghc/GHCi/UI.hs
    ... ... @@ -861,7 +861,7 @@ installInteractiveHomeUnits dflags = do
    861 861
           (unit_state,home_unit,_mconstants) <-
    
    862 862
             liftIO $ initUnits logger dflags unit_index all_home_units
    
    863 863
           hpt <- liftIO emptyHomePackageTable
    
    864
    -      pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit))
    
    864
    +      pure (HUG.mkHomeUnitEnv unit_state dflags hpt home_unit)
    
    865 865
     
    
    866 866
         concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
    
    867 867
         concatPackageDbStacksUsingLongestCommonPrefix stacks =