When a value Id comes from hi-boot, insert noinline. Fixes #10083.

Summary:
This also drops the parked fix from
efa7b3a474bc373201ab145c129262a73c86f959
(though I didn't revert the refactoring).

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2211

GHC Trac Issues: #10083

5 files changed, 89 insertions, 62 deletions

diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 183495f7b5..c1ae518927 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -980,6 +980,8 @@ data Unfolding
 
   | BootUnfolding      -- ^ We have no information about the unfolding, because
                        -- this 'Id' came from an @hi-boot@ file.
+                       -- See Note [Inlining and hs-boot files] for what
+                       -- this is used for.
 
   | OtherCon [AltCon]  -- ^ It ain't one of these constructors.
                        -- @OtherCon xs@ also indicates that something has been evaluated
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index e78975b27f..4c44e25eca 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -108,6 +108,7 @@ import Fingerprint
 import Exception
 import UniqFM
 import UniqDFM
+import MkId
 
 import Control.Monad
 import Data.Function
@@ -1832,6 +1833,81 @@ toIfaceVar :: Id -> IfaceExpr
 toIfaceVar v
     | Just fcall <- isFCallId_maybe v            = IfaceFCall fcall (toIfaceType (idType v))
        -- Foreign calls have special syntax
+    | isBootUnfolding (idUnfolding v)
+    = IfaceApp (IfaceApp (IfaceExt noinlineIdName) (IfaceType (toIfaceType (idType v))))
+               (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
+       -- See Note [Inlining and hs-boot files]
     | isExternalName name                        = IfaceExt name
     | otherwise                                  = IfaceLcl (getOccFS name)
   where name = idName v
+
+{-
+Note [Inlining and hs-boot files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this example (Trac #10083):
+
+    ---------- RSR.hs-boot ------------
+    module RSR where
+      data RSR
+      eqRSR :: RSR -> RSR -> Bool
+
+    ---------- SR.hs ------------
+    module SR where
+      import {-# SOURCE #-} RSR
+      data SR = MkSR RSR
+      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2
+
+    ---------- RSR.hs ------------
+    module RSR where
+      import SR
+      data RSR = MkRSR SR -- deriving( Eq )
+      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
+      foo x y = not (eqRSR x y)
+
+When compiling RSR we get this code
+
+    RSR.eqRSR :: RSR -> RSR -> Bool
+    RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
+                case ds1 of _ { RSR.MkRSR s1 ->
+                case ds2 of _ { RSR.MkRSR s2 ->
+                SR.eqSR s1 s2 }}
+
+    RSR.foo :: RSR -> RSR -> Bool
+    RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)
+
+Now, when optimising foo:
+    Inline eqRSR (small, non-rec)
+    Inline eqSR  (small, non-rec)
+but the result of inlining eqSR from SR is another call to eqRSR, so
+everything repeats.  Neither eqSR nor eqRSR are (apparently) loop
+breakers.
+
+Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR
+with `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means
+that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly
+as would have been the case if `foo` had been defined in SR.hs (and
+marked as a loop-breaker).
+
+But how do we arrange for this to happen?  There are two ingredients:
+
+    1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),
+    for every variable reference we see if we are referring to an
+    'Id' that came from an hs-boot file.  If so, we add a `noinline`
+    to the reference.
+
+    2. But how do we know if a reference came from an hs-boot file
+    or not?  We could record this directly in the 'IdInfo', but
+    actually we deduce this by looking at the unfolding: 'Id's
+    that come from boot files are given a special unfolding
+    (upon typechecking) 'BootUnfolding' which say that there is
+    no unfolding, and the reason is because the 'Id' came from
+    a boot file.
+
+Here is a solution that doesn't work: when compiling RSR,
+add a NOINLINE pragma to every function exported by the boot-file
+for RSR (if it exists).  Doing so makes the bootstrapped GHC itself
+slower by 8% overall (on Trac #9872a-d, and T1969: the reason
+is that these NOINLINE'd functions now can't be profitably inlined
+outside of the hs-boot loop.
+
+-}
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index ba63051c80..204fd5f353 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -279,53 +279,6 @@ time by defaulting.  No no no.
 
 However [Oct 10] this is all handled automatically by the
 untouchable-range idea.
-
-Note [Inlining and hs-boot files]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this example (Trac #10083):
-
-    ---------- RSR.hs-boot ------------
-    module RSR where
-      data RSR
-      eqRSR :: RSR -> RSR -> Bool
-
-    ---------- SR.hs ------------
-    module SR where
-      import {-# SOURCE #-} RSR
-      data SR = MkSR RSR
-      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2
-
-    ---------- RSR.hs ------------
-    module RSR where
-      import SR
-      data RSR = MkRSR SR -- deriving( Eq )
-      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
-      foo x y = not (eqRSR x y)
-
-When compiling RSR we get this code
-
-    RSR.eqRSR :: RSR -> RSR -> Bool
-    RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
-                case ds1 of _ { RSR.MkRSR s1 ->
-                case ds2 of _ { RSR.MkRSR s2 ->
-                SR.eqSR s1 s2 }}
-
-    RSR.foo :: RSR -> RSR -> Bool
-    RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)
-
-Now, when optimising foo:
-    Inline eqRSR (small, non-rec)
-    Inline eqSR  (small, non-rec)
-but the result of inlining eqSR from SR is another call to eqRSR, so
-everything repeats.  Neither eqSR nor eqRSR are (apparently) loop
-breakers.
-
-Solution: when compiling RSR, add a NOINLINE pragma to every function
-exported by the boot-file for RSR (if it exists).
-
-ALAS: doing so makes the boostrappted GHC itself slower by 8% overall
-      (on Trac #9872a-d, and T1969.  So I un-did this change, and
-      parked it for now.  Sigh.
 -}
 
 tcValBinds :: TopLevelFlag
@@ -340,20 +293,8 @@ tcValBinds top_lvl binds sigs thing_inside
         ; (poly_ids, sig_fn) <- tcAddPatSynPlaceholders patsyns $
                                 tcTySigs sigs
 
-        ; _self_boot <- tcSelfBootInfo
         ; let prag_fn = mkPragEnv sigs (foldr (unionBags . snd) emptyBag binds)
 
--- -------  See Note [Inlining and hs-boot files] (change parked) --------
---              prag_fn | isTopLevel top_lvl   -- See Note [Inlining and hs-boot files]
---                      , SelfBoot { sb_ids = boot_id_names } <- self_boot
---                      = foldNameSet add_no_inl prag_fn1 boot_id_names
---                      | otherwise
---                      = prag_fn1
---              add_no_inl boot_id_name prag_fn
---                = extendPragEnv prag_fn (boot_id_name, no_inl_sig boot_id_name)
---              no_inl_sig name = L boot_loc (InlineSig (L boot_loc name) neverInlinePragma)
---              boot_loc = mkGeneralSrcSpan (fsLit "The hs-boot file for this module")
-
                 -- Extend the envt right away with all the Ids
                 -- declared with complete type signatures
                 -- Do not extend the TcIdBinderStack; instead
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index e9e2493d20..3c8cbdabf9 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -801,17 +801,25 @@ test('T9233',
 test('T10370',
      [ only_ways(['optasm']),
        compiler_stats_num_field('max_bytes_used', # Note [residency]
-          [(wordsize(64), 28256896, 15),
+          [(wordsize(64), 33049168, 15),
           # 2015-10-22    19548720
           # 2016-02-24    22823976   Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis
           # 2016-04-14    28256896   final demand analyzer run
+          # 2016-08-08    33049304
+          #     This change happened because we changed the behavior
+          #     of inlining across hs-boot files, so that we don't
+          #     inline if something comes from a boot file.  This
+          #     affected stats on bootstrapped GHC.  However,
+          #     when I set -i0.01 with profiling, the heap profiles
+          #     were identical, so I think it's just GC noise.
            (wordsize(32), 11371496, 15),
           # 2015-10-22    11371496
           ]),
        compiler_stats_num_field('peak_megabytes_allocated', # Note [residency]
-          [(wordsize(64), 101, 15),
+          [(wordsize(64), 121, 15),
           # 2015-10-22     76
           # 2016-04-14    101 final demand analyzer run
+          # 2016-08-08    121 see above
            (wordsize(32),  39, 15),
           # 2015-10-22     39
           ]),
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index d59fa1c8b0..92f9af4797 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -220,7 +220,7 @@ test('T10602', only_ways(['optasm']), multimod_compile, ['T10602','-v0'])
 test('T10627', only_ways(['optasm']), compile, [''])
 test('T10181', [expect_broken(10181), only_ways(['optasm'])], compile, [''])
 test('T10083',
-     expect_broken(10083),
+     normal,
      run_command,
      ['$MAKE -s --no-print-directory T10083'])
 test('T10689', normal, compile, [''])