More WIP in the direction of linting

This is temporarily disabled as it breaks T11068 (at least).

16 files changed, 92 insertions, 68 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index e88a67af6d..f981baef44 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -81,12 +81,17 @@ import GHC.Core.Coercion.Opt ( checkAxInstCo )
 import GHC.Core.Opt.Arity    ( typeArity )
 import GHC.Types.Demand      ( splitStrictSig, isDeadEndDiv )
 import GHC.Types.TypeEnv
+import GHC.Tc.Solver.Monad ( steps )
+import GHC.Unit.Home.ModInfo
+import GHC.Unit.External
+import GHC.Unit.Module.ModDetails
 import GHC.Unit.Module.ModGuts
 import GHC.Runtime.Context
 
 import Control.Monad
 import GHC.Utils.Monad
 import Data.Foldable      ( toList )
+import Data.IORef
 import Data.List.NonEmpty ( NonEmpty(..), groupWith )
 import Data.List          ( partition )
 import Data.Maybe
@@ -281,19 +286,20 @@ be, and it makes a convenient place for them.  They print out stuff
 before and after core passes, and do Core Lint when necessary.
 -}
 
-endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM ()
-endPass pass binds rules
+endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> [FamInst] -> CoreM ()
+endPass pass binds rules fam_insts
   = do { hsc_env <- getHscEnv
        ; print_unqual <- getPrintUnqualified
-       ; liftIO $ endPassIO hsc_env print_unqual pass binds rules }
+       ; liftIO $ endPassIO hsc_env print_unqual pass binds rules fam_insts }
 
 endPassIO :: HscEnv -> PrintUnqualified
-          -> CoreToDo -> CoreProgram -> [CoreRule] -> IO ()
+          -> CoreToDo -> CoreProgram -> [CoreRule] -> [FamInst] -> IO ()
 -- Used by the IO-is CorePrep too
-endPassIO hsc_env print_unqual pass binds rules
+endPassIO hsc_env print_unqual pass binds rules fam_insts
   = do { dumpPassResult logger dflags print_unqual mb_flag
                         (ppr pass) (pprPassDetails pass) binds rules
-       ; lintPassResult hsc_env (error "AMG TODO: fam_envs") pass binds }
+       ; fam_envs <- getFamInstEnvsIO hsc_env fam_insts
+       ; lintPassResult hsc_env fam_envs pass binds }
   where
     logger  = hsc_logger hsc_env
     dflags  = hsc_dflags hsc_env
@@ -302,6 +308,17 @@ endPassIO hsc_env print_unqual pass binds rules
                           | dopt Opt_D_verbose_core2core dflags -> Just flag
                 _ -> Nothing
 
+-- AMG TODO: it's far from clear this is right
+getFamInstEnvsIO :: HscEnv -> [FamInst] -> IO FamInstEnvs
+getFamInstEnvsIO hsc_env this_module_fam_insts
+  = do { let (_home_insts, home_fam_inst_list) = hptInstances hsc_env (\_ -> True)
+       ; let home_fam_insts = extendFamInstEnvList emptyFamInstEnv home_fam_inst_list
+       ; let (_, ic_fam_insts) = ic_instances (hsc_IC hsc_env)
+       ; let all_home_fam_insts = extendFamInstEnvList home_fam_insts (this_module_fam_insts ++ ic_fam_insts)
+       ; eps_fam_insts <- eps_fam_inst_env <$> readIORef (hsc_EPS hsc_env)
+       ; return (eps_fam_insts, all_home_fam_insts)
+       }
+
 dumpIfSet :: Logger -> DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO ()
 dumpIfSet logger dflags dump_me pass extra_info doc
   = Logger.dumpIfSet logger dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc
@@ -432,10 +449,12 @@ lintInteractiveExpr :: SDoc -- ^ The source of the linted expression
 lintInteractiveExpr what hsc_env expr
   | not (gopt Opt_DoCoreLinting dflags)
   = return ()
-  | Just err <- lintExpr dflags (error "AMG TODO: fam_envs") (interactiveInScope hsc_env) expr
-  = displayLintResults logger dflags False what (pprCoreExpr expr) (emptyBag, err)
   | otherwise
-  = return ()
+  = do { fam_envs <- getFamInstEnvsIO hsc_env [] -- AMG TODO: is empty list right?
+       ; case lintExpr dflags fam_envs (interactiveInScope hsc_env) expr of
+           Just err -> displayLintResults logger dflags False what (pprCoreExpr expr) (emptyBag, err)
+           Nothing   -> return ()
+       }
   where
     dflags = hsc_dflags hsc_env
     logger = hsc_logger hsc_env
