summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/CoreToIface.hs13
-rw-r--r--compiler/GHC/IfaceToCore.hs8
-rw-r--r--testsuite/tests/driver/fat-iface/Makefile7
-rw-r--r--testsuite/tests/driver/fat-iface/T22807.stdout2
-rw-r--r--testsuite/tests/driver/fat-iface/T22807A.hs6
-rw-r--r--testsuite/tests/driver/fat-iface/T22807B.hs5
-rw-r--r--testsuite/tests/driver/fat-iface/T22807_ghci.hs8
-rw-r--r--testsuite/tests/driver/fat-iface/T22807_ghci.script6
-rw-r--r--testsuite/tests/driver/fat-iface/T22807_ghci.stdout1
-rw-r--r--testsuite/tests/driver/fat-iface/all.T4
10 files changed, 56 insertions, 4 deletions
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 87fe4793b8..f0e2c0ad5f 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -604,8 +604,12 @@ toIfaceTopBind b =
IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs)
in (top_bndr, rhs')
- already_has_unfolding b =
- -- The identifier has an unfolding, which we are going to serialise anyway
+ -- The sharing behaviour is currently disabled due to #22807, and relies on
+ -- finished #220056 to be re-enabled.
+ disabledDueTo22807 = True
+
+ already_has_unfolding b = not disabledDueTo22807
+ && -- The identifier has an unfolding, which we are going to serialise anyway
hasCoreUnfolding (realIdUnfolding b)
-- But not a stable unfolding, we want the optimised unfoldings.
&& not (isStableUnfolding (realIdUnfolding b))
@@ -771,7 +775,10 @@ is that these NOINLINE'd functions now can't be profitably inlined
outside of the hs-boot loop.
Note [Interface File with Core: Sharing RHSs]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+IMPORTANT: This optimisation is currently disabled due to #22027, it can be
+ re-enabled once #220056 is implemented.
In order to avoid duplicating definitions for bindings which already have unfoldings
we do some minor headstands to avoid serialising the RHS of a definition if it has
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 93a3bce842..7138c0433e 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -933,7 +933,13 @@ tc_iface_bindings (IfaceRec bs) = do
-- | See Note [Interface File with Core: Sharing RHSs]
tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr
-tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i)
+tc_iface_binding i IfUseUnfoldingRhs =
+ case maybeUnfoldingTemplate $ realIdUnfolding i of
+ Just e -> return e
+ Nothing -> pprPanic "tc_iface_binding" (vcat [text "Binding" <+> quotes (ppr i) <+> text "had an unfolding when the interface file was created"
+ , text "which has now gone missing, something has badly gone wrong."
+ , text "Unfolding:" <+> ppr (realIdUnfolding i)])
+
tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs
mk_top_id :: IfaceTopBndrInfo -> IfL Id
diff --git a/testsuite/tests/driver/fat-iface/Makefile b/testsuite/tests/driver/fat-iface/Makefile
index 7241e48333..e74578a491 100644
--- a/testsuite/tests/driver/fat-iface/Makefile
+++ b/testsuite/tests/driver/fat-iface/Makefile
@@ -49,4 +49,11 @@ fat010: clean
echo >> "THB.hs"
"$(TEST_HC)" $(TEST_HC_OPTS) THC.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code
+T22807: clean
+ "$(TEST_HC)" $(TEST_HC_OPTS) T22807A.hs -fhide-source-paths -fwrite-if-simplified-core -fbyte-code-and-object-code -fno-omit-interface-pragmas -fprefer-byte-code
+ "$(TEST_HC)" $(TEST_HC_OPTS) T22807B.hs -fhide-source-paths -fwrite-if-simplified-core -fprefer-byte-code -fbyte-code-and-object-code -fno-omit-interface-pragmas
+
+T22807_ghci: clean
+ "$(TEST_HC)" $(TEST_HC_OPTS) T22807_ghci.hs -fno-full-laziness -fhide-source-paths -fwrite-if-simplified-core -O2 -dynamic -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --interactive -fhide-source-paths -fno-full-laziness < T22807_ghci.script
diff --git a/testsuite/tests/driver/fat-iface/T22807.stdout b/testsuite/tests/driver/fat-iface/T22807.stdout
new file mode 100644
index 0000000000..173c70efee
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling T22807A
+[2 of 2] Compiling T22807B
diff --git a/testsuite/tests/driver/fat-iface/T22807A.hs b/testsuite/tests/driver/fat-iface/T22807A.hs
new file mode 100644
index 0000000000..8a86caf95e
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807A.hs
@@ -0,0 +1,6 @@
+module T22807A where
+
+xs :: [a]
+xs = []
+
+
diff --git a/testsuite/tests/driver/fat-iface/T22807B.hs b/testsuite/tests/driver/fat-iface/T22807B.hs
new file mode 100644
index 0000000000..5f1dd047cd
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807B.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T22807B where
+import T22807A
+
+$(pure xs)
diff --git a/testsuite/tests/driver/fat-iface/T22807_ghci.hs b/testsuite/tests/driver/fat-iface/T22807_ghci.hs
new file mode 100644
index 0000000000..1d603b16d8
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807_ghci.hs
@@ -0,0 +1,8 @@
+module T22807_ghci where
+
+
+foo b =
+ let x = Just [1..1000]
+ in if b
+ then Left x
+ else Right x
diff --git a/testsuite/tests/driver/fat-iface/T22807_ghci.script b/testsuite/tests/driver/fat-iface/T22807_ghci.script
new file mode 100644
index 0000000000..be68d82d12
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807_ghci.script
@@ -0,0 +1,6 @@
+:l T22807_ghci.hs
+
+import T22807_ghci
+import Data.Either
+
+isLeft (foo True)
diff --git a/testsuite/tests/driver/fat-iface/T22807_ghci.stdout b/testsuite/tests/driver/fat-iface/T22807_ghci.stdout
new file mode 100644
index 0000000000..0ca95142bb
--- /dev/null
+++ b/testsuite/tests/driver/fat-iface/T22807_ghci.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/driver/fat-iface/all.T b/testsuite/tests/driver/fat-iface/all.T
index c526aa7493..18837711de 100644
--- a/testsuite/tests/driver/fat-iface/all.T
+++ b/testsuite/tests/driver/fat-iface/all.T
@@ -15,5 +15,9 @@ test('fat013', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_comp
# When using interpreter should not produce objects
test('fat014', [req_th, extra_files(['FatTH.hs', 'FatQuote.hs']), extra_run_opts('-fno-code')], ghci_script, ['fat014.script'])
test('fat015', [req_th, unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface'])
+test('T22807', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807A.hs', 'T22807B.hs'])]
+ , makefile_test, ['T22807'])
+test('T22807_ghci', [req_th, unless(ghc_dynamic(), skip), extra_files(['T22807_ghci.hs'])]
+ , makefile_test, ['T22807_ghci'])