Hannes Siebenhandl pushed to branch wip/fendor/drop-preloadclosure-from-unitstate at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • changelog.d/T27308
    1
    +section: compiler
    
    2
    +synopsis: Drop `preloadClosure` from `UnitState`
    
    3
    +issues: #27308
    
    4
    +mrs: !16108
    
    5
    +
    
    6
    +description: {
    
    7
    +    Drop `preloadClosure` from `UnitState` as it is always set to the empty set.
    
    8
    +    This allows to simplify the `UnitState` and related functions.
    
    9
    +}
    
    10
    +

  • compiler/GHC/Driver/Backpack.hs
    ... ... @@ -241,7 +241,6 @@ withBkpSession cid insts deps session_type do_this = do
    241 241
                 -- Synthesize the flags
    
    242 242
                 , packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
    
    243 243
                   let uid = unwireUnit unit_state
    
    244
    -                        $ improveUnit unit_state
    
    245 244
                             $ renameHoleUnit unit_state (listToUFM insts) uid0
    
    246 245
                   in ExposePackage
    
    247 246
                     (showSDoc dflags
    
    ... ... @@ -310,19 +309,16 @@ buildUnit session cid insts lunit = do
    310 309
         -- The compilation dependencies are just the appropriately filled
    
    311 310
         -- in unit IDs which must be compiled before we can compile.
    
    312 311
         let hsubst = listToUFM insts
    
    313
    -        deps0 = map (renameHoleUnit (hsc_units hsc_env) hsubst) raw_deps
    
    312
    +        deps = map (renameHoleUnit (hsc_units hsc_env) hsubst) raw_deps
    
    314 313
     
    
    315 314
         -- Build dependencies OR make sure they make sense. BUT NOTE,
    
    316 315
         -- we can only check the ones that are fully filled; the rest
    
    317 316
         -- we have to defer until we've typechecked our local signature.
    
    318 317
         -- TODO: work this into GHC.Driver.Make!!
    
    319
    -    forM_ (zip [1..] deps0) $ \(i, dep) ->
    
    318
    +    forM_ (zip [1..] deps) $ \(i, dep) ->
    
    320 319
             case session of
    
    321 320
                 TcSession -> return ()
    
    322
    -            _ -> compileInclude (length deps0) (i, dep)
    
    323
    -
    
    324
    -    -- IMPROVE IT
    
    325
    -    let deps = map (improveUnit (hsc_units hsc_env)) deps0
    
    321
    +            _ -> compileInclude (length deps) (i, dep)
    
    326 322
     
    
    327 323
         mb_old_eps <- case session of
    
    328 324
                         TcSession -> fmap Just getEpsGhc
    

  • compiler/GHC/Iface/Load.hs
    ... ... @@ -914,13 +914,13 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    914 914
                   && not (isOneShot (ghcMode dflags))
    
    915 915
                 then return (Failed (HomeModError mod loc))
    
    916 916
                 else do
    
    917
    -                r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
    
    917
    +                r <- read_file hooks logger name_cache dflags wanted_mod (ml_hi_file loc)
    
    918 918
                     case r of
    
    919 919
                       Failed err
    
    920 920
                         -> return (Failed $ BadIfaceFile err)
    
    921 921
                       Succeeded (iface,_fp)
    
    922 922
                         -> do
    
    923
    -                        r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state
    
    923
    +                        r2 <- load_dynamic_too_maybe hooks logger name_cache
    
    924 924
                                                      (setDynamicNow dflags) wanted_mod
    
    925 925
                                                      iface loc
    
    926 926
                             case r2 of
    
    ... ... @@ -936,20 +936,20 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
    936 936
                                   err
    
    937 937
     
    
    938 938
     -- | Check if we need to try the dynamic interface for -dynamic-too
    
    939
    -load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    
    939
    +load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> DynFlags
    
    940 940
                            -> Module -> ModIface -> ModLocation
    
    941 941
                            -> IO (MaybeErr MissingInterfaceError ())
    
    942
    -load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc
    
    942
    +load_dynamic_too_maybe hooks logger name_cache dflags wanted_mod iface loc
    
    943 943
       -- Indefinite interfaces are ALWAYS non-dynamic.
    
    944 944
       | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
    
    945
    -  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc
    
    945
    +  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache dflags wanted_mod iface loc
    
    946 946
       | otherwise = return (Succeeded ())
    
    947 947
     
    
    948
    -load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    
    948
    +load_dynamic_too :: Hooks -> Logger -> NameCache -> DynFlags
    
    949 949
                      -> Module -> ModIface -> ModLocation
    
    950 950
                      -> IO (MaybeErr MissingInterfaceError ())
    
    951
    -load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do
    
    952
    -  read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
    
    951
    +load_dynamic_too hooks logger name_cache dflags wanted_mod iface loc = do
    
    952
    +  read_file hooks logger name_cache dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
    
    953 953
         Succeeded (dynIface, _)
    
    954 954
          | mi_mod_hash iface == mi_mod_hash dynIface
    
    955 955
          -> return (Succeeded ())
    
    ... ... @@ -963,10 +963,10 @@ load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc
    963 963
     
    
    964 964
     
    
    965 965
     
    
    966
    -read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
    
    966
    +read_file :: Hooks -> Logger -> NameCache -> DynFlags
    
    967 967
               -> Module -> FilePath
    
    968 968
               -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
    
    969
    -read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do
    
    969
    +read_file hooks logger name_cache dflags wanted_mod file_path = do
    
    970 970
     
    
    971 971
       -- Figure out what is recorded in mi_module.  If this is
    
    972 972
       -- a fully definite interface, it'll match exactly, but
    
    ... ... @@ -975,7 +975,7 @@ read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do
    975 975
             case getModuleInstantiation wanted_mod of
    
    976 976
                 (_, Nothing) -> wanted_mod
    
    977 977
                 (_, Just indef_mod) ->
    
    978
    -              instModuleToModule unit_state
    
    978
    +              instModuleToModule
    
    979 979
                     (uninstantiateInstantiatedModule indef_mod)
    
    980 980
       read_result <- readIface hooks logger dflags name_cache wanted_mod' file_path
    
    981 981
       case read_result of
    

  • compiler/GHC/Iface/Recomp.hs
    ... ... @@ -620,7 +620,7 @@ checkMergedSignatures hsc_env mod_summary self_recomp = do
    620 620
             new_merged = case lookupUniqMap (requirementContext unit_state)
    
    621 621
                               (ms_mod_name mod_summary) of
    
    622 622
                             Nothing -> []
    
    623
    -                        Just r -> sort $ map (instModuleToModule unit_state) r
    
    623
    +                        Just r -> sort $ map instModuleToModule r
    
    624 624
         if old_merged == new_merged
    
    625 625
             then up_to_date logger (text "signatures to merge in unchanged" $$ ppr new_merged)
    
    626 626
             else return $ needsRecompileBecause SigsMergeChanged
    

  • compiler/GHC/Unit.hs
    ... ... @@ -314,32 +314,6 @@ field in the SDocContext to pretty-print.
    314 314
           (i.e. GHC doesn't correctly call `pprWithUnitState` before pretty-printing a
    
    315 315
           UnitId), that's what will be shown to the user so it's no big deal.
    
    316 316
     
    
    317
    -
    
    318
    -Note [VirtUnit to RealUnit improvement]
    
    319
    -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    320
    -
    
    321
    -Over the course of instantiating VirtUnits on the fly while typechecking an
    
    322
    -indefinite library, we may end up with a fully instantiated VirtUnit. I.e.
    
    323
    -one that could be compiled and installed in the database. During
    
    324
    -type-checking we generate a virtual UnitId for it, say "abc".
    
    325
    -
    
    326
    -Now the question is: do we have a matching installed unit in the database?
    
    327
    -Suppose we have one with UnitId "xyz" (provided by Cabal so we don't know how
    
    328
    -to generate it). The trouble is that if both units end up being used in the
    
    329
    -same type-checking session, their names won't match (e.g. "abc:M.X" vs
    
    330
    -"xyz:M.X").
    
    331
    -
    
    332
    -As we want them to match we just replace the virtual unit with the installed
    
    333
    -one: for some reason this is called "improvement".
    
    334
    -
    
    335
    -There is one last niggle: improvement based on the unit database means
    
    336
    -that we might end up developing on a unit that is not transitively
    
    337
    -depended upon by the units the user specified directly via command line
    
    338
    -flags.  This could lead to strange and difficult to understand bugs if those
    
    339
    -instantiations are out of date.  The solution is to only improve a
    
    340
    -unit id if the new unit id is part of the 'preloadClosure'; i.e., the
    
    341
    -closure of all the units which were explicitly specified.
    
    342
    -
    
    343 317
     Note [Representation of module/name variables]
    
    344 318
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    345 319
     In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
    

  • compiler/GHC/Unit/State.hs
    ... ... @@ -7,7 +7,6 @@ module GHC.Unit.State (
    7 7
     
    
    8 8
             -- * Reading the package config, and processing cmdline args
    
    9 9
             UnitState(..),
    
    10
    -        PreloadUnitClosure,
    
    11 10
             UnitDatabase (..),
    
    12 11
             UnitErr (..),
    
    13 12
             emptyUnitState,
    
    ... ... @@ -29,7 +28,6 @@ module GHC.Unit.State (
    29 28
     
    
    30 29
             lookupPackageName,
    
    31 30
             resolvePackageImport,
    
    32
    -        improveUnit,
    
    33 31
             searchPackageId,
    
    34 32
             listVisibleModuleNames,
    
    35 33
             lookupModuleInAllUnits,
    
    ... ... @@ -89,7 +87,6 @@ import GHC.Unit.Home
    89 87
     
    
    90 88
     import GHC.Types.Unique.FM
    
    91 89
     import GHC.Types.Unique.DFM
    
    92
    -import GHC.Types.Unique.Set
    
    93 90
     import GHC.Types.Unique.DSet
    
    94 91
     import GHC.Types.Unique.Map
    
    95 92
     import GHC.Types.Unique
    
    ... ... @@ -267,8 +264,6 @@ originEmpty :: ModuleOrigin -> Bool
    267 264
     originEmpty (ModOrigin Nothing [] [] False) = True
    
    268 265
     originEmpty _ = False
    
    269 266
     
    
    270
    -type PreloadUnitClosure = UniqSet UnitId
    
    271
    -
    
    272 267
     -- | 'UniqFM' map from 'Unit' to a 'UnitVisibility'.
    
    273 268
     type VisibilityMap = UniqMap Unit UnitVisibility
    
    274 269
     
    
    ... ... @@ -431,13 +426,6 @@ data UnitState = UnitState {
    431 426
       -- may have the 'exposed' flag be 'False'.)
    
    432 427
       unitInfoMap :: UnitInfoMap,
    
    433 428
     
    
    434
    -  -- | The set of transitively reachable units according
    
    435
    -  -- to the explicitly provided command line arguments.
    
    436
    -  -- A fully instantiated VirtUnit may only be replaced by a RealUnit from
    
    437
    -  -- this set.
    
    438
    -  -- See Note [VirtUnit to RealUnit improvement]
    
    439
    -  preloadClosure :: PreloadUnitClosure,
    
    440
    -
    
    441 429
       -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same
    
    442 430
       -- package name (e.g. different instantiations), then we return one of them...
    
    443 431
       -- This is used when users refer to packages in Backpack includes.
    
    ... ... @@ -490,7 +478,6 @@ data UnitState = UnitState {
    490 478
     emptyUnitState :: UnitState
    
    491 479
     emptyUnitState = UnitState {
    
    492 480
         unitInfoMap    = emptyUniqMap,
    
    493
    -    preloadClosure = emptyUniqSet,
    
    494 481
         packageNameMap = emptyUFM,
    
    495 482
         wireMap        = emptyUniqMap,
    
    496 483
         unwireMap      = emptyUniqMap,
    
    ... ... @@ -516,7 +503,7 @@ type UnitInfoMap = UniqMap UnitId UnitInfo
    516 503
     
    
    517 504
     -- | Find the unit we know about with the given unit, if any
    
    518 505
     lookupUnit :: UnitState -> Unit -> Maybe UnitInfo
    
    519
    -lookupUnit pkgs = lookupUnit' (allowVirtualUnits pkgs) (unitInfoMap pkgs) (preloadClosure pkgs)
    
    506
    +lookupUnit pkgs = lookupUnit' (allowVirtualUnits pkgs) (unitInfoMap pkgs)
    
    520 507
     
    
    521 508
     -- | A more specialized interface, which doesn't require a 'UnitState' (so it
    
    522 509
     -- can be used while we're initializing 'DynFlags')
    
    ... ... @@ -524,16 +511,15 @@ lookupUnit pkgs = lookupUnit' (allowVirtualUnits pkgs) (unitInfoMap pkgs) (prelo
    524 511
     -- Parameters:
    
    525 512
     --    * a boolean specifying whether or not to look for on-the-fly renamed interfaces
    
    526 513
     --    * a 'UnitInfoMap'
    
    527
    ---    * a 'PreloadUnitClosure'
    
    528
    -lookupUnit' :: Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo
    
    529
    -lookupUnit' allowOnTheFlyInst pkg_map closure u = case u of
    
    514
    +lookupUnit' :: Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
    
    515
    +lookupUnit' allowOnTheFlyInst pkg_map u = case u of
    
    530 516
        HoleUnit   -> error "Hole unit"
    
    531 517
        RealUnit i -> lookupUniqMap pkg_map (unDefinite i)
    
    532 518
        VirtUnit i
    
    533 519
           | allowOnTheFlyInst
    
    534 520
           -> -- lookup UnitInfo of the indefinite unit to be instantiated and
    
    535 521
              -- instantiate it on-the-fly
    
    536
    -         fmap (renameUnitInfo pkg_map closure (instUnitInsts i))
    
    522
    +         fmap (renameUnitInfo pkg_map (instUnitInsts i))
    
    537 523
                (lookupUniqMap pkg_map (instUnitInstanceOf i))
    
    538 524
     
    
    539 525
           | otherwise
    
    ... ... @@ -907,7 +893,6 @@ applyTrustFlag prec_map unusable pkgs flag =
    907 893
     applyPackageFlag
    
    908 894
        :: UnitPrecedenceMap
    
    909 895
        -> UnitInfoMap
    
    910
    -   -> PreloadUnitClosure
    
    911 896
        -> UnusableUnits
    
    912 897
        -> Bool -- if False, if you expose a package, it implicitly hides
    
    913 898
                -- any previously exposed packages with the same name
    
    ... ... @@ -916,10 +901,10 @@ applyPackageFlag
    916 901
        -> PackageFlag             -- flag to apply
    
    917 902
        -> MaybeErr UnitErr VisibilityMap -- Now exposed
    
    918 903
     
    
    919
    -applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
    
    904
    +applyPackageFlag prec_map pkg_map unusable no_hide_others pkgs vm flag =
    
    920 905
       case flag of
    
    921 906
         ExposePackage _ arg (ModRenaming b rns) ->
    
    922
    -       case findPackages prec_map pkg_map closure arg pkgs unusable of
    
    907
    +       case findPackages prec_map pkg_map arg pkgs unusable of
    
    923 908
              Left ps     -> Failed (PackageFlagErr flag ps)
    
    924 909
              Right (p:_) -> Succeeded vm'
    
    925 910
               where
    
    ... ... @@ -983,7 +968,7 @@ applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
    983 968
              _ -> panic "applyPackageFlag"
    
    984 969
     
    
    985 970
         HidePackage str ->
    
    986
    -       case findPackages prec_map pkg_map closure (PackageArg str) pkgs unusable of
    
    971
    +       case findPackages prec_map pkg_map (PackageArg str) pkgs unusable of
    
    987 972
              Left ps  -> Failed (PackageFlagErr flag ps)
    
    988 973
              Right ps -> Succeeded $ foldl' delFromUniqMap vm (map mkUnit ps)
    
    989 974
     
    
    ... ... @@ -992,12 +977,11 @@ applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
    992 977
     -- if the 'UnitArg' has a renaming associated with it.
    
    993 978
     findPackages :: UnitPrecedenceMap
    
    994 979
                  -> UnitInfoMap
    
    995
    -             -> PreloadUnitClosure
    
    996 980
                  -> PackageArg -> [UnitInfo]
    
    997 981
                  -> UnusableUnits
    
    998 982
                  -> Either [(UnitInfo, UnusableUnitReason)]
    
    999 983
                     [UnitInfo]
    
    1000
    -findPackages prec_map pkg_map closure arg pkgs unusable
    
    984
    +findPackages prec_map pkg_map arg pkgs unusable
    
    1001 985
       = let ps = mapMaybe (finder arg) pkgs
    
    1002 986
         in if null ps
    
    1003 987
             then Left (mapMaybe (\(x,y) -> finder arg x >>= \x' -> return (x',y))
    
    ... ... @@ -1015,7 +999,7 @@ findPackages prec_map pkg_map closure arg pkgs unusable
    1015 999
                 -> Just p
    
    1016 1000
               VirtUnit inst
    
    1017 1001
                 | instUnitInstanceOf inst == unitId p
    
    1018
    -            -> Just (renameUnitInfo pkg_map closure (instUnitInsts inst) p)
    
    1002
    +            -> Just (renameUnitInfo pkg_map (instUnitInsts inst) p)
    
    1019 1003
               _ -> Nothing
    
    1020 1004
     
    
    1021 1005
     selectPackages :: UnitPrecedenceMap -> PackageArg -> [UnitInfo]
    
    ... ... @@ -1030,10 +1014,10 @@ selectPackages prec_map arg pkgs unusable
    1030 1014
             else Right (sortByPreference prec_map ps, rest)
    
    1031 1015
     
    
    1032 1016
     -- | Rename a 'UnitInfo' according to some module instantiation.
    
    1033
    -renameUnitInfo :: UnitInfoMap -> PreloadUnitClosure -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
    
    1034
    -renameUnitInfo pkg_map closure insts conf =
    
    1017
    +renameUnitInfo :: UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
    
    1018
    +renameUnitInfo pkg_map insts conf =
    
    1035 1019
         let hsubst = listToUFM insts
    
    1036
    -        smod  = renameHoleModule' pkg_map closure hsubst
    
    1020
    +        smod  = renameHoleModule' pkg_map hsubst
    
    1037 1021
             new_insts = map (\(k,v) -> (k,smod v)) (unitInstantiations conf)
    
    1038 1022
         in conf {
    
    1039 1023
             unitInstantiations = new_insts,
    
    ... ... @@ -1631,7 +1615,7 @@ mkUnitState logger cfg = do
    1631 1615
       -- user tries to enable an unusable package, we should let them know.
    
    1632 1616
       --
    
    1633 1617
       vis_map2 <- mayThrowUnitErr
    
    1634
    -                $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
    
    1618
    +                $ foldM (applyPackageFlag prec_map prelim_pkg_db unusable
    
    1635 1619
                             (unitConfigHideAll cfg) pkgs1)
    
    1636 1620
                                 vis_map1 other_flags
    
    1637 1621
     
    
    ... ... @@ -1660,7 +1644,7 @@ mkUnitState logger cfg = do
    1660 1644
                             | otherwise = vis_map2
    
    1661 1645
                     plugin_vis_map2
    
    1662 1646
                         <- mayThrowUnitErr
    
    1663
    -                        $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
    
    1647
    +                        $ foldM (applyPackageFlag prec_map prelim_pkg_db unusable
    
    1664 1648
                                     hide_plugin_pkgs pkgs1)
    
    1665 1649
                                  plugin_vis_map1
    
    1666 1650
                                  (reverse (unitConfigFlagsPlugins cfg))
    
    ... ... @@ -1712,7 +1696,7 @@ mkUnitState logger cfg = do
    1712 1696
                         $ closeUnitDeps pkg_db
    
    1713 1697
                         $ zip (map toUnitId preload3) (repeat Nothing)
    
    1714 1698
     
    
    1715
    -  let mod_map1 = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet vis_map
    
    1699
    +  let mod_map1 = mkModuleNameProvidersMap logger cfg pkg_db vis_map
    
    1716 1700
           mod_map2 = mkUnusableModuleNameProvidersMap unusable
    
    1717 1701
           mod_map = mod_map2 `plusUniqMap` mod_map1
    
    1718 1702
     
    
    ... ... @@ -1722,9 +1706,8 @@ mkUnitState logger cfg = do
    1722 1706
              , explicitUnits                = explicit_pkgs
    
    1723 1707
              , homeUnitDepends              = home_unit_deps
    
    1724 1708
              , unitInfoMap                  = pkg_db
    
    1725
    -         , preloadClosure               = emptyUniqSet
    
    1726 1709
              , moduleNameProvidersMap       = mod_map
    
    1727
    -         , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db emptyUniqSet plugin_vis_map
    
    1710
    +         , pluginModuleNameProvidersMap = mkModuleNameProvidersMap logger cfg pkg_db plugin_vis_map
    
    1728 1711
              , packageNameMap               = pkgname_map
    
    1729 1712
              , wireMap                      = wired_map
    
    1730 1713
              , unwireMap                    = listToUniqMap [ (v,k) | (k,v) <- nonDetUniqMapToList wired_map ]
    
    ... ... @@ -1764,10 +1747,9 @@ mkModuleNameProvidersMap
    1764 1747
       :: Logger
    
    1765 1748
       -> UnitConfig
    
    1766 1749
       -> UnitInfoMap
    
    1767
    -  -> PreloadUnitClosure
    
    1768 1750
       -> VisibilityMap
    
    1769 1751
       -> ModuleNameProvidersMap
    
    1770
    -mkModuleNameProvidersMap logger cfg pkg_map closure vis_map =
    
    1752
    +mkModuleNameProvidersMap logger cfg pkg_map vis_map =
    
    1771 1753
         -- What should we fold on?  Both situations are awkward:
    
    1772 1754
         --
    
    1773 1755
         --    * Folding on the visibility map means that we won't create
    
    ... ... @@ -1839,7 +1821,7 @@ mkModuleNameProvidersMap logger cfg pkg_map closure vis_map =
    1839 1821
         hiddens = [(m, mkModMap pk m ModHidden) | m <- hidden_mods]
    
    1840 1822
     
    
    1841 1823
         pk = mkUnit pkg
    
    1842
    -    unit_lookup uid = lookupUnit' (unitConfigAllowVirtual cfg) pkg_map closure uid
    
    1824
    +    unit_lookup uid = lookupUnit' (unitConfigAllowVirtual cfg) pkg_map uid
    
    1843 1825
                             `orElse` pprPanic "unit_lookup" (ppr uid)
    
    1844 1826
     
    
    1845 1827
         exposed_mods = unitExposedModules pkg
    
    ... ... @@ -2190,44 +2172,16 @@ fsPackageName info = fs
    2190 2172
        where
    
    2191 2173
           PackageName fs = unitPackageName info
    
    2192 2174
     
    
    2193
    -
    
    2194
    --- | Given a fully instantiated 'InstantiatedUnit', improve it into a
    
    2195
    --- 'RealUnit' if we can find it in the package database.
    
    2196
    -improveUnit :: UnitState -> Unit -> Unit
    
    2197
    -improveUnit state u = improveUnit' (unitInfoMap state) (preloadClosure state) u
    
    2198
    -
    
    2199
    --- | Given a fully instantiated 'InstantiatedUnit', improve it into a
    
    2200
    --- 'RealUnit' if we can find it in the package database.
    
    2201
    -improveUnit' :: UnitInfoMap -> PreloadUnitClosure -> Unit -> Unit
    
    2202
    -improveUnit' _       _       uid@(RealUnit _) = uid -- short circuit
    
    2203
    -improveUnit' pkg_map closure uid =
    
    2204
    -    -- Do NOT lookup indefinite ones, they won't be useful!
    
    2205
    -    case lookupUnit' False pkg_map closure uid of
    
    2206
    -        Nothing  -> uid
    
    2207
    -        Just pkg ->
    
    2208
    -            -- Do NOT improve if the indefinite unit id is not
    
    2209
    -            -- part of the closure unique set.  See
    
    2210
    -            -- Note [VirtUnit to RealUnit improvement]
    
    2211
    -            if unitId pkg `elementOfUniqSet` closure
    
    2212
    -                then mkUnit pkg
    
    2213
    -                else uid
    
    2214
    -
    
    2215
    --- | Check the database to see if we already have an installed unit that
    
    2216
    --- corresponds to the given 'InstantiatedUnit'.
    
    2217
    ---
    
    2218
    --- Return a `UnitId` which either wraps the `InstantiatedUnit` unchanged or
    
    2219
    --- references a matching installed unit.
    
    2220
    ---
    
    2221
    --- See Note [VirtUnit to RealUnit improvement]
    
    2222
    -instUnitToUnit :: UnitState -> InstantiatedUnit -> Unit
    
    2223
    -instUnitToUnit state iuid =
    
    2175
    +-- | Return a `UnitId` which either wraps the `InstantiatedUnit` unchanged.
    
    2176
    +instUnitToUnit :: InstantiatedUnit -> Unit
    
    2177
    +instUnitToUnit iuid =
    
    2224 2178
         -- NB: suppose that we want to compare the instantiated
    
    2225 2179
         -- unit p[H=impl:H] against p+abcd (where p+abcd
    
    2226 2180
         -- happens to be the existing, installed version of
    
    2227 2181
         -- p[H=impl:H].  If we *only* wrap in p[H=impl:H]
    
    2228 2182
         -- VirtUnit, they won't compare equal; only
    
    2229 2183
         -- after improvement will the equality hold.
    
    2230
    -    improveUnit state $ VirtUnit iuid
    
    2184
    +    VirtUnit iuid
    
    2231 2185
     
    
    2232 2186
     
    
    2233 2187
     -- | Substitution on module variables, mapping module names to module
    
    ... ... @@ -2239,30 +2193,30 @@ type ShHoleSubst = ModuleNameEnv Module
    2239 2193
     -- @p[A=\<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
    
    2240 2194
     -- similarly, @\<A>@ maps to @q():A@.
    
    2241 2195
     renameHoleModule :: UnitState -> ShHoleSubst -> Module -> Module
    
    2242
    -renameHoleModule state = renameHoleModule' (unitInfoMap state) (preloadClosure state)
    
    2196
    +renameHoleModule state = renameHoleModule' (unitInfoMap state)
    
    2243 2197
     
    
    2244 2198
     -- | Substitutes holes in a 'Unit', suitable for renaming when
    
    2245 2199
     -- an include occurs; see Note [Representation of module/name variables].
    
    2246 2200
     --
    
    2247 2201
     -- @p[A=\<A>]@ maps to @p[A=\<B>]@ with @A=\<B>@.
    
    2248 2202
     renameHoleUnit :: UnitState -> ShHoleSubst -> Unit -> Unit
    
    2249
    -renameHoleUnit state = renameHoleUnit' (unitInfoMap state) (preloadClosure state)
    
    2203
    +renameHoleUnit state = renameHoleUnit' (unitInfoMap state)
    
    2250 2204
     
    
    2251
    --- | Like 'renameHoleModule', but requires only 'ClosureUnitInfoMap'
    
    2205
    +-- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
    
    2252 2206
     -- so it can be used by "GHC.Unit.State".
    
    2253
    -renameHoleModule' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Module -> Module
    
    2254
    -renameHoleModule' pkg_map closure env m
    
    2207
    +renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
    
    2208
    +renameHoleModule' pkg_map env m
    
    2255 2209
       | not (isHoleModule m) =
    
    2256
    -        let uid = renameHoleUnit' pkg_map closure env (moduleUnit m)
    
    2210
    +        let uid = renameHoleUnit' pkg_map env (moduleUnit m)
    
    2257 2211
             in mkModule uid (moduleName m)
    
    2258 2212
       | Just m' <- lookupUFM env (moduleName m) = m'
    
    2259 2213
       -- NB m = <Blah>, that's what's in scope.
    
    2260 2214
       | otherwise = m
    
    2261 2215
     
    
    2262
    --- | Like 'renameHoleUnit, but requires only 'ClosureUnitInfoMap'
    
    2216
    +-- | Like 'renameHoleUnit', but requires only 'UnitInfoMap'
    
    2263 2217
     -- so it can be used by "GHC.Unit.State".
    
    2264
    -renameHoleUnit' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Unit -> Unit
    
    2265
    -renameHoleUnit' pkg_map closure env uid =
    
    2218
    +renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
    
    2219
    +renameHoleUnit' pkg_map env uid =
    
    2266 2220
         case uid of
    
    2267 2221
           (VirtUnit
    
    2268 2222
             InstantiatedUnit{ instUnitInstanceOf = cid
    
    ... ... @@ -2270,20 +2224,15 @@ renameHoleUnit' pkg_map closure env uid =
    2270 2224
                             , instUnitHoles      = fh })
    
    2271 2225
               -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
    
    2272 2226
                     then uid
    
    2273
    -                -- Functorially apply the substitution to the instantiation,
    
    2274
    -                -- then check the 'ClosureUnitInfoMap' to see if there is
    
    2275
    -                -- a compiled version of this 'InstantiatedUnit' we can improve to.
    
    2276
    -                -- See Note [VirtUnit to RealUnit improvement]
    
    2277
    -                else improveUnit' pkg_map closure $
    
    2278
    -                        mkVirtUnit cid
    
    2279
    -                            (map (\(k,v) -> (k, renameHoleModule' pkg_map closure env v)) insts)
    
    2227
    +                else mkVirtUnit cid
    
    2228
    +                          (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
    
    2280 2229
           _ -> uid
    
    2281 2230
     
    
    2282 2231
     -- | Injects an 'InstantiatedModule' to 'Module' (see also
    
    2283 2232
     -- 'instUnitToUnit'.
    
    2284
    -instModuleToModule :: UnitState -> InstantiatedModule -> Module
    
    2285
    -instModuleToModule pkgstate (Module iuid mod_name) =
    
    2286
    -    mkModule (instUnitToUnit pkgstate iuid) mod_name
    
    2233
    +instModuleToModule :: InstantiatedModule -> Module
    
    2234
    +instModuleToModule (Module iuid mod_name) =
    
    2235
    +    mkModule (instUnitToUnit iuid) mod_name
    
    2287 2236
     
    
    2288 2237
     -- | Print unit-ids with UnitInfo found in the given UnitState
    
    2289 2238
     pprWithUnitState :: UnitState -> SDoc -> SDoc
    

  • compiler/GHC/Unit/Types.hs
    ... ... @@ -250,9 +250,7 @@ data GenUnit uid
    250 250
     --
    
    251 251
     -- This unit may be indefinite or not (i.e. with remaining holes or not). If it
    
    252 252
     -- is definite, we don't know if it has already been compiled and installed in a
    
    253
    --- database. Nevertheless, we have a mechanism called "improvement" to try to
    
    254
    --- match a fully instantiated unit with existing compiled and installed units:
    
    255
    --- see Note [VirtUnit to RealUnit improvement].
    
    253
    +-- database.
    
    256 254
     --
    
    257 255
     -- An indefinite unit identifier pretty-prints to something like
    
    258 256
     -- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'UnitId', and the