diff options
-rw-r--r-- | compiler/GHC/HsToCore.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Iface/Tidy.hs | 69 | ||||
-rw-r--r-- | compiler/GHC/IfaceToCore.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/showIface/T17871.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/showIface/T17871a.hs | 9 | ||||
-rw-r--r-- | testsuite/tests/showIface/all.T | 1 |
6 files changed, 68 insertions, 33 deletions
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index 7b4659edba..d467e559cd 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -639,18 +639,7 @@ The solution is documented in Note [Patching magic definitions]. We now simply look up the UnsafeEquality GADT in the environment, leaving us only to wire in unsafeCoerce# directly. -Wrinkle: --------- -We must make absolutely sure that unsafeCoerce# is inlined. You might -think that giving it a compulsory unfolding is enough. However, -unsafeCoerce# is put in an interface file like any other definition. -At optimization level 0, we enable -fignore-interface-pragmas, which -ignores pragmas in interface files. We thus must check to see whether -there is a compulsory unfolding, even with -fignore-interface-pragmas. -This is done in TcIface.tcIdInfo. - -Test case: ghci/linker/dyn/T3372 - +Wrinkle: see Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy -} diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs index d764b92edb..c305f60dd3 100644 --- a/compiler/GHC/Iface/Tidy.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -317,6 +317,28 @@ binder Finally, substitute these new top-level binders consistently throughout, including in unfoldings. We also tidy binders in RHSs, so that they print nicely in interfaces. + +Note [Always expose compulsory unfoldings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must make absolutely sure that unsafeCoerce# is inlined. You might +think that giving it a compulsory unfolding is enough. However, +unsafeCoerce# is put in an interface file just like any other definition. +So, unless we take special precuations +- If we compiled Unsafe.Coerce with -O0, we might not put the unfolding + into the interface file. +- If we compile a module M, that imports Unsafe.Coerce, with -O0 we might + not read the unfolding out of the interface file. + +So we need to take care, to ensure that Compulsory unfoldings are written +and read. That makes sense: they are compulsory, after all. There are +three places this is actioned: + +* GHC.Iface.Tidy.addExternal. Export end: expose compulsory + unfoldings, even with -O0. + +* GHC.IfaceToCore.tcIdInfo. Import end: when reading in from + interface file, even with -O0 (fignore-interface-pragmas.) we must + load a compulsory unfolding -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) @@ -379,7 +401,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- exported Ids and things needed from them, which saves space -- -- See Note [Don't attempt to trim data types] - ; final_ids = [ if omit_prags then trimId id else id + ; final_ids = [ trimId omit_prags id | id <- bindersOfBinds tidy_binds , isExternalName (idName id) , not (isWiredIn id) @@ -450,19 +472,21 @@ tidyProgram hsc_env (ModGuts { mg_module = mod dflags = hsc_dflags hsc_env -------------------------- -trimId :: Id -> Id -trimId id - | not (isImplicitId id) - = id `setIdInfo` vanillaIdInfo - `setIdUnfolding` unfolding - | otherwise +trimId :: Bool -> Id -> Id +-- With -O0 we now trim off the arity, one-shot-ness, strictness +-- etc which tidyTopIdInfo retains for the benefit of the code generator +-- but which we don't want in the interface file or ModIface for +-- downstream compilations +trimId omit_prags id + | omit_prags, not (isImplicitId id) + = id `setIdInfo` vanillaIdInfo + `setIdUnfolding` idUnfolding id + -- We respect the final unfolding chosen by tidyTopIdInfo. + -- We have already trimmed it if we don't want it for -O0; + -- see also Note [Always expose compulsory unfoldings] + + | otherwise -- No trimming = id - where - unfolding - | isCompulsoryUnfolding (idUnfolding id) - = idUnfolding id - | otherwise - = noUnfolding {- Note [Drop wired-in things] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -663,9 +687,7 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_ | otherwise = do (occ_env', name') <- tidyTopName mod nc_var (Just referrer) occ_env idocc let - (new_ids, show_unfold) - | omit_prags = ([], False) - | otherwise = addExternal expose_all refined_id + (new_ids, show_unfold) = addExternal omit_prags expose_all refined_id -- 'idocc' is an *occurrence*, but we need to see the -- unfolding in the *definition*; so look up in binder_set @@ -687,12 +709,21 @@ chooseExternalIds hsc_env mod omit_prags expose_all binds implicit_binds imp_id_ let unfold_env' = extendVarEnv unfold_env id (name',False) tidy_internal ids unfold_env' occ_env' -addExternal :: Bool -> Id -> ([Id], Bool) -addExternal expose_all id = (new_needed_ids, show_unfold) +addExternal :: Bool -> Bool -> Id -> ([Id], Bool) +addExternal omit_prags expose_all id + | omit_prags + , not (isCompulsoryUnfolding unfolding) + = ([], False) -- See Note [Always expose compulsory unfoldings] + -- in GHC.HsToCore + + | otherwise + = (new_needed_ids, show_unfold) + where new_needed_ids = bndrFvsInOrder show_unfold id idinfo = idInfo id - show_unfold = show_unfolding (unfoldingInfo idinfo) + unfolding = unfoldingInfo idinfo + show_unfold = show_unfolding unfolding never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) bottoming_fn = isBottomingSig (strictnessInfo idinfo) diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index 700d830c9d..1af97d1b6b 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -1474,8 +1474,8 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = filter need_prag items need_prag :: IfaceInfoItem -> Bool - -- compulsory unfoldings are really compulsory. - -- See wrinkle in Note [Wiring in unsafeCoerce#] in Desugar + -- Always read in compulsory unfoldings + -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy need_prag (HsUnfold _ (IfCompulsory {})) = True need_prag _ = False diff --git a/testsuite/tests/showIface/T17871.hs b/testsuite/tests/showIface/T17871.hs new file mode 100644 index 0000000000..bc2b0c791a --- /dev/null +++ b/testsuite/tests/showIface/T17871.hs @@ -0,0 +1,5 @@ +module T17871 where + +import T17871a + +instance C () diff --git a/testsuite/tests/showIface/T17871a.hs b/testsuite/tests/showIface/T17871a.hs new file mode 100644 index 0000000000..151e994690 --- /dev/null +++ b/testsuite/tests/showIface/T17871a.hs @@ -0,0 +1,9 @@ +-- A.hs +module T17871a (C(..)) where + +class C a where + m :: a -> a + m = identity + +identity :: a -> a +identity x = x diff --git a/testsuite/tests/showIface/all.T b/testsuite/tests/showIface/all.T index 34550f696b..e2ec264431 100644 --- a/testsuite/tests/showIface/all.T +++ b/testsuite/tests/showIface/all.T @@ -5,3 +5,4 @@ test('DocsInHiFile0', test('DocsInHiFile1', extra_files(['DocsInHiFile.hs']), makefile_test, ['DocsInHiFile1']) +test('T17871', [extra_files(['T17871a.hs'])], multimod_compile, ['T17871', '-v0']) |