diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-05-18 11:34:32 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-13 02:13:03 -0400 |
| commit | 266bc3d9c3735620598ab18ff6ac9c44134cbbff (patch) | |
| tree | f3a45d334ace92690dd42fed20ce4b983686d9db | |
| parent | 9400aa934880695b83201e192998de2576cfdf92 (diff) | |
| download | haskell-266bc3d9c3735620598ab18ff6ac9c44134cbbff.tar.gz | |
DynFlags: refactor unwireUnit
| -rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 12 | ||||
| -rw-r--r-- | compiler/GHC/Unit/State.hs | 6 |
3 files changed, 12 insertions, 11 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 658750b1c9..95005b405e 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -195,7 +195,7 @@ withBkpSession cid insts deps session_type do_this = do -- Synthesized the flags packageFlags = packageFlags dflags ++ map (\(uid0, rn) -> let state = unitState dflags - uid = unwireUnit dflags (improveUnit state $ renameHoleUnit state (listToUFM insts) uid0) + uid = unwireUnit state (improveUnit state $ renameHoleUnit state (listToUFM insts) uid0) in ExposePackage (showSDoc dflags (text "-unit-id" <+> ppr uid <+> ppr rn)) @@ -306,6 +306,7 @@ buildUnit session cid insts lunit = do $ home_mod_infos getOfiles (LM _ _ us) = map nameOfObject (filter isObject us) obj_files = concatMap getOfiles linkables + state = unitState (hsc_dflags hsc_env) let compat_fs = unitIdFS (indefUnit cid) compat_pn = PackageName compat_fs @@ -330,7 +331,7 @@ buildUnit session cid insts lunit = do -- really used for anything, so we leave it -- blank for now. TcSession -> [] - _ -> map (toUnitId . unwireUnit dflags) + _ -> map (toUnitId . unwireUnit state) $ deps ++ [ moduleUnit mod | (_, mod) <- insts , not (isHoleModule mod) ], diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index a9b93dbe44..ed3dffe512 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -320,7 +320,7 @@ warnUnusedPackages = do requestedArgs = mapMaybe packageArg (packageFlags dflags) unusedArgs - = filter (\arg -> not $ any (matching dflags arg) loadedPackages) + = filter (\arg -> not $ any (matching state arg) loadedPackages) requestedArgs let warn = makeIntoWarning @@ -348,15 +348,15 @@ warnUnusedPackages = do = str == unitPackageIdString p || str == unitPackageNameString p - matching :: DynFlags -> PackageArg -> UnitInfo -> Bool + matching :: UnitState -> PackageArg -> UnitInfo -> Bool matching _ (PackageArg str) p = matchingStr str p - matching dflags (UnitIdArg uid) p = uid == realUnit dflags p + matching state (UnitIdArg uid) p = uid == realUnit state p -- For wired-in packages, we have to unwire their id, -- otherwise they won't match package flags - realUnit :: DynFlags -> UnitInfo -> Unit - realUnit dflags - = unwireUnit dflags + realUnit :: UnitState -> UnitInfo -> Unit + realUnit state + = unwireUnit state . RealUnit . Definite . unitId diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index d1107bcc7b..65acf20cd4 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -1616,9 +1616,9 @@ mkUnitState dflags dbs = do -- | Given a wired-in 'Unit', "unwire" it into the 'Unit' -- that it was recorded as in the package database. -unwireUnit :: DynFlags -> Unit-> Unit -unwireUnit dflags uid@(RealUnit (Definite def_uid)) = - maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap (unitState dflags))) +unwireUnit :: UnitState -> Unit-> Unit +unwireUnit state uid@(RealUnit (Definite def_uid)) = + maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap state)) unwireUnit _ uid = uid -- ----------------------------------------------------------------------------- |