@@ -2153,21 +2172,23 @@ lintCoercion co@(UnivCo prov r ty1 ty2)
      lint_prov _ _ _ _ prov@(PluginProv _) = return prov
 
      lint_prov _ ty1' _ ty2' prov@(StepsProv m n)
+       | 1 == 1 = return prov -- AMG TODO: fix lint
+       | otherwise
        = do { fam_envs <- getFamInstEnvs
-            ; let mb_u = stepsUntil fam_envs m ty1'
-            ; let mb_v = stepsUntil fam_envs n ty2'
-            ; case (mb_u, mb_v) of
-                (Just u, Just v) -> do checkL (u `eqType` v) (report mb_u mb_v "inputs do not reduce to equal types")
-                                       return prov
-                _ -> failWithL (report mb_u mb_v "inputs do not reduce by the given step counts")
+            ; let (u, m') = steps (mkIntWithInf m) fam_envs ty1'
+            ; let (v, n') = steps (mkIntWithInf n) fam_envs ty2'
+            ; checkL (u `eqType` v) (report u m' v n' "inputs do not reduce to equal types")
+            ; return prov
             }
        where
-         report mb_u mb_v s =
+         report u m' v n' s =
              hang (text $ "Invalid steps coercion: " ++ s)
-                     2 (vcat [ text "From:" <+> ppr ty1'
-                             , if m > 0 then text "after" <+> ppr m <+> text "steps:" <+> ppr mb_u else empty
-                             , text "  To:" <+> ppr ty2'
-                             , if n > 0 then text "after" <+> ppr n <+> text "steps:" <+> ppr mb_v else empty
+                     2 (vcat [ text "LHS:" <+> ppr ty1'
+                             , text "Expected" <+> ppr m <+> text "steps, got" <+> ppr m'
+                             , if m' > 0 then text "Reduced LHS:" <+> ppr u else empty
+                             , text "RHS:" <+> ppr ty2'
+                             , text "Expected" <+> ppr n <+> text "steps, got" <+> ppr n'
+                             , if n' > 0 then text "Reduced RHS:" <+> ppr v else empty
                              ])
 
      check_kinds kco k1 k2
@@ -2509,17 +2530,6 @@ compatible_branches (CoAxBranch { cab_tvs = tvs1
       Nothing             -> True
 
 
-stepsUntil :: FamInstEnvs -> Int -> Type -> Maybe Type
-stepsUntil fam_envs = go
-  where
-    go :: Int -> Type -> Maybe Type
-    go 0 ty = Just ty
-    go !i (TyConApp tycon args)
-            | Just (_, ty) <- reduceTyFamApp_maybe fam_envs Nominal tycon args = go (i-1) ty
-            | Just ty      <- expandSynTyConApp_maybe tycon args               = go i ty
-    go _ _ = Nothing
-
-
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 5a9a86c4f6..ac5f1c28a4 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -471,7 +471,7 @@ runCorePasses passes guts
       withTiming logger dflags (ppr pass <+> brackets (ppr mod))
                    (const ()) $ do
             guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
-            endPass pass (mg_binds guts') (mg_rules guts')
+            endPass pass (mg_binds guts') (mg_rules guts') (mg_fam_insts guts')
             return guts'
 
     mod = mg_module guts
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 7c17bad4ad..9014e5c7c3 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -37,6 +37,7 @@ import GHC.Builtin.Types
 import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
 import GHC.Types.Id.Make ( realWorldPrimId, mkPrimOpId )
 
+import GHC.Core.FamInstEnv
 import GHC.Core.Utils
 import GHC.Core.Opt.Arity
 import GHC.Core.FVs
@@ -187,9 +188,9 @@ type CpeRhs  = CoreExpr    -- Non-terminal 'rhs'
 ************************************************************************
 -}
 
-corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon]
+corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon] -> [FamInst]
             -> IO (CoreProgram, S.Set CostCentre)
-corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
+corePrepPgm hsc_env this_mod mod_loc binds data_tycons fam_insts =
     withTiming logger dflags
                (text "CorePrep"<+>brackets (ppr this_mod))
                (const ()) $ do
@@ -211,7 +212,7 @@ corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
                       floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds
                       return (deFloatTop (floats1 `appendFloats` floats2))
 
-    endPassIO hsc_env alwaysQualify CorePrep binds_out []
+    endPassIO hsc_env alwaysQualify CorePrep binds_out [] fam_insts
     return (binds_out, cost_centres)
   where
     dflags = hsc_dflags hsc_env
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index f16685775b..a21263ffff 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1509,10 +1509,10 @@ hscSimpleIface' tc_result mb_old_iface = do
 --------------------------------------------------------------
 
 -- | Compile to hard-code.
-hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
+hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath -> [FamInst]
                -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
                -- ^ @Just f@ <=> _stub.c is f
-hscGenHardCode hsc_env cgguts location output_filename = do
+hscGenHardCode hsc_env cgguts location output_filename fam_insts = do
         let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                     -- From now on, we just use the bits we need.
                     cg_module   = this_mod,
@@ -1534,7 +1534,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
         -- Do saturation and convert to A-normal form
         (prepd_binds, local_ccs) <- {-# SCC "CorePrep" #-}
                        corePrepPgm hsc_env this_mod location
-                                   core_binds data_tycons
+                                   core_binds data_tycons fam_insts
         -----------------  Convert to STG ------------------
         (stg_binds, (caf_ccs, caf_cc_stacks))
             <- {-# SCC "CoreToStg" #-}
@@ -1584,8 +1584,9 @@ hscGenHardCode hsc_env cgguts location output_filename = do
 hscInteractive :: HscEnv
                -> CgGuts
                -> ModLocation
+               -> [FamInst]
                -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-hscInteractive hsc_env cgguts location = do
+hscInteractive hsc_env cgguts location fam_insts = do
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
     let CgGuts{ -- This is the last use of the ModGuts in a compilation.
@@ -1605,7 +1606,7 @@ hscInteractive hsc_env cgguts location = do
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
     (prepd_binds, _) <- {-# SCC "CorePrep" #-}
-                   corePrepPgm hsc_env this_mod location core_binds data_tycons
+                   corePrepPgm hsc_env this_mod location core_binds data_tycons fam_insts
     -----------------  Generate byte code ------------------
     comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks
     ------------------ Create f-x-dynamic C-side stuff -----
@@ -1885,7 +1886,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
     {- Prepare For Code Generation -}
     -- Do saturation and convert to A-normal form
     (prepd_binds, _) <- {-# SCC "CorePrep" #-}
-      liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons
+      liftIO $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons fam_insts
 
     {- Generate byte code -}
     cbc <- liftIO $ byteCodeGen hsc_env this_mod
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index df54f35e04..77fb8e763e 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -266,7 +266,7 @@ compileOne' m_tc_result mHscMessage
             final_iface <- mkFullIface hsc_env' partial_iface Nothing
             liftIO $ hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash (ms_location summary)
 
-            (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location
+            (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env' cgguts mod_location (md_fam_insts hmi_details)
 
             stub_o <- case hasStub of
                       Nothing -> return []
@@ -1355,7 +1355,7 @@ runPhase (HscOut src_flavour mod_name result) _ = do
                     PipeState{hsc_env=hsc_env'} <- getPipeState
 
                     (outputFilename, mStub, foreign_files, cg_infos) <- liftIO $
-                      hscGenHardCode hsc_env' cgguts mod_location output_fn
+                      hscGenHardCode hsc_env' cgguts mod_location output_fn (md_fam_insts mod_details)
 
                     let dflags = hsc_dflags hsc_env'
                     final_iface <- liftIO (mkFullIface hsc_env' partial_iface (Just cg_infos))
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 1410ef2709..9babcd2890 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -184,7 +184,7 @@ deSugar hsc_env
         -- You might think it doesn't matter, but the simplifier brings all top-level
         -- things into the in-scope set before simplifying; so we get no unfolding for F#!
 
-        ; endPassIO hsc_env print_unqual CoreDesugar final_pgm rules_for_imps
+        ; endPassIO hsc_env print_unqual CoreDesugar final_pgm rules_for_imps fam_insts
         ; let simpl_opts = initSimpleOpts dflags
         ; let (ds_binds, ds_rules_for_imps, occ_anald_binds)
                 = simpleOptPgm simpl_opts mod final_pgm rules_for_imps
@@ -193,7 +193,7 @@ deSugar hsc_env
         ; dumpIfSet_dyn logger dflags Opt_D_dump_occur_anal "Occurrence analysis"
             FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps )
 
-        ; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps
+        ; endPassIO hsc_env print_unqual CoreDesugarOpt ds_binds ds_rules_for_imps fam_insts
 
         ; let used_names = mkUsedNames tcg_env
               pluginModules = map lpModule (hsc_plugins hsc_env)
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index df4a377e39..9e4840d9c1 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -314,7 +314,8 @@ mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
 mkDsEnvs unit_env mod rdr_env type_env fam_inst_env msg_var cc_st_var
          complete_matches
   = let if_genv = IfGblEnv { if_doc       = text "mkDsEnvs",
-                             if_rec_types = Just (mod, return type_env) }
+                             if_rec_types = Just (mod, return type_env)
+                           , if_fam_insts = Just (mempty, fam_inst_env) } -- AMY TODO: EPS fam insts? how come DS doesn't need them?
         if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod)
                              NotBoot
         real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1)
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 14afbeeb14..2dddaf67a7 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -439,7 +439,7 @@ tidyProgram hsc_env  (ModGuts { mg_module           = mod
               ; alg_tycons = filter isAlgTyCon tcs
               }
 
-        ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules
+        ; endPassIO hsc_env print_unqual CoreTidy all_tidy_binds tidy_rules fam_insts
 
           -- If the endPass didn't print the rules, but ddump-rules is
           -- on, print now
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index d974485e0f..79de0951a6 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1200,13 +1200,16 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
                    ; rhs'   <- tcIfaceExpr rhs
                    ; whenGOptM Opt_DoCoreLinting $ do
                       { dflags <- getDynFlags
-                      ; (_, lcl_env) <- getEnvs
+                      ; (gbl_env, lcl_env) <- getEnvs
                       ; let in_scope :: [Var]
                             in_scope = ((nonDetEltsUFM $ if_tv_env lcl_env) ++
                                         (nonDetEltsUFM $ if_id_env lcl_env) ++
                                         bndrs' ++
                                         exprsFreeIdsList args')
-                      ; case lintExpr dflags (error "AMG TODO: fam_envs")  in_scope rhs' of
+                      ; let fam_envs = case if_fam_insts gbl_env of -- AMG TODO: clean up
+                                         Just xs -> xs
+                                         Nothing -> panic "tcIfaceRule: missing if_fam_insts"
+                      ; case lintExpr dflags fam_envs in_scope rhs' of
                           Nothing   -> return ()
                           Just errs -> do
                             logger <- getLogger
@@ -1734,7 +1737,8 @@ tcPragExpr is_compulsory toplvl name expr
         in_scope <- get_in_scope
         dflags   <- getDynFlags
         logger   <- getLogger
-        case lintUnfolding is_compulsory dflags (error "AMG TODO: fam_envs")  noSrcLoc in_scope core_expr' of
+        fam_envs <- fromJust . if_fam_insts <$> getGblEnv -- AMG TODO
+        case lintUnfolding is_compulsory dflags fam_envs noSrcLoc in_scope core_expr' of
           Nothing   -> return ()
           Just errs -> liftIO $
             displayLintResults logger dflags False doc
diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs
index 65e91608b9..d70b3ec381 100644
--- a/compiler/GHC/Tc/Instance/Family.hs
+++ b/compiler/GHC/Tc/Instance/Family.hs
@@ -1034,10 +1034,3 @@ reportConflictInstErr fam_inst (match1 : _)
    -- The sortBy just arranges that instances are displayed in order
    -- of source location, which reduced wobbling in error messages,
    -- and is better for users
-
-tcGetFamInstEnvs :: TcM FamInstEnvs
--- Gets both the external-package inst-env
--- and the home-pkg inst env (includes module being compiled)
-tcGetFamInstEnvs
-  = do { eps <- getEps; env <- getGblEnv
-       ; return (eps_fam_inst_env eps, tcg_fam_inst_env env) }
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 7afbffe960..32dd6b7c0c 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -117,7 +117,7 @@ module GHC.Tc.Solver.Monad (
 
     -- Misc
     getDefaultInfo, getDynFlags, getGlobalRdrEnvTcS,
-    matchFam, matchFamTcM, stepFam,
+    matchFam, matchFamTcM, stepFam, steps,
     checkWellStagedDFun,
     pprEq,                                   -- Smaller utils, re-exported from TcM
                                              -- TODO (DV): these are only really used in the
@@ -3830,8 +3830,8 @@ stepFamTcM limit tycon args
            Just (co, ty) -> do { let ty0 = mkTyConApp tycon args
                                ; let (ty', n) = steps (limit `minusWithInf` 1) fam_envs ty
                                ; let co' = Rep.UnivCo (Rep.StepsProv 0 (n+1)) Nominal ty' ty0
-                               ; let r | n > 0     = (co', ty')
-                                       | otherwise = (mkTcSymCo co, ty')
+                               ; let r | n > 1     = (co', ty')  -- AMG TODO: testing not n > 0
+                                       | otherwise = (mkTcSymCo co, ty)
                                ; return (Just r, n+1)
                                }
        }
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 8f22e3c1f3..b183cc0e56 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -268,6 +268,7 @@ data IfGblEnv
                 -- Allows a read effect, so it can be in a mutable
                 -- variable; c.f. handling the external package type env
                 -- Nothing => interactive stuff, no loops possible
+      , if_fam_insts :: Maybe FamInstEnvs
     }
 
 data IfLclEnv
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 493602fea0..ae1efed685 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -142,6 +142,8 @@ module GHC.Tc.Utils.Monad(
   -- * Stuff for cost centres.
   getCCIndexM, getCCIndexTcM,
 
+  tcGetFamInstEnvs,
+
   -- * Types etc.
   module GHC.Tc.Types,
   module GHC.Data.IOEnv
@@ -2026,12 +2028,14 @@ initIfaceTcRn thing_inside
               -- When we are instantiating a signature, we DEFINITELY
               -- do not want to knot tie.
               is_instantiate = isHomeUnitInstantiating home_unit
+        ; fam_insts <- tcGetFamInstEnvs
         ; let { if_env = IfGblEnv {
                             if_doc = text "initIfaceTcRn",
                             if_rec_types =
                                 if is_instantiate
                                     then Nothing
-                                    else Just (mod, get_type_env)
+                                    else Just (mod, get_type_env),
+                        if_fam_insts = Just fam_insts
                          }
               ; get_type_env = readTcRef (tcg_type_env_var tcg_env) }
         ; setEnvs (if_env, ()) thing_inside }
@@ -2044,7 +2048,8 @@ initIfaceLoad :: HscEnv -> IfG a -> IO a
 initIfaceLoad hsc_env do_this
  = do let gbl_env = IfGblEnv {
                         if_doc = text "initIfaceLoad",
-                        if_rec_types = Nothing
+                        if_rec_types = Nothing,
+                        if_fam_insts = Nothing
                     }
       initTcRnIf 'i' hsc_env gbl_env () do_this
 
@@ -2057,7 +2062,8 @@ initIfaceCheck doc hsc_env do_this
                          Nothing        -> Nothing
           gbl_env = IfGblEnv {
                         if_doc = text "initIfaceCheck" <+> doc,
-                        if_rec_types = rec_types
+                        if_rec_types = rec_types,
+                        if_fam_insts = Nothing
                     }
       initTcRnIf 'i' hsc_env gbl_env () do_this
 
@@ -2172,3 +2178,12 @@ getCCIndexM get_ccs nm = do
 -- | See 'getCCIndexM'.
 getCCIndexTcM :: FastString -> TcM CostCentreIndex
 getCCIndexTcM = getCCIndexM tcg_cc_st
+
+
+
+tcGetFamInstEnvs :: TcM FamInstEnvs
+-- Gets both the external-package inst-env
+-- and the home-pkg inst env (includes module being compiled)
+tcGetFamInstEnvs
+  = do { eps <- getEps; env <- getGblEnv
+       ; return (eps_fam_inst_env eps, tcg_fam_inst_env env) }
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
index 64800dd243..0a1516879b 100644
--- a/testsuite/tests/callarity/unittest/CallArity1.hs
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -172,7 +172,7 @@ main = do
         dflags <- getSessionDynFlags
         logger <- getLogger
         liftIO $ forM_ exprs $ \(n,e) -> do
-            case lintExpr dflags [f,scrutf,scruta] e of
+            case lintExpr dflags mempty [f,scrutf,scruta] e of
                 Just errs -> putMsg logger dflags (pprMessageBag errs $$ text "in" <+> text n)
                 Nothing -> return ()
             putMsg logger dflags (text n Outputable.<> char ':')
diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/parser/should_run/CountAstDeps.stdout
index 84819595a6..f86cd80734 100644
--- a/testsuite/tests/parser/should_run/CountAstDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountAstDeps.stdout
@@ -1,4 +1,4 @@
-Found 239 Language.Haskell.Syntax module dependencies
+Found 238 Language.Haskell.Syntax module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -29,7 +29,6 @@ GHC.Core.DataCon
 GHC.Core.FVs
 GHC.Core.FamInstEnv
 GHC.Core.InstEnv
-GHC.Core.Lint
 GHC.Core.Make
 GHC.Core.Map.Type
 GHC.Core.Multiplicity
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout
index a7fe9c604e..22c079039b 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout
@@ -1,4 +1,4 @@
-Found 247 GHC.Parser module dependencies
+Found 246 GHC.Parser module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.Types
@@ -29,7 +29,6 @@ GHC.Core.DataCon
 GHC.Core.FVs
 GHC.Core.FamInstEnv
 GHC.Core.InstEnv
-GHC.Core.Lint
 GHC.Core.Make
 GHC.Core.Map.Type
 GHC.Core.Multiplicity