[Git][ghc/ghc][wip/disable-iface-sharing] Disable unfolding sharing for interface files with core definitions

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Wed Feb 1 09:51:41 UTC 2023



Matthew Pickering pushed to branch wip/disable-iface-sharing at Glasgow Haskell Compiler / GHC


Commits:
a060fa30 by Matthew Pickering at 2023-02-01T09:51:14+00:00
Disable unfolding sharing for interface files with core definitions

Ticket #22807 pointed out that the RHS sharing was not compatible with
-fignore-interface-pragmas because the flag would remove unfoldings from
identifiers before the `extra-decls` field was populated.

For the 9.6 timescale the only solution is to disable this sharing,
which will make interface files bigger but this is acceptable for the
first release of `-fwrite-if-simplified-core`.

For 9.8 it would be good to fix this by implementing #20056 due to the
large number of other bugs that would fix.

I also improved the error message in tc_iface_binding to avoid the "no match
in record selector" error but it should never happen now as the entire
sharing logic is disabled.

Also added the currently broken test for #22807 which could be fixed by
!6080

Fixes #22807

- - - - -


10 changed files:

- compiler/GHC/CoreToIface.hs
- compiler/GHC/IfaceToCore.hs
- testsuite/tests/driver/fat-iface/Makefile
- + testsuite/tests/driver/fat-iface/T22807.stdout
- + testsuite/tests/driver/fat-iface/T22807A.hs
- + testsuite/tests/driver/fat-iface/T22807B.hs
- + testsuite/tests/driver/fat-iface/T22807_ghci.hs
- + testsuite/tests/driver/fat-iface/T22807_ghci.script
- + testsuite/tests/driver/fat-iface/T22807_ghci.stdout
- testsuite/tests/driver/fat-iface/all.T


Changes:

=====================================
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


=====================================
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


=====================================
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
 


=====================================
testsuite/tests/driver/fat-iface/T22807.stdout
=====================================
@@ -0,0 +1,2 @@
+[1 of 1] Compiling T22807A
+[2 of 2] Compiling T22807B


=====================================
testsuite/tests/driver/fat-iface/T22807A.hs
=====================================
@@ -0,0 +1,6 @@
+module T22807A where
+
+xs :: [a]
+xs = []
+
+


=====================================
testsuite/tests/driver/fat-iface/T22807B.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T22807B where
+import T22807A
+
+$(pure xs)


=====================================
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


=====================================
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)


=====================================
testsuite/tests/driver/fat-iface/T22807_ghci.stdout
=====================================
@@ -0,0 +1 @@
+True


=====================================
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'])
 
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a060fa30a2149aa498d847ce441ac696b1ed04d5

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a060fa30a2149aa498d847ce441ac696b1ed04d5
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230201/a2e8377a/attachment-0001.html>


More information about the ghc-commits mailing list