Make deSugarExpr use runTcInteractive

Preparation for #13102, which needs to add more logic to
runTcInteractive, which would need to be duplicated in deSugarExpr.

In order to break an import cycle, I had to move
"Dependency/fingerprinting code" to a new module
DsUsage; which seems sensible anyways.

Test Plan: validate

Reviewers: simonpj, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie, snowleopard

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

2 files changed, 219 insertions, 206 deletions

diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 5111141770..d5931d16e5 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -10,22 +10,21 @@ The Desugarer: turning HsSyn into Core.
 
 module Desugar (
     -- * Desugaring operations
-    deSugar, deSugarExpr,
-    -- * Dependency/fingerprinting code (used by MkIface)
-    mkUsageInfo, mkUsedNames, mkDependencies
+    deSugar, deSugarExpr
     ) where
 
 #include "HsVersions.h"
 
+import DsUsage
 import DynFlags
 import HscTypes
 import HsSyn
 import TcRnTypes
 import TcRnMonad ( finalSafeMode, fixSafeInstances )
+import TcRnDriver ( runTcInteractive )
 import Id
 import Name
 import Type
-import FamInstEnv
 import InstEnv
 import Class
 import Avail
@@ -60,201 +59,10 @@ import Coverage
 import Util
 import MonadUtils
 import OrdList
-import UniqFM
-import UniqDFM
-import ListSetOps
-import Fingerprint
-import Maybes
 
 import Data.List
 import Data.IORef
 import Control.Monad( when )
