Commit c889df86 authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Packages: Kill unused UnitId argument to isDllName

Test Plan: Validate

Reviewers: austin, simonmar

Subscribers: thomie, ezyang

Differential Revision: https://phabricator.haskell.org/D2866
parent 13c1fc4d
...@@ -952,7 +952,7 @@ labelDynamic dflags this_pkg this_mod lbl = ...@@ -952,7 +952,7 @@ labelDynamic dflags this_pkg this_mod lbl =
-- is the RTS in a DLL or not? -- is the RTS in a DLL or not?
RtsLabel _ -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId) RtsLabel _ -> (WayDyn `elem` ways dflags) && (this_pkg /= rtsUnitId)
IdLabel n _ _ -> isDllName dflags this_pkg this_mod n IdLabel n _ _ -> isDllName dflags this_mod n
-- When compiling in the "dyn" way, each package is to be linked into -- When compiling in the "dyn" way, each package is to be linked into
-- its own shared library. -- its own shared library.
......
...@@ -1747,11 +1747,11 @@ displayInstalledUnitId dflags uid = ...@@ -1747,11 +1747,11 @@ displayInstalledUnitId dflags uid =
fmap sourcePackageIdString (lookupInstalledPackage dflags uid) fmap sourcePackageIdString (lookupInstalledPackage dflags uid)
-- | Will the 'Name' come from a dynamically linked library? -- | Will the 'Name' come from a dynamically linked library?
isDllName :: DynFlags -> UnitId {- not used -} -> Module -> Name -> Bool isDllName :: DynFlags -> Module -> Name -> Bool
-- Despite the "dll", I think this function just means that -- Despite the "dll", I think this function just means that
-- the symbol comes from another dynamically-linked package, -- the symbol comes from another dynamically-linked package,
-- and applies on all platforms, not just Windows -- and applies on all platforms, not just Windows
isDllName dflags _this_pkg this_mod name isDllName dflags this_mod name
| WayDyn `notElem` ways dflags = False | WayDyn `notElem` ways dflags = False
| Just mod <- nameModule_maybe name | Just mod <- nameModule_maybe name
-- Issue #8696 - when GHC is dynamically linked, it will attempt -- Issue #8696 - when GHC is dynamically linked, it will attempt
......
...@@ -1132,18 +1132,15 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds ...@@ -1132,18 +1132,15 @@ tidyTopBinds hsc_env this_mod unfold_env init_occ_env binds
init_env = (init_occ_env, emptyVarEnv) init_env = (init_occ_env, emptyVarEnv)
this_pkg = thisPackage dflags
tidy _ env [] = (env, []) tidy _ env [] = (env, [])
tidy cvt_integer env (b:bs) tidy cvt_integer env (b:bs)
= let (env1, b') = tidyTopBind dflags this_pkg this_mod = let (env1, b') = tidyTopBind dflags this_mod
cvt_integer unfold_env env b cvt_integer unfold_env env b
(env2, bs') = tidy cvt_integer env1 bs (env2, bs') = tidy cvt_integer env1 bs
in (env2, b':bs') in (env2, b':bs')
------------------------ ------------------------
tidyTopBind :: DynFlags tidyTopBind :: DynFlags
-> UnitId
-> Module -> Module
-> (Integer -> CoreExpr) -> (Integer -> CoreExpr)
-> UnfoldEnv -> UnfoldEnv
...@@ -1151,17 +1148,19 @@ tidyTopBind :: DynFlags ...@@ -1151,17 +1148,19 @@ tidyTopBind :: DynFlags
-> CoreBind -> CoreBind
-> (TidyEnv, CoreBind) -> (TidyEnv, CoreBind)
tidyTopBind dflags this_pkg this_mod cvt_integer unfold_env tidyTopBind dflags this_mod cvt_integer unfold_env
(occ_env,subst1) (NonRec bndr rhs) (occ_env,subst1) (NonRec bndr rhs)
= (tidy_env2, NonRec bndr' rhs') = (tidy_env2, NonRec bndr' rhs')
where where
Just (name',show_unfold) = lookupVarEnv unfold_env bndr Just (name',show_unfold) = lookupVarEnv unfold_env bndr
caf_info = hasCafRefs dflags this_pkg this_mod (subst1, cvt_integer) (idArity bndr) rhs caf_info = hasCafRefs dflags this_mod (subst1, cvt_integer)
(bndr', rhs') = tidyTopPair dflags show_unfold tidy_env2 caf_info name' (bndr, rhs) (idArity bndr) rhs
(bndr', rhs') = tidyTopPair dflags show_unfold tidy_env2 caf_info name'
(bndr, rhs)
subst2 = extendVarEnv subst1 bndr bndr' subst2 = extendVarEnv subst1 bndr bndr'
tidy_env2 = (occ_env, subst2) tidy_env2 = (occ_env, subst2)
tidyTopBind dflags this_pkg this_mod cvt_integer unfold_env tidyTopBind dflags this_mod cvt_integer unfold_env
(occ_env, subst1) (Rec prs) (occ_env, subst1) (Rec prs)
= (tidy_env2, Rec prs') = (tidy_env2, Rec prs')
where where
...@@ -1179,7 +1178,7 @@ tidyTopBind dflags this_pkg this_mod cvt_integer unfold_env ...@@ -1179,7 +1178,7 @@ tidyTopBind dflags this_pkg this_mod cvt_integer unfold_env
-- the CafInfo for a recursive group says whether *any* rhs in -- the CafInfo for a recursive group says whether *any* rhs in
-- the group may refer indirectly to a CAF (because then, they all do). -- the group may refer indirectly to a CAF (because then, they all do).
caf_info caf_info
| or [ mayHaveCafRefs (hasCafRefs dflags this_pkg this_mod | or [ mayHaveCafRefs (hasCafRefs dflags this_mod
(subst1, cvt_integer) (subst1, cvt_integer)
(idArity bndr) rhs) (idArity bndr) rhs)
| (bndr,rhs) <- prs ] = MayHaveCafRefs | (bndr,rhs) <- prs ] = MayHaveCafRefs
...@@ -1331,15 +1330,15 @@ type CafRefEnv = (VarEnv Id, Integer -> CoreExpr) ...@@ -1331,15 +1330,15 @@ type CafRefEnv = (VarEnv Id, Integer -> CoreExpr)
-- The Integer -> CoreExpr is the desugaring function for Integer literals -- The Integer -> CoreExpr is the desugaring function for Integer literals
-- See Note [Disgusting computation of CafRefs] -- See Note [Disgusting computation of CafRefs]
hasCafRefs :: DynFlags -> UnitId -> Module hasCafRefs :: DynFlags -> Module
-> CafRefEnv -> Arity -> CoreExpr -> CafRefEnv -> Arity -> CoreExpr
-> CafInfo -> CafInfo
hasCafRefs dflags this_pkg this_mod p@(_,cvt_integer) arity expr hasCafRefs dflags this_mod p@(_,cvt_integer) arity expr
| is_caf || mentions_cafs = MayHaveCafRefs | is_caf || mentions_cafs = MayHaveCafRefs
| otherwise = NoCafRefs | otherwise = NoCafRefs
where where
mentions_cafs = cafRefsE p expr mentions_cafs = cafRefsE p expr
is_dynamic_name = isDllName dflags this_pkg this_mod is_dynamic_name = isDllName dflags this_mod
is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name cvt_integer expr) is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name cvt_integer expr)
-- NB. we pass in the arity of the expression, which is expected -- NB. we pass in the arity of the expression, which is expected
......
...@@ -98,18 +98,16 @@ data GenStgArg occ ...@@ -98,18 +98,16 @@ data GenStgArg occ
isDllConApp :: DynFlags -> Module -> DataCon -> [StgArg] -> Bool isDllConApp :: DynFlags -> Module -> DataCon -> [StgArg] -> Bool
isDllConApp dflags this_mod con args isDllConApp dflags this_mod con args
| platformOS (targetPlatform dflags) == OSMinGW32 | platformOS (targetPlatform dflags) == OSMinGW32
= isDllName dflags this_pkg this_mod (dataConName con) || any is_dll_arg args = isDllName dflags this_mod (dataConName con) || any is_dll_arg args
| otherwise = False | otherwise = False
where where
-- NB: typePrimRep is legit because any free variables won't have -- NB: typePrimRep is legit because any free variables won't have
-- unlifted type (there are no unlifted things at top level) -- unlifted type (there are no unlifted things at top level)
is_dll_arg :: StgArg -> Bool is_dll_arg :: StgArg -> Bool
is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep (idType v)) is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep (idType v))
&& isDllName dflags this_pkg this_mod (idName v) && isDllName dflags this_mod (idName v)
is_dll_arg _ = False is_dll_arg _ = False
this_pkg = thisPackage dflags
-- True of machine addresses; these are the things that don't -- True of machine addresses; these are the things that don't
-- work across DLLs. The key point here is that VoidRep comes -- work across DLLs. The key point here is that VoidRep comes
-- out False, so that a top level nullary GADT constructor is -- out False, so that a top level nullary GADT constructor is
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment