Move loadDecl into IfaceToCore

5 files changed, 126 insertions, 123 deletions

diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index ed8ecf0e08..16ca152edc 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -2,13 +2,13 @@
 (c) The University of Glasgow 2006
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
-
-Loading interface files
 -}
 
 {-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Loading interface files
 module GHC.Iface.Load (
         -- Importing one thing
         tcLookupImported_maybe, importDecl,
@@ -23,7 +23,6 @@ module GHC.Iface.Load (
         loadInterface,
         loadSysInterface, loadUserInterface, loadPluginInterface,
         findAndReadIface, readIface, writeIface,
-        loadDecls,      -- Should move to GHC.IfaceToCore and be renamed
         initExternalPackageState,
         moduleFreeHolesPrecise,
         needWiredInHomeIface, loadWiredInHomeIface,
@@ -37,7 +36,7 @@ module GHC.Iface.Load (
 import GHC.Prelude
 
 import {-# SOURCE #-} GHC.IfaceToCore
-   ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
+   ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
    , tcIfaceAnnotations, tcIfaceCompleteMatches )
 
 import GHC.Driver.Env
@@ -48,7 +47,6 @@ import GHC.Driver.Hooks
 import GHC.Driver.Plugins
 
 import GHC.Iface.Syntax
-import GHC.Iface.Env
 import GHC.Iface.Ext.Fields
 import GHC.Iface.Binary
 import GHC.Iface.Rename
@@ -60,7 +58,6 @@ import GHC.Utils.Error
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
-import GHC.Utils.Fingerprint
 
 import GHC.Settings.Constants
 
@@ -489,13 +486,13 @@ loadInterface doc_str mod from
         --      IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules,
         -- out of the ModIface and put them into the big EPS pools
 
-        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
+        -- NB: *first* we do tcIfaceDecls, so that the provenance of all the locally-defined
         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
         --     If we do loadExport first the wrong info gets into the cache (unless we
         --      explicitly tag each export which seems a bit of a bore)
 
         ; ignore_prags      <- goptM Opt_IgnoreInterfacePragmas
-        ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
+        ; new_eps_decls     <- tcIfaceDecls ignore_prags (mi_decls iface)
         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
@@ -777,110 +774,6 @@ badSourceImport mod
 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 addDeclsToPTE pte things = extendNameEnvList pte things
 
-loadDecls :: Bool
-          -> [(Fingerprint, IfaceDecl)]
-          -> IfL [(Name,TyThing)]
-loadDecls ignore_prags ver_decls
-   = concatMapM (loadDecl ignore_prags) ver_decls
-
-loadDecl :: Bool                    -- Don't load pragmas into the decl pool
-          -> (Fingerprint, IfaceDecl)
-          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
-                                    -- TyThings are forkM'd thunks
-loadDecl ignore_prags (_version, decl)
-  = do  {       -- Populate the name cache with final versions of all
-                -- the names associated with the decl
-          let main_name = ifName decl
-
-        -- Typecheck the thing, lazily
-        -- NB. Firstly, the laziness is there in case we never need the
-        -- declaration (in one-shot mode), and secondly it is there so that
-        -- we don't look up the occurrence of a name before calling mk_new_bndr
-        -- on the binder.  This is important because we must get the right name
-        -- which includes its nameParent.
-
-        ; thing <- forkM doc $ do { bumpDeclStats main_name
-                                  ; tcIfaceDecl ignore_prags decl }
-
-        -- Populate the type environment with the implicitTyThings too.
-        --
-        -- Note [Tricky iface loop]
-        -- ~~~~~~~~~~~~~~~~~~~~~~~~
-        -- Summary: The delicate point here is that 'mini-env' must be
-        -- buildable from 'thing' without demanding any of the things
-        -- 'forkM'd by tcIfaceDecl.
-        --
-        -- In more detail: Consider the example
-        --      data T a = MkT { x :: T a }
-        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
-        -- (plus their workers, wrappers, coercions etc etc)
-        --
-        -- We want to return an environment
-        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
-        -- (where the "MkT" is the *Name* associated with MkT, etc.)
-        --
-        -- We do this by mapping the implicit_names to the associated
-        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
-        -- implicitTyThings, we can use getOccName on the implicit
-        -- TyThings to make this association: each Name's OccName should
-        -- be the OccName of exactly one implicitTyThing.  So the key is
-        -- to define a "mini-env"
-        --
-        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
-        -- where the 'MkT' here is the *OccName* associated with MkT.
-        --
-        -- However, there is a subtlety: due to how type checking needs
-        -- to be staged, we can't poke on the forkM'd thunks inside the
-        -- implicitTyThings while building this mini-env.
-        -- If we poke these thunks too early, two problems could happen:
-        --    (1) When processing mutually recursive modules across
-        --        hs-boot boundaries, poking too early will do the
-        --        type-checking before the recursive knot has been tied,
-        --        so things will be type-checked in the wrong
-        --        environment, and necessary variables won't be in
-        --        scope.
-        --
-        --    (2) Looking up one OccName in the mini_env will cause
-        --        others to be looked up, which might cause that
-        --        original one to be looked up again, and hence loop.
-        --
-        -- The code below works because of the following invariant:
-        -- getOccName on a TyThing does not force the suspended type
-        -- checks in order to extract the name. For example, we don't
-        -- poke on the "T a" type of <selector x> on the way to
-        -- extracting <selector x>'s OccName. Of course, there is no
-        -- reason in principle why getting the OccName should force the
-        -- thunks, but this means we need to be careful in
-        -- implicitTyThings and its helper functions.
-        --
-        -- All a bit too finely-balanced for my liking.
-
-        -- This mini-env and lookup function mediates between the
-        --'Name's n and the map from 'OccName's to the implicit TyThings
-        ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
-              lookup n = case lookupOccEnv mini_env (getOccName n) of
-                           Just thing -> thing
-                           Nothing    ->
-                             pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
-
-        ; implicit_names <- mapM lookupIfaceTop (ifaceDeclImplicitBndrs decl)
-
---         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
-        ; return $ (main_name, thing) :
-                      -- uses the invariant that implicit_names and
-                      -- implicitTyThings are bijective
-                      [(n, lookup n) | n <- implicit_names]
-        }
-  where
-    doc = text "Declaration for" <+> ppr (ifName decl)
-
-bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
-bumpDeclStats name
-  = do  { traceIf (text "Loading decl for" <+> ppr name)
-        ; updateEps_ (\eps -> let stats = eps_stats eps
-                              in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
-        }
-
 {-
 *********************************************************
 *                                                      *
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 72ff681c99..e6fc3a8bc0 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -469,7 +469,8 @@ ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
 -- N.B. the set of names returned here *must* match the set of
 -- TyThings returned by GHC.Driver.Env.implicitTyThings, in the sense that
 -- TyThing.getOccName should define a bijection between the two lists.
--- This invariant is used in GHC.Iface.Load.loadDecl (see note [Tricky iface loop])
+-- This invariant is used in GHC.IfaceToCore.tc_iface_decl_fingerprint (see note
+-- [Tricky iface loop])
 -- The order of the list does not matter.
 
 ifaceDeclImplicitBndrs (IfaceData {ifName = tc_name, ifCons = cons })
@@ -2017,13 +2018,13 @@ knot in the type checker. It saved ~1% of the total build time of GHC.
 When we read an interface file, we extend the PTE, a mapping of Names
 to TyThings, with the declarations we have read. The extension of the
 PTE is strict in the Names, but not in the TyThings themselves.
-GHC.Iface.Load.loadDecl calculates the list of (Name, TyThing) bindings to
-add to the PTE. For an IfaceId, there's just one binding to add; and
+GHC.IfaceToCore.tcIfaceDecls calculates the list of (Name, TyThing) bindings
+to add to the PTE.  For an IfaceId, there's just one binding to add; and
 the ty, details, and idinfo fields of an IfaceId are used only in the
 TyThing. So by reading those fields lazily we may be able to save the
 work of ever having to deserialize them (into IfaceType, etc.).
 
-For IfaceData and IfaceClass, loadDecl creates extra implicit bindings
+For IfaceData and IfaceClass, tcIfaceDecls creates extra implicit bindings
 (the constructors and field selectors of the data declaration, or the
 methods of the class), whose Names depend on more than just the Name
 of the type constructor or class itself. So deserializing them lazily
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index ad7db247f7..b382165834 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -16,7 +16,8 @@ module GHC.IfaceToCore (
         importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
         typecheckIfacesForMerging,
         typecheckIfaceForInstantiate,
-        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
+        tcIfaceDecl, tcIfaceDecls,
+        tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
         tcIfaceAnnotations, tcIfaceCompleteMatches,
         tcIfaceExpr,    -- Desired by HERMIT (#7683)
         tcIfaceGlobal,
@@ -185,7 +186,7 @@ typecheckIface iface
                 -- Typecheck the decls.  This is done lazily, so that the knot-tying
                 -- within this single module works out right.  It's the callers
                 -- job to make sure the knot is tied.
-        ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
+        ; names_w_things <- tcIfaceDecls ignore_prags (mi_decls iface)
         ; let type_env = mkNameEnv names_w_things
 
                 -- Now do those rules, instances and annotations
@@ -390,8 +391,8 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
                         :: [OccEnv IfaceDecl]
         decl_env = foldl' mergeIfaceDecls emptyOccEnv decl_envs
                         ::  OccEnv IfaceDecl
-    -- TODO: change loadDecls to accept w/o Fingerprint
-    names_w_things <- loadDecls ignore_prags (map (\x -> (fingerprint0, x))
+    -- TODO: change tcIfaceDecls to accept w/o Fingerprint
+    names_w_things <- tcIfaceDecls ignore_prags (map (\x -> (fingerprint0, x))
                                                   (occEnvElts decl_env))
     let global_type_env = mkNameEnv names_w_things
     writeMutVar tc_env_var global_type_env
@@ -401,7 +402,7 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
         -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
         type_env <- fixM $ \type_env -> do
             setImplicitEnvM type_env $ do
-                decls <- loadDecls ignore_prags (mi_decls iface)
+                decls <- tcIfaceDecls ignore_prags (mi_decls iface)
                 return (mkNameEnv decls)
         -- But note that we use this type_env to typecheck references to DFun
         -- in 'IfaceInst'
@@ -441,7 +442,7 @@ typecheckIfaceForInstantiate nsubst iface =
     -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
     type_env <- fixM $ \type_env -> do
         setImplicitEnvM type_env $ do
-            decls     <- loadDecls ignore_prags (mi_decls iface)
+            decls     <- tcIfaceDecls ignore_prags (mi_decls iface)
             return (mkNameEnv decls)
     -- See Note [rnIfaceNeverExported]
     setImplicitEnvM type_env $ do
@@ -871,6 +872,110 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = name
      tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
                         ; return (id, b) }
 
+tcIfaceDecls :: Bool
+          -> [(Fingerprint, IfaceDecl)]
+          -> IfL [(Name,TyThing)]
+tcIfaceDecls ignore_prags ver_decls
+   = concatMapM (tc_iface_decl_fingerprint ignore_prags) ver_decls
+
+tc_iface_decl_fingerprint :: Bool                    -- Don't load pragmas into the decl pool
+          -> (Fingerprint, IfaceDecl)
+          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
+                                    -- TyThings are forkM'd thunks
+tc_iface_decl_fingerprint ignore_prags (_version, decl)
+  = do  {       -- Populate the name cache with final versions of all
+                -- the names associated with the decl
+          let main_name = ifName decl
+
+        -- Typecheck the thing, lazily
+        -- NB. Firstly, the laziness is there in case we never need the
+        -- declaration (in one-shot mode), and secondly it is there so that
+        -- we don't look up the occurrence of a name before calling mk_new_bndr
+        -- on the binder.  This is important because we must get the right name
+        -- which includes its nameParent.
+
+        ; thing <- forkM doc $ do { bumpDeclStats main_name
+                                  ; tcIfaceDecl ignore_prags decl }
+
+        -- Populate the type environment with the implicitTyThings too.
+        --
+        -- Note [Tricky iface loop]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~~
+        -- Summary: The delicate point here is that 'mini-env' must be
+        -- buildable from 'thing' without demanding any of the things
+        -- 'forkM'd by tcIfaceDecl.
+        --
+        -- In more detail: Consider the example
+        --      data T a = MkT { x :: T a }
+        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
+        -- (plus their workers, wrappers, coercions etc etc)
+        --
+        -- We want to return an environment
+        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
+        -- (where the "MkT" is the *Name* associated with MkT, etc.)
+        --
+        -- We do this by mapping the implicit_names to the associated
+        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
+        -- implicitTyThings, we can use getOccName on the implicit
+        -- TyThings to make this association: each Name's OccName should
+        -- be the OccName of exactly one implicitTyThing.  So the key is
+        -- to define a "mini-env"
+        --
+        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
+        -- where the 'MkT' here is the *OccName* associated with MkT.
+        --
+        -- However, there is a subtlety: due to how type checking needs
+        -- to be staged, we can't poke on the forkM'd thunks inside the
+        -- implicitTyThings while building this mini-env.
+        -- If we poke these thunks too early, two problems could happen:
+        --    (1) When processing mutually recursive modules across
+        --        hs-boot boundaries, poking too early will do the
+        --        type-checking before the recursive knot has been tied,
+        --        so things will be type-checked in the wrong
+        --        environment, and necessary variables won't be in
+        --        scope.
+        --
+        --    (2) Looking up one OccName in the mini_env will cause
+        --        others to be looked up, which might cause that
+        --        original one to be looked up again, and hence loop.
+        --
+        -- The code below works because of the following invariant:
+        -- getOccName on a TyThing does not force the suspended type
+        -- checks in order to extract the name. For example, we don't
+        -- poke on the "T a" type of <selector x> on the way to
+        -- extracting <selector x>'s OccName. Of course, there is no
+        -- reason in principle why getting the OccName should force the
+        -- thunks, but this means we need to be careful in
+        -- implicitTyThings and its helper functions.
+        --
+        -- All a bit too finely-balanced for my liking.
+
+        -- This mini-env and lookup function mediates between the
+        --'Name's n and the map from 'OccName's to the implicit TyThings
+        ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
+              lookup n = case lookupOccEnv mini_env (getOccName n) of
+                           Just thing -> thing
+                           Nothing    ->
+                             pprPanic "tc_iface_decl_fingerprint" (ppr main_name <+> ppr n $$ ppr (decl))
+
+        ; implicit_names <- mapM lookupIfaceTop (ifaceDeclImplicitBndrs decl)
+
+--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
+        ; return $ (main_name, thing) :
+                      -- uses the invariant that implicit_names and
+                      -- implicitTyThings are bijective
+                      [(n, lookup n) | n <- implicit_names]
+        }
+  where
+    doc = text "Declaration for" <+> ppr (ifName decl)
+
+bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
+bumpDeclStats name
+  = do  { traceIf (text "Loading decl for" <+> ppr name)
+        ; updateEps_ (\eps -> let stats = eps_stats eps
+                              in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
+        }
+
 tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
 tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
                         ; tvs2' <- mapM tcIfaceTyVar tvs2
diff --git a/compiler/GHC/IfaceToCore.hs-boot b/compiler/GHC/IfaceToCore.hs-boot
index 96daafae3c..c21c4a3acb 100644
--- a/compiler/GHC/IfaceToCore.hs-boot
+++ b/compiler/GHC/IfaceToCore.hs-boot
@@ -10,6 +10,8 @@ import GHC.Core.FamInstEnv ( FamInst )
 import GHC.Core         ( CoreRule )
 import GHC.Types.CompleteMatch ( CompleteMatch )
 import GHC.Types.Annotations ( Annotation )
+import GHC.Types.Name
+import GHC.Fingerprint.Type
 
 tcIfaceDecl            :: Bool -> IfaceDecl -> IfL TyThing
 tcIfaceRules           :: Bool -> [IfaceRule] -> IfL [CoreRule]
@@ -17,3 +19,4 @@ tcIfaceInst            :: IfaceClsInst -> IfL ClsInst
 tcIfaceFamInst         :: IfaceFamInst -> IfL FamInst
 tcIfaceAnnotations     :: [IfaceAnnotation] -> IfL [Annotation]
 tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
+tcIfaceDecls           :: Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name,TyThing)]
diff --git a/compiler/GHC/Types/TyThing.hs b/compiler/GHC/Types/TyThing.hs
index eebcf3796d..d9c1bad013 100644
--- a/compiler/GHC/Types/TyThing.hs
+++ b/compiler/GHC/Types/TyThing.hs
@@ -138,7 +138,8 @@ Examples:
 -- N.B. the set of TyThings returned here *must* match the set of
 -- names returned by 'GHC.Iface.Load.ifaceDeclImplicitBndrs', in the sense that
 -- TyThing.getOccName should define a bijection between the two lists.
--- This invariant is used in 'GHC.Iface.Load.loadDecl' (see note [Tricky iface loop])
+-- This invariant is used in 'GHC.IfaceToCore.tc_iface_decl_fingerprint' (see
+-- note [Tricky iface loop])
 -- The order of the list does not matter.
 implicitTyThings :: TyThing -> [TyThing]
 implicitTyThings (AnId _)       = []