-import Data.Map (Map)
-import qualified Data.Map as Map
-
--- | Extract information from the rename and typecheck phases to produce
--- a dependencies information for the module being compiled.
-mkDependencies :: TcGblEnv -> IO Dependencies
-mkDependencies
-          TcGblEnv{ tcg_mod = mod,
-                    tcg_imports = imports,
-                    tcg_th_used = th_var
-                  }
- = do
-      -- Template Haskell used?
-      th_used <- readIORef th_var
-      let dep_mods = eltsUDFM (delFromUDFM (imp_dep_mods imports)
-                                           (moduleName mod))
-                -- M.hi-boot can be in the imp_dep_mods, but we must remove
-                -- it before recording the modules on which this one depends!
-                -- (We want to retain M.hi-boot in imp_dep_mods so that
-                --  loadHiBootInterface can see if M's direct imports depend
-                --  on M.hi-boot, and hence that we should do the hi-boot consistency
-                --  check.)
-
-          pkgs | th_used   = insertList (toInstalledUnitId thUnitId) (imp_dep_pkgs imports)
-               | otherwise = imp_dep_pkgs imports
-
-          -- Set the packages required to be Safe according to Safe Haskell.
-          -- See Note [RnNames . Tracking Trust Transitively]
-          sorted_pkgs = sort pkgs
-          trust_pkgs  = imp_trust_pkgs imports
-          dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
-
-      return Deps { dep_mods   = dep_mods,
-                    dep_pkgs   = dep_pkgs',
-                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
-                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-                    -- sort to get into canonical order
-                    -- NB. remember to use lexicographic ordering
-
-mkUsedNames :: TcGblEnv -> NameSet
-mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
-
-mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> IO [Usage]
-mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
-  = do
-    eps <- hscEPS hsc_env
-    hashes <- mapM getFileHash dependent_files
-    let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
-                                       dir_imp_mods used_names
-        usages = mod_usages ++ [ UsageFile { usg_file_path = f
-                                           , usg_file_hash = hash }
-                               | (f, hash) <- zip dependent_files hashes ]
-                            ++ [ UsageMergedRequirement
-                                    { usg_mod = mod,
-                                      usg_mod_hash = hash
-                                    }
-                               | (mod, hash) <- merged ]
-    usages `seqList` return usages
-    -- seq the list of Usages returned: occasionally these
-    -- don't get evaluated for a while and we can end up hanging on to
-    -- the entire collection of Ifaces.
-
-mk_mod_usage_info :: PackageIfaceTable
-              -> HscEnv
-              -> Module
-              -> ImportedMods
-              -> NameSet
-              -> [Usage]
-mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
-  = mapMaybe mkUsage usage_mods
-  where
-    hpt = hsc_HPT hsc_env
-    dflags = hsc_dflags hsc_env
-    this_pkg = thisPackage dflags
-
-    used_mods    = moduleEnvKeys ent_map
-    dir_imp_mods = moduleEnvKeys direct_imports
-    all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
-    usage_mods   = sortBy stableModuleCmp all_mods
-                        -- canonical order is imported, to avoid interface-file
-                        -- wobblage.
-
-    -- ent_map groups together all the things imported and used
-    -- from a particular module
-    ent_map :: ModuleEnv [OccName]
-    ent_map  = nonDetFoldUFM add_mv emptyModuleEnv used_names
-     -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-     -- in ent_hashs
-     where
-      add_mv name mv_map
-        | isWiredInName name = mv_map  -- ignore wired-in names
-        | otherwise
-        = case nameModule_maybe name of
-             Nothing  -> ASSERT2( isSystemName name, ppr name ) mv_map
-                -- See Note [Internal used_names]
-
-             Just mod -> -- This lambda function is really just a
-                         -- specialised (++); originally came about to
-                         -- avoid quadratic behaviour (trac #2680)
-                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
-                where occ = nameOccName name
-
-    -- We want to create a Usage for a home module if
-    --  a) we used something from it; has something in used_names
-    --  b) we imported it, even if we used nothing from it
-    --     (need to recompile if its export list changes: export_fprint)
-    mkUsage :: Module -> Maybe Usage
-    mkUsage mod
-      | isNothing maybe_iface           -- We can't depend on it if we didn't
-                                        -- load its interface.
-      || mod == this_mod                -- We don't care about usages of
-                                        -- things in *this* module
-      = Nothing
-
-      | moduleUnitId mod /= this_pkg
-      = Just UsagePackageModule{ usg_mod      = mod,
-                                 usg_mod_hash = mod_hash,
-                                 usg_safe     = imp_safe }
-        -- for package modules, we record the module hash only
-
-      | (null used_occs
-          && isNothing export_hash
-          && not is_direct_import
-          && not finsts_mod)
-      = Nothing                 -- Record no usage info
-        -- for directly-imported modules, we always want to record a usage
-        -- on the orphan hash.  This is what triggers a recompilation if
-        -- an orphan is added or removed somewhere below us in the future.
-
-      | otherwise
-      = Just UsageHomeModule {
-                      usg_mod_name = moduleName mod,
-                      usg_mod_hash = mod_hash,
-                      usg_exports  = export_hash,
-                      usg_entities = Map.toList ent_hashs,
-                      usg_safe     = imp_safe }
-      where
-        maybe_iface  = lookupIfaceByModule dflags hpt pit mod
-                -- In one-shot mode, the interfaces for home-package
-                -- modules accumulate in the PIT not HPT.  Sigh.
-
-        Just iface   = maybe_iface
-        finsts_mod   = mi_finsts    iface
-        hash_env     = mi_hash_fn   iface
-        mod_hash     = mi_mod_hash  iface
-        export_hash | depend_on_exports = Just (mi_exp_hash iface)
-                    | otherwise         = Nothing
-
-        (is_direct_import, imp_safe)
-            = case lookupModuleEnv direct_imports mod of
-                Just (imv : _xs) -> (True, imv_is_safe imv)
-                Just _           -> pprPanic "mkUsage: empty direct import" Outputable.empty
-                Nothing          -> (False, safeImplicitImpsReq dflags)
-                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-                -- is used in the source code. We require them to be safe in Safe Haskell
-
-        used_occs = lookupModuleEnv ent_map mod `orElse` []
-
-        -- Making a Map here ensures that (a) we remove duplicates
-        -- when we have usages on several subordinates of a single parent,
-        -- and (b) that the usages emerge in a canonical order, which
-        -- is why we use Map rather than OccEnv: Map works
-        -- using Ord on the OccNames, which is a lexicographic ordering.
-        ent_hashs :: Map OccName Fingerprint
-        ent_hashs = Map.fromList (map lookup_occ used_occs)
-
-        lookup_occ occ =
-            case hash_env occ of
-                Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
-                Just r  -> r
-
-        depend_on_exports = is_direct_import
-        {- True
-              Even if we used 'import M ()', we have to register a
-              usage on the export list because we are sensitive to
-              changes in orphan instances/rules.
-           False
-              In GHC 6.8.x we always returned true, and in
-              fact it recorded a dependency on *all* the
-              modules underneath in the dependency tree.  This
-              happens to make orphans work right, but is too
-              expensive: it'll read too many interface files.
-              The 'isNothing maybe_iface' check above saved us
-              from generating many of these usages (at least in
-              one-shot mode), but that's even more bogus!
-        -}
 
 {-
 ************************************************************************
@@ -446,25 +254,19 @@ and Rec the rest.
 
 deSugarExpr :: HscEnv -> LHsExpr Id -> IO (Messages, Maybe CoreExpr)
 
-deSugarExpr hsc_env tc_expr
-  = do { let dflags       = hsc_dflags hsc_env
-             icntxt       = hsc_IC hsc_env
-             rdr_env      = ic_rn_gbl_env icntxt
-             type_env     = mkTypeEnvWithImplicits (ic_tythings icntxt)
-             fam_insts    = snd (ic_instances icntxt)
-             fam_inst_env = extendFamInstEnvList emptyFamInstEnv fam_insts
-             -- This stuff is a half baked version of TcRnDriver.setInteractiveContext
+deSugarExpr hsc_env tc_expr = do {
+         let dflags = hsc_dflags hsc_env
 
        ; showPass dflags "Desugar"
 
          -- Do desugaring
-       ; (msgs, mb_core_expr) <- initDs hsc_env (icInteractiveModule icntxt) rdr_env
-                                        type_env fam_inst_env [] $
+       ; (msgs, mb_core_expr) <- runTcInteractive hsc_env $ initDsTc $
                                  dsLExpr tc_expr
 
        ; case mb_core_expr of
             Nothing   -> return ()
-            Just expr -> dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr expr)
+            Just expr -> dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared"
+                         (pprCoreExpr expr)
 
        ; return (msgs, mb_core_expr) }
 
diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs
new file mode 100644
index 0000000000..665f2933bb
--- /dev/null
+++ b/compiler/deSugar/DsUsage.hs
@@ -0,0 +1,211 @@
+{-# LANGUAGE CPP #-}
+
+module DsUsage (
+    -- * Dependency/fingerprinting code (used by MkIface)
+    mkUsageInfo, mkUsedNames, mkDependencies
+    ) where
+
+#include "HsVersions.h"
+
+import DynFlags
+import HscTypes
+import TcRnTypes
+import Name
+import NameSet
+import Module
+import Outputable
+import Util
+import UniqFM
+import UniqDFM
+import ListSetOps
+import Fingerprint
+import Maybes
+
+import Data.List
+import Data.IORef
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+-- | Extract information from the rename and typecheck phases to produce
+-- a dependencies information for the module being compiled.
+mkDependencies :: TcGblEnv -> IO Dependencies
+mkDependencies
+          TcGblEnv{ tcg_mod = mod,
+                    tcg_imports = imports,
+                    tcg_th_used = th_var
+                  }
+ = do
+      -- Template Haskell used?
+      th_used <- readIORef th_var
+      let dep_mods = eltsUDFM (delFromUDFM (imp_dep_mods imports)
+                                           (moduleName mod))
+                -- M.hi-boot can be in the imp_dep_mods, but we must remove
+                -- it before recording the modules on which this one depends!
+                -- (We want to retain M.hi-boot in imp_dep_mods so that
+                --  loadHiBootInterface can see if M's direct imports depend
+                --  on M.hi-boot, and hence that we should do the hi-boot consistency
+                --  check.)
+
+          pkgs | th_used   = insertList (toInstalledUnitId thUnitId) (imp_dep_pkgs imports)
+               | otherwise = imp_dep_pkgs imports
+
+          -- Set the packages required to be Safe according to Safe Haskell.
+          -- See Note [RnNames . Tracking Trust Transitively]
+          sorted_pkgs = sort pkgs
+          trust_pkgs  = imp_trust_pkgs imports
+          dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
+
+      return Deps { dep_mods   = dep_mods,
+                    dep_pkgs   = dep_pkgs',
+                    dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
+                    dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
+                    -- sort to get into canonical order
+                    -- NB. remember to use lexicographic ordering
+
+mkUsedNames :: TcGblEnv -> NameSet
+mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
+
+mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> IO [Usage]
+mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
+  = do
+    eps <- hscEPS hsc_env
+    hashes <- mapM getFileHash dependent_files
+    let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
+                                       dir_imp_mods used_names
+        usages = mod_usages ++ [ UsageFile { usg_file_path = f
+                                           , usg_file_hash = hash }
+                               | (f, hash) <- zip dependent_files hashes ]
+                            ++ [ UsageMergedRequirement
+                                    { usg_mod = mod,
+                                      usg_mod_hash = hash
+                                    }
+                               | (mod, hash) <- merged ]
+    usages `seqList` return usages
+    -- seq the list of Usages returned: occasionally these
+    -- don't get evaluated for a while and we can end up hanging on to
+    -- the entire collection of Ifaces.
+
+mk_mod_usage_info :: PackageIfaceTable
+              -> HscEnv
+              -> Module
+              -> ImportedMods
+              -> NameSet
+              -> [Usage]
+mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
+  = mapMaybe mkUsage usage_mods
+  where
+    hpt = hsc_HPT hsc_env
+    dflags = hsc_dflags hsc_env
+    this_pkg = thisPackage dflags
+
+    used_mods    = moduleEnvKeys ent_map
+    dir_imp_mods = moduleEnvKeys direct_imports
+    all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
+    usage_mods   = sortBy stableModuleCmp all_mods
+                        -- canonical order is imported, to avoid interface-file
+                        -- wobblage.
+
+    -- ent_map groups together all the things imported and used
+    -- from a particular module
+    ent_map :: ModuleEnv [OccName]
+    ent_map  = nonDetFoldUFM add_mv emptyModuleEnv used_names
+     -- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
+     -- in ent_hashs
+     where
+      add_mv name mv_map
+        | isWiredInName name = mv_map  -- ignore wired-in names
+        | otherwise
+        = case nameModule_maybe name of
+             Nothing  -> ASSERT2( isSystemName name, ppr name ) mv_map
+                -- See Note [Internal used_names]
+
+             Just mod -> -- This lambda function is really just a
+                         -- specialised (++); originally came about to
+                         -- avoid quadratic behaviour (trac #2680)
+                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
+                where occ = nameOccName name
+
+    -- We want to create a Usage for a home module if
+    --  a) we used something from it; has something in used_names
+    --  b) we imported it, even if we used nothing from it
+    --     (need to recompile if its export list changes: export_fprint)
+    mkUsage :: Module -> Maybe Usage
+    mkUsage mod
+      | isNothing maybe_iface           -- We can't depend on it if we didn't
+                                        -- load its interface.
+      || mod == this_mod                -- We don't care about usages of
+                                        -- things in *this* module
+      = Nothing
+
+      | moduleUnitId mod /= this_pkg
+      = Just UsagePackageModule{ usg_mod      = mod,
+                                 usg_mod_hash = mod_hash,
+                                 usg_safe     = imp_safe }
+        -- for package modules, we record the module hash only
+
+      | (null used_occs
+          && isNothing export_hash
+          && not is_direct_import
+          && not finsts_mod)
+      = Nothing                 -- Record no usage info
+        -- for directly-imported modules, we always want to record a usage
+        -- on the orphan hash.  This is what triggers a recompilation if
+        -- an orphan is added or removed somewhere below us in the future.
+
+      | otherwise
+      = Just UsageHomeModule {
+                      usg_mod_name = moduleName mod,
+                      usg_mod_hash = mod_hash,
+                      usg_exports  = export_hash,
+                      usg_entities = Map.toList ent_hashs,
+                      usg_safe     = imp_safe }
+      where
+        maybe_iface  = lookupIfaceByModule dflags hpt pit mod
+                -- In one-shot mode, the interfaces for home-package
+                -- modules accumulate in the PIT not HPT.  Sigh.
+
+        Just iface   = maybe_iface
+        finsts_mod   = mi_finsts    iface
+        hash_env     = mi_hash_fn   iface
+        mod_hash     = mi_mod_hash  iface
+        export_hash | depend_on_exports = Just (mi_exp_hash iface)
+                    | otherwise         = Nothing
+
+        (is_direct_import, imp_safe)
+            = case lookupModuleEnv direct_imports mod of
+                Just (imv : _xs) -> (True, imv_is_safe imv)
+                Just _           -> pprPanic "mkUsage: empty direct import" Outputable.empty
+                Nothing          -> (False, safeImplicitImpsReq dflags)
+                -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
+                -- is used in the source code. We require them to be safe in Safe Haskell
+
+        used_occs = lookupModuleEnv ent_map mod `orElse` []
+
+        -- Making a Map here ensures that (a) we remove duplicates
+        -- when we have usages on several subordinates of a single parent,
+        -- and (b) that the usages emerge in a canonical order, which
+        -- is why we use Map rather than OccEnv: Map works
+        -- using Ord on the OccNames, which is a lexicographic ordering.
+        ent_hashs :: Map OccName Fingerprint
+        ent_hashs = Map.fromList (map lookup_occ used_occs)
+
+        lookup_occ occ =
+            case hash_env occ of
+                Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
+                Just r  -> r
+
+        depend_on_exports = is_direct_import
+        {- True
+              Even if we used 'import M ()', we have to register a
+              usage on the export list because we are sensitive to
+              changes in orphan instances/rules.
+           False
+              In GHC 6.8.x we always returned true, and in
+              fact it recorded a dependency on *all* the
+              modules underneath in the dependency tree.  This
+              happens to make orphans work right, but is too
+              expensive: it'll read too many interface files.
+              The 'isNothing maybe_iface' check above saved us
+              from generating many of these usages (at least in
+              one-shot mode), but that's even more bogus!
+        